diff --git a/.gitattributes b/.gitattributes index c8de2ea05..56f995dfd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1,5 +1,10 @@ -*.txt eol=crlf -*.pas eol=lf -*.lpr eol=lf -*.lpi eol=lf -*.po eol=lf +# Autodetect text files +* text=auto + +# Text files +*.txt text +*.pas text +*.lfm text +*.lpr text +*.lpi text +*.po text diff --git a/.gitignore b/.gitignore index f0005bebf..e32cb3801 100644 --- a/.gitignore +++ b/.gitignore @@ -21,6 +21,7 @@ fp.dsk *.res mangadownloader/lib updater/lib +updaterslim/lib bin/ Release/ diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..0876d0aa3 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,5 @@ +[submodule "3rd/internettools"] + path = 3rd/internettools + url = https://github.com/benibela/internettools.git + ignore = dirty + shallow = true diff --git a/3rd/Imaging/Extras/Extensions/ElderImagery.pas b/3rd/Imaging/Extras/Extensions/ElderImagery.pas deleted file mode 100644 index d84f792c8..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImagery.pas +++ /dev/null @@ -1,657 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is basic unit of Elder Imagery extension for Vampyre Imaging Library. - It adds support for loading and saving of images and textures from older - Bethesda games (like TES2: Daggerfall, Redguard, Terminator: FS, TES: Arena, ...). - This unit registers all file formats declared in additional ElderImagery units - so its the only unit you need to add to uses clause of your project - for Imaging to be able to load/save these new formats using standard - loading/saving functions.} -unit ElderImagery; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging; - -type - TElderFileFormat = class; - TElderFileFormatClass = class of TElderFileFormat; - - { Used to hold information about some special images without headers.} - TNoHeaderFileInfo = record - Size: LongInt; - Width: LongInt; - Height: LongInt; - end; - - { Basic class for image formats used mainly in TES2: Daggerfall.} - TElderFileFormat = class(TImageFileFormat) - protected - FPalette: TPalette24Size256; - FARGBPalette: PPalette32; - procedure Define; override; - { Decodes RLE compressed data.} - procedure DagRLEDecode(InData: Pointer; OutSize: LongInt; out OutData: Pointer); - function FindNoHeaderInfo(Size: LongInt; Infos: array of TNoHeaderFileInfo): LongInt; - function TestNoHeaderFormat(Handle: TImagingHandle): TElderFileFormatClass; - procedure ConvertPalette(const ElderPal: TPalette24Size256; ARGBPal: PPalette32); - procedure SetPalette(const Value: TPalette24Size256); - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - function IsSupported(const Image: TImageData): Boolean; override; - public - destructor Destroy; override; - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Current palette used when loading and saving images. Nearly all images - in Daggerfall use external palettes. Change this property if you want - images that don't use default palette to load correctly.} - property Palette: TPalette24Size256 read FPalette write SetPalette; - end; - - { Header of IMG and CIF files.} - TImgHeader = packed record - XOff: Word; - YOff: Word; - Width: Word; - Height: Word; - Unk: Word; // Might indicate compressed data or not - ImageSize: Word; // Size of Image data (but not always) - end; - -const - { This is default Daggerfall's palette (C:\Dagger\Arena2\pal.pal). - Every TElderFileFormat descendant loads this pal in constructor.} - DaggerfallPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 244; G: 202; R: 167), - (B: 227; G: 180; R: 144), (B: 207; G: 152; R: 118), (B: 193; G: 133; R: 100), - (B: 180; G: 113; R: 80), (B: 165; G: 100; R: 70), (B: 152; G: 93; R: 63), - (B: 140; G: 86; R: 55), (B: 129; G: 79; R: 48), (B: 122; G: 75; R: 43), - (B: 112; G: 70; R: 40), (B: 103; G: 64; R: 39), (B: 91; G: 67; R: 38), - (B: 79; G: 63; R: 43), (B: 66; G: 54; R: 41), (B: 54; G: 50; R: 40), - (B: 232; G: 196; R: 196), (B: 220; G: 177; R: 177), (B: 204; G: 157; R: 157), - (B: 188; G: 138; R: 138), (B: 175; G: 122; R: 122), (B: 155; G: 105; R: 106), - (B: 143; G: 94; R: 97), (B: 126; G: 81; R: 89), (B: 109; G: 72; R: 88), - (B: 101; G: 68; R: 85), (B: 86; G: 61; R: 77), (B: 75; G: 55; R: 71), - (B: 67; G: 51; R: 63), (B: 63; G: 47; R: 56), (B: 56; G: 45; R: 52), - (B: 46; G: 44; R: 46), (B: 245; G: 212; R: 172), (B: 229; G: 193; R: 150), - (B: 213; G: 174; R: 128), (B: 196; G: 154; R: 105), (B: 183; G: 140; R: 88), - (B: 173; G: 127; R: 78), (B: 160; G: 118; R: 74), (B: 151; G: 110; R: 69), - (B: 134; G: 103; R: 65), (B: 123; G: 92; R: 60), (B: 109; G: 85; R: 54), - (B: 96; G: 76; R: 51), (B: 83; G: 71; R: 44), (B: 69; G: 63; R: 42), - (B: 61; G: 54; R: 38), (B: 50; G: 45; R: 34), (B: 205; G: 205; R: 224), - (B: 188; G: 188; R: 199), (B: 165; G: 165; R: 174), (B: 145; G: 145; R: 159), - (B: 135; G: 135; R: 149), (B: 122; G: 122; R: 137), (B: 114; G: 114; R: 127), - (B: 103; G: 103; R: 116), (B: 94; G: 94; R: 109), (B: 85; G: 85; R: 96), - (B: 75; G: 75; R: 85), (B: 68; G: 68; R: 80), (B: 61; G: 61; R: 67), - (B: 53; G: 53; R: 59), (B: 48; G: 48; R: 50), (B: 44; G: 44; R: 45), - (B: 176; G: 205; R: 255), (B: 147; G: 185; R: 244), (B: 123; G: 164; R: 230), - (B: 104; G: 152; R: 217), (B: 87; G: 137; R: 205), (B: 68; G: 124; R: 192), - (B: 68; G: 112; R: 179), (B: 62; G: 105; R: 167), (B: 55; G: 97; R: 154), - (B: 49; G: 90; R: 142), (B: 45; G: 82; R: 122), (B: 51; G: 77; R: 102), - (B: 52; G: 69; R: 87), (B: 50; G: 62; R: 73), (B: 47; G: 59; R: 60), - (B: 44; G: 48; R: 49), (B: 220; G: 220; R: 220), (B: 197; G: 197; R: 197), - (B: 185; G: 185; R: 185), (B: 174; G: 174; R: 174), (B: 162; G: 162; R: 162), - (B: 147; G: 147; R: 147), (B: 132; G: 132; R: 132), (B: 119; G: 119; R: 119), - (B: 110; G: 110; R: 110), (B: 99; G: 99; R: 99), (B: 87; G: 87; R: 87), - (B: 78; G: 78; R: 78), (B: 67; G: 67; R: 67), (B: 58; G: 58; R: 58), - (B: 51; G: 51; R: 51), (B: 44; G: 44; R: 44), (B: 182; G: 218; R: 227), - (B: 158; G: 202; R: 202), (B: 134; G: 187; R: 187), (B: 109; G: 170; R: 170), - (B: 87; G: 154; R: 154), (B: 77; G: 142; R: 142), (B: 70; G: 135; R: 135), - (B: 62; G: 124; R: 124), (B: 54; G: 112; R: 112), (B: 46; G: 103; R: 103), - (B: 39; G: 91; R: 91), (B: 40; G: 83; R: 83), (B: 45; G: 72; R: 72), - (B: 47; G: 63; R: 63), (B: 50; G: 55; R: 55), (B: 45; G: 48; R: 48), - (B: 255; G: 246; R: 103), (B: 241; G: 238; R: 45), (B: 226; G: 220; R: 0), - (B: 212; G: 203; R: 0), (B: 197; G: 185; R: 0), (B: 183; G: 168; R: 0), - (B: 168; G: 150; R: 0), (B: 154; G: 133; R: 0), (B: 139; G: 115; R: 0), - (B: 127; G: 106; R: 4), (B: 116; G: 97; R: 7), (B: 104; G: 87; R: 11), - (B: 93; G: 78; R: 14), (B: 81; G: 69; R: 18), (B: 69; G: 60; R: 21), - (B: 58; G: 51; R: 25), (B: 202; G: 221; R: 196), (B: 175; G: 200; R: 168), - (B: 148; G: 176; R: 141), (B: 123; G: 156; R: 118), (B: 107; G: 144; R: 109), - (B: 93; G: 130; R: 94), (B: 82; G: 116; R: 86), (B: 77; G: 110; R: 78), - (B: 68; G: 99; R: 67), (B: 61; G: 89; R: 53), (B: 52; G: 77; R: 45), - (B: 46; G: 68; R: 37), (B: 39; G: 60; R: 39), (B: 30; G: 55; R: 30), - (B: 34; G: 51; R: 34), (B: 40; G: 47; R: 40), (B: 179; G: 107; R: 83), - (B: 175; G: 95; R: 75), (B: 175; G: 87; R: 67), (B: 163; G: 79; R: 59), - (B: 155; G: 75; R: 51), (B: 147; G: 71; R: 47), (B: 155; G: 91; R: 47), - (B: 139; G: 83; R: 43), (B: 127; G: 75; R: 39), (B: 115; G: 67; R: 35), - (B: 99; G: 63; R: 31), (B: 87; G: 55; R: 27), (B: 75; G: 47; R: 23), - (B: 59; G: 39; R: 19), (B: 47; G: 31; R: 15), (B: 35; G: 23; R: 11), - (B: 216; G: 227; R: 162), (B: 185; G: 205; R: 127), (B: 159; G: 183; R: 101), - (B: 130; G: 162; R: 77), (B: 109; G: 146; R: 66), (B: 101; G: 137; R: 60), - (B: 92; G: 127; R: 54), (B: 84; G: 118; R: 48), (B: 76; G: 108; R: 42), - (B: 65; G: 98; R: 37), (B: 53; G: 87; R: 34), (B: 51; G: 75; R: 35), - (B: 45; G: 64; R: 37), (B: 43; G: 56; R: 39), (B: 38; G: 51; R: 40), - (B: 43; G: 46; R: 45), (B: 179; G: 115; R: 79), (B: 175; G: 111; R: 75), - (B: 171; G: 107; R: 71), (B: 167; G: 103; R: 67), (B: 159; G: 99; R: 63), - (B: 155; G: 95; R: 59), (B: 151; G: 91; R: 55), (B: 143; G: 87; R: 51), - (B: 40; G: 40; R: 40), (B: 38; G: 38; R: 38), (B: 35; G: 35; R: 35), - (B: 31; G: 31; R: 31), (B: 27; G: 27; R: 27), (B: 23; G: 23; R: 23), - (B: 19; G: 19; R: 19), (B: 15; G: 15; R: 15), (B: 254; G: 255; R: 199), - (B: 254; G: 245; R: 185), (B: 254; G: 235; R: 170), (B: 254; G: 225; R: 156), - (B: 255; G: 215; R: 141), (B: 255; G: 205; R: 127), (B: 255; G: 195; R: 112), - (B: 255; G: 185; R: 98), (B: 255; G: 175; R: 83), (B: 241; G: 167; R: 54), - (B: 234; G: 155; R: 50), (B: 226; G: 143; R: 46), (B: 219; G: 131; R: 43), - (B: 212; G: 119; R: 39), (B: 205; G: 107; R: 35), (B: 198; G: 95; R: 31), - (B: 190; G: 84; R: 27), (B: 183; G: 72; R: 23), (B: 176; G: 60; R: 19), - (B: 169; G: 48; R: 15), (B: 162; G: 36; R: 12), (B: 154; G: 24; R: 8), - (B: 147; G: 12; R: 4), (B: 130; G: 22; R: 0), (B: 111; G: 34; R: 0), - (B: 102; G: 33; R: 1), (B: 92; G: 33; R: 3), (B: 83; G: 32; R: 10), - (B: 74; G: 39; R: 27), (B: 65; G: 41; R: 33), (B: 57; G: 43; R: 39), - (B: 48; G: 45; R: 45)); - - { This is default Redguard's palette (Redguard\fxart\Redguard.col). - It is default palette for BSI image file format.} - RedguardPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), (B: 255; G: 0; R: 255), - (B: 255; G: 0; R: 255), (B: 133; G: 196; R: 183), (B: 100; G: 181; R: 153), - (B: 66; G: 165; R: 124), (B: 33; G: 150; R: 94), (B: 31; G: 139; R: 87), - (B: 28; G: 127; R: 80), (B: 26; G: 116; R: 73), (B: 24; G: 105; R: 66), - (B: 21; G: 93; R: 59), (B: 19; G: 82; R: 52), (B: 17; G: 71; R: 45), - (B: 14; G: 59; R: 38), (B: 12; G: 48; R: 31), (B: 10; G: 37; R: 24), - (B: 7; G: 25; R: 17), (B: 5; G: 14; R: 10), (B: 230; G: 179; R: 142), - (B: 216; G: 155; R: 127), (B: 199; G: 151; R: 136), (B: 205; G: 134; R: 118), - (B: 199; G: 131; R: 103), (B: 191; G: 130; R: 108), (B: 202; G: 113; R: 95), - (B: 180; G: 112; R: 94), (B: 197; G: 95; R: 78), (B: 183; G: 106; R: 78), - (B: 174; G: 96; R: 75), (B: 160; G: 91; R: 63), (B: 166; G: 84; R: 55), - (B: 151; G: 91; R: 54), (B: 152; G: 75; R: 49), (B: 142; G: 81; R: 51), - (B: 216; G: 227; R: 162), (B: 155; G: 212; R: 109), (B: 95; G: 198; R: 57), - (B: 34; G: 183; R: 4), (B: 32; G: 169; R: 4), (B: 29; G: 155; R: 4), - (B: 27; G: 141; R: 4), (B: 25; G: 127; R: 4), (B: 22; G: 113; R: 4), - (B: 20; G: 100; R: 4), (B: 18; G: 86; R: 3), (B: 15; G: 72; R: 3), - (B: 13; G: 58; R: 3), (B: 11; G: 44; R: 3), (B: 8; G: 30; R: 3), - (B: 6; G: 16; R: 3), (B: 134; G: 72; R: 57), (B: 132; G: 71; R: 47), - (B: 122; G: 75; R: 51), (B: 123; G: 61; R: 44), (B: 119; G: 59; R: 37), - (B: 103; G: 55; R: 41), (B: 104; G: 47; R: 31), (B: 98; G: 47; R: 27), - (B: 91; G: 45; R: 33), (B: 83; G: 42; R: 34), (B: 75; G: 40; R: 24), - (B: 80; G: 33; R: 22), (B: 63; G: 29; R: 24), (B: 66; G: 24; R: 16), - (B: 51; G: 27; R: 24), (B: 40; G: 24; R: 24), (B: 255; G: 246; R: 103), - (B: 241; G: 238; R: 45), (B: 235; G: 247; R: 0), (B: 228; G: 228; R: 3), - (B: 204; G: 207; R: 1), (B: 189; G: 187; R: 2), (B: 173; G: 166; R: 2), - (B: 158; G: 146; R: 3), (B: 142; G: 126; R: 3), (B: 127; G: 106; R: 4), - (B: 114; G: 97; R: 9), (B: 96; G: 81; R: 7), (B: 75; G: 63; R: 6), - (B: 53; G: 47; R: 6), (B: 35; G: 31; R: 6), (B: 19; G: 18; R: 6), - (B: 184; G: 116; R: 83), (B: 175; G: 96; R: 57), (B: 166; G: 75; R: 30), - (B: 157; G: 55; R: 4), (B: 145; G: 51; R: 4), (B: 133; G: 47; R: 4), - (B: 122; G: 43; R: 4), (B: 110; G: 39; R: 3), (B: 98; G: 35; R: 3), - (B: 86; G: 31; R: 3), (B: 74; G: 26; R: 3), (B: 62; G: 22; R: 3), - (B: 51; G: 18; R: 3), (B: 39; G: 14; R: 2), (B: 27; G: 10; R: 2), - (B: 15; G: 6; R: 2), (B: 255; G: 255; R: 184), (B: 255; G: 241; R: 137), - (B: 255; G: 226; R: 90), (B: 255; G: 212; R: 43), (B: 240; G: 189; R: 39), - (B: 225; G: 166; R: 35), (B: 211; G: 144; R: 30), (B: 196; G: 121; R: 26), - (B: 181; G: 98; R: 22), (B: 163; G: 92; R: 20), (B: 127; G: 73; R: 15), - (B: 105; G: 60; R: 13), (B: 83; G: 46; R: 12), (B: 61; G: 33; R: 10), - (B: 39; G: 20; R: 8), (B: 26; G: 15; R: 9), (B: 252; G: 203; R: 179), - (B: 245; G: 189; R: 158), (B: 222; G: 167; R: 133), (B: 196; G: 147; R: 111), - (B: 186; G: 134; R: 91), (B: 174; G: 125; R: 81), (B: 161; G: 118; R: 78), - (B: 147; G: 110; R: 72), (B: 136; G: 102; R: 65), (B: 122; G: 93; R: 59), - (B: 110; G: 85; R: 55), (B: 98; G: 79; R: 53), (B: 85; G: 69; R: 46), - (B: 66; G: 54; R: 37), (B: 46; G: 40; R: 29), (B: 27; G: 25; R: 20), - (B: 228; G: 133; R: 133), (B: 225; G: 96; R: 94), (B: 222; G: 58; R: 55), - (B: 219; G: 21; R: 16), (B: 202; G: 20; R: 15), (B: 185; G: 18; R: 14), - (B: 167; G: 17; R: 13), (B: 150; G: 16; R: 12), (B: 133; G: 14; R: 11), - (B: 116; G: 13; R: 11), (B: 98; G: 12; R: 10), (B: 81; G: 10; R: 9), - (B: 64; G: 9; R: 8), (B: 47; G: 8; R: 7), (B: 29; G: 6; R: 6), - (B: 12; G: 5; R: 5), (B: 255; G: 255; R: 255), (B: 240; G: 240; R: 240), - (B: 220; G: 220; R: 220), (B: 201; G: 201; R: 201), (B: 181; G: 181; R: 181), - (B: 162; G: 162; R: 162), (B: 148; G: 148; R: 148), (B: 135; G: 135; R: 135), - (B: 121; G: 121; R: 121), (B: 108; G: 108; R: 108), (B: 90; G: 90; R: 90), - (B: 74; G: 74; R: 74), (B: 58; G: 58; R: 58), (B: 42; G: 42; R: 42), - (B: 22; G: 22; R: 22), (B: 8; G: 8; R: 8), (B: 104; G: 150; R: 233), - (B: 93; G: 125; R: 242), (B: 82; G: 98; R: 249), (B: 72; G: 72; R: 255), - (B: 48; G: 48; R: 255), (B: 25; G: 25; R: 254), (B: 7; G: 7; R: 246), - (B: 7; G: 7; R: 220), (B: 6; G: 6; R: 194), (B: 6; G: 6; R: 169), - (B: 5; G: 5; R: 143), (B: 5; G: 5; R: 117), (B: 4; G: 4; R: 91), - (B: 4; G: 4; R: 66), (B: 3; G: 3; R: 40), (B: 3; G: 3; R: 14), - (B: 191; G: 88; R: 117), (B: 180; G: 63; R: 97), (B: 169; G: 38; R: 78), - (B: 159; G: 14; R: 56), (B: 147; G: 13; R: 52), (B: 135; G: 12; R: 48), - (B: 123; G: 12; R: 44), (B: 111; G: 11; R: 40), (B: 99; G: 10; R: 36), - (B: 87; G: 9; R: 32), (B: 75; G: 8; R: 27), (B: 63; G: 7; R: 23), - (B: 51; G: 7; R: 19), (B: 39; G: 6; R: 15), (B: 27; G: 5; R: 11), - (B: 15; G: 4; R: 7), (B: 135; G: 224; R: 255), (B: 91; G: 213; R: 255), - (B: 46; G: 197; R: 255), (B: 2; G: 184; R: 255), (B: 2; G: 170; R: 235), - (B: 2; G: 156; R: 215), (B: 2; G: 141; R: 195), (B: 2; G: 127; R: 175), - (B: 2; G: 113; R: 155), (B: 3; G: 99; R: 136), (B: 3; G: 84; R: 116), - (B: 3; G: 70; R: 96), (B: 3; G: 56; R: 76), (B: 3; G: 42; R: 56), - (B: 3; G: 27; R: 36), (B: 3; G: 13; R: 16), (B: 254; G: 255; R: 199), - (B: 254; G: 235; R: 170), (B: 255; G: 215; R: 141), (B: 255; G: 205; R: 127), - (B: 255; G: 195; R: 112), (B: 255; G: 175; R: 83), (B: 234; G: 155; R: 50), - (B: 219; G: 131; R: 43), (B: 205; G: 107; R: 35), (B: 190; G: 84; R: 27), - (B: 176; G: 60; R: 19), (B: 155; G: 24; R: 10), (B: 130; G: 21; R: 9), - (B: 105; G: 19; R: 8), (B: 80; G: 16; R: 7), (B: 55; G: 13; R: 6), - (B: 197; G: 215; R: 255), (B: 181; G: 196; R: 233), (B: 165; G: 177; R: 212), - (B: 149; G: 158; R: 190), (B: 138; G: 146; R: 176), (B: 126; G: 134; R: 162), - (B: 115; G: 122; R: 147), (B: 103; G: 110; R: 133), (B: 92; G: 98; R: 119), - (B: 81; G: 87; R: 105), (B: 69; G: 75; R: 90), (B: 58; G: 63; R: 76), - (B: 46; G: 51; R: 62), (B: 35; G: 39; R: 48), (B: 23; G: 27; R: 33), - (B: 12; G: 15; R: 19)); - - { This is default Arena's palette (Arena\pal.col).} - ArenaPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 0; G: 0; R: 170), (B: 0; G: 170; R: 0), - (B: 0; G: 170; R: 170), (B: 170; G: 0; R: 0), (B: 170; G: 0; R: 170), - (B: 170; G: 85; R: 0), (B: 170; G: 170; R: 170), (B: 85; G: 85; R: 85), - (B: 85; G: 85; R: 255), (B: 85; G: 255; R: 85), (B: 85; G: 255; R: 255), - (B: 255; G: 85; R: 85), (B: 255; G: 85; R: 255), (B: 255; G: 255; R: 85), - (B: 255; G: 255; R: 255), (B: 212; G: 232; R: 248), (B: 193; G: 211; R: 227), - (B: 174; G: 190; R: 205), (B: 155; G: 169; R: 184), (B: 136; G: 148; R: 163), - (B: 118; G: 128; R: 142), (B: 99; G: 107; R: 120), (B: 80; G: 86; R: 99), - (B: 61; G: 65; R: 78), (B: 42; G: 44; R: 56), (B: 0; G: 180; R: 0), - (B: 0; G: 160; R: 0), (B: 0; G: 144; R: 0), (B: 144; G: 184; R: 0), - (B: 124; G: 160; R: 0), (B: 108; G: 140; R: 0), (B: 175; G: 175; R: 187), - (B: 160; G: 160; R: 172), (B: 145; G: 145; R: 157), (B: 129; G: 129; R: 141), - (B: 114; G: 114; R: 126), (B: 99; G: 99; R: 111), (B: 84; G: 84; R: 96), - (B: 69; G: 69; R: 81), (B: 53; G: 53; R: 65), (B: 38; G: 38; R: 50), - (B: 139; G: 127; R: 127), (B: 127; G: 117; R: 118), (B: 116; G: 106; R: 109), - (B: 104; G: 96; R: 99), (B: 93; G: 85; R: 90), (B: 81; G: 75; R: 81), - (B: 69; G: 65; R: 72), (B: 58; G: 54; R: 63), (B: 46; G: 44; R: 53), - (B: 35; G: 33; R: 44), (B: 127; G: 127; R: 139), (B: 117; G: 117; R: 129), - (B: 106; G: 106; R: 118), (B: 96; G: 96; R: 108), (B: 85; G: 85; R: 97), - (B: 75; G: 75; R: 87), (B: 65; G: 65; R: 77), (B: 54; G: 54; R: 66), - (B: 44; G: 44; R: 56), (B: 33; G: 33; R: 45), (B: 0; G: 0; R: 203), - (B: 0; G: 0; R: 175), (B: 30; G: 97; R: 134), (B: 29; G: 90; R: 124), - (B: 29; G: 82; R: 114), (B: 28; G: 75; R: 104), (B: 27; G: 67; R: 94), - (B: 27; G: 60; R: 85), (B: 26; G: 53; R: 75), (B: 25; G: 45; R: 65), - (B: 24; G: 38; R: 55), (B: 24; G: 30; R: 45), (B: 0; G: 127; R: 127), - (B: 2; G: 117; R: 118), (B: 5; G: 106; R: 109), (B: 7; G: 96; R: 99), - (B: 9; G: 85; R: 90), (B: 12; G: 75; R: 81), (B: 14; G: 65; R: 72), - (B: 16; G: 54; R: 63), (B: 18; G: 44; R: 53), (B: 21; G: 33; R: 44), - (B: 75; G: 92; R: 95), (B: 70; G: 85; R: 89), (B: 65; G: 78; R: 83), - (B: 59; G: 71; R: 77), (B: 54; G: 64; R: 71), (B: 49; G: 58; R: 65), - (B: 44; G: 51; R: 59), (B: 39; G: 44; R: 53), (B: 33; G: 37; R: 47), - (B: 28; G: 30; R: 41), (B: 187; G: 39; R: 239), (B: 195; G: 0; R: 199), - (B: 231; G: 215; R: 0), (B: 255; G: 167; R: 0), (B: 223; G: 119; R: 0), - (B: 231; G: 83; R: 0), (B: 139; G: 139; R: 150), (B: 111; G: 111; R: 123), - (B: 95; G: 95; R: 107), (B: 79; G: 79; R: 91), (B: 63; G: 63; R: 75), - (B: 51; G: 51; R: 59), (B: 43; G: 43; R: 51), (B: 39; G: 39; R: 47), - (B: 31; G: 31; R: 43), (B: 27; G: 27; R: 39), (B: 23; G: 23; R: 35), - (B: 19; G: 19; R: 31), (B: 15; G: 15; R: 27), (B: 255; G: 255; R: 255), - (B: 255; G: 255; R: 255), (B: 30; G: 9; R: 1), (B: 112; G: 112; R: 112), - (B: 103; G: 103; R: 104), (B: 94; G: 94; R: 97), (B: 85; G: 85; R: 89), - (B: 76; G: 76; R: 81), (B: 68; G: 68; R: 74), (B: 59; G: 59; R: 66), - (B: 50; G: 50; R: 58), (B: 41; G: 41; R: 50), (B: 32; G: 32; R: 43), - (B: 2; G: 221; R: 221), (B: 0; G: 175; R: 175), (B: 155; G: 51; R: 51), - (B: 142; G: 48; R: 49), (B: 129; G: 45; R: 48), (B: 115; G: 43; R: 46), - (B: 102; G: 40; R: 45), (B: 89; G: 37; R: 43), (B: 76; G: 34; R: 41), - (B: 63; G: 31; R: 40), (B: 49; G: 29; R: 38), (B: 36; G: 26; R: 37), - (B: 127; G: 0; R: 0), (B: 117; G: 2; R: 4), (B: 106; G: 5; R: 7), - (B: 96; G: 7; R: 11), (B: 85; G: 9; R: 14), (B: 75; G: 12; R: 18), - (B: 65; G: 14; R: 21), (B: 54; G: 16; R: 25), (B: 44; G: 18; R: 28), - (B: 33; G: 21; R: 32), (B: 78; G: 61; R: 48), (B: 73; G: 57; R: 47), - (B: 67; G: 53; R: 45), (B: 62; G: 50; R: 44), (B: 56; G: 46; R: 43), - (B: 51; G: 42; R: 42), (B: 45; G: 38; R: 40), (B: 40; G: 34; R: 39), - (B: 34; G: 31; R: 38), (B: 29; G: 27; R: 36), (B: 225; G: 2; R: 2), - (B: 195; G: 0; R: 0), (B: 0; G: 127; R: 0), (B: 2; G: 117; R: 4), - (B: 5; G: 106; R: 7), (B: 7; G: 96; R: 11), (B: 9; G: 85; R: 14), - (B: 12; G: 75; R: 18), (B: 14; G: 65; R: 21), (B: 16; G: 54; R: 25), - (B: 18; G: 44; R: 28), (B: 21; G: 33; R: 32), (B: 55; G: 63; R: 39), - (B: 52; G: 59; R: 39), (B: 49; G: 55; R: 38), (B: 45; G: 51; R: 38), - (B: 42; G: 47; R: 37), (B: 39; G: 43; R: 37), (B: 36; G: 39; R: 37), - (B: 33; G: 35; R: 36), (B: 29; G: 31; R: 36), (B: 26; G: 27; R: 35), - (B: 158; G: 176; R: 195), (B: 145; G: 161; R: 179), (B: 131; G: 145; R: 163), - (B: 118; G: 130; R: 147), (B: 104; G: 115; R: 131), (B: 91; G: 100; R: 115), - (B: 77; G: 84; R: 99), (B: 64; G: 69; R: 83), (B: 50; G: 54; R: 67), - (B: 37; G: 38; R: 51), (B: 56; G: 25; R: 25), (B: 36; G: 20; R: 26), - (B: 215; G: 159; R: 7), (B: 196; G: 145; R: 10), (B: 177; G: 132; R: 13), - (B: 157; G: 118; R: 15), (B: 138; G: 105; R: 18), (B: 119; G: 91; R: 21), - (B: 100; G: 77; R: 24), (B: 81; G: 64; R: 27), (B: 61; G: 50; R: 29), - (B: 42; G: 37; R: 32), (B: 139; G: 115; R: 0), (B: 127; G: 106; R: 4), - (B: 116; G: 97; R: 7), (B: 104; G: 87; R: 11), (B: 93; G: 78; R: 14), - (B: 81; G: 69; R: 18), (B: 69; G: 60; R: 21), (B: 58; G: 51; R: 25), - (B: 46; G: 41; R: 28), (B: 35; G: 32; R: 32), (B: 151; G: 99; R: 0), - (B: 138; G: 91; R: 4), (B: 125; G: 84; R: 7), (B: 113; G: 76; R: 11), - (B: 100; G: 69; R: 14), (B: 87; G: 61; R: 18), (B: 74; G: 53; R: 21), - (B: 61; G: 46; R: 25), (B: 49; G: 38; R: 28), (B: 36; G: 31; R: 32), - (B: 254; G: 170; R: 0), (B: 255; G: 184; R: 0), (B: 211; G: 203; R: 179), - (B: 208; G: 195; R: 167), (B: 205; G: 186; R: 155), (B: 212; G: 178; R: 143), - (B: 200; G: 163; R: 131), (B: 187; G: 148; R: 119), (B: 183; G: 133; R: 107), - (B: 170; G: 118; R: 95), (B: 156; G: 104; R: 84), (B: 143; G: 89; R: 72), - (B: 126; G: 74; R: 60), (B: 103; G: 59; R: 48), (B: 90; G: 45; R: 36), - (B: 77; G: 30; R: 24), (B: 64; G: 15; R: 12), (B: 41; G: 0; R: 0), - (B: 212; G: 120; R: 8), (B: 209; G: 111; R: 9), (B: 206; G: 102; R: 10), - (B: 204; G: 92; R: 10), (B: 201; G: 83; R: 11), (B: 198; G: 74; R: 12), - (B: 195; G: 65; R: 13), (B: 192; G: 56; R: 14), (B: 190; G: 46; R: 14), - (B: 187; G: 37; R: 15), (B: 184; G: 28; R: 16), (B: 0; G: 0; R: 60), - (B: 251; G: 239; R: 79), (B: 191; G: 115; R: 0), (B: 197; G: 197; R: 197), - (B: 52; G: 52; R: 52)); - - { This is default Terminator Future Shock's palette (Shock\Gamedata\Shock.col).} - FutureShockPalette: TPalette24Size256 = ( - (B: 0; G: 0; R: 0), (B: 255; G: 255; R: 255), (B: 255; G: 255; R: 211), - (B: 255; G: 255; R: 177), (B: 255; G: 255; R: 127), (B: 255; G: 255; R: 97), - (B: 255; G: 210; R: 67), (B: 255; G: 166; R: 55), (B: 255; G: 0; R: 0), - (B: 255; G: 131; R: 0), (B: 0; G: 255; R: 0), (B: 71; G: 71; R: 255), - (B: 255; G: 255; R: 0), (B: 254; G: 137; R: 46), (B: 216; G: 111; R: 37), - (B: 177; G: 88; R: 29), (B: 51; G: 55; R: 55), (B: 55; G: 51; R: 55), - (B: 51; G: 51; R: 53), (B: 51; G: 51; R: 54), (B: 59; G: 51; R: 63), - (B: 59; G: 51; R: 54), (B: 51; G: 55; R: 57), (B: 51; G: 51; R: 51), - (B: 239; G: 51; R: 239), (B: 239; G: 51; R: 239), (B: 239; G: 51; R: 239), - (B: 239; G: 51; R: 239), (B: 64; G: 41; R: 38), (B: 49; G: 33; R: 32), - (B: 33; G: 26; R: 27), (B: 18; G: 18; R: 21), (B: 191; G: 239; R: 211), - (B: 179; G: 223; R: 195), (B: 163; G: 207; R: 179), (B: 147; G: 191; R: 159), - (B: 131; G: 175; R: 143), (B: 115; G: 155; R: 127), (B: 103; G: 139; R: 111), - (B: 91; G: 131; R: 103), (B: 83; G: 119; R: 91), (B: 75; G: 107; R: 83), - (B: 67; G: 95; R: 71), (B: 63; G: 87; R: 67), (B: 59; G: 79; R: 63), - (B: 55; G: 71; R: 59), (B: 55; G: 63; R: 55), (B: 51; G: 55; R: 51), - (B: 227; G: 203; R: 203), (B: 211; G: 187; R: 187), (B: 191; G: 175; R: 171), - (B: 175; G: 159; R: 159), (B: 159; G: 143; R: 143), (B: 143; G: 127; R: 127), - (B: 127; G: 111; R: 111), (B: 115; G: 99; R: 99), (B: 103; G: 91; R: 91), - (B: 91; G: 83; R: 83), (B: 83; G: 71; R: 71), (B: 75; G: 67; R: 67), - (B: 71; G: 63; R: 63), (B: 67; G: 59; R: 59), (B: 63; G: 55; R: 55), - (B: 59; G: 51; R: 51), (B: 179; G: 235; R: 247), (B: 163; G: 219; R: 231), - (B: 147; G: 203; R: 219), (B: 131; G: 187; R: 203), (B: 115; G: 171; R: 191), - (B: 99; G: 155; R: 175), (B: 83; G: 139; R: 163), (B: 75; G: 127; R: 151), - (B: 67; G: 115; R: 139), (B: 59; G: 103; R: 123), (B: 51; G: 91; R: 111), - (B: 51; G: 83; R: 99), (B: 51; G: 79; R: 91), (B: 51; G: 71; R: 79), - (B: 51; G: 63; R: 67), (B: 51; G: 55; R: 55), (B: 207; G: 207; R: 215), - (B: 191; G: 191; R: 199), (B: 175; G: 179; R: 187), (B: 163; G: 163; R: 171), - (B: 147; G: 151; R: 155), (B: 131; G: 135; R: 143), (B: 119; G: 119; R: 127), - (B: 107; G: 111; R: 115), (B: 99; G: 103; R: 107), (B: 87; G: 91; R: 95), - (B: 79; G: 83; R: 83), (B: 71; G: 75; R: 79), (B: 67; G: 71; R: 71), - (B: 63; G: 63; R: 67), (B: 55; G: 59; R: 59), (B: 51; G: 55; R: 55), - (B: 231; G: 211; R: 171), (B: 215; G: 195; R: 155), (B: 199; G: 179; R: 143), - (B: 187; G: 159; R: 127), (B: 171; G: 143; R: 111), (B: 155; G: 127; R: 95), - (B: 139; G: 107; R: 83), (B: 131; G: 99; R: 75), (B: 119; G: 87; R: 67), - (B: 107; G: 75; R: 59), (B: 95; G: 67; R: 51), (B: 87; G: 63; R: 51), - (B: 79; G: 59; R: 51), (B: 71; G: 59; R: 51), (B: 63; G: 55; R: 51), - (B: 55; G: 51; R: 51), (B: 140; G: 47; R: 47), (B: 179; G: 54; R: 54), - (B: 255; G: 99; R: 0), (B: 255; G: 191; R: 0), (B: 151; G: 78; R: 26), - (B: 112; G: 70; R: 41), (B: 94; G: 57; R: 53), (B: 64; G: 41; R: 38), - (B: 47; G: 47; R: 52), (B: 43; G: 43; R: 49), (B: 38; G: 38; R: 44), - (B: 35; G: 35; R: 40), (B: 31; G: 31; R: 36), (B: 27; G: 27; R: 30), - (B: 22; G: 22; R: 27), (B: 18; G: 18; R: 21), (B: 175; G: 219; R: 219), - (B: 131; G: 231; R: 231), (B: 95; G: 231; R: 231), (B: 51; G: 239; R: 239), - (B: 51; G: 235; R: 235), (B: 51; G: 219; R: 219), (B: 51; G: 199; R: 199), - (B: 51; G: 175; R: 179), (B: 51; G: 159; R: 163), (B: 51; G: 139; R: 143), - (B: 51; G: 119; R: 123), (B: 51; G: 99; R: 107), (B: 51; G: 87; R: 91), - (B: 51; G: 71; R: 79), (B: 51; G: 55; R: 63), (B: 51; G: 51; R: 51), - (B: 219; G: 219; R: 175), (B: 231; G: 231; R: 131), (B: 231; G: 231; R: 95), - (B: 239; G: 239; R: 51), (B: 235; G: 235; R: 51), (B: 219; G: 219; R: 51), - (B: 199; G: 199; R: 51), (B: 179; G: 175; R: 51), (B: 163; G: 159; R: 51), - (B: 143; G: 139; R: 51), (B: 123; G: 119; R: 51), (B: 107; G: 99; R: 51), - (B: 91; G: 87; R: 51), (B: 79; G: 71; R: 51), (B: 63; G: 55; R: 51), - (B: 51; G: 51; R: 51), (B: 219; G: 175; R: 219), (B: 231; G: 131; R: 231), - (B: 231; G: 95; R: 231), (B: 239; G: 51; R: 239), (B: 235; G: 51; R: 235), - (B: 219; G: 51; R: 219), (B: 199; G: 51; R: 199), (B: 179; G: 51; R: 179), - (B: 163; G: 51; R: 159), (B: 143; G: 51; R: 139), (B: 123; G: 51; R: 119), - (B: 107; G: 51; R: 99), (B: 91; G: 51; R: 87), (B: 79; G: 51; R: 71), - (B: 63; G: 51; R: 55), (B: 51; G: 51; R: 51), (B: 175; G: 219; R: 175), - (B: 131; G: 231; R: 131), (B: 99; G: 231; R: 99), (B: 55; G: 235; R: 55), - (B: 55; G: 231; R: 55), (B: 55; G: 211; R: 55), (B: 63; G: 187; R: 63), - (B: 71; G: 159; R: 71), (B: 67; G: 143; R: 67), (B: 67; G: 127; R: 67), - (B: 63; G: 111; R: 63), (B: 59; G: 99; R: 59), (B: 59; G: 83; R: 59), - (B: 55; G: 71; R: 55), (B: 55; G: 59; R: 55), (B: 51; G: 55; R: 51), - (B: 143; G: 143; R: 223), (B: 123; G: 123; R: 235), (B: 95; G: 95; R: 243), - (B: 59; G: 59; R: 255), (B: 55; G: 55; R: 235), (B: 59; G: 59; R: 211), - (B: 63; G: 63; R: 191), (B: 67; G: 67; R: 167), (B: 63; G: 63; R: 151), - (B: 63; G: 63; R: 131), (B: 59; G: 59; R: 119), (B: 55; G: 55; R: 103), - (B: 55; G: 55; R: 91), (B: 55; G: 55; R: 75), (B: 51; G: 51; R: 63), - (B: 51; G: 51; R: 55), (B: 219; G: 131; R: 131), (B: 235; G: 111; R: 111), - (B: 239; G: 95; R: 95), (B: 243; G: 67; R: 67), (B: 235; G: 51; R: 51), - (B: 215; G: 51; R: 51), (B: 199; G: 55; R: 55), (B: 179; G: 51; R: 51), - (B: 163; G: 51; R: 51), (B: 143; G: 51; R: 51), (B: 123; G: 51; R: 51), - (B: 107; G: 51; R: 51), (B: 91; G: 51; R: 51), (B: 79; G: 51; R: 51), - (B: 63; G: 51; R: 51), (B: 51; G: 51; R: 51), (B: 203; G: 187; R: 227), - (B: 191; G: 175; R: 211), (B: 175; G: 163; R: 195), (B: 159; G: 147; R: 179), - (B: 147; G: 135; R: 167), (B: 131; G: 123; R: 151), (B: 119; G: 107; R: 135), - (B: 107; G: 99; R: 123), (B: 99; G: 91; R: 111), (B: 91; G: 83; R: 103), - (B: 79; G: 71; R: 91), (B: 75; G: 67; R: 83), (B: 71; G: 63; R: 79), - (B: 67; G: 59; R: 71), (B: 63; G: 55; R: 67), (B: 59; G: 51; R: 63), - (B: 183; G: 219; R: 227), (B: 167; G: 203; R: 211), (B: 151; G: 187; R: 191), - (B: 135; G: 167; R: 175), (B: 119; G: 151; R: 155), (B: 99; G: 135; R: 139), - (B: 83; G: 119; R: 119), (B: 75; G: 107; R: 111), (B: 67; G: 95; R: 99), - (B: 67; G: 91; R: 91), (B: 63; G: 83; R: 83), (B: 59; G: 75; R: 79), - (B: 59; G: 71; R: 71), (B: 55; G: 63; R: 63), (B: 51; G: 59; R: 59), - (B: 49; G: 51; R: 51)); - -implementation - -uses - Types, - SysUtils, - Classes, - ImagingIO, - ImagingUtility, - ElderImageryBsi, - ElderImageryCif, - ElderImageryImg, - ElderImageryTexture, - ElderImagerySky; - -{ TDaggerfallFileFormat class implementation } - -procedure TElderFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FSupportedFormats := []; - - GetMem(FARGBPalette, Length(FPalette) * SizeOf(TColor32Rec)); - SetPalette(DaggerfallPalette); -end; - -destructor TElderFileFormat.Destroy; -begin - FreeMem(FARGBPalette); - inherited Destroy; -end; - -procedure TElderFileFormat.DagRLEDecode(InData: Pointer; OutSize: LongInt; - out OutData: Pointer); -var - I, Pos, CByte: LongInt; - Rle, B: Byte; -begin - Pos := 0; - CByte := 0; - while Pos < OutSize do - begin - Rle := PByteArray(InData)[CByte]; - CByte := CByte + 1; - if Rle < 128 then - begin - Rle := Rle + 1; - Move(PByteArray(InData)[CByte], PByteArray(OutData)[Pos], Rle); - CByte := CByte + Rle; - Pos := Pos + Rle; - end - else - begin - Rle := Rle - 127; - B := PByteArray(InData)[CByte];; - CByte := CByte + 1; - for I := 0 to Rle - 1 do - begin - PByteArray(OutData)[Pos] := B; - Pos := Pos + 1; - end; - end; - end; -end; - -function TElderFileFormat.FindNoHeaderInfo(Size: LongInt; - Infos: array of TNoHeaderFileInfo): LongInt; -var - I: LongInt; -begin - for I := Low(Infos) to High(Infos) do - begin - if Size = Infos[I].Size then - begin - Result := I; - Exit; - end; - end; - Result := -1; -end; - -function TElderFileFormat.TestNoHeaderFormat(Handle: TImagingHandle): TElderFileFormatClass; -var - InputSize, I: LongInt; -begin - Result := nil; - if Handle <> nil then - begin - InputSize := GetInputSize(GetIO, Handle); - // Check special IMG files - I := FindNoHeaderInfo(InputSize, NoHeaderIMGInfos); - if I >= 0 then - begin - Result := TIMGFileFormat; - Exit; - end; - // Check special CIF files - I := FindNoHeaderInfo(InputSize, NoHeaderCIFInfos); - if I >= 0 then - begin - Result := TCIFFileFormat; - Exit; - end; - end; -end; - -procedure TElderFileFormat.ConvertPalette(const ElderPal: TPalette24Size256; - ARGBPal: PPalette32); -var - I: LongInt; -begin - for I := Low(ElderPal) to High(ElderPal) do - begin - ARGBPal[I].A := $FF; - ARGBPal[I].R := ElderPal[I].B; - ARGBPal[I].G := ElderPal[I].G; - ARGBPal[I].B := ElderPal[I].R; - end; - // Palette index 0 represents transparent color - ARGBPal[0].A := 0; -end; - -procedure TElderFileFormat.SetPalette(const Value: TPalette24Size256); -begin - FPalette := Value; - ConvertPalette(FPalette, FARGBPalette); -end; - -procedure TElderFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - R: TRect; -begin - if CanSave then - begin - if Image.Width * Image.Height > 65535 then - begin - // Regular CIF and IMG files can only store images no larger than 65535 bytes - if Image.Width > Image.Height then - R := Rect(0, 0, 320, 200) - else - R := Rect(0, 0, 200, 320); - R := ScaleRectToRect(Rect(0, 0, Image.Width, Image.Height), R); - ResizeImage(Image, R.Right - R.Left, R.Bottom - R.Top, rfBilinear); - end; - // Map image to current palette - MapImageToPalette(Image, FARGBPalette, Length(FPalette)); - end; -end; - -function TElderFileFormat.IsSupported(const Image: TImageData): Boolean; -begin - // Image is supported for saving if its indexed and is mapped to current palette - Result := (Image.Format = ifIndex8) and - CompareMem(Image.Palette, FARGBPalette, Length(FPalette) * SizeOf(TColor32Rec)); -end; - -function TElderFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TImgHeader; - DagClass: TElderFileFormatClass; - ReadCount: LongInt; -begin - // TestFormat for both IMG and CIF formats - Result := False; - DagClass := TestNoHeaderFormat(Handle); - if (DagClass = nil) and (Handle <> nil) then - begin - // Check ordinary IMG/CIF files with header - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount > 0) and (Hdr.ImageSize <= Hdr.Width * Hdr.Height) and - (Hdr.Width * Hdr.Height <= High(Word)) and (Hdr.ImageSize <> 0) and - (Hdr.Width <> 0) and (Hdr.Height <> 0); - if IsMultiImageFormat then - Result := Result and (GetInputSize(GetIO, Handle) > Hdr.ImageSize + SizeOf(Hdr)) - else - Result := Result and (GetInputSize(GetIO, Handle) = Hdr.ImageSize + SizeOf(Hdr)); - end - else if DagClass = Self.ClassType then - Result := True; -end; - -initialization - RegisterImageFileFormat(TBSIFileFormat); - RegisterImageFileFormat(TCIFFileFormat); - RegisterImageFileFormat(TIMGFileFormat); - RegisterImageFileFormat(TTextureFileFormat); - RegisterImageFileFormat(TSKYFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Fixed TestFormat which could identify something (eof) as image. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Too large images that are to be saved in CIF/IMG formats are - automatically rescaled in ConvertToSupported method. - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Added default palettes for more games. - - Added transparency to Daggerfall palettes. - - Initial version created based on my older code. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ElderImageryBsi.pas b/3rd/Imaging/Extras/Extensions/ElderImageryBsi.pas deleted file mode 100644 index 3f15609ef..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImageryBsi.pas +++ /dev/null @@ -1,409 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for textures and images - from Redguard and BattleSpire.} -unit ElderImageryBsi; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ElderImagery, ImagingUtility; - -type - { Class for loading of BSI format textures and images found - in Redguard and BattleSpire (maybe in other games too, Skynet?). This format - uses chunk structure similar to PNG (HDR/DAT/END). Redguard stores - multiple images in one file (usually related like textures for various - parts of single 3d object). Image data is stored as 8bit. Each image - can have its own embedded palette or it can use external default palette. - BattleSpire BSI use *.bsi file extension whilst Redguard uses - texbsi.* mask with number extension (just like Daggerfall). - Only loading is supported for this format. - BattleSpire images also contain some sort of 8bit->16bit color mapping data - which I've not yet figured out (only blue channel known).} - TBSIFileFormat = class(TElderFileFormat) - private - function IsMultiBSI(Handle: TImagingHandle): Boolean; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SBSIFormatName = 'Bethesda Image'; - SBSIMasks = '*.bsi,texbsi.*'; - -resourcestring - SErrorLoadingChunk = 'Error when reading %s chunk data.'; - -type - { BSI chunk header.} - TChunk = packed record - ChunkID: TChar4; - DataSize: LongWord; // In Big Endian! - end; - - { Additional header of BSI textures.} - TTextureBSIHeader = packed record - Name: array[0..8] of AnsiChar; - ImageSize: LongInt; - end; - - { Main image info header located in BHDR chunk's data.} - TBHDRChunk = packed record - OffsetX: Word; - OffsetY: Word; - Width: SmallInt; - Height: SmallInt; - Unk1, Unk2: Byte; - Unk3, Unk4: Word; - Frames: Word; - Unk6, Unk7, Unk8: Word; - Unk9, Unk10: Byte; - Unk11: Word; - end; - -const - IFHDSignature: TChar4 = 'IFHD'; - BSIFSignature: TChar4 = 'BSIF'; - BHDRSignature: TChar4 = 'BHDR'; - CMAPSignature: TChar4 = 'CMAP'; - HICLSignature: TChar4 = 'HICL'; - HTBLSignature: TChar4 = 'HTBL'; - DATASignature: TChar4 = 'DATA'; - ENDSignature: TChar4 = 'END '; - - -{ TBSIFileFormat class implementation } - -procedure TBSIFileFormat.Define; -begin - inherited; - FName := SBSIFormatName; - FFeatures := [ffLoad, ffMultiImage]; - - AddMasks(SBSIMasks); - SetPalette(RedguardPalette); -end; - -function TBSIFileFormat.IsMultiBSI(Handle: TImagingHandle): Boolean; -var - ReadCount, StartPos: LongInt; - Sig: TChar4; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - StartPos := Tell(Handle); - // Redguard textures have 13 byte tex header and then IFHD or BSIF - Seek(Handle, SizeOf(TTextureBSIHeader), smFromCurrent); - ReadCount := Read(Handle, @Sig, SizeOf(Sig)); - Seek(Handle, StartPos, smFromBeginning); - Result := Result or ((ReadCount = SizeOf(Sig)) and - ((Sig = IFHDSignature) or (Sig = BSIFSignature))); - end; -end; - -function TBSIFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Chunk: TChunk; - ChunkData: Pointer; - DATASize: LongInt; - BHDR: TBHDRChunk; - PalLoaded: TPalette24Size256; - HICL: PByteArray; - HTBL: PWordArray; - IsMulti: Boolean; - TextureHdr: TTextureBSIHeader; - PaletteFound: Boolean; - - procedure ReadChunk; - begin - GetIO.Read(Handle, @Chunk, SizeOf(Chunk)); - Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize); - end; - - procedure ReadChunkData; - var - ReadBytes: LongWord; - begin - FreeMemNil(ChunkData); - GetMem(ChunkData, Chunk.DataSize); - ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize); - if ReadBytes <> Chunk.DataSize then - RaiseImaging(SErrorLoadingChunk, [Chunk.ChunkID]); - end; - - procedure SkipChunkData; - begin - GetIO.Seek(Handle, Chunk.DataSize, smFromCurrent); - end; - - procedure GetBHDR; - begin - ReadChunkData; - BHDR := TBHDRChunk(ChunkData^); - end; - - procedure GetHICL; - begin - ReadChunkData; - GetMem(HICL, Chunk.DataSize); - Move(ChunkData^, HICL[0], Chunk.DataSize); - end; - - procedure GetHTBL; - begin - ReadChunkData; - GetMem(HTBL, Chunk.DataSize); - Move(ChunkData^, HTBL[0], Chunk.DataSize); - end; - - procedure GetCMAP; - begin - ReadChunkData; - Move(ChunkData^, PalLoaded, Chunk.DataSize); - PaletteFound := True; - end; - - procedure GetDATA; - begin - ReadChunkData; - DATASize := Chunk.DataSize; - end; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - if not PaletteFound then - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)) - else - ConvertPalette(PalLoaded, Images[Result].Palette); - end; - - function AddImageHiColor(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifA8R8G8B8, Images[Result]); - end; - - procedure Reconstruct; - var - Index, I, J, K: LongInt; - RowOffsets: PLongIntArray; - Idx: Byte; - W: Word; - begin - if HICL = nil then - begin - if BHDR.Frames = 1 then - begin - // Load simple image - Index := AddImage(BHDR.Width, BHDR.Height); - Move(ChunkData^, Images[Index].Bits^, Images[Index].Size); - end - else - begin - // Load animated image: - // At the beggining of the chunk data there is BHDR.Height * BHDR.Frames - // 32bit offsets. Each BHDR.Height offsets point to rows of the current frame - RowOffsets := PLongIntArray(ChunkData); - - for I := 0 to BHDR.Frames - 1 do - begin - Index := AddImage(BHDR.Width, BHDR.Height); - with Images[Index] do - for J := 0 to BHDR.Height - 1 do - Move(PByteArray(ChunkData)[RowOffsets[I * BHDR.Height + J]], - PByteArray(Bits)[J * Width], Width); - end; - end; - end - else - begin - if BHDR.Frames = 1 then - begin - // Experimental BattleSpire 16bit image support! - Index := AddImageHiColor(BHDR.Width, BHDR.Height); - with Images[Index] do - for I := 0 to DATASize - 1 do - with PColor32RecArray(Bits)[I] do - begin - // It looks like "HICL[PByteArray(ChunkData)[I]] and 63" gives - // value of 6bit Blue channel, not other channels are sure yet. - // So now it looks grayscalish. - // You can also get interesting results using HTBL as look up table - // 8->16bit. There are 16 tables for shading (table 0 - darkest colors, - // table 15 - lightest) each with 256 16bit Words. But their data format - // is weird (555 is closest). There are some pixels that look - // as they should (proper color) but some does not. - // PWordArray(Bits)[I] := HTBL[256 * 15 + PByteArray(ChunkData)[I]] - Idx := PByteArray(ChunkData)[I]; - A := Iff(Idx <> 0, 255, 0); - R := MulDiv(HICL[Idx] and 63, 255, 63); - G := MulDiv(HICL[Idx] and 63, 255, 63); - B := MulDiv(HICL[Idx] and 63, 255, 63); - end; - end - else - begin - // Load animated BattleSpire image, uses offset list just like Redguard - // animated textures (but high word must be zeroed first to get valid offset) - RowOffsets := PLongIntArray(ChunkData); - - for I := 0 to BHDR.Frames - 1 do - begin - Index := AddImageHiColor(BHDR.Width, BHDR.Height); - with Images[Index] do - for J := 0 to BHDR.Height - 1 do - for K := 0 to BHDR.Width - 1 do - with PColor32RecArray(Bits)[J * BHDR.Width + K] do - begin - Idx := PByteArray(ChunkData)[RowOffsets[I * BHDR.Height + J] and $FFFF + K]; - W := HTBL[256 * 15 + Idx]; - A := Iff(Idx <> 0, 255, 0); - R := MulDiv(W shr 10 and 31, 255, 31); - G := MulDiv(W shr 5 and 31, 255, 31); - B := MulDiv(W and 31, 255, 31); - { A := Iff(Idx <> 0, 255, 0); - R := MulDiv(HICL[Idx] and 63, 255, 63); - G := MulDiv(HICL[Idx] and 63, 255, 63); - B := MulDiv(HICL[Idx] and 63, 255, 63);} - end; - end; - end; - end; - end; - - procedure ReadTextureHeader; - begin - FillChar(TextureHdr, SizeOf(TextureHdr), 0); - if IsMulti then - GetIO.Read(Handle, @TextureHdr, SizeOf(TextureHdr)) - else if Length(Images) = 0 then - // Ensure that while loop that reads chunks is executed for - // single-image files - TextureHdr.ImageSize := 1; - end; - -begin - ChunkData := nil; - HICL := nil; - HTBL := nil; - SetLength(Images, 0); - IsMulti := IsMultiBSI(Handle); - with GetIO do - begin - // Redguard textures can contain more than one image. Try to read texture - // header and if ImageSize is >0 there is another image. - ReadTextureHeader; - while TextureHdr.ImageSize > 0 do - try - PaletteFound := False; - ReadChunk; - SkipChunkData; - // Read data chunks. If they are recognized their data is stored for - // later image reconstruction - repeat - ReadChunk; - if Chunk.ChunkID = BHDRSignature then - GetBHDR - else if Chunk.ChunkID = HICLSignature then - GetHICL - else if Chunk.ChunkID = HTBLSignature then - GetHTBL - else if Chunk.ChunkID = CMAPSignature then - GetCMAP - else if Chunk.ChunkID = DATASignature then - GetDATA - else - SkipChunkData; - until Eof(Handle) or (Chunk.ChunkID = ENDSignature); - // Recontruct current image according to data read from chunks - Reconstruct; - // Read header for next image - ReadTextureHeader; - finally - FreeMemNil(ChunkData); - FreeMemNil(HICL); - FreeMemNil(HTBL); - end; - Result := True; - end; -end; - -function TBSIFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - Sig: TChar4; -begin - // First check if have multi-image BSI file (Redguard textures) - Result := IsMultiBSI(Handle); - if not Result and (Handle <> nil) then - with GetIO do - begin - // Check standard Bettlespire images with IFHD chunk at - // the beginning of the file - ReadCount := Read(Handle, @Sig, SizeOf(Sig)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Sig)) and (Sig = IFHDSignature); - end; -end; - - -{ - Changes/Bug Fixes: - - -- TODOS ---------------------------------------------------- - - crack the BattleSpire format completely - - -- 0.21 ----------------------------------------------------- - - Blue channel of BattleSpire images cracked but others arer still unknown. - - Added support for animated BattleSpire images. - - Added support for animated Redguard textures. - - Added support for Redguard textures (Battlespire images still don't figured out). - - Updated to current Imaging version. - - -- 0.13 ----------------------------------------------------- - - TBSIFileFormat class added - -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ElderImageryCif.pas b/3rd/Imaging/Extras/Extensions/ElderImageryCif.pas deleted file mode 100644 index 8bc42ec59..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImageryCif.pas +++ /dev/null @@ -1,289 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Daggerfall - multi-image fomat CIF.} -unit ElderImageryCif; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingIO, ElderImagery; - -type - { Class for loading and saving of multi-images in CIF format. It is - 8 bit indexed format found in Daggerfall. It is basically a sequence of - images in IMG (see TIMGFileFormat) stored in one file (with exception - of Weapo*.cif files which are little bit more complex). As with IMG files - CIF files can be RLE compressed and there are also special CIFs without header. - Total number of frames in file is known after the whole file was parsed - so exact file size must be known prior to loading.} - TCIFFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; - -const - { Info about special CIFs without header.} - NoHeaderCIFInfos: array[0..6] of TNoHeaderFileInfo = ( - (Size: 2601; Width: 17; Height: 17), // MPOP.RCI - (Size: 3168; Width: 44; Height: 9), // NOTE.RCI - (Size: 4356; Width: 22; Height: 22), // SPOP.RCI - (Size: 10752; Width: 32; Height: 16), // BUTTONS.RCI - (Size: 49152; Width: 64; Height: 64), // CHLD00I0.RCI - (Size: 249856; Width: 64; Height: 64), // FACES.CIF - (Size: 2060295; Width: 64; Height: 64)); // TFAC00I0.RCI - -implementation - -const - SCIFFormatName = 'Daggerfall MultiImage'; - SCIFMasks = '*.cif,*.rci'; - -resourcestring - SInvalidImageSize = 'Size of image in IMG/CIF format cannot exceed 65535 bytes. %s'; - -type - { Header for CIF group files.} - TCIFGroup = packed record - Width: Word; - Height: Word; - XOff: Word; - YOff: Word; - Unk: Word; - ImageSize: Word; // Size of Image data (but not always) - Offsets: array[0..31] of Word; // Offsets from beginning of header to - // image datas. Last offset points to next - // group header - end; - -{ TCIFFileFormat class implementation } - -procedure TCIFFileFormat.Define; -begin - inherited; - FName := SCIFFormatName; - AddMasks(SCIFMasks); -end; - -function TCIFFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TImgHeader; - Group: TCIFGroup; - Data: Pointer; - IsWeapon, ISW9, IsStandard, IsFirst: Boolean; - InputSize, I, FrameWidth, FrameHeight, OldPos, Index, BufferSize: LongInt; - HasHeader: Boolean; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - end; - -begin - SetLength(Images, 0); - with GetIO do - begin - InputSize := GetInputSize(GetIO, Handle); - HasHeader := True; - IsWeapon := False; - IsW9 := False; - IsFirst := True; - FrameWidth := 0; - FrameHeight := 0; - - // Check if this is one of special CIF with no header - I := FindNoHeaderInfo(InputSize, NoHeaderCIFInfos); - - if I >= 0 then - begin - // It is no-header CIF - FrameWidth := NoHeaderCIFInfos[I].Width; - FrameHeight := NoHeaderCIFInfos[I].Height; - HasHeader := False; - end; - - if HasHeader then - begin - OldPos := Tell(Handle); - // CIF has header so use its values - Read(Handle, @Hdr, SizeOf(Hdr)); - - if Hdr.Unk = $15 then - begin - // This file is weapon09.cif (shooting arrows) - IsWeapon := True; - IsW9 := True; - end; - - if Tell(Handle) + Hdr.ImageSize < InputSize then - begin - Seek(Handle, Hdr.ImageSize, smFromCurrent); - Read(Handle, @Group, SizeOf(Group)); - if Group.Offsets[0] = 76 then - // CIF is regular weapon file - IsWeapon := True; - end; - Seek(Handle, OldPos, smFromBeginning); - end; - - IsStandard := HasHeader and (not IsWeapon); - - while not Eof(Handle) do - begin - if IsStandard then - begin - // Handle CIFs in standard format with header - Read(Handle, @Hdr, SizeOf(Hdr)); - Index := AddImage(Hdr.Width, Hdr.Height); - if Hdr.Unk <> 2 then - begin - // Read uncompressed data - Read(Handle, Images[Index].Bits, Hdr.ImageSize); - end - else - begin - GetMem(Data, Hdr.ImageSize); - try - // Read RLE compressed data - Read(Handle, Data, Hdr.ImageSize); - DagRLEDecode(Data, Images[Index].Size, Images[Index].Bits); - finally - FreeMem(Data); - end; - end; - end - else if not HasHeader then - begin - // Handle CIFs in standard format without header - if Tell(Handle) + FrameWidth * FrameHeight <= InputSize then - begin - Index := AddImage(FrameWidth, FrameHeight); - Read(Handle, Images[Index].Bits, Images[Index].Size); - end - else - Break; - end - else if IsWeapon then - begin - // Handle CIFs with weapon animations - if IsFirst and (not IsW9) then - begin - // First frame is std IMG file, next ones are not - // but if IsW9 is true this first frame is missing - Read(Handle, @Hdr, SizeOf(Hdr)); - Index := AddImage(Hdr.Width, Hdr.Height); - Read(Handle, Images[Index].Bits, Images[Index].Size); - IsFirst := False; - end - else - begin - OldPos := Tell(Handle); - // Read next group - Read(Handle, @Group, SizeOf(Group)); - // Read images in group - I := 0; - while Group.Offsets[I] <> 0 do - begin - BufferSize := Group.Offsets[I + 1] - Group.Offsets[I]; - if BufferSize < 0 then - BufferSize := Group.Offsets[31] - Group.Offsets[I]; - - Seek(Handle, OldPos + Group.Offsets[I], smFromBeginning); - Index := AddImage(Group.Width, Group.Height); - // Read current image from current group and decode it - GetMem(Data, BufferSize); - try - Read(Handle, Data, BufferSize); - DagRLEDecode(Data, Images[Index].Size, Images[Index].Bits); - Inc(I); - finally - FreeMem(Data); - end; - end; - Seek(Handle, OldPos + Group.Offsets[31], smFromBeginning); - end; - end; - end; - Result := True; - end; -end; - -function TCIFFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Hdr: TImgHeader; - ImageToSave: TImageData; - MustBeFreed: Boolean; - I: LongInt; -begin - Result := False; - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - FillChar(Hdr, SizeOf(Hdr), 0); - Hdr.Width := Width; - Hdr.Height := Height; - // Hdr.ImageSize is Word so max size of image in bytes can be 65535 - if Width * Height > High(Word) then - RaiseImaging(SInvalidImageSize, [ImageToStr(ImageToSave)]); - Hdr.ImageSize := Width * Height; - Write(Handle, @Hdr, SizeOf(Hdr)); - Write(Handle, Bits, Hdr.ImageSize); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end - else - Exit; - end; - Result := True; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ElderImageryImg.pas b/3rd/Imaging/Extras/Extensions/ElderImageryImg.pas deleted file mode 100644 index 0106781d3..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImageryImg.pas +++ /dev/null @@ -1,226 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for IMG file format used - in Daggerfall and other old Bethesda games.} -unit ElderImageryImg; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingIO, ElderImagery; - -type - { Class for loading and saving of images in IMG format. It is - 8 bit indexed format found in Daggerfall, Arena, Terminator: FS, - and maybe other old Bethesda games. Files can be RLE compressed - and may contain palette although most images use external palettes. - Some files have no header at all so exact file size must be known - prior to loading (otherwise no-header files wont be recognized or whole - image could be identified as CIF as they use the same header).} - TIMGFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; - -const - { Info about special images without header.} - NoHeaderIMGInfos: array[0..18] of TNoHeaderFileInfo = ( - (Size: 64; Width: 8; Height: 8), // Arena file - (Size: 90; Width: 9; Height: 10), // Arena file - (Size: 128; Width: 8; Height: 16), // Arena file - (Size: 720; Width: 9; Height: 80), - (Size: 990; Width: 45; Height: 22), - (Size: 1720; Width: 43; Height: 40), - (Size: 2140; Width: 107; Height: 20), - (Size: 2916; Width: 81; Height: 36), - (Size: 3200; Width: 40; Height: 80), - (Size: 3938; Width: 179; Height: 22), - (Size: 4096; Width: 64; Height: 64), // Textures from TES: Arena - (Size: 4280; Width: 107; Height: 40), - (Size: 4508; Width: 322; Height: 14), - (Size: 20480; Width: 320; Height: 64), - (Size: 26496; Width: 184; Height: 144), - (Size: 64000; Width: 320; Height: 200), - (Size: 64768; Width: 320; Height: 200), // These contain palette - (Size: 68800; Width: 320; Height: 215), - (Size: 112128; Width: 512; Height: 219)); - -implementation - -const - SIMGFormatName = 'Daggerfall Image'; - SIMGMasks = '*.img'; - -resourcestring - SInvalidImageSize = 'Size of image in IMG format cannot exceed 65535 bytes. %s'; - -{ TIMGFileFormat class implementation } - -procedure TIMGFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave]; - FName := SIMGFormatName; - AddMasks(SIMGMasks); -end; - -function TIMGFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TImgHeader; - PalUsed: TPalette24Size256; - Data: Pointer; - IsRLE: Boolean; - InputSize, I: LongInt; - - procedure SetSize(W, H: LongInt); - begin - Images[0].Width := W; - Images[0].Height := H; - Images[0].Size := W * H; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - InputSize := GetInputSize(GetIO, Handle); - Format := ifIndex8; - IsRLE := False; - - // Check if this is one of special images with no header - I := FindNoHeaderInfo(InputSize, NoHeaderIMGInfos); - - if I >= 0 then - begin - // It is no-header image - NewImage(NoHeaderIMGInfos[I].Width, NoHeaderIMGInfos[I].Height, ifIndex8, Images[0]); - end - else - begin - // Image has header so use its values - Read(Handle, @Hdr, SizeOf(Hdr)); - NewImage(Hdr.Width, Hdr.Height, ifIndex8, Images[0]); - IsRLE := Hdr.Unk = 2; - end; - - if (Hdr.Unk = 260) or (Hdr.Unk = 264) then - begin - // Compressed data from Arena: - // compression algorithm is unknown to me now - // if Unk = 264 then after header is word size of original data - // if Unk = 260 no size after head - Exit; - end; - - if not IsRLE then - begin - // Read uncompressed data - GetMem(Bits, Size); - Read(Handle, Bits, Size); - end - else - begin - GetMem(Data, Hdr.ImageSize); - try - // Read compressed data - Read(Handle, Data, Hdr.ImageSize); - DagRLEDecode(Data, Size, Bits); - finally - FreeMem(Data); - end; - end; - - // Palette handling - GetMem(Palette, 256 * SizeOf(TColor32Rec)); - - if (InputSize = Tell(Handle) + 768) then - begin - // Some IMG files has embedded palette - Read(Handle, @PalUsed, 768); - for I := Low(PalUsed) to High(PalUsed) do - begin - Palette[I].A := $FF; - Palette[I].R := PalUsed[I].B; - Palette[I].G := PalUsed[I].G; - Palette[I].B := PalUsed[I].R; - end; - Palette[0].A := 0; - end - else - Move(FARGBPalette[0], Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - - Result := True; - end; -end; - -function TIMGFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Hdr: TImgHeader; - ImageToSave: TImageData; - MustBeFreed: Boolean; -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - FillChar(Hdr, SizeOf(Hdr), 0); - Hdr.Width := Width; - Hdr.Height := Height; - // Hdr.ImageSize is Word so max size of image in bytes can be 65535 - if Width * Height > High(Word) then - RaiseImaging(SInvalidImageSize, [ImageToStr(ImageToSave)]); - Hdr.ImageSize := Width * Height; - Write(Handle, @Hdr, SizeOf(Hdr)); - Write(Handle, Bits, Hdr.ImageSize); - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ElderImagerySky.pas b/3rd/Imaging/Extras/Extensions/ElderImagerySky.pas deleted file mode 100644 index fe68a02fa..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImagerySky.pas +++ /dev/null @@ -1,141 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for SKY file format used - in Daggerfall to store sky backdrops.} -unit ElderImagerySky; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ElderImagery; - -type - { Class for loading and saving of images in SKY format. It is - 8 bit indexed format found in Daggerfall, and maybe other old Bethesda - games. Files are named SKY##.DAT and each contains two sets of 32 images - (512 by 220 pixels), each with its palette. First set contains sky - without sun, seconf set sky with sun. } - TSKYFileFormat = class(TElderFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SSKYFormatName = 'Daggerfall Sky Images'; - SSKYMasks = '*.dagsky,sky??.dat'; - - SkyWidth = 512; - SkyHeight = 220; - SkyCount = 64; - DataOffset = 549120; - PalFileSize = 776; - SkyImageSize = SkyWidth * SkyHeight; - - SkyFileId: array[0..5] of Byte = ($08, $03, $00, $00, $23, $B1); - -{ TSKYFileFormat class implementation } - -procedure TSKYFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffMultiImage]; - FName := SSKYFormatName; - AddMasks(SSKYMasks); -end; - -function TSKYFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - I: Integer; - Pal24: TPalette24Size256; - - procedure CopyPalette(Dest: PPalette32); - var - I: Integer; - begin - for I := 0 to 255 do - begin - Dest[I].A := 255; - Dest[I].R := Pal24[I].B; - Dest[I].G := Pal24[I].G; - Dest[I].B := Pal24[I].R; - end; - end; - -begin - SetLength(Images, SkyCount); - for I := 0 to SkyCount - 1 do - begin - NewImage(SkyWidth, SkyHeight, ifIndex8, Images[I]); - // Read corresponding palette from file - GetIO.Seek(Handle, PalFileSize * (I mod 32) + 8, smFromBeginning); - GetIO.Read(Handle, @Pal24, SizeOf(Pal24)); - CopyPalette(Images[I].Palette); - // Now read image pixels - GetIO.Seek(Handle, DataOffset + I * SkyImageSize, smFromBeginning); - GetIO.Read(Handle, Images[I].Bits, SkyImageSize); - end; - Result := True; -end; - -function TSKYFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Id: array[0..5] of Byte; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(ID, SizeOf(Id), 0); - ReadCount := Read(Handle, @Id, SizeOf(Id)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Id)) and - CompareMem(@Id, @SkyFileId, SizeOf(SkyFileId)); - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Initial version created. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ElderImageryTexture.pas b/3rd/Imaging/Extras/Extensions/ElderImageryTexture.pas deleted file mode 100644 index 3c255c736..000000000 --- a/3rd/Imaging/Extras/Extensions/ElderImageryTexture.pas +++ /dev/null @@ -1,390 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader of Daggerfall texture file format.} -unit ElderImageryTexture; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ElderImagery, ImagingIO, ImagingUtility; - -type - { Class that proveides loading of textures from TES2: Daggerfall - (works for Terminator: FS and maybe other games too). - Textures are stored in 8bit indexed format with external palette. - This format is very complicated (more images with subimages, - non-standard RLE, many unknowns) so module supports only loading. - These texture files cannot be recognized by filename extension because - their filenames are in form texture.### where # is number. Use filename - masks instead. Also note that after loading the input position is not set - at the exact end of the data so it's not "stream-safe".} - TTextureFileFormat = class(TElderFileFormat) - private - FLastTextureName: string; - { Deletes non-valid chars from texture name.} - function RepairName(const S: array of AnsiChar): string; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Internal name of the last texture loaded.} - property LastTextureName: string read FLastTextureName; - end; - -const - { Metadata item id for accessing name of last loaded Daggetfall texture. - Value type is string.} - SMetaDagTextureName = 'DagTexture.Name'; - -implementation - -const - STextureFormatName = 'Daggerfall Texture'; - STextureMasks = '*.dagtexture,texture.*'; // fake ext first, it's used as format id - -type - { Main texture header.} - TTexHeader = packed record - ImgCount: Word; // Number of images in texture - TexName: array[0..23] of AnsiChar; // Name of texture - end; - - { Offset list for texture.} - TOffset = packed record - Type1: Word; // ?? - HdrOffset: LongInt; // Contains offsetof Img header from the origin - // of the file - Type2: Word; // ?? - Unk: LongWord; // Ranges from 0 to 4 (0 in 90%) - Null1: LongWord; // Always 0 - Null2: LongWord; // Always 0 - end; - - TOffsetList = array[Word] of TOffset; - POffsetList = ^TOffsetList; - - { Image header for texture.} - TTexImgHeader = packed record - XOff: Word; - YOff: Word; - Width: Word; - Height: Word; - Unk1: Word; // $0108 = Image has subimages which are RLE - // compressed data. - // $1108 = Image has RLE type compressed data with - // a row offset section before the single image data. - ImageSize: LongInt; // Image size (including header) - ImageOff: LongInt; // Pointer to start of image data from this header - Unk2: Word; // $0000 = Image has subimages in special - // compressed format. - // $00C0 = Usual value, regular single image. - // NonZero = Regular single image.Unknown what the - // differences indicate - SubImages: Word; // Number of subimages (1 = single image) - Unk3: LongInt; - Unk4: Word; - end; - -{ TTextureFileFormat } - -procedure TTextureFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffMultiImage]; - FName := STextureFormatName; - AddMasks(STextureMasks); -end; - -function TTextureFileFormat.RepairName(const S: array of AnsiChar): string; -var - I: LongInt; - First: Boolean; -begin - I := 1; - Result := string(S); - First := False; - while I <= Length(Result) do - begin - if (Ord(Result[I]) < 32) or ((Ord(Result[I]) = 32) and (not First)) then - begin - Delete(Result, I, 1); - end - else - begin - Inc(I); - First := True; - end; - end; -end; - -function TTextureFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TTexHeader; - InputSize, BasePos, HdrPos, Index, I, Bias: LongInt; - List: POffsetList; - ImageHdr: TTexImgHeader; - - function AddImage(Width, Height: LongInt): LongInt; - begin - Result := Length(Images); - SetLength(Images, Length(Images) + 1); - NewImage(Width, Height, ifIndex8, Images[Result]); - Move(FARGBPalette[0], Images[Result].Palette[0], Length(FPalette) * SizeOf(TColor32Rec)); - end; - - procedure LoadUncompressed; - var - I: LongInt; - begin - // Add image and read its pixels row by row - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - for I := 0 to ImageHdr.Height - 1 do - begin - Read(Handle, @PByteArray(Bits)[I * Width], Width); - Seek(Handle, 256 - Width, smFromCurrent); - end; - end; - - procedure LoadUncompressedSubImages; - var - SubOffs: packed array[0..63] of LongInt; - I, StartPos, J, WritePos: LongInt; - NumZeroes, NumImageBytes: Byte; - SubWidth, SubHeight: Word; - begin - // Read subimages offset list - StartPos := GetIO.Tell(Handle); - FillChar(SubOffs, SizeOf(SubOffs), 0); - GetIO.Read(Handle, @SubOffs, ImageHdr.SubImages * 4); - for I := 0 to ImageHdr.SubImages - 1 do - begin - // Add new subimage and load its pixels - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - begin - Seek(Handle, StartPos + SubOffs[I], smFromBeginning); - Read(Handle, @SubWidth, 2); - Read(Handle, @SubHeight, 2); - // Read rows - for J := 0 to SubHeight - 1 do - begin - WritePos := 0; - while WritePos < SubWidth do - begin - // First there is a number of zero pixels that should be written - // to this row (slight compression as many images/sprites have - // many zero pixels) - Read(Handle, @NumZeroes, 1); - FillChar(PByteArray(Bits)[J * SubWidth + WritePos], NumZeroes, 0); - WritePos := WritePos + NumZeroes; - // Now there is a number of bytes that contain image data and should - // be copied to this row - Read(Handle, @NumImageBytes, 1); - Read(Handle, @PByteArray(Bits)[J * SubWidth + WritePos], NumImageBytes); - WritePos := WritePos + NumImageBytes; - end; - end; - end; - end; - end; - - procedure LoadRLESubImages; - type - TRowOff = packed record - Off: Word; - RLEStatus: Word; - end; - var - RowOffs: packed array[0..255] of TRowOff; - I, J, WritePos, NextOffsetPos: LongInt; - RLEData: Byte; - ByteCount, RowWidth: SmallInt; - begin - NextOffsetPos := GetIO.Tell(Handle); - for I := 0 to ImageHdr.SubImages - 1 do - begin - // Read row offsets for RLE subimage - FillChar(RowOffs, SizeOf(RowOffs), 0); - GetIO.Seek(Handle, NextOffsetPos, smFromBeginning); - GetIO.Read(Handle, @RowOffs, ImageHdr.Height * SizeOf(TRowOff)); - NextOffsetPos := GetIO.Tell(Handle); - // Add new image - Index := AddImage(ImageHdr.Width, ImageHdr.Height); - with GetIO, Images[Index] do - begin - for J := 0 to Height - 1 do - begin - // Seek to the beginning of the current row in the source - Seek(Handle, HdrPos + RowOffs[J].Off, smFromBeginning); - if RowOffs[J].RLEStatus = $8000 then - begin - // This row is compressed so it must be decoded (it is different - // from RLE in IMG/CIF files) - Read(Handle, @RowWidth, 2); - WritePos := 0; - while WritePos < RowWidth do - begin - Read(Handle, @ByteCount, 2); - if ByteCount > 0 then - begin - Read(Handle, @PByteArray(Bits)[J * Width + WritePos], ByteCount); - WritePos := WritePos + ByteCount; - end - else - begin - Read(Handle, @RLEData, 1); - FillChar(PByteArray(Bits)[J * Width + WritePos], -ByteCount, RLEData); - WritePos := WritePos - ByteCount; - end; - end; - end - else - // Read uncompressed row - Read(Handle, @PByteArray(Bits)[J * Width], Width); - end; - end; - end; - end; - -begin - Result := False; - SetLength(Images, 0); - with GetIO do - begin - InputSize := GetInputSize(GetIO, Handle); - BasePos := Tell(Handle); - Read(Handle, @Hdr, SizeOf(Hdr)); - FLastTextureName := RepairName(Hdr.TexName); - FMetadata.SetMetaItem(SMetaDagTextureName, FLastTextureName); - - if InputSize = 2586 then - begin - // Handle texture.001 and texture.000 files - // They contain only indices to palette so we create small - // images with colors defined by these indices - Bias := 0; - if Pos('B', FLastTextureName) > 0 then - Bias := 128; - for I := 0 to Hdr.ImgCount - 1 do - begin - Index := AddImage(16, 16); - FillMemoryByte(Images[Index].Bits, Images[Index].Size, I + Bias); - end; - end - else if (InputSize = 46) or (InputSize = 126) or (InputSize = 266) then - begin - // These textures don't contain any image data - Exit; - end - else - begin - GetMem(List, Hdr.ImgCount * SizeOf(TOffset)); - try - // Load offsets - for I := 0 to Hdr.ImgCount - 1 do - Read(Handle, @List[I], SizeOf(TOffset)); - // Load subimages one by one - for I := 0 to Hdr.ImgCount - 1 do - begin - // Jump at position of image header - Seek(Handle, BasePos + List[I].HdrOffset, smFromBeginning); - HdrPos := Tell(Handle); - Read(Handle, @ImageHdr, SizeOf(ImageHdr)); - Seek(Handle, HdrPos + ImageHdr.ImageOff, smFromBeginning); - // According to number of subimages and RLE settings appropriate - // procedure is called to load subimages - if ImageHdr.SubImages = 1 then - begin - if (ImageHdr.Unk1 <> $1108) and (ImageHdr.Unk1 <> $0108) then - LoadUncompressed - else - LoadRLESubImages; - end - else - begin - if (ImageHdr.Unk1 <> $0108) then - LoadUncompressedSubImages - else - LoadRLESubImages; - end; - end; - finally - FreeMem(List); - end; - end; - Result := True; - end; -end; - -function TTextureFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TTexHeader; - ReadCount, I: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Hdr)) and (Hdr.ImgCount > 0) and - (Hdr.ImgCount <= 2048); - if Result then - begin - for I := 0 to High(Hdr.TexName) do - begin - if not (Hdr.TexName[I] in [#0, #32, 'a'..'z', 'A'..'Z', '0'..'9', '.', - '(', ')', '_', ',', '-', '''', '"', '/', '\', #9, '+']) then - begin - Result := False; - Exit; - end; - end; - end; - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Last texture name now accessible trough metadata interface. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Initial version created based on my older code (fixed few things). -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingBinary.pas b/3rd/Imaging/Extras/Extensions/ImagingBinary.pas deleted file mode 100644 index 15dc5afb2..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingBinary.pas +++ /dev/null @@ -1,457 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Unit with operations on binary images. Binary images in Imaging are - ifGray8 images where pixels with value 0 are considerend off, an pixels > 0 - are on. - Note: Native ifBinary data format was later added to Imaging. However, - these functions still use ifGray8 for representation for less complex - and faster processing. ifBinary is meant moreless like interchange - format for IO file formats. } -unit ImagingBinary; - -{$I ImagingOptions.inc} - -interface - -uses - Types, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Basic morphologic operators.} - TMorphologyOp = ( - moErode, // Erosion - moDilate // Dilatation - ); - - { Structuring element for morphology operations. Use ones and - zeroes to define your struct elements.} - TStructElement = array of array of Byte; - - TCalcSkewAngleStats = record - PixelCount: Integer; - TestedPixels: Integer; - AccumulatorSize: Integer; - AccumulatedCounts: Integer; - BestCount: Integer; - end; - PCalcSkewAngleStats = ^TCalcSkewAngleStats; - -{ Thresholding using Otsu's method (which chooses the threshold - to minimize the intraclass variance of the black and white pixels!). - Functions returns calculated threshold level value [0..255]. - If BinarizeImage is True then the Image is automatically converted to binary using - computed threshold level.} -function OtsuThresholding(var Image: TImageData; BinarizeImage: Boolean = False): Integer; -{ Applies basic morphology operators (Erode/Dilate) on Image using given structuring element - Strel. You can do composite operations (Open/Close) by calling this function - twice each time with different operator.} -procedure Morphology(var Image: TImageData; const Strel: TStructElement; Op: TMorphologyOp); -{ Calculates rotation angle for given 8bit grayscale image. - Useful for finding skew of scanned documents etc. - Uses Hough transform internally. - MaxAngle is maximal (abs. value) expected skew angle in degrees (to speed things up) - and Threshold (0..255) is used to classify pixel as black (text) or white (background). - Area of interest rectangle can be defined to restrict the detection to - work only in defined part of image (useful when the document has text only in - smaller area of page and non-text features outside the area confuse the rotation detector). - Various calculations stats can be retrieved by passing Stats parameter.} -function CalcRotationAngle(MaxAngle: Integer; Treshold: Integer; - Width, Height: Integer; Pixels: PByteArray; DetectionArea: PRect = nil; - Stats: PCalcSkewAngleStats = nil): Double; -{ Deskews given image. Finds rotation angle and rotates image accordingly. - Works best on low-color document-like images (scans). - MaxAngle is maximal (abs. value) expected skew angle in degrees (to speed things up) - and Threshold (0..255) is used to classify pixel as black (text) or white (background). - If Treshold=-1 then auto threshold calculated by OtsuThresholding is used.} -procedure DeskewImage(var Image: TImageData; MaxAngle: Integer = 10; Threshold: Integer = -1); - -implementation - -function OtsuThresholding(var Image: TImageData; BinarizeImage: Boolean): Integer; -var - Histogram: array[Byte] of Single; - Level, Max, Min, I, J, NumPixels: Integer; - Pix: PByte; - Mean, Variance: Single; - Mu, Omega, LevelMean, LargestMu: Single; -begin - Assert(Image.Format = ifGray8); - - FillChar(Histogram, SizeOf(Histogram), 0); - Min := 255; - Max := 0; - Level := 0; - NumPixels := Image.Width * Image.Height; - Pix := Image.Bits; - - // Compute histogram and determine min and max pixel values - for I := 0 to NumPixels - 1 do - begin - Histogram[Pix^] := Histogram[Pix^] + 1.0; - if Pix^ < Min then - Min := Pix^; - if Pix^ > Max then - Max := Pix^; - Inc(Pix); - end; - - // Normalize histogram - for I := 0 to 255 do - Histogram[I] := Histogram[I] / NumPixels; - - // Compute image mean and variance - Mean := 0.0; - Variance := 0.0; - for I := 0 to 255 do - Mean := Mean + (I + 1) * Histogram[I]; - for I := 0 to 255 do - Variance := Variance + Sqr(I + 1 - Mean) * Histogram[I]; - - // Now finally compute threshold level - LargestMu := 0; - - for I := 0 to 255 do - begin - Omega := 0.0; - LevelMean := 0.0; - - for J := 0 to I - 1 do - begin - Omega := Omega + Histogram[J]; - LevelMean := LevelMean + (J + 1) * Histogram[J]; - end; - - Mu := Sqr(Mean * Omega - LevelMean); - Omega := Omega * (1.0 - Omega); - - if Omega > 0.0 then - Mu := Mu / Omega - else - Mu := 0; - - if Mu > LargestMu then - begin - LargestMu := Mu; - Level := I; - end; - end; - - if BinarizeImage then - begin - // Do thresholding using computed level - Pix := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - if Pix^ >= Level then - Pix^ := 255 - else - Pix^ := 0; - Inc(Pix); - end; - end; - - Result := Level; -end; - -procedure Morphology(var Image: TImageData; const Strel: TStructElement; Op: TMorphologyOp); -var - X, Y, I, J: Integer; - SWidth, SHeight, PixCount, PixVal, NumOnes, PosX, PosY: Integer; - ImgOut: TImageData; - OutPix: PByte; -begin - Assert(Image.Format = ifGray8); - Assert((Length(Strel) > 0) and (Length(Strel[0]) > 0)); - - SWidth := Length(Strel); - SHeight := Length(Strel[0]); - - NumOnes := 0; - if Op = moErode then - begin - // We need to know number of ones in the strel for erosion - for I := 0 to SWidth - 1 do - for J := 0 to SHeight - 1 do - NumOnes := NumOnes + Strel[I, J]; - end; - - InitImage(ImgOut); - NewImage(Image.Width, Image.Height, ifGray8, ImgOut); - OutPix := ImgOut.Bits; - - for J := 0 to Image.Height - 1 do - for I := 0 to Image.Width - 1 do - begin - PixCount := 0; - - for X := 0 to SWidth - 1 do - begin - PosX := ClampInt(X + I - SWidth div 2, 0, Image.Width - 1); - for Y := 0 to SHeight - 1 do - begin - PosY := ClampInt(Y + J - SHeight div 2, 0, Image.Height - 1); - if (PosX >= 0) and (PosX < Image.Width) and - (PosY >= 0) and (PosY < Image.Height) then - begin - PixVal := PByteArray(Image.Bits)[PosY * Image.Width + PosX]; - end - else - PixVal := 0; - - if (Strel[X, Y] > 0) and (PixVal > 0) then - Inc(PixCount); - end; - end; - - case Op of - moErode: OutPix^ := Iff(PixCount = NumOnes, 255, 0); - moDilate: OutPix^ := Iff(PixCount > 0, 255, 0); - end; - - Inc(OutPix); - end; - - FreeImage(Image); - Image := ImgOut; -end; - -function CalcRotationAngle(MaxAngle: Integer; Treshold: Integer; - Width, Height: Integer; Pixels: PByteArray; DetectionArea: PRect; Stats: PCalcSkewAngleStats): Double; -const - // Number of "best" lines we take into account when determining - // resulting rotation angle (lines with most votes). - BestLinesCount = 20; - // Angle step used in alpha parameter quantization - AlphaStep = 0.1; -type - TLine = record - Count: Integer; - Index: Integer; - Alpha: Double; - D: Double; - end; - TLineArray = array of TLine; -var - AlphaStart, MinD, SumAngles: Double; - AlphaSteps, DCount, AccumulatorSize, I, AccumulatedCounts: Integer; - BestLines: TLineArray; - HoughAccumulator: array of Integer; - PageWidth, PageHeight: Integer; - ContentRect: TRect; - - // Classifies pixel at [X, Y] as black or white using threshold. - function IsPixelBlack(X, Y: Integer): Boolean; - begin - Result := Pixels[Y * Width + X] < Treshold; - end; - - // Calculates alpha parameter for given angle step. - function GetAlpha(Index: Integer): Double; - begin - Result := AlphaStart + Index * AlphaStep; - end; - - function CalcDIndex(D: Double): Integer; - begin - Result := Trunc(D - MinD); - end; - - // Calculates angle and distance parameters for all lines - // going through point [X, Y]. - procedure CalcLines(X, Y: Integer); - var - D, Rads: Double; - I, DIndex, Index: Integer; - begin - for I := 0 to AlphaSteps - 1 do - begin - Rads := GetAlpha(I) * Pi / 180; // Angle for current step in radians - D := Y * Cos(Rads) - X * Sin(Rads); // Parameter D of the line y=tg(alpha)x + d - DIndex := CalcDIndex(D); - Index := DIndex * AlphaSteps + I; - HoughAccumulator[Index] := HoughAccumulator[Index] + 1; // Add one vote for current line - end; - end; - - // Uses Hough transform to calculate all lines that intersect - // interesting points (those classified as beign on base line of the text). - procedure CalcHoughTransform; - var - Y, X: Integer; - begin - for Y := 0 to PageHeight - 1 do - for X := 0 to PageWidth - 1 do - begin - if IsPixelBlack(ContentRect.Left + X, ContentRect.Top + Y) and - not IsPixelBlack(ContentRect.Left + X, ContentRect.Top + Y + 1) then - begin - CalcLines(X, Y); - end; - end; - end; - - // Chooses "best" lines (with the most votes) from the accumulator - function GetBestLines(Count: Integer): TLineArray; - var - I, J, DIndex, AlphaIndex: Integer; - Temp: TLine; - begin - AccumulatedCounts := 0; - SetLength(Result, Count); - - for I := 0 to AccumulatorSize - 1 do - begin - if HoughAccumulator[I] > Result[Count - 1].Count then - begin - // Current line has more votes than the last selected one, - // let's put it the pot - Result[Count - 1].Count := HoughAccumulator[I]; - Result[Count - 1].Index := I; - J := Count - 1; - - // Sort the lines based on number of votes - while (J > 0) and (Result[J].Count > Result[J - 1].Count) do - begin - Temp := Result[J]; - Result[J] := Result[J - 1]; - Result[J - 1] := Temp; - J := J - 1; - end; - end; - - AccumulatedCounts := AccumulatedCounts + HoughAccumulator[I]; - end; - - for I := 0 to Count - 1 do - begin - // Caculate line angle and distance according to index in the accumulator - DIndex := Result[I].Index div AlphaSteps; - AlphaIndex := Result[I].Index - DIndex * AlphaSteps; - Result[I].Alpha := GetAlpha(AlphaIndex); - Result[I].D := DIndex + MinD; - end; - end; - -begin - // Use supplied page content rect or just the whole image - ContentRect := Rect(0, 0, Width, Height); - if DetectionArea <> nil then - begin - Assert((RectWidth(DetectionArea^) <= Width) and (RectHeight(DetectionArea^) <= Height)); - ContentRect := DetectionArea^; - end; - - PageWidth := ContentRect.Right - ContentRect.Left; - PageHeight := ContentRect.Bottom - ContentRect.Top; - - AlphaStart := -MaxAngle; - AlphaSteps := Round(2 * MaxAngle / AlphaStep); // Number of angle steps = samples from interval <-MaxAngle, MaxAngle> - MinD := -PageWidth; - DCount := 2 * (PageWidth + PageHeight); - - // Determine the size of line accumulator - AccumulatorSize := DCount * AlphaSteps; - SetLength(HoughAccumulator, AccumulatorSize); - - // Calculate Hough transform - CalcHoughTransform; - - // Get the best lines with most votes - BestLines := GetBestLines(BestLinesCount); - - // Average angles of the selected lines to get the rotation angle of the image - SumAngles := 0; - for I := 0 to BestLinesCount - 1 do - SumAngles := SumAngles + BestLines[I].Alpha; - - Result := SumAngles / BestLinesCount; - - if Stats <> nil then - begin - Stats.BestCount := BestLines[0].Count; - Stats.PixelCount := PageWidth * PageHeight; - Stats.AccumulatorSize := AccumulatorSize; - Stats.AccumulatedCounts := AccumulatedCounts; - Stats.TestedPixels := AccumulatedCounts div AlphaSteps; - end; -end; - -procedure DeskewImage(var Image: TImageData; MaxAngle: Integer; Threshold: Integer); -var - Angle: Double; - OutputImage: TImageData; - Info: TImageFormatInfo; -begin - if not TestImage(Image) then - raise EImagingBadImage.Create; - - // Clone input image and convert it to 8bit grayscale. This will be our - // working image. - CloneImage(Image, OutputImage); - ConvertImage(Image, ifGray8); - - if Threshold < 0 then - begin - // Determine the threshold automatically if needed. - Threshold := OtsuThresholding(Image); - end; - - // Main step - calculate image rotation angle - Angle := CalcRotationAngle(MaxAngle, Threshold, Image.Width, Image.Height, Image.Bits); - - // Finally, rotate the image. We rotate the original input image, not the working - // one so the color space is preserved. - GetImageFormatInfo(OutputImage.Format, Info); - if Info.IsIndexed or Info.IsSpecial then - ConvertImage(OutputImage, ifA8R8G8B8); // Rotation doesn't like indexed and compressed images - RotateImage(OutputImage, Angle); - - FreeImage(Image); - Image := OutputImage; -end; - - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 ------------------------------------------------------- - - OtsuThresholding signature changed, now it's a function and - always returns the computed level. - - Extended CalcRotationAngle, added margins and stats. - - Added CalcRotationAngle and DeskewImage functions. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Unit created with basic stuff (otsu and erode/dilate morphology ops). - -} - -end. - diff --git a/3rd/Imaging/Extras/Extensions/ImagingCompare.pas b/3rd/Imaging/Extras/Extensions/ImagingCompare.pas deleted file mode 100644 index 4f0c8aee2..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingCompare.pas +++ /dev/null @@ -1,131 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ - This unit contains various image comparing functions and image difference - computations. -} -unit ImagingCompare; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -{ Computes various error metrics for two images. Images must have - the same size and format. Only formats with 1, 2, and 4 byte samples are - supported (no indexed, compressed, etc.).} -procedure ComputeErrorMetrics(const Image1, Image2: TImageData; - var PSNR, MSE, RMSE, PAE, MAE: Single); - -implementation - -procedure ComputeErrorMetrics(const Image1, Image2: TImageData; - var PSNR, MSE, RMSE, PAE, MAE: Single); -var - I: Integer; - Info: TImageFormatInfo; - Samples, Bps: Integer; - PixelPtr1, PixelPtr2: PByte; - Diff, MaxSample: Single; -begin - GetImageFormatInfo(Image1.Format, Info); - Bps := Info.ChannelCount div Info.BytesPerPixel; - Assert((Image1.Width = Image2.Width) and (Image1.Height = Image2.Height) and - (Image1.Format = Image2.Format)); - Assert(not Info.IsIndexed and not Info.IsSpecial and not Info.UsePixelFormat - and (Bps in [1, 2, 4])); - - Diff := 0; - PSNR := 0; - MSE := 0; - RMSE := 0; - PAE := 0; - MAE := 0; - PixelPtr1 := Image1.Bits; - PixelPtr2 := Image2.Bits; - Samples := Image1.Width * Image1.Height * Info.ChannelCount; - - for I := 0 to Samples - 1 do - begin - // Compute difference betwen pixels - case Bps of - 1: Diff := Abs(PixelPtr2^ - PixelPtr1^); - 2: - begin - if Info.IsFloatingPoint then - Diff := Abs(HalfToFloat(PWord(PixelPtr2)^) - HalfToFloat(PWord(PixelPtr1)^)) - else - Diff := Abs(PWord(PixelPtr2)^ - PWord(PixelPtr1)^); - end; - 4: - begin - if Info.IsFloatingPoint then - Diff := Abs(PSingle(PixelPtr2)^ - PSingle(PixelPtr1)^) - else - Diff := Abs(PLongWord(PixelPtr2)^ - PLongWord(PixelPtr1)^); - end; - end; - - // Update metrics - MAE := MAE + Diff; - PAE := MaxFloat(PAE, Diff); - MSE := MSE + Diff * Diff; - - Inc(PixelPtr1, Bps); - Inc(PixelPtr2, Bps); - end; - - if Info.IsFloatingPoint then - MaxSample := 1.0 - else - MaxSample := Pow2Int(Bps * 8) - 1; - - // Final metrics calculations - MAE := MAE / Samples; - MSE := MSE / Samples; - RMSE := Sqrt(MSE); - if RMSE < 0.0001 then - PSNR := 1e06 - else - PSNR := 20 * Log10(MaxSample / RMSE); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - none - - -- 0.26.5 Changes/Bug Fixes ----------------------------------- - - Added ComputeErrorMetrics. - - Unit created. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingDirect3D9.pas b/3rd/Imaging/Extras/Extensions/ImagingDirect3D9.pas deleted file mode 100644 index d3956a6a7..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingDirect3D9.pas +++ /dev/null @@ -1,784 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading and saving Direct3D 9 textures - using Imaging and for converting images to textures and vice versa.} -unit ImagingDirect3D9; - -{$I ImagingOptions.inc} - -interface - -uses - Windows, SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, - ImagingUtility, Direct3D9; - -type - { Contains some texture capabilities of Direct3D device.} - TD3DTextureCaps = record - PowerOfTwo: Boolean; - CubePowerOfTwo: Boolean; - VolumePowerOfTwo: Boolean; - MaxWidth: LongInt; - MaxHeight: LongInt; - DXTCompression: Boolean; - ATI3DcCompression: Boolean; - MaxAnisotropy: LongInt; - MaxSimultaneousTextures: LongInt; - end; - -{ Returns some texture capabilities of the given D3D device.} -function GetDeviceTextureCaps(Device: IDirect3DDevice9; var Caps: TD3DTextureCaps): Boolean; -{ Returns True if the given Format is valid texture format for the given D3D device.} -function IsD3DFormatSupported(Device: IDirect3DDevice9; Format: TD3DFormat): Boolean; -{ Returns D3D format equivalent to the given TImageFormatInfo. It returns D3DFMT_UNKNOWN - if equivalent cannot be found. If returned ConversionTo is not the same - as input format then image must be first converted to this format for - the returned D3D format to be valid. You should also check if returned D3D - format is supported by the current D3D device using IsD3DFormatSupported.} -function ImageFormatToD3DFormat(const Format: TImageFormat; var ConversionTo: TImageFormat): TD3DFormat; -{ Returns TImageFormat equivalent to the given D3D format. If equivalent does - not exist ifUnknown is returned.} -function D3DFormatToImageFormat(Format: TD3DFormat): TImageFormat; - -{ LoadD3DTextureFromFile and similar functions use these default values: - All mipmap levels are created, Pool is D3DPOOL_MANAGED, - Usage is 0, Format and size are taken from image.} - -{ Creates D3D texture from image in file in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromFile(const FileName: string; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): Boolean; -{ Creates D3D texture from image in stream in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromStream(Stream: TStream; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): Boolean; -{ Creates D3D texture from image in memory in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadD3DTextureFromMemory(Data: Pointer; Size: LongInt; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; - -{ Converts TImageData structure to IDirect3DTexture9 texture. - Input images is used as main mipmap level and additional requested - levels are generated from this one. For the details on parameters - look at CreateD3DTextureFromMultiImage function.} -function CreateD3DTextureFromImage(const Image: TImageData; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width: LongInt = 0; - Height: LongInt = 0; MipLevels: LongInt = 0; Usage: LongWord = 0; - Format: TD3DFormat = D3DFMT_UNKNOWN; Pool: TD3DPool = D3DPOOL_MANAGED; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; -{ Converts images in TDymImageDataArray to one IDirect3DTexture9 texture. - First image in array is used as main mipmap level and additional images - are used as subsequent levels. If MipLevels is larger than number of images - in array missing levels are automatically generated. - If Device supports only power of two sized textures images are resized. - If Format is D3DFMT_UNKNOWN then format of input image is used. - If desired texture format is not supported by hardware default - A8R8G8B8 format is used instead. - Width and Height of 0 mean use width and height of main image. - MipLevels set to 0 mean build all possible levels. For details on - Usage and Pool parameters look at DirectX SDK docs. - You can use CreatedWidth and CreatedHeight parameters to query dimensions of - created texture's largest mipmap level (it could differ from dimensions - of source image).} -function CreateD3DTextureFromMultiImage(const Images: TDynImageDataArray; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width: LongInt = 0; - Height: LongInt = 0; MipLevels: LongInt = 0; Usage: LongWord = 0; - Format: TD3DFormat = D3DFMT_UNKNOWN; Pool: TD3DPool = D3DPOOL_MANAGED; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): Boolean; - -{ Saves D3D texture to file in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToFile(const FileName: string; const Texture: IDirect3DTexture9): Boolean; -{ Saves D3D texture to stream in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToStream(const Ext: string; Stream: TStream; const Texture: IDirect3DTexture9): Boolean; -{ Saves D3D texture to memory in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveD3DTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: IDirect3DTexture9): Boolean; - -{ Converts main level of the D3D texture to TImageData strucrue. OverrideFormat - can be used to convert output image to the specified format rather - than use the format taken from D3D texture, ifUnknown means no conversion.} -function CreateImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean; -{ Converts D3D texture to TDynImageDataArray array of images. You can specify - how many mipmap levels of the input texture you want to be converted - (default is all levels). OverrideFormat can be used to convert output images to - the specified format rather than use the format taken from D3D texture, - ifUnknown means no conversion.} -function CreateMultiImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Images: TDynImageDataArray; MipLevels: LongInt = 0; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -{ Creates contents of Image to D3D surface. Surface must exist before calling this - function so it can be used to fill various types of surfaces (textures surfaces, - offscreen, depth buffer, ...). Surface must be lockable for function to work.} -function CreateD3DSurfaceFromImage(const Image: TImageData; Surface: IDirect3DSurface9): Boolean; -{ Creates image filled with contents of input D3D surface. - Surface must be lockable for function to work.} -function CreateImageFromD3DSurface(Surface: IDirect3DSurface9; var Image: TImageData): Boolean; - -const - D3DFMT_ATI1 = TD3DFormat(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('1') shl 24)); - D3DFMT_ATI2 = TD3DFormat(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('2') shl 24)); - -implementation - -const - DefaultUsage = 0; - DefaultPool = D3DPOOL_MANAGED; - -function GetDeviceTextureCaps(Device: IDirect3DDevice9; - var Caps: TD3DTextureCaps): Boolean; -var - D3DCaps: TD3DCaps9; -begin - FillChar(Caps, SizeOf(Caps), 0); - Result := Device <> nil; - // Get D3D Device Caps and fill our caps - if Result and (Device.GetDeviceCaps(D3DCaps) = D3D_OK) then - begin - Caps.PowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_POW2) = D3DPTEXTURECAPS_POW2; - Caps.CubePowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_CUBEMAP_POW2) = D3DPTEXTURECAPS_CUBEMAP_POW2; - Caps.VolumePowerOfTwo := (D3DCaps.TextureCaps and D3DPTEXTURECAPS_VOLUMEMAP_POW2) = D3DPTEXTURECAPS_VOLUMEMAP_POW2; - Caps.MaxWidth := D3DCaps.MaxTextureWidth; - Caps.MaxHeight := D3DCaps.MaxTextureHeight; - if (D3DCaps.TextureFilterCaps and D3DPTFILTERCAPS_MINFANISOTROPIC) = D3DPTFILTERCAPS_MINFANISOTROPIC then - Caps.MaxAnisotropy := D3DCaps.MaxAnisotropy - else - Caps.MaxAnisotropy := 0; - Caps.MaxSimultaneousTextures := D3DCaps.MaxSimultaneousTextures; - // Texture format caps - Caps.DXTCompression := IsD3DFormatSupported(Device, D3DFMT_DXT1) and - IsD3DFormatSupported(Device, D3DFMT_DXT3) and IsD3DFormatSupported(Device, D3DFMT_DXT5); - Caps.ATI3DcCompression := IsD3DFormatSupported(Device, D3DFMT_ATI1) and - IsD3DFormatSupported(Device, D3DFMT_ATI2); - end; -end; - -function IsD3DFormatSupported(Device: IDirect3DDevice9; Format: TD3DFormat): Boolean; -var - Direct3D: IDirect3D9; - Mode: TD3DDisplayMode; - Hr: HResult; -begin - Result := False; - if Device <> nil then - begin - Device.GetDirect3D(Direct3D); - if Direct3D <> nil then - begin - Direct3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, Mode); - Hr := Direct3D.CheckDeviceFormat(D3DADAPTER_DEFAULT, - D3DDEVTYPE_HAL, Mode.Format, 0, D3DRTYPE_TEXTURE, Format); - Result := Succeeded(Hr); - end; - end; -end; - -function ImageFormatToD3DFormat(const Format: TImageFormat; var ConversionTo: TImageFormat): TD3DFormat; -begin - Result := D3DFMT_UNKNOWN; - ConversionTo := Format; - case Format of - ifIndex8: Result := D3DFMT_P8; - ifGray8: Result := D3DFMT_L8; - ifA8Gray8: Result := D3DFMT_A8L8; - ifGray16: Result := D3DFMT_L16; - ifGray32, - ifGray64: - begin - Result := D3DFMT_L16; - ConversionTo := ifGray16; - end; - ifA16Gray16: - begin - Result := D3DFMT_A8L8; - ConversionTo := ifA8Gray8; - end; - ifX5R1G1B1: - begin - Result := D3DFMT_R3G3B2; - ConversionTo := ifR3G3B2; - end; - ifR3G3B2: Result := D3DFMT_R3G3B2; - ifR5G6B5: Result := D3DFMT_R5G6B5; - ifA1R5G5B5: Result := D3DFMT_A1R5G5B5; - ifA4R4G4B4: Result := D3DFMT_A4R4G4B4; - ifX1R5G5B5: Result := D3DFMT_X1R5G5B5; - ifX4R4G4B4: Result := D3DFMT_X4R4G4B4; - ifR8G8B8: Result := D3DFMT_R8G8B8; - ifA8R8G8B8: Result := D3DFMT_A8R8G8B8; - ifX8R8G8B8: Result := D3DFMT_X8R8G8B8; - ifR16G16B16, - ifA16R16G16B16, - ifB16G16R16: - begin - Result := D3DFMT_A16B16G16R16; - ConversionTo := ifA16B16G16R16; - end; - ifA16B16G16R16: Result := D3DFMT_A16B16G16R16; - ifR32F: Result := D3DFMT_R32F; - ifA32B32G32R32F: Result := D3DFMT_A32B32G32R32F; - ifA32R32G32B32F: - begin - Result := D3DFMT_A32B32G32R32F; - ConversionTo := ifA32B32G32R32F; - end; - ifR16F: Result := D3DFMT_R16F; - ifA16B16G16R16F: Result := D3DFMT_A16B16G16R16F; - ifA16R16G16B16F: - begin - Result := D3DFMT_A16B16G16R16F; - ConversionTo := ifA16B16G16R16F; - end; - ifDXT1: Result := D3DFMT_DXT1; - ifDXT3: Result := D3DFMT_DXT3; - ifDXT5: Result := D3DFMT_DXT5; - ifATI1N: Result := D3DFMT_ATI1; - ifATI2N: Result := D3DFMT_ATI2; - end; -end; - -function D3DFormatToImageFormat(Format: TD3DFormat): TImageFormat; -begin - Result := ifUnknown; - case Format of - D3DFMT_P8: Result := ifIndex8; - D3DFMT_A8, - D3DFMT_L8: Result := ifGray8; - D3DFMT_A8L8, - D3DFMT_V8U8: Result := ifA8Gray8; - D3DFMT_L16: Result := ifGray16; - D3DFMT_R3G3B2: Result := ifR3G3B2; - D3DFMT_R5G6B5: Result := ifR5G6B5; - D3DFMT_X1R5G5B5: Result := ifX1R5G5B5; - D3DFMT_A1R5G5B5: Result := ifA1R5G5B5; - D3DFMT_A4R4G4B4: Result := ifA4R4G4B4; - D3DFMT_X4R4G4B4: Result := ifX4R4G4B4; - D3DFMT_R8G8B8: Result := ifR8G8B8; - D3DFMT_A8R8G8B8, - D3DFMT_Q8W8V8U8, - D3DFMT_A8B8G8R8: Result := ifA8R8G8B8; - D3DFMT_X8R8G8B8, - D3DFMT_X8L8V8U8, - D3DFMT_X8B8G8R8: Result := ifX8R8G8B8; - D3DFMT_A16B16G16R16, - D3DFMT_Q16W16V16U16: Result := ifA16B16G16R16; - D3DFMT_R32F: Result := ifR32F; - D3DFMT_A32B32G32R32F: Result := ifA32B32G32R32F; - D3DFMT_R16F: Result := ifR16F; - D3DFMT_A16B16G16R16F: Result := ifA16B16G16R16F; - D3DFMT_DXT1: Result := ifDXT1; - D3DFMT_DXT3: Result := ifDXT3; - D3DFMT_DXT5: Result := ifDXT5; - D3DFMT_ATI1: Result := ifATI1N; - D3DFMT_ATI2: Result := ifATI2N; - end; -end; - -function LoadD3DTextureFromFile(const FileName: string; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, - Images[0].Width, Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, - DefaultPool, CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function LoadD3DTextureFromStream(Stream: TStream; Device: IDirect3DDevice9; - var Texture: IDirect3DTexture9; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, - Images[0].Width, Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, - DefaultPool, CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function LoadD3DTextureFromMemory(Data: Pointer; Size: LongInt; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; - CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then - begin - Result := CreateD3DTextureFromMultiImage(Images, Device, Texture, Images[0].Width, - Images[0].Height, 0, DefaultUsage, D3DFMT_UNKNOWN, DefaultPool, - CreatedWidth, CreatedHeight); - end - else - Result := False; - FreeImagesInArray(Images); -end; - -function CreateD3DTextureFromImage(const Image: TImageData; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width, - Height, MipLevels: LongInt; Usage: LongWord; Format: TD3DFormat; - Pool: TD3DPool; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - SetLength(Arr, 1); - Arr[0] := Image; - Result := CreateD3DTextureFromMultiImage(Arr, Device, Texture, Width, Height, - MipLevels, Usage, Format, Pool, CreatedWidth, CreatedHeight); -end; - -procedure FillLockedRectWithImage(var Rect: TD3DLockedRect; const Image: TImageData); -var - I, LineBytes: LongInt; - Info: TImageFormatInfo; -begin - GetImageFormatInfo(Image.Format, Info); - LineBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - // Pixels of the image are copied to D3D texture - if (not Info.IsSpecial) and (LineBytes < Rect.Pitch) then - begin - for I := 0 to Image.Height - 1 do - Move(PByteArray(Image.Bits)[I * LineBytes], - PByteArray(Rect.pBits)[I * Rect.Pitch], LineBytes); - end - else - Move(Image.Bits^, Rect.pBits^, Image.Size); -end; - -function CreateD3DTextureFromMultiImage(const Images: TDynImageDataArray; - Device: IDirect3DDevice9; var Texture: IDirect3DTexture9; Width, - Height, MipLevels: LongInt; Usage: LongWord; Format: TD3DFormat; - Pool: TD3DPool; CreatedWidth, CreatedHeight: PLongInt): Boolean; -var - I, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt; - Caps: TD3DTextureCaps; - Rect: TD3DLockedRect; - ConvTo: TImageFormat; - LevelsArray: TDynImageDataArray; - NeedsResize, NeedsConvert: Boolean; -begin - Texture := nil; - ExistingLevels := 0; - Result := False; - // Get texture caps of the current device and test if there is anything to convert - if GetDeviceTextureCaps(Device, Caps) and (Length(Images) > 0) then - try - // First check desired size and modify it if necessary - if Width <= 0 then Width := Images[0].Width; - if Height <= 0 then Height := Images[0].Height; - if Caps.PowerOfTwo then - begin - // If device supports only power of 2 texture sizes - Width := NextPow2(Width); - Height := NextPow2(Height); - end; - Width := ClampInt(Width, 1, Caps.MaxWidth); - Height := ClampInt(Height, 1, Caps.MaxHeight); - - // Get various mipmap level counts and modify - // desired MipLevels if its value is invalid - ExistingLevels := Length(Images); - PossibleLevels := GetNumMipMapLevels(Width, Height); - if (MipLevels < 1) or (MipLevels > PossibleLevels) then - MipLevels := PossibleLevels; - - // Now determine which image format will be used - if Format = D3DFMT_UNKNOWN then - begin - // D3D texture format is not explicitly defined so we use - // the current format of the input image - Format := ImageFormatToD3DFormat(Images[0].Format, ConvTo); - // Format is now either D3DFMT_UNKNOWN or some valid format and - // ConvTo contains format to which input image must be converted first - // (if ConvTo and input image's format differ). - // We must also test if returned D3D format is supported by D3D device - if (Format = D3DFMT_UNKNOWN) or not IsD3DFormatSupported(Device, Format) then - begin - Format := D3DFMT_A8R8G8B8; - ConvTo := ifA8R8G8B8; - end; - end - else - begin - // Image format coresponding to desired D3D format is either found - // and image is converted to it (if the image is not in this format already) - // or it is not found (or not supported by hardware) and default format is used - ConvTo := D3DFormatToImageFormat(Format); - if (ConvTo = ifUnknown) or not IsD3DFormatSupported(Device, Format) then - begin - Format := D3DFMT_A8R8G8B8; - ConvTo := ifA8R8G8B8; - end; - end; - - // Prepare array for mipmap levels - SetLength(LevelsArray, MipLevels); - - CurrentWidth := Width; - CurrentHeight := Height; - - for I := 0 to MipLevels - 1 do - begin - // Check if we can use input image array as a source for this mipmap level - if I < ExistingLevels then - begin - // Check if input image for this mipmap level has the right - // size and format - NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); - NeedsConvert := not (Images[I].Format = ConvTo); - - if NeedsResize or NeedsConvert then - begin - // Input image must be resized or converted to different format - // to become valid mipmap level - CloneImage(Images[I], LevelsArray[I]); - if NeedsConvert then - ConvertImage(LevelsArray[I], ConvTo); - if NeedsResize then - ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear); - end - else - // Input image can be used without any changes - LevelsArray[I] := Images[I]; - end - else - begin - // This mipmap level is not present in the input image array - // so we create a new level - FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]); - end; - // Calculate width and height of the next mipmap level - CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth); - CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight); - end; - - // Finally create D3D texture object - if Succeeded(Device.CreateTexture(LevelsArray[0].Width, - LevelsArray[0].Height, MipLevels, Usage, Format, Pool, Texture, nil)) then - begin - // Fill each mipmap level - for I := 0 to MipLevels - 1 do - if Succeeded(Texture.LockRect(I, Rect, nil, 0)) then - begin - FillLockedRectWithImage(Rect, LevelsArray[I]); - Texture.UnlockRect(I); - end; - Result := True; - end; - - // If user is interested in width and height of created texture lets - // give him that - if CreatedWidth <> nil then CreatedWidth^ := LevelsArray[0].Width; - if CreatedHeight <> nil then CreatedHeight^ := LevelsArray[0].Height; - - finally - // Free local image copies - for I := 0 to Length(LevelsArray) - 1 do - begin - if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or - (I >= ExistingLevels) then - FreeImage(LevelsArray[I]); - end; - end; -end; - -function SaveD3DTextureToFile(const FileName: string; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByName(FileName); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToFile(FileName, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function SaveD3DTextureToStream(const Ext: string; Stream: TStream; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToStream(Ext, Stream, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function SaveD3DTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: IDirect3DTexture9): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromD3DTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToMemory(Ext, Data, Size, Arr); - if IsDDS then - PopOptions; - end; - end; -end; - -function CreateImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Image: TImageData; OverrideFormat: TImageFormat): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - FreeImage(Image); - SetLength(Arr, 1); - Result := CreateMultiImageFromD3DTexture(Texture, Arr, 1, OverrideFormat); - Image := Arr[0]; -end; - -procedure FillImageWithLockedRect(var Image: TImageData; const Rect: TD3DLockedRect); -var - I, LineBytes: LongInt; - Info: TImageFormatInfo; -begin - GetImageFormatInfo(Image.Format, Info); - LineBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - // Pixels are copied from D3D texture to the image - if (not Info.IsSpecial) and (LineBytes < Rect.Pitch) then - begin - for I := 0 to Image.Height - 1 do - Move(PByteArray(Rect.pBits)[I * Rect.Pitch], - PByteArray(Image.Bits)[I * LineBytes], LineBytes); - end - else - Move(Rect.pBits^, Image.Bits^, Image.Size); -end; - -function CreateMultiImageFromD3DTexture(const Texture: IDirect3DTexture9; - var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean; -var - Rect: TD3DLockedRect; - Desc: TD3DSurfaceDesc; - I,ExistingLevels: LongInt; - CurrentFormat: TImageFormat; - Info: TImageFormatInfo; -begin - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := False; - if Texture <> nil then - begin - // Check if desired mipmap level count is valid - ExistingLevels := Texture.GetLevelCount; - if (MipLevels <= 0) or (Miplevels > ExistingLevels) then - MipLevels := ExistingLevels; - - Texture.GetLevelDesc(0, Desc); - // Try to find image format compatible with d3d texture's format - CurrentFormat := D3DFormatToImageFormat(Desc.Format); - // Exit if no compatible image format is found - if CurrentFormat = ifUnknown then - Exit; - - SetLength(Images, MipLevels); - GetImageFormatInfo(CurrentFormat, Info); - - for I := 0 to MipLevels - 1 do - begin - if Failed(Texture.LockRect(I, Rect, nil, D3DLOCK_READONLY)) then Exit; - Texture.GetLevelDesc(I, Desc); - - // Create image for the current mipmap level and copy texture data to it - NewImage(Desc.Width, Desc.Height, CurrentFormat, Images[I]); - FillImageWithLockedRect(Images[I], Rect); - - // If override format is set each mipmap level is converted to it - if OverrideFormat <> ifUnknown then - ConvertImage(Images[I], OverrideFormat); - - Texture.UnlockRect(I); - end; - Result := True; - end; -end; - -function CreateD3DSurfaceFromImage(const Image: TImageData; Surface: IDirect3DSurface9): Boolean; -var - ConvTo: TImageFormat; - Desc: TD3DSurfaceDesc; - Rect: TD3DLockedRect; - WorkImage: TImageData; -begin - Result := False; - if (Surface = nil) or not TestImage(Image) then - Exit; - // Get surface's format and find Imaging data format match - Surface.GetDesc(Desc); - ConvTo := D3DFormatToImageFormat(Desc.Format); - // If no Imaging data format was found we must exit - if ConvTo = ifUnknown then - Exit; - - if (LongInt(Desc.Width) <> Image.Width) or (LongInt(Desc.Height) <> Image.Height) or - (Image.Format <> ConvTo) then - begin - // Source image has different dimensions or format than dest surface, - // working image is created - InitImage(WorkImage); - NewImage(Desc.Width, Desc.Height, ConvTo, WorkImage); - StretchRect(Image, 0, 0, Image.Width, Image.Height, WorkImage, 0, 0, - WorkImage.Width, WorkImage.Height, rfBilinear); - end - else - WorkImage := Image; - - try - // Lock surface and fill it with image - if Succeeded(Surface.LockRect(Rect, nil, 0)) then - begin - FillLockedRectWithImage(Rect, WorkImage); - Surface.UnlockRect; - Result := True; - end; - finally - // Free working image if it is not reference to source image - if WorkImage.Bits <> Image.Bits then - FreeImage(WorkImage); - end; -end; - -function CreateImageFromD3DSurface(Surface: IDirect3DSurface9; var Image: TImageData): Boolean; -var - CurrentFormat: TImageFormat; - Desc: TD3DSurfaceDesc; - Rect: TD3DLockedRect; -begin - Result := False; - FreeImage(Image); - if Surface = nil then - Exit; - Surface.GetDesc(Desc); - CurrentFormat := D3DFormatToImageFormat(Desc.Format); - // Exit if no compatible image format is found - if CurrentFormat = ifUnknown then - Exit; - - if Succeeded(Surface.LockRect(Rect, nil, D3DLOCK_READONLY)) then - begin - // If surface was successfuly locked a new image is created - // and surface's contents are copied to it - NewImage(Desc.Width, Desc.Height, CurrentFormat, Image); - FillImageWithLockedRect(Image, Rect); - Surface.UnlockRect; - Result := True; - end; -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - support for cube and volume maps - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added support for 3Dc compressed texture formats. - - Added detection of 3Dc support to texture caps. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added CreatedWidth and CreatedHeight parameters to most - LoadD3DTextureFromXXX/CreateD3DTextureFromXXX functions. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed bug in CreateGLTextureFromMultiImage which caused assert failure - when creating mipmaps (using FillMipMapLevel) for DXTC formats - - added support for 16bit half-float texture formats - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - D3D surface support - fill surface with image and vice versa - - more texture caps added - - filtered mipmap creation - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingExtras.pas b/3rd/Imaging/Extras/Extensions/ImagingExtras.pas deleted file mode 100644 index f8074f707..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingExtras.pas +++ /dev/null @@ -1,153 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This is helper unit that registers all image file formats in Extras package - to Imaging core loading and saving functions. Just put this unit in your uses - clause instead of adding every unit that provides new file format support. - Also new constants for SetOption/GetOption functions for new file formats - are located here.} -unit ImagingExtras; - -{$I ImagingOptions.inc} - -//{$DEFINE DONT_LINK_JPEG2000} // link support for JPEG2000 images -//{$DEFINE DONT_LINK_TIFF} // link support for TIFF images -//{$DEFINE DONT_LINK_PSD} // link support for PSD images -//{$DEFINE DONT_LINK_PCX} // link support for PCX images -//{$DEFINE DONT_LINK_XPM} // link support for XPM images -{$IFNDEF FULL_FEATURE_SET} - {$DEFINE DONT_LINK_ELDER} // link support for Elder Imagery images -{$ENDIF} - -{$IF not ( - (Defined(DCC) and Defined(CPUX86) and not Defined(MACOS)) or - (Defined(FPC) and not Defined(MSDOS) and - ((Defined(CPUX86) and (Defined(LINUX) or Defined(WIN32) or Defined(MACOS)) or - (Defined(CPUX64) and Defined(LINUX))))) - )} - // JPEG2000 only for 32bit Windows/Linux/OSX and for 64bit Unix with FPC - {$DEFINE DONT_LINK_JPEG2000} -{$IFEND} - -{$IF not (Defined(DCC) and Defined(CPUX86) and not Defined(MACOS))} - {$DEFINE DONT_LINK_TIFF} // Only for Delphi now -{$IFEND} - -interface - -const - { Those are new options for GetOption/SetOption interface. } - - { Controls JPEG 2000 lossy compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Default is 80.} - ImagingJpeg2000Quality = 55; - { Controls whether JPEG 2000 image is saved with full file headers or just - as code stream. Default value is False (0).} - ImagingJpeg2000CodeStreamOnly = 56; - { Specifies JPEG 2000 image compression type. If True (1), saved JPEG 2000 files - will be losslessly compressed. Otherwise lossy compression is used. - Default value is False (0).} - ImagingJpeg2000LosslessCompression = 57; - { Specifies compression scheme used when saving TIFF images. Supported values - are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG), - 5 (CCITT Group 4 fax encoding - for binary images only). - Default is 1 (LZW). Note that not all images can be stored with - JPEG compression - these images will be saved with default compression if - JPEG is set.} - ImagingTiffCompression = 65; - { Controls compression quality when selected TIFF compression is Jpeg. - It is number in range 1..100. 1 means small/ugly file, - 100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.} - ImagingTiffJpegQuality = 66; - { When activated (True = 1) existing TIFF files are not overwritten when saving but - new images are instead appended thus producing multipage TIFFs. - Default value is False (0).} - ImagingTiffAppendMode = 67; - { If enabled image data is saved as layer of PSD file. This is required - to get proper transparency when opened in Photoshop for images with - alpha data (will be opened with one layer, RGB color channels, and transparency). - If you don't need this Photoshop compatibility turn this option off as you'll get - smaller file (will be opened in PS as background raster with RGBA channels). - Default value is True (1). } - ImagingPSDSaveAsLayer = 70; - -implementation - -uses -{$IFNDEF DONT_LINK_JPEG2000} - ImagingJpeg2000, -{$ENDIF} -{$IFNDEF DONT_LINK_TIFF} - ImagingLibTiffDelphi, -{$ENDIF} -{$IFNDEF DONT_LINK_PSD} - ImagingPsd, -{$ENDIF} -{$IFNDEF DONT_LINK_PCX} - ImagingPcx, -{$ENDIF} -{$IFNDEF DONT_LINK_XPM} - ImagingXpm, -{$ENDIF} -{$IFNDEF DONT_LINK_ELDER} - ElderImagery, -{$ENDIF} - Imaging; - -{ - File Notes: - - -- TODOS ----------------------------------------------------- - - nothing now - - -- 0.77 ----------------------------------------------------- - - Added ImagingTiffAppendMode option. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Added Group 4 Fax encoding as compression for TIFF files. - - Added ImagingTiffJpegQuality option. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Allowed JPEG2000 for Mac OS X x86 - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - ElderImagery formats are disabled by default, TIFF enabled. - - Changed _LINK_ symbols according to changes in ImagingOptions.inc. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Allowed JPEG2000 for x86_64 CPUS in Linux - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Better IF conditional to disable JPEG2000 on unsupported platforms. - - Added PSD and TIFF related stuff. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Created with initial stuff. - -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingFmx.pas b/3rd/Imaging/Extras/Extensions/ImagingFmx.pas deleted file mode 100644 index 2dcfe1189..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingFmx.pas +++ /dev/null @@ -1,353 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Functions and classes for interoperability between Imaging and - FireMonkey framework.} -unit ImagingFmx; - -{$I ImagingOptions.inc} - -{$IF not Defined(DCC) or (CompilerVersion < 23)} - {$MESSAGE FATAL 'FMX needs Delphi XE2+'} -{$IFEND} - -{$IF (CompilerVersion = 24)} - {$MESSAGE FATAL 'FMX needs Delphi XE4+'} -{$IFEND} - - -interface - -uses -{$IF (CompilerVersion > 23)} - System.UITypes, -{$IFEND} - Types, - SysUtils, - ImagingTypes, - Imaging, - ImagingFormats, - ImagingClasses, - ImagingUtility, - Fmx.Types; - -{ Converts image from TImageData record to FMX bitmap. Bitmap must be already instantiated.} -procedure ConvertImageDataToFmxBitmap(const Image: TImageData; Bitmap: TBitmap); -{$IF (CompilerVersion > 23)} -{ Converts FMX bitmap to TImageData. Image Data must already instantiated.} -procedure ConvertFmxBitmapToImageData(const Bitmap: TBitmap;Image: TImageData); -{$IFEND} - -{ Converts image from TBaseImage instance to FMX bitmap. Bitmap must be already instantiated.} -procedure ConvertImageToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap); - -{ Copies rectangular area of pixels from TImageData record to existing FMX bitmap.} -procedure CopyRectToFmxBitmap(const Image: TImageData; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; -{ Copies rectangular area of pixels from TBaseImage instance to existing FMX bitmap.} -procedure CopyRectToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; - -implementation - -{$IF (CompilerVersion > 23)} -type - TARGB = record - A, R, G, B: System.Byte; - end; - -procedure ConvertFmxBitmapToImageData(const Bitmap: TBitmap;Image: TImageData); -var - Color32:TColor32Rec; - MapData:TBitmapData; - SourceData: PAlphaColorRec; - TargetData: PByte; - X, Y, Bpp, SrcWidthBytes: Integer; - TargetInfo: TImageFormatInfo; -begin - Bitmap.Map(TMapAccess.maRead,MapData); - GetImageFormatInfo(Image.Format, TargetInfo); - - Bpp := TargetInfo.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - TargetData := @PByteArray(Image.Bits)[0]; - - for Y := 0 to Pred(Bitmap.Height) do - for X:= 0 to Pred(Bitmap.Width) do - begin - SourceData:= @PAlphaColorArray(MapData.Data)[Y * (MapData.Pitch div 4)+X]; - case TargetInfo.Format of - ifIndex8: - begin - Image.Palette[TargetData^].R := SourceData^.R; - Image.Palette[TargetData^].G := SourceData^.G; - Image.Palette[TargetData^].B := SourceData^.B; - Image.Palette[TargetData^].A := SourceData^.A; - end; - ifGray8: - TargetData^ := SourceData.R; - ifA8Gray8: - begin - TargetData^ := SourceData.R; - PWordRec(TargetData).High := SourceData.A; - end; - ifGray16: - PWord(TargetData)^ := SourceData.R; - ifR8G8B8: - begin - PColor24Rec(TargetData)^.R := SourceData.R; - PColor24Rec(TargetData)^.G := SourceData.G; - PColor24Rec(TargetData)^.B := SourceData.B; - end; - ifA8R8G8B8: - begin - PColor32Rec(TargetData)^.A := SourceData^.B; - PColor32Rec(TargetData)^.G := SourceData^.R; - PColor32Rec(TargetData)^.R := SourceData^.G; - PColor32Rec(TargetData)^.B := SourceData^.A; - end; - ifR16G16B16: - begin - PColor48Rec(TargetData).R := Round(SourceData.R*$FFFF/255); - PColor48Rec(TargetData).G := Round(SourceData.G*$FFFF/255); - PColor48Rec(TargetData).B := Round(SourceData.B*$FFFF/255); - end; - ifA16R16G16B16: - begin - PColor64Rec(TargetData).R := Round(SourceData.R*$FFFF/255); - PColor64Rec(TargetData).G := Round(SourceData.G*$FFFF/255); - PColor64Rec(TargetData).B := Round(SourceData.B*$FFFF/255); - PColor64Rec(TargetData).A := Round(SourceData.A*$FFFF/255); - end; - else - Color32.R := SourceData^.R; - Color32.G := SourceData^.G; - Color32.B := SourceData^.B; - Color32.A := SourceData^.A; - TargetInfo.SetPixel32(TargetData,@TargetInfo, Image.Palette,Color32); - end; - Inc(TargetData, Bpp); - end; - Bitmap.Unmap(MapData); -end; -{$IFEND} - -procedure ConvertImageDataToFmxBitmap(const Image: TImageData; Bitmap: TBitmap); -begin - Assert(TestImage(Image)); - Bitmap.SetSize(Image.Width, Image.Height); - CopyRectToFmxBitmap(Image, Bitmap, 0, 0, Image.Width, Image.Height, 0, 0); -end; - -procedure ConvertImageToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap); -begin - ConvertImageDataToFmxBitmap(Image.ImageDataPointer^, Bitmap); -end; - -{$IF (CompilerVersion > 23)} -procedure ConvertToAlphaColorRec(SrcPix: PByte; DestPix: PAlphaColorRec; - const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32); -var - Color32:TColor32Rec; -begin - case SrcInfo.Format of - ifIndex8: - begin - DestPix^.R := SrcPalette[SrcPix^].R; - DestPix^.G := SrcPalette[SrcPix^].G; - DestPix^.B := SrcPalette[SrcPix^].B; - DestPix^.A := SrcPalette[SrcPix^].A; - end; - ifGray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := 255; - end; - ifA8Gray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := PWordRec(SrcPix).High; - end; - ifGray16: - begin - DestPix.R := PWord(SrcPix)^ shr 8; - DestPix.G := DestPix.R; - DestPix.B := DestPix.R; - DestPix.A := 255; - end; - ifR8G8B8: - begin - DestPix.R := PColor24Rec(SrcPix)^.R; - DestPix.G := PColor24Rec(SrcPix)^.G; - DestPix.B := PColor24Rec(SrcPix)^.B; - DestPix.A := 255; - end; - ifA8R8G8B8: - begin - DestPix^.R := PColor32Rec(SrcPix)^.R; - DestPix^.G := PColor32Rec(SrcPix)^.G; - DestPix^.B := PColor32Rec(SrcPix)^.B; - DestPix^.A := PColor32Rec(SrcPix)^.A; - end; - ifR16G16B16: - begin - DestPix.R := PColor48Rec(SrcPix).R shr 8; - DestPix.G := PColor48Rec(SrcPix).G shr 8; - DestPix.B := PColor48Rec(SrcPix).B shr 8; - DestPix.A := 255; - end; - ifA16R16G16B16: - begin - DestPix.R := PColor64Rec(SrcPix).R shr 8; - DestPix.G := PColor64Rec(SrcPix).G shr 8; - DestPix.B := PColor64Rec(SrcPix).B shr 8; - DestPix.A := PColor64Rec(SrcPix).A shr 8; - end; - else - Color32:=SrcInfo.GetPixel32(SrcPix, @SrcInfo, SrcPalette); - DestPix^.R := Color32.R; - DestPix^.G := Color32.G; - DestPix^.B := Color32.B; - DestPix^.A := Color32.A; - end; -end; -{$IFEND} - -procedure CopyRectToFmxBitmap(const Image: TImageData; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -var - TempImage: TImageData; - X, Y, Bpp, SrcWidthBytes, MoveBytes: Integer; - SrcPtr: PByte; - Info: TImageFormatInfo; -{$IF (CompilerVersion > 23)} - MapData: TBitmapData; - DstPtr: PAlphaColorRec; - ARGB: TARGB; -{$ELSE} - DstPtr: PColor32Rec; -{$IFEND} -begin - Assert(TestImage(Image) and not Bitmap.IsEmpty); - - ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, Image.Width, Image.Height, - Rect(0, 0, Bitmap.Width, Bitmap.Height)); - GetImageFormatInfo(Image.Format, Info); - - if not Info.IsSpecial then - begin - Bpp := Info.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - MoveBytes := Width * Bpp; - SrcPtr := @PByteArray(Image.Bits)[SrcY * SrcWidthBytes + SrcX * Bpp]; -{$IF (CompilerVersion > 23)} - Bitmap.Map(TMapAccess.maReadWrite,MapData); -{$IFEND} - for Y := 0 to Height - 1 do - begin -{$IF (CompilerVersion = 23)} - DstPtr := PColor32Rec(@Bitmap.ScanLine[Y][DstX]); -{$IFEND} - if Info.Format = ifA8R8G8B8 then - begin -{$IF (CompilerVersion = 23)} - Move(SrcPtr^, DstPtr^, MoveBytes); - Inc(SrcPtr, MoveBytes); -{$ELSE} //CompilerVersion > 23 - for X:= 0 to Pred(Width) do - begin - DstPtr:= @PAlphaColorArray(MapData.Data)[Y * (MapData.Pitch div 4)+X]; - Move(SrcPtr^,ARGB,4); - DstPtr^.A:=ARGB.A; - DstPtr^.R:=ARGB.R; - DstPtr^.G:=ARGB.G; - DstPtr^.B:=ARGB.B; - Inc(SrcPtr,4); - end; -{$IFEND} - end - else - begin - for X := 0 to Width - 1 do - begin -{$IF (CompilerVersion = 23)} - ConvertToPixel32(SrcPtr, DstPtr, Info, Image.Palette); - Inc(DstPtr); - Inc(SrcPtr, Bpp); -{$ELSE} //CompilerVersion > 23 - DstPtr:= @PAlphaColorArray(MapData.Data)[Y * (MapData.Pitch div 4)+X]; - ConvertToAlphaColorRec(SrcPtr, DstPtr, Info, Image.Palette); - Inc(SrcPtr, Bpp); -{$IFEND} - end; - end; - end; - end - else - begin - InitImage(TempImage); - CloneImage(Image, TempImage); - ConvertImage(TempImage, ifA8R8G8B8); - try - CopyRectToFmxBitmap(TempImage, Bitmap, SrcX, SrcY, Width, Height, DstX, DstY); - finally - FreeImage(TempImage); - end; - end; -{$IF (CompilerVersion > 23)} - Bitmap.UnMap(MapData); -{$ELSE} - Bitmap.UpdateHandles; - Bitmap.BitmapChanged; -{$IFEND} -end; - -procedure CopyRectToFmxBitmap(Image: TBaseImage; Bitmap: TBitmap; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -begin - CopyRectToFmxBitmap(Image.ImageDataPointer^, Bitmap, - SrcX, SrcY, Width, Height, DstX, DstY); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 Changes/Bug Fixes --------------------------------- - - Support for current FMX version (XE4+) contributed by Ken Schafer. - - -- 0.77 Changes/Bug Fixes ----------------------------------- - - Unit created with initial stuff, working with FMX1 in Delphi XE2. - } - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingGraphics32.pas b/3rd/Imaging/Extras/Extensions/ImagingGraphics32.pas deleted file mode 100644 index a64f24ef8..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingGraphics32.pas +++ /dev/null @@ -1,256 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ Unit functions for converting and copying images between Imaging and Graphics32 library.} -unit ImagingGraphics32; - -{$I ImagingOptions.inc} - -interface - -uses - Types, GR32, ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingClasses; - -{ Converts image from TImageData record to GR32's bitmap. Bitmap32 must be already - instantiated.} -procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -{ Converts image from TBaseImage instance to GR32's bitmap. Bitmap32 must be already - instantiated.} -procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); - -{ Converts image data from GR32's bitmap to TImageData record.} -procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -{ Converts image data from GR32's bitmap to existing TBaseImage instance.} -procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage); - -{ Copies pixels from TImageData record (with all the necessary conversion if - the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must - have the same width and height. } -procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -{ Copies pixels from TBaseImage instance (with all the necessary conversion if - the format is not 32bit) to existing GR32's bitmap. Both Image and Bitmap32 must - have the same width and height. } -procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); - -{ Copies rectangular area of pixels from TImageData record to existing GR32's bitmap.} -procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; -{ Copies rectangular area of pixels from TBaseImage instance to existing GR32's bitmap.} -procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); overload; - -{ Maps GR32 bitmap on TImageData record so that they'll both share - the same pixels in memory (Bitmap32.Bits and Image.Bits point to the same - memory address). Usefull if you wan to e.g. save Bitmap32 using Imaging - and don't want to needlesly duplicate the entire image in memory. - Note that you must not call FreeImage on Image after the mapping or - the memory of Bitmap32 would be freed too.} -procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); - -implementation - -procedure ConvertImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -begin - Assert(TestImage(Image)); - Bitmap32.SetSize(Image.Width, Image.Height); - CopyImageDataToBitmap32(Image, Bitmap32); -end; - -procedure ConvertImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); -begin - ConvertImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32); -end; - -procedure ConvertBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -begin - Assert(not Bitmap32.Empty); - NewImage(Bitmap32.Width, Bitmap32.Height, ifA8R8G8B8, Image); - Move(Bitmap32.Bits^, Image.Bits^, Image.Size); -end; - -procedure ConvertBitmap32ToImage(Bitmap32: TCustomBitmap32; Image: TBaseImage); -begin - ConvertBitmap32ToImageData(Bitmap32, Image.ImageDataPointer^); -end; - -procedure CopyImageDataToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32); -begin - Assert(TestImage(Image) and (Image.Width = Bitmap32.Width) and (Image.Height = Bitmap32.Height)); - CopyRectToBitmap32(Image, Bitmap32, 0, 0, Image.Width, Image.Height, 0, 0); -end; - -procedure CopyImageToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32); -begin - CopyImageDataToBitmap32(Image.ImageDataPointer^, Bitmap32); -end; - -procedure CopyRectToBitmap32(const Image: TImageData; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -var - TempImage: TImageData; - X, Y, Bpp, SrcWidthBytes, DstWidth, MoveBytes: Integer; - DstPtr: PColor32Rec; - SrcPtr: PByte; - Info: TImageFormatInfo; -begin - Assert(TestImage(Image) and not Bitmap32.Empty); - - ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, Image.Width, Image.Height, - Rect(0, 0, Bitmap32.Width, Bitmap32.Height)); - - if Image.Format in [ifIndex8, ifGray8, ifA8Gray8, ifGray16, ifR8G8B8, ifA8R8G8B8, - ifR16G16B16, ifA16R16G16B16] then - begin - GetImageFormatInfo(Image.Format, Info); - Bpp := Info.BytesPerPixel; - SrcWidthBytes := Image.Width * Bpp; - DstWidth := Bitmap32.Width; - MoveBytes := Width * Bpp; - SrcPtr := @PByteArray(Image.Bits)[SrcY * SrcWidthBytes + SrcX * Bpp]; - DstPtr := @PColor32RecArray(Bitmap32.Bits)[DstY * DstWidth + DstX]; - - for Y := 0 to Height - 1 do - begin - case Image.Format of - ifIndex8: - for X := 0 to Width - 1 do - begin - DstPtr^ := Image.Palette[SrcPtr^]; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifGray8: - for X := 0 to Width - 1 do - begin - DstPtr.R := SrcPtr^; - DstPtr.G := SrcPtr^; - DstPtr.B := SrcPtr^; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA8Gray8: - for X := 0 to Width - 1 do - begin - DstPtr.R := SrcPtr^; - DstPtr.G := SrcPtr^; - DstPtr.B := SrcPtr^; - DstPtr.A := PWordRec(SrcPtr).High; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifGray16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PWord(SrcPtr)^ shr 8; - DstPtr.G := DstPtr.R; - DstPtr.B := DstPtr.R; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifR8G8B8: - for X := 0 to Width - 1 do - begin - DstPtr.Color24Rec := PColor24Rec(SrcPtr)^; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA8R8G8B8: - begin - Move(SrcPtr^, DstPtr^, MoveBytes); - Inc(DstPtr, Width); - Inc(SrcPtr, MoveBytes); - end; - ifR16G16B16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PColor48Rec(SrcPtr).R shr 8; - DstPtr.G := PColor48Rec(SrcPtr).G shr 8; - DstPtr.B := PColor48Rec(SrcPtr).B shr 8; - DstPtr.A := 255; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - ifA16R16G16B16: - for X := 0 to Width - 1 do - begin - DstPtr.R := PColor64Rec(SrcPtr).R shr 8; - DstPtr.G := PColor64Rec(SrcPtr).G shr 8; - DstPtr.B := PColor64Rec(SrcPtr).B shr 8; - DstPtr.A := PColor64Rec(SrcPtr).A shr 8; - Inc(DstPtr); - Inc(SrcPtr, Bpp); - end; - end; - - Inc(SrcPtr, SrcWidthBytes - MoveBytes); - Inc(DstPtr, DstWidth - Width); - end; - end - else - begin - InitImage(TempImage); - CloneImage(Image, TempImage); - ConvertImage(TempImage, ifA8R8G8B8); - try - CopyRectToBitmap32(TempImage, Bitmap32, SrcX, SrcY, Width, Height, DstX, DstY); - finally - FreeImage(TempImage); - end; - end; -end; - -procedure CopyRectToBitmap32(Image: TBaseImage; Bitmap32: TCustomBitmap32; - SrcX, SrcY, Width, Height, DstX, DstY: Integer); -begin - CopyRectToBitmap32(Image.ImageDataPointer^, Bitmap32, - SrcX, SrcY, Width, Height, DstX, DstY); -end; - -procedure MapBitmap32ToImageData(Bitmap32: TCustomBitmap32; var Image: TImageData); -begin - Assert(not Bitmap32.Empty); - FreeImage(Image); - - Image.Width := Bitmap32.Width; - Image.Height := Bitmap32.Height; - Image.Format := ifA8R8G8B8; - Image.Size := Image.Width * Image.Height * 4; - - Image.Bits := Bitmap32.Bits; -end; - -{ - File Notes: - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Created with initial stuff. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingJpeg2000.pas b/3rd/Imaging/Extras/Extensions/ImagingJpeg2000.pas deleted file mode 100644 index dbeca970a..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingJpeg2000.pas +++ /dev/null @@ -1,628 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Jpeg 2000 images.} -unit ImagingJpeg2000; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingIO, ImagingUtility, - ImagingExtras, OpenJpeg; - -type - { Type Jpeg 2000 file (needed for OpenJPEG codec settings).} - TJpeg2000FileType = (jtInvalid, jtJP2, jtJ2K, jtJPT); - - { Class for loading/saving Jpeg 2000 images. It uses OpenJPEG library - compiled to object files and linked to Object Pascal program. Jpeg 2000 - supports wide variety of data formats. You can have arbitrary number - of components/channels, each with different bitdepth and optional - "signedness". Jpeg 2000 images can be lossy or lossless compressed. - - Imaging can load most data formats (except images - with componenet bitdepth > 16 => no Imaging data format equivalents). - Components with sample separation are loaded correctly, ICC profiles - or palettes are not used, YCbCr images are translated to RGB. - - You can set various options when saving Jpeg-2000 images. Look at - properties of TJpeg2000FileFormat for details.} - TJpeg2000FileFormat = class(TImageFileFormat) - private - FQuality: LongInt; - FCodeStreamOnly: LongBool; - FLosslessCompression: LongBool; - function GetFileType(Handle: TImagingHandle): TJpeg2000FileType; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Controls JPEG 2000 lossy compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Accessible trough - ImagingJpeg2000Quality option. Default value is 80.} - property Quality: LongInt read FQuality write FQuality; - { Controls whether JPEG 2000 image is saved with full file headers or just - as code stream. Default value is False. Accessible trough - ImagingJpeg2000CodeStreamOnly option.} - property CodeStreamOnly: LongBool read FCodeStreamOnly write FCodeStreamOnly; - { Specifies JPEG 2000 image compression type. If True, saved JPEG 2000 files - will be losslessly compressed. Otherwise lossy compression is used. - Default value is False. Accessible trough - ImagingJpeg2000LosslessCompression option.} - property LosslessCompression: LongBool read FLosslessCompression write FLosslessCompression; - end; - -implementation - -const - SJpeg2000FormatName = 'JPEG 2000 Image'; - SJpeg2000Masks = '*.jp2,*.j2k,*.j2c,*.jpx,*.jpc'; - Jpeg2000SupportedFormats: TImageFormats = [ifGray8, ifGray16, - ifA8Gray8, ifA16Gray16, ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16]; - Jpeg2000DefaultQuality = 80; - Jpeg2000DefaultCodeStreamOnly = False; - Jpeg2000DefaultLosslessCompression = False; - -const - JP2Signature: TChar8 = #0#0#0#$0C#$6A#$50#$20#$20; - J2KSignature: TChar4 = #$FF#$4F#$FF#$51; - -procedure TJpeg2000FileFormat.Define; -begin - inherited; - FName := SJpeg2000FormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := Jpeg2000SupportedFormats; - - FQuality := Jpeg2000DefaultQuality; - FCodeStreamOnly := Jpeg2000DefaultCodeStreamOnly; - FLosslessCompression := Jpeg2000DefaultLosslessCompression; - - AddMasks(SJpeg2000Masks); - RegisterOption(ImagingJpeg2000Quality, @FQuality); - RegisterOption(ImagingJpeg2000CodeStreamOnly, @FCodeStreamOnly); - RegisterOption(ImagingJpeg2000LosslessCompression, @FLosslessCompression); -end; - -procedure TJpeg2000FileFormat.CheckOptionsValidity; -begin - // Check if option values are valid - if not (FQuality in [1..100]) then - FQuality := Jpeg2000DefaultQuality; -end; - -function TJpeg2000FileFormat.GetFileType(Handle: TImagingHandle): TJpeg2000FileType; -var - ReadCount: LongInt; - Id: TChar8; -begin - Result := jtInvalid; - with GetIO do - begin - ReadCount := Read(Handle, @Id, SizeOf(Id)); - if ReadCount = SizeOf(Id) then - begin - // Check if we have full JP2 file format or just J2K code stream - if CompareMem(@Id, @JP2Signature, SizeOf(JP2Signature)) then - Result := jtJP2 - else if CompareMem(@Id, @J2KSignature, SizeOf(J2KSignature)) then - Result := jtJ2K; - end; - Seek(Handle, -ReadCount, smFromCurrent); - end; -end; - -function TJpeg2000FileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -type - TChannelInfo = record - DestOffset: Integer; - CompType: OPJ_COMPONENT_TYPE; - Shift: Integer; - SrcMaxValue: Integer; - DestMaxValue: Integer; - end; -var - FileType: TJpeg2000FileType; - Buffer: PByte; - BufferSize, ChannelSize, I: Integer; - Info: TImageFormatInfo; - dinfo: popj_dinfo_t; - parameters: opj_dparameters_t; - cio: popj_cio_t; - image: popj_image_t; - StartPos: Int64; - Channels: array of TChannelInfo; - - procedure WriteSample(Dest: PByte; ChannelSize, Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - begin - case ChannelSize of - 1: Dest^ := Value; - 2: PWord(Dest)^ := Value; - 4: PLongWord(Dest)^ := Value; - end; - end; - - procedure CopySample(Src, Dest: PByte; ChannelSize: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - begin - case ChannelSize of - 1: Dest^ := Src^; - 2: PWord(Dest)^ := PWord(Src)^; - 4: PLongWord(Dest)^ := PLongWord(Src)^; - end; - end; - - procedure ReadChannel(const Image: TImageData; const Info: TChannelInfo; const Comp: opj_image_comp; BytesPerPixel: Integer); - var - X, Y, SX, SY, SrcIdx, LineBytes: Integer; - DestPtr, NewPtr, LineUpPtr: PByte; - DontScaleSamples: Boolean; - begin - DontScaleSamples := Info.SrcMaxValue = Info.DestMaxValue; - LineBytes := Image.Width * BytesPerPixel; - DestPtr := @PByteArray(Image.Bits)[Info.DestOffset]; - SrcIdx := 0; - - if (Comp.dx = 1) and (Comp.dy = 1) then - begin - // X and Y sample separation is 1 so just need to assign component values - // to image pixels one by one - for Y := 0 to Image.Height * Image.Width - 1 do - begin - if DontScaleSamples then - WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift) - else - WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue)); - - Inc(SrcIdx); - Inc(DestPtr, BytesPerPixel); - end; - end - else - begin - // Sample separation is active - component is sub-sampled. Real component - // dimensions are [Comp.w * Comp.dx, Comp.h * Comp.dy] - for Y := 0 to Comp.h - 1 do - begin - LineUpPtr := @PByteArray(Image.Bits)[Y * Comp.dy * LineBytes + Info.DestOffset]; - DestPtr := LineUpPtr; - - for X := 0 to Comp.w - 1 do - begin - if DontScaleSamples then - WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift) - else - WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue)); - - NewPtr := DestPtr; - - for SX := 1 to Comp.dx - 1 do - begin - if X * Comp.dx + SX >= Image.Width then Break; - // Replicate pixels on line - Inc(NewPtr, BytesPerPixel); - CopySample(DestPtr, NewPtr, ChannelSize); - end; - - Inc(SrcIdx); - Inc(DestPtr, BytesPerPixel * Comp.dx); - end; - - for SY := 1 to Comp.dy - 1 do - begin - if Y * Comp.dy + SY >= Image.Height then Break; - // Replicate line - NewPtr := @PByteArray(Image.Bits)[(Y * Comp.dy + SY) * LineBytes + Info.DestOffset]; - for X := 0 to Image.Width - 1 do - begin - CopySample(LineUpPtr, NewPtr, ChannelSize); - Inc(LineUpPtr, BytesPerPixel); - Inc(NewPtr, BytesPerPixel); - end; - end; - end; - end; - end; - - procedure ConvertYCbCrToRGB(Pixels: PByte; NumPixels, BytesPerPixel: Integer); - var - I: Integer; - PixPtr: PByte; - CY, CB, CR: Byte; - CYW, CBW, CRW: Word; - begin - PixPtr := Pixels; - for I := 0 to NumPixels - 1 do - begin - if BytesPerPixel in [3, 4] then - with PColor24Rec(PixPtr)^ do - begin - CY := R; - CB := G; - CR := B; - YCbCrToRGB(CY, CB, CR, R, G, B); - end - else - with PColor48Rec(PixPtr)^ do - begin - CYW := R; - CBW := G; - CRW := B; - YCbCrToRGB16(CYW, CBW, CRW, R, G, B); - end; - Inc(PixPtr, BytesPerPixel); - end; - end; - -begin - Result := False; - image := nil; - cio := nil; - opj_set_default_decoder_parameters(@parameters); - // Determine which codec to use - FileType := GetFileType(Handle); - case FileType of - jtJP2: dinfo := opj_create_decompress(CODEC_JP2); - jtJ2K: dinfo := opj_create_decompress(CODEC_J2K); - jtJPT: dinfo := opj_create_decompress(CODEC_JPT); - else - Exit; - end; - // Set event manager to nil to avoid getting messages - dinfo.event_mgr := nil; - // Currently OpenJPEG can load images only from memory so we have to - // preload whole input to mem buffer. Not good but no other way now. - // At least we set stream pos to end of JP2 data after loading (we will now - // the exact size by then). - StartPos := GetIO.Tell(Handle); - BufferSize := ImagingIO.GetInputSize(GetIO, Handle); - GetMem(Buffer, BufferSize); - - SetLength(Images, 1); - with GetIO, Images[0] do - try - Read(Handle, Buffer, BufferSize); - cio := opj_cio_open(opj_common_ptr(dinfo), Buffer, BufferSize); - opj_setup_decoder(dinfo, @parameters); - // Decode image - image := opj_decode(dinfo, cio); - if image = nil then - Exit; - - // Determine which Imaging data format to use accorsing to - // decoded image components - case image.numcomps of - 2: case image.comps[0].prec of - 1..8: Format := ifA8Gray8; - 9..16: Format := ifA16Gray16; - end; - 3: case image.comps[0].prec of - 1..8: Format := ifR8G8B8; - 9..16: Format := ifR16G16B16; - end; - 4: case image.comps[0].prec of - 1..8: Format := ifA8R8G8B8; - 9..16: Format := ifA16R16G16B16; - end; - else - // There is only one component or there is more than four => - // just load the first one as gray - case image.comps[0].prec of - 1..8: Format := ifGray8; - 9..16: Format := ifGray16; - 17..32: Format := ifGray32; - end; - end; - // Exit if no compatible format was found - if Format = ifUnknown then - Exit; - - NewImage(image.x1 - image.x0, image.y1 - image.y0, Format, Images[0]); - Info := GetFormatInfo(Format); - ChannelSize := Info.BytesPerPixel div Info.ChannelCount; - SetLength(Channels, Info.ChannelCount); - - // Get information about all channels/components of JP2 file - for I := 0 to Info.ChannelCount - 1 do - begin - // Get component type for this channel and based on this - // determine where in dest image bits write this channel's data - Channels[I].CompType := image.comps[I].comp_type; - case Channels[I].CompType of - COMPTYPE_UNKNOWN: - begin - if Info.ChannelCount <> 4 then - begin - // Missing CDEF box in file - usually BGR order - Channels[I].DestOffset := image.numcomps - I - 1 - end - else - begin - // Missing CDEF box in file - usually ABGR order - if I = 3 then - Channels[I].DestOffset := 3 - else - Channels[I].DestOffset := image.numcomps - I - 2 - end; - end; - COMPTYPE_R: Channels[I].DestOffset := 2; - COMPTYPE_G: Channels[I].DestOffset := 1; - COMPTYPE_B: Channels[I].DestOffset := 0; - COMPTYPE_CB: Channels[I].DestOffset := 1; - COMPTYPE_CR: Channels[I].DestOffset := 0; - COMPTYPE_OPACITY: Channels[I].DestOffset := 3; - COMPTYPE_Y: - case image.color_space of - CLRSPC_SYCC: Channels[I].DestOffset := 2; // Y is intensity part of YCC - CLRSPC_GRAY: Channels[I].DestOffset := 0; // Y is independent gray channel - end; - end; - // Scale channel offset - Channels[I].DestOffset := Channels[I].DestOffset * ChannelSize; - // Signed componets must be scaled to [0, 1] interval (depends on precision) - if image.comps[I].sgnd = 1 then - Channels[I].Shift := 1 shl (image.comps[I].prec - 1); - // Max channel values used to easier scaling of precisions - // not supported by Imaging to supported ones (like 12bits etc.). - Channels[I].SrcMaxValue := 1 shl image.comps[I].prec - 1; - Channels[I].DestMaxValue := 1 shl (ChannelSize * 8) - 1; - end; - - // Images components are stored separately in JP2, each can have - // different dimensions, bitdepth, ... - for I := 0 to Info.ChannelCount - 1 do - ReadChannel(Images[0], Channels[I], image.comps[I], Info.BytesPerPixel); - - // If we have YCbCr image we need to convert it to RGB - if (image.color_space = CLRSPC_SYCC) and (Info.ChannelCount in [3, 4]) then - ConvertYCbCrToRGB(Bits, Width * Height, Info.BytesPerPixel); - - // Set the input position just after end of image - Seek(Handle, StartPos + Cardinal(cio.bp) - Cardinal(cio.start), smFromBeginning); - - Result := True; - finally - opj_image_destroy(image); - opj_destroy_decompress(dinfo); - opj_cio_close(cio); - FreeMem(Buffer); - end; -end; - -function TJpeg2000FileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - TargetSize, Rate: Single; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Info: TImageFormatInfo; - I, Z, InvZ, Channel, ChannelSize, NumPixels: Integer; - Pix: PByte; - image: popj_image_t; - cio: popj_cio_t; - cinfo: popj_cinfo_t; - parameters: opj_cparameters_t; - compparams: popj_image_cmptparm_array; - ColorSpace: OPJ_COLOR_SPACE; - - function GetComponentType(Comp: Integer): OPJ_COMPONENT_TYPE; - begin - if Info.HasAlphaChannel and (Comp = Info.ChannelCount - 1) then - Result := COMPTYPE_OPACITY - else if Info.HasGrayChannel then - Result := COMPTYPE_Y - else if Comp = 2 then - Result := COMPTYPE_B - else if Comp = 1 then - Result := COMPTYPE_G - else if Comp = 0 then - Result := COMPTYPE_R - else - Result := COMPTYPE_UNKNOWN; - end; - -begin - Result := False; - image := nil; - compparams := nil; - cinfo := nil; - cio := nil; - // Makes image to save compatible with Jpeg 2000 saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - ChannelSize := Info.BytesPerPixel div Info.ChannelCount; - - // Fill component info structures and then create OpenJPEG image - GetMem(compparams, Info.ChannelCount * SizeOf(opj_image_comptparm)); - for I := 0 to Info.ChannelCount - 1 do - with compparams[I] do - begin - dx := 1; - dy := 1; - w := Width; - h := Height; - prec := (Info.BytesPerPixel div Info.ChannelCount) * 8; - bpp := prec; - sgnd := 0; - comp_type := GetComponentType(I); - x0 := 0; - y0 := 0; - end; - - if Info.HasGrayChannel then - ColorSpace := CLRSPC_GRAY - else - ColorSpace := CLRSPC_SRGB; - - image := opj_image_create(Info.ChannelCount, @compparams[0], ColorSpace); - if image = nil then Exit; - image.x1 := Width; - image.y1 := Height; - - if FCodeStreamOnly then - cinfo := opj_create_compress(CODEC_J2K) - else - cinfo := opj_create_compress(CODEC_JP2); - - // Set event manager to nil to avoid getting messages - cinfo.event_mgr := nil; - // Set compression parameters based current file format properties - opj_set_default_encoder_parameters(@parameters); - parameters.cod_format := Iff(FCodeStreamOnly, 0, 1); - parameters.numresolution := 6; - parameters.tcp_numlayers := 1; - parameters.cp_disto_alloc := 1; - if FLosslessCompression then - begin - // Set rate to 0 -> lossless - parameters.tcp_rates[0] := 0; - end - else - begin - // Quality -> Rate computation taken from ImageMagick - Rate := 100.0 / Sqr(115 - FQuality); - NumPixels := Width * Height * Info.BytesPerPixel; - TargetSize := (NumPixels * Rate) + 550 + (Info.ChannelCount - 1) * 142; - parameters.tcp_rates[0] := 1.0 / (TargetSize / NumPixels); - end; - // Setup encoder - opj_setup_encoder(cinfo, @parameters, image); - - // Fill component samples in data with values taken from - // image pixels. - // Components should be ordered like this: RGBA, YA, RGB, etc. - for Channel := 0 to Info.ChannelCount - 1 do - begin - Z := Channel; - InvZ := Info.ChannelCount - 1 - Z; - if Info.HasAlphaChannel then - begin - if Channel = Info.ChannelCount - 1 then - InvZ := Z - else - InvZ := Info.ChannelCount - 2 - Z; - end; - Pix := @PByteArray(Bits)[InvZ * ChannelSize]; - for I := 0 to Width * Height - 1 do - begin - case ChannelSize of - 1: image.comps[Z].data[I] := Pix^; - 2: image.comps[Z].data[I] := PWord(Pix)^; - 4: LongWord(image.comps[Z].data[I]) := PLongWord(Pix)^; - end; - Inc(Pix, Info.BytesPerPixel); - end; - end; - - // Open OpenJPEG output - cio := opj_cio_open(opj_common_ptr(cinfo), nil, 0); - // Try to encode the image - if not opj_encode(cinfo, cio, image, nil) then - Exit; - // Finally write buffer with encoded image to output - Write(Handle, cio.buffer, cio_tell(cio)); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - opj_destroy_compress(cinfo); - opj_image_destroy(image); - opj_cio_close(cio); - FreeMem(compparams); - end; -end; - -procedure TJpeg2000FileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - ConvFormat := IffFormat(Info.ChannelCount = 1, ifGray16, ifA16R16G16B16) - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16) - else if Info.IsIndexed then - ConvFormat := ifA8R8G8B8 - else if Info.BytesPerPixel div Info.ChannelCount > 1 then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -function TJpeg2000FileFormat.TestFormat(Handle: TImagingHandle): Boolean; -begin - Result := False; - if Handle <> nil then - Result := GetFileType(Handle) <> jtInvalid; -end; - -initialization - RegisterImageFileFormat(TJpeg2000FileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Rewritten JP2 loading part (based on PasJpeg2000) to be - more readable (it's a bit faster too) and handled more JP2 files better: - components with precisions like 12bit (not direct Imaging equivalent) - are properly scaled, images/components with offsets are loaded ok. - - -- 0.24.3 Changes/Bug Fixes ----------------------------------- - - Alpha channels are now saved properly in FPC (GCC optimization issue), - FPC lossy compression enabled again! - - Added handling of component types (CDEF Box), JP2 images with alpha - are now properly recognized by other applications. - - Fixed wrong color space when saving grayscale images - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Removed ifGray32 from supported formats, OpenJPEG crashes when saving them. - - Added Seek after loading to set input pos to the end of image. - - Saving added losy/lossless, quality option added. - - Initial loading-only version created. - -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingJpegIJL.pas b/3rd/Imaging/Extras/Extensions/ImagingJpegIJL.pas deleted file mode 100644 index 67fed22ba..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingJpegIJL.pas +++ /dev/null @@ -1,447 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format alternative loader/saver for Jpeg images - using Intel Jpeg Library (Win32 only).} -unit ImagingJpegIJL; - -{$I ImagingOptions.inc} - -{$IFNDEF WIN32} - {$ERROR 'IJL 1.5 only for Win32'} -{$ENDIF} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingUtility, ImagingIO; - -type - { Class for loading/saving Jpeg images. This is alternative to - default built-in Jpeg handler (which uses JpegLib). - This handler uses Intel Jpeg Library 1.5 (DLL needed) and is - much faster than JpegLib (2-4x). Also supports reading and writing of - alpha channels in Jpeg files.} - TJpegFileFormatIJL = class(TImageFileFormat) - private - FQuality: LongInt; - procedure JpegError(Code: Integer); - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Controls Jpeg save compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Accessible trough - ImagingJpegQuality option.} - property Quality: LongInt read FQuality write FQuality; - end; - -implementation - -{$MINENUMSIZE 4} // Min enum size: 4 B - -uses - Types; - -const - SJpegFormatName = 'JPEG Image (IJL)'; - SJpegMasks = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif,*.jpa'; - JpegSupportedFormats: TImageFormats = [ifGray8, ifR8G8B8, ifA8R8G8B8]; - JpegDefaultQuality = 90; - JpegDefaultProgressive = False; - -resourcestring - SJpegError = 'JPEG Error'; - -const - { Jpeg file identifiers.} - JpegMagic: TChar2 = #$FF#$D8; - SIJLLibrary = 'ijl15.dll'; - -const - IJL_SETUP = -1; - IJL_OK = 0; - IJL_NONE = 0; - IJL_OTHER = 255; - JBUFSIZE = 4096; // Size of file I/O buffer (4K). - -type - { - Purpose: Possible types of data read/write/other operations to be - performed by the functions IJL_Read and IJL_Write. - See the Developer's Guide for details on appropriate usage. - Fields: - IJL_JFILE_XXXXXXX Indicates JPEG data in a stdio file. - IJL_JBUFF_XXXXXXX Indicates JPEG data in an addressable buffer. - } - TIJLIOType = ( - // Read JPEG parameters (i.e., height, width, channels, sampling, etc.) - // from a JPEG bit stream. - IJL_JFILE_READPARAMS = 0, - IJL_JBUFF_READPARAMS = 1, - // Read a JPEG Interchange Format image. - IJL_JFILE_READWHOLEIMAGE = 2, - IJL_JBUFF_READWHOLEIMAGE = 3, - // Read JPEG tables from a JPEG Abbreviated Format bit stream. - IJL_JFILE_READHEADER = 4, - IJL_JBUFF_READHEADER = 5, - // Read image info from a JPEG Abbreviated Format bit stream. - IJL_JFILE_READENTROPY = 6, - IJL_JBUFF_READENTROPY = 7, - // Write an entire JFIF bit stream. - IJL_JFILE_WRITEWHOLEIMAGE = 8, - IJL_JBUFF_WRITEWHOLEIMAGE = 9, - // Write a JPEG Abbreviated Format bit stream. - IJL_JFILE_WRITEHEADER = 10, - IJL_JBUFF_WRITEHEADER = 11, - // Write image info to a JPEG Abbreviated Format bit stream. - IJL_JFILE_WRITEENTROPY = 12, - IJL_JBUFF_WRITEENTROPY = 13, - - // Scaled Decoding Options: - // Reads a JPEG image scaled to 1/2 size. - IJL_JFILE_READONEHALF = 14, - IJL_JBUFF_READONEHALF = 15, - // Reads a JPEG image scaled to 1/4 size. - IJL_JFILE_READONEQUARTER = 16, - IJL_JBUFF_READONEQUARTER = 17, - // Reads a JPEG image scaled to 1/8 size. - IJL_JFILE_READONEEIGHTH = 18, - IJL_JBUFF_READONEEIGHTH = 19, - // Reads an embedded thumbnail from a JFIF bit stream. - IJL_JFILE_READTHUMBNAIL = 20, - IJL_JBUFF_READTHUMBNAIL = 21 - ); - - { - Purpose: Possible color space formats. - Note these formats do *not* necessarily denote - the number of channels in the color space. - There exists separate "channel" fields in the - JPEG_CORE_PROPERTIES data structure specifically - for indicating the number of channels in the - JPEG and/or DIB color spaces.} - TIJL_COLOR = ( - IJL_RGB = 1, // Red-Green-Blue color space. - IJL_BGR = 2, // Reversed channel ordering from IJL_RGB. - IJL_YCBCR = 3, // Luminance-Chrominance color space as defined - // by CCIR Recommendation 601. - IJL_G = 4, // Grayscale color space. - IJL_RGBA_FPX = 5, // FlashPix RGB 4 channel color space that - // has pre-multiplied opacity. - IJL_YCBCRA_FPX = 6 // FlashPix YCbCr 4 channel color space that - // has pre-multiplied opacity. - //IJL_OTHER = 255 // Some other color space not defined by the IJL. - // (This means no color space conversion will - // be done by the IJL.) - ); - - { Purpose: Possible subsampling formats used in the JPEG.} - TIJL_JPGSUBSAMPLING = ( - IJL_NOSUBSAMP = 0, - IJL_411 = 1, // Valid on a JPEG w/ 3 channels. - IJL_422 = 2, // Valid on a JPEG w/ 3 channels. - IJL_4114 = 3, // Valid on a JPEG w/ 4 channels. - IJL_4224 = 4 // Valid on a JPEG w/ 4 channels. - ); - - { Purpose: Possible subsampling formats used in the DIB. } - TIJL_DIBSUBSAMPLING = TIJL_JPGSUBSAMPLING; - - { Purpose: This is the primary data structure between the IJL and - the external user. It stores JPEG state information - and controls the IJL. It is user-modifiable. - Context: Used by all low-level IJL routines to store - pseudo-global information.} - TJpegCoreProperties = packed record - UseJPEGPROPERTIES : LongBool; // default = 0 - // DIB specific I/O data specifiers. - DIBBytes : PByte; // default = NULL - DIBWidth : LongWord; // default = 0 - DIBHeight : LongWord; // default = 0 - DIBPadBytes : LongWord; // default = 0 - DIBChannels : LongWord; // default = 3 - DIBColor : TIJL_COLOR; // default = IJL_BGR - DIBSubsampling : TIJL_DIBSUBSAMPLING; // default = IJL_NONE - // JPEG specific I/O data specifiers. - JPGFile : PAnsiChar; // default = NULL - JPGBytes : PByte; // default = NULL - JPGSizeBytes : LongWord; // default = 0 - JPGWidth : LongWord; // default = 0 - JPGHeight : LongWord; // default = 0 - JPGChannels : LongWord; // default = 3 - JPGColor : TIJL_COLOR; // default = IJL_YCBCR - JPGSubsampling : TIJL_JPGSUBSAMPLING; // default = IJL_411 - JPGThumbWidth : LongWord; // default = 0 - JPGThumbHeight : LongWord; // default = 0 - // JPEG conversion properties. - NeedsConvert : LongBool; // default = TRUE - NeedsResample : LongBool; // default = TRUE - Quality : LongWord; // default = 75 - // Low-level properties. - PropsAndUnused : array[0..19987] of Byte; - end; - PJpegCoreProperties = ^TJpegCoreProperties; - -function ijlInit(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary; -function ijlFree(var Props: TJpegCoreProperties): Integer; stdcall; external SIJLLibrary; -function ijlRead(var Props: TJpegCoreProperties; IoType : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary; -function ijlWrite(var Props: TJpegCoreProperties; IoType : TIJLIOTYPE): Integer; stdcall; external SIJLLibrary; -function ijlErrorStr(Code : Integer) : PAnsiChar; stdcall; external SIJLLibrary; - -{ TJpegFileFormatIJL class implementation } - -procedure TJpegFileFormatIJL.Define; -begin - inherited; - FName := SJpegFormatName; - FCanLoad := True; - FCanSave := True; - FIsMultiImageFormat := False; - FSupportedFormats := JpegSupportedFormats; - - FQuality := JpegDefaultQuality; - - AddMasks(SJpegMasks); - RegisterOption(ImagingJpegQuality, @FQuality); -end; - -procedure TJpegFileFormatIJL.CheckOptionsValidity; -begin - // Check if option values are valid - if not (FQuality in [1..100]) then - FQuality := JpegDefaultQuality; -end; - -procedure TJpegFileFormatIJL.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - if Info.HasAlphaChannel then - ConvertImage(Image, ifA8R8G8B8) - else if Info.HasGrayChannel then - ConvertImage(Image, ifGray8) - else - ConvertImage(Image, ifR8G8B8); -end; - -function TJpegFileFormatIJL.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - ID: array[0..9] of AnsiChar; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(ID, SizeOf(ID), 0); - ReadCount := Read(Handle, @ID, SizeOf(ID)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(ID)) and - CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic)); - end; -end; - -procedure TJpegFileFormatIJL.JpegError(Code: Integer); -begin - raise EImagingError.Create(SJpegError + ': ' + ijlErrorStr(Code)); -end; - -function TJpegFileFormatIJL.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Props: TJpegCoreProperties; - Status: Integer; - Buffer: TDynByteArray; - InputLen: Integer; - JpegFmt: TImageFormat; -begin - // Copy IO functions to global var used in JpegLib callbacks - Result := False; - SetLength(Images, 1); - - with Images[0] do - try - InputLen := GetInputSize(GetIO, Handle); - - Status := IjlInit(Props); - if Status = IJL_OK then - begin - // Load input to memory and read Jpeg props - SetLength(Buffer, InputLen); - Props.JPGSizeBytes := InputLen; - Props.JPGBytes := @Buffer[0]; - GetIO.Read(Handle, @Buffer[0], InputLen); - Status := ijlRead(Props, IJL_JBUFF_READPARAMS); - end; - - if Status = IJL_OK then - begin - // Set image and DIB props based on Jpeg params read from input - case Props.JPGChannels of - 1: - begin - JpegFmt := ifGray8; - Props.DIBColor := IJL_G; - end; - 3: - begin - JpegFmt := ifR8G8B8; - Props.DIBColor := IJL_BGR; - end; - 4: - begin - JpegFmt := ifA8R8G8B8; - Props.DIBColor := IJL_RGBA_FPX; - end - else - Exit; - end; - - NewImage(Props.JPGWidth, Props.JPGHeight, JpegFmt, Images[0]); - - Props.DIBWidth := Props.JPGWidth; - Props.DIBHeight := Props.JPGHeight; - Props.DIBChannels := Props.JPGChannels; - Props.DIBPadBytes := 0; - Props.DIBBytes := Bits; - - // Now read the image bits - Status := ijlRead(Props, IJL_JBUFF_READWHOLEIMAGE); - end; - - if Status <> IJL_OK then - JpegError(Status); - - // Decoded images with alpha are in ABGR format so R and B chanels are switched - if JpegFmt = ifA8R8G8B8 then - SwapChannels(Images[0], ChannelRed, ChannelBlue); - - Result := True; - finally - ijlFree(Props); - end; -end; - -function TJpegFileFormatIJL.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Props: TJpegCoreProperties; - Status: Integer; - Info: TImageFormatInfo; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Buffer: TDynByteArray; -begin - Result := False; - // Makes image to save compatible with Jpeg saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with ImageToSave do - try - Status := ijlInit(Props); - if Status = IJL_OK then - begin - Info := GetFormatInfo(Format); - // Set all the needed props - Props.DIBWidth := Width; - Props.DIBHeight := Height; - Props.DIBChannels := Info.ChannelCount; - Props.DIBPadBytes := 0; - Props.DIBBytes := Bits; - - Props.Quality := FQuality; - - Props.JPGWidth := Width; - Props.JPGHeight := Height; - Props.JPGChannels := Info.ChannelCount; - SetLength(Buffer, Size); - Props.JPGSizeBytes := Size; - Props.JPGBytes := @Buffer[0]; - - case Info.ChannelCount of - 1: - begin - Props.DIBColor := IJL_G; - Props.JPGColor := IJL_G; - Props.JPGSubsampling := IJL_NOSUBSAMP; - end; - 3: - begin - Props.DIBColor := IJL_BGR; - Props.JPGColor := IJL_YCBCR; - Props.JPGSubsampling := IJL_411; - end; - 4: - begin - Props.DIBColor := IJL_RGBA_FPX; - Props.JPGColor := IJL_YCBCRA_FPX; - Props.JPGSubsampling := IJL_4114; - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // IJL expects ABGR order - end; - end; - - // Encode image - Status := ijlWrite(Props, IJL_JBUFF_WRITEWHOLEIMAGE); - end; - - if Status <> IJL_OK then - JpegError(Status); - - // Write temp buffer to file - GetIO.Write(Handle, @Buffer[0], Props.JPGSizeBytes); - - Result := True; - finally - ijlFree(Props); - if MustBeFreed then - FreeImage(ImageToSave) - else if Format = ifA8R8G8B8 then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); // Swap image back to ARGB if not temp - end; -end; - -initialization - RegisterImageFileFormat(TJpegFileFormatIJL); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Initial version created. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingLibTiffDelphi.pas b/3rd/Imaging/Extras/Extensions/ImagingLibTiffDelphi.pas deleted file mode 100644 index b7701d306..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingLibTiffDelphi.pas +++ /dev/null @@ -1,605 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for TIFF images - using LibTiff C library compiled to object files for Delphi.} -unit ImagingLibTiffDelphi; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Imaging, ImagingTypes, ImagingUtility, ImagingIO, ImagingExtras, - LibTiffDelphi; - -type - { TIFF (Tag Image File Format) loader/saver class. Uses LibTiff so - it can handle most types of TIFF files.} - TTiffFileFormat = class(TImageFileFormat) - private - FCompression: Integer; - FJpegQuality: Integer; - FAppendMode: LongBool; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: Integer): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - { Specifies compression scheme used when saving TIFF images. Supported values - are 0 (Uncompressed), 1 (LZW), 2 (PackBits RLE), 3 (Deflate - ZLib), 4 (JPEG), - 5 (CCITT Group 4 fax encoding - for binary images only). - Default is 1 (LZW). Note that not all images can be stored with - JPEG compression - these images will be saved with default compression if - JPEG is set.} - property Compression: Integer read FCompression write FCompression; - { Controls compression quality when selected TIFF compression is Jpeg. - It is number in range 1..100. 1 means small/ugly file, - 100 means large/nice file. Accessible trough ImagingTiffJpegQuality option.} - property JpegQuality: Integer read FJpegQuality write FJpegQuality; - { When activated (True = 1) existing TIFF files are not overwritten when saving but - new images are instead appended thus producing multipage TIFFs. - Default value is False (0).} - property AppendMode: LongBool read FAppendMode write FAppendMode; - end; - -implementation - -const - STiffFormatName = 'Tagged Image File Format'; - STiffMasks = '*.tif,*.tiff'; - TiffSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, - ifGray16, ifA16Gray16, ifGray32, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, - ifA16R16G16B16, ifR32F, ifA32R32G32B32F, ifR16F, ifA16R16G16B16F, ifBinary]; - TiffDefaultCompression = 1; - TiffDefaultJpegQuality = 90; - TiffDefaultAppendMode = False; - -const - TiffBEMagic: TChar4 = 'MM'#0#42; - TiffLEMagic: TChar4 = 'II'#42#0; - -type - TTiffIOWrapper = record - IO: TIOFunctions; - Handle: TImagingHandle; - end; - PTiffIOWrapper = ^TTiffIOWrapper; - -function TIFFReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - Result := PTiffIOWrapper(Fd).IO.Read(PTiffIOWrapper(Fd).Handle, Buffer, Size); -end; - -function TIFFWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - Result := PTiffIOWrapper(Fd).IO.Write(PTiffIOWrapper(Fd).Handle, Buffer, Size); -end; - -function TIFFSizeProc(Fd: Cardinal): Cardinal; cdecl; -begin - Result := ImagingIO.GetInputSize(PTiffIOWrapper(Fd).IO, PTiffIOWrapper(Fd).Handle); -end; - -function TIFFSeekProc(Fd: Cardinal; Offset: Cardinal; Where: Integer): Cardinal; cdecl; -const - SEEK_SET = 0; - SEEK_CUR = 1; - SEEK_END = 2; -var - Mode: TSeekMode; -begin - if Offset = $FFFFFFFF then - begin - Result := $FFFFFFFF; - Exit; - end; - case Where of - SEEK_SET: Mode := smFromBeginning; - SEEK_CUR: Mode := smFromCurrent; - SEEK_END: Mode := smFromEnd; - else - Mode := smFromBeginning; - end; - Result := PTiffIOWrapper(Fd).IO.Seek(PTiffIOWrapper(Fd).Handle, Offset, Mode); -end; - -function TIFFCloseProc(Fd: Cardinal): Integer; cdecl; -begin - Result := 0; -end; - -function TIFFNoMapProc(Fd: Cardinal; Base: PPointer; Size: PCardinal): Integer; cdecl; -begin - Result := 0; -end; - -procedure TIFFNoUnmapProc(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl; -begin -end; - -var - LastError: string = 'None'; - -procedure TIFFErrorHandler(const A, B: AnsiString); -begin - LastError := string(A + ': ' + B); -end; - -{ - TTiffFileFormat implementation -} - -procedure TTiffFileFormat.Define; -begin - inherited; - FName := STiffFormatName; - FFeatures := [ffLoad, ffSave, ffMultiImage, ffReadOnSave { needed for Append mode }]; - FSupportedFormats := TiffSupportedFormats; - FCompression := TiffDefaultCompression; - FJpegQuality := TiffDefaultJpegQuality; - FAppendMode := TiffDefaultAppendMode; - - AddMasks(STiffMasks); - RegisterOption(ImagingTiffCompression, @FCompression); - RegisterOption(ImagingTiffJpegQuality, @FJpegQuality); - RegisterOption(ImagingTiffAppendMode, @FAppendMode); -end; - -function TTiffFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Tiff: PTIFF; - IOWrapper: TTiffIOWrapper; - I, Idx, TiffResult, ScanLineSize, NumDirectories, X: Integer; - RowsPerStrip: LongWord; - Orientation, BitsPerSample, SamplesPerPixel, Photometric, - PlanarConfig, SampleFormat: Word; - DataFormat: TImageFormat; - CanAccessScanlines: Boolean; - Ptr: PByte; - Red, Green, Blue: PWordRecArray; - - procedure LoadMetadata(Tiff: PTiff; TiffPage: Integer); - var - TiffResUnit: Word; - XRes, YRes: Single; - ResUnit: TResolutionUnit; - begin - TIFFGetFieldDefaulted(Tiff, TIFFTAG_RESOLUTIONUNIT, @TiffResUnit); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_XRESOLUTION, @XRes); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_YRESOLUTION, @YRes); - if (TiffResUnit <> RESUNIT_NONE) and (XRes >= 0.1) and (YRes >= 0.1) then - begin - ResUnit := ruDpi; - if TiffResUnit = RESUNIT_CENTIMETER then - ResUnit := ruDpcm; - FMetadata.SetPhysicalPixelSize(ResUnit, XRes, YRes, False, TiffPage); - end; - end; - -begin - Result := False; - LibTiffDelphiSetErrorHandler(TIFFErrorHandler); - - // Set up IO wrapper and open TIFF - IOWrapper.IO := GetIO; - IOWrapper.Handle := Handle; - - Tiff := TIFFClientOpen('LibTIFF', 'r', Cardinal(@IOWrapper), @TIFFReadProc, - @TIFFWriteProc, @TIFFSeekProc, @TIFFCloseProc, - @TIFFSizeProc, @TIFFNoMapProc, @TIFFNoUnmapProc); - - if Tiff <> nil then - TIFFSetFileNo(Tiff, Cardinal(@IOWrapper)) - else - Exit; - - NumDirectories := TIFFNumberOfDirectories(Tiff); - if OnlyFirstLevel then - NumDirectories := Min(1, NumDirectories); - - SetLength(Images, NumDirectories); - - for Idx := 0 to NumDirectories - 1 do - begin - TIFFSetDirectory(Tiff, Idx); - - // Set defaults for TIFF fields - DataFormat := ifUnknown; - - // Read some TIFF fields with basic image info - TIFFGetField(Tiff, TIFFTAG_IMAGEWIDTH, @Images[Idx].Width); - TIFFGetField(Tiff, TIFFTAG_IMAGELENGTH, @Images[Idx].Height); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_ORIENTATION, @Orientation); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_BITSPERSAMPLE, @BitsPerSample); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_SAMPLESPERPIXEL, @SamplesPerPixel); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_SAMPLEFORMAT, @SampleFormat); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_PHOTOMETRIC, @Photometric); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_PLANARCONFIG, @PlanarConfig); - TIFFGetFieldDefaulted(Tiff, TIFFTAG_ROWSPERSTRIP, @RowsPerStrip); - - // Load supported metadata - LoadMetadata(Tiff, Idx); - // See if we can just copy scanlines from TIFF to Imaging image - CanAccessScanlines := (PlanarConfig = PLANARCONFIG_CONTIG) or (SamplesPerPixel = 1); - - if CanAccessScanlines then - begin - // We can copy scanlines so we try to find data format that best matches - // TIFFs internal data format - if (Photometric = PHOTOMETRIC_MINISBLACK) or (Photometric = PHOTOMETRIC_MINISWHITE) then - begin - if SampleFormat = SAMPLEFORMAT_UINT then - begin - case BitsPerSample of - 1: - if SamplesPerPixel = 1 then - DataFormat := ifBinary; - 8: - case SamplesPerPixel of - 1: DataFormat := ifGray8; - 2: DataFormat := ifA8Gray8; - end; - 16: - case SamplesPerPixel of - 1: DataFormat := ifGray16; - 2: DataFormat := ifA16Gray16; - end; - 32: - if SamplesPerPixel = 1 then - DataFormat := ifGray32; - end; - end - else if SampleFormat = SAMPLEFORMAT_IEEEFP then - begin - case BitsPerSample of - 16: - if SamplesPerPixel = 1 then - DataFormat := ifR16F; - 32: - if SamplesPerPixel = 1 then - DataFormat := ifR32F; - end; - end; - end - else if Photometric = PHOTOMETRIC_RGB then - begin - if SampleFormat = SAMPLEFORMAT_UINT then - begin - case BitsPerSample of - 8: - case SamplesPerPixel of - 3: DataFormat := ifR8G8B8; - 4: DataFormat := ifA8R8G8B8; - end; - 16: - case SamplesPerPixel of - 3: DataFormat := ifR16G16B16; - 4: DataFormat := ifA16R16G16B16; - end; - end; - end - else if SampleFormat = SAMPLEFORMAT_IEEEFP then - begin - case BitsPerSample of - 16: - if SamplesPerPixel = 4 then - DataFormat := ifA16R16G16B16F; - 32: - if SamplesPerPixel = 4 then - DataFormat := ifA32R32G32B32F; - end; - end; - end - else if Photometric = PHOTOMETRIC_PALETTE then - begin - if (SamplesPerPixel = 1) and (SampleFormat = SAMPLEFORMAT_UINT) and (BitsPerSample = 8) then - DataFormat := ifIndex8 - end; - end; - - if DataFormat = ifUnknown then - begin - // Use RGBA interface to read A8R8G8B8 TIFFs and mainly TIFFs in various - // formats with no Imaging equivalent, exotic color spaces etc. - NewImage(Images[Idx].Width, Images[Idx].Height, ifA8R8G8B8, Images[Idx]); - TiffResult := TIFFReadRGBAImageOriented(Tiff, Images[Idx].Width, Images[Idx].Height, - Images[Idx].Bits, Orientation, 0); - if TiffResult = 0 then - RaiseImaging(LastError, []); - end - else - begin - // Create new image in given format and read scanlines from TIFF, - // read palette too if needed - NewImage(Images[Idx].Width, Images[Idx].Height, DataFormat, Images[Idx]); - ScanLineSize := TIFFScanlineSize(Tiff); - - for I := 0 to Images[Idx].Height - 1 do - TIFFReadScanline(Tiff, @PByteArray(Images[Idx].Bits)[I * ScanLineSize], I, 0); - - if DataFormat = ifIndex8 then - begin - TIFFGetField(Tiff, TIFFTAG_COLORMAP, @Red, @Green, @Blue); - for I := 0 to 255 do - with Images[Idx].Palette[I] do - begin - A := 255; - R := Red[I].High; - G := Green[I].High; - B := Blue[I].High; - end; - end; - - // TIFF uses BGR order so we must swap it (but not images we got - // from TiffLib RGBA interface) - if Photometric = PHOTOMETRIC_RGB then - SwapChannels(Images[Idx], ChannelRed, ChannelBlue); - - // We need to negate 'MinIsWhite' formats to get common grayscale - // formats where min sample value is black - if Photometric = PHOTOMETRIC_MINISWHITE then - for I := 0 to Images[Idx].Height - 1 do - begin - Ptr := @PByteArray(Images[Idx].Bits)[I * ScanLineSize]; - for X := 0 to ScanLineSize - 1 do - begin - Ptr^ := not Ptr^; - Inc(Ptr); - end; - end; - end; - end; - - TIFFClose(Tiff); - Result := True; -end; - -function TTiffFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -const - Compressions: array[0..5] of Word = (COMPRESSION_NONE, COMPRESSION_LZW, - COMPRESSION_PACKBITS, COMPRESSION_DEFLATE, COMPRESSION_JPEG, COMPRESSION_CCITTFAX4); -var - Tiff: PTIFF; - IOWrapper: TTiffIOWrapper; - I, J, ScanLineSize: Integer; - ImageToSave: TImageData; - MustBeFreed: Boolean; - Info: TImageFormatInfo; - Orientation, BitsPerSample, SamplesPerPixel, Photometric, - PlanarConfig, SampleFormat, CompressionScheme: Word; - RowsPerStrip: LongWord; - Red, Green, Blue: array[Byte] of TWordRec; - CompressionMismatch: Boolean; - OpenMode: PAnsiChar; - - procedure SaveMetadata(Tiff: PTiff; TiffPage: Integer); - var - XRes, YRes: Single; - begin - XRes := -1; - YRes := -1; - - // First try to find phys. size for current TIFF page index. If not found then - // try size for main image (index 0). - if not FMetadata.GetPhysicalPixelSize(ruDpcm, XRes, YRes, True, TiffPage) then - FMetadata.GetPhysicalPixelSize(ruDpcm, XRes, YRes, True, 0); - - if (XRes > 0) and (YRes > 0) then - begin - TIFFSetField(Tiff, TIFFTAG_RESOLUTIONUNIT, RESUNIT_CENTIMETER); - TIFFSetField(Tiff, TIFFTAG_XRESOLUTION, XRes); - TIFFSetField(Tiff, TIFFTAG_YRESOLUTION, YRes); - end; - end; - -begin - Result := False; - LibTiffDelphiSetErrorHandler(TIFFErrorHandler); - - if not (FCompression in [0..5]) then - FCompression := TiffDefaultCompression; - - // Set up IO wrapper and open TIFF - IOWrapper.IO := GetIO; - IOWrapper.Handle := Handle; - - OpenMode := 'w'; - if FAppendMode then - OpenMode := 'a'; - - Tiff := TIFFClientOpen('LibTIFF', OpenMode, Cardinal(@IOWrapper), @TIFFReadProc, - @TIFFWriteProc, @TIFFSeekProc, @TIFFCloseProc, - @TIFFSizeProc, @TIFFNoMapProc, @TIFFNoUnmapProc); - - if Tiff <> nil then - TIFFSetFileNo(Tiff, Cardinal(@IOWrapper)) - else - Exit; - - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - GetImageFormatInfo(Format, Info); - - // Set Tag values - Orientation := ORIENTATION_TOPLEFT; - BitsPerSample := Info.BytesPerPixel div Info.ChannelCount * 8; - if Info.Format = ifBinary then - BitsPerSample := 1; - SamplesPerPixel := Info.ChannelCount; - SampleFormat := Iff(not Info.IsFloatingPoint, SAMPLEFORMAT_UINT, SAMPLEFORMAT_IEEEFP); - PlanarConfig := PLANARCONFIG_CONTIG; - CompressionScheme := Compressions[FCompression]; - - // Check if selected compression scheme can be used for current image - CompressionMismatch := (CompressionScheme = COMPRESSION_JPEG) and ((BitsPerSample <> 8) or - not (SamplesPerPixel in [1, 3]) or Info.IsIndexed or Info.IsFloatingPoint); - CompressionMismatch := CompressionMismatch or ((CompressionScheme = COMPRESSION_CCITTFAX4) and (Info.Format <> ifBinary)); - if CompressionMismatch then - CompressionScheme := Compressions[TiffDefaultCompression]; - // If we have some compression scheme selected and it's not Fax then select it automatically - better comp ratios! - if (Info.Format = ifBinary) and (CompressionScheme <> COMPRESSION_NONE) and (CompressionScheme <> COMPRESSION_CCITTFAX4) then - CompressionScheme := COMPRESSION_CCITTFAX4; - - RowsPerStrip := TIFFDefaultStripSize(Tiff, Height); - if Info.IsIndexed then - Photometric := PHOTOMETRIC_PALETTE - else if (Info.HasGrayChannel) or (Info.ChannelCount = 1) then - Photometric := PHOTOMETRIC_MINISBLACK - else - Photometric := PHOTOMETRIC_RGB; - - // Write tags - TIFFSetField(Tiff, TIFFTAG_IMAGEWIDTH, Width); - TIFFSetField(Tiff, TIFFTAG_IMAGELENGTH, Height); - TIFFSetField(Tiff, TIFFTAG_PHOTOMETRIC, Photometric); - TIFFSetField(Tiff, TIFFTAG_PLANARCONFIG, PlanarConfig); - TIFFSetField(Tiff, TIFFTAG_ORIENTATION, Orientation); - TIFFSetField(Tiff, TIFFTAG_BITSPERSAMPLE, BitsPerSample); - TIFFSetField(Tiff, TIFFTAG_SAMPLESPERPIXEL, SamplesPerPixel); - TIFFSetField(Tiff, TIFFTAG_SAMPLEFORMAT, SampleFormat); - TIFFSetField(Tiff, TIFFTAG_COMPRESSION, CompressionScheme); - if CompressionScheme = COMPRESSION_JPEG then - TIFFSetField(Tiff, TIFFTAG_JPEGQUALITY, FJpegQuality); - TIFFSetField(Tiff, TIFFTAG_ROWSPERSTRIP, RowsPerStrip); - // Save supported metadata - SaveMetadata(Tiff, I); - - if Format = ifIndex8 then - begin - // Set paletee for indexed images - for J := 0 to 255 do - with ImageToSave.Palette[J] do - begin - Red[J].High := R; - Green[J].High := G; - Blue[J].High := B; - end; - TIFFSetField(Tiff, TIFFTAG_COLORMAP, Red, Green, Blue); - end; - - ScanLineSize := Info.GetPixelsSize(Info.Format, Width, 1); - - if Photometric = PHOTOMETRIC_RGB then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); - // Write image scanlines and then directory for current image - for J := 0 to Height - 1 do - TIFFWriteScanline(Tiff, @PByteArray(Bits)[J * ScanLineSize], J, 0); - if Info.ChannelCount > 1 then - SwapChannels(ImageToSave, ChannelRed, ChannelBlue); - - TIFFWriteDirectory(Tiff); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; - end; - - TIFFClose(Tiff); - Result := True; -end; - -procedure TTiffFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.RBSwapFormat in GetSupportedFormats then - ConvFormat := Info.RBSwapFormat - else if Info.IsFloatingPoint then - ConvFormat := IffFormat(Info.ChannelCount = 1, ifR32F, ifA32R32G32B32F) - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray32) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -function TTiffFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Magic: TChar4; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Magic, SizeOf(Magic)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Magic)) and - ((Magic = TiffBEMagic) or (Magic = TiffLEMagic)); - end; -end; - -initialization - RegisterImageFileFormat(TTiffFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 ---------------------------------------------------- - - Renamed unit to ImagingLibTiffDelphi since there will be more - Tiff implementations in the future, cleaned up interface units - and obj file a little bit. - - Updated LibTiff to version 3.9.4 and added EXIF tag support. - - Added TIFF Append mode: when saving existing files are not - overwritten but images are appended to TIFF instead. - - Images in ifBinary format are now supported for loading/saving - (optional Group 4 fax encoding added). - - PHOTOMETRIC_MINISWHITE is now properly read as Grayscale/Binary - instead of using unefficient RGBA interface. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fix: All pages of multipage TIFF were loaded even when - OnlyFirstLevel was True. - - Loading and saving of physical resolution metadata. - - Unicode compatibility fixes in LibTiffDelphi. - - Added Jpeg compression quality setting. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Fixed bug in loading and saving of 2 channel images - Imaging - tried to swap R and B channels here. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added TIFF loading and saving. - - Unit created and initial code added. -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingOpenGL.pas b/3rd/Imaging/Extras/Extensions/ImagingOpenGL.pas deleted file mode 100644 index 19ae6bb8a..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingOpenGL.pas +++ /dev/null @@ -1,955 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading and saving OpenGL textures - using Imaging and for converting images to textures and vice versa.} -unit ImagingOpenGL; - -{$I ImagingOptions.inc} - -{ Define this symbol if you want to use dglOpenGL header.} -{$DEFINE USE_DGL_HEADERS} -{ $DEFINE USE_GLSCENE_HEADERS} - -interface - -uses - SysUtils, Classes, ImagingTypes, Imaging, ImagingFormats, -{$IF Defined(USE_DGL_HEADERS)} - dglOpenGL, -{$ELSEIF Defined(USE_GLSCENE_HEADERS)} - OpenGL1x, -{$ELSE} - gl, glext, -{$IFEND} - ImagingUtility; - -type - { Various texture capabilities of installed OpenGL driver.} - TGLTextureCaps = record - MaxTextureSize: LongInt; // Max size of texture in pixels supported by HW - NonPowerOfTwo: Boolean; // HW has full support for NPOT textures - DXTCompression: Boolean; // HW supports S3TC/DXTC compressed textures - ATI3DcCompression: Boolean; // HW supports ATI 3Dc compressed textures (ATI2N) - LATCCompression: Boolean; // HW supports LATC/RGTC compressed textures (ATI1N+ATI2N) - FloatTextures: Boolean; // HW supports floating point textures - MaxAnisotropy: LongInt; // Max anisotropy for aniso texture filtering - MaxSimultaneousTextures: LongInt; // Number of texture units - ClampToEdge: Boolean; // GL_EXT_texture_edge_clamp - TextureLOD: Boolean; // GL_SGIS_texture_lod - VertexTextureUnits: Integer; // Texture units accessible in vertex programs - end; - -{ Returns texture capabilities of installed OpenGL driver.} -function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; -{ Function which can be used to retrieve GL extension functions.} -function GetGLProcAddress(const ProcName: string): Pointer; -{ Returns True if the given GL extension is supported.} -function IsGLExtensionSupported(const Extension: string): Boolean; -{ Returns True if the given image format can be represented as GL texture - format. GLFormat, GLType, and GLInternal are parameters for functions like - glTexImage. Note that GLU functions like gluBuildMipmaps cannot handle some - formats returned by this function (i.e. GL_UNSIGNED_SHORT_5_5_5_1 as GLType). - If you are using compressed or floating-point images make sure that they are - supported by hardware using GetGLTextureCaps, ImageFormatToGL does not - check this.} -function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; - var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; - -{ All GL textures created by Imaging functions have default parameters set - - that means that no glTexParameter calls are made so default filtering, - wrapping, and other parameters are used. Created textures - are left bound by glBindTexture when function is exited.} - -{ Creates GL texture from image in file in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromFile(const FileName: string; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Creates GL texture from image in stream in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromStream(Stream: TStream; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Creates GL texture from image in memory in format supported by Imaging. - You can use CreatedWidth and Height parameters to query dimensions of created textures - (it could differ from dimensions of source image).} -function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; - -{ Converts TImageData structure to OpenGL texture. - Input images is used as main mipmap level and additional requested - levels are generated from this one. For the details on parameters - look at CreateGLTextureFromMultiImage function.} -function CreateGLTextureFromImage(const Image: TImageData; - Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; - OverrideFormat: TImageFormat = ifUnknown; CreatedWidth: PLongInt = nil; - CreatedHeight: PLongInt = nil): GLuint; -{ Converts images in TDymImageDataArray to one OpenGL texture. - Image at index MainLevelIndex in the array is used as main mipmap level and - additional images are used as subsequent levels. If there is not enough images - in array missing levels are automatically generated (and if there is enough images - but they have wrong dimensions or format then they are resized/converted). - If driver supports only power of two sized textures images are resized. - OverrideFormat can be used to convert image into specific format before - it is passed to OpenGL, ifUnknown means no conversion. - If desired texture format is not supported by hardware default - A8R8G8B8 format is used instead for color images and ifGray8 is used - for luminance images. DXTC (S3TC) compressed and floating point textures - are created if supported by hardware. - Width and Height can be used to set size of main mipmap level according - to your needs, Width and Height of 0 mean use width and height of input - image that will become main level mipmap. - MipMaps set to True mean build all possible levels, False means use only level 0. - You can use CreatedWidth and CreatedHeight parameters to query dimensions of - created texture's largest mipmap level (it could differ from dimensions - of source image).} -function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; - Width: LongInt = 0; Height: LongInt = 0; MipMaps: Boolean = True; - MainLevelIndex: LongInt = 0; OverrideFormat: TImageFormat = ifUnknown; - CreatedWidth: PLongInt = nil; CreatedHeight: PLongInt = nil): GLuint; - -{ Saves GL texture to file in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; -{ Saves GL texture to stream in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; -{ Saves GL texture to memory in one of formats supported by Imaging. - Saves all present mipmap levels.} -function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; - -{ Converts main level of the GL texture to TImageData strucrue. OverrideFormat - can be used to convert output image to the specified format rather - than use the format taken from GL texture, ifUnknown means no conversion.} -function CreateImageFromGLTexture(const Texture: GLuint; - var Image: TImageData; OverrideFormat: TImageFormat = ifUnknown): Boolean; -{ Converts GL texture to TDynImageDataArray array of images. You can specify - how many mipmap levels of the input texture you want to be converted - (default is all levels). OverrideFormat can be used to convert output images to - the specified format rather than use the format taken from GL texture, - ifUnknown means no conversion.} -function CreateMultiImageFromGLTexture(const Texture: GLuint; - var Images: TDynImageDataArray; MipLevels: LongInt = 0; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -var - { Standard behaviour of image->texture functions like CreateGLTextureFrom(Multi)Image is: - If graphic card supports non power of 2 textures and image is nonpow2 then - texture is created directly from image. - If graphic card does not support them input image is rescaled (bilinear) - to power of 2 size. - If you set PasteNonPow2ImagesIntoPow2 to True then instead of rescaling, a new - pow2 texture is created and nonpow2 input image is pasted into it - keeping its original size. This could be useful for some 2D stuff - (and its faster than rescaling of course). Note that this is applied - to all rescaling smaller->bigger operations that might ocurr during - image->texture process (usually only pow2/nonpow2 stuff and when you - set custom Width & Height in CreateGLTextureFrom(Multi)Image).} - PasteNonPow2ImagesIntoPow2: Boolean = False; - { Standard behaviur if GL_ARB_texture_non_power_of_two extension is not supported - is to rescale image to power of 2 dimensions. NPOT extension is exposed only - when HW has full support for NPOT textures but some cards - (pre-DX10 ATI Radeons, some other maybe) have partial NPOT support. - Namely Radeons can use NPOT textures but not mipmapped. If you know what you are doing - you can disable NPOT support check so the image won't be rescaled to POT - by seting DisableNPOTSupportCheck to True.} - DisableNPOTSupportCheck: Boolean = False; - -implementation - -const - // Cube map consts - GL_TEXTURE_BINDING_CUBE_MAP = $8514; - GL_TEXTURE_CUBE_MAP_POSITIVE_X = $8515; - GL_TEXTURE_CUBE_MAP_NEGATIVE_X = $8516; - GL_TEXTURE_CUBE_MAP_POSITIVE_Y = $8517; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = $8518; - GL_TEXTURE_CUBE_MAP_POSITIVE_Z = $8519; - GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = $851A; - - // Texture formats - GL_COLOR_INDEX = $1900; - GL_STENCIL_INDEX = $1901; - GL_DEPTH_COMPONENT = $1902; - GL_RED = $1903; - GL_GREEN = $1904; - GL_BLUE = $1905; - GL_ALPHA = $1906; - GL_RGB = $1907; - GL_RGBA = $1908; - GL_LUMINANCE = $1909; - GL_LUMINANCE_ALPHA = $190A; - GL_BGR_EXT = $80E0; - GL_BGRA_EXT = $80E1; - - // Texture internal formats - GL_ALPHA4 = $803B; - GL_ALPHA8 = $803C; - GL_ALPHA12 = $803D; - GL_ALPHA16 = $803E; - GL_LUMINANCE4 = $803F; - GL_LUMINANCE8 = $8040; - GL_LUMINANCE12 = $8041; - GL_LUMINANCE16 = $8042; - GL_LUMINANCE4_ALPHA4 = $8043; - GL_LUMINANCE6_ALPHA2 = $8044; - GL_LUMINANCE8_ALPHA8 = $8045; - GL_LUMINANCE12_ALPHA4 = $8046; - GL_LUMINANCE12_ALPHA12 = $8047; - GL_LUMINANCE16_ALPHA16 = $8048; - GL_INTENSITY = $8049; - GL_INTENSITY4 = $804A; - GL_INTENSITY8 = $804B; - GL_INTENSITY12 = $804C; - GL_INTENSITY16 = $804D; - GL_R3_G3_B2 = $2A10; - GL_RGB4 = $804F; - GL_RGB5 = $8050; - GL_RGB8 = $8051; - GL_RGB10 = $8052; - GL_RGB12 = $8053; - GL_RGB16 = $8054; - GL_RGBA2 = $8055; - GL_RGBA4 = $8056; - GL_RGB5_A1 = $8057; - GL_RGBA8 = $8058; - GL_RGB10_A2 = $8059; - GL_RGBA12 = $805A; - GL_RGBA16 = $805B; - GL_RGB565 = $8D62; - - // Floating point texture formats - GL_RGBA32F_ARB = $8814; - GL_INTENSITY32F_ARB = $8817; - GL_LUMINANCE32F_ARB = $8818; - GL_RGBA16F_ARB = $881A; - GL_INTENSITY16F_ARB = $881D; - GL_LUMINANCE16F_ARB = $881E; - - // Compressed texture formats - // S3TC/DXTC - GL_COMPRESSED_RGB_S3TC_DXT1_EXT = $83F0; - GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = $83F1; - GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = $83F2; - GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = $83F3; - // 3Dc LATC - GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI = $8837; - GL_COMPRESSED_LUMINANCE_LATC1_EXT = $8C70; - GL_COMPRESSED_SIGNED_LUMINANCE_LATC1_EXT = $8C71; - GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT = $8C72; - GL_COMPRESSED_SIGNED_LUMINANCE_ALPHA_LATC2_EXT = $8C73; - // ETC1 GL_OES_compressed_ETC1_RGB8_texture - GL_ETC1_RGB_OES = $8D64; - // PVRTC GL_IMG_texture_compression_pvrtc - GL_COMPRESSED_RGB_PVRTC_4BPPV1_IMG = $8C00; - GL_COMPRESSED_RGB_PVRTC_2BPPV1_IMG = $8C01; - GL_COMPRESSED_RGBA_PVRTC_4BPPV1_IMG = $8C02; - GL_COMPRESSED_RGBA_PVRTC_2BPPV1_IMG = $8C03; - // AMD ATC - GL_ATC_RGBA_EXPLICIT_ALPHA_AMD = $8C93; - GL_ATC_RGBA_INTERPOLATED_ALPHA_AMD = $87EE; - // ETC2/EAC - GL_COMPRESSED_R11_EAC = $9270; - GL_COMPRESSED_SIGNED_R11_EAC = $9271; - GL_COMPRESSED_RG11_EAC = $9272; - GL_COMPRESSED_SIGNED_RG11_EAC = $9273; - GL_COMPRESSED_RGB8_ETC2 = $9274; - GL_COMPRESSED_SRGB8_ETC2 = $9275; - GL_COMPRESSED_RGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9276; - GL_COMPRESSED_SRGB8_PUNCHTHROUGH_ALPHA1_ETC2 = $9277; - GL_COMPRESSED_RGBA8_ETC2_EAC = $9278; - GL_COMPRESSED_SRGB8_ALPHA8_ETC2_EAC = $9279; - - // Various GL extension constants - GL_MAX_TEXTURE_UNITS = $84E2; - GL_TEXTURE_MAX_ANISOTROPY_EXT = $84FE; - GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT = $84FF; - - // Texture source data formats - GL_UNSIGNED_BYTE_3_3_2 = $8032; - GL_UNSIGNED_SHORT_4_4_4_4 = $8033; - GL_UNSIGNED_SHORT_5_5_5_1 = $8034; - GL_UNSIGNED_INT_8_8_8_8 = $8035; - GL_UNSIGNED_INT_10_10_10_2 = $8036; - GL_UNSIGNED_BYTE_2_3_3_REV = $8362; - GL_UNSIGNED_SHORT_5_6_5 = $8363; - GL_UNSIGNED_SHORT_5_6_5_REV = $8364; - GL_UNSIGNED_SHORT_4_4_4_4_REV = $8365; - GL_UNSIGNED_SHORT_1_5_5_5_REV = $8366; - GL_UNSIGNED_INT_8_8_8_8_REV = $8367; - GL_UNSIGNED_INT_2_10_10_10_REV = $8368; - GL_HALF_FLOAT_ARB = $140B; - - // Other GL constants - GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS = $8B4C; - - -{$IFDEF MSWINDOWS} - GLLibName = 'opengl32.dll'; -{$ENDIF} -{$IFDEF UNIX} - GLLibName = 'libGL.so'; -{$ENDIF} - -type - TglCompressedTexImage2D = procedure (Target: GLenum; Level: GLint; - InternalFormat: GLenum; Width: GLsizei; Height: GLsizei; Border: GLint; - ImageSize: GLsizei; const Data: PGLvoid); - {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - glCompressedTexImage2D: TglCompressedTexImage2D = nil; - ExtensionBuffer: string = ''; - -{$IFDEF MSWINDOWS} -function wglGetProcAddress(ProcName: PAnsiChar): Pointer; stdcall; external GLLibName; -{$ENDIF} -{$IFDEF UNIX} -function glXGetProcAddress(ProcName: PAnsiChar): Pointer; cdecl; external GLLibName; -{$ENDIF} - -function IsGLExtensionSupported(const Extension: string): Boolean; -var - ExtPos: LongInt; -begin - if ExtensionBuffer = '' then - ExtensionBuffer := glGetString(GL_EXTENSIONS); - - ExtPos := Pos(Extension, ExtensionBuffer); - Result := ExtPos > 0; - if Result then - begin - Result := ((ExtPos + Length(Extension) - 1) = Length(ExtensionBuffer)) or - not (ExtensionBuffer[ExtPos + Length(Extension)] in ['_', 'A'..'Z', 'a'..'z']); - end; -end; - -function GetGLProcAddress(const ProcName: string): Pointer; -begin -{$IFDEF MSWINDOWS} - Result := wglGetProcAddress(PAnsiChar(AnsiString(ProcName))); -{$ENDIF} -{$IFDEF UNIX} - Result := glXGetProcAddress(PAnsiChar(AnsiString(ProcName))); -{$ENDIF} -end; - -function GetGLTextureCaps(var Caps: TGLTextureCaps): Boolean; -begin - // Check DXTC support and load extension functions if necesary - Caps.DXTCompression := IsGLExtensionSupported('GL_ARB_texture_compression') and - IsGLExtensionSupported('GL_EXT_texture_compression_s3tc'); - if Caps.DXTCompression then - glCompressedTexImage2D := GetGLProcAddress('glCompressedTexImage2D'); - Caps.DXTCompression := Caps.DXTCompression and (@glCompressedTexImage2D <> nil); - Caps.ATI3DcCompression := Caps.DXTCompression and - IsGLExtensionSupported('GL_ATI_texture_compression_3dc'); - Caps.LATCCompression := Caps.DXTCompression and - IsGLExtensionSupported('GL_EXT_texture_compression_latc'); - // Check non power of 2 textures - Caps.NonPowerOfTwo := IsGLExtensionSupported('GL_ARB_texture_non_power_of_two'); - // Check for floating point textures support - Caps.FloatTextures := IsGLExtensionSupported('GL_ARB_texture_float'); - // Get max texture size - glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); - // Get max anisotropy - if IsGLExtensionSupported('GL_EXT_texture_filter_anisotropic') then - glGetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @Caps.MaxAnisotropy) - else - Caps.MaxAnisotropy := 0; - // Get number of texture units - if IsGLExtensionSupported('GL_ARB_multitexture') then - glGetIntegerv(GL_MAX_TEXTURE_UNITS, @Caps.MaxSimultaneousTextures) - else - Caps.MaxSimultaneousTextures := 1; - // Get number of vertex texture units - if IsGLExtensionSupported('GL_ARB_vertex_shader') then - glGetIntegerv(GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS, @Caps.VertexTextureUnits) - else - Caps.VertexTextureUnits := 1; - // Get max texture size - glGetIntegerv(GL_MAX_TEXTURE_SIZE, @Caps.MaxTextureSize); - // Clamp texture to edge? - Caps.ClampToEdge := IsGLExtensionSupported('GL_EXT_texture_edge_clamp'); - // Texture LOD extension? - Caps.TextureLOD := IsGLExtensionSupported('GL_SGIS_texture_lod'); - - Result := True; -end; - -function ImageFormatToGL(Format: TImageFormat; var GLFormat: GLenum; - var GLType: GLenum; var GLInternal: GLint; const Caps: TGLTextureCaps): Boolean; -begin - GLFormat := 0; - GLType := 0; - GLInternal := 0; - case Format of - // Gray formats - ifGray8, ifGray16: - begin - GLFormat := GL_LUMINANCE; - GLType := Iff(Format = ifGray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); - GLInternal := Iff(Format = ifGray8, GL_LUMINANCE8, GL_LUMINANCE16); - end; - ifA8Gray8, ifA16Gray16: - begin - GLFormat := GL_LUMINANCE_ALPHA; - GLType := Iff(Format = ifA8Gray8, GL_UNSIGNED_BYTE, GL_UNSIGNED_SHORT); - GLInternal := Iff(Format = ifA8Gray8, GL_LUMINANCE8_ALPHA8, GL_LUMINANCE16_ALPHA16); - end; - // RGBA formats - ifR3G3B2: - begin - GLFormat := GL_RGB; - GLType := GL_UNSIGNED_BYTE_3_3_2; - GLInternal := GL_R3_G3_B2; - end; - ifR5G6B5: - begin - GLFormat := GL_RGB; - GLType := GL_UNSIGNED_SHORT_5_6_5; - GLInternal := GL_RGB5; //GL_RGB565 ot working on Radeons - end; - ifA1R5G5B5, ifX1R5G5B5: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_SHORT_1_5_5_5_REV; - GLInternal := Iff(Format = ifA1R5G5B5, GL_RGB5_A1, GL_RGB5); - end; - ifA4R4G4B4, ifX4R4G4B4: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_SHORT_4_4_4_4_REV; - GLInternal := Iff(Format = ifA4R4G4B4, GL_RGBA4, GL_RGB4); - end; - ifR8G8B8: - begin - GLFormat := GL_BGR_EXT; - GLType := GL_UNSIGNED_BYTE; - GLInternal := GL_RGB8; - end; - ifA8R8G8B8, ifX8R8G8B8: - begin - GLFormat := GL_BGRA_EXT; - GLType := GL_UNSIGNED_BYTE; - GLInternal := Iff(Format = ifA8R8G8B8, GL_RGBA8, GL_RGB8); - end; - ifR16G16B16, ifB16G16R16: - begin - GLFormat := Iff(Format = ifR16G16B16, GL_BGR_EXT, GL_RGB); - GLType := GL_UNSIGNED_SHORT; - GLInternal := GL_RGB16; - end; - ifA16R16G16B16, ifA16B16G16R16: - begin - GLFormat := Iff(Format = ifA16R16G16B16, GL_BGRA_EXT, GL_RGBA); - GLType := GL_UNSIGNED_SHORT; - GLInternal := GL_RGBA16; - end; - // Floating-Point formats - ifR32F: - begin - GLFormat := GL_RED; - GLType := GL_FLOAT; - GLInternal := GL_LUMINANCE32F_ARB; - end; - ifA32R32G32B32F, ifA32B32G32R32F: - begin - GLFormat := Iff(Format = ifA32R32G32B32F, GL_BGRA_EXT, GL_RGBA); - GLType := GL_FLOAT; - GLInternal := GL_RGBA32F_ARB; - end; - ifR16F: - begin - GLFormat := GL_RED; - GLType := GL_HALF_FLOAT_ARB; - GLInternal := GL_LUMINANCE16F_ARB; - end; - ifA16R16G16B16F, ifA16B16G16R16F: - begin - GLFormat := Iff(Format = ifA16R16G16B16F, GL_BGRA_EXT, GL_RGBA); - GLType := GL_HALF_FLOAT_ARB; - GLInternal := GL_RGBA16F_ARB; - end; - // Special formats - ifDXT1: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT1_EXT; - ifDXT3: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT3_EXT; - ifDXT5: GLInternal := GL_COMPRESSED_RGBA_S3TC_DXT5_EXT; - ifATI1N: GLInternal := GL_COMPRESSED_LUMINANCE_LATC1_EXT; - ifATI2N: - begin - GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_LATC2_EXT; - if not Caps.LATCCompression and Caps.ATI3DcCompression then - GLInternal := GL_COMPRESSED_LUMINANCE_ALPHA_3DC_ATI; - end; - end; - Result := GLInternal <> 0; -end; - -function LoadGLTextureFromFile(const FileName: string; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromFile(FileName, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function LoadGLTextureFromStream(Stream: TStream; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromStream(Stream, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function LoadGLTextureFromMemory(Data: Pointer; Size: LongInt; CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Images: TDynImageDataArray; -begin - if LoadMultiImageFromMemory(Data, Size, Images) and (Length(Images) > 0) then - begin - Result := CreateGLTextureFromMultiImage(Images, Images[0].Width, - Images[0].Height, True, 0, ifUnknown, CreatedWidth, CreatedHeight); - end - else - Result := 0; - FreeImagesInArray(Images); -end; - -function CreateGLTextureFromImage(const Image: TImageData; - Width, Height: LongInt; MipMaps: Boolean; OverrideFormat: TImageFormat; - CreatedWidth, CreatedHeight: PLongInt): GLuint; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - SetLength(Arr, 1); - Arr[0] := Image; - Result := CreateGLTextureFromMultiImage(Arr, Width, Height, MipMaps, 0, - OverrideFormat, CreatedWidth, CreatedHeight); -end; - -function CreateGLTextureFromMultiImage(const Images: TDynImageDataArray; - Width, Height: LongInt; MipMaps: Boolean; MainLevelIndex: LongInt; OverrideFormat: TImageFormat; - CreatedWidth, CreatedHeight: PLongInt): GLuint; -const - BlockCompressedFormats: TImageFormats = [ifDXT1, ifDXT3, ifDXT5, ifATI1N, ifATI2N]; -var - I, MipLevels, PossibleLevels, ExistingLevels, CurrentWidth, CurrentHeight: LongInt; - Caps: TGLTextureCaps; - GLFormat: GLenum; - GLType: GLenum; - GLInternal: GLint; - Desired, ConvTo: TImageFormat; - Info: TImageFormatInfo; - LevelsArray: TDynImageDataArray; - NeedsResize, NeedsConvert: Boolean; - UnpackAlignment, UnpackSkipRows, UnpackSkipPixels, UnpackRowLength: LongInt; - - procedure PasteImage(var Image: TImageData; Width, Height: LongInt); - var - Clone: TImageData; - begin - CloneImage(Image, Clone); - NewImage(Width, Height, Clone.Format, Image); - FillRect(Image, 0, 0, Width, Height, Clone.Bits); - CopyRect(Clone, 0, 0, Clone.Width, Clone.Height, Image, 0, 0); - FreeImage(Clone); - end; - -begin - Result := 0; - ExistingLevels := Length(Images); - - if GetGLTextureCaps(Caps) and (ExistingLevels > 0) then - try - // Check if requested main level is at valid index - if (MainLevelIndex < 0) or (MainLevelIndex > High(Images)) then - MainLevelIndex := 0; - - // First check desired size and modify it if necessary - if Width <= 0 then Width := Images[MainLevelIndex].Width; - if Height <= 0 then Height := Images[MainLevelIndex].Height; - if not Caps.NonPowerOfTwo and not DisableNPOTSupportCheck then - begin - // If device supports only power of 2 texture sizes - Width := NextPow2(Width); - Height := NextPow2(Height); - end; - Width := ClampInt(Width, 1, Caps.MaxTextureSize); - Height := ClampInt(Height, 1, Caps.MaxTextureSize); - - // Get various mipmap level counts and modify - // desired MipLevels if its value is invalid - PossibleLevels := GetNumMipMapLevels(Width, Height); - if MipMaps then - MipLevels := PossibleLevels - else - MipLevels := 1; - - // Prepare array for mipmap levels. Make it larger than necessary - that - // way we can use the same index for input images and levels in the large loop below - SetLength(LevelsArray, MipLevels + MainLevelIndex); - - // Now determine which image format will be used - if OverrideFormat = ifUnknown then - Desired := Images[MainLevelIndex].Format - else - Desired := OverrideFormat; - - // Check if the hardware supports floating point and compressed textures - GetImageFormatInfo(Desired, Info); - if Info.IsFloatingPoint and not Caps.FloatTextures then - Desired := ifA8R8G8B8; - if (Desired in [ifDXT1, ifDXT3, ifDXT5]) and not Caps.DXTCompression then - Desired := ifA8R8G8B8; - if (Desired = ifATI1N) and not Caps.LATCCompression then - Desired := ifGray8; - if (Desired = ifATI2N) and not (Caps.ATI3DcCompression or Caps.LATCCompression) then - Desired := ifA8Gray8; - - // Try to find GL format equivalent to image format and if it is not - // found use one of default formats - if not ImageFormatToGL(Desired, GLFormat, GLType, GLInternal, Caps) then - begin - GetImageFormatInfo(Desired, Info); - if Info.HasGrayChannel then - ConvTo := ifGray8 - else - ConvTo := ifA8R8G8B8; - if not ImageFormatToGL(ConvTo, GLFormat, GLType, GLInternal, Caps) then - Exit; - end - else - ConvTo := Desired; - - CurrentWidth := Width; - CurrentHeight := Height; - // If user is interested in width and height of created texture lets - // give him that - if CreatedWidth <> nil then CreatedWidth^ := CurrentWidth; - if CreatedHeight <> nil then CreatedHeight^ := CurrentHeight; - - // Store old pixel unpacking settings - glGetIntegerv(GL_UNPACK_ALIGNMENT, @UnpackAlignment); - glGetIntegerv(GL_UNPACK_SKIP_ROWS, @UnpackSkipRows); - glGetIntegerv(GL_UNPACK_SKIP_PIXELS, @UnpackSkipPixels); - glGetIntegerv(GL_UNPACK_ROW_LENGTH, @UnpackRowLength); - // Set new pixel unpacking settings - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - glPixelStorei(GL_UNPACK_SKIP_ROWS, 0); - glPixelStorei(GL_UNPACK_SKIP_PIXELS, 0); - glPixelStorei(GL_UNPACK_ROW_LENGTH, 0); - - // Generate new texture, bind it and set - glGenTextures(1, @Result); - glBindTexture(GL_TEXTURE_2D, Result); - if Byte(glIsTexture(Result)) <> GL_TRUE then - Exit; - - for I := MainLevelIndex to MipLevels - 1 + MainLevelIndex do - begin - // Check if we can use input image array as a source for this mipmap level - if I < ExistingLevels then - begin - // Check if input image for this mipmap level has the right - // size and format - NeedsConvert := not (Images[I].Format = ConvTo); - if ConvTo in BlockCompressedFormats then - begin - // Input images in DXTC will have min dimensions of 4, but we need - // current Width and Height to be lesser (for glCompressedTexImage2D) - NeedsResize := not ((Images[I].Width = Max(4, CurrentWidth)) and - (Images[I].Height = Max(4, CurrentHeight))); - end - else - NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); - - if NeedsResize or NeedsConvert then - begin - // Input image must be resized or converted to different format - // to become valid mipmap level - CloneImage(Images[I], LevelsArray[I]); - if NeedsConvert then - ConvertImage(LevelsArray[I], ConvTo); - if NeedsResize then - begin - if (not PasteNonPow2ImagesIntoPow2) or (LevelsArray[I].Width > CurrentWidth) or - (LevelsArray[I].Height > CurrentHeight)then - begin - // If pasteNP2toP2 is disabled or if source is bigger than target - // we rescale image, otherwise we paste it with the same size - ResizeImage(LevelsArray[I], CurrentWidth, CurrentHeight, rfBilinear) - end - else - PasteImage(LevelsArray[I], CurrentWidth, CurrentHeight); - end; - end - else - // Input image can be used without any changes - LevelsArray[I] := Images[I]; - end - else - begin - // This mipmap level is not present in the input image array - // so we create a new level - FillMipMapLevel(LevelsArray[I - 1], CurrentWidth, CurrentHeight, LevelsArray[I]); - end; - - if ConvTo in BlockCompressedFormats then - begin - // Note: GL DXTC texture snaller than 4x4 must have width and height - // as expected for non-DXTC texture (like 1x1 - we cannot - // use LevelsArray[I].Width and LevelsArray[I].Height - they are - // at least 4 for DXTC images). But Bits and Size passed to - // glCompressedTexImage2D must contain regular 4x4 DXTC block. - glCompressedTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, - CurrentHeight, 0, LevelsArray[I].Size, LevelsArray[I].Bits) - end - else - begin - glTexImage2D(GL_TEXTURE_2D, I - MainLevelIndex, GLInternal, CurrentWidth, - CurrentHeight, 0, GLFormat, GLType, LevelsArray[I].Bits); - end; - - // Calculate width and height of the next mipmap level - CurrentWidth := ClampInt(CurrentWidth div 2, 1, CurrentWidth); - CurrentHeight := ClampInt(CurrentHeight div 2, 1, CurrentHeight); - end; - - // Restore old pixel unpacking settings - glPixelStorei(GL_UNPACK_ALIGNMENT, UnpackAlignment); - glPixelStorei(GL_UNPACK_SKIP_ROWS, UnpackSkipRows); - glPixelStorei(GL_UNPACK_SKIP_PIXELS, UnpackSkipPixels); - glPixelStorei(GL_UNPACK_ROW_LENGTH, UnpackRowLength); - finally - // Free local image copies - for I := 0 to Length(LevelsArray) - 1 do - begin - if ((I < ExistingLevels) and (LevelsArray[I].Bits <> Images[I].Bits)) or - (I >= ExistingLevels) then - FreeImage(LevelsArray[I]); - end; - end; -end; - -function SaveGLTextureToFile(const FileName: string; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByName(FileName); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToFile(FileName, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function SaveGLTextureToStream(const Ext: string; Stream: TStream; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToStream(Ext, Stream, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function SaveGLTextureToMemory(const Ext: string; Data: Pointer; var Size: LongInt; const Texture: GLuint): Boolean; -var - Arr: TDynImageDataArray; - Fmt: TImageFileFormat; - IsDDS: Boolean; -begin - Result := CreateMultiImageFromGLTexture(Texture, Arr); - if Result then - begin - Fmt := FindImageFileFormatByExt(Ext); - if Fmt <> nil then - begin - IsDDS := SameText(Fmt.Extensions[0], 'dds'); - if IsDDS then - begin - PushOptions; - SetOption(ImagingDDSSaveMipMapCount, Length(Arr)); - end; - Result := SaveMultiImageToMemory(Ext, Data, Size, Arr); - if IsDDS then - PopOptions; - end; - FreeImagesInArray(Arr); - end; -end; - -function CreateImageFromGLTexture(const Texture: GLuint; - var Image: TImageData; OverrideFormat: TImageFormat): Boolean; -var - Arr: TDynImageDataArray; -begin - // Just calls function operating on image arrays - FreeImage(Image); - SetLength(Arr, 1); - Result := CreateMultiImageFromGLTexture(Texture, Arr, 1, OverrideFormat); - Image := Arr[0]; -end; - -function CreateMultiImageFromGLTexture(const Texture: GLuint; - var Images: TDynImageDataArray; MipLevels: LongInt; OverrideFormat: TImageFormat): Boolean; -var - I, Width, Height, ExistingLevels: LongInt; -begin - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := False; - if Byte(glIsTexture(Texture)) = GL_TRUE then - begin - // Check if desired mipmap level count is valid - glBindTexture(GL_TEXTURE_2D, Texture); - if MipLevels <= 0 then - MipLevels := GetNumMipMapLevels(Width, Height); - SetLength(Images, MipLevels); - ExistingLevels := 0; - - for I := 0 to MipLevels - 1 do - begin - // Get the current level size - glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_WIDTH, @Width); - glGetTexLevelParameteriv(GL_TEXTURE_2D, I, GL_TEXTURE_HEIGHT, @Height); - // Break when the mipmap chain is broken - if (Width = 0) or (Height = 0) then - Break; - // Create new image and copy texture data - NewImage(Width, Height, ifA8R8G8B8, Images[I]); - glGetTexImage(GL_TEXTURE_2D, I, GL_BGRA_EXT, GL_UNSIGNED_BYTE, Images[I].Bits); - Inc(ExistingLevels); - end; - // Resize mipmap array if necessary - if MipLevels <> ExistingLevels then - SetLength(Images, ExistingLevels); - // Convert images to desired format if set - if OverrideFormat <> ifUnknown then - for I := 0 to Length(Images) - 1 do - ConvertImage(Images[I], OverrideFormat); - - Result := True; - end; -end; - -initialization - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - -- 0.77.1 --------------------------------------------------- - - Added some new compressed formats IDs - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fixed GetGLProcAddress in Unicode Delphi. Compressed - textures didn't work because of this. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added support for GLScene's OpenGL header. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added 3Dc compressed texture formats support. - - Added detection of 3Dc formats to texture caps. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Added DisableNPOTSupportCheck option and related functionality. - - Added some new texture caps detection. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Added PasteNonPow2ImagesIntoPow2 option and related functionality. - - Better NeedsResize determination for small DXTC textures - - avoids needless resizing. - - Added MainLevelIndex to CreateMultiImageFromGLTexture. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added CreatedWidth and CreatedHeight parameters to most - LoadGLTextureFromXXX/CreateGLTextureFromXXX functions. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed bug in CreateGLTextureFromMultiImage which caused assert failure - when creating mipmaps (using FillMipMapLevel) for DXTC formats - - changed single channel floating point texture formats from - GL_INTENSITY..._ARB to GL_LUMINANCE..._ARB - - added support for half float texture formats (GL_RGBA16F_ARB etc.) - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - filtered mipmap creation - - more texture caps added - - fixed memory leaks in SaveGLTextureTo... functions - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingPcx.pas b/3rd/Imaging/Extras/Extensions/ImagingPcx.pas deleted file mode 100644 index bcd858c0c..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingPcx.pas +++ /dev/null @@ -1,375 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for ZSoft Paintbrush images known as PCX.} -unit ImagingPcx; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingFormats, ImagingUtility, ImagingIO; - -type - { Class for loading ZSoft Paintbrush images known as PCX. It is old - format which can store 1bit, 2bit, 4bit, 8bit, and 24bit (and 32bit but is - probably non-standard) images. Only loading is supported (you can still come - accross some PCX files) but saving is not (I don't wont this venerable format - to spread).} - TPCXFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SPCXFormatName = 'ZSoft Paintbrush Image'; - SPCXMasks = '*.pcx'; - -type - TPCXHeader = packed record - Id: Byte; // Always $0A - Version: Byte; // 0, 2, 3, 4, 5 - Encoding: Byte; // 0, 1 - BitsPerPixel: Byte; // 1, 2, 4, 8 - X0, Y0: Word; // Image window top-left - X1, Y1: Word; // Image window bottom-right - DpiX: Word; - DpiY: Word; - Palette16: array [0..15] of TColor24Rec; - Reserved1: Byte; - Planes: Byte; // 1, 3, 4 - BytesPerLine: Word; - PaletteType: Word; // 1: color or s/w 2: grayscale - Reserved2: array [0..57] of Byte; - end; - -{ TPCXFileFormat } - -procedure TPCXFileFormat.Define; -begin - inherited; - FName := SPCXFormatName; - FFeatures := [ffLoad]; - - AddMasks(SPCXMasks); -end; - -function TPCXFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -const - ifMono: TImageFormat = TImageFormat(250); - ifIndex2: TImageFormat = TImageFormat(251); - ifIndex4: TImageFormat = TImageFormat(252); -var - Hdr: TPCXHeader; - PalID, B: Byte; - PalPCX: TPalette24Size256; - FileDataFormat: TImageFormat; - I, J, UncompSize, BytesPerLine, ByteNum, BitNum: LongInt; - UncompData, RowPointer, PixelIdx: PByte; - Pixel24: PColor24Rec; - Pixel32: PColor32Rec; - AlphaPlane, RedPlane, GreenPlane, BluePlane, - Plane1, Plane2, Plane3, Plane4: PByteArray; - - procedure RleDecode(Target: PByte; UnpackedSize: LongInt); - var - Count: LongInt; - Source: Byte; - begin - while UnpackedSize > 0 do - with GetIO do - begin - GetIO.Read(Handle, @Source, SizeOf(Source)); - if (Source and $C0) = $C0 then - begin - // RLE data - Count := Source and $3F; - if UnpackedSize < Count then - Count := UnpackedSize; - Read(Handle, @Source, SizeOf(Source)); - FillChar(Target^, Count, Source); - //Inc(Source); - Inc(Target, Count); - Dec(UnpackedSize, Count); - end - else - begin - // Uncompressed data - Target^ := Source; - Inc(Target); - Dec(UnpackedSize); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read PCX header and store input position (start of image data) - Read(Handle, @Hdr, SizeOf(Hdr)); - FileDataFormat := ifUnknown; - - // Determine image's data format and find its Imaging equivalent - // (using some custom TImageFormat constants) - case Hdr.BitsPerPixel of - 1: - case Hdr.Planes of - 1: FileDataFormat := ifMono; - 4: FileDataFormat := ifIndex4; - end; - 2: FileDataFormat := ifIndex2; - 4: FileDataFormat := ifIndex4; - 8: - case Hdr.Planes of - 1: FileDataFormat := ifIndex8; - 3: FileDataFormat := ifR8G8B8; - 4: FileDataFormat := ifA8R8G8B8; - end; - end; - - // No compatible Imaging format found, exit - if FileDataFormat = ifUnknown then - Exit; - - // Get width, height, and output data format (unsupported formats - // like ifMono are converted later to ifIndex8) - Width := Hdr.X1 - Hdr.X0 + 1; - Height := Hdr.Y1 - Hdr.Y0 + 1; - if FileDataFormat in [ifIndex8, ifR8G8B8] then - Format := FileDataFormat - else - Format := ifIndex8; - - NewImage(Width, Height, Format, Images[0]); - - if not (FileDataFormat in [ifIndex8, ifR8G8B8]) then - begin - // other formats use palette embedded to file header - for I := Low(Hdr.Palette16) to High(Hdr.Palette16) do - begin - Palette[I].A := $FF; - Palette[I].R := Hdr.Palette16[I].B; - Palette[I].G := Hdr.Palette16[I].G; - Palette[I].B := Hdr.Palette16[I].R; - end; - end; - - // Now we determine various data sizes - BytesPerLine := Hdr.BytesPerLine * Hdr.Planes; - UncompSize := BytesPerLine * Height; - - GetMem(UncompData, UncompSize); - try - if Hdr.Encoding = 1 then - begin - // Image data is compressed -> read and decompress - RleDecode(UncompData, UncompSize); - end - else - begin - // Just read uncompressed data - Read(Handle, UncompData, UncompSize); - end; - - if FileDataFormat in [ifR8G8B8, ifA8R8G8B8] then - begin - // RGB and ARGB images are stored in layout different from - // Imaging's (and most other file formats'). First there is - // Width red values then there is Width green values and so on - RowPointer := UncompData; - - if FileDataFormat = ifA8R8G8B8 then - begin - Pixel32 := Bits; - for I := 0 to Height - 1 do - begin - AlphaPlane := PByteArray(RowPointer); - RedPlane := @AlphaPlane[Hdr.BytesPerLine]; - GreenPlane := @AlphaPlane[Hdr.BytesPerLine * 2]; - BluePlane := @AlphaPlane[Hdr.BytesPerLine * 3]; - for J := 0 to Width - 1 do - begin - Pixel32.A := AlphaPlane[J]; - Pixel32.R := RedPlane[J]; - Pixel32.G := GreenPlane[J]; - Pixel32.B := BluePlane[J]; - Inc(Pixel32); - end; - Inc(RowPointer, BytesPerLine); - end; - end - else - begin - Pixel24 := Bits; - for I := 0 to Height - 1 do - begin - RedPlane := PByteArray(RowPointer); - GreenPlane := @RedPlane[Hdr.BytesPerLine]; - BluePlane := @RedPlane[Hdr.BytesPerLine * 2]; - for J := 0 to Width - 1 do - begin - Pixel24.R := RedPlane[J]; - Pixel24.G := GreenPlane[J]; - Pixel24.B := BluePlane[J]; - Inc(Pixel24); - end; - Inc(RowPointer, BytesPerLine); - end; - end; - end - else if FileDataFormat = ifIndex8 then - begin - // Just copy 8bit lines - for I := 0 to Height - 1 do - Move(PByteArray(UncompData)[I * Hdr.BytesPerLine], PByteArray(Bits)[I * Width], Width); - end - else if FileDataFormat = ifMono then - begin - // Convert 1bit images to ifIndex8 - Convert1To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - else if FileDataFormat = ifIndex2 then - begin - // Convert 2bit images to ifIndex8. Note that 2bit PCX images - // usually use (from specs, I've never seen one myself) CGA palette - // which is not array of RGB tripplets. So 2bit PCXs are loaded but - // their colors would be wrong - Convert2To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - else if FileDataFormat = ifIndex4 then - begin - // 4bit images can be stored similar to RGB images (in four one bit planes) - // or like array of nibbles (which is more common) - if (Hdr.BitsPerPixel = 1) and (Hdr.Planes = 4) then - begin - RowPointer := UncompData; - PixelIdx := Bits; - for I := 0 to Height - 1 do - begin - Plane1 := PByteArray(RowPointer); - Plane2 := @Plane1[Hdr.BytesPerLine]; - Plane3 := @Plane1[Hdr.BytesPerLine * 2]; - Plane4 := @Plane1[Hdr.BytesPerLine * 3]; - - for J := 0 to Width - 1 do - begin - B := 0; - ByteNum := J div 8; - BitNum := 7 - (J mod 8); - if (Plane1[ByteNum] shr BitNum) and $1 <> 0 then B := B or $01; - if (Plane2[ByteNum] shr BitNum) and $1 <> 0 then B := B or $02; - if (Plane3[ByteNum] shr BitNum) and $1 <> 0 then B := B or $04; - if (Plane4[ByteNum] shr BitNum) and $1 <> 0 then B := B or $08; - PixelIdx^ := B; - Inc(PixelIdx); - end; - Inc(RowPointer, BytesPerLine); - end; - end - else if (Hdr.BitsPerPixel = 4) and (Hdr.Planes = 1) then - begin - // Convert 4bit images to ifIndex8 - Convert4To8(UncompData, Bits, Width, Height, Hdr.BytesPerLine, False); - end - end; - - if FileDataFormat = ifIndex8 then - begin - // 8bit palette is appended at the end of the file - // with $0C identifier - //Seek(Handle, -769, smFromEnd); - Read(Handle, @PalID, SizeOf(PalID)); - if PalID = $0C then - begin - Read(Handle, @PalPCX, SizeOf(PalPCX)); - for I := Low(PalPCX) to High(PalPCX) do - begin - Palette[I].A := $FF; - Palette[I].R := PalPCX[I].B; - Palette[I].G := PalPCX[I].G; - Palette[I].B := PalPCX[I].R; - end; - end - else - Seek(Handle, -SizeOf(PalID), smFromCurrent); - end; - - finally - FreeMem(UncompData); - end; - Result := True; - end; -end; - -function TPCXFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TPCXHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Hdr)) and - (Hdr.Id = $0A) and - (Hdr.Version in [0, 2, 3, 4, 5]) and - (Hdr.Encoding in [0..1]) and - (Hdr.BitsPerPixel in [1, 2, 4, 8]) and - (Hdr.Planes in [1, 3, 4]) and - (Hdr.PaletteType in [1..2]); - end; - -end; - -initialization - RegisterImageFileFormat(TPCXFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Made loader stream-safe - stream position is exactly at the end of the - image after loading and file size doesn't need to be know during the process. - - Initial TPCXFileFormat class implemented. - -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingPsd.pas b/3rd/Imaging/Extras/Extensions/ImagingPsd.pas deleted file mode 100644 index 96ce9c919..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingPsd.pas +++ /dev/null @@ -1,801 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Photoshop PSD image format.} -unit ImagingPsd; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingUtility; - -type - { Class for loading and saving Adobe Photoshop PSD images. - Loading and saving of indexed, grayscale, RGB(A), HDR (FP32), and CMYK - (auto converted to RGB) images is supported. Non-HDR gray, RGB, - and CMYK images can have 8bit or 16bit color channels. - There is no support for loading mono images, duotone images are treated - like grayscale images, and multichannel and CIE Lab images are loaded as - RGB images but without actual conversion to RGB color space. - Also no layer information is loaded.} - TPSDFileFormat = class(TImageFileFormat) - private - FSaveAsLayer: LongBool; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - property SaveAsLayer: LongBool read FSaveAsLayer write FSaveAsLayer; - end; - -implementation - -uses - ImagingExtras; - -const - SPSDFormatName = 'Photoshop Image'; - SPSDMasks = '*.psd,*.pdd'; - PSDSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, - ifR8G8B8, ifA8R8G8B8, ifGray16, ifA16Gray16, ifR16G16B16, ifA16R16G16B16, - ifR32F, ifR32G32B32F, ifA32R32G32B32F]; - PSDDefaultSaveAsLayer = True; - -const - SPSDMagic = '8BPS'; - CompressionNone: Word = 0; - CompressionRLE: Word = 1; - -type - {$MINENUMSIZE 2} - { PSD Image color mode.} - TPSDColorMode = ( - cmMono = 0, - cmGrayscale = 1, - cmIndexed = 2, - cmRGB = 3, - cmCMYK = 4, - cmMultiChannel = 7, - cmDuoTone = 8, - cmLab = 9 - ); - - { PSD image main header.} - TPSDHeader = packed record - Signature: TChar4; // Format ID '8BPS' - Version: Word; // Always 1 - Reserved: array[0..5] of Byte; // Reserved, all zero - Channels: Word; // Number of color channels (1-24) including alpha channels - Rows : LongWord; // Height of image in pixels (1-30000) - Columns: LongWord; // Width of image in pixels (1-30000) - Depth: Word; // Number of bits per channel (1, 8, and 16) - Mode: TPSDColorMode; // Color mode - end; - - TPSDChannelInfo = packed record - ChannelID: Word; // 0 = Red, 1 = Green, 2 = Blue etc., -1 = Transparency mask, -2 = User mask - Size: LongWord; // Size of channel data. - end; - -procedure SwapHeader(var Header: TPSDHeader); -begin - Header.Version := SwapEndianWord(Header.Version); - Header.Channels := SwapEndianWord(Header.Channels); - Header.Depth := SwapEndianWord(Header.Depth); - Header.Rows := SwapEndianLongWord(Header.Rows); - Header.Columns := SwapEndianLongWord(Header.Columns); - Header.Mode := TPSDColorMode(SwapEndianWord(Word(Header.Mode))); -end; - -{ - TPSDFileFormat class implementation -} - -procedure TPSDFileFormat.Define; -begin - inherited; - FName := SPSDFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := PSDSupportedFormats; - AddMasks(SPSDMasks); - - FSaveAsLayer := PSDDefaultSaveAsLayer; - RegisterOption(ImagingPSDSaveAsLayer, @FSaveAsLayer); -end; - -function TPSDFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Header: TPSDHeader; - ByteCount: LongWord; - RawPal: array[0..767] of Byte; - Compression, PackedSize: Word; - LineSize, ChannelPixelSize, WidthBytes, - CurrChannel, MaxRLESize, I, Y, X: LongInt; - Info: TImageFormatInfo; - PackedLine, LineBuffer: PByte; - RLELineSizes: array of Word; - Col32: TColor32Rec; - Col64: TColor64Rec; - PCol32: PColor32Rec; - PCol64: PColor64Rec; - - { PackBits RLE decode code from Mike Lischke's GraphicEx library.} - procedure DecodeRLE(Source, Dest: PByte; PackedSize, UnpackedSize: LongInt); - var - Count: LongInt; - begin - while (UnpackedSize > 0) and (PackedSize > 0) do - begin - Count := ShortInt(Source^); - Inc(Source); - Dec(PackedSize); - if Count < 0 then - begin - // Replicate next byte -Count + 1 times - if Count = -128 then - Continue; - Count := -Count + 1; - if Count > UnpackedSize then - Count := UnpackedSize; - FillChar(Dest^, Count, Source^); - Inc(Source); - Dec(PackedSize); - Inc(Dest, Count); - Dec(UnpackedSize, Count); - end - else - begin - // Copy next Count + 1 bytes from input - Inc(Count); - if Count > UnpackedSize then - Count := UnpackedSize; - if Count > PackedSize then - Count := PackedSize; - Move(Source^, Dest^, Count); - Inc(Dest, Count); - Inc(Source, Count); - Dec(PackedSize, Count); - Dec(UnpackedSize, Count); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read PSD header - Read(Handle, @Header, SizeOf(Header)); - SwapHeader(Header); - - // Determine image data format - Format := ifUnknown; - case Header.Mode of - cmGrayscale, cmDuoTone: - begin - if Header.Depth in [8, 16] then - begin - if Header.Channels = 1 then - Format := IffFormat(Header.Depth = 8, ifGray8, ifGray16) - else if Header.Channels >= 2 then - Format := IffFormat(Header.Depth = 8, ifA8Gray8, ifA16Gray16); - end - else if (Header.Depth = 32) and (Header.Channels = 1) then - Format := ifR32F; - end; - cmIndexed: - begin - if Header.Depth = 8 then - Format := ifIndex8; - end; - cmRGB, cmMultiChannel, cmCMYK, cmLab: - begin - if Header.Depth in [8, 16] then - begin - if Header.Channels = 3 then - Format := IffFormat(Header.Depth = 8, ifR8G8B8, ifR16G16B16) - else if Header.Channels >= 4 then - Format := IffFormat(Header.Depth = 8, ifA8R8G8B8, ifA16R16G16B16); - end - else if Header.Depth = 32 then - begin - if Header.Channels = 3 then - Format := ifR32G32B32F - else if Header.Channels >= 4 then - Format := ifA32R32G32B32F; - end; - end; - cmMono:; // Not supported - end; - - // Exit if no compatible format was found - if Format = ifUnknown then - Exit; - - NewImage(Header.Columns, Header.Rows, Format, Images[0]); - Info := GetFormatInfo(Format); - - // Read or skip Color Mode Data Block (palette) - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianLongWord(ByteCount); - if Format = ifIndex8 then - begin - // Read palette only for indexed images - Read(Handle, @RawPal, SizeOf(RawPal)); - for I := 0 to 255 do - begin - Palette[I].A := $FF; - Palette[I].R := RawPal[I + 0]; - Palette[I].G := RawPal[I + 256]; - Palette[I].B := RawPal[I + 512]; - end; - end - else - Seek(Handle, ByteCount, smFromCurrent); - - // Skip Image Resources Block - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianLongWord(ByteCount); - Seek(Handle, ByteCount, smFromCurrent); - // Now there is Layer and Mask Information Block - Read(Handle, @ByteCount, SizeOf(ByteCount)); - ByteCount := SwapEndianLongWord(ByteCount); - // Skip Layer and Mask Information Block - Seek(Handle, ByteCount, smFromCurrent); - - // Read compression flag - Read(Handle, @Compression, SizeOf(Compression)); - Compression := SwapEndianWord(Compression); - - if Compression = CompressionRLE then - begin - // RLE compressed PSDs (most) have first lengths of compressed scanlines - // for each channel stored - SetLength(RLELineSizes, Height * Header.Channels); - Read(Handle, @RLELineSizes[0], Length(RLELineSizes) * SizeOf(Word)); - SwapEndianWord(@RLELineSizes[0], Height * Header.Channels); - MaxRLESize := RLELineSizes[0]; - for I := 1 to High(RLELineSizes) do - begin - if MaxRLESize < RLELineSizes[I] then - MaxRLESize := RLELineSizes[I]; - end; - end - else - MaxRLESize := 0; - - ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount; - LineSize := Width * ChannelPixelSize; - WidthBytes := Width * Info.BytesPerPixel; - GetMem(LineBuffer, LineSize); - GetMem(PackedLine, MaxRLESize); - - try - // Image color chanels are stored separately in PSDs so we will load - // one by one and copy their data to appropriate addresses of dest image. - for I := 0 to Header.Channels - 1 do - begin - // Now determine to which color channel of destination image we are going - // to write pixels. - if I <= 4 then - begin - // If PSD has alpha channel we need to switch current channel order - - // PSDs have alpha stored after blue channel but Imaging has alpha - // before red. - if Info.HasAlphaChannel and (Header.Mode <> cmCMYK) then - begin - if I = Info.ChannelCount - 1 then - CurrChannel := I - else - CurrChannel := Info.ChannelCount - 2 - I; - end - else - CurrChannel := Info.ChannelCount - 1 - I; - end - else - begin - // No valid channel remains - CurrChannel := -1; - end; - - if CurrChannel >= 0 then - begin - for Y := 0 to Height - 1 do - begin - if Compression = CompressionRLE then - begin - // Read RLE line and decompress it - PackedSize := RLELineSizes[I * Height + Y]; - Read(Handle, PackedLine, PackedSize); - DecodeRLE(PackedLine, LineBuffer, PackedSize, LineSize); - end - else - begin - // Just read uncompressed line - Read(Handle, LineBuffer, LineSize); - end; - - // Swap endian if needed - if ChannelPixelSize = 4 then - SwapEndianLongWord(PLongWord(LineBuffer), Width) - else if ChannelPixelSize = 2 then - SwapEndianWord(PWordArray(LineBuffer), Width); - - if Info.ChannelCount > 1 then - begin - // Copy each pixel fragment to its right place in destination image - for X := 0 to Width - 1 do - begin - Move(PByteArray(LineBuffer)[X * ChannelPixelSize], - PByteArray(Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize], - ChannelPixelSize); - end; - end - else - begin - // Just copy the line - Move(LineBuffer^, PByteArray(Bits)[Y * LineSize], LineSize); - end; - end; - end - else - begin - // Skip current color channel, not needed for image loading - just to - // get stream's position to the end of PSD - if Compression = CompressionRLE then - begin - for Y := 0 to Height - 1 do - Seek(Handle, RLELineSizes[I * Height + Y], smFromCurrent); - end - else - Seek(Handle, LineSize * Height, smFromCurrent); - end; - end; - - if Header.Mode = cmCMYK then - begin - // Convert CMYK images to RGB (alpha is ignored here). PSD stores CMYK - // channels in the way that first requires substraction from max channel value - if ChannelPixelSize = 1 then - begin - PCol32 := Bits; - for X := 0 to Width * Height - 1 do - begin - Col32.A := 255 - PCol32.A; - Col32.R := 255 - PCol32.R; - Col32.G := 255 - PCol32.G; - Col32.B := 255 - PCol32.B; - CMYKToRGB(Col32.A, Col32.R, Col32.G, Col32.B, PCol32.R, PCol32.G, PCol32.B); - PCol32.A := 255; - Inc(PCol32); - end; - end - else - begin - PCol64 := Bits; - for X := 0 to Width * Height - 1 do - begin - Col64.A := 65535 - PCol64.A; - Col64.R := 65535 - PCol64.R; - Col64.G := 65535 - PCol64.G; - Col64.B := 65535 - PCol64.B; - CMYKToRGB16(Col64.A, Col64.R, Col64.G, Col64.B, PCol64.R, PCol64.G, PCol64.B); - PCol64.A := 65535; - Inc(PCol64); - end; - end; - end; - - Result := True; - finally - FreeMem(LineBuffer); - FreeMem(PackedLine); - end; - end; -end; - -function TPSDFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -type - TURect = packed record - Top, Left, Bottom, Right: LongWord; - end; -const - BlendMode: TChar8 = '8BIMnorm'; - LayerOptions: array[0..3] of Byte = (255, 0, 0, 0); - LayerName: array[0..7] of AnsiChar = #7'Layer 0'; -var - MustBeFreed: Boolean; - ImageToSave: TImageData; - Info: TImageFormatInfo; - Header: TPSDHeader; - I, CurrChannel, ChannelPixelSize: LongInt; - LayerBlockOffset, SaveOffset, ChannelInfoOffset: Integer; - ChannelInfo: TPSDChannelInfo; - R: TURect; - LongVal: LongWord; - WordVal, LayerCount: Word; - RawPal: array[0..767] of Byte; - ChannelDataSizes: array of Integer; - - function PackLine(Src, Dest: PByteArray; Length: Integer): Integer; - var - I, Remaining: Integer; - begin - Remaining := Length; - Result := 0; - while Remaining > 0 do - begin - I := 0; - // Look for characters same as the first - while (I < 128) and (Remaining - I > 0) and (Src[0] = Src[I]) do - Inc(I); - - if I > 2 then - begin - Dest[0] := Byte(-(I - 1)); - Dest[1] := Src[0]; - Dest := PByteArray(@Dest[2]); - - Src := PByteArray(@Src[I]); - Dec(Remaining, I); - Inc(Result, 2); - end - else - begin - // Look for different characters - I := 0; - while (I < 128) and (Remaining - (I + 1) > 0) and - ((Src[I] <> Src[I + 1]) or (Remaining - (I + 2) <= 0) or - (Src[I] <> Src[I + 2])) do - begin - Inc(I); - end; - // If there's only 1 remaining, the previous WHILE doesn't catch it - if Remaining = 1 then - I := 1; - - if I > 0 then - begin - // Some distinct ones found - Dest[0] := I - 1; - Move(Src[0], Dest[1], I); - Dest := PByteArray(@Dest[1 + I]); - Src := PByteArray(@Src[I]); - Dec(Remaining, I); - Inc(Result, I + 1); - end; - end; - end; - end; - - procedure WriteChannelData(SeparateChannelStorage: Boolean); - var - I, X, Y, LineSize, WidthBytes, RLETableOffset, CurrentOffset, WrittenLineSize: Integer; - LineBuffer, RLEBuffer: PByteArray; - RLELengths: array of Word; - Compression: Word; - begin - LineSize := ImageToSave.Width * ChannelPixelSize; - WidthBytes := ImageToSave.Width * Info.BytesPerPixel; - GetMem(LineBuffer, LineSize); - GetMem(RLEBuffer, LineSize * 3); - SetLength(RLELengths, ImageToSave.Height * Info.ChannelCount); - RLETableOffset := 0; - // No compression for FP32, Photoshop won't open them - Compression := Iff(Info.IsFloatingPoint, CompressionNone, CompressionRLE); - - if not SeparateChannelStorage then - begin - // This is for storing background merged image. There's only one - // compression flag and one RLE lenghts table for all channels - WordVal := Swap(Compression); - GetIO.Write(Handle, @WordVal, SizeOf(WordVal)); - if Compression = CompressionRLE then - begin - RLETableOffset := GetIO.Tell(Handle); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount); - end; - end; - - for I := 0 to Info.ChannelCount - 1 do - begin - if SeparateChannelStorage then - begin - // Layer image data has compression flag and RLE lenghts table - // independent for each channel - WordVal := Swap(CompressionRLE); - GetIO.Write(Handle, @WordVal, SizeOf(WordVal)); - if Compression = CompressionRLE then - begin - RLETableOffset := GetIO.Tell(Handle); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height); - ChannelDataSizes[I] := 0; - end; - end; - - // Now determine which color channel we are going to write to file. - if Info.HasAlphaChannel then - begin - if I = Info.ChannelCount - 1 then - CurrChannel := I - else - CurrChannel := Info.ChannelCount - 2 - I; - end - else - CurrChannel := Info.ChannelCount - 1 - I; - - for Y := 0 to ImageToSave.Height - 1 do - begin - if Info.ChannelCount > 1 then - begin - // Copy each pixel fragment to its right place in destination image - for X := 0 to ImageToSave.Width - 1 do - begin - Move(PByteArray(ImageToSave.Bits)[Y * WidthBytes + X * Info.BytesPerPixel + CurrChannel * ChannelPixelSize], - PByteArray(LineBuffer)[X * ChannelPixelSize], ChannelPixelSize); - end; - end - else - Move(PByteArray(ImageToSave.Bits)[Y * LineSize], LineBuffer^, LineSize); - - // Write current channel line to file (swap endian if needed first) - if ChannelPixelSize = 4 then - SwapEndianLongWord(PLongWord(LineBuffer), ImageToSave.Width) - else if ChannelPixelSize = 2 then - SwapEndianWord(PWordArray(LineBuffer), ImageToSave.Width); - - if Compression = CompressionRLE then - begin - // Compress and write line - WrittenLineSize := PackLine(LineBuffer, RLEBuffer, LineSize); - RLELengths[ImageToSave.Height * I + Y] := SwapEndianWord(WrittenLineSize); - GetIO.Write(Handle, RLEBuffer, WrittenLineSize); - end - else - begin - WrittenLineSize := LineSize; - GetIO.Write(Handle, LineBuffer, WrittenLineSize); - end; - - if SeparateChannelStorage then - Inc(ChannelDataSizes[I], WrittenLineSize); - end; - - if SeparateChannelStorage and (Compression = CompressionRLE) then - begin - // Update channel RLE lengths - CurrentOffset := GetIO.Tell(Handle); - GetIO.Seek(Handle, RLETableOffset, smFromBeginning); - GetIO.Write(Handle, @RLELengths[ImageToSave.Height * I], SizeOf(Word) * ImageToSave.Height); - GetIO.Seek(Handle, CurrentOffset, smFromBeginning); - Inc(ChannelDataSizes[I], SizeOf(Word) * ImageToSave.Height); - end; - end; - - if not SeparateChannelStorage and (Compression = CompressionRLE) then - begin - // Update channel RLE lengths - CurrentOffset := GetIO.Tell(Handle); - GetIO.Seek(Handle, RLETableOffset, smFromBeginning); - GetIO.Write(Handle, @RLELengths[0], SizeOf(Word) * ImageToSave.Height * Info.ChannelCount); - GetIO.Seek(Handle, CurrentOffset, smFromBeginning); - end; - - FreeMem(LineBuffer); - FreeMem(RLEBuffer); - end; - -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - ChannelPixelSize := Info.BytesPerPixel div Info.ChannelCount; - - // Fill header with proper info and save it - FillChar(Header, SizeOf(Header), 0); - Header.Signature := SPSDMagic; - Header.Version := 1; - Header.Channels := Info.ChannelCount; - Header.Rows := Height; - Header.Columns := Width; - Header.Depth := Info.BytesPerPixel div Info.ChannelCount * 8; - if Info.IsIndexed then - Header.Mode := cmIndexed - else if Info.HasGrayChannel or (Info.ChannelCount = 1) then - Header.Mode := cmGrayscale - else - Header.Mode := cmRGB; - - SwapHeader(Header); - Write(Handle, @Header, SizeOf(Header)); - - // Write palette size and data - LongVal := SwapEndianLongWord(IffUnsigned(Info.IsIndexed, SizeOf(RawPal), 0)); - Write(Handle, @LongVal, SizeOf(LongVal)); - if Info.IsIndexed then - begin - for I := 0 to Info.PaletteEntries - 1 do - begin - RawPal[I] := Palette[I].R; - RawPal[I + 256] := Palette[I].G; - RawPal[I + 512] := Palette[I].B; - end; - Write(Handle, @RawPal, SizeOf(RawPal)); - end; - - // Write empty resource and layer block sizes - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); - LayerBlockOffset := Tell(Handle); - Write(Handle, @LongVal, SizeOf(LongVal)); - - if FSaveAsLayer and (ChannelPixelSize < 4) then // No Layers for FP32 images - begin - LayerCount := SwapEndianWord(Iff(Info.HasAlphaChannel, Word(-1), 1)); // Must be -1 to get transparency in Photoshop - R.Top := 0; - R.Left := 0; - R.Bottom := SwapEndianLongWord(Height); - R.Right := SwapEndianLongWord(Width); - WordVal := SwapEndianWord(Info.ChannelCount); - Write(Handle, @LongVal, SizeOf(LongVal)); // Layer section size, empty now - Write(Handle, @LayerCount, SizeOf(LayerCount)); // Layer count - Write(Handle, @R, SizeOf(R)); // Bounds rect - Write(Handle, @WordVal, SizeOf(WordVal)); // Channel count - - ChannelInfoOffset := Tell(Handle); - SetLength(ChannelDataSizes, Info.ChannelCount); // Empty channel infos - FillChar(ChannelInfo, SizeOf(ChannelInfo), 0); - for I := 0 to Info.ChannelCount - 1 do - Write(Handle, @ChannelInfo, SizeOf(ChannelInfo)); - - Write(Handle, @BlendMode, SizeOf(BlendMode)); // Blend mode = normal - Write(Handle, @LayerOptions, SizeOf(LayerOptions)); // Predefined options - LongVal := SwapEndianLongWord(16); // Extra data size (4 (mask size) + 4 (ranges size) + 8 (name)) - Write(Handle, @LongVal, SizeOf(LongVal)); - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); // Mask size = 0 - LongVal := 0; - Write(Handle, @LongVal, SizeOf(LongVal)); // Blend ranges size - Write(Handle, @LayerName, SizeOf(LayerName)); // Layer name - - WriteChannelData(True); // Write Layer image data - - Write(Handle, @LongVal, SizeOf(LongVal)); // Global mask info size = 0 - - SaveOffset := Tell(Handle); - Seek(Handle, LayerBlockOffset, smFromBeginning); - - // Update layer and mask section sizes - LongVal := SwapEndianLongWord(SaveOffset - LayerBlockOffset - 4); - Write(Handle, @LongVal, SizeOf(LongVal)); - LongVal := SwapEndianLongWord(SaveOffset - LayerBlockOffset - 8); - Write(Handle, @LongVal, SizeOf(LongVal)); - - // Update layer channel info - Seek(Handle, ChannelInfoOffset, smFromBeginning); - for I := 0 to Info.ChannelCount - 1 do - begin - ChannelInfo.ChannelID := SwapEndianWord(I); - if (I = Info.ChannelCount - 1) and Info.HasAlphaChannel then - ChannelInfo.ChannelID := Swap(Word(-1)); - ChannelInfo.Size := SwapEndianLongWord(ChannelDataSizes[I] + 2); // datasize (incl RLE table) + comp. flag - Write(Handle, @ChannelInfo, SizeOf(ChannelInfo)); - end; - - Seek(Handle, SaveOffset, smFromBeginning); - end; - - // Write background merged image - WriteChannelData(False); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TPSDFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - begin - if Info.ChannelCount = 1 then - ConvFormat := ifR32F - else if Info.HasAlphaChannel then - ConvFormat := ifA32R32G32B32F - else - ConvFormat := ifR32G32B32F; - end - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16) - else if Info.RBSwapFormat in GetSupportedFormats then - ConvFormat := Info.RBSwapFormat - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(Image, ConvFormat); -end; - -function TPSDFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Header: TPSDHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Header, SizeOf(Header)); - SwapHeader(Header); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Header)) and - (Header.Signature = SPSDMagic) and - (Header.Version = 1); - end; -end; - -initialization - RegisterImageFileFormat(TPSDFileFormat); - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - 3 channel RGB float images are loaded and saved directly - as ifR32G32B32F. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - PSDs are now saved with RLE compression. - - Mask layer saving added to SaveData for images with alpha - (shows proper transparency when opened in Photoshop). Can be - enabled/disabled using option - - Fixed memory leak in SaveData. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Saving implemented. - - Loading implemented. - - Unit created with initial stuff! -} - -end. - diff --git a/3rd/Imaging/Extras/Extensions/ImagingSDL.pas b/3rd/Imaging/Extras/Extensions/ImagingSDL.pas deleted file mode 100644 index eddf203e9..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingSDL.pas +++ /dev/null @@ -1,393 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for loading/saving SDL surfaces using Imaging - and for converting images to surfaces and vice versa.} -unit ImagingSDL; - -{$I ImagingOptions.inc} - -interface - -uses - Classes, sdl, ImagingTypes, Imaging, ImagingUtility; - -type - { This SDL type is redefined here so ImagingExport unit does not - need sdl unit in the uses list.} - PSDL_Surface = sdl.PSDL_Surface; - -{ LoadSDLSurfaceFromFile and similar functions use SDL_SWSURFACE as Flags when creating - SDL surface. If you want other Flags to be used load image by standard - LoadImageFromFile and similar functions and then call CreateSDLSurfaceFromImage - which has more options.} - -{ Creates SDL surface from image in file in format supported by Imaging.} -function LoadSDLSurfaceFromFile(const FileName: string): PSDL_Surface; -{ Creates SDL surface from image in stream in format supported by Imaging.} -function LoadSDLSurfaceFromStream(Stream: TStream): PSDL_Surface; -{ Creates SDL surface from image in memory in format supported by Imaging.} -function LoadSDLSurfaceFromMemory(Data: Pointer; Size: LongInt): PSDL_Surface; - -{ Converts image to SDL surface. Flags is used when creating SDL surface - using SDL_CreateRGBSurface and is passed to it. OverrideFormat can be - used to convert image to specified format before SDL surface is created, - ifUnknown means no conversion.} -function CreateSDLSurfaceFromImage(const ImageData: TImageData; - Flags: LongWord; OverrideFormat: TImageFormat = ifUnknown): PSDL_Surface; - -{ Saves SDL surface to file in one of the formats supported by Imaging.} -function SaveSDLSurfaceToFile(const FileName: string; Surface: PSDL_Surface): Boolean; -{ Saves SDL surface to stream in one of the formats supported by Imaging defined by Ext.} -function SaveSDLSurfaceToStream(const Ext: string; Stream: TStream; Surface: PSDL_Surface): Boolean; -{ Saves SDL surface to memory in one of the formats supported by Imaging defined - by Ext. Size must contain size of available memory before the function - is called and memory size taken up by the image is returned in this parameter.} -function SaveSDLSurfaceToMemory(const Ext: string; Data: Pointer; var Size: LongInt; Surface: PSDL_Surface): Boolean; - -{ Converts SDL surface to TImageData structure. OverrideFormat can be - used to convert output image to the specified format rather than - use the format taken from SDL surface, ifUnknown means no conversion.} -function CreateImageFromSDLSurface(Surface: PSDL_Surface; var ImageData: TImageData; - OverrideFormat: TImageFormat = ifUnknown): Boolean; - -implementation - -const - DefaultFlags = SDL_SWSURFACE; - -function Iff(Condition: Boolean; const TruePart, FalsePart: TImageFormat): TImageFormat; overload; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function LoadSDLSurfaceFromFile(const FileName: string): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromFile(FileName, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function LoadSDLSurfaceFromStream(Stream: TStream): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromStream(Stream, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function LoadSDLSurfaceFromMemory(Data: Pointer; Size: LongInt): PSDL_Surface; -var - ImageData: TImageData; -begin - InitImage(ImageData); - if LoadImageFromMemory(Data, Size, ImageData) then - Result := CreateSDLSurfaceFromImage(ImageData, DefaultFlags) - else - Result := nil; - FreeImage(ImageData); -end; - -function CreateSDLSurfaceFromImage(const ImageData: TImageData; - Flags: LongWord; OverrideFormat: TImageFormat): PSDL_Surface; -var - WorkData: TImageData; - Info: TImageFormatInfo; - ConvFormat: TImageFormat; - AMask, RMask, GMask, BMask: LongWord; - I, LineBytes: LongInt; - - procedure DetermineSDLMasks(var AMask, RMask, GMask, BMask: LongWord); - begin - if Info.UsePixelFormat then - begin - AMask := Info.PixelFormat.ABitMask; - RMask := Info.PixelFormat.RBitMask; - GMask := Info.PixelFormat.GBitMask; - BMask := Info.PixelFormat.BBitMask; - end - else - begin - AMask := IffUnsigned(Info.HasAlphaChannel, $FF000000, 0); - RMask := $00FF0000; - GMask := $0000FF00; - BMask := $000000FF; - end; - end; - -begin - Result := nil; - if TestImage(ImageData) then - begin - InitImage(WorkData); - CloneImage(ImageData, WorkData); - // Image is converted to override format - if OverrideFormat <> ifUnknown then - ConvertImage(WorkData, OverrideFormat); - - GetImageFormatInfo(WorkData.Format, Info); - // Image is first converted to format supported by SDL - if Info.IsFloatingPoint or Info.IsSpecial then - ConvFormat := ifA8R8G8B8 - else - if Info.UsePixelFormat then - begin - if Info.BytesPerPixel < 2 then - ConvFormat := Iff(Info.HasAlphaChannel, ifA4R4G4B4, ifR5G6B5) - else - ConvFormat := WorkData.Format; - end - else - if Info.IsIndexed then - ConvFormat := ifIndex8 - else - ConvFormat := Iff(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - - ConvertImage(WorkData, ConvFormat); - GetImageFormatInfo(WorkData.Format, Info); - // Channel masks are determined based on image's format, - // only 8/16/24/32bit images should be here now - DetermineSDLMasks(AMask, RMask, GMask, BMask); - - // SDL surface is created - Result := SDL_CreateRGBSurface(Flags, WorkData.Width, WorkData.Height, - Info.BytesPerPixel * 8, RMask, GMask, BMask, AMask); - - if Result <> nil then - begin - LineBytes := Info.BytesPerPixel * WorkData.Width; - - if SDL_MustLock(Result) then - SDL_LockSurface(Result); - - // Pixels of image are copied to SDL surface - if LineBytes = Result.pitch then - Move(WorkData.Bits^, Result.pixels^, WorkData.Size) - else - for I := 0 to WorkData.Height - 1 do - Move(PByteArray(WorkData.Bits)[I * LineBytes], - PByteArray(Result.pixels)[I * Result.pitch], LineBytes); - - if SDL_MustLock(Result) then - SDL_UnlockSurface(Result); - - // If surface is in indexed format, palette is copied - if (Info.Format = ifIndex8) and (Result.format.palette <> nil) then - begin - Result.format.palette.ncolors := Info.PaletteEntries; - for I := 0 to Info.PaletteEntries - 1 do - begin - Result.format.palette.colors[I].r := WorkData.Palette[I].R; - Result.format.palette.colors[I].g := WorkData.Palette[I].G; - Result.format.palette.colors[I].b := WorkData.Palette[I].B; - Result.format.palette.colors[I].unused := 0; - end; - end; - end; - - FreeImage(WorkData); - end; -end; - -function SaveSDLSurfaceToFile(const FileName: string; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToFile(FileName, ImageData); - FreeImage(ImageData); - end; -end; - -function SaveSDLSurfaceToStream(const Ext: string; Stream: TStream; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToStream(Ext, Stream, ImageData); - FreeImage(ImageData); - end; -end; - -function SaveSDLSurfaceToMemory(const Ext: string; Data: Pointer; var Size: LongInt; Surface: PSDL_Surface): Boolean; -var - ImageData: TImageData; -begin - Result := False; - if CreateImageFromSDLSurface(Surface, ImageData) then - begin - Result := SaveImageToMemory(Ext, Data, Size, ImageData); - FreeImage(ImageData); - end; -end; - -function CreateImageFromSDLSurface(Surface: PSDL_Surface; var ImageData: TImageData; - OverrideFormat: TImageFormat): Boolean; -const - SDL_A8R8G8B8Format: TSDL_PixelFormat = (palette: nil; BitsPerPixel: 32; - BytesPerPixel: 4; Rloss: 0; Gloss: 0; Bloss: 0; Aloss: 0; - Rshift: 16; Gshift: 8; Bshift: 0; Ashift: 24; - Rmask: $00FF0000; Gmask: $0000FF00; Bmask: $000000FF; Amask: $FF000000; - colorkey: 0; alpha: $FF); -var - Format: TImageFormat; - Converted: PSDL_Surface; - Info: TImageFormatInfo; - I, LineBytes: LongInt; - - function DetermineImageFormat: TImageFormat; - var - Fmt: TImageFormat; - begin - Result := ifUnknown; - case Surface.format.BitsPerPixel of - 8: Result := ifIndex8; - 16: - begin - // go trough 16bit formats supported by Imaging and - // if there is one that matches SDL format's masks then use it - for Fmt := ifR5G6B5 to ifX4R4G4B4 do - begin - GetImageFormatInfo(Fmt, Info); - if (Info.PixelFormat.ABitMask = Surface.format.AMask) and - (Info.PixelFormat.RBitMask = Surface.format.RMask) and - (Info.PixelFormat.GBitMask = Surface.format.GMask) and - (Info.PixelFormat.BBitMask = Surface.format.BMask) then - begin - Result := Fmt; - Break; - end; - end; - end; - 24: - begin - if (Surface.format.RMask = $FF0000) and - (Surface.format.GMask = $00FF00) and - (Surface.format.BMask = $0000FF) then - Result := ifR8G8B8; - end; - 32: - begin - if (Surface.format.RMask = $00FF0000) and - (Surface.format.GMask = $0000FF00) and - (Surface.format.BMask = $000000FF) then - if (Surface.format.AMask = $FF000000) then - Result := ifA8R8G8B8 - else - Result := ifX8R8G8B8 - end; - end; - end; - -begin - Result := False; - FreeImage(ImageData); - - // See if surface is in format supported by Imaging and if it is - // not then it is converted to A8R8G8B8 - Format := DetermineImageFormat; - if Format = ifUnknown then - begin - Converted := SDL_ConvertSurface(Surface, @SDL_A8R8G8B8Format, SDL_SWSURFACE); - Format := ifA8R8G8B8; - end - else - Converted := Surface; - - if (Converted <> nil) and NewImage(Converted.w, Converted.h, Format, ImageData) then - begin - GetImageFormatInfo(Format, Info); - LineBytes := Info.BytesPerPixel * ImageData.Width; - - if SDL_MustLock(Converted) then - SDL_LockSurface(Converted); - - // New image is created and pixels are copied from SDL surface - if LineBytes = Converted.pitch then - Move(Converted.pixels^, ImageData.Bits^, ImageData.Size) - else - for I := 0 to ImageData.Height - 1 do - Move(PByteArray(Converted.pixels)[I * Converted.pitch], - PByteArray(ImageData.Bits)[I * LineBytes], LineBytes); - - if SDL_MustLock(Converted) then - SDL_UnlockSurface(Converted); - - // Copy palette if necessary - // If surface is in indexed format, palette is copied - if (Info.Format = ifIndex8) and (Converted.format.palette <> nil) then - begin - for I := 0 to Min(Info.PaletteEntries, Converted.format.palette.ncolors) - 1 do - begin - ImageData.Palette[I].A := 255; - ImageData.Palette[I].R := Converted.format.palette.colors[I].r; - ImageData.Palette[I].G := Converted.format.palette.colors[I].g; - ImageData.Palette[I].B := Converted.format.palette.colors[I].b; - end; - end; - - // Image is converted to override format - if OverrideFormat <> ifUnknown then - ConvertImage(ImageData, OverrideFormat); - - Result := True; - end; - - if Converted <> Surface then - SDL_FreeSurface(Converted); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Fixed possible int overflow in CreateSDLSurfaceFromImage. - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - unit created and initial stuff added -} - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingSquishLib.pas b/3rd/Imaging/Extras/Extensions/ImagingSquishLib.pas deleted file mode 100644 index 4d6c763fb..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingSquishLib.pas +++ /dev/null @@ -1,170 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ High quality DXTC compressor using Squish library (dynamicaly linked).} -unit ImagingSquishLib; - -interface - -{$I ImagingOptions.inc} - -uses - ImagingTypes, Imaging, ImagingFormats; - -type - TDXTCompressor = ( - dcClusterFit, // Use a slow but high quality colour compressor (the default). - dcRangeFit, // Use a fast but low quality colour compressor. - dcClusterFitAlphaWeighted // Cluster fit that weights the colour by alpha. - // For images that are rendered using alpha blending, - // this can significantly increase the perceived quality. - ); - - TColorMetric = ( - cmPerceptual, // Use a perceptual metric for colour error (the default). - cmUniform // Use a uniform metric for colour error. - ); - -{ Compresses SrcImage using selected DXTn compression into DestImage. - DestImage should be cleared before calling.} -procedure DXTCompressImage(const SrcImage: TImageData; var DestImage: TImageData; - DXTFormat: TImageFormat; Compressor: TDXTCompressor = dcClusterFit; - Metric: TColorMetric = cmPerceptual); - -implementation - -const - FlagDXT1 = 1 shl 0; - FlagDXT3 = 1 shl 1; - FlagDXT5 = 1 shl 2; - FlagColourClusterFit = 1 shl 3; - FlagColourRangeFit = 1 shl 4; - FlagColourMetricPerceptual = 1 shl 5; - FlagColourMetricUniform = 1 shl 6; - FlagWeightColourByAlpha = 1 shl 7; - -(* @brief Compresses an image in memory. - - @param rgba The pixels of the source. - @param width The width of the source image. - @param height The height of the source image. - @param blocks Storage for the compressed output. - @param flags Compression flags. - - The source pixels should be presented as a contiguous array of width*height - rgba values, with each component as 1 byte each. In memory this should be: - - { r1, g1, b1, a1, .... , rn, gn, bn, an } for n = width*height - - The flags parameter should specify either kDxt1, kDxt3 or kDxt5 compression, - however, DXT1 will be used by default if none is specified. When using DXT1 - compression, 8 bytes of storage are required for each compressed DXT block. - DXT3 and DXT5 compression require 16 bytes of storage per block. - - The flags parameter can also specify a preferred colour compressor and - colour error metric to use when fitting the RGB components of the data. - Possible colour compressors are: kColourClusterFit (the default) or - kColourRangeFit. Possible colour error metrics are: kColourMetricPerceptual - (the default) or kColourMetricUniform. If no flags are specified in any - particular category then the default will be used. Unknown flags are - ignored. - - When using kColourClusterFit, an additional flag can be specified to - weight the colour of each pixel by its alpha value. For images that are - rendered using alpha blending, this can significantly increase the - perceived quality. - - Internally this function calls squish::Compress for each block. To see how - much memory is required in the compressed image, use - squish::GetStorageRequirements. -*) - -procedure CompressImage(RGBA: PByte; Width, Height: Integer; Blocks: Pointer; - Flags: Integer); cdecl; external 'libsquish.dll'; - - -procedure DXTCompressImage(const SrcImage: TImageData; var DestImage: TImageData; - DXTFormat: TImageFormat; Compressor: TDXTCompressor = dcClusterFit; - Metric: TColorMetric = cmPerceptual); -var - Width, Height: Integer; - Info: TImageFormatInfo; - TempImage: TImageData; - Flags: Integer; - - function GetSquishFlags: Integer; - begin - Result := 0; - - case DXTFormat of - ifDXT1: Result := FlagDXT1; - ifDXT3: Result := FlagDXT3; - ifDXT5: Result := FlagDXT5; - end; - - case Compressor of - dcClusterFit: Result := Result or FlagColourClusterFit; - dcRangeFit: Result := Result or FlagColourRangeFit; - dcClusterFitAlphaWeighted: Result := Result or FlagColourClusterFit or FlagWeightColourByAlpha; - end; - - case Metric of - cmPerceptual: Result := Result or FlagColourMetricPerceptual; - cmUniform: Result := Result or FlagColourMetricUniform; - end; - end; - -begin - Assert(DXTFormat in [ifDXT1, ifDXT3, ifDXT5]); - - Width := SrcImage.Width; - Height := SrcImage.Height; - Flags := GetSquishFlags; - - // Check if input has correct dimensions and change them if needed - GetImageFormatInfo(DXTFormat, Info); - Info.CheckDimensions(DXTFormat, Width, Height); - - try - // Create temp image as input for squish (must be ABGR order with - // dimensions being multiples of 4) - NewImage(Width, Height, ifA8R8G8B8, TempImage); - CopyRect(SrcImage, 0, 0, SrcImage.Width, SrcImage.Height, TempImage, 0, 0); - SwapChannels(TempImage, ChannelRed, ChannelBlue); - - // Init and create out image - InitImage(DestImage); - NewImage(Width, Height, DXTFormat, DestImage); - - // Finally call Squish - CompressImage(TempImage.Bits, Width, Height, DestImage.Bits, Flags); - finally - FreeImage(TempImage); - end; -end; - -end. diff --git a/3rd/Imaging/Extras/Extensions/ImagingXpm.pas b/3rd/Imaging/Extras/Extensions/ImagingXpm.pas deleted file mode 100644 index fc91a8dc8..000000000 --- a/3rd/Imaging/Extras/Extensions/ImagingXpm.pas +++ /dev/null @@ -1,582 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader for X Window Pixmap images. } -unit ImagingXpm; -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Contnrs, ImagingTypes, Imaging, ImagingUtility, - ImagingFormats, ImagingIO, ImagingCanvases; - -type - { Class for loading X Window Pixmap images known as XPM. - It is ASCII-text-based format, basicaly a fragment of C code - declaring static array. Loaded image is in ifA8R8G8B8 data format. - Loading as well as saving is supported now. } - TXPMFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -const - SXPMFormatName = 'X Window Pixmap'; - SXPMMasks = '*.xpm'; - XPMSupportedFormats: TImageFormats = [ifA8R8G8B8]; - -const - SXPMId = '/* XPM */'; - WhiteSpaces = [#9, #10, #13, #32]; - -const - BucketCount = 257; - -type - TColorHolder = class - public - Color: TColor32; - end; - - TBucketItem = record - Key: TColor32; - Data: string[8]; - end; - - TBucketItemArray = array of TBucketItem; - - TBucket = record - Count: Integer; - ItemIdxStart: Integer; - Items: TBucketItemArray; - end; - - TBucketArray = array of TBucket; - - { Simple color-string hash table for faster than linear searches - during XPM saving. } - TSimpleBucketList = class - private - FBuckets: TBucketArray; - FItemCount: Integer; - FABucket, FAIndex: Integer; - function GetData(AKey: TColor32): string; - procedure SetData(AKey: TColor32; const AData: string); - function FindItem(AKey: TColor32; out ABucket, AIndex: Integer): Boolean; - public - constructor Create; - procedure Add(AKey: TColor32; const AData: string); - function Exists(AKey: TColor32): Boolean; - function EnumNext(out AData: string): TColor32; - property Data[AKey: TColor32]: string read GetData write SetData; default; - property ItemCount: Integer read FItemCount; - end; - - { TSimpleBucketList } - -constructor TSimpleBucketList.Create; -begin - SetLength(FBuckets, BucketCount); -end; - -function TSimpleBucketList.GetData(AKey: TColor32): string; -var - Bucket, Index: Integer; -begin - Result := ''; - if FindItem(AKey, Bucket, Index) then - Result := string(FBuckets[Bucket].Items[Index].Data); -end; - -procedure TSimpleBucketList.SetData(AKey: TColor32; const AData: string); -var - Bucket, Index: Integer; -begin - if FindItem(AKey, Bucket, Index) then - FBuckets[Bucket].Items[Index].Data := ShortString(AData); -end; - -function TSimpleBucketList.EnumNext(out AData: string): TColor32; -begin - // Skip empty buckets - while FAIndex >= FBuckets[FABucket].Count do - begin - Inc(FABucket); - if FABucket >= Length(FBuckets) then - FABucket := 0; - FAIndex := 0; - end; - - Result := FBuckets[FABucket].Items[FAIndex].Key; - AData := string(FBuckets[FABucket].Items[FAIndex].Data); - Inc(FAIndex); -end; - -function TSimpleBucketList.FindItem(AKey: TColor32; out ABucket, - AIndex: Integer): Boolean; -var - I: Integer; - Col: TColor32Rec; -begin - Result := False; - Col := TColor32Rec(AKey); - ABucket := (Col.A + 11 * Col.B + 59 * Col.R + 119 * Col.G) mod BucketCount; - with FBuckets[ABucket] do - for I := 0 to Count - 1 do - if Items[I].Key = AKey then - begin - AIndex := I; - Result := True; - Break; - end; -end; - -procedure TSimpleBucketList.Add(AKey: TColor32; const AData: string); -var - Bucket, Index, Delta, Size: Integer; -begin - if not FindItem(AKey, Bucket, Index) then - with FBuckets[Bucket] do - begin - Size := Length(Items); - if Count = Size then - begin - if Size > 64 then - Delta := Size div 4 - else - Delta := 16; - SetLength(Items, Size + Delta); - end; - - with Items[Count] do - begin - Key := AKey; - Data := ShortString(AData); - end; - Inc(Count); - Inc(FItemCount); - end; -end; - -function TSimpleBucketList.Exists(AKey: TColor32): Boolean; -var - Bucket, Index: Integer; -begin - Result := FindItem(AKey, Bucket, Index); -end; - -{ - TXPMFileFormat implementation -} - -procedure TXPMFileFormat.Define; -begin - inherited; - FName := SXPMFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := XPMSupportedFormats; - - AddMasks(SXPMMasks); -end; - -function TXPMFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Contents, PalLookup: TStringList; - S: AnsiString; - I, J, NumColors, Cpp, Line: Integer; - - procedure SkipWhiteSpace(var Line: string); - begin - while (Length(Line) > 0) and (AnsiChar(Line[1]) in WhiteSpaces) do - Delete(Line, 1, 1); - end; - - function ReadString(var Line: string): string; - begin - Result := ''; - SkipWhiteSpace(Line); - while (Length(Line) > 0) and not (AnsiChar(Line[1]) in WhiteSpaces) do - begin - SetLength(Result, Length(Result) + 1); - Result[Length(Result)] := Line[1]; - Delete(Line, 1, 1); - end; - end; - - function ReadInt(var Line: string): Integer; - begin - Result := StrToInt(ReadString(Line)); - end; - - function ParseHeader: Boolean; - var - S: string; - begin - S := Contents[0]; - try - Images[0].Width := ReadInt(S); - Images[0].Height := ReadInt(S); - NumColors := ReadInt(S); - Cpp := ReadInt(S); - Line := 1; - Result := True; - except - Result := False; - end; - end; - - function NamedToColor(const ColStr: string): TColor32; - var - S: string; - begin - S := LowerCase(ColStr); - if (S = 'transparent') or (S = 'none') then - Result := pcClear - else if S = 'black' then - Result := pcBlack - else if S = 'blue' then - Result := pcBlue - else if S = 'green' then - Result := pcGreen - else if S = 'cyan' then - Result := pcAqua - else if S = 'red' then - Result := pcRed - else if S = 'magenta' then - Result := pcFuchsia - else if S = 'yellow' then - Result := pcYellow - else if S = 'white' then - Result := pcWhite - else if S = 'gray' then - Result := pcLtGray - else if S = 'dkblue' then - Result := pcNavy - else if S = 'dkgreen' then - Result := pcGreen - else if S = 'dkcyan' then - Result := pcTeal - else if S = 'dkred' then - Result := pcMaroon - else if S = 'dkmagenta' then - Result := pcPurple - else if S = 'dkyellow' then - Result := pcOlive - else if S = 'maroon' then - Result := pcMaroon - else if S = 'olive' then - Result := pcOlive - else if S = 'navy' then - Result := pcNavy - else if S = 'purple' then - Result := pcPurple - else if S = 'teal' then - Result := pcTeal - else if S = 'silver' then - Result := pcSilver - else if S = 'lime' then - Result := pcLime - else if S = 'fuchsia' then - Result := pcFuchsia - else if S = 'aqua' then - Result := pcAqua - else - Result := pcClear; - end; - - procedure ParsePalette; - var - I: Integer; - S, ColType, ColStr, Code: string; - Color: TColor32; - Holder: TColorHolder; - begin - for I := 0 to NumColors - 1 do - begin - Holder := TColorHolder.Create; - // Parse pixel code and color - S := Contents[Line + I]; - Code := Copy(S, 1, Cpp); - Delete(S, 1, Cpp); - ColType := ReadString(S); - ColStr := ReadString(S); - // Convert color from hex number or named constant - if ColStr[1] = '#' then - begin - Delete(ColStr, 1, 1); - Color := LongWord(StrToInt('$' + Trim(ColStr))) or $FF000000; - end - else - Color := NamedToColor(ColStr); - // Store code and color in table for later lookup - Holder.Color := Color; - PalLookup.AddObject(Code, Holder); - end; - Inc(Line, NumColors); - end; - - procedure ParsePixels; - var - X, Y, Idx: Integer; - S, Code: string; - Pix: PColor32; - begin - Pix := Images[0].Bits; - for Y := 0 to Images[0].Height - 1 do - begin - S := Contents[Line + Y]; - for X := 0 to Images[0].Width - 1 do - begin - // Read code and look up color in the palette - Code := Copy(S, X * Cpp + 1, Cpp); - if PalLookup.Find(Code, Idx) then - Pix^ := TColorHolder(PalLookup.Objects[Idx]).Color - else - Pix^ := pcClear; - Inc(Pix); - end; - end; - end; - -begin - Result := False; - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Look up table for XPM palette entries - PalLookup := TStringList.Create; - PalLookup.Sorted := True; - PalLookup.CaseSensitive := True; - // Read whole file and assign it to string list - Contents := TStringList.Create; - SetLength(S, GetInputSize(GetIO, Handle)); - Read(Handle, @S[1], Length(S)); - Contents.Text := string(S); - // Remove quotes and other stuff - for I := Contents.Count - 1 downto 0 do - begin - J := Pos('"', Contents[I]); - if J > 0 then - Contents[I] := Copy(Contents[I], J + 1, LastDelimiter('"', Contents[I]) - J - 1) - else - Contents.Delete(I); - end; - // Parse header and create new image - if not ParseHeader then - Exit; - NewImage(Width, Height, ifA8R8G8B8, Images[0]); - // Read palette entries and assign colors to pixels - ParsePalette; - ParsePixels; - - Contents.Free; - for I := 0 to PalLookup.Count - 1 do - PalLookup.Objects[I].Free; - PalLookup.Free; - Result := True; - end; -end; - -function TXPMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -const - ColorCharsCount = 92; - ColorChars = ' .XoO+@#$%&*=-;:>,<1234567890qwertyuipasdfghjklzxcvbnmMNBVCZASDFGHJKLPIUYTREWQ!~^/()_`''][{}|'; -var - X, Y: Integer; - ImageToSave: TImageData; - MustBeFreed: Boolean; - StrFile: TStringList; - ColTable: TSimpleBucketList; - Stream: TMemoryStream; - Line, Id: string; - CharsPerPixel: Integer; - Ptr: PColor32Rec; - ColRec: TColor32Rec; - - procedure BuildColorTables(const Img: TImageData); - var - I: Integer; - begin - Ptr := Img.Bits; - for I := 0 to Img.Width * Img.Height - 1 do - begin - if not ColTable.Exists(Ptr.Color) then - ColTable.Add(Ptr.Color, ''); - Inc(Ptr); - end; - end; - - procedure MakeStrIdsForColors; - var - I, J, K: Integer; - Id, Data: string; - begin - SetLength(Id, CharsPerPixel); - for I := 0 to ColTable.ItemCount - 1 do - begin - ColRec.Color := ColTable.EnumNext(Data); - K := I; - for J := 0 to CharsPerPixel - 1 do - begin - Id[J + 1] := ColorChars[K mod ColorCharsCount + 1]; - K := K div ColorCharsCount; - end; - ColTable.Data[ColRec.Color] := Id; - end; - end; - -begin - Result := False; - - StrFile := TStringList.Create; - ColTable := TSimpleBucketList.Create; - Stream := TMemoryStream.Create; - - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - try - // Put all unique colors of image to table - BuildColorTables(ImageToSave); - // Compute the character per pixel - CharsPerPixel := 1; - X := ColorCharsCount; - while ColTable.ItemCount > X do - begin - X := X * ColorCharsCount; - Inc(CharsPerPixel); - end; - // Assign char id to each color - MakeStrIdsForColors; - - // Start writing XPM file - StrFile.Add(SXPMId); - StrFile.Add('static char *graphic[] = {'); - StrFile.Add('/* width height num_colors chars_per_pixel */'); - StrFile.Add(SysUtils.Format('"%d %d %d %d", ', [ImageToSave.Width, - ImageToSave.Height, ColTable.ItemCount, CharsPerPixel])); - StrFile.Add('/* colors */'); - - // Write 'colors' part of XPM file - for X := 0 to ColTable.ItemCount - 1 do - begin - ColRec.Color := ColTable.EnumNext(Id); - if ColRec.A >= 128 then - StrFile.Add(Format('"%s c #%.2x%.2x%.2x",', [Id, ColRec.R, ColRec.G, ColRec.B])) - else - StrFile.Add(Format('"%s c None",', [Id])); - end; - - StrFile.Add('/* pixels */'); - - // Write pixels - for aech pixel of image find its char id - // and append it to line - Ptr := ImageToSave.Bits; - for Y := 0 to ImageToSave.Height - 1 do - begin - Line := ''; - for X := 0 to ImageToSave.Width - 1 do - begin - Line := Line + ColTable.Data[Ptr.Color]; - Inc(Ptr); - end; - Line := '"' + Line + '"'; - if Y < ImageToSave.Height - 1 then - Line := Line + ','; - StrFile.Add(Line); - end; - - StrFile.Add('};'); - - // Finally save strings to stream and write stream's data to output - // (we could directly write lines from list to output, but stream method - // takes care of D2009+ Unicode strings). - StrFile.SaveToStream(Stream); - GetIO.Write(Handle, Stream.Memory, Stream.Size); - - Result := True; - finally - StrFile.Free; - ColTable.Free; - Stream.Free; - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TXPMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - ConvertImage(Image, ifA8R8G8B8) -end; - -function TXPMFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Id: array[0 .. 8] of AnsiChar; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Id, SizeOf(Id)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (Id = SXPMId) and (ReadCount = SizeOf(Id)); - end; -end; - -initialization - -RegisterImageFileFormat(TXPMFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Added XPM saving. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Added XPM loading. - - Unit created. -} - -end. - - diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/bio.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/bio.obj deleted file mode 100644 index f28a922a9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/bio.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/cio.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/cio.obj deleted file mode 100644 index 072ff4423..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/cio.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/dwt.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/dwt.obj deleted file mode 100644 index c90e97951..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/dwt.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/event.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/event.obj deleted file mode 100644 index dbc8db54b..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/event.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/image.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/image.obj deleted file mode 100644 index 635b5c64d..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/image.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/j2k.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/j2k.obj deleted file mode 100644 index 23f360146..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/j2k.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/j2k_lib.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/j2k_lib.obj deleted file mode 100644 index 3dbe8d569..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/j2k_lib.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/jp2.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/jp2.obj deleted file mode 100644 index 587d7a758..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/jp2.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/jpt.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/jpt.obj deleted file mode 100644 index a2949243c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/jpt.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/libcrtdll.a b/3rd/Imaging/Extras/Extensions/J2KObjects/libcrtdll.a deleted file mode 100644 index 712870778..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/libcrtdll.a and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a b/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a deleted file mode 100644 index 32e4dd02f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86.a and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a b/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a deleted file mode 100644 index a6af54430..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpeglinx86_64.a and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a b/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a deleted file mode 100644 index 1f7dd32b1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegosxx86.a and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a b/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a deleted file mode 100644 index efef2ac99..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/libopenjpegwin32.a and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/mct.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/mct.obj deleted file mode 100644 index 4a25c0d90..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/mct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/mqc.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/mqc.obj deleted file mode 100644 index cd84bbe02..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/mqc.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/openjpeg.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/openjpeg.obj deleted file mode 100644 index 9b971a1c9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/openjpeg.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/pi.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/pi.obj deleted file mode 100644 index 5e606499a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/pi.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/raw.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/raw.obj deleted file mode 100644 index e02070854..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/raw.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/t1.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/t1.obj deleted file mode 100644 index 9f4cd2213..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/t1.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/t2.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/t2.obj deleted file mode 100644 index 7cb038923..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/t2.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/tcd.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/tcd.obj deleted file mode 100644 index 30060181a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/tcd.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/J2KObjects/tgt.obj b/3rd/Imaging/Extras/Extensions/J2KObjects/tgt.obj deleted file mode 100644 index 3396853cb..000000000 Binary files a/3rd/Imaging/Extras/Extensions/J2KObjects/tgt.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/adler32.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/adler32.obj deleted file mode 100644 index 4ea3e7625..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/adler32.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/compress.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/compress.obj deleted file mode 100644 index e2b153ee2..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/compress.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/crc32.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/crc32.obj deleted file mode 100644 index 25d86be35..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/crc32.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/deflate.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/deflate.obj deleted file mode 100644 index 25bbf9db6..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/deflate.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inffast.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inffast.obj deleted file mode 100644 index cfaf0b61d..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inffast.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inflate.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inflate.obj deleted file mode 100644 index 6b1536110..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inflate.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj deleted file mode 100644 index 4357da25e..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/inftrees.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj deleted file mode 100644 index 1979f24eb..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapimin.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj deleted file mode 100644 index b6b51c1db..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcapistd.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj deleted file mode 100644 index 505b1a335..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccoefct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj deleted file mode 100644 index 7e8d7dc02..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jccolor.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj deleted file mode 100644 index 4dc9d104d..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcdctmgr.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj deleted file mode 100644 index fe396b800..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jchuff.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj deleted file mode 100644 index 6a6d0a4b9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcinit.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj deleted file mode 100644 index e9cbdfe3f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmainct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj deleted file mode 100644 index d65aed34f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmarker.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj deleted file mode 100644 index 7e7d2e15a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcmaster.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj deleted file mode 100644 index 655eb62ea..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcomapi.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj deleted file mode 100644 index 4de111311..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcparam.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj deleted file mode 100644 index cacf644a8..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcphuff.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj deleted file mode 100644 index 744687d56..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcprepct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj deleted file mode 100644 index 1bfaf5b1c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jcsample.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj deleted file mode 100644 index 90204b13b..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jctrans.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj deleted file mode 100644 index e427785da..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapimin.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj deleted file mode 100644 index ba183e825..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdapistd.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj deleted file mode 100644 index 22be293e7..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatadst.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj deleted file mode 100644 index 0b20f8b99..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdatasrc.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj deleted file mode 100644 index 79348f7e1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcoefct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj deleted file mode 100644 index bbc03e3c1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdcolor.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj deleted file mode 100644 index ad7d4bb39..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jddctmgr.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj deleted file mode 100644 index 75e2a82bf..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdhuff.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj deleted file mode 100644 index 6f66c5413..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdinput.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj deleted file mode 100644 index 2e170859e..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmainct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj deleted file mode 100644 index 877b3e2e9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmarker.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj deleted file mode 100644 index 615bec6d1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmaster.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj deleted file mode 100644 index dddbf74e8..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdmerge.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj deleted file mode 100644 index 972948904..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdphuff.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj deleted file mode 100644 index ea40e463a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdpostct.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj deleted file mode 100644 index 279e125ba..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdsample.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj deleted file mode 100644 index 98ce9983a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jdtrans.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jerror.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jerror.obj deleted file mode 100644 index 543ab46d9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jerror.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj deleted file mode 100644 index 9a866178c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctflt.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj deleted file mode 100644 index dca0149f5..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctfst.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj deleted file mode 100644 index c03cc6008..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jfdctint.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj deleted file mode 100644 index 0d0cc684c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctflt.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj deleted file mode 100644 index a237e9941..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctfst.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj deleted file mode 100644 index 25fba0b5b..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctint.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj deleted file mode 100644 index 5ca86acf1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jidctred.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj deleted file mode 100644 index 2667f56cc..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemmgr.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj deleted file mode 100644 index 7860f549a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jmemnobs.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj deleted file mode 100644 index 5fa2e4179..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant1.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj deleted file mode 100644 index 91adacbf0..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jquant2.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jutils.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jutils.obj deleted file mode 100644 index 84003fa50..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/jutils.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj deleted file mode 100644 index e98da5586..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_aux.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj deleted file mode 100644 index b85ecdcfb..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_close.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj deleted file mode 100644 index 696342865..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_codec.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj deleted file mode 100644 index 26b2cd037..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_color.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj deleted file mode 100644 index 26a919a87..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_compress.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj deleted file mode 100644 index 4282fee20..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dir.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj deleted file mode 100644 index dcf31dc0c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirinfo.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj deleted file mode 100644 index 2e3c2d3ab..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirread.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj deleted file mode 100644 index 687b5f095..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dirwrite.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj deleted file mode 100644 index 98dbf0779..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_dumpmode.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj deleted file mode 100644 index 72ef9d5be..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_error.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj deleted file mode 100644 index 717df59c2..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_extension.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj deleted file mode 100644 index 3818b96a9..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj deleted file mode 100644 index 806ecc748..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_fax3sm.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj deleted file mode 100644 index 2a4cfcaff..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_flush.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj deleted file mode 100644 index acd6476fa..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_getimage.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj deleted file mode 100644 index b7fb8678c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_jpeg.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj deleted file mode 100644 index 2baa44337..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_luv.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj deleted file mode 100644 index 6baebbb19..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_lzw.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj deleted file mode 100644 index f241b3069..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_next.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj deleted file mode 100644 index f460b3e6f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_ojpeg.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj deleted file mode 100644 index 5731976aa..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_open.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj deleted file mode 100644 index 65f2b8bed..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_packbits.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj deleted file mode 100644 index 34314f1f1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_pixarlog.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj deleted file mode 100644 index 1a2d2276c..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_predict.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj deleted file mode 100644 index 3bdc51dcb..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_print.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj deleted file mode 100644 index 34546af2f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_read.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj deleted file mode 100644 index 0fe67ceb1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_strip.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj deleted file mode 100644 index 6da888d1e..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_swab.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj deleted file mode 100644 index d3909ab48..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_thunder.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj deleted file mode 100644 index 1194a0f5f..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_tile.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj deleted file mode 100644 index 4b3920df3..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_version.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj deleted file mode 100644 index 226c2e15a..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_warning.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj deleted file mode 100644 index 7b22eb897..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_write.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj deleted file mode 100644 index cba16eff1..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/tif_zip.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/trees.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/trees.obj deleted file mode 100644 index b0bf94173..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/trees.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj deleted file mode 100644 index 2d22cbbbe..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/uncompr.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/zutil.obj b/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/zutil.obj deleted file mode 100644 index 5dc64c82b..000000000 Binary files a/3rd/Imaging/Extras/Extensions/LibTiff/Compiled/zutil.obj and /dev/null differ diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/LibDelphi.pas b/3rd/Imaging/Extras/Extensions/LibTiff/LibDelphi.pas deleted file mode 100644 index 03dce376f..000000000 --- a/3rd/Imaging/Extras/Extensions/LibTiff/LibDelphi.pas +++ /dev/null @@ -1,371 +0,0 @@ -unit LibDelphi; - -interface - -uses - Windows, SysUtils; - -function fprintf(stream: Pointer; format: Pointer; arguments: Pointer): Integer; cdecl; -function sprintf(buffer: Pointer; format: Pointer; arguments: Pointer): Integer; cdecl; -function fputs(s: Pointer; stream: Pointer): Integer; cdecl; -function fputc(c: Integer; stream: Pointer): Integer; cdecl; -function isprint(c: Integer): Integer; cdecl; -procedure memset(a: Pointer; b: Integer; c: Cardinal); cdecl; -function memcpy(dest: Pointer; const src: Pointer; count: Cardinal): Pointer; cdecl; -function _ftol: Integer; cdecl; -function malloc(s: Longint): Pointer; cdecl; -procedure free(p: Pointer); cdecl; -function _ltolower(ch: Integer): Integer; cdecl; -function _ltoupper(ch: Integer): Integer; cdecl; -function _ltowlower(ch: Integer): Integer; cdecl; -function _ltowupper(ch: Integer): Integer; cdecl; -function strcpy(dest: Pointer; src: Pointer): Pointer; cdecl; - -function sprintfsec(buffer: Pointer; format: Pointer; arguments: Pointer): Integer; - -var - __turboFloat: LongBool = False; - _streams: Integer; - -implementation - -{PODD} - -function fputc(c: Integer; stream: Pointer): Integer; cdecl; -var - m: array[0..1] of AnsiChar; - n: Cardinal; - o: Cardinal; -begin - if c=13 then - begin - m[0]:=#13; - m[1]:=#10; - n:=2; - end - else - begin - m[0]:=AnsiChar(c); - n:=1; - end; - WriteFile(Cardinal(stream),m[0],n,o,nil); - Result:=c; -end; - -function isprint(c: Integer): Integer; cdecl; -begin - if (c<32) or (127<=c) then - Result:=0 - else - Result:=1; -end; - -function fputs(s: Pointer; stream: Pointer): Integer; cdecl; -var - m: Integer; - n: Pointer; - o: Cardinal; -begin - m:=0; - n:=s; - while PByte(n)^<>0 do - begin - Inc(m); - Inc(PByte(n)); - end; - WriteFile(Cardinal(stream),s^,Cardinal(m),o,nil); - Result:=1; -end; - -function sprintf(buffer: Pointer; format: Pointer; arguments: Pointer): Integer; cdecl; -begin - Result := sprintfsec(buffer,format,@arguments); -end; - -function fprintf(stream: Pointer; format: Pointer; arguments: Pointer): Integer; cdecl; -var - m: Integer; - n: Pointer; - o: Cardinal; -begin - m:=sprintfsec(nil,format,@arguments); - GetMem(n,m); - sprintfsec(n,format,@arguments); - WriteFile(Cardinal(stream),n^,Cardinal(m),o,nil); - FreeMem(n); - Result := m; -end; - -function strcpy(dest: Pointer; src: Pointer): Pointer; cdecl; -var - ma,mb: PByte; - n: Integer; -begin - ma:=src; - mb:=dest; - while True do - begin - n:=ma^; - mb^:=n; - if n=0 then break; - Inc(ma); - Inc(mb); - end; - Result:=dest; -end; - -function _ltolower(ch: Integer): Integer; cdecl; -begin - raise Exception.Create('LibDelphi - call to _ltolower - should presumably not occur'); -end; - -function _ltoupper(ch: Integer): Integer; cdecl; -begin - raise Exception.Create('LibDelphi - call to _ltoupper - should presumably not occur'); -end; - -function _ltowlower(ch: Integer): Integer; cdecl; -begin - raise Exception.Create('LibDelphi - call to _ltowlower - should presumably not occur'); -end; - -function _ltowupper(ch: Integer): Integer; cdecl; -begin - raise Exception.Create('LibDelphi - call to _ltowupper - should presumably not occur'); -end; - -function sprintfsec(buffer: Pointer; format: Pointer; arguments: Pointer): Integer; -var - Modifier: Integer; - Width: Integer; - m,ma: PByte; - mb: Boolean; - n: PByte; - o: PByte; - r: PByte; - -procedure Append(const p: AnsiString); -var - q: Integer; -begin - if Width>Length(p) then - begin - if buffer<>nil then - begin - for q:=0 to Width-Length(p)-1 do - begin - o^:=Ord('0'); - Inc(o); - end; - end - else - Inc(o,Width-Length(p)); - end; - if buffer<>nil then CopyMemory(o,PAnsiChar(p),Length(p)); - Inc(o,Length(p)); -end; -begin - m:=format; - n:=arguments; - o:=buffer; - while True do - begin - if m^=0 then break; - if m^=Ord('%') then - begin - ma:=m; - mb:=True; - Inc(m); - Width:=-1; - Modifier:=0; - {flags} - case m^ of - Ord('-'): mb:=False; - Ord('+'): mb:=False; - Ord(' '): mb:=False; - Ord('#'): mb:=False; - end; - if mb then - begin - {width} - case m^ of - Ord('1')..Ord('9'): - begin - Width:=0; - while True do - begin - if (m^0 do - begin - if buffer<>nil then o^:=r^; - Inc(o); - Inc(r); - end; - Inc(n,SizeOf(Pointer)); - Inc(m); - end; - Ord('%'): mb:=False; - Ord('n'): mb:=False; - Ord('p'): mb:=False; - else - raise Exception.Create('LibDelphi'); - end; - end; - if mb=False then - begin - m:=ma; - if buffer<>nil then o^:=m^; - Inc(o); - Inc(m); - end; - end - else if m^=10 then - begin - if buffer<>nil then o^:=13; - Inc(o); - if buffer<>nil then o^:=10; - Inc(o); - Inc(m); - end - else - begin - if buffer<>nil then o^:=m^; - Inc(o); - Inc(m); - end; - end; - if buffer<>nil then o^:=0; - Inc(o); - Result:=(Cardinal(o)-Cardinal(buffer)); -end; - -procedure free(p: Pointer); cdecl; -begin - FreeMem(p); -end; - -function malloc(s: Longint): Pointer; cdecl; -begin - Result := AllocMem(s); -end; - -function _ftol: Integer; cdecl; -var - f: double; -begin - asm - lea eax, f // BC++ passes floats on the FPU stack - fstp qword ptr [eax] // Delphi passes floats on the CPU stack - end; - Result := Trunc(f); -end; - -function memcpy(dest: Pointer; const src: Pointer; count: Cardinal): Pointer; cdecl; -begin - CopyMemory(dest,src,count); - Result:=dest; -end; - -procedure memset(a: Pointer; b: Integer; c: Cardinal); cdecl; -begin - FillMemory(a,c,b); -end; - -end. diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/LibJpegDelphi.pas b/3rd/Imaging/Extras/Extensions/LibTiff/LibJpegDelphi.pas deleted file mode 100644 index 59c83440f..000000000 --- a/3rd/Imaging/Extras/Extensions/LibTiff/LibJpegDelphi.pas +++ /dev/null @@ -1,521 +0,0 @@ -unit LibJpegDelphi; - -interface - -uses - Windows, SysUtils; - -const - - JPEG_LIB_VERSION = 62; { Version 6b } - - JMSG_STR_PARM_MAX = 80; - JMSG_LENGTH_MAX = 200; { recommended size of format_message buffer } - NUM_QUANT_TBLS = 4; { Quantization tables are numbered 0..3 } - NUM_HUFF_TBLS = 4; { Huffman tables are numbered 0..3 } - NUM_ARITH_TBLS = 16; { Arith-coding tables are numbered 0..15 } - MAX_COMPS_IN_SCAN = 4; { JPEG limit on # of components in one scan } - C_MAX_BLOCKS_IN_MCU = 10; { compressor's limit on blocks per MCU } - D_MAX_BLOCKS_IN_MCU = 10; { decompressor's limit on blocks per MCU } - DCTSIZE2 = 64; - - JCS_UNKNOWN = 0; { error/unspecified } - JCS_GRAYSCALE = 1; { monochrome } - JCS_RGB = 2; { red/green/blue } - JCS_YCbCr = 3; { Y/Cb/Cr (also known as YUV) } - JCS_CMYK = 4; { C/M/Y/K } - JCS_YCCK = 5; { Y/Cb/Cr/K } - -type - - PRJpegErrorMgr = ^RJpegErrorMgr; - PRJpegMemoryMgr = Pointer; - PRJpegProgressMgr = Pointer; - PRJpegDestinationMgr = ^RJpegDestinationMgr; - PRJpegSourceMgr = ^RJpegSourceMgr; - PRJpegComponentInfo = ^RJpegComponentInfo; - PRJpegQuantTbl = Pointer; - PRJpegHuffTbl = Pointer; - PRJpegScanInfo = Pointer; - PRJpegCompMaster = Pointer; - PRJpegCMainController = Pointer; - PRJpegCPrepController = Pointer; - PRJpegCCoefController = Pointer; - PRJpegMarkerWriter = Pointer; - PRJpegColorConverter = Pointer; - PRJpegDownsampler = Pointer; - PRJpegForwardDct = Pointer; - PRJpegEntropyEncoder = Pointer; - PRJpegSavedMarker = Pointer; - PRJpegDecompMaster = Pointer; - PRJpegDMainController = Pointer; - PRJpegDCoefController = Pointer; - PRJpegDPosController = Pointer; - PRJpegInputController = Pointer; - PRJpegMarkerReader = Pointer; - PRJpegEntropyDecoder = Pointer; - PRJpegInverseDct = Pointer; - PRJpegUpsampler = Pointer; - PRJpegColorDeconverter = Pointer; - PRJpegColorQuantizer = Pointer; - PRJpegCommonStruct = ^RJpegCommonStruct; - PRJpegCompressStruct = ^RJpegCompressStruct; - PRJpegDecompressStruct = ^RJpegDecompressStruct; - - TJpegErrorExit = procedure(cinfo: PRJpegCommonStruct); cdecl; - TJpegEmitMessage = procedure(cinfo: PRJpegCommonStruct; MsgLevel: Integer); cdecl; - TJpegOutputMessage = procedure(cinfo: PRJpegCommonStruct); cdecl; - TJpegFormatMessage = procedure(cinfo: PRJpegCommonStruct; Buffer: Pointer); cdecl; - TJpegResetErrorMgr = procedure(cinfo: PRJpegCommonStruct); cdecl; - - RJpegErrorMgrMsgParm = record - case Boolean of - False: (MsgParmI: array[0..7] of Integer); - True: (MsgParmS: array[0..JMSG_STR_PARM_MAX-1] of AnsiChar); - end; - - RJpegErrorMgr = record - ErrorExit: TJpegErrorExit; { Error exit handler: does not return to caller } - EmitMessage: TJpegEmitMessage; { Conditionally emit a trace or warning message } - OutputMessage: TJpegOutputMessage; { Routine that actually outputs a trace or error message } - FormatMessage: TJpegFormatMessage; { Format a message string for the most recent JPEG error or message } - ResetErrorMgr: TJpegResetErrorMgr; { Reset error state variables at start of a new image } - { The message ID code and any parameters are saved here. A message can have one string parameter or up to 8 int parameters. } - MsgCode: Integer; - MsgParm: RJpegErrorMgrMsgParm; - { Standard state variables for error facility } - TraceLevel: Integer; {max msg_level that will be displayed} - { For recoverable corrupt-data errors, we emit a warning message, but keep going unless emit_message chooses to abort. - emit_message should count warnings in num_warnings. The surrounding application can check for bad data by seeing if num_warnings - is nonzero at the end of processing. } - NumWarnings: Integer; { number of corrupt-data warnings } - { These fields point to the table(s) of error message strings. An application can change the table pointer to switch to a different - message list (typically, to change the language in which errors are reported). Some applications may wish to add additional - error codes that will be handled by the JPEG library error mechanism; the second table pointer is used for this purpose. - First table includes all errors generated by JPEG library itself. Error code 0 is reserved for a "no such error string" message. } - JpegMessageTable: PPAnsiChar; { Library errors } - LastJpegMessage: Integer; { Table contains strings 0..last_jpeg_message } - { Second table can be added by application (see cjpeg/djpeg for example). It contains strings numbered - first_addon_message..last_addon_message. } - AddonMessageTable: PPAnsiChar; { Non-library errors } - FirstAddonMessage: Integer; { code for first string in addon table } - LastAddonMessage: Integer; { code for last string in addon table } - end; - - TJpegInitDestination = procedure(cinfo: PRJpegCompressStruct); cdecl; - TJpegEmptyOutputBuffer = function(cinfo: PRJpegCompressStruct): Boolean; cdecl; - TJpegTermDestination = procedure(cinfo: PRJpegCompressStruct); cdecl; - - RJpegDestinationMgr = record - NextOutputByte: Pointer; { => next byte to write in buffer } - FreeInBuffer: Cardinal; { # of byte spaces remaining in buffer } - InitDestination: TJpegInitDestination; - EmptyOutputBuffer: TJpegEmptyOutputBuffer; - TermDestination: TJpegTermDestination; - end; - - TJpegInitSource = procedure(cinfo: PRJpegDecompressStruct); cdecl; - TJpegFillInputBuffer = function(cinfo: PRJpegDecompressStruct): Boolean; cdecl; - TJpegSkipInputData = procedure(cinfo: PRJpegDecompressStruct; NumBytes: Integer); cdecl; - TJpegResyncToRestart = function(cinfo: PRJpegDecompressStruct; Desired: Integer): Boolean; cdecl; - TJpegTermSource = procedure(cinfo: PRJpegDecompressStruct); cdecl; - - RJpegSourceMgr = record - NextInputByte: Pointer; - BytesInBuffer: Cardinal; - InitSource: TJpegInitSource; - FillInputBuffer: TJpegFillInputBuffer; - SkipInputData: TJpegSkipInputData; - ResyncToRestart: TJpegResyncToRestart; - TermSource: TJpegTermSource; - end; - - RJpegComponentInfo = record - { Basic info about one component (color channel). } - { These values are fixed over the whole image. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOF marker. } - ComponentId: Integer; { identifier for this component (0..255) } - ComponentIndex: Integer; { its index in SOF or cinfo->comp_info[] } - HSampFactor: Integer; { horizontal sampling factor (1..4) } - VSampFactor: Integer; { vertical sampling factor (1..4) } - QuantTblNo: Integer; { quantization table selector (0..3) } - { These values may vary between scans. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOS marker. } - { The decompressor output side may not use these variables. } - DcTblNo: Integer; { DC entropy table selector (0..3) } - AsTblNo: Integer; { AC entropy table selector (0..3) } - { Remaining fields should be treated as private by applications. } - { These values are computed during compression or decompression startup: } - { Component's size in DCT blocks. Any dummy blocks added to complete an MCU are not counted; therefore these values do not depend - on whether a scan is interleaved or not. } - WidthInBlocks: Cardinal; - HeightInBlocks: Cardinal; - { Size of a DCT block in samples. Always DCTSIZE for compression. For decompression this is the size of the output from one DCT - block, reflecting any scaling we choose to apply during the IDCT step. Values of 1,2,4,8 are likely to be supported. Note that - different components may receive different IDCT scalings. } - DctScaledSize: Integer; - { The downsampled dimensions are the component's actual, unpadded number of samples at the main buffer (preprocessing/compression - interface), thus downsampled_width = ceil(image_width * Hi/Hmax) and similarly for height. For decompression, IDCT scaling is - included, so downsampled_width = ceil(image_width * Hi/Hmax * DCT_scaled_size/DCTSIZE) } - DownsampledWidth: Cardinal; { actual width in samples } - DownsampledHeight: Cardinal; { actual height in samples } - { This flag is used only for decompression. In cases where some of the components will be ignored (eg grayscale output from YCbCr - image), we can skip most computations for the unused components. } - ComponentNeeded: Boolean; { do we need the value of this component? } - { These values are computed before starting a scan of the component. } - { The decompressor output side may not use these variables. } - McuWidth: Integer; { number of blocks per MCU, horizontally } - McuHeight: Integer; { number of blocks per MCU, vertically } - McuBlocks: Integer; { MCU_width * MCU_height } - McuSampleWidth: Integer; { MCU width in samples, MCU_width*DCT_scaled_size } - LastColWidth: Integer; { # of non-dummy blocks across in last MCU } - LastRowHeight: Integer; { # of non-dummy blocks down in last MCU } - { Saved quantization table for component; NULL if none yet saved. See jdinput.c comments about the need for this information. This - field is currently used only for decompression. } - QuantTable: PRJpegQuantTbl; - { Private per-component storage for DCT or IDCT subsystem. } - DctTable: Pointer; - end; - - RJpegCommonStruct = record - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - end; - - RJpegCompressStruct = record - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - { Destination for compressed data } - Dest: PRJpegDestinationMgr; - { Description of source image --- these fields must be filled in by outer application before starting compression. - in_color_space must be correct before you can even call jpeg_set_defaults(). } - ImageWidth: Cardinal; { input image width } - ImageHeight: Cardinal; { input image height } - InputComponents: Integer; { # of color components in input image } - InColorSpace: Integer; { colorspace of input image } - InputGamme: Double; { image gamma of input image } - { Compression parameters --- these fields must be set before calling jpeg_start_compress(). We recommend calling - jpeg_set_defaults() to initialize everything to reasonable defaults, then changing anything the application specifically wants - to change. That way you won't get burnt when new parameters are added. Also note that there are several helper routines to - simplify changing parameters. } - DataPrecision: Integer; { bits of precision in image data } - NumComponents: Integer; { # of color components in JPEG image } - JpegColorSpace: Integer; { colorspace of JPEG image } - CompInfo: PRJpegComponentInfo; { comp_info[i] describes component that appears i'th in SOF } - QuantTblPtrs: array[0..NUM_QUANT_TBLS-1] of PRJpegQuantTbl; {ptrs to coefficient quantization tables, or NULL if not defined } - DcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of PRJpegHuffTbl; {ptrs to Huffman coding tables, or NULL if not defined } - AcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of PRJpegHuffTbl; - ArithDcL: array[0..NUM_ARITH_TBLS-1] of Byte; { L values for DC arith-coding tables } - ArithDcU: array[0..NUM_ARITH_TBLS-1] of Byte; { U values for DC arith-coding tables } - ArithAcK: array[0..NUM_ARITH_TBLS-1] of Byte; { Kx values for AC arith-coding tables } - NumScans: Integer; { # of entries in scan_info array } - ScanInfo: PRJpegScanInfo; { script for multi-scan file, or NULL } - { The default value of scan_info is NULL, which causes a single-scan sequential JPEG file to be emitted. To create a multi-scan - file, set num_scans and scan_info to point to an array of scan definitions. } - RawDataIn: Boolean; { TRUE=caller supplies downsampled data } - ArithCode: Boolean; { TRUE=arithmetic coding, FALSE=Huffman } - OptimizeCoding: Boolean; { TRUE=optimize entropy encoding parms } - CCIR601Sampling: Boolean; { TRUE=first samples are cosited } - SmoothingFactor: Integer; { 1..100, or 0 for no input smoothing } - DctMethod: Integer; { DCT algorithm selector } - { The restart interval can be specified in absolute MCUs by setting restart_interval, or in MCU rows by setting restart_in_rows - (in which case the correct restart_interval will be figured for each scan). } - RestartInterval: Cardinal; { MCUs per restart, or 0 for no restart } - RestartInRows: Integer; { if > 0, MCU rows per restart interval } - { Parameters controlling emission of special markers. } - WriteJfifHeader: Boolean; { should a JFIF marker be written? } - JfifMajorVersion: Byte; { What to write for the JFIF version number } - JFifMinorVersion: Byte; - { These three values are not used by the JPEG code, merely copied into the JFIF APP0 marker. density_unit can be 0 for unknown, - 1 for dots/inch, or 2 for dots/cm. Note that the pixel aspect ratio is defined by X_density/Y_density even when density_unit=0. } - DensityUnit: Byte; { JFIF code for pixel size units } - XDensity: Word; { Horizontal pixel density } - YDensity: WOrd; { Vertical pixel density } - WriteAdobeMarker: Boolean; { should an Adobe marker be written? } - { State variable: index of next scanline to be written to jpeg_write_scanlines(). Application may use this to control its - processing loop, e.g., "while (next_scanline < image_height)". } - NextScanline: Cardinal; { 0 .. image_height-1 } - { Remaining fields are known throughout compressor, but generally should not be touched by a surrounding application. } - { These fields are computed during compression startup } - ProgressiveMode: Boolean; { TRUE if scan script uses progressive mode } - MaxHSampFactor: Integer; { largest h_samp_factor } - MaxVSampFactor: Integer; { largest v_samp_factor } - TotalIMCURows: Cardinal; { # of iMCU rows to be input to coef ctlr } - { The coefficient controller receives data in units of MCU rows as defined for fully interleaved scans (whether the JPEG file is - interleaved or not). There are v_samp_factor * DCTSIZE sample rows of each component in an "iMCU" (interleaved MCU) row. } - { These fields are valid during any one scan. They describe the components and MCUs actually appearing in the scan. } - CompsInScan: Integer; { # of JPEG components in this scan } - CurCompInfo: array[0..MAX_COMPS_IN_SCAN-1] of PRJpegComponentInfo; - { *cur_comp_info[i] describes component that appears i'th in SOS } - MCUsPerRow: Cardinal; { # of MCUs across the image } - MCUsRowsInScan: Cardinal; { # of MCU rows in the image } - BlocksInMcu: Integer; { # of DCT blocks per MCU } - MCUMembership: array[0..C_MAX_BLOCKS_IN_MCU-1] of Integer; - { MCU_membership[i] is index in cur_comp_info of component owning i'th block in an MCU } - Ss,Se,Ah,Al: Integer; { progressive JPEG parameters for scan } - { Links to compression subobjects (methods and private variables of modules) } - Master: PRJpegCompMaster; - Main: PRJpegCMainController; - Prep: PRJpegCPrepController; - Coef: PRJpegCCoefController; - Marker: PRJpegMarkerWriter; - CConvert: PRJpegColorConverter; - Downsample: PRJpegDownsampler; - FDct: PRJpegForwardDct; - Entropy: PRJpegEntropyEncoder; - ScriptSpace: PRJpegScanInfo; { workspace for jpeg_simple_progression } - ScriptSpaceSize: Integer; - end; - - RJpegDecompressStruct = record - { Fields shared with jpeg_compress_struct } - Err: PRJpegErrorMgr; { Error handler module } - Mem: PRJpegMemoryMgr; { Memory manager module } - Progress: PRJpegProgressMgr; { Progress monitor, or NULL if none } - ClientData: Pointer; { Available for use by application } - IsDecompressor: Boolean; { So common code can tell which is which } - GlobalState: Integer; { For checking call sequence validity } - { Source of compressed data } - Src: PRJpegSourceMgr; - { Basic description of image --- filled in by jpeg_read_header(). } - { Application may inspect these values to decide how to process image. } - ImageWidth: Cardinal; { nominal image width (from SOF marker) } - ImageHeight: Cardinal; { nominal image height } - NumComponents: Integer; { # of color components in JPEG image } - JpegColorSpace: Integer; { colorspace of JPEG image } - { Decompression processing parameters --- these fields must be set before calling jpeg_start_decompress(). Note that - jpeg_read_header() initializes them to default values. } - OutColorSpace: Integer; { colorspace for output } - ScaleNum,ScaleDenom: Cardinal; { fraction by which to scale image } - OutputGamme: Double; { image gamma wanted in output } - BufferedImage: Boolean; { TRUE=multiple output passes } - RawDataOut: Boolean; { TRUE=downsampled data wanted } - DctMethod: Integer; { IDCT algorithm selector } - DoFancyUpsampling: Boolean; { TRUE=apply fancy upsampling } - DoBlockSmoothing: Boolean; { TRUE=apply interblock smoothing } - QuantizeColors: Boolean; { TRUE=colormapped output wanted } - { the following are ignored if not quantize_colors: } - DitherMode: Integer; { type of color dithering to use } - TwoPassQuantize: Boolean; { TRUE=use two-pass color quantization } - DesiredNumberOfColors: Integer;{ max # colors to use in created colormap } - { these are significant only in buffered-image mode: } - Enable1PassQuant: Boolean; { enable future use of 1-pass quantizer } - EnableExternalQuant: Boolean; { enable future use of external colormap } - Enable2PassQuant: Boolean; { enable future use of 2-pass quantizer } - { Description of actual output image that will be returned to application. These fields are computed by jpeg_start_decompress(). - You can also use jpeg_calc_output_dimensions() to determine these values in advance of calling jpeg_start_decompress(). } - OutputWidth: Cardinal; { scaled image width } - OutputHeight: Cardinal; { scaled image height } - OutColorComponents: Integer; { # of color components in out_color_space } - OutputComponents: Integer; { # of color components returned } - { output_components is 1 (a colormap index) when quantizing colors; otherwise it equals out_color_components. } - RecOutbufHeight: Integer; { min recommended height of scanline buffer } - { If the buffer passed to jpeg_read_scanlines() is less than this many rows high, space and time will be wasted due to unnecessary - data copying. Usually rec_outbuf_height will be 1 or 2, at most 4. } - { When quantizing colors, the output colormap is described by these fields. The application can supply a colormap by setting - colormap non-NULL before calling jpeg_start_decompress; otherwise a colormap is created during jpeg_start_decompress or - jpeg_start_output. The map has out_color_components rows and actual_number_of_colors columns. } - ActualNumberOfColors: Integer; { number of entries in use } - Colormap: Pointer; { The color map as a 2-D pixel array } - { State variables: these variables indicate the progress of decompression. The application may examine these but must not modify - them. } - { Row index of next scanline to be read from jpeg_read_scanlines(). Application may use this to control its processing loop, e.g., - "while (output_scanline < output_height)". } - OutputScanline: Cardinal; { 0 .. output_height-1 } - { Current input scan number and number of iMCU rows completed in scan. These indicate the progress of the decompressor input side. } - InputScanNumber: Integer; { Number of SOS markers seen so far } - InputIMcuRow: Cardinal; { Number of iMCU rows completed } - { The "output scan number" is the notional scan being displayed by the output side. The decompressor will not allow output - scan/row number to get ahead of input scan/row, but it can fall arbitrarily far behind. } - OutputScanNumber: Integer; { Nominal scan number being displayed } - OutputIMcuRow: Cardinal; { Number of iMCU rows read } - { Current progression status. coef_bits[c][i] indicates the precision with which component c's DCT coefficient i (in zigzag order) - is known. It is -1 when no data has yet been received, otherwise it is the point transform (shift) value for the most recent scan - of the coefficient (thus, 0 at completion of the progression). This pointer is NULL when reading a non-progressive file. } - CoefBits: Pointer; { -1 or current Al value for each coef } - { Internal JPEG parameters --- the application usually need not look at these fields. Note that the decompressor output side may - not use any parameters that can change between scans. } - { Quantization and Huffman tables are carried forward across input datastreams when processing abbreviated JPEG datastreams. } - QuantTblPtrs: array[0..NUM_QUANT_TBLS-1] of Pointer; - { ptrs to coefficient quantization tables, or NULL if not defined } - DcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of Pointer; - AcHuffTblPtrs: array[0..NUM_HUFF_TBLS-1] of Pointer; - { ptrs to Huffman coding tables, or NULL if not defined } - { These parameters are never carried across datastreams, since they are given in SOF/SOS markers or defined to be reset by SOI. } - DataPrecision: Integer; { bits of precision in image data } - CompInfo: PRJpegComponentInfo; { comp_info[i] describes component that appears i'th in SOF } - ProgressiveMode: Boolean; { TRUE if SOFn specifies progressive mode } - ArithCode: Boolean; { TRUE=arithmetic coding, FALSE=Huffman } - ArithDcL: array[0..NUM_ARITH_TBLS-1] of Byte; { L values for DC arith-coding tables } - ArithDcY: array[0..NUM_ARITH_TBLS-1] of Byte; { U values for DC arith-coding tables } - ArithAcK: array[0..NUM_ARITH_TBLS-1] of Byte; { Kx values for AC arith-coding tables } - RestartInterval: Cardinal; { MCUs per restart interval, or 0 for no restart } - { These fields record data obtained from optional markers recognized by the JPEG library. } - SawJfifMarker: Boolean; { TRUE iff a JFIF APP0 marker was found } - { Data copied from JFIF marker; only valid if saw_JFIF_marker is TRUE: } - JfifMajorVersion: Byte; { JFIF version number } - JfifMinorVersion: Byte; { JFIF code for pixel size units } - XDensity: Word; { Horizontal pixel density } - YDensity: Word; { Vertical pixel density } - SawAdobeMarker: Boolean; { TRUE iff an Adobe APP14 marker was found } - AdobeTransform: Byte; { Color transform code from Adobe marker } - Ccir601Sampling: Boolean; { TRUE=first samples are cosited } - { Aside from the specific data retained from APPn markers known to the library, the uninterpreted contents of any or all APPn and - COM markers can be saved in a list for examination by the application. } - MarkerList: PRJpegSavedMarker; { Head of list of saved markers } - { Remaining fields are known throughout decompressor, but generally should not be touched by a surrounding application. } - { These fields are computed during decompression startup } - MaxHSampFactor: Integer; { largest h_samp_factor } - MaxVSampFactor: Integer; { largest v_samp_factor } - MinDctScaledSize: Integer; { smallest DCT_scaled_size of any component } - TotalIMcuRows: Cardinal; { # of iMCU rows in image } - { The coefficient controller's input and output progress is measured in units of "iMCU" (interleaved MCU) rows. These are the same - as MCU rows in fully interleaved JPEG scans, but are used whether the scan is interleaved or not. We define an iMCU row as - v_samp_factor DCT block rows of each component. Therefore, the IDCT output contains v_samp_factor*DCT_scaled_size sample rows - of a component per iMCU row. } - SampleRangeLimit: Pointer; { table for fast range-limiting } - { These fields are valid during any one scan. They describe the components and MCUs actually appearing in the scan. Note that the - decompressor output side must not use these fields. } - CompsInScan: Integer; { # of JPEG components in this scan } - CurCompInfo: array[0..MAX_COMPS_IN_SCAN-1] of PRJpegComponentInfo; - { *cur_comp_info[i] describes component that appears i'th in SOS } - McusPerRow: Cardinal; { # of MCUs across the image } - McuRowsInScan: Cardinal; { # of MCU rows in the image } - BlocksInMcu: Integer; { # of DCT blocks per MCU } - McuMembership: array[0..D_MAX_BLOCKS_IN_MCU-1] of Integer; - { MCU_membership[i] is index in cur_comp_info of component owning i'th block in an MCU } - Ss,Se,Ah,Al: Integer; { progressive JPEG parameters for scan } - { This field is shared between entropy decoder and marker parser. It is either zero or the code of a JPEG marker that has been read - from the data source, but has not yet been processed. } - UnreadMarker: Integer; - { Links to decompression subobjects (methods, private variables of modules) } - Master: PRJpegDecompMaster; - Main: PRJpegDMainController; - Coef: PRJpegDCoefController; - Post: PRJpegDPosController; - InputCtl: PRJpegInputController; - Marker: PRJpegMarkerReader; - Entropy: PRJpegEntropyDecoder; - IDct: PRJpegInverseDct; - Upsample: PRJpegUpsampler; - CConvert: PRJpegColorDeconverter; - CQuantize: PRJpegColorQuantizer; - end; - -procedure jpeg_create_compress(cinfo: PRJpegCompressStruct); cdecl; -procedure jpeg_CreateCompress(cinfo: PRJpegCompressStruct; version: Integer; structsize: Cardinal); cdecl; external; -procedure jpeg_create_decompress(cinfo: PRJpegDecompressStruct); cdecl; -procedure jpeg_CreateDecompress(cinfo: PRJpegDecompressStruct; version: Integer; structsize: Cardinal); cdecl; external; -procedure jpeg_abort(cinfo: PRJpegCommonStruct); cdecl; external; -procedure jpeg_set_defaults(cinfo: PRJpegCompressStruct); cdecl; external; -procedure jpeg_set_colorspace(cinfo: PRJpegCompressStruct; colorspace: Integer); cdecl; external; -procedure jpeg_set_quality(cinfo: PRJpegCompressStruct; quality: Integer; force_baseline: Byte); cdecl; external; -procedure jpeg_suppress_tables(cinfo: PRJpegCompressStruct; suppress: Byte); cdecl; external; -procedure jpeg_start_compress(cinfo: PRJpegCompressStruct; write_all_tables: Byte); cdecl; external; -function jpeg_write_scanlines(cinfo: PRJpegCompressStruct; scanlines: PPointer; num_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_write_raw_data(cinfo: PRJpegCompressStruct; data: Pointer; num_lines: Cardinal): Cardinal; cdecl; external; -procedure jpeg_finish_compress(cinfo: PRJpegCompressStruct); cdecl; external; -procedure jpeg_write_tables(cinfo: PRJpegCompressStruct); cdecl; external; -function jpeg_read_header(cinfo: PRJpegDecompressStruct; require_image: Boolean): Integer; cdecl; external; -function jpeg_start_decompress(cinfo: PRJpegDecompressStruct): Byte; cdecl; external; -function jpeg_read_scanlines(cinfo: PRJpegDecompressStruct; scanlines: Pointer; max_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_read_raw_data(cinfo: PRJpegDecompressStruct; data: Pointer; max_lines: Cardinal): Cardinal; cdecl; external; -function jpeg_finish_decompress(cinfo: PRJpegDecompressStruct): Byte; cdecl; external; -procedure jpeg_destroy(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_std_error(err: PRJpegErrorMgr): Pointer; cdecl; external; -function jpeg_resync_to_restart(cinfo: PRJpegDecompressStruct; desired: Integer): Byte; cdecl; external; - -implementation - -uses - LibDelphi; - -procedure jpeg_error_exit_raise; cdecl; -begin - raise Exception.Create('LibJpeg error_exit'); -end; - -procedure jpeg_create_compress(cinfo: PRJpegCompressStruct); cdecl; -begin - jpeg_CreateCompress(cinfo,JPEG_LIB_VERSION,SizeOf(RJpegCompressStruct)); -end; - -procedure jpeg_create_decompress(cinfo: PRJpegDecompressStruct); cdecl; -begin - jpeg_CreateDecompress(cinfo,JPEG_LIB_VERSION,SizeOf(RJpegDecompressStruct)); -end; - -function jpeg_get_small(cinfo: PRJpegCommonStruct; sizeofobject: Cardinal): Pointer; cdecl; external; -function jpeg_get_large(cinfo: PRJpegCommonStruct; sizeofobject: Cardinal): Pointer; cdecl; external; -function jpeg_mem_available(cinfo: PRJpegCommonStruct; min_bytes_needed: Integer; max_bytes_needed: Integer; already_allocated: Integer): Integer; cdecl; external; -procedure jpeg_open_backing_store(cinfo: PRJpegCommonStruct; info: Pointer; total_bytes_needed: Integer); cdecl; external; -procedure jpeg_free_large(cinfo: PRJpegCommonStruct; objectt: Pointer; sizeofobject: Cardinal); cdecl; external; -procedure jpeg_free_small(cinfo: PRJpegCommonStruct; objectt: Pointer; sizeofobject: Cardinal); cdecl; external; -procedure jpeg_mem_term(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_mem_init(cinfo: PRJpegCommonStruct): Integer; cdecl; external; -procedure jinit_memory_mgr(cinfo: PRJpegCommonStruct); cdecl; external; -function jpeg_alloc_huff_table(cinfo: PRJpegCommonStruct): Pointer; cdecl; external; -function jpeg_alloc_quant_table(cinfo: PRJpegCommonStruct): Pointer; cdecl; external; -function jdiv_round_up(a: Integer; b: Integer): Integer; cdecl; external; -procedure jcopy_sample_rows(input_array: Pointer; source_row: Integer; output_array: Pointer; dest_row: Integer; num_rows: Integer; - num_cols: Cardinal); cdecl; external; -function jround_up(a: Integer; b: Integer): Integer; cdecl; external; -procedure jcopy_block_row(input_row: Pointer; output_row: Pointer; num_blocks: Cardinal); cdecl; external; - -{$L Compiled\jmemnobs.obj} -{$L Compiled\jmemmgr.obj} -{$L Compiled\jcomapi.obj} -{$L Compiled\jerror.obj} -{$L Compiled\jcapimin.obj} -{$L Compiled\jcmarker.obj} -{$L Compiled\jutils.obj} -{$L Compiled\jdapimin.obj} -{$L Compiled\jdmarker.obj} -{$L Compiled\jdinput.obj} -{$L Compiled\jcparam.obj} -{$L Compiled\jcapistd.obj} -{$L Compiled\jcinit.obj} -{$L Compiled\jcmaster.obj} -{$L Compiled\jccolor.obj} -{$L Compiled\jcsample.obj} -{$L Compiled\jcprepct.obj} -{$L Compiled\jcdctmgr.obj} -{$L Compiled\jcphuff.obj} -{$L Compiled\jchuff.obj} -{$L Compiled\jccoefct.obj} -{$L Compiled\jcmainct.obj} -{$L Compiled\jfdctint.obj} -{$L Compiled\jfdctfst.obj} -{$L Compiled\jfdctflt.obj} -{$L Compiled\jdapistd.obj} -{$L Compiled\jdmaster.obj} -{$L Compiled\jquant1.obj} -{$L Compiled\jquant2.obj} -{$L Compiled\jdmerge.obj} -{$L Compiled\jdcolor.obj} -{$L Compiled\jdsample.obj} -{$L Compiled\jdpostct.obj} -{$L Compiled\jddctmgr.obj} -{$L Compiled\jdphuff.obj} -{$L Compiled\jdhuff.obj} -{$L Compiled\jdcoefct.obj} -{$L Compiled\jdmainct.obj} -{$L Compiled\jidctred.obj} -{$L Compiled\jidctint.obj} -{$L Compiled\jidctfst.obj} -{$L Compiled\jidctflt.obj} - -end. - - - diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas b/3rd/Imaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas deleted file mode 100644 index e68980438..000000000 --- a/3rd/Imaging/Extras/Extensions/LibTiff/LibTiffDelphi.pas +++ /dev/null @@ -1,1602 +0,0 @@ -unit LibTiffDelphi; - -{$ALIGN 8} -{$MINENUMSIZE 1} - -interface - -uses - Windows, SysUtils, Classes; - -const - //DW - LibTiffDelphiVersionString = 'LibTiffDelphi 3.9.4.00'#13#10'Pre-compiled LibTiff for Delphi'#13#10'http://www.awaresystems.be/'#13#10'3.9.4 implementaion by Do-wan Kim'#13#10; - - TIFF_NOTYPE = 0; - TIFF_BYTE = 1; { 8-bit unsigned integer } - TIFF_ASCII = 2; { 8-bit bytes w/ last byte null } - TIFF_SHORT = 3; { 16-bit unsigned integer } - TIFF_LONG = 4; { 32-bit unsigned integer } - TIFF_RATIONAL = 5; { 64-bit unsigned fraction } - TIFF_SBYTE = 6; { !8-bit signed integer } - TIFF_UNDEFINED = 7; { !8-bit untyped data } - TIFF_SSHORT = 8; { !16-bit signed integer } - TIFF_SLONG = 9; { !32-bit signed integer } - TIFF_SRATIONAL = 10; { !64-bit signed fraction } - TIFF_FLOAT = 11; { !32-bit IEEE floating point } - TIFF_DOUBLE = 12; { !64-bit IEEE floating point } - TIFF_IFD = 13; { %32-bit unsigned integer (offset) } - TIFF_UNICODE = 14; - TIFF_COMPLEX = 15; - TIFF_LONG8 = 16; - TIFF_SLONG8 = 17; - TIFF_IFD8 = 18; - - - TIFFTAG_SUBFILETYPE = 254; { subfile data descriptor } - FILETYPE_REDUCEDIMAGE = $1; { reduced resolution version } - FILETYPE_PAGE = $2; { one page of many } - FILETYPE_MASK = $4; { transparency mask } - TIFFTAG_OSUBFILETYPE = 255; { kind of data in subfile } - OFILETYPE_IMAGE = 1; { full resolution image data } - OFILETYPE_REDUCEDIMAGE = 2; { reduced size image data } - OFILETYPE_PAGE = 3; { one page of many } - TIFFTAG_IMAGEWIDTH = 256; { image width in pixels } - TIFFTAG_IMAGELENGTH = 257; { image height in pixels } - TIFFTAG_BITSPERSAMPLE = 258; { bits per channel (sample) } - TIFFTAG_COMPRESSION = 259; { data compression technique } - COMPRESSION_NONE = 1; { dump mode } - COMPRESSION_CCITTRLE = 2; { CCITT modified Huffman RLE } - COMPRESSION_CCITTFAX3 = 3; { CCITT Group 3 fax encoding } - COMPRESSION_CCITT_T4 = 3; { CCITT T.4 (TIFF 6 name) } - COMPRESSION_CCITTFAX4 = 4; { CCITT Group 4 fax encoding } - COMPRESSION_CCITT_T6 = 4; { CCITT T.6 (TIFF 6 name) } - COMPRESSION_LZW = 5; { Lempel-Ziv & Welch } - COMPRESSION_OJPEG = 6; { !6.0 JPEG } - COMPRESSION_JPEG = 7; { %JPEG DCT compression } - COMPRESSION_NEXT = 32766; { NeXT 2-bit RLE } - COMPRESSION_CCITTRLEW = 32771; { #1 w/ word alignment } - COMPRESSION_PACKBITS = 32773; { Macintosh RLE } - COMPRESSION_THUNDERSCAN = 32809; { ThunderScan RLE } - { codes 32895-32898 are reserved for ANSI IT8 TIFF/IT } - COMPRESSION_DCS = 32947; { Kodak DCS encoding } - COMPRESSION_JBIG = 34661; { ISO JBIG } - COMPRESSION_SGILOG = 34676; { SGI Log Luminance RLE } - COMPRESSION_SGILOG24 = 34677; { SGI Log 24-bit packed } - COMPRESSION_JP2000 = 34712; { Leadtools JPEG2000 } - TIFFTAG_PHOTOMETRIC = 262; { photometric interpretation } - PHOTOMETRIC_MINISWHITE = 0; { min value is white } - PHOTOMETRIC_MINISBLACK = 1; { min value is black } - PHOTOMETRIC_RGB = 2; { RGB color model } - PHOTOMETRIC_PALETTE = 3; { color map indexed } - PHOTOMETRIC_MASK = 4; { $holdout mask } - PHOTOMETRIC_SEPARATED = 5; { !color separations } - PHOTOMETRIC_YCBCR = 6; { !CCIR 601 } - PHOTOMETRIC_CIELAB = 8; { !1976 CIE L*a*b* } - PHOTOMETRIC_ICCLAB = 9; { ICC L*a*b* [Adobe TIFF Technote 4] } - PHOTOMETRIC_ITULAB = 10; { ITU L*a*b* } - PHOTOMETRIC_LOGL = 32844; { CIE Log2(L) } - PHOTOMETRIC_LOGLUV = 32845; { CIE Log2(L) (u',v') } - TIFFTAG_THRESHHOLDING = 263; { thresholding used on data } - THRESHHOLD_BILEVEL = 1; { b&w art scan } - THRESHHOLD_HALFTONE = 2; { or dithered scan } - THRESHHOLD_ERRORDIFFUSE = 3; { usually floyd-steinberg } - TIFFTAG_CELLWIDTH = 264; { +dithering matrix width } - TIFFTAG_CELLLENGTH = 265; { +dithering matrix height } - TIFFTAG_FILLORDER = 266; { data order within a byte } - FILLORDER_MSB2LSB = 1; { most significant -> least } - FILLORDER_LSB2MSB = 2; { least significant -> most } - TIFFTAG_DOCUMENTNAME = 269; { name of doc. image is from } - TIFFTAG_IMAGEDESCRIPTION = 270; { info about image } - TIFFTAG_MAKE = 271; { scanner manufacturer name } - TIFFTAG_MODEL = 272; { scanner model name/number } - TIFFTAG_STRIPOFFSETS = 273; { offsets to data strips } - TIFFTAG_ORIENTATION = 274; { +image orientation } - ORIENTATION_TOPLEFT = 1; { row 0 top, col 0 lhs } - ORIENTATION_TOPRIGHT = 2; { row 0 top, col 0 rhs } - ORIENTATION_BOTRIGHT = 3; { row 0 bottom, col 0 rhs } - ORIENTATION_BOTLEFT = 4; { row 0 bottom, col 0 lhs } - ORIENTATION_LEFTTOP = 5; { row 0 lhs, col 0 top } - ORIENTATION_RIGHTTOP = 6; { row 0 rhs, col 0 top } - ORIENTATION_RIGHTBOT = 7; { row 0 rhs, col 0 bottom } - ORIENTATION_LEFTBOT = 8; { row 0 lhs, col 0 bottom } - TIFFTAG_SAMPLESPERPIXEL = 277; { samples per pixel } - TIFFTAG_ROWSPERSTRIP = 278; { rows per strip of data } - TIFFTAG_STRIPBYTECOUNTS = 279; { bytes counts for strips } - TIFFTAG_MINSAMPLEVALUE = 280; { +minimum sample value } - TIFFTAG_MAXSAMPLEVALUE = 281; { +maximum sample value } - TIFFTAG_XRESOLUTION = 282; { pixels/resolution in x } - TIFFTAG_YRESOLUTION = 283; { pixels/resolution in y } - TIFFTAG_PLANARCONFIG = 284; { storage organization } - PLANARCONFIG_CONTIG = 1; { single image plane } - PLANARCONFIG_SEPARATE = 2; { separate planes of data } - TIFFTAG_PAGENAME = 285; { page name image is from } - TIFFTAG_XPOSITION = 286; { x page offset of image lhs } - TIFFTAG_YPOSITION = 287; { y page offset of image lhs } - TIFFTAG_FREEOFFSETS = 288; { +byte offset to free block } - TIFFTAG_FREEBYTECOUNTS = 289; { +sizes of free blocks } - - {matched with tag reference up to this point} - - TIFFTAG_GRAYRESPONSEUNIT = 290; { $gray scale curve accuracy } - GRAYRESPONSEUNIT_10S = 1; { tenths of a unit } - GRAYRESPONSEUNIT_100S = 2; { hundredths of a unit } - GRAYRESPONSEUNIT_1000S = 3; { thousandths of a unit } - GRAYRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - GRAYRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_GRAYRESPONSECURVE = 291; { $gray scale response curve } - TIFFTAG_GROUP3OPTIONS = 292; { 32 flag bits } - TIFFTAG_T4OPTIONS = 292; { TIFF 6.0 proper name alias } - GROUP3OPT_2DENCODING = $1; { 2-dimensional coding } - GROUP3OPT_UNCOMPRESSED = $2; { data not compressed } - GROUP3OPT_FILLBITS = $4; { fill to byte boundary } - TIFFTAG_GROUP4OPTIONS = 293; { 32 flag bits } - TIFFTAG_T6OPTIONS = 293; { TIFF 6.0 proper name } - GROUP4OPT_UNCOMPRESSED = $2; { data not compressed } - TIFFTAG_RESOLUTIONUNIT = 296; { units of resolutions } - RESUNIT_NONE = 1; { no meaningful units } - RESUNIT_INCH = 2; { english } - RESUNIT_CENTIMETER = 3; { metric } - TIFFTAG_PAGENUMBER = 297; { page numbers of multi-page } - TIFFTAG_COLORRESPONSEUNIT = 300; { $color curve accuracy } - COLORRESPONSEUNIT_10S = 1; { tenths of a unit } - COLORRESPONSEUNIT_100S = 2; { hundredths of a unit } - COLORRESPONSEUNIT_1000S = 3; { thousandths of a unit } - COLORRESPONSEUNIT_10000S = 4; { ten-thousandths of a unit } - COLORRESPONSEUNIT_100000S = 5; { hundred-thousandths } - TIFFTAG_TRANSFERFUNCTION = 301; { !colorimetry info } - TIFFTAG_SOFTWARE = 305; { name & release } - TIFFTAG_DATETIME = 306; { creation date and time } - TIFFTAG_ARTIST = 315; { creator of image } - TIFFTAG_HOSTCOMPUTER = 316; { machine where created } - TIFFTAG_PREDICTOR = 317; { prediction scheme w/ LZW } - TIFFTAG_WHITEPOINT = 318; { image white point } - TIFFTAG_PRIMARYCHROMATICITIES = 319; { !primary chromaticities } - TIFFTAG_COLORMAP = 320; { RGB map for pallette image } - TIFFTAG_HALFTONEHINTS = 321; { !highlight+shadow info } - TIFFTAG_TILEWIDTH = 322; { !rows/data tile } - TIFFTAG_TILELENGTH = 323; { !cols/data tile } - TIFFTAG_TILEOFFSETS = 324; { !offsets to data tiles } - TIFFTAG_TILEBYTECOUNTS = 325; { !byte counts for tiles } - TIFFTAG_BADFAXLINES = 326; { lines w/ wrong pixel count } - TIFFTAG_CLEANFAXDATA = 327; { regenerated line info } - CLEANFAXDATA_CLEAN = 0; { no errors detected } - CLEANFAXDATA_REGENERATED = 1; { receiver regenerated lines } - CLEANFAXDATA_UNCLEAN = 2; { uncorrected errors exist } - TIFFTAG_CONSECUTIVEBADFAXLINES = 328; { max consecutive bad lines } - TIFFTAG_SUBIFD = 330; { subimage descriptors } - TIFFTAG_INKSET = 332; { !inks in separated image } - INKSET_CMYK = 1; { !cyan-magenta-yellow-black color } - INKSET_MULTIINK = 2; { !multi-ink or hi-fi color } - TIFFTAG_INKNAMES = 333; { !ascii names of inks } - TIFFTAG_NUMBEROFINKS = 334; { !number of inks } - TIFFTAG_DOTRANGE = 336; { !0% and 100% dot codes } - TIFFTAG_TARGETPRINTER = 337; { !separation target } - TIFFTAG_EXTRASAMPLES = 338; { !info about extra samples } - EXTRASAMPLE_UNSPECIFIED = 0; { !unspecified data } - EXTRASAMPLE_ASSOCALPHA = 1; { !associated alpha data } - EXTRASAMPLE_UNASSALPHA = 2; { !unassociated alpha data } - TIFFTAG_SAMPLEFORMAT = 339; { !data sample format } - SAMPLEFORMAT_UINT = 1; { !unsigned integer data } - SAMPLEFORMAT_INT = 2; { !signed integer data } - SAMPLEFORMAT_IEEEFP = 3; { !IEEE floating point data } - SAMPLEFORMAT_VOID = 4; { !untyped data } - SAMPLEFORMAT_COMPLEXINT = 5; { !complex signed int } - SAMPLEFORMAT_COMPLEXIEEEFP = 6; { !complex ieee floating } - TIFFTAG_SMINSAMPLEVALUE = 340; { !variable MinSampleValue } - TIFFTAG_SMAXSAMPLEVALUE = 341; { !variable MaxSampleValue } - TIFFTAG_CLIPPATH = 343; { %ClipPath [Adobe TIFF technote 2] } - TIFFTAG_XCLIPPATHUNITS = 344; { %XClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_YCLIPPATHUNITS = 345; { %YClipPathUnits [Adobe TIFF technote 2] } - TIFFTAG_INDEXED = 346; { %Indexed [Adobe TIFF Technote 3] } - TIFFTAG_JPEGTABLES = 347; { %JPEG table stream } - TIFFTAG_OPIPROXY = 351; { %OPI Proxy [Adobe TIFF technote] } - { Tags 512-521 are obsoleted by Technical Note #2 - which specifies a revised JPEG-in-TIFF scheme. } - TIFFTAG_JPEGPROC = 512; { !JPEG processing algorithm } - JPEGPROC_BASELINE = 1; { !baseline sequential } - JPEGPROC_LOSSLESS = 14; { !Huffman coded lossless } - TIFFTAG_JPEGIFOFFSET = 513; { !pointer to SOI marker } - TIFFTAG_JPEGIFBYTECOUNT = 514; { !JFIF stream length } - TIFFTAG_JPEGRESTARTINTERVAL = 515; { !restart interval length } - TIFFTAG_JPEGLOSSLESSPREDICTORS = 517; { !lossless proc predictor } - TIFFTAG_JPEGPOINTTRANSFORM = 518; { !lossless point transform } - TIFFTAG_JPEGQTABLES = 519; { !Q matrice offsets } - TIFFTAG_JPEGDCTABLES = 520; { !DCT table offsets } - TIFFTAG_JPEGACTABLES = 521; { !AC coefficient offsets } - TIFFTAG_YCBCRCOEFFICIENTS = 529; { !RGB -> YCbCr transform } - TIFFTAG_YCBCRSUBSAMPLING = 530; { !YCbCr subsampling factors } - TIFFTAG_YCBCRPOSITIONING = 531; { !subsample positioning } - YCBCRPOSITION_CENTERED = 1; { !as in PostScript Level 2 } - YCBCRPOSITION_COSITED = 2; { !as in CCIR 601-1 } - TIFFTAG_REFERENCEBLACKWHITE = 532; { !colorimetry info } - TIFFTAG_XMLPACKET = 700; { %XML packet [Adobe XMP technote 9-14-02] (dkelly@apago.com) } - TIFFTAG_OPIIMAGEID = 32781; { %OPI ImageID [Adobe TIFF technote] } - { tags 32952-32956 are private tags registered to Island Graphics } - TIFFTAG_REFPTS = 32953; { image reference points } - TIFFTAG_REGIONTACKPOINT = 32954; { region-xform tack point } - TIFFTAG_REGIONWARPCORNERS = 32955; { warp quadrilateral } - TIFFTAG_REGIONAFFINE = 32956; { affine transformation mat } - { tags 32995-32999 are private tags registered to SGI } - TIFFTAG_MATTEING = 32995; { $use ExtraSamples } - TIFFTAG_DATATYPE = 32996; { $use SampleFormat } - TIFFTAG_IMAGEDEPTH = 32997; { z depth of image } - TIFFTAG_TILEDEPTH = 32998; { z depth/data tile } - { tags 33300-33309 are private tags registered to Pixar } - { TIFFTAG_PIXAR_IMAGEFULLWIDTH and TIFFTAG_PIXAR_IMAGEFULLLENGTH are set when an image has been cropped out of a larger image. - They reflect the size of the original uncropped image. The TIFFTAG_XPOSITION and TIFFTAG_YPOSITION can be used to determine the - position of the smaller image in the larger one. } - TIFFTAG_PIXAR_IMAGEFULLWIDTH = 33300; { full image size in x } - TIFFTAG_PIXAR_IMAGEFULLLENGTH = 33301; { full image size in y } - { Tags 33302-33306 are used to identify special image modes and data used by Pixar's texture formats. } - TIFFTAG_PIXAR_TEXTUREFORMAT = 33302; { texture map format } - TIFFTAG_PIXAR_WRAPMODES = 33303; { s & t wrap modes } - TIFFTAG_PIXAR_FOVCOT = 33304; { cotan(fov) for env. maps } - TIFFTAG_PIXAR_MATRIX_WORLDTOSCREEN = 33305; - TIFFTAG_PIXAR_MATRIX_WORLDTOCAMERA = 33306; - { tag 33405 is a private tag registered to Eastman Kodak } - TIFFTAG_WRITERSERIALNUMBER = 33405; { device serial number } - { tag 33432 is listed in the 6.0 spec w/ unknown ownership } - TIFFTAG_COPYRIGHT = 33432; { copyright string } - { IPTC TAG from RichTIFF specifications } - TIFFTAG_RICHTIFFIPTC = 33723; - { 34016-34029 are reserved for ANSI IT8 TIFF/IT } - TIFFTAG_STONITS = 37439; { Sample value to Nits } - { tag 34929 is a private tag registered to FedEx } - TIFFTAG_FEDEX_EDR = 34929; { unknown use } - { tag 65535 is an undefined tag used by Eastman Kodak } - TIFFTAG_DCSHUESHIFTVALUES = 65535; { hue shift correction data } - { The following are ``pseudo tags'' that can be used to control codec-specific functionality. These tags are not written to file. - Note that these values start at 0xffff+1 so that they'll never collide with Aldus-assigned tags. } - TIFFTAG_FAXMODE = 65536; { Group 3/4 format control } - FAXMODE_CLASSIC = $0; { default, include RTC } - FAXMODE_NORTC = $1; { no RTC at end of data } - FAXMODE_NOEOL = $2; { no EOL code at end of row } - FAXMODE_BYTEALIGN = $4; { byte align row } - FAXMODE_WORDALIGN = $8; { word align row } - FAXMODE_CLASSF = FAXMODE_NORTC; { TIFF Class F } - TIFFTAG_JPEGQUALITY = 65537; { Compression quality level } - { Note: quality level is on the IJG 0-100 scale. Default value is 75 } - TIFFTAG_JPEGCOLORMODE = 65538; { Auto RGB<=>YCbCr convert? } - JPEGCOLORMODE_RAW = $0; { no conversion (default) } - JPEGCOLORMODE_RGB = $1; { do auto conversion } - TIFFTAG_JPEGTABLESMODE = 65539; { What to put in JPEGTables } - JPEGTABLESMODE_QUANT = $1; { include quantization tbls } - JPEGTABLESMODE_HUFF = $2; { include Huffman tbls } - { Note: default is JPEGTABLESMODE_QUANT | JPEGTABLESMODE_HUFF } - TIFFTAG_FAXFILLFUNC = 65540; { G3/G4 fill function } - TIFFTAG_PIXARLOGDATAFMT = 65549; { PixarLogCodec I/O data sz } - PIXARLOGDATAFMT_8BIT = 0; { regular u_char samples } - PIXARLOGDATAFMT_8BITABGR = 1; { ABGR-order u_chars } - PIXARLOGDATAFMT_11BITLOG = 2; { 11-bit log-encoded (raw) } - PIXARLOGDATAFMT_12BITPICIO = 3; { as per PICIO (1.0==2048) } - PIXARLOGDATAFMT_16BIT = 4; { signed short samples } - PIXARLOGDATAFMT_FLOAT = 5; { IEEE float samples } - { 65550-65556 are allocated to Oceana Matrix } - TIFFTAG_DCSIMAGERTYPE = 65550; { imager model & filter } - DCSIMAGERMODEL_M3 = 0; { M3 chip (1280 x 1024) } - DCSIMAGERMODEL_M5 = 1; { M5 chip (1536 x 1024) } - DCSIMAGERMODEL_M6 = 2; { M6 chip (3072 x 2048) } - DCSIMAGERFILTER_IR = 0; { infrared filter } - DCSIMAGERFILTER_MONO = 1; { monochrome filter } - DCSIMAGERFILTER_CFA = 2; { color filter array } - DCSIMAGERFILTER_OTHER = 3; { other filter } - TIFFTAG_DCSINTERPMODE = 65551; { interpolation mode } - DCSINTERPMODE_NORMAL = 0; { whole image, default } - DCSINTERPMODE_PREVIEW = 1; { preview of image (384x256) } - TIFFTAG_DCSBALANCEARRAY = 65552; { color balance values } - TIFFTAG_DCSCORRECTMATRIX = 65553; { color correction values } - TIFFTAG_DCSGAMMA = 65554; { gamma value } - TIFFTAG_DCSTOESHOULDERPTS = 65555; { toe & shoulder points } - TIFFTAG_DCSCALIBRATIONFD = 65556; { calibration file desc } - { Note: quality level is on the ZLIB 1-9 scale. Default value is -1 } - TIFFTAG_ZIPQUALITY = 65557; { compression quality level } - TIFFTAG_PIXARLOGQUALITY = 65558; { PixarLog uses same scale } - { 65559 is allocated to Oceana Matrix } - TIFFTAG_DCSCLIPRECTANGLE = 65559; { area of image to acquire } - TIFFTAG_SGILOGDATAFMT = 65560; { SGILog user data format } - SGILOGDATAFMT_FLOAT = 0; { IEEE float samples } - SGILOGDATAFMT_16BIT = 1; { 16-bit samples } - SGILOGDATAFMT_RAW = 2; { uninterpreted data } - SGILOGDATAFMT_8BIT = 3; { 8-bit RGB monitor values } - TIFFTAG_SGILOGENCODE = 65561; { SGILog data encoding control } - SGILOGENCODE_NODITHER = 0; { do not dither encoded values } - SGILOGENCODE_RANDITHER = 1; { randomly dither encd values } - - - { Flags to pass to TIFFPrintDirectory to control printing of data structures that are potentially very large. Bit-or these flags to - enable printing multiple items. } - TIFFPRINT_NONE = $0; { no extra info } - TIFFPRINT_STRIPS = $1; { strips/tiles info } - TIFFPRINT_CURVES = $2; { color/gray response curves } - TIFFPRINT_COLORMAP = $4; { colormap } - TIFFPRINT_JPEGQTABLES = $100; { JPEG Q matrices } - TIFFPRINT_JPEGACTABLES = $200; { JPEG AC tables } - TIFFPRINT_JPEGDCTABLES = $200; { JPEG DC tables } - - - TIFF_ANY = TIFF_NOTYPE; { for field descriptor searching } - TIFF_VARIABLE = -1; { marker for variable length tags } - TIFF_SPP = -2; { marker for SamplesPerPixel tags } - TIFF_VARIABLE2 = -3; { marker for uint32 var-length tags } - - FIELD_CUSTOM = 65; - - {added for LibTiff 3.9.4 by Alex (leontyyy@gmail.com) Dec.2011} - TIFFTAG_EXIFIFD = 34665; { pointer to the Exif IFD } - EXIFTAG_FOCALLENGTH = 37386; { focal length } - EXIFTAG_FOCALLENGTHIN35MMFILM = 41989; { indicates the equivalent focal length assuming a 35mm film camera, in mm } - EXIFTAG_EXIFVERSION = 36864; { version of exif format } - EXIFTAG_DATETIMEDIGITIZED = 36868; { date and time when the image was stored as digital data } - EXIFTAG_DATETIMEORIGINAL = 36867; { date and time when the original image data was generated } - EXIFTAG_EXPOSURETIME = 33434; { exposure time, given in seconds } - EXIFTAG_FNUMBER = 33437; { F number } - EXIFTAG_EXPOSUREPROGRAM = 34850; { class of the program used by the camera to set exposure } - EXIFTAG_SPECTRALSENSITIVITY = 34852; { spectral sensitivity of each channel of the camera used } - EXIFTAG_ISOSPEEDRATINGS = 34855; { ISO Speed and ISO Latitude } - EXIFTAG_OECF = 34856; { Opto-Electric Conversion Function } - EXIFTAG_COMPONENTSCONFIGURATION = 37121; { meaning of each component } - EXIFTAG_COMPRESSEDBITSPERPIXEL = 37122; { compression mode } - EXIFTAG_SHUTTERSPEEDVALUE = 37377; { shutter speed } - EXIFTAG_APERTUREVALUE = 37378; { lens aperture } - EXIFTAG_BRIGHTNESSVALUE = 37379; { brightness } - EXIFTAG_EXPOSUREBIASVALUE = 37380; { exposure bias } - EXIFTAG_MAXAPERTUREVALUE = 37381; { maximum lens aperture } - EXIFTAG_SUBJECTDISTANCE = 37382; { distance to the subject in meters } - EXIFTAG_METERINGMODE = 37383; { metering mode } - EXIFTAG_LIGHTSOURCE = 37384; { light source } - EXIFTAG_FLASH = 37385; { flash } - EXIFTAG_SUBJECTAREA = 37396; { subject area (in exif ver.2.2) } - EXIFTAG_MAKERNOTE = 37500; { manufacturer notes } - EXIFTAG_USERCOMMENT = 37510; { user comments } - EXIFTAG_SUBSECTIME = 37520; { DateTime subseconds } - EXIFTAG_SUBSECTIMEORIGINAL = 37521; { DateTimeOriginal subseconds } - EXIFTAG_SUBSECTIMEDIGITIZED = 37522; { DateTimeDigitized subseconds } - EXIFTAG_FLASHPIXVERSION = 40960; { FlashPix format version } - EXIFTAG_COLORSPACE = 40961; { color space information } - EXIFTAG_PIXELXDIMENSION = 40962; { valid image width } - EXIFTAG_PIXELYDIMENSION = 40963; { valid image height } - EXIFTAG_RELATEDSOUNDFILE = 40964; { related audio file } - EXIFTAG_FLASHENERGY = 41483; { flash energy } - EXIFTAG_SPATIALFREQUENCYRESPONSE = 41484; { spatial frequency response } - EXIFTAG_FOCALPLANEXRESOLUTION = 41486; { focal plane X resolution } - EXIFTAG_FOCALPLANEYRESOLUTION = 41487; { focal plane Y resolution } - EXIFTAG_FOCALPLANERESOLUTIONUNIT = 41488; { focal plane resolution unit } - EXIFTAG_SUBJECTLOCATION = 41492; { subject location } - EXIFTAG_EXPOSUREINDEX = 41493; { exposure index } - EXIFTAG_SENSINGMETHOD = 41495; { sensing method } - EXIFTAG_FILESOURCE = 41728; { file source } - EXIFTAG_SCENETYPE = 41729; { scene type } - EXIFTAG_CFAPATTERN = 41730; { CFA pattern } - EXIFTAG_CUSTOMRENDERED = 41985; { custom image processing (in exif ver.2.2) } - EXIFTAG_EXPOSUREMODE = 41986; { exposure mode (in exif ver.2.2) } - EXIFTAG_WHITEBALANCE = 41987; { white balance (in exif ver.2.2) } - EXIFTAG_DIGITALZOOMRATIO = 41988; { digital zoom ratio (in exif ver.2.2) } - EXIFTAG_SCENECAPTURETYPE = 41990; { scene capture type (in exif ver.2.2) } - EXIFTAG_GAINCONTROL = 41991; { gain control (in exif ver.2.2) } - EXIFTAG_CONTRAST = 41992; { contrast (in exif ver.2.2) } - EXIFTAG_SATURATION = 41993; { saturation (in exif ver.2.2) } - EXIFTAG_SHARPNESS = 41994; { sharpness (in exif ver.2.2) } - EXIFTAG_DEVICESETTINGDESCRIPTION = 41995; { device settings description (in exif ver.2.2) } - EXIFTAG_SUBJECTDISTANCERANGE = 41996; { subject distance range (in exif ver.2.2) } - EXIFTAG_IMAGEUNIQUEID = 42016; { Unique image ID (in exif ver.2.2) } - -type - - PTIFF = Pointer; - PTIFFRGBAImage = Pointer; - - TIFFErrorHandler = procedure(a: Pointer; b: Pointer; c: Pointer); cdecl; - LibTiffDelphiErrorHandler = procedure(const a,b: AnsiString); - TIFFReadWriteProc = function(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; - TIFFSeekProc = function(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; - TIFFCloseProc = function(Fd: Cardinal): Integer; cdecl; - TIFFSizeProc = function(Fd: Cardinal): Cardinal; cdecl; - TIFFMapFileProc = function(Fd: Cardinal; PBase: PPointer; PSize: PCardinal): Integer; cdecl; - TIFFUnmapFileProc = procedure(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl; - TIFFExtendProc = procedure(Handle: PTIFF); cdecl; - - TIFFInitMethod = function(Handle: PTIFF; Scheme: Integer): Integer; cdecl; - - PTIFFCodec = ^TIFFCodec; - TIFFCodec = record - Name: PAnsiChar; - Scheme: Word; - Init: TIFFInitMethod; - end; - - PTIFFFieldInfo = ^TIFFFieldInfo; - TIFFFieldInfo = record - FieldTag: Cardinal; { field's tag } - FieldReadCount: Smallint; { read count/TIFF_VARIABLE/TIFF_SPP } - FieldWriteCount: Smallint; { write count/TIFF_VARIABLE } - FieldType: Integer; { type of associated data } - FieldBit: Word; { bit in fieldsset bit vector } - FieldOkToChange: Byte; { if true, can change while writing } - FieldPassCount: Byte; { if true, pass dir count on set } - FieldName: PAnsiChar; { ASCII name } - end; - - PTIFFTagValue = ^TIFFTagValue; - TIFFTagValue = record - Info: PTIFFFieldInfo; - Count: Integer; - Value: Pointer; - end; - -function LibTiffDelphiVersion: AnsiString; -function TIFFGetVersion: PAnsiChar; cdecl; external; -function TIFFFindCODEC(Scheme: Word): PTIFFCodec; cdecl; external; -function TIFFRegisterCODEC(Scheme: Word; Name: PAnsiChar; InitMethod: TIFFInitMethod): PTIFFCodec; cdecl; external; -procedure TIFFUnRegisterCODEC(c: PTIFFCodec); cdecl; external; -function TIFFIsCODECConfigured(Scheme: Word): Integer; cdecl; external; -function TIFFGetConfiguredCODECs: PTIFFCodec; cdecl; external; - -function TIFFOpen(const Name: AnsiString; const Mode: AnsiString): PTIFF; -function TIFFOpenStream(const Stream: TStream; const Mode: AnsiString): PTIFF; -function TIFFClientOpen(Name: PAnsiChar; Mode: PAnsiChar; ClientData: Cardinal; - ReadProc: TIFFReadWriteProc; - WriteProc: TIFFReadWriteProc; - SeekProc: TIFFSeekProc; - CloseProc: TIFFCloseProc; - SizeProc: TIFFSizeProc; - MapProc: TIFFMapFileProc; - UnmapProc: TIFFUnmapFileProc): PTIFF; cdecl; external; -procedure TIFFCleanup(Handle: PTIFF); cdecl; external; -procedure TIFFClose(Handle: PTIFF); cdecl; external; -function TIFFFileno(Handle: PTIFF): Integer; cdecl; external; -function TIFFSetFileno(Handle: PTIFF; Newvalue: Integer): Integer; cdecl; external; -function TIFFClientdata(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFSetClientdata(Handle: PTIFF; Newvalue: Cardinal): Cardinal; cdecl; external; -function TIFFGetMode(Handle: PTIFF): Integer; cdecl; external; -function TIFFSetMode(Handle: PTIFF; Mode: Integer): Integer; cdecl; external; -function TIFFFileName(Handle: PTIFF): Pointer; cdecl; external; -function TIFFSetFileName(Handle: PTIFF; Name: PAnsiChar): PAnsiChar; cdecl; external; -function TIFFGetReadProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external; -function TIFFGetWriteProc(Handle: PTIFF): TIFFReadWriteProc; cdecl; external; -function TIFFGetSeekProc(Handle: PTIFF): TIFFSeekProc; cdecl; external; -function TIFFGetCloseProc(Handle: PTIFF): TIFFCloseProc; cdecl; external; -function TIFFGetSizeProc(Handle: PTIFF): TIFFSizeProc; cdecl; external; -procedure TIFFError(Module: Pointer; Fmt: Pointer); cdecl; external; varargs; -function TIFFSetErrorHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external; -function LibTiffDelphiGetErrorHandler: LibTiffDelphiErrorHandler; -function LibTiffDelphiSetErrorHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler; -procedure TIFFWarning(Module: Pointer; Fmt: Pointer); cdecl; external; varargs; -function TIFFSetWarningHandler(Handler: TIFFErrorHandler): TIFFErrorHandler; cdecl; external; -function LibTiffDelphiGetWarningHandler: LibTiffDelphiErrorHandler; -function LibTiffDelphiSetWarningHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler; -function TIFFSetTagExtender(Extender: TIFFExtendProc): TIFFExtendProc; cdecl; external; - - -function TIFFFlush(Handle: PTIFF): Integer; cdecl; external; -function TIFFFlushData(Handle: PTIFF): Integer; cdecl; external; - -{added for LibTiff 3.9.4 by Alex (leontyyy@gmail.com) Dec.2011} -function TIFFReadEXIFDirectory(Handle: PTIFF; Diroff: Cardinal): Integer; cdecl; external; - -function TIFFReadDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFCurrentDirectory(Handle: PTIFF): Word; cdecl; external; -function TIFFCurrentDirOffset(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFLastDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFNumberOfDirectories(Handle: PTIFF): Word; cdecl; external; -function TIFFSetDirectory(Handle: PTIFF; Dirn: Word): Integer; cdecl; external; -function TIFFSetSubDirectory(Handle: PTIFF; Diroff: Cardinal): Integer; cdecl; external; -function TIFFCreateDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFWriteDirectory(Handle: PTIFF): Integer; cdecl; external; -function TIFFUnlinkDirectory(handle: PTIFF; Dirn: Word): Integer; cdecl; external; -procedure TIFFPrintDirectory(Handle: PTIFF; Fd: Pointer; Flags: Integer); cdecl; external; - -function TIFFGetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFGetFieldDefaulted(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFVGetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external; -function TIFFSetField(Handle: PTIFF; Tag: Cardinal): Integer; cdecl; external; varargs; -function TIFFVSetField(Handle: PTIFF; Tag: Cardinal; Ap: Pointer): Integer; cdecl; external; -function TIFFIsBigEndian(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsTiled(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsByteSwapped(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsUpSampled(Handle: PTIFF): Integer; cdecl; external; -function TIFFIsMSB2LSB(Handle: PTIFF): Integer; cdecl; external; - -function TIFFGetTagListCount(Handle: PTIFF): Integer; cdecl; external; -function TIFFGetTagListEntry(Handle: PTIFF; TagIndex: Integer): Cardinal; cdecl; external; -procedure TIFFMergeFieldInfo(Handle: PTIFF; Info: PTIFFFieldInfo; N: Integer); cdecl; external; -function TIFFFindFieldInfo(Handle: PTIFF; Tag: Cardinal; Dt: Integer): PTIFFFieldInfo; cdecl; external; -function TIFFFindFieldInfoByName(Handle: PTIFF; FIeldName: PAnsiChar; Dt: Integer): PTIFFFieldInfo; cdecl; external; -function TIFFFieldWithTag(Handle: PTIFF; Tag: Cardinal): PTIFFFieldInfo; cdecl; external; -function TIFFFieldWithName(Handle: PTIFF; FieldName: PAnsiChar): PTIFFFieldInfo; cdecl; external; -function TIFFDataWidth(DataType: Integer): Integer; cdecl; external; - -function TIFFReadRGBAImage(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Stop: Integer): Integer; cdecl; external; -function TIFFReadRGBAImageOriented(Handle: PTIFF; RWidth,RHeight: Cardinal; Raster: Pointer; Orientation: Integer; Stop: Integer): Integer; cdecl; external; -function TIFFReadRGBAStrip(Handle: PTIFF; Row: Cardinal; Raster: Pointer): Integer; cdecl; external; -function TIFFReadRGBATile(Handle: PTIFF; Col,Row: Cardinal; Raster: Pointer): Integer; cdecl; external; -function TIFFRGBAImageOk(Handle: PTIFF; Emsg: PAnsiChar): Integer; cdecl; external; -function TIFFRGBAImageBegin(Img: PTIFFRGBAImage; Handle: PTIFF; Stop: Integer; Emsg: PAnsiChar): Integer; cdecl; external; -function TIFFRGBAImageGet(Img: PTIFFRGBAImage; Raster: Pointer; W,H: Cardinal): Integer; cdecl; external; -procedure TIFFRGBAImageEnd(Img: PTIFFRGBAImage); cdecl; external; - -function TIFFCurrentRow(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFStripSize(Handle: PTIFF): Integer; cdecl; external; -function TIFFRawStripSize(Handle: PTIFF; Strip: Cardinal): Integer; cdecl; external; -function TIFFVStripSize(Handle: PTIFF; NRows: Cardinal): Integer; cdecl; external; -function TIFFDefaultStripSize(Handle: PTIFF; Request: Cardinal): Cardinal; cdecl; external; -function TIFFNumberOfStrips(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFComputeStrip(Handle: PTIFF; Row: Cardinal; Sample: Word): Cardinal; cdecl; external; -function TIFFReadRawStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: Integer): Integer; cdecl; external; -function TIFFReadEncodedStrip(Handle: PTIFF; Strip: Cardinal; Buf: Pointer; Size: Integer): Integer; cdecl; external; -function TIFFWriteRawStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: Integer): Integer; cdecl; external; -function TIFFWriteEncodedStrip(Handle: PTIFF; Strip: Cardinal; Data: Pointer; Cc: Integer): Integer; cdecl; external; -function TIFFCurrentStrip(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFTileSize(Handle: PTIFF): Integer; cdecl; external; -function TIFFTileRowSize(Handle: PTIFF): Integer; cdecl; external; -function TIFFVTileSize(Handle: PTIFF; NRows: Cardinal): Integer; cdecl; external; -procedure TIFFDefaultTileSize(Handle: PTIFF; Tw: PCardinal; Th: PCardinal); cdecl; external; -function TIFFNumberOfTiles(Handle: PTIFF): Cardinal; cdecl; external; -function TIFFComputeTile(Handle: PTIFF; X,Y,Z: Cardinal; S: Word): Cardinal; cdecl; external; -function TIFFReadRawTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: Integer): Integer; cdecl; external; -function TIFFReadEncodedTile(Handle: PTIFF; Tile: Cardinal; Buf: Pointer; Size: Integer): Integer; cdecl; external; -function TIFFWriteRawTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: Integer): Integer; cdecl; external; -function TIFFWriteEncodedTile(Handle: PTIFF; Tile: Cardinal; Data: Pointer; Cc: Integer): Integer; cdecl; external; -function TIFFCurrentTile(Handle: PTIFF): Cardinal; cdecl; external; - -function TIFFScanlineSize(Handle: PTIFF): Integer; cdecl; external; -function TIFFRasterScanlineSize(Handle: PTIFF): Integer; cdecl; external; -function TIFFReadScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: Word): Integer; cdecl; external; -function TIFFWriteScanline(Handle: PTIFF; Buf: Pointer; Row: Cardinal; Sample: Word): Integer; cdecl; external; - -procedure TIFFSetWriteOffset(Handle: PTIFF; Off: Cardinal); cdecl; external; - -procedure TIFFSwabShort(Wp: PWord); cdecl; external; -procedure TIFFSwabLong(Lp: PCardinal); cdecl; external; -procedure TIFFSwabDouble(Dp: PDouble); cdecl; external; -procedure TIFFSwabArrayOfShort(Wp: PWord; N: Cardinal); cdecl; external; -procedure TIFFSwabArrayOfLong(Lp: PCardinal; N: Cardinal); cdecl; external; -procedure TIFFSwabArrayOfDouble(Dp: PDouble; N: Cardinal); cdecl; external; -procedure TIFFReverseBits(Cp: Pointer; N: Cardinal); cdecl; external; -function TIFFGetBitRevTable(Reversed: Integer): Pointer; cdecl; external; - -function _TIFFmalloc(s: Longint): Pointer; cdecl; -function _TIFFrealloc(p: Pointer; s: Longint): Pointer; cdecl; -procedure _TIFFfree(p: Pointer); cdecl; - -implementation - -uses - Math, LibDelphi, LibJpegDelphi, ZLibDelphi; - -type - - TCompareFunc = function(a,b: Pointer): Integer; cdecl; - -function floor(x: Double): Double; cdecl; forward; -function pow(x: Double; y: Double): Double; cdecl; forward; -function sqrt(x: Double): Double; cdecl; forward; -function atan2(y: Double; x: Double): Double; cdecl; forward; -function exp(x: Double): Double; cdecl; forward; -function log(x: Double): Double; cdecl; forward; -function fabs(x: Double): Double; cdecl; forward; -function rand: Integer; cdecl; forward; -function strlen(s: Pointer): Cardinal; cdecl; forward; -function strcmp(a: Pointer; b: Pointer): Integer; cdecl; forward; -function strncmp(a: Pointer; b: Pointer; c: Longint): Integer; cdecl; forward; -procedure qsort(base: Pointer; num: Cardinal; width: Cardinal; compare: TCompareFunc); cdecl; forward; -//DW function bsearch(key: Pointer; base: Pointer; nelem: Cardinal; width: Cardinal; fcmp: TCompareFunc): Pointer; cdecl; forward; -function memmove(dest: Pointer; src: Pointer; n: Cardinal): Pointer; cdecl; forward; -function strchr(s: Pointer; c: Integer): Pointer; cdecl; forward; - -procedure _TIFFmemcpy(d: Pointer; s: Pointer; c: Longint); cdecl; forward; -procedure _TIFFmemset(p: Pointer; v: Integer; c: Longint); cdecl; forward; -function _TIFFmemcmp(buf1: Pointer; buf2: Pointer; count: Cardinal): Integer; cdecl; forward; - -var - - _TIFFwarningHandler: TIFFErrorHandler; - _TIFFerrorHandler: TIFFErrorHandler; - FLibTiffDelphiWarningHandler: LibTiffDelphiErrorHandler; - FLibTiffDelphiErrorHandler: LibTiffDelphiErrorHandler; - -function fabs(x: Double): Double; -begin - if x<0 then - Result:=-x - else - Result:=x; -end; - -function atan2(y: Double; x: Double): Double; -begin - Result:=ArcTan2(y,x); -end; - -function rand: Integer; cdecl; -begin - Result:=Trunc(Random*($7FFF+1)); -end; - -function sqrt(x: Double): Double; cdecl; -begin - Result:=System.Sqrt(x); -end; - -function log(x: Double): Double; cdecl; -begin - Result:=Ln(x); -end; - -function exp(x: Double): Double; cdecl; -begin - Result:=System.Exp(x); -end; - -function strchr(s: Pointer; c: Integer): Pointer; cdecl; -begin - Result:=s; - while True do - begin - if PByte(Result)^=c then exit; - if PByte(Result)^=0 then - begin - Result:=nil; - exit; - end; - Inc(PByte(Result)); - end; -end; - -function memmove(dest: Pointer; src: Pointer; n: Cardinal): Pointer; cdecl; -begin - MoveMemory(dest,src,n); - Result:=dest; -end; - -function _TIFFmemcmp(buf1: Pointer; buf2: Pointer; count: Cardinal): Integer; cdecl; -var - ma,mb: PByte; - n: Integer; -begin - ma:=buf1; - mb:=buf2; - n:=0; - while Cardinal(n)mb^ then - begin - if ma^=0 then - ob:=0 - else - begin - oa:=0; - ob:=n; - while oa+1mb^ then - begin - if ma^mb^ then - begin - if ma^0 do - begin - Inc(Result); - Inc(m); - end; -end; - -procedure _TIFFfree(p: Pointer); cdecl; -begin - FreeMem(p); -end; - -procedure _TIFFmemcpy(d: Pointer; s: Pointer; c: Longint); cdecl; -begin - CopyMemory(d,s,c); -end; - -function pow(x: Double; y: Double): Double; cdecl; -begin - Result:=Power(x,y); -end; - -function floor(x: Double): Double; cdecl; -begin - Result:=Trunc(x); -end; - -function _TIFFmalloc(s: Longint): Pointer; cdecl; -begin - Result:=AllocMem(s); -end; - -{LibTiffDelphi} - -function LibTiffDelphiVersion: AnsiString; -var - m: AnsiString; - na,nb: Integer; -begin - Result:=''; - m:=TIFFGetVersion; - na:=1; - while True do - begin - nb:=na; - while nb<=Length(m) do - begin - if m[nb]=#10 then break; - Inc(nb); - end; - Result:=Result+System.Copy(m,na,nb-na); - if nb>Length(m) then break; - Result:=Result+#13#10; - na:=nb+1; - end; - Result:=Result+#13#10+LibTiffDelphiVersionString; -end; - -procedure LibTiffDelphiWarningThrp(a: Pointer; b: Pointer; c: Pointer); cdecl; -var - m: Integer; - n: AnsiString; -begin - if @FLibTiffDelphiWarningHandler<>nil then - begin - m:=sprintfsec(nil,b,@c); - SetLength(n,m); - sprintfsec(Pointer(n),b,@c); - FLibTiffDelphiWarningHandler(PAnsiChar(a),n); - end; -end; - -procedure LibTiffDelphiErrorThrp(a: Pointer; b: Pointer; c: Pointer); cdecl; -var - m: Integer; - n: AnsiString; -begin - if @FLibTiffDelphiErrorHandler<>nil then - begin - m:=sprintfsec(nil,b,@c); - SetLength(n,m); - sprintfsec(Pointer(n),b,@c); - FLibTiffDelphiErrorHandler(PAnsiChar(a),n); - end; -end; - -function LibTiffDelphiGetWarningHandler: LibTiffDelphiErrorHandler; -begin - Result:=FLibTiffDelphiWarningHandler; -end; - -function LibTiffDelphiSetWarningHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler; -begin - Result:=FLibTiffDelphiWarningHandler; - FLibTiffDelphiWarningHandler:=Handler; -end; - -function LibTiffDelphiGetErrorHandler: LibTiffDelphiErrorHandler; -begin - Result:=FLibTiffDelphiErrorHandler; -end; - -function LibTiffDelphiSetErrorHandler(Handler: LibTiffDelphiErrorHandler): LibTiffDelphiErrorHandler; -begin - Result:=FLibTiffDelphiErrorHandler; - FLibTiffDelphiErrorHandler:=Handler; -end; - -{tif_read} - -procedure _TIFFSwab16BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFSwab24BitData(tif: pointer; buf: pointer; cc: integer); cdecl; external; //DW 3.8.2 -procedure _TIFFSwab32BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFSwab64BitData(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -procedure _TIFFNoPostDecode(tif: Pointer; buf: Pointer; cc: Integer); cdecl; external; -function TIFFReadTile(tif: Pointer; buf: Pointer; x: Cardinal; y: Cardinal; z: Cardinal; s: Word): Integer; cdecl; external; -function TIFFFillTile(tif: Pointer; tile: longword):integer; cdecl; external; //DW 3.8.2 - -{$L Compiled\tif_read.obj} - -{tif_dirinfo} - -function _TIFFSampleToTagType(tif: Pointer): Integer; cdecl; external; -procedure _TIFFSetupFieldInfo(tif: Pointer); cdecl; external; -function _TIFFCreateAnonFieldInfo(tif: Pointer; tag: Cardinal; field_type: Integer): Pointer; cdecl; external; -function _TIFFGetExifFieldInfo(size : plongint):pointer; cdecl; external; //DW 3.8.2 -function _TIFFDataSize(TIFFDataType : longint):longint; cdecl; external; //DW 3.8.2 -function _TIFFGetFieldInfo(size : plongint):pointer; cdecl; external; //DW 3.8.2 -function _TIFFMergeFieldInfo(tif: Pointer; fieldinfo : Pointer; n : Integer):Integer; cdecl; external; //DW 3.9.1 - -{$L Compiled\tif_dirinfo.obj} - -{tif_dirwrite} - -{$L Compiled\tif_dirwrite.obj} - -{tif_flush} - -{$L Compiled\tif_flush.obj} - -{tif_write} - -function TIFFFlushData1(tif: Pointer): Integer; cdecl; external; -function TIFFSetupStrips(tif: Pointer): Integer; cdecl; external; - -{$L Compiled\tif_write.obj} - -{tif_dumpmode} - -function TIFFInitDumpMode(tif: Pointer; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_dumpmode.obj} - -{tif_compress} - -function TIFFSetCompressionScheme(tif: Pointer; scheme: Integer): Integer; cdecl; external; -procedure _TIFFSetDefaultCompressionState(tif: Pointer); cdecl; external; - -{$L Compiled\tif_compress.obj} - -{tif_dirread} - -{$L Compiled\tif_dirread.obj} - -{tif_dir} - -procedure TIFFFreeDirectory(tif: Pointer); cdecl; external; -function TIFFDefaultDirectory(tif: Pointer): Integer; cdecl; external; -function TIFFReassignTagToIgnore(task: Integer; TIFFtagID: Integer): Integer; cdecl; external; -procedure _TIFFsetString(cpp: Pointer; cp: Pointer); cdecl; external; -procedure _TIFFsetByteArray(vpp: Pointer; vp: Pointer; n: Integer); cdecl; external; - -{$L Compiled\tif_dir.obj} - -{tif_aux} - -function TIFFVGetFieldDefaulted(tif: Pointer; tag: Cardinal; ap: Pointer): Integer; cdecl; external; - -{$L Compiled\tif_aux.obj} - -{tif_color} - -procedure TIFFCIELabToXYZ(cielab: Pointer; l: Cardinal; a: Integer; b: Integer; X: Pointer; Y: Pointer; Z: Pointer); cdecl; external; -procedure TIFFXYZToRGB(cielab: Pointer; X: Single; Y: Single; Z: Single; r: Pointer; g: Pointer; b: Pointer); cdecl; external; -procedure TIFFYCbCrtoRGB(ycbcr: Pointer; Y: Cardinal; Cb: Integer; Cr: Integer; r: Pointer; g: Pointer; b: Pointer); cdecl; external; -function TIFFYCbCrToRGBInit(ycbcr: Pointer; luma: Pointer; refBlackWhite: Pointer): Integer; cdecl; external; -function TIFFCIELabToRGBInit(cielab: Pointer; display: Pointer; refWhite: Pointer): Integer; cdecl; external; - -{$L Compiled\tif_color.obj} - -{tif_close} - -{$L Compiled\tif_close.obj} - -{tif_extension} - -{$L Compiled\tif_extension.obj} - -{tif_open} - -function _TIFFgetMode(mode: PAnsiChar; module: PAnsiChar): Integer; cdecl; external; - -{$L Compiled\tif_open.obj} - -{tif_getimage} - -{$L Compiled\tif_getimage.obj} - -{tif_predict} - -function TIFFPredictorInit(tif: PTIFF): Integer; cdecl; external; -function TIFFPredictorCleanup(tif: PTIFF):integer; cdecl; external; //DW 3.8.2 - -{$L Compiled\tif_predict.obj} - -{tif_print} - -{$L Compiled\tif_print.obj} - -{tif_error} - -{$L Compiled\tif_error.obj} - -{tif_strip} - -function _TIFFDefaultStripSize(tif: Pointer; s: Cardinal): Cardinal; cdecl; external; -function TIFFOldScanlineSize(tif: Pointer):Cardinal; cdecl; external; //DW 3.9.1 - -{$L Compiled\tif_strip.obj} - -{tif_swab} - -{$L Compiled\tif_swab.obj} - -{tif_tile} - -function TIFFCheckTile(tif: Pointer; x: Cardinal; y: Cardinal; z: Cardinal; s: Word): Integer; cdecl; external; -procedure _TIFFDefaultTileSize(tif: Pointer; tw: Pointer; th: Pointer); cdecl; external; - -{$L Compiled\tif_tile.obj} - -{tif_warning} - -{$L Compiled\tif_warning.obj} - -{tif_fax3} - -function TIFFInitCCITTRLE(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTRLEW(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTFax3(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFInitCCITTFax4(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_fax3.obj} - -{tif_fax3sm} - -{$L Compiled\tif_fax3sm.obj} - -{tif_jpeg} - -procedure TIFFjpeg_error_exit_raise; cdecl; -begin - raise Exception.Create('TIFFjpeg_error_exit'); -end; - -function TIFFcallvjpeg_jpeg_CreateCompress(cinfo: Pointer; version: Integer; structsize: Cardinal): Integer; cdecl; -begin - try - jpeg_CreateCompress(cinfo,version,structsize); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_CreateDecompress(cinfo: Pointer; version: Integer; structsize: Cardinal): Integer; cdecl; -begin - try - jpeg_CreateDecompress(cinfo,version,structsize); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_defaults(cinfo: Pointer): Integer; cdecl; -begin - try - jpeg_set_defaults(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_colorspace(cinfo: Pointer; colorspace: Integer): Integer; cdecl; -begin - try - jpeg_set_colorspace(cinfo, colorspace); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_set_quality(cinfo: Pointer; quality: Integer; force_baseline: Byte): Integer; cdecl; -begin - try - jpeg_set_quality(cinfo,quality,force_baseline); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_suppress_tables(cinfo: PRJpegCompressStruct; suppress: Byte): Integer; cdecl; -begin - try - jpeg_suppress_tables(cinfo,suppress); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_start_compress(cinfo: PRJpegCompressStruct; write_all_tables: Byte): Integer; cdecl; -begin - try - jpeg_start_compress(cinfo,write_all_tables); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_write_scanlines(errreturn: Integer; cinfo: PRJpegCompressStruct; scanlines: Pointer; num_lines: Cardinal): Integer; cdecl; -begin - try - Result:=jpeg_write_scanlines(cinfo,scanlines,num_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_write_raw_data(errreturn: Integer; cinfo: PRJpegCompressStruct; data: Pointer; num_lines: Cardinal): Integer; cdecl; -begin - try - Result:=jpeg_write_raw_data(cinfo,data,num_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_finish_compress(cinfo: PRJpegCompressStruct): Integer; cdecl; -begin - try - jpeg_finish_compress(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_write_tables(cinfo: PRJpegCompressStruct): Integer; cdecl; -begin - try - jpeg_write_tables(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_read_header(errreturn: Integer; cinfo: PRJpegDecompressStruct; require_image: Byte): Integer; cdecl; -begin - try - Result:=jpeg_read_header(cinfo,Boolean(require_image)); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_start_decompress(cinfo: PRJpegDecompressStruct): Integer; cdecl; -begin - try - jpeg_start_decompress(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcalljpeg_jpeg_read_scanlines(errreturn: Integer; cinfo: PRJpegDecompressStruct; scanlines: Pointer; max_lines: Cardinal): Integer; cdecl; -begin - try - Result:=jpeg_read_scanlines(cinfo,scanlines,max_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_read_raw_data(errreturn: Integer; cinfo: PRJpegDecompressStruct; data: Pointer; max_lines: Cardinal): Integer; cdecl; -begin - try - Result:=jpeg_read_raw_data(cinfo,data,max_lines); - except - Result:=errreturn; - end; -end; - -function TIFFcalljpeg_jpeg_finish_decompress(errreturn: Integer; cinfo: PRJpegDecompressStruct): Integer; cdecl; -begin - try - Result:=jpeg_finish_decompress(cinfo); - except - Result:=errreturn; - end; -end; - -function TIFFcallvjpeg_jpeg_abort(cinfo: PRJpegCommonStruct): Integer; cdecl; -begin - try - jpeg_abort(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -function TIFFcallvjpeg_jpeg_destroy(cinfo: PRJpegCommonStruct): Integer; cdecl; -begin - try - jpeg_destroy(cinfo); - Result:=1; - except - Result:=0; - end; -end; - -type - jpeg_alloc_sarray = function(cinfo: PRJpegCommonStruct; pool_id: Integer; samplesperrow: Cardinal; numrows: Cardinal): Pointer; cdecl; - -function TIFFcalljpeg_alloc_sarray(alloc_sarray: jpeg_alloc_sarray; cinfo: PRJpegCommonStruct; pool_id: Integer; samplesperrow: Cardinal; - numrows: Cardinal): Pointer; cdecl; -begin - try - Result:=alloc_sarray(cinfo,pool_id,samplesperrow,numrows); - except - Result:=nil; - end; -end; - -function TIFFInitJPEG(tif: PTIFF; scheme: Integer): Integer; cdecl; external; -function TIFFFillStrip(tif : PTIFF; Len : longword): integer; cdecl; external; //DW 3.8.2 - -{$L Compiled\tif_jpeg.obj} - -{tif_luv} - -function TIFFInitSGILog(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_luv.obj} - -{tif_lzw} - -function TIFFInitLZW(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_lzw.obj} - -{tif_next} - -function TIFFInitNeXT(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_next.obj} - -{tif_packbits} - -function TIFFInitPackBits(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_packbits.obj} - -{tif_pixarlog} - -function TIFFInitPixarLog(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_pixarlog.obj} - -{tif_thunder} - -function TIFFInitThunderScan(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_thunder.obj} - -{tif_version} - -{$L Compiled\tif_version.obj} - -{tif_zip} - -function TIFFInitZIP(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{$L Compiled\tif_zip.obj} - -{tif_codec} - -function NotConfigured(tif: PTIFF; scheme: Integer): Integer; cdecl; external; - -{DW -const - - _TIFFBuiltinCODECS: array[0..17] of TIFFCodec = ( - (name:'None'; scheme: COMPRESSION_NONE; init: TIFFInitDumpMode), - (name:'LZW'; scheme: COMPRESSION_LZW; init: TIFFInitLZW), - (name:'PackBits'; scheme: COMPRESSION_PACKBITS; init: TIFFInitPackBits), - (name:'ThunderScan'; scheme: COMPRESSION_THUNDERSCAN; init: TIFFInitThunderScan), - (name:'NeXT'; scheme: COMPRESSION_NEXT; init: TIFFInitNeXT), - (name:'JPEG'; scheme: COMPRESSION_JPEG; init: TIFFInitJPEG), - (name:'Old-style JPEG'; scheme: COMPRESSION_OJPEG; init: NotConfigured), - (name:'CCITT RLE'; scheme: COMPRESSION_CCITTRLE; init: TIFFInitCCITTRLE), - (name:'CCITT RLE/W'; scheme: COMPRESSION_CCITTRLEW; init: TIFFInitCCITTRLEW), - (name:'CCITT Group 3'; scheme: COMPRESSION_CCITTFAX3; init: TIFFInitCCITTFax3), - (name:'CCITT Group 4'; scheme: COMPRESSION_CCITTFAX4; init: TIFFInitCCITTFax4), - (name:'ISO JBIG'; scheme: COMPRESSION_JBIG; init: NotConfigured), - (name:'Deflate'; scheme: COMPRESSION_DEFLATE; init: TIFFInitZIP), - (name:'AdobeDeflate'; scheme: COMPRESSION_ADOBE_DEFLATE; init: TIFFInitZIP), - (name:'PixarLog'; scheme: COMPRESSION_PIXARLOG; init: TIFFInitPixarLog), - (name:'SGILog'; scheme: COMPRESSION_SGILOG; init: TIFFInitSGILog), - (name:'SGILog24'; scheme: COMPRESSION_SGILOG24; init: TIFFInitSGILog), - (name:nil; scheme:0; init:nil)); -} - -{$L Compiled\tif_codec.obj} - -{LibTiffDelphi} - -function TIFFFileReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFFileWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFFileSizeProc(Fd: Cardinal): Cardinal; cdecl; forward; -function TIFFFileSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; forward; -function TIFFFileCloseProc(Fd: Cardinal): Integer; cdecl; forward; - -function TIFFStreamReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFStreamWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; forward; -function TIFFStreamSizeProc(Fd: Cardinal): Cardinal; cdecl; forward; -function TIFFStreamSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; forward; -function TIFFStreamCloseProc(Fd: Cardinal): Integer; cdecl; forward; - -function TIFFNoMapProc(Fd: Cardinal; PBase: PPointer; PSize: PCardinal): Integer; cdecl; forward; -procedure TIFFNoUnmapProc(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl; forward; - -function TIFFFileCloseProc(Fd: Cardinal): Integer; cdecl; -begin - if CloseHandle(Fd)=True then - Result:=0 - else - Result:=-1; -end; - -function TIFFFileSizeProc(Fd: Cardinal): Cardinal; cdecl; -begin - Result:=GetFileSize(Fd,nil); -end; - -function TIFFFileSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; -const - SEEK_SET = 0; - SEEK_CUR = 1; - SEEK_END = 2; -var - MoveMethod: Cardinal; -begin - if Off=$ffffffff then - begin - Result:=$ffffffff; - exit; - end; - case Whence of - SEEK_SET: MoveMethod:=FILE_BEGIN; - SEEK_CUR: MoveMethod:=FILE_CURRENT; - SEEK_END: MoveMethod:=FILE_END; - else - MoveMethod:=FILE_BEGIN; - end; - Result:=SetFilePointer(Fd,Off,nil,MoveMethod); -end; - -function TIFFFileReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -var - m: Cardinal; -begin - if ReadFile(Fd,Buffer^,Cardinal(Size),m,nil)=False then - Result:=0 - else - Result:=m; -end; - -function TIFFFileWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -var - m: Cardinal; -begin - if WriteFile(Fd,Buffer^,Cardinal(Size),m,nil)=False then - Result:=0 - else - Result:=m; -end; - -function TIFFStreamCloseProc(Fd: Cardinal): Integer; cdecl; -begin - Result:=0; -end; - -function TIFFStreamSizeProc(Fd: Cardinal): Cardinal; cdecl; -begin - try - Result:=TStream(Fd).Size; - except - Result:=0; - end; -end; - -function TIFFStreamSeekProc(Fd: Cardinal; Off: Cardinal; Whence: Integer): Cardinal; cdecl; -const - SEEK_SET = 0; - SEEK_CUR = 1; - SEEK_END = 2; -var - MoveMethod: Word; -begin - if Off=$ffffffff then - begin - Result:=$ffffffff; - exit; - end; - case Whence of - SEEK_SET: MoveMethod:=soFromBeginning; - SEEK_CUR: MoveMethod:=soFromCurrent; - SEEK_END: MoveMethod:=soFromEnd; - else - MoveMethod:=soFromBeginning; - end; - try - Result:=TStream(Fd).Seek(Off,MoveMethod); - except - Result:=0; - end; -end; - -function TIFFStreamReadProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - try - Result:=TStream(Fd).Read(Buffer^,Size); - except - Result:=0; - end; -end; - -function TIFFStreamWriteProc(Fd: Cardinal; Buffer: Pointer; Size: Integer): Integer; cdecl; -begin - try - Result:=TStream(Fd).Write(Buffer^,Size); - except - Result:=0; - end; -end; - -function TIFFNoMapProc(Fd: Cardinal; PBase: PPointer; PSize: PCardinal): Integer; cdecl; -begin - Result:=0; -end; - -procedure TIFFNoUnmapProc(Fd: Cardinal; Base: Pointer; Size: Cardinal); cdecl; -begin -end; - -function TIFFOpen(const Name: AnsiString; const Mode: AnsiString): PTIFF; -const - Module: AnsiString = 'TIFFOpen'; - O_RDONLY = 0; - O_WRONLY = 1; - O_RDWR = 2; - O_CREAT = $0100; - O_TRUNC = $0200; -var - m: Integer; - DesiredAccess: Cardinal; - CreateDisposition: Cardinal; - FlagsAndAttributes: Cardinal; - fd: THandle; -begin - m:=_TIFFgetMode(PAnsiChar(Mode),PAnsiChar(Module)); - if m=o_RDONLY then - DesiredAccess:=GENERIC_READ - else - DesiredAccess:=(GENERIC_READ or GENERIC_WRITE); - case m of - O_RDONLY: CreateDisposition:=OPEN_EXISTING; - O_RDWR: CreateDisposition:=OPEN_ALWAYS; - (O_RDWR or O_CREAT): CreateDisposition:=OPEN_ALWAYS; - (O_RDWR or O_TRUNC): CreateDisposition:=CREATE_ALWAYS; - (O_RDWR or O_CREAT or O_TRUNC): CreateDisposition:=CREATE_ALWAYS; - else - Result:=nil; - exit; - end; - if m=O_RDONLY then - FlagsAndAttributes:=FILE_ATTRIBUTE_READONLY - else - FlagsAndAttributes:=FILE_ATTRIBUTE_NORMAL; - fd:=CreateFileA(PAnsiChar(Name),DesiredAccess,FILE_SHARE_READ,nil,CreateDisposition,FlagsAndAttributes,0); - if fd=INVALID_HANDLE_VALUE then - begin - TiffError(PAnsiChar(Module),PAnsiChar('%s: Cannot open'),PAnsiChar(Name)); - Result:=nil; - exit; - end; - Result:=TIFFClientOpen(PAnsiChar(Name),PAnsiChar(Mode),fd,@TIFFFileReadProc,@TIFFFileWriteProc,@TIFFFileSeekProc,@TIFFFileCloseProc, - @TIFFFileSizeProc,@TIFFNoMapProc,@TIFFNoUnmapProc); - if Result<>nil then - TIFFSetFileno(Result,fd) - else - CloseHandle(fd); -end; - -function TIFFOpenStream(const Stream: TStream; const Mode: AnsiString): PTIFF; -var - m: AnsiString; -begin - m:='Stream'; - Result:=TIFFClientOpen(PAnsiChar(m),PAnsiChar(Mode),Cardinal(Stream),@TIFFStreamReadProc,@TIFFStreamWriteProc,@TIFFStreamSeekProc,@TIFFStreamCloseProc, - @TIFFStreamSizeProc,@TIFFNoMapProc,@TIFFNoUnmapProc); - if Result<>nil then TIFFSetFileno(Result,Cardinal(Stream)); -end; - - -initialization - - _TIFFwarningHandler:=LibTiffDelphiWarningThrp; - _TIFFerrorHandler:=LibTiffDelphiErrorThrp; - -end. - diff --git a/3rd/Imaging/Extras/Extensions/LibTiff/ZLibDelphi.pas b/3rd/Imaging/Extras/Extensions/LibTiff/ZLibDelphi.pas deleted file mode 100644 index e96491c78..000000000 --- a/3rd/Imaging/Extras/Extensions/LibTiff/ZLibDelphi.pas +++ /dev/null @@ -1,80 +0,0 @@ -unit ZLibDelphi; - -interface - -uses - Windows, SysUtils; - -const - - ZLIB_VERSION = '1.2.1'; - - Z_NO_FLUSH = 0; - Z_FINISH = 4; - - Z_OK = 0; - Z_STREAM_END = 1; - -type - - PRZStream = ^RZStream; - - RZStream = record - NextIn: PByte; - AvailIn: Cardinal; - TotalIn: Cardinal; - NextOut: PByte; - AvailOut: Cardinal; - TotalOut: Cardinal; - Msg: PAnsiChar; - State: Pointer; - AllocFunc: Pointer; - FreeFunc: Pointer; - Opaque: Cardinal; - DataType: Integer; - Adler: Cardinal; - Reserved: Cardinal; - end; - -function inflateInit_(strm: Pointer; version: Pointer; stream_size: Integer): Integer; cdecl; external; -function inflateReset(strm: Pointer): Integer; cdecl; external; -function inflate(strm: Pointer; flush: Integer): Integer; cdecl; external; -function inflateSync(strm: Pointer): Integer; cdecl; external; -function deflateInit(strm: Pointer; level: Integer): Integer; -function deflateInit_(strm: Pointer; level: Integer; version: Pointer; stream_size: Integer): Integer; cdecl; external; -function deflateReset(strm: Pointer): Integer; cdecl; external; -function deflate(strm: Pointer; flush: Integer): Integer; cdecl; external; -function deflateEnd(strm: Pointer): Integer; cdecl; external; -function inflateEnd(strm: Pointer): Integer; cdecl; external; -function deflateParams(strm: Pointer; level: Integer; strategy: Integer): Integer; cdecl; external; - -implementation - -uses - LibDelphi; - -function deflateInit(strm: Pointer; level: Integer): Integer; -begin - Result:=deflateInit_(strm,level,PAnsiChar(ZLIB_VERSION),SizeOf(RZStream)); -end; - -{$L Compiled\inflate.obj} -{$L Compiled\crc32.obj} -{$L Compiled\adler32.obj} -{$L Compiled\inftrees.obj} -{$L Compiled\inffast.obj} -{$L Compiled\deflate.obj} -{$L Compiled\zutil.obj} -{$L Compiled\trees.obj} -{$L Compiled\compress.obj} -{$L Compiled\uncompr.obj} - -end. - - - - - - - - diff --git a/3rd/Imaging/Extras/Extensions/OpenJpeg.pas b/3rd/Imaging/Extras/Extensions/OpenJpeg.pas deleted file mode 100644 index b42225399..000000000 --- a/3rd/Imaging/Extras/Extensions/OpenJpeg.pas +++ /dev/null @@ -1,740 +0,0 @@ -(* - * Copyright (c) 2002-2007, Communications and Remote Sensing Laboratory, Universite catholique de Louvain (UCL), Belgium - * Copyright (c) 2002-2007, Professor Benoit Macq - * Copyright (c) 2001-2003, David Janssens - * Copyright (c) 2002-2003, Yannick Verschueren - * Copyright (c) 2003-2007, Francois-Olivier Devaux and Antonin Descampe - * Copyright (c) 2005, Herve Drolon, FreeImage Team - * Copyright (c) 2006-2007, Parvatha Elangovan - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions - * are met: - * 1. Redistributions of source code must retain the above copyright - * notice, this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, this list of conditions and the following disclaimer in the - * documentation and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS `AS IS' - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE - * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR - * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF - * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS - * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN - * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) - * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE - * POSSIBILITY OF SUCH DAMAGE. - *) - -{ - PasOpenJpeg - Free JPEG 2000 library for Delphi and Free Pascal - - Headers translated to Object Pascal and C code precompliled - by Marek Mauder (http://galfar.vevb.net) - for Vampyre Imaging Library (http://imaginglib.sourceforge.net). - - Supported compilers: Delphi, Free Pascal - Supported platforms (tested): Windows 32bit, Linux 32/64bit - - OpenJpeg Homepage: http://www.openjpeg.org - PasOpenJpeg Homepage: http://galfar.vevb.net/openjpeg - - Current Version: 1.05 (OpenJpeg 1.3 SVN revision 611 with CDEF/PCLR patch) - - History: - v1.05 (2010-08-12): - - added palette support - - added CMYK support - v1.04 (2010-06-08): - - added few Pascal-looking type aliases - v1.03 (2009-06-04): - - added Mac OSX x86 support - v1.02 (2009-01-30): - - removed linking to stdc++ lib in LINUX/UNIX - v1.01 (2008-12-27): - - Delphi 2009 compatibility checks - v1.00 (2008-03-01): - - CDEF patch for OpenJpeg, added component types -} - -unit OpenJpeg; - -{$IFDEF FPC} - { Free Pascal settings } - {$PACKRECORDS 8} - {$PACKENUM 4} -{$ELSE} - { Delphi settings } - {$DEFINE DCC} - {$ALIGN 8} - {$MINENUMSIZE 4} -{$ENDIF} - -interface - -const - OPENJPEG_VERSION = '1.3.0'; - -type - Bool = ByteBool; - Char = AnsiChar; - -{ Constant Definitions } - -const - { Maximum allowed size for filenames } - OPJ_PATH_LEN = 4096; - - { Number of maximum resolution level authorized } - J2K_MAXRLVLS = 33; - { Number of maximum sub-band linked to number of resolution level } - J2K_MAXBANDS = 3 * J2K_MAXRLVLS - 2; - - JPWL_MAX_NO_TILESPECS = 16; - JPWL_MAX_NO_PACKSPECS = 16; - JPWL_MAX_NO_MARKERS = 512; - JPWL_PRIVATEINDEX_NAME = 'jpwl_index_privatefilename'; - JPWL_EXPECTED_COMPONENTS = 3; - JPWL_MAXIMUM_TILES = 8192; - JPWL_MAXIMUM_HAMMING = 2; - JPWL_MAXIMUM_EPB_ROOM = 65450; - -{ Enum Definitions } - -type - { Rsiz capabilities } - OPJ_RSIZ_CAPABILITIES = ( - STD_RSIZ = 0, { Standard JPEG2000 profile } - CINEMA2K = 3, { Profile name for a 2K image } - CINEMA4K = 4 { Profile name for a 4K image } - ); - - { Digital cinema operation mode } - OPJ_CINEMA_MODE = ( - OFF = 0, { Not Digital Cinema } - CINEMA2K_24 = 1, { 2K Digital Cinema at 24 fps } - CINEMA2K_48 = 2, { 2K Digital Cinema at 48 fps } - CINEMA4K_24 = 3 { 4K Digital Cinema at 24 fps } - ); - - { Progression order } - OPJ_PROG_ORDER = ( - PROG_UNKNOWN = -1, { place-holder } - LRCP = 0, { layer-resolution-component-precinct order } - RLCP = 1, { resolution-layer-component-precinct order } - RPCL = 2, { resolution-precinct-component-layer order } - PCRL = 3, { precinct-component-resolution-layer order } - CPRL = 4 { component-precinct-resolution-layer order } - ); - - { Supported image color spaces } - OPJ_COLOR_SPACE = ( - CLRSPC_UNKNOWN = -1, { place-holder } - CLRSPC_SRGB = 1, { sRGB } - CLRSPC_GRAY = 2, { grayscale } - CLRSPC_SYCC = 3, { YUV } - CLRSPC_CMYK = 4 { CMYK } - ); - TOpjColorSpace = OPJ_COLOR_SPACE; - - { Supported image component types - added by patch } - OPJ_COMPONENT_TYPE = ( - COMPTYPE_UNKNOWN = 0, { unknown component type, cdef box not present } - COMPTYPE_R = 1, { red component of sRGB image } - COMPTYPE_G = 2, { green component of sRGB image } - COMPTYPE_B = 3, { blue component of sRGB image } - COMPTYPE_L = 4, { luminance component of YUV and grayscale images } - COMPTYPE_CB = 5, { Cb component of YUV image } - COMPTYPE_CR = 6, { Cr component of YUV image } - COMPTYPE_OPACITY = 7, { opacity/alpha channel } - COMPTYPE_C = 8, { C component of CMYK image } - COMPTYPE_M = 9, { M component of CMYK image } - COMPTYPE_Y = 10, { Y component of CMYK image } - COMPTYPE_K = 11 { K component of CMYK image } - ); - TOpjComponentType = OPJ_COMPONENT_TYPE; - - { Supported codec } - OPJ_CODEC_FORMAT = ( - CODEC_UNKNOWN = -1, { place-holder } - CODEC_J2K = 0, { JPEG-2000 codestream : read/write } - CODEC_JPT = 1, { JPT-stream (JPEG 2000, JPIP) : read only } - CODEC_JP2 = 2 { JPEG-2000 file format : read/write } - ); - - { Limit decoding to certain portions of the codestream. } - OPJ_LIMIT_DECODING = ( - NO_LIMITATION = 0, { No limitation for the decoding. The entire codestream will de decoded } - LIMIT_TO_MAIN_HEADER = 1, { The decoding is limited to the Main Header } - DECODE_ALL_BUT_PACKETS = 2 { Decode everything except the JPEG 2000 packets } - ); - -{ Event Manager Type Definitions } - - { Callback function prototype for events } - opj_msg_callback = procedure(msg: PAnsiChar; client_data: Pointer); cdecl; - { Message handler object } - opj_event_mgr = record - error_handler: opj_msg_callback; { Error message callback if available, NULL otherwise } - warning_handler: opj_msg_callback; { Warning message callback if available, NULL otherwise } - info_handler: opj_msg_callback; { Debug message callback if available, NULL otherwise } - end; - opj_event_mgr_t = opj_event_mgr; - popj_event_mgr_t = ^opj_event_mgr_t; - - -{ Codec Type Definitions } - - { Progression order changes } - opj_poc = record - resno0, compno0: Integer; - layno1, resno1, compno1: Integer; - layno0, precno0, precno1: Integer; - prg1, prg: OPJ_PROG_ORDER; - progorder: array[0..4] of Char; - tile: Integer; - tx0, tx1, ty0, ty1: Integer; - layS, resS, compS, prcS: Integer; - layE, resE, compE, prcE: Integer; - txS, txE, tyS, tyE, dx, dy: Integer; - lay_t, res_t, comp_t, prc_t, tx0_t, ty0_t: Integer; - end; - opj_poc_t = opj_poc; - - { Compression parameters } - opj_cparameters = record - tile_size_on: Bool; - cp_tx0: Integer; - cp_ty0: Integer; - cp_tdx: Integer; - cp_tdy: Integer; - cp_disto_alloc: Integer; - cp_fixed_alloc: Integer; - cp_fixed_quality: Integer; - cp_matrice: PInteger; - cp_comment: PAnsiChar; - csty: Integer; - prog_order: OPJ_PROG_ORDER; - POC: array[0..31] of opj_poc_t; - numpocs: Integer; - tcp_numlayers: Integer; - tcp_rates: array[0..99] of Single; - tcp_distoratio: array[0..99] of Single; - numresolution: Integer; - cblockw_init: Integer; - cblockh_init: Integer; - mode: Integer; - irreversible: Integer; - roi_compno: Integer; - roi_shift: Integer; - res_spec: Integer; - prcw_init: array[0..J2K_MAXRLVLS - 1] of Integer; - prch_init: array[0..J2K_MAXRLVLS - 1] of Integer; - infile: array[0..OPJ_PATH_LEN - 1] of Char; - outfile: array[0..OPJ_PATH_LEN - 1] of Char; - index_on: Integer; - index: array[0..OPJ_PATH_LEN - 1] of Char; - image_offset_x0: Integer; - image_offset_y0: Integer; - subsampling_dx: Integer; - subsampling_dy: Integer; - decod_format: Integer; - cod_format: Integer; - jpwl_epc_on: Bool; - jpwl_hprot_MH: Integer; - jpwl_hprot_TPH_tileno: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_hprot_TPH: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_pprot_tileno: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_pprot_packno: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_pprot: array[0..JPWL_MAX_NO_PACKSPECS - 1] of Integer; - jpwl_sens_size: Integer; - jpwl_sens_addr: Integer; - jpwl_sens_range: Integer; - jpwl_sens_MH: Integer; - jpwl_sens_TPH_tileno: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - jpwl_sens_TPH: array[0..JPWL_MAX_NO_TILESPECS - 1] of Integer; - cp_cinema: OPJ_CINEMA_MODE; - max_comp_size: Integer; - cp_rsiz: OPJ_RSIZ_CAPABILITIES; - tp_on: Byte; - tp_flag: Byte; - tcp_mct: Byte; - end; - opj_cparameters_t = opj_cparameters; - popj_cparameters_t = ^opj_cparameters_t; - TOpjCParameters = opj_cparameters_t; - - { Decompression parameters } - opj_dparameters = record - cp_reduce: Integer; - cp_layer: Integer; - infile: array[0..OPJ_PATH_LEN - 1] of Char; - outfile: array[0..OPJ_PATH_LEN - 1] of Char; - decod_format: Integer; - cod_format: Integer; - jpwl_correct: Bool; - jpwl_exp_comps: Integer; - jpwl_max_tiles: Integer; - cp_limit_decoding: OPJ_LIMIT_DECODING; - end; - opj_dparameters_t = opj_dparameters; - popj_dparameters_t = ^opj_dparameters_t; - TOpjDParameters = opj_dparameters_t; - - { Routines that are to be used by both halves of the library are declared - to receive a Pointer to this structure. There are no actual instances of - opj_common_struct_t, only of opj_cinfo_t and opj_dinfo_t. } - opj_common_struct = record - event_mgr: popj_event_mgr_t; { Pointer to the event manager } - client_data: Pointer; { Available for use by application } - is_decompressor: Bool; { So common code can tell which is which } - codec_format: OPJ_CODEC_FORMAT; { selected codec } - j2k_handle: Pointer; { Pointer to the J2K codec } - jp2_handle: Pointer; { Pointer to the JP2 codec } - mj2_handle: Pointer; - end; - opj_common_struct_t = opj_common_struct; - opj_common_ptr = ^opj_common_struct_t; - - { Compression context info } - opj_cinfo = record - event_mgr: popj_event_mgr_t; - client_data: Pointer; - is_decompressor: Bool; - codec_format: OPJ_CODEC_FORMAT; - j2k_handle: Pointer; - jp2_handle: Pointer; - mj2_handle: Pointer; - end; - opj_cinfo_t = opj_cinfo; - popj_cinfo_t = ^opj_cinfo_t; - TOpjCInfo = opj_cinfo_t; - POpjCInfo = popj_cinfo_t; - - { Decompression context info } - opj_dinfo = record - event_mgr: popj_event_mgr_t; - client_data: Pointer; - is_decompressor: Bool; - codec_format: OPJ_CODEC_FORMAT; - j2k_handle: Pointer; - jp2_handle: Pointer; - mj2_handle: Pointer; - end; - opj_dinfo_t = opj_dinfo; - popj_dinfo_t = ^opj_dinfo_t; - TOpjDInfo = opj_dinfo_t; - POpjDInfo = popj_dinfo_t; - -{ I/O Stream Types Definitions } - -const - { Stream open flags } - { The stream was opened for reading } - OPJ_STREAM_READ = $0001; - { The stream was opened for writing } - OPJ_STREAM_WRITE = $0002; - -type - { Byte input-output stream (CIO) } - opj_cio = record - cinfo: opj_common_ptr; { codec context } - openmode: Integer; { open mode (read/write) either OPJ_STREAM_READ or OPJ_STREAM_WRITE } - buffer: PAnsiChar; { Pointer to the start of the buffer } - length: Integer; { buffer size in bytes } - start: PAnsiChar; { Pointer to the start of the stream } - end_: PAnsiChar; { Pointer to the end of the stream } - bp: PAnsiChar; { Pointer to the current position } - end; - opj_cio_t = opj_cio; - popj_cio_t = ^opj_cio_t; - TOpjCio = opj_cio_t; - POpjCio = popj_cio_t; - -{ Image Type Definitions } - - { Defines a single image component } - opj_image_comp = record - dx: Integer; { XRsiz: horizontal separation of a sample of ith component with respect to the reference grid } - dy: Integer; { YRsiz: vertical separation of a sample of ith component with respect to the reference grid } - w: Integer; { data width } - h: Integer; { data height } - x0: Integer; { x component offset compared to the whole image } - y0: Integer; { y component offset compared to the whole image } - prec: Integer; { precision } - bpp: Integer; { image depth in bits } - sgnd: Integer; { signed (1) / unsigned (0) } - resno_decoded: Integer; { number of decoded resolution } - factor: Integer; { number of division by 2 of the out image compared to the original size of image } - comp_type: OPJ_COMPONENT_TYPE; { type of this component: color channel, opacity, ... } - data: PIntegerArray; { image component data } - end; - opj_image_comp_t = opj_image_comp; - popj_image_comp_t = ^opj_image_comp_t; - opj_image_comp_array = array[0..255] of opj_image_comp_t; - popj_image_comp_array = ^opj_image_comp_array; - TOpjImageComp = opj_image_comp_t; - POpjImageComp = popj_image_comp_t; - - { Defines image palette - added by patch } - opj_image_palette = record - hascmap: Integer; { set to one if the original image had a component mapping box } - haspalette: Integer; { set to one if the original image had a palette color box } - numchans: Integer; { number of channels the palette has } - numentrs: Integer; { number of entries the palette has } - sizentr: Integer; { size of one entry for one channel (in bytes) } - paldata: PByte; { byte pointer to the palette data } - end; - opj_image_palette_t = opj_image_palette; - popj_image_palette_t = ^opj_image_palette_t; - - { Defines image data and characteristics } - opj_image = record - x0: Integer; { XOsiz: horizontal offset from the origin of the reference grid to the left side of the image area } - y0: Integer; { YOsiz: vertical offset from the origin of the reference grid to the top side of the image area } - x1: Integer; { Xsiz: width of the reference grid } - y1: Integer; { Ysiz: height of the reference grid } - numcomps: Integer; { number of components in the image } - color_space: OPJ_COLOR_SPACE; { color space: sRGB, Greyscale or YUV } - comps: popj_image_comp_array; { image components } - palette: popj_image_palette_t; { palette structure } - end; - opj_image_t = opj_image; - popj_image_t = ^opj_image_t; - TOpjImage = opj_image_t; - POpjImage = popj_image_t; - - { Component parameters structure used by the opj_image_create function } - opj_image_comptparm = record - dx: Integer; { XRsiz: horizontal separation of a sample of ith component with respect to the reference grid } - dy: Integer; { YRsiz: vertical separation of a sample of ith component with respect to the reference grid } - w: Integer; { data width } - h: Integer; { data height } - x0: Integer; { x component offset compared to the whole image } - y0: Integer; { y component offset compared to the whole image } - prec: Integer; { precision } - bpp: Integer; { image depth in bits } - sgnd: Integer; { signed (1) / unsigned (0) } - comp_type: OPJ_COMPONENT_TYPE; { type of this component: color channel, opacity, ... } - end; - opj_image_cmptparm_t = opj_image_comptparm; - popj_image_cmptparm_t = ^opj_image_cmptparm_t; - opj_image_cmptparm_array = array[0..255] of opj_image_cmptparm_t; - popj_image_cmptparm_array = ^opj_image_cmptparm_array; - TOpjImageCompParam = opj_image_cmptparm_t; - -{ OpenJpeg Version Functions Definitions } - -function opj_version: PAnsiChar; cdecl; external; - -{ Image Functions Definitions } - -{ Create an image - @param numcmpts number of components - @param cmptparms components parameters - @param clrspc image color space - @return returns a new image structure if successful, returns NULL otherwise } -function opj_image_create(numcmpts: Integer; cmptparms: popj_image_cmptparm_t; - clrspc: OPJ_COLOR_SPACE): popj_image_t; cdecl; external; - -{ Deallocate any resources associated with an image - @param image image to be destroyed } -procedure opj_image_destroy(image: popj_image_t); cdecl; external; - -{ Stream Functions Definitions } - -{ Open and allocate a memory stream for read / write. - On reading, the user must provide a buffer containing encoded data. The buffer - will be wrapped by the returned CIO handle. - On writing, buffer parameters must be set to 0: a buffer will be allocated - by the library to contain encoded data. - @param cinfo Codec context info - @param buffer Reading: buffer address. Writing: NULL - @param length Reading: buffer length. Writing: 0 - @return Returns a CIO handle if successful, returns NULL otherwise } -function opj_cio_open(cinfo: opj_common_ptr; buffer: PByte; - length: Integer): popj_cio_t; cdecl; external; - -{ Close and free a CIO handle - @param cio CIO handle to free } -procedure opj_cio_close(cio: popj_cio_t); cdecl; external; - -{ Get position in byte stream - @param cio CIO handle - @return Returns the position in bytes } -function cio_tell(cio: popj_cio_t): Integer; cdecl; external; - -{ Set position in byte stream - @param cio CIO handle - @param pos Position, in number of bytes, from the beginning of the stream } -procedure cio_seek(cio: popj_cio_t; pos: Integer); cdecl; external; - -{ Event Manager Functions Definitions } - -function opj_set_event_mgr(cinfo: opj_common_ptr; event_mgr: popj_event_mgr_t; - context: Pointer): popj_event_mgr_t; cdecl; external; - -{ Codec Functions Definitions } - -{ Creates a J2K/JPT/JP2 decompression structure - @param format Decoder to select - @return Returns a handle to a decompressor if successful, returns NULL otherwise } -function opj_create_decompress(format: OPJ_CODEC_FORMAT): popj_dinfo_t; cdecl; external; - -{ Destroy a decompressor handle - @param dinfo decompressor handle to destroy } -procedure opj_destroy_decompress(dinfo: popj_dinfo_t); cdecl; external; - -{ Set decoding parameters to default values - @param parameters Decompression parameters } -procedure opj_set_default_decoder_parameters(parameters: popj_dparameters_t); cdecl; external ; - -{ Setup the decoder decoding parameters using user parameters. - Decoding parameters are returned in j2k->cp. - @param dinfo decompressor handle - @param parameters decompression parameters } -procedure opj_setup_decoder(dinfo: popj_dinfo_t; parameters: popj_dparameters_t); cdecl; external; - -{ Decode an image from a JPEG-2000 codestream - @param dinfo decompressor handle - @param cio Input buffer stream - @return Returns a decoded image if successful, returns NULL otherwise } -function opj_decode(dinfo: popj_dinfo_t; cio: popj_cio_t): popj_image_t; cdecl; external; - -{ Creates a J2K/JP2 compression structure - @param format Coder to select - @return Returns a handle to a compressor if successful, returns NULL otherwise } -function opj_create_compress(format: OPJ_CODEC_FORMAT): popj_cinfo_t; cdecl; external; - -{ Destroy a compressor handle - @param cinfo compressor handle to destroy } -procedure opj_destroy_compress(cinfo: popj_cinfo_t); cdecl; external; - -{ Set encoding parameters to default values, that means : -
    -
  • Lossless -
  • 1 tile -
  • Size of precinct : 2^15 x 2^15 (means 1 precinct) -
  • Size of code-block : 64 x 64 -
  • Number of resolutions: 6 -
  • No SOP marker in the codestream -
  • No EPH marker in the codestream -
  • No sub-sampling in x or y direction -
  • No mode switch activated -
  • Progression order: LRCP -
  • No index file -
  • No ROI upshifted -
  • No offset of the origin of the image -
  • No offset of the origin of the tiles -
  • Reversible DWT 5-3 -
- @param parameters Compression parameters } -procedure opj_set_default_encoder_parameters(parameters: popj_cparameters_t); cdecl; external; - -{ Setup the encoder parameters using the current image and using user parameters. - @param cinfo compressor handle - @param parameters compression parameters - @param image input filled image } -procedure opj_setup_encoder(cinfo: popj_cinfo_t; parameters: popj_cparameters_t; - image: popj_image_t); cdecl; external; - -{ Encode an image into a JPEG-2000 codestream - @param cinfo compressor handle - @param cio Output buffer stream - @param image Image to encode - @param index Name of the index file if required, NULL otherwise - @return Returns true if successful, returns false otherwise } -function opj_encode(cinfo: popj_cinfo_t; cio: popj_cio_t; image: popj_image_t; - index: PAnsiChar): Bool; cdecl; external; - -implementation - -function pow(const Base, Exponent: Double): Double; cdecl; {$IFDEF FPC}[Public];{$ENDIF} -begin - if Exponent = 0.0 then - Result := 1.0 - else if (Base = 0.0) and (Exponent > 0.0) then - Result := 0.0 - else - Result := Exp(Exponent * Ln(Base)); -end; - -{$IF Defined(MSWINDOWS)} - {$IF Defined(DCC)} - { Delphi Win32 } - { Link object files created with C++ Builder.} - {$L J2KObjects\pi.obj} - {$L J2KObjects\openjpeg.obj} - {$L J2KObjects\j2k_lib.obj} - {$L J2KObjects\event.obj} - {$L J2KObjects\cio.obj} - {$L J2KObjects\image.obj} - {$L J2KObjects\j2k.obj} - {$L J2KObjects\jp2.obj} - {$L J2KObjects\jpt.obj} - {$L J2KObjects\mqc.obj} - {$L J2KObjects\raw.obj} - {$L J2KObjects\bio.obj} - {$L J2KObjects\tgt.obj} - {$L J2KObjects\tcd.obj} - {$L J2KObjects\t1.obj} - {$L J2KObjects\dwt.obj} - {$L J2KObjects\t2.obj} - {$L J2KObjects\mct.obj} - - const - { MS C Runtime library needed for importing std C functions.} - MSCRuntimeLib = 'msvcrt.dll'; - var - { Some unresolved external constants.} - __turboFloat: LongBool = False; - _max_dble: Double = 1.7e308; - _streams: Pointer; - - { Internal OpenJpeg functions external declarations. - Delphi yells 'unsatisfied external declaration' if they are not referenced here.} - procedure mqc_create; cdecl; external; - procedure raw_create; cdecl; external; - procedure bio_create; cdecl; external; - procedure opj_image_create0; cdecl; external; - procedure opj_event_msg; cdecl; external; - procedure opj_clock; cdecl; external; - procedure cio_read; cdecl; external; - procedure cio_write; cdecl; external; - procedure cio_skip; cdecl; external; - procedure bio_read; cdecl; external; - procedure bio_write; cdecl; external; - procedure cio_numbytesleft; cdecl; external; - procedure cio_getbp; cdecl; external; - procedure j2k_destroy_compress; cdecl; external; - procedure tgt_create; cdecl; external; - procedure tgt_destroy; cdecl; external; - procedure mqc_bypass_enc; cdecl; external; - procedure mqc_encode; cdecl; external; - procedure mqc_decode; cdecl; external; - procedure raw_decode; cdecl; external; - procedure mqc_resetstates; cdecl; external; - procedure mqc_setstate; cdecl; external; - procedure mqc_init_enc; cdecl; external; - procedure mqc_segmark_enc; cdecl; external; - procedure mqc_flush; cdecl; external; - procedure mqc_bypass_init_enc; cdecl; external; - procedure mqc_numbytes; cdecl; external; - procedure mqc_reset_enc; cdecl; external; - procedure mqc_erterm_enc; cdecl; external; - procedure mqc_init_dec; cdecl; external; - procedure raw_init_dec; cdecl; external; - procedure mqc_destroy; cdecl; external; - procedure mqc_restart_init_enc; cdecl; external; - procedure raw_destroy; cdecl; external; - procedure tgt_reset; cdecl; external; - procedure tgt_setvalue; cdecl; external; - procedure bio_init_enc; cdecl; external; - procedure bio_flush; cdecl; external; - procedure bio_numbytes; cdecl; external; - procedure bio_destroy; cdecl; external; - procedure bio_init_dec; cdecl; external; - procedure pi_create_encode; cdecl; external; - procedure pi_initialise_encode; cdecl; external; - procedure pi_create_decode; cdecl; external; - procedure pi_next; cdecl; external; - procedure pi_destroy; cdecl; external; - procedure tgt_encode; cdecl; external; - procedure tgt_decode; cdecl; external; - procedure bio_inalign; cdecl; external; - - procedure _llmul; cdecl; - asm - { from Delphi's System.pas __llmul } - push edx - push eax - - mov eax, [esp+16] - mul dword ptr [esp] - mov ecx, eax - - mov eax, [esp+4] - mul dword ptr [esp+12] - add ecx, eax - - mov eax, [esp] - mul dword ptr [esp+12] - add edx, ecx - - pop ecx - pop ecx - - ret 8 - end; - - { C library imports } - function malloc(size: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_malloc'{$ENDIF}; - function calloc(nelem, elsize: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_calloc'{$ENDIF}; - procedure free(ptr: Pointer); cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_free'{$ENDIF}; - function realloc(ptr: Pointer; size: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_realloc'{$ENDIF}; - function memset(s: Pointer; c, n: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_memset'{$ENDIF}; - function memcpy(s1, s2: Pointer; n: Cardinal): Pointer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_memcpy'{$ENDIF}; - function floor(const x: Double): Double; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_floor'{$ENDIF}; - function ceil(const num: Double): Double; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_ceil'{$ENDIF}; - function printf(format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_printf'{$ENDIF}; - function fprintf(f: Pointer; format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_fprintf'{$ENDIF}; - function vsprintf(s, format: PAnsiChar): Integer; cdecl; varargs; external MSCRuntimeLib{$IFDEF BCB} name '_vsprintf'{$ENDIF}; - function _ftol(x: Single): LongInt; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '__ftol'{$ENDIF}; - function strcpy(s1, s2: PAnsiChar): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strcpy'{$ENDIF}; - function wcscpy(s1, s2: PAnsiChar): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_wstrcpy'{$ENDIF}; - function strncpy(s1, s2: PAnsiChar; maxlen: Integer): PAnsiChar; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strncpy'{$ENDIF}; - function strlen(s: PAnsiChar): Integer; cdecl; external MSCRuntimeLib{$IFDEF BCB} name '_strlen'{$ENDIF}; - {$ELSEIF Defined(FPC)} - { Free Pascal Win32 } - { Link OpenJpeg static library and C runtime library.} - {$LINKLIB libopenjpegwin32.a} - {$LINKLIB libcrtdll.a} - {$IFEND} - -{$ELSEIF Defined(LINUX)} - {$IF Defined(FPC)} - { Free Pascal Linux } - { Link C runtime library.} - {$LINKLIB c} - - {$IF Defined(CPU86)} - { Free Pascal Linux x86 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpeglinx86.a} - {$ELSEIF Defined(CPUX86_64)} - { Free Pascal Linux x86_64 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpeglinx86_64.a} - {$ELSE} - No support for this CPU architecture. - {$IFEND} - {$ELSE} - No support for this compiler - {$IFEND} -{$ELSEIF Defined(DARWIN)} - {$IF Defined(FPC)} - { Free Pascal MacOSX } - { Link C runtime library.} - {$LINKLIB c} - - {$IF Defined(CPU86)} - { Free Pascal MacOSX x86 } - { Link OpenJpeg static library.} - {$LINKLIB libopenjpegosxx86.a} - {$ELSE} - No support for this CPU architecture. - {$IFEND} - {$ELSE} - No support for this compiler - {$IFEND} -{$ELSE} - No suppor for this OS -{$IFEND} - -end. - diff --git a/3rd/Imaging/Source/Imaging.pas b/3rd/Imaging/Source/Imaging.pas deleted file mode 100644 index 6cab849e0..000000000 --- a/3rd/Imaging/Source/Imaging.pas +++ /dev/null @@ -1,4253 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit is heart of Imaging library. It contains basic functions for - manipulating image data as well as various image file format support.} -unit Imaging; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Types, ImagingTypes; - -type - { Default Imaging excepton class } - EImagingError = class(Exception); - { Raised when function receives bad image (not passed TestImage).} - EImagingBadImage = class(Exception) - public - constructor Create; - end; - - { Dynamic array of TImageData records } - TDynImageDataArray = array of TImageData; - - -{ ------------------------------------------------------------------------ - Low Level Interface Functions - ------------------------------------------------------------------------} - -{ General Functions } - -{ Initializes image (all is set to zeroes). Call this for each image - before using it (before calling every other function) to be sure there - are no random-filled bytes (which would cause errors later).} -procedure InitImage(var Image: TImageData); -{ Creates empty image of given dimensions and format. Image is filled with - transparent black color (A=0, R=0, G=0, B=0).} -function NewImage(Width, Height: LongInt; Format: TImageFormat; - var Image: TImageData): Boolean; -{ Returns True if given TImageData record is valid.} -function TestImage(const Image: TImageData): Boolean; -{ Frees given image data. Ater this call image is in the same state - as after calling InitImage. If image is not valid (dost not pass TestImage - test) it is only zeroed by calling InitImage.} -procedure FreeImage(var Image: TImageData); -{ Call FreeImage() on all images in given dynamic array and sets its - length to zero.} -procedure FreeImagesInArray(var Images: TDynImageDataArray); -{ Returns True if all TImageData records in given array are valid. Returns False - if at least one is invalid or if array is empty.} -function TestImagesInArray(const Images: TDynImageDataArray): Boolean; -{ Checks given file for every supported image file format and if - the file is in one of them returns its string identifier - (which can be used in LoadFromStream/LoadFromMem type functions). - If file is not in any of the supported formats empty string is returned.} -function DetermineFileFormat(const FileName: string): string; -{ Checks given stream for every supported image file format and if - the stream is in one of them returns its string identifier - (which can be used in LoadFromStream/LoadFromMem type functions). - If stream is not in any of the supported formats empty string is returned.} -function DetermineStreamFormat(Stream: TStream): string; -{ Checks given memory for every supported image file format and if - the memory is in one of them returns its string identifier - (which can be used in LoadFromStream/LoadFromMem type functions). - If memory is not in any of the supported formats empty string is returned.} -function DetermineMemoryFormat(Data: Pointer; Size: LongInt): string; -{ Checks that an apropriate file format is supported purely from inspecting - the given file name's extension (not contents of the file itself). - The file need not exist.} -function IsFileFormatSupported(const FileName: string): Boolean; -{ Enumerates all registered image file formats. Descriptive name, - default extension, masks (like '*.jpg,*.jfif') and some capabilities - of each format are returned. To enumerate all formats start with Index at 0 and - call EnumFileFormats with given Index in loop until it returns False (Index is - automatically increased by 1 in function's body on successful call).} -function EnumFileFormats(var Index: LongInt; var Name, DefaultExt, Masks: string; - var CanSaveImages, IsMultiImageFormat: Boolean): Boolean; - -{ Loading Functions } - -{ Loads single image from given file.} -function LoadImageFromFile(const FileName: string; var Image: TImageData): Boolean; -{ Loads single image from given stream. If function fails stream position - is not changed.} -function LoadImageFromStream(Stream: TStream; var Image: TImageData): Boolean; -{ Loads single image from given memory location.} -function LoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; -{ Loads multiple images from given file.} -function LoadMultiImageFromFile(const FileName: string; - var Images: TDynImageDataArray): Boolean; -{ Loads multiple images from given stream. If function fails stream position - is not changed.} -function LoadMultiImageFromStream(Stream: TStream; - var Images: TDynImageDataArray): Boolean; -{ Loads multiple images from given memory location.} -function LoadMultiImageFromMemory(Data: Pointer; Size: LongInt; - var Images: TDynImageDataArray): Boolean; - -{ Saving Functions } - -{ Saves single image to given file.} -function SaveImageToFile(const FileName: string; const Image: TImageData): Boolean; -{ Saves single image to given stream. If function fails stream position - is not changed. Ext identifies desired image file format (jpg, png, dds, ...).} -function SaveImageToStream(const Ext: string; Stream: TStream; - const Image: TImageData): Boolean; -{ Saves single image to given memory location. Memory must be allocated and its - size is passed in Size parameter in which number of written bytes is returned. - Ext identifies desired image file format (jpg, png, dds, ...).} -function SaveImageToMemory(const Ext: string; Data: Pointer; var Size: LongInt; - const Image: TImageData): Boolean; -{ Saves multiple images to given file. If format supports - only single level images and there are multiple images to be saved, - they are saved as sequence of files img000.jpg, img001.jpg ....).} -function SaveMultiImageToFile(const FileName: string; - const Images: TDynImageDataArray): Boolean; -{ Saves multiple images to given stream. If format supports - only single level images and there are multiple images to be saved, - they are saved one after another to the stream. If function fails stream - position is not changed. Ext identifies desired image file format (jpg, png, dds, ...).} -function SaveMultiImageToStream(const Ext: string; Stream: TStream; - const Images: TDynImageDataArray): Boolean; -{ Saves multiple images to given memory location. If format supports - only single level images and there are multiple images to be saved, - they are saved one after another to the memory. Memory must be allocated and - its size is passed in Size parameter in which number of written bytes is returned. - Ext identifies desired image file format (jpg, png, dds, ...).} -function SaveMultiImageToMemory(const Ext: string; Data: Pointer; - var Size: LongInt; const Images: TDynImageDataArray): Boolean; - -{ Manipulation Functions } - -{ Creates identical copy of image data. Clone should be initialized - by InitImage or it should be vaild image which will be freed by CloneImage.} -function CloneImage(const Image: TImageData; var Clone: TImageData): Boolean; -{ Converts image to the given format.} -function ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; -{ Flips given image. Reverses the image along its horizontal axis - the top - becomes the bottom and vice versa.} -function FlipImage(var Image: TImageData): Boolean; -{ Mirrors given image. Reverses the image along its vertical axis � the left - side becomes the right and vice versa.} -function MirrorImage(var Image: TImageData): Boolean; -{ Resizes given image to new dimensions. Nearest, bilinear, or bicubic filtering - can be used. Input Image must already be created - use NewImage to create new images.} -function ResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; - Filter: TResizeFilter): Boolean; -{ Swaps SrcChannel and DstChannel color or alpha channels of image. - Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to - identify channels.} -function SwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; -{ Reduces the number of colors of the Image. Currently MaxColors must be in - range <2, 4096>. Color reduction works also for alpha channel. Note that for - large images and big number of colors it can be very slow. - Output format of the image is the same as input format.} -function ReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; -{ Generates mipmaps for image. Levels is the number of desired mipmaps levels - with zero (or some invalid number) meaning all possible levels.} -function GenerateMipMaps(const Image: TImageData; Levels: LongInt; - var MipMaps: TDynImageDataArray): Boolean; -{ Maps image to existing palette producing image in ifIndex8 format. - Pal must be allocated to at least Entries * SizeOf(TColor32Rec) bytes. - As resulting image is in 8bit indexed format Entries must be lower or - equal to 256.} -function MapImageToPalette(var Image: TImageData; Pal: PPalette32; - Entries: LongInt): Boolean; -{ Splits image into XChunks x YChunks subimages. Default size of each chunk is - ChunkWidth x ChunkHeight. If PreserveSize si True chunks at the edges of - the image are also ChunkWidth x ChunkHeight sized and empty space is filled - with optional Fill pixels. After calling this function XChunks contains number of - chunks along x axis and YChunks along y axis. To access chunk [X, Y] use this - index: Chunks[Y * XChunks + X].} -function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray; - ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; - PreserveSize: Boolean; Fill: Pointer = nil): Boolean; -{ Creates palette with MaxColors based on the colors of images in Images array. - Use it when you want to convert several images to indexed format using - single palette for all of them. If ConvertImages is True images in array - are converted to indexed format using resulting palette. if it is False - images are left intact and only resulting palatte is returned in Pal. - Pal must be allocated to have at least MaxColors entries.} -function MakePaletteForImages(var Images: TDynImageDataArray; Pal: PPalette32; - MaxColors: LongInt; ConvertImages: Boolean): Boolean; -{ Rotates image by Angle degrees counterclockwise. All angles are allowed.} -procedure RotateImage(var Image: TImageData; Angle: Single); - -{ Drawing/Pixel functions } - -{ Copies rectangular part of SrcImage to DstImage. No blending is performed - - alpha is simply copied to destination image. Operates also with - negative X and Y coordinates. - Note that copying is fastest for images in the same data format - (and slowest for images in special formats).} -function CopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; - var DstImage: TImageData; DstX, DstY: LongInt): Boolean; -{ Fills given rectangle of image with given pixel fill data. Fill should point - to the pixel in the same format as the given image is in.} -function FillRect(var Image: TImageData; X, Y, Width, Height: LongInt; FillColor: Pointer): Boolean; -{ Replaces pixels with OldPixel in the given rectangle by NewPixel. - OldPixel and NewPixel should point to the pixels in the same format - as the given image is in.} -function ReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; - OldColor, NewColor: Pointer): Boolean; -{ Stretches the contents of the source rectangle to the destination rectangle - with optional resampling. No blending is performed - alpha is - simply copied/resampled to destination image. Note that stretching is - fastest for images in the same data format (and slowest for - images in special formats).} -function StretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TResizeFilter): Boolean; -{ Copies pixel of Image at [X, Y] to memory pointed at by Pixel. Doesn't - work with special formats.} -procedure GetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -{ Copies pixel from memory pointed at by Pixel to Image at position [X, Y]. - Doesn't work with special formats.} -procedure SetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -{ Function for getting pixel colors. Native pixel is read from Image and - then translated to 32 bit ARGB. Works for all image formats (except special) - so it is not very fast.} -function GetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; -{ Procedure for setting pixel colors. Input 32 bit ARGB color is translated to - native format and then written to Image. Works for all image formats (except special) - so it is not very fast.} -procedure SetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); -{ Function for getting pixel colors. Native pixel is read from Image and - then translated to FP ARGB. Works for all image formats (except special) - so it is not very fast.} -function GetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; -{ Procedure for setting pixel colors. Input FP ARGB color is translated to - native format and then written to Image. Works for all image formats (except special) - so it is not very fast.} -procedure SetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); - -{ Palette Functions } - -{ Allocates new palette with Entries ARGB color entries.} -procedure NewPalette(Entries: LongInt; var Pal: PPalette32); -{ Frees given palette.} -procedure FreePalette(var Pal: PPalette32); -{ Copies Count palette entries from SrcPal starting at index SrcIdx to - DstPal at index DstPal.} -procedure CopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt); -{ Returns index of color in palette or index of nearest color if exact match - is not found. Pal must have at least Entries color entries.} -function FindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): LongInt; -{ Creates grayscale palette where each color channel has the same value. - Pal must have at least Entries color entries.} -procedure FillGrayscalePalette(Pal: PPalette32; Entries: LongInt); -{ Creates palette with given bitcount for each channel. - 2^(RBits + GBits + BBits) should be equl to Entries. Examples: - (3, 3, 2) will create palette with all possible colors of R3G3B2 format - and (8, 0, 0) will create palette with 256 shades of red. - Pal must be allocated to at least Entries * SizeOf(TColor32Rec) bytes.} -procedure FillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits, - BBits: Byte; Alpha: Byte = $FF); -{ Swaps SrcChannel and DstChannel color or alpha channels of palette. - Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to - identify channels. Pal must be allocated to at least - Entries * SizeOf(TColor32Rec) bytes.} -procedure SwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel, - DstChannel: LongInt); - -{ Options Functions } - -{ Sets value of integer option specified by OptionId parameter. - Option Ids are constans starting ImagingXXX.} -function SetOption(OptionId, Value: LongInt): Boolean; -{ Returns value of integer option specified by OptionId parameter. If OptionId is - invalid, InvalidOption is returned. Option Ids are constans - starting ImagingXXX.} -function GetOption(OptionId: LongInt): LongInt; -{ Pushes current values of all options on the stack. Returns True - if successfull (max stack depth is 8 now). } -function PushOptions: Boolean; -{ Pops back values of all options from the top of the stack. Returns True - if successfull (max stack depth is 8 now). } -function PopOptions: Boolean; - -{ Image Format Functions } - -{ Returns short information about given image format.} -function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean; -{ Returns size in bytes of Width x Height area of pixels. Works for all formats.} -function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; - -{ IO Functions } - -{ User can set his own file IO functions used when loading from/saving to - files by this function.} -procedure SetUserFileIO(OpenProc: TOpenProc; CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: - TSeekProc; TellProc: TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); -{ Sets file IO functions to Imaging default.} -procedure ResetFileIO; - -{ Raw Image IO Functions } - -procedure ReadRawImageFromFile(const FileName: string; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset: Integer = 0; RowLength: Integer = 0); -procedure ReadRawImageFromStream(Stream: TStream; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset: Integer = 0; RowLength: Integer = 0); -procedure ReadRawImageFromMemory(Data: Pointer; DataSize: Integer; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset: Integer = 0; RowLength: Integer = 0); -procedure ReadRawImageRect(Data: Pointer; Left, Top, Width, Height: Integer; - var Image: TImageData; Offset: Integer = 0; RowLength: Integer = 0); - -procedure WriteRawImageToFile(const FileName: string; const Image: TImageData; - Offset: Integer = 0; RowLength: Integer = 0); -procedure WriteRawImageToStream(Stream: TStream; const Image: TImageData; - Offset: Integer = 0; RowLength: Integer = 0); -procedure WriteRawImageToMemory(Data: Pointer; DataSize: Integer; const Image: TImageData; - Offset: Integer = 0; RowLength: Integer = 0); -procedure WriteRawImageRect(Data: Pointer; Left, Top, Width, Height: Integer; - const Image: TImageData; Offset: Integer = 0; RowLength: Integer = 0); - -{ Convenience/helper Functions } - -procedure ResizeImageToFit(const SrcImage: TImageData; FitWidth, FitHeight: Integer; - Filter: TResizeFilter; var DestImage: TImageData); - - -{ ------------------------------------------------------------------------ - Other Imaging Stuff - ------------------------------------------------------------------------} - -type - { Set of TImageFormat enum.} - TImageFormats = set of TImageFormat; - - { Record containg set of IO functions internaly used by image loaders/savers.} - TIOFunctions = record - Open: TOpenProc; - Close: TCloseProc; - Eof: TEofProc; - Seek: TSeekProc; - Tell: TTellProc; - Read: TReadProc; - Write: TWriteProc; - end; - PIOFunctions = ^TIOFunctions; - -type - TFileFormatFeature = ( - ffLoad, - ffSave, - ffMultiImage, - ffReadOnSave, - ffProgress, - ffReadScanlines); - - TFileFormatFeatures = set of TFileFormatFeature; - - TMetadata = class; - - { Base class for various image file format loaders/savers which - descend from this class. If you want to add support for new image file - format the best way is probably to look at TImageFileFormat descendants' - implementations that are already part of Imaging.} -{$TYPEINFO ON} - TImageFileFormat = class - private - FExtensions: TStringList; - FMasks: TStringList; - function GetCanLoad: Boolean; - function GetCanSave: Boolean; - function GetIsMultiImageFormat: Boolean; - { Does various checks and actions before LoadData method is called.} - function PrepareLoad(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstFrame: Boolean): Boolean; - { Processes some actions according to result of LoadData.} - function PostLoadCheck(var Images: TDynImageDataArray; LoadResult: Boolean): Boolean; - { Helper function to be called in SaveData methods of descendants (ensures proper - index and sets FFirstIdx and FLastIdx for multi-images).} - function PrepareSave(Handle: TImagingHandle; const Images: TDynImageDataArray; - var Index: LongInt): Boolean; - { Returns file open mode used for saving images. Depends on defined Features.} - function GetSaveOpenMode: TOpenMode; - protected - FName: string; - FFeatures: TFileFormatFeatures; - FSupportedFormats: TImageFormats; - FFirstIdx, FLastIdx: LongInt; - FMetadata: TMetadata; - { Descendants must override this method and define file format name and - capabilities.} - procedure Define; virtual; - { Defines filename masks for this image file format. AMasks should be - in format '*.ext1,*.ext2,umajo.*'.} - procedure AddMasks(const AMasks: string); - function GetFormatInfo(Format: TImageFormat): TImageFormatInfo; - { Returns set of TImageData formats that can be saved in this file format - without need for conversion.} - function GetSupportedFormats: TImageFormats; virtual; - { Method which must be overrided in descendants if they' are be capable - of loading images. Images are already freed and length is set to zero - whenever this method gets called. Also Handle is assured to be valid - and contains data that passed TestFormat method's check.} - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstFrame: Boolean): Boolean; virtual; - { Method which must be overriden in descendants if they are be capable - of saving images. Images are checked to have length >0 and - that they contain valid images. For single-image file formats - Index contain valid index to Images array (to image which should be saved). - Multi-image formats should use FFirstIdx and FLastIdx fields to - to get all images that are to be saved.} - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; virtual; - { This method is called internaly by MakeCompatible when input image - is in format not supported by this file format. Image is clone of - MakeCompatible's input and Info is its extended format info.} - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); virtual; - { Returns True if given image is supported for saving by this file format. - Most file formats don't need to override this method. It checks - (in this base class) if Image's format is in SupportedFromats set. - But you may override it if you want further checks - (proper widht and height for example).} - function IsSupported(const Image: TImageData): Boolean; virtual; - public - constructor Create(AMetadata: TMetadata = nil); virtual; - destructor Destroy; override; - - { Loads images from file source.} - function LoadFromFile(const FileName: string; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean = False): Boolean; - { Loads images from stream source.} - function LoadFromStream(Stream: TStream; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean = False): Boolean; - { Loads images from memory source.} - function LoadFromMemory(Data: Pointer; Size: LongInt; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean = False): Boolean; - - { Saves images to file. If format supports only single level images and - there are multiple images to be saved, they are saved as sequence of - independent images (for example SaveToFile saves sequence of - files img000.jpg, img001.jpg ....).} - function SaveToFile(const FileName: string; const Images: TDynImageDataArray; - OnlyFirstLevel: Boolean = False): Boolean; - { Saves images to stream. If format supports only single level images and - there are multiple images to be saved, they are saved as sequence of - independent images.} - function SaveToStream(Stream: TStream; const Images: TDynImageDataArray; - OnlyFirstLevel: Boolean = False): Boolean; - { Saves images to memory. If format supports only single level images and - there are multiple images to be saved, they are saved as sequence of - independent images. Data must be already allocated and their size passed - as Size parameter, number of written bytes is then returned in the same - parameter.} - function SaveToMemory(Data: Pointer; var Size: LongInt; - const Images: TDynImageDataArray; OnlyFirstLevel: Boolean = False): Boolean; - - { Makes Image compatible with this file format (that means it is in one - of data formats in Supported formats set). If input is already - in supported format then Compatible just use value from input - (Compatible := Image) so must not free it after you are done with it - (image bits pointer points to input image's bits). - If input is not in supported format then it is cloned to Compatible - and concerted to one of supported formats (which one dependeds on - this file format). If image is cloned MustBeFreed is set to True - to indicated that you must free Compatible after you are done with it.} - function MakeCompatible(const Image: TImageData; var Compatible: TImageData; - out MustBeFreed: Boolean): Boolean; - { Returns True if data located in source identified by Handle - represent valid image in current format.} - function TestFormat(Handle: TImagingHandle): Boolean; virtual; - { Resturns True if the given FileName matches filter for this file format. - For most formats it just checks filename extensions. - It uses filename masks in from Masks property so it can recognize - filenames like this 'umajoXXXumajo.j0j' if one of themasks is - 'umajo*umajo.j?j'.} - function TestFileName(const FileName: string): Boolean; - { Descendants use this method to check if their options (registered with - constant Ids for SetOption/GetOption interface or accessible as properties - of descendants) have valid values and make necessary changes.} - procedure CheckOptionsValidity; virtual; - - { Description of this format.} - property Name: string read FName; - { Indicates whether images in this format can be loaded.} - property CanLoad: Boolean read GetCanLoad; - { Indicates whether images in this format can be saved.} - property CanSave: Boolean read GetCanSave; - { Indicates whether images in this format can contain multiple image levels.} - property IsMultiImageFormat: Boolean read GetIsMultiImageFormat; - { List of filename extensions for this format.} - property Extensions: TStringList read FExtensions; - { List of filename masks that are used to associate filenames - with TImageFileFormat descendants. Typical mask looks like - '*.bmp' or 'texture.*' (supports file formats which use filename instead - of extension to identify image files).} - property Masks: TStringList read FMasks; - { Set of TImageFormats supported by saving functions of this format. Images - can be saved only in one those formats.} - property SupportedFormats: TImageFormats read GetSupportedFormats; - end; -{$TYPEINFO OFF} - - { Class reference for TImageFileFormat class} - TImageFileFormatClass = class of TImageFileFormat; - - { Physical resolution unit.} - TResolutionUnit = ( - ruSizeInMicroMeters, // value is pixel size in micrometers - ruDpi, // value is pixels/dots per inch - ruDpm, // value is pixels/dots per meter - ruDpcm // value is pixels/dots per centimeter - ); - - { Class for storage of single metadata item.} - TMetadataItem = class - public - Id: string; - ImageIndex: Integer; - Value: Variant; - end; - - { Metadata manager class.} - TMetadata = class - private - FLoadMetaItems: TStringList; - FSaveMetaItems: TStringList; - procedure AddMetaToList(List: TStringList; const Id: string; const Value: Variant; ImageIndex: Integer); - procedure ClearMetaList(List: TStringList); - function GetMetaById(const Id: string): Variant; - function GetMetaByIdMulti(const Id: string; ImageIndex: Integer): Variant; - function GetMetaCount: Integer; - function GetMetaByIdx(Index: Integer): TMetadataItem; - function GetSaveMetaById(const Id: string): Variant; - function GetSaveMetaByIdMulti(const Id: string; ImageIndex: Integer): Variant; - procedure TranslateUnits(ResolutionUnit: TResolutionUnit; var XRes, YRes: Single); - public - constructor Create; - destructor Destroy; override; - - procedure SetMetaItem(const Id: string; const Value: Variant; ImageIndex: Integer = 0); - procedure SetMetaItemForSaving(const Id: string; const Value: Variant; ImageIndex: Integer = 0); - function HasMetaItem(const Id: string; ImageIndex: Integer = 0): Boolean; - function HasMetaItemForSaving(const Id: string; ImageIndex: Integer = 0): Boolean; - - procedure ClearMetaItems; - procedure ClearMetaItemsForSaving; - function GetMetaItemName(const Id: string; ImageIndex: Integer): string; - { Copies loaded meta items to items-for-save stack. Use this when you want to - save metadata that have been just loaded (e.g. resaving image in - different file format but keeping the metadata).} - procedure CopyLoadedMetaItemsForSaving; - - function GetPhysicalPixelSize(ResUnit: TResolutionUnit; var XSize, - YSize: Single; MetaForSave: Boolean = False; ImageIndex: Integer = 0): Boolean; - procedure SetPhysicalPixelSize(ResUnit: TResolutionUnit; XSize, YSize: Single; - MetaForSave: Boolean = False; ImageIndex: Integer = 0); - - property MetaItems[const Id: string]: Variant read GetMetaById; - property MetaItemsMulti[const Id: string; ImageIndex: Integer]: Variant read GetMetaByIdMulti; - { Number of loaded metadata items.} - property MetaItemCount: Integer read GetMetaCount; - property MetaItemsByIdx[Index: Integer]: TMetadataItem read GetMetaByIdx; - property MetaItemsForSaving[const Id: string]: Variant read GetSaveMetaById; - property MetaItemsForSavingMulti[const Id: string; ImageIndex: Integer]: Variant read GetSaveMetaByIdMulti; - end; - -const - { Metadata item id constants } - - { Physical size of one pixel in micrometers. Type of value is Float.} - SMetaPhysicalPixelSizeX = 'PhysicalPixelSizeX'; - SMetaPhysicalPixelSizeY = 'PhysicalPixelSizeY'; - { Delay for frame of animation (how long it should stay visible) in milliseconds. - Type of value is Integer.} - SMetaFrameDelay = 'FrameDelay'; - { Number of times animation should be looped (0 = infinite looping). Type is Int. } - SMetaAnimationLoops = 'AnimationLoops'; - { Gamma correction value. Type is Float.} - SMetaGamma = 'Gamma'; - { Exposure value for HDR etc. Type is Float.} - SMetaExposure = 'Exposure'; - { EXIF image metadata raw blob.} - SMetaExifBlob = 'ExifBlob'; - { XMP image metadata raw blob.} - SMetaXmpBlob = 'XmpBlob'; - { IPTC image metadata raw blob.} - SMetaIptcBlob = 'IptcBlob'; - -var - GlobalMetadata: TMetadata; - -{ Returns symbolic name of given format.} -function GetFormatName(Format: TImageFormat): string; -{ Returns string with information about given Image.} -function ImageToStr(const Image: TImageData): string; -{ Returns Imaging version string in format 'Major.Minor.Patch'.} -function GetVersionStr: string; -{ If Condition is True then TruePart is retured, otherwise FalsePart is returned.} -function IffFormat(Condition: Boolean; const TruePart, FalsePart: TImageFormat): TImageFormat; - -{ Registers new option so it can be used by SetOption and GetOption functions. - Returns True if registration was succesful - that is Id is valid and is - not already taken by another option.} -function RegisterOption(OptionId: LongInt; Variable: PLongInt): Boolean; - -{ Registers new image loader/saver so it can be used by LoadFrom/SaveTo - functions.} -procedure RegisterImageFileFormat(AClass: TImageFileFormatClass); -{ Returns image format loader/saver according to given extension - or nil if not found.} -function FindImageFileFormatByExt(const Ext: string): TImageFileFormat; -{ Returns image format loader/saver according to given filename - or nil if not found.} -function FindImageFileFormatByName(const FileName: string): TImageFileFormat; -{ Returns image format loader/saver based on its class - or nil if not found or not registered.} -function FindImageFileFormatByClass(AClass: TImageFileFormatClass): TImageFileFormat; -{ Returns number of registered image file format loaders/saver.} -function GetFileFormatCount: LongInt; -{ Returns image file format loader/saver at given index. Index must be - in range [0..GetFileFormatCount - 1] otherwise nil is returned.} -function GetFileFormatAtIndex(Index: LongInt): TImageFileFormat; -{ Returns filter string for usage with open and save picture dialogs - which contains all registered image file formats. - Set OpenFileFilter to True if you want filter for open dialog - and to False if you want save dialog filter (formats that cannot save to files - are not added then). - For open dialog filter for all known graphic files - (like All(*.jpg;*.png;....) is added too at the first index.} -function GetImageFileFormatsFilter(OpenFileFilter: Boolean): string; -{ Returns file extension (without dot) of image format selected - by given filter index. Used filter string is defined by GetImageFileFormatsFilter - function. This function can be used with save dialogs (with filters created - by GetImageFileFormatsFilter) to get the extension of file format selected - in dialog quickly. Index is in range 1..N (as FilterIndex property - of TOpenDialog/TSaveDialog)} -function GetFilterIndexExtension(Index: LongInt; OpenFileFilter: Boolean): string; -{ Returns filter index of image file format of file specified by FileName. Used filter - string is defined by GetImageFileFormatsFilter function. - Returned index is in range 1..N (as FilterIndex property of TOpenDialog/TSaveDialog)} -function GetFileNameFilterIndex(const FileName: string; OpenFileFilter: Boolean): LongInt; - -{ Returns current IO functions.} -function GetIO: TIOFunctions; -{ Raises EImagingError with given message.} -procedure RaiseImaging(const Msg: string; const Args: array of const); overload; -procedure RaiseImaging(const Msg: string); overload; {$IFDEF USE_INLINE}inline;{$ENDIF} - -const - SImagingLibTitle = 'Vampyre Imaging Library'; - -implementation - -uses -{$IFNDEF DONT_LINK_BITMAP} - ImagingBitmap, -{$ENDIF} -{$IFNDEF DONT_LINK_JPEG} - ImagingJpeg, -{$ENDIF} -{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)} - ImagingNetworkGraphics, -{$IFEND} -{$IFNDEF DONT_LINK_GIF} - ImagingGif, -{$ENDIF} -{$IFNDEF DONT_LINK_DDS} - ImagingDds, -{$ENDIF} -{$IFNDEF DONT_LINK_TARGA} - ImagingTarga, -{$ENDIF} -{$IFNDEF DONT_LINK_PNM} - ImagingPortableMaps, -{$ENDIF} -{$IFNDEF DONT_LINK_RADHDR} - ImagingRadiance, -{$ENDIF} -{$IFNDEF DONT_LINK_EXTRAS} - ImagingExtras, -{$ENDIF} - //ImagingDebug, - ImagingFormats, ImagingUtility, ImagingIO, Variants; - -resourcestring - SExceptMsg = 'Exception Message'; - SAllFilter = 'All Images'; - SUnknownFormat = 'Unknown and unsupported format'; - - SErrorFreeImage = 'Error while freeing image. %s'; - SErrorCloneImage = 'Error while cloning image. %s'; - SErrorFlipImage = 'Error while flipping image. %s'; - SErrorMirrorImage = 'Error while mirroring image. %s'; - SErrorResizeImage = 'Error while resizing image. %s'; - SErrorSwapImage = 'Error while swapping channels of image. %s'; - SFileFormatCanNotLoad = 'Image Format "%s" does not support loading images.'; - SFileFormatCanNotSave = 'Image Format "%s" does not support saving images.'; - SErrorNewImage = 'Error while creating image data with params: Width=%d ' + - 'Height=%d Format=%s.'; - SErrorConvertImage = 'Error while converting image to format "%s". %s'; - SImageInfo = 'Image @%p info: Width = %dpx, Height = %dpx, ' + - 'Format = %s, Size = %.0n %s, Bits @%p, Palette @%p.'; - SImageInfoInvalid = 'Access violation encountered when getting info on ' + - 'image at address %p.'; - SFileNotValid = 'File "%s" is not valid image in "%s" format.'; - SStreamNotValid = 'Stream %p does not contain valid image in "%s" format.'; - SMemoryNotValid = 'Memory %p (%d Bytes) does not contain valid image ' + - 'in "%s" format.'; - SErrorLoadingFile = 'Error while loading images from file "%s" (file format: %s).'; - SErrorLoadingStream = 'Error while loading images from stream %p (file format: %s).'; - SErrorLoadingMemory = 'Error while loading images from memory %p (%d Bytes) (file format: %s).'; - SErrorSavingFile = 'Error while saving images to file "%s" (file format: %s).'; - SErrorSavingStream = 'Error while saving images to stream %p (file format: %s).'; - SErrorSavingMemory = 'Error while saving images to memory %p (%d Bytes) (file format: %s).'; - SErrorFindColor = 'Error while finding color in palette @%p with %d entries.'; - SErrorGrayscalePalette = 'Error while filling grayscale palette @%p with %d entries.'; - SErrorCustomPalette = 'Error while filling custom palette @%p with %d entries.'; - SErrorSwapPalette = 'Error while swapping channels of palette @%p with %d entries.'; - SErrorReduceColors = 'Error while reducing number of colors of image to %d. %s'; - SErrorGenerateMipMaps = 'Error while generating %d mipmap levels for image %s'; - SImagesNotValid = 'One or more images are not valid.'; - SErrorCopyRect = 'Error while copying rect from image %s to image %s.'; - SErrorMapImage = 'Error while mapping image %s to palette.'; - SErrorFillRect = 'Error while filling rectangle X:%d Y:%d W:%d H:%d in image %s'; - SErrorSplitImage = 'Error while splitting image %s to %dx%d sized chunks.'; - SErrorMakePaletteForImages = 'Error while making %d color palette for %d images.'; - SErrorNewPalette = 'Error while creating new palette with %d entries'; - SErrorFreePalette = 'Error while freeing palette @%p'; - SErrorCopyPalette = 'Error while copying %d entries from palette @%p to @%p'; - SErrorReplaceColor = 'Error while replacing colors in rectangle X:%d Y:%d W:%d H:%d of image %s'; - SErrorRotateImage = 'Error while rotating image %s by %.2n degrees'; - SErrorStretchRect = 'Error while stretching rect from image %s to image %s.'; - SErrorEmptyStream = 'Input stream has no data. Check Position property.'; - SErrorInvalidInputImage = 'Invalid input image.'; - - SErrorBadImage = 'Bad image detected.'; - -const - // Initial size of array with options information - InitialOptions = 256; - // Max depth of the option stack - OptionStackDepth = 8; - // Do not change the default format now, its too late - DefaultImageFormat: TImageFormat = ifA8R8G8B8; - // Format used to create metadata IDs for frames loaded form multiimages. - SMetaIdForSubImage = '%s/%d'; - -type - TOptionArray = array of PLongInt; - TOptionValueArray = array of LongInt; - - TOptionStack = class(TObject) - private - FStack: array[0..OptionStackDepth - 1] of TOptionValueArray; - FPosition: LongInt; - public - constructor Create; - destructor Destroy; override; - function Push: Boolean; - function Pop: Boolean; - end; - -var - // Currently set IO functions - IO: TIOFunctions; - // List with all registered TImageFileFormat classes - ImageFileFormats: TList = nil; - // Aarray with registered options (pointers to their values) - Options: TOptionArray = nil; - // Array containing addional infomation about every image format - ImageFormatInfos: TImageFormatInfoArray; - // Stack used by PushOptions/PopOtions functions - OptionStack: TOptionStack = nil; -var - // Variable for ImagingColorReduction option - ColorReductionMask: LongInt = $FF; - // Variable for ImagingLoadOverrideFormat option - LoadOverrideFormat: TImageFormat = ifUnknown; - // Variable for ImagingSaveOverrideFormat option - SaveOverrideFormat: TImageFormat = ifUnknown; - // Variable for ImagingSaveOverrideFormat option - MipMapFilter: TSamplingFilter = sfLinear; - // Variable for ImagingBinaryTreshold option - BinaryTreshold: Integer = 128; - -{ Exceptions } - -constructor EImagingBadImage.Create; -begin - inherited Create(SErrorBadImage); -end; - -{ Internal unit functions } - -{ Modifies option value to be in the allowed range. Works only - for options registered in this unit.} -function CheckOptionValue(OptionId, Value: LongInt): LongInt; forward; -{ Sets IO functions to file IO.} -procedure SetFileIO; forward; -{ Sets IO functions to stream IO.} -procedure SetStreamIO; forward; -{ Sets IO functions to memory IO.} -procedure SetMemoryIO; forward; -{ Inits image format infos array.} -procedure InitImageFormats; forward; -{ Freew image format infos array.} -procedure FreeImageFileFormats; forward; -{ Creates options array and stack.} -procedure InitOptions; forward; -{ Frees options array and stack.} -procedure FreeOptions; forward; - -function UpdateExceptMessage(E: Exception; const MsgToPrepend: string; const Args: array of const): Exception; -begin - Result := E; - E.Message := Format(MsgToPrepend, Args) + ' ' + SExceptMsg + ': ' + E.Message -end; - -{ ------------------------------------------------------------------------ - Low Level Interface Functions - ------------------------------------------------------------------------} - -{ General Functions } - -procedure InitImage(var Image: TImageData); -begin - FillChar(Image, SizeOf(Image), 0); -end; - -function NewImage(Width, Height: LongInt; Format: TImageFormat; var Image: - TImageData): Boolean; -var - FInfo: PImageFormatInfo; -begin - Assert((Width > 0) and (Height >0)); - Assert(IsImageFormatValid(Format)); - Result := False; - FreeImage(Image); - try - Image.Width := Width; - Image.Height := Height; - // Select default data format if selected - if (Format = ifDefault) then - Image.Format := DefaultImageFormat - else - Image.Format := Format; - // Get extended format info - FInfo := ImageFormatInfos[Image.Format]; - if FInfo = nil then - begin - InitImage(Image); - Exit; - end; - // Check image dimensions and calculate its size in bytes - FInfo.CheckDimensions(FInfo.Format, Image.Width, Image.Height); - Image.Size := FInfo.GetPixelsSize(FInfo.Format, Image.Width, Image.Height); - if Image.Size = 0 then - begin - InitImage(Image); - Exit; - end; - // Image bits are allocated and set to zeroes - GetMem(Image.Bits, Image.Size); - FillChar(Image.Bits^, Image.Size, 0); - // Palette is allocated and set to zeroes - if FInfo.PaletteEntries > 0 then - begin - GetMem(Image.Palette, FInfo.PaletteEntries * SizeOf(TColor32Rec)); - FillChar(Image.Palette^, FInfo.PaletteEntries * SizeOf(TColor32Rec), 0); - end; - Result := TestImage(Image); - except - on E: Exception do - begin - FreeMem(Image.Bits); - FreeMem(Image.Palette); - InitImage(Image); - raise UpdateExceptMessage(E, SErrorNewImage, [Width, Height, GetFormatName(Format)]); - end; - end; -end; - -function TestImage(const Image: TImageData): Boolean; -begin - try - Result := (LongInt(Image.Format) >= LongInt(Low(TImageFormat))) and - (LongInt(Image.Format) <= LongInt(High(TImageFormat))) and - (ImageFormatInfos[Image.Format] <> nil) and - (Assigned(ImageFormatInfos[Image.Format].GetPixelsSize) and - (ImageFormatInfos[Image.Format].GetPixelsSize(Image.Format, - Image.Width, Image.Height) = Image.Size)); - except - // Possible int overflows or other errors - Result := False; - end; -end; - -procedure FreeImage(var Image: TImageData); -begin - try - if TestImage(Image) then - begin - FreeMemNil(Image.Bits); - FreeMemNil(Image.Palette); - end; - InitImage(Image); - except - raise UpdateExceptMessage(GetExceptObject, SErrorFreeImage, [ImageToStr(Image)]); - end; -end; - -procedure FreeImagesInArray(var Images: TDynImageDataArray); -var - I: LongInt; -begin - if Length(Images) > 0 then - begin - for I := 0 to Length(Images) - 1 do - FreeImage(Images[I]); - SetLength(Images, 0); - end; -end; - -function TestImagesInArray(const Images: TDynImageDataArray): Boolean; -var - I: LongInt; -begin - if Length(Images) > 0 then - begin - Result := True; - for I := 0 to Length(Images) - 1 do - begin - Result := Result and TestImage(Images[I]); - if not Result then - Break; - end; - end - else - Result := False; -end; - -function DetermineFileFormat(const FileName: string): string; -var - I: LongInt; - Fmt: TImageFileFormat; - Handle: TImagingHandle; -begin - Assert(FileName <> ''); - Result := ''; - SetFileIO; - Handle := IO.Open(PChar(FileName), omReadOnly); - try - // First file format according to FileName and test if the data in - // file is really in that format - for I := 0 to ImageFileFormats.Count - 1 do - begin - Fmt := TImageFileFormat(ImageFileFormats[I]); - if Fmt.TestFileName(FileName) and Fmt.TestFormat(Handle) then - begin - Result := Fmt.Extensions[0]; - Exit; - end; - end; - // No file format was found with filename search so try data-based search - for I := 0 to ImageFileFormats.Count - 1 do - begin - Fmt := TImageFileFormat(ImageFileFormats[I]); - if Fmt.TestFormat(Handle) then - begin - Result := Fmt.Extensions[0]; - Exit; - end; - end; - finally - IO.Close(Handle); - end; -end; - -function DetermineStreamFormat(Stream: TStream): string; -var - I: LongInt; - Fmt: TImageFileFormat; - Handle: TImagingHandle; -begin - Assert(Stream <> nil); - Result := ''; - SetStreamIO; - Handle := IO.Open(Pointer(Stream), omReadOnly); - try - for I := 0 to ImageFileFormats.Count - 1 do - begin - Fmt := TImageFileFormat(ImageFileFormats[I]); - if Fmt.TestFormat(Handle) then - begin - Result := Fmt.Extensions[0]; - Exit; - end; - end; - finally - IO.Close(Handle); - end; -end; - -function DetermineMemoryFormat(Data: Pointer; Size: LongInt): string; -var - I: LongInt; - Fmt: TImageFileFormat; - Handle: TImagingHandle; - IORec: TMemoryIORec; -begin - Assert((Data <> nil) and (Size > 0)); - Result := ''; - SetMemoryIO; - IORec.Data := Data; - IORec.Position := 0; - IORec.Size := Size; - Handle := IO.Open(@IORec, omReadOnly); - try - for I := 0 to ImageFileFormats.Count - 1 do - begin - Fmt := TImageFileFormat(ImageFileFormats[I]); - if Fmt.TestFormat(Handle) then - begin - Result := Fmt.Extensions[0]; - Exit; - end; - end; - finally - IO.Close(Handle); - end; -end; - -function IsFileFormatSupported(const FileName: string): Boolean; -begin - Result := FindImageFileFormatByName(FileName) <> nil; -end; - -function EnumFileFormats(var Index: LongInt; var Name, DefaultExt, Masks: string; - var CanSaveImages, IsMultiImageFormat: Boolean): Boolean; -var - FileFmt: TImageFileFormat; -begin - FileFmt := GetFileFormatAtIndex(Index); - Result := FileFmt <> nil; - if Result then - begin - Name := FileFmt.Name; - DefaultExt := FileFmt.Extensions[0]; - Masks := FileFmt.Masks.DelimitedText; - CanSaveImages := FileFmt.CanSave; - IsMultiImageFormat := FileFmt.IsMultiImageFormat; - Inc(Index); - end - else - begin - Name := ''; - DefaultExt := ''; - Masks := ''; - CanSaveImages := False; - IsMultiImageFormat := False; - end; -end; - -{ Loading Functions } - -function LoadImageFromFile(const FileName: string; var Image: TImageData): - Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; - I: LongInt; -begin - Assert(FileName <> ''); - Result := False; - Format := FindImageFileFormatByExt(DetermineFileFormat(FileName)); - if Format <> nil then - begin - FreeImage(Image); - Result := Format.LoadFromFile(FileName, IArray, True); - if Result and (Length(IArray) > 0) then - begin - Image := IArray[0]; - for I := 1 to Length(IArray) - 1 do - FreeImage(IArray[I]); - end - else - Result := False; - end; -end; - -function LoadImageFromStream(Stream: TStream; var Image: TImageData): Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; - I: LongInt; -begin - Assert(Stream <> nil); - if Stream.Size - Stream.Position = 0 then - RaiseImaging(SErrorEmptyStream, []); - Result := False; - Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream)); - if Format <> nil then - begin - FreeImage(Image); - Result := Format.LoadFromStream(Stream, IArray, True); - if Result and (Length(IArray) > 0) then - begin - Image := IArray[0]; - for I := 1 to Length(IArray) - 1 do - FreeImage(IArray[I]); - end - else - Result := False; - end; -end; - -function LoadImageFromMemory(Data: Pointer; Size: LongInt; var Image: TImageData): Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; - I: LongInt; -begin - Assert((Data <> nil) and (Size > 0)); - Result := False; - Format := FindImageFileFormatByExt(DetermineMemoryFormat(Data, Size)); - if Format <> nil then - begin - FreeImage(Image); - Result := Format.LoadFromMemory(Data, Size, IArray, True); - if Result and (Length(IArray) > 0) then - begin - Image := IArray[0]; - for I := 1 to Length(IArray) - 1 do - FreeImage(IArray[I]); - end - else - Result := False; - end; -end; - -function LoadMultiImageFromFile(const FileName: string; var Images: - TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert(FileName <> ''); - Result := False; - Format := FindImageFileFormatByExt(DetermineFileFormat(FileName)); - if Format <> nil then - begin - FreeImagesInArray(Images); - Result := Format.LoadFromFile(FileName, Images); - end; -end; - -function LoadMultiImageFromStream(Stream: TStream; var Images: TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert(Stream <> nil); - if Stream.Size - Stream.Position = 0 then - RaiseImaging(SErrorEmptyStream, []); - Result := False; - Format := FindImageFileFormatByExt(DetermineStreamFormat(Stream)); - if Format <> nil then - begin - FreeImagesInArray(Images); - Result := Format.LoadFromStream(Stream, Images); - end; -end; - -function LoadMultiImageFromMemory(Data: Pointer; Size: LongInt; - var Images: TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert((Data <> nil) and (Size > 0)); - Result := False; - Format := FindImageFileFormatByExt(DetermineMemoryFormat(Data, Size)); - if Format <> nil then - begin - FreeImagesInArray(Images); - Result := Format.LoadFromMemory(Data, Size, Images); - end; -end; - -{ Saving Functions } - -function SaveImageToFile(const FileName: string; const Image: TImageData): Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; -begin - Assert(FileName <> ''); - Result := False; - Format := FindImageFileFormatByName(FileName); - if Format <> nil then - begin - SetLength(IArray, 1); - IArray[0] := Image; - Result := Format.SaveToFile(FileName, IArray, True); - end; -end; - -function SaveImageToStream(const Ext: string; Stream: TStream; - const Image: TImageData): Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; -begin - Assert((Ext <> '') and (Stream <> nil)); - Result := False; - Format := FindImageFileFormatByExt(Ext); - if Format <> nil then - begin - SetLength(IArray, 1); - IArray[0] := Image; - Result := Format.SaveToStream(Stream, IArray, True); - end; -end; - -function SaveImageToMemory(const Ext: string; Data: Pointer; var Size: LongInt; - const Image: TImageData): Boolean; -var - Format: TImageFileFormat; - IArray: TDynImageDataArray; -begin - Assert((Ext <> '') and (Data <> nil) and (Size > 0)); - Result := False; - Format := FindImageFileFormatByExt(Ext); - if Format <> nil then - begin - SetLength(IArray, 1); - IArray[0] := Image; - Result := Format.SaveToMemory(Data, Size, IArray, True); - end; -end; - -function SaveMultiImageToFile(const FileName: string; - const Images: TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert(FileName <> ''); - Result := False; - Format := FindImageFileFormatByName(FileName); - if Format <> nil then - Result := Format.SaveToFile(FileName, Images); -end; - -function SaveMultiImageToStream(const Ext: string; Stream: TStream; - const Images: TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert((Ext <> '') and (Stream <> nil)); - Result := False; - Format := FindImageFileFormatByExt(Ext); - if Format <> nil then - Result := Format.SaveToStream(Stream, Images); -end; - -function SaveMultiImageToMemory(const Ext: string; Data: Pointer; - var Size: LongInt; const Images: TDynImageDataArray): Boolean; -var - Format: TImageFileFormat; -begin - Assert((Ext <> '') and (Data <> nil) and (Size > 0)); - Result := False; - Format := FindImageFileFormatByExt(Ext); - if Format <> nil then - Result := Format.SaveToMemory(Data, Size, Images); -end; - -{ Manipulation Functions } - -function CloneImage(const Image: TImageData; var Clone: TImageData): Boolean; -var - Info: PImageFormatInfo; -begin - Result := False; - if TestImage(Image) then - try - if TestImage(Clone) and (Image.Bits <> Clone.Bits) then - FreeImage(Clone) - else - InitImage(Clone); - - Info := ImageFormatInfos[Image.Format]; - Clone.Width := Image.Width; - Clone.Height := Image.Height; - Clone.Format := Image.Format; - Clone.Size := Image.Size; - - if Info.PaletteEntries > 0 then - begin - GetMem(Clone.Palette, Info.PaletteEntries * SizeOf(TColor32Rec)); - Move(Image.Palette^, Clone.Palette^, Info.PaletteEntries * - SizeOf(TColor32Rec)); - end; - - GetMem(Clone.Bits, Clone.Size); - Move(Image.Bits^, Clone.Bits^, Clone.Size); - Result := True; - except - raise UpdateExceptMessage(GetExceptObject, SErrorCloneImage, [ImageToStr(Image)]); - end; -end; - -function ConvertImage(var Image: TImageData; DestFormat: TImageFormat): Boolean; -var - NewData: Pointer; - NewPal: PPalette32; - NewSize, NumPixels: LongInt; - SrcInfo, DstInfo: PImageFormatInfo; -begin - Assert(IsImageFormatValid(DestFormat)); - Result := False; - if TestImage(Image) then - with Image do - try - // If default format is set we use DefaultImageFormat - if DestFormat = ifDefault then - DestFormat := DefaultImageFormat; - SrcInfo := ImageFormatInfos[Format]; - DstInfo := ImageFormatInfos[DestFormat]; - if SrcInfo = DstInfo then - begin - // There is nothing to convert - src is alredy in dest format - Result := True; - Exit; - end; - // Exit Src or Dest format is invalid - if (SrcInfo = nil) or (DstInfo = nil) then Exit; - // If dest format is just src with swapped channels we call - // SwapChannels instead - if (SrcInfo.RBSwapFormat = DestFormat) and - (DstInfo.RBSwapFormat = SrcInfo.Format) then - begin - Result := SwapChannels(Image, ChannelRed, ChannelBlue); - Image.Format := SrcInfo.RBSwapFormat; - Exit; - end; - - if (not SrcInfo.IsSpecial) and (not DstInfo.IsSpecial) then - begin - NumPixels := Width * Height; - NewSize := NumPixels * DstInfo.BytesPerPixel; - GetMem(NewData, NewSize); - FillChar(NewData^, NewSize, 0); - GetMem(NewPal, DstInfo.PaletteEntries * SizeOf(TColor32Rec)); - FillChar(NewPal^, DstInfo.PaletteEntries * SizeOf(TColor32Rec), 0); - - if SrcInfo.IsIndexed then - begin - // Source: indexed format - if DstInfo.IsIndexed then - IndexToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette, NewPal) - else if DstInfo.HasGrayChannel then - IndexToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette) - else if DstInfo.IsFloatingPoint then - IndexToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette) - else - IndexToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo, Palette); - end - else if SrcInfo.HasGrayChannel then - begin - // Source: grayscale format - if DstInfo.IsIndexed then - GrayToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal) - else if DstInfo.HasGrayChannel then - GrayToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else if DstInfo.IsFloatingPoint then - GrayToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else - GrayToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo); - end - else if SrcInfo.IsFloatingPoint then - begin - // Source: floating point format - if DstInfo.IsIndexed then - FloatToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal) - else if DstInfo.HasGrayChannel then - FloatToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else if DstInfo.IsFloatingPoint then - FloatToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else - FloatToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo); - end - else - begin - // Source: standard multi channel image - if DstInfo.IsIndexed then - ChannelToIndex(NumPixels, Bits, NewData, SrcInfo, DstInfo, NewPal) - else if DstInfo.HasGrayChannel then - ChannelToGray(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else if DstInfo.IsFloatingPoint then - ChannelToFloat(NumPixels, Bits, NewData, SrcInfo, DstInfo) - else - ChannelToChannel(NumPixels, Bits, NewData, SrcInfo, DstInfo); - end; - - FreeMemNil(Bits); - FreeMemNil(Palette); - Format := DestFormat; - Bits := NewData; - Size := NewSize; - Palette := NewPal; - end - else - ConvertSpecial(Image, SrcInfo, DstInfo); - - Assert(SrcInfo.Format <> Image.Format); - - Result := True; - except - raise UpdateExceptMessage(GetExceptObject, SErrorConvertImage, [GetFormatName(DestFormat), ImageToStr(Image)]); - end; -end; - -function FlipImage(var Image: TImageData): Boolean; -var - P1, P2, Buff: Pointer; - WidthBytes, I: LongInt; - OldFmt: TImageFormat; -begin - Result := False; - OldFmt := Image.Format; - if TestImage(Image) then - with Image do - try - if ImageFormatInfos[OldFmt].IsSpecial then - ConvertImage(Image, ifDefault); - - WidthBytes := Width * ImageFormatInfos[Format].BytesPerPixel; - GetMem(Buff, WidthBytes); - try - // Swap all scanlines of image - for I := 0 to Height div 2 - 1 do - begin - P1 := @PByteArray(Bits)[I * WidthBytes]; - P2 := @PByteArray(Bits)[(Height - I - 1) * WidthBytes]; - Move(P1^, Buff^, WidthBytes); - Move(P2^, P1^, WidthBytes); - Move(Buff^, P2^, WidthBytes); - end; - finally - FreeMemNil(Buff); - end; - - if OldFmt <> Format then - ConvertImage(Image, OldFmt); - - Result := True; - except - RaiseImaging(SErrorFlipImage, [ImageToStr(Image)]); - end; -end; - -function MirrorImage(var Image: TImageData): Boolean; -var - Scanline: PByte; - Buff: TColorFPRec; - Bpp, Y, X, WidthDiv2, WidthBytes, XLeft, XRight: LongInt; - OldFmt: TImageFormat; -begin - Result := False; - OldFmt := Image.Format; - if TestImage(Image) then - with Image do - try - if ImageFormatInfos[OldFmt].IsSpecial then - ConvertImage(Image, ifDefault); - - Bpp := ImageFormatInfos[Format].BytesPerPixel; - WidthDiv2 := Width div 2; - WidthBytes := Width * Bpp; - // Mirror all pixels on each scanline of image - for Y := 0 to Height - 1 do - begin - Scanline := @PByteArray(Bits)[Y * WidthBytes]; - XLeft := 0; - XRight := (Width - 1) * Bpp; - for X := 0 to WidthDiv2 - 1 do - begin - CopyPixel(@PByteArray(Scanline)[XLeft], @Buff, Bpp); - CopyPixel(@PByteArray(Scanline)[XRight], - @PByteArray(Scanline)[XLeft], Bpp); - CopyPixel(@Buff, @PByteArray(Scanline)[XRight], Bpp); - Inc(XLeft, Bpp); - Dec(XRight, Bpp); - end; - end; - - if OldFmt <> Format then - ConvertImage(Image, OldFmt); - - Result := True; - except - RaiseImaging(SErrorMirrorImage, [ImageToStr(Image)]); - end; -end; - -function ResizeImage(var Image: TImageData; NewWidth, NewHeight: LongInt; - Filter: TResizeFilter): Boolean; -var - WorkImage: TImageData; -begin - Assert((NewWidth > 0) and (NewHeight > 0), 'New width or height is zero.'); - Result := False; - if TestImage(Image) and ((Image.Width <> NewWidth) or (Image.Height <> NewHeight)) then - try - InitImage(WorkImage); - // Create new image with desired dimensions - NewImage(NewWidth, NewHeight, Image.Format, WorkImage); - // Stretch pixels from old image to new one - StretchRect(Image, 0, 0, Image.Width, Image.Height, - WorkImage, 0, 0, WorkImage.Width, WorkImage.Height, Filter); - // Free old image and assign new image to it - FreeMemNil(Image.Bits); - if Image.Palette <> nil then - begin - FreeMem(WorkImage.Palette); - WorkImage.Palette := Image.Palette; - end; - Image := WorkImage; - Result := True; - except - raise UpdateExceptMessage(GetExceptObject, SErrorResizeImage, [ImageToStr(Image)]); - end; -end; - -function SwapChannels(var Image: TImageData; SrcChannel, DstChannel: LongInt): Boolean; -var - I, NumPixels: LongInt; - Info: PImageFormatInfo; - Swap, Alpha: Word; - Data: PByte; - Pix64: TColor64Rec; - PixF: TColorFPRec; - SwapF: Single; -begin - Assert((SrcChannel in [0..3]) and (DstChannel in [0..3])); - Result := False; - if TestImage(Image) and (SrcChannel <> DstChannel) then - with Image do - try - NumPixels := Width * Height; - Info := ImageFormatInfos[Format]; - Data := Bits; - - if (Info.Format = ifR8G8B8) or ((Info.Format = ifA8R8G8B8) and - (SrcChannel <> ChannelAlpha) and (DstChannel <> ChannelAlpha)) then - begin - // Swap channels of most common formats R8G8B8 and A8R8G8B8 (no alpha) - for I := 0 to NumPixels - 1 do - with PColor24Rec(Data)^ do - begin - Swap := Channels[SrcChannel]; - Channels[SrcChannel] := Channels[DstChannel]; - Channels[DstChannel] := Swap; - Inc(Data, Info.BytesPerPixel); - end; - end - else if Info.IsIndexed then - begin - // Swap palette channels of indexed images - SwapChannelsOfPalette(Palette, Info.PaletteEntries, SrcChannel, DstChannel) - end - else if Info.IsFloatingPoint then - begin - // Swap channels of floating point images - for I := 0 to NumPixels - 1 do - begin - FloatGetSrcPixel(Data, Info, PixF); - with PixF do - begin - SwapF := Channels[SrcChannel]; - Channels[SrcChannel] := Channels[DstChannel]; - Channels[DstChannel] := SwapF; - end; - FloatSetDstPixel(Data, Info, PixF); - Inc(Data, Info.BytesPerPixel); - end; - end - else if Info.IsSpecial then - begin - // Swap channels of special format images - ConvertImage(Image, ifDefault); - SwapChannels(Image, SrcChannel, DstChannel); - ConvertImage(Image, Info.Format); - end - else if Info.HasGrayChannel and Info.HasAlphaChannel and - ((SrcChannel = ChannelAlpha) or (DstChannel = ChannelAlpha)) then - begin - for I := 0 to NumPixels - 1 do - begin - // If we have grayscale image with alpha and alpha is channel - // to be swapped, we swap it. No other alternative for gray images, - // just alpha and something - GrayGetSrcPixel(Data, Info, Pix64, Alpha); - Swap := Alpha; - Alpha := Pix64.A; - Pix64.A := Swap; - GraySetDstPixel(Data, Info, Pix64, Alpha); - Inc(Data, Info.BytesPerPixel); - end; - end - else - begin - // Then do general swap on other channel image formats - for I := 0 to NumPixels - 1 do - begin - ChannelGetSrcPixel(Data, Info, Pix64); - with Pix64 do - begin - Swap := Channels[SrcChannel]; - Channels[SrcChannel] := Channels[DstChannel]; - Channels[DstChannel] := Swap; - end; - ChannelSetDstPixel(Data, Info, Pix64); - Inc(Data, Info.BytesPerPixel); - end; - end; - - Result := True; - except - RaiseImaging(SErrorSwapImage, [ImageToStr(Image)]); - end; -end; - -function ReduceColors(var Image: TImageData; MaxColors: LongInt): Boolean; -var - TmpInfo: TImageFormatInfo; - Data, Index: PWord; - I, NumPixels: LongInt; - Pal: PPalette32; - Col:PColor32Rec; - OldFmt: TImageFormat; -begin - Result := False; - if TestImage(Image) then - with Image do - try - // First create temp image info and allocate output bits and palette - MaxColors := ClampInt(MaxColors, 2, High(Word)); - OldFmt := Format; - FillChar(TmpInfo, SizeOf(TmpInfo), 0); - TmpInfo.PaletteEntries := MaxColors; - TmpInfo.BytesPerPixel := 2; - NumPixels := Width * Height; - GetMem(Data, NumPixels * TmpInfo.BytesPerPixel); - GetMem(Pal, MaxColors * SizeOf(TColor32Rec)); - ConvertImage(Image, ifA8R8G8B8); - // We use median cut algorithm to create reduced palette and to - // fill Data with indices to this palette - ReduceColorsMedianCut(NumPixels, Bits, PByte(Data), - ImageFormatInfos[Format], @TmpInfo, MaxColors, ColorReductionMask, Pal); - Col := Bits; - Index := Data; - // Then we write reduced colors to the input image - for I := 0 to NumPixels - 1 do - begin - Col.Color := Pal[Index^].Color; - Inc(Col); - Inc(Index); - end; - FreeMemNil(Data); - FreeMemNil(Pal); - // And convert it to its original format - ConvertImage(Image, OldFmt); - Result := True; - except - RaiseImaging(SErrorReduceColors, [MaxColors, ImageToStr(Image)]); - end; -end; - -function GenerateMipMaps(const Image: TImageData; Levels: LongInt; - var MipMaps: TDynImageDataArray): Boolean; -var - Width, Height, I, Count: LongInt; - Info: TImageFormatInfo; - CompatibleCopy: TImageData; -begin - Result := False; - if TestImage(Image) then - try - Width := Image.Width; - Height := Image.Height; - // We compute number of possible mipmap levels and if - // the given levels are invalid or zero we use this value - Count := GetNumMipMapLevels(Width, Height); - if (Levels <= 0) or (Levels > Count) then - Levels := Count; - - // If we have special format image we create copy to allow pixel access. - // This is also done in FillMipMapLevel which is called for each level - // but then the main big image would be converted to compatible - // for every level. - GetImageFormatInfo(Image.Format, Info); - if Info.IsSpecial then - begin - InitImage(CompatibleCopy); - CloneImage(Image, CompatibleCopy); - ConvertImage(CompatibleCopy, ifDefault); - end - else - CompatibleCopy := Image; - - FreeImagesInArray(MipMaps); - SetLength(MipMaps, Levels); - CloneImage(Image, MipMaps[0]); - - for I := 1 to Levels - 1 do - begin - Width := Width shr 1; - Height := Height shr 1; - if Width < 1 then Width := 1; - if Height < 1 then Height := 1; - FillMipMapLevel(CompatibleCopy, Width, Height, MipMaps[I]); - end; - - if CompatibleCopy.Format <> MipMaps[0].Format then - begin - // Must convert smaller levels to proper format - for I := 1 to High(MipMaps) do - ConvertImage(MipMaps[I], MipMaps[0].Format); - FreeImage(CompatibleCopy); - end; - - Result := True; - except - RaiseImaging(SErrorGenerateMipMaps, [Levels, ImageToStr(Image)]); - end; -end; - -function MapImageToPalette(var Image: TImageData; Pal: PPalette32; - Entries: LongInt): Boolean; - - function FindNearestColor(Pal: PPalette32; Entries: LongInt; Col: TColor32Rec): LongInt; - var - I, MinDif, Dif: LongInt; - begin - Result := 0; - MinDif := 1020; - for I := 0 to Entries - 1 do - with Pal[I] do - begin - Dif := Abs(R - Col.R); - if Dif > MinDif then Continue; - Dif := Dif + Abs(G - Col.G); - if Dif > MinDif then Continue; - Dif := Dif + Abs(B - Col.B); - if Dif > MinDif then Continue; - Dif := Dif + Abs(A - Col.A); - if Dif < MinDif then - begin - MinDif := Dif; - Result := I; - end; - end; - end; - -var - I, MaxEntries: LongInt; - PIndex: PByte; - PColor: PColor32Rec; - CloneARGB: TImageData; - Info: PImageFormatInfo; -begin - Assert((Entries >= 2) and (Entries <= 256)); - Result := False; - - if TestImage(Image) then - try - // We create clone of source image in A8R8G8B8 and - // then recreate source image in ifIndex8 format - // with palette taken from Pal parameter - InitImage(CloneARGB); - CloneImage(Image, CloneARGB); - ConvertImage(CloneARGB, ifA8R8G8B8); - FreeImage(Image); - NewImage(CloneARGB.Width, CloneARGB.Height, ifIndex8, Image); - - Info := ImageFormatInfos[Image.Format]; - MaxEntries := Min(Info.PaletteEntries, Entries); - Move(Pal^, Image.Palette^, MaxEntries * SizeOf(TColor32Rec)); - PIndex := Image.Bits; - PColor := CloneARGB.Bits; - - // For every pixel of ARGB clone we find closest color in - // given palette and assign its index to resulting image's pixel - // procedure used here is very slow but simple and memory usage friendly - // (contrary to other methods) - for I := 0 to Image.Width * Image.Height - 1 do - begin - PIndex^ := Byte(FindNearestColor(Image.Palette, MaxEntries, PColor^)); - Inc(PIndex); - Inc(PColor); - end; - - FreeImage(CloneARGB); - Result := True; - except - raise UpdateExceptMessage(GetExceptObject, SErrorMapImage, [ImageToStr(Image)]); - end; -end; - -function SplitImage(var Image: TImageData; var Chunks: TDynImageDataArray; - ChunkWidth, ChunkHeight: LongInt; var XChunks, YChunks: LongInt; - PreserveSize: Boolean; Fill: Pointer): Boolean; -var - X, Y, XTrunc, YTrunc: LongInt; - NotOnEdge: Boolean; - Info: PImageFormatInfo; - OldFmt: TImageFormat; -begin - Assert((ChunkWidth > 0) and (ChunkHeight > 0)); - Result := False; - OldFmt := Image.Format; - FreeImagesInArray(Chunks); - - if TestImage(Image) then - try - Info := ImageFormatInfos[Image.Format]; - if Info.IsSpecial then - ConvertImage(Image, ifDefault); - - // We compute make sure that chunks are not larger than source image or negative - ChunkWidth := ClampInt(ChunkWidth, 0, Image.Width); - ChunkHeight := ClampInt(ChunkHeight, 0, Image.Height); - // Number of chunks along X and Y axes is computed - XChunks := Trunc(Ceil(Image.Width / ChunkWidth)); - YChunks := Trunc(Ceil(Image.Height / ChunkHeight)); - SetLength(Chunks, XChunks * YChunks); - - // For every chunk we create new image and copy a portion of - // the source image to it. If chunk is on the edge of the source image - // we fill enpty space with Fill pixel data if PreserveSize is set or - // make the chunk smaller if it is not set - for Y := 0 to YChunks - 1 do - for X := 0 to XChunks - 1 do - begin - // Determine if current chunk is on the edge of original image - NotOnEdge := ((X < XChunks - 1) and (Y < YChunks - 1)) or - ((Image.Width mod ChunkWidth = 0) and (Image.Height mod ChunkHeight = 0)); - - if PreserveSize or NotOnEdge then - begin - // We should preserve chunk sizes or we are somewhere inside original image - NewImage(ChunkWidth, ChunkHeight, Image.Format, Chunks[Y * XChunks + X]); - if (not NotOnEdge) and (Fill <> nil) then - FillRect(Chunks[Y * XChunks + X], 0, 0, ChunkWidth, ChunkHeight, Fill); - CopyRect(Image, X * ChunkWidth, Y * ChunkHeight, ChunkWidth, ChunkHeight, - Chunks[Y * XChunks + X], 0, 0); - end - else - begin - // Create smaller edge chunk - XTrunc := Image.Width - X * ChunkWidth; - YTrunc := Image.Height - Y * ChunkHeight; - NewImage(XTrunc, YTrunc, Image.Format, Chunks[Y * XChunks + X]); - CopyRect(Image, X * ChunkWidth, Y * ChunkHeight, XTrunc, YTrunc, - Chunks[Y * XChunks + X], 0, 0); - end; - - // If source image is in indexed format we copy its palette to chunk - if Info.IsIndexed then - begin - Move(Image.Palette^, Chunks[Y * XChunks + X].Palette^, - Info.PaletteEntries * SizeOf(TColor32Rec)); - end; - end; - - if OldFmt <> Image.Format then - begin - ConvertImage(Image, OldFmt); - for X := 0 to Length(Chunks) - 1 do - ConvertImage(Chunks[X], OldFmt); - end; - - Result := True; - except - raise UpdateExceptMessage(GetExceptObject, SErrorSplitImage, - [ImageToStr(Image), ChunkWidth, ChunkHeight]); - end; -end; - -function MakePaletteForImages(var Images: TDynImageDataArray; Pal: PPalette32; - MaxColors: LongInt; ConvertImages: Boolean): Boolean; -var - I: Integer; - SrcInfo, DstInfo: PImageFormatInfo; - Target, TempImage: TImageData; - DstFormat: TImageFormat; -begin - Assert((Pal <> nil) and (MaxColors > 0)); - Result := False; - InitImage(TempImage); - - if TestImagesInArray(Images) then - try - // Null the color histogram - ReduceColorsMedianCut(0, nil, nil, nil, nil, 0, 0, nil, [raCreateHistogram]); - for I := 0 to Length(Images) - 1 do - begin - SrcInfo := ImageFormatInfos[Images[I].Format]; - if SrcInfo.IsIndexed or SrcInfo.IsSpecial then - begin - // create temp image in supported format for updating histogram - CloneImage(Images[I], TempImage); - ConvertImage(TempImage, ifA8R8G8B8); - SrcInfo := ImageFormatInfos[TempImage.Format]; - end - else - TempImage := Images[I]; - - // Update histogram with colors of each input image - ReduceColorsMedianCut(TempImage.Width * TempImage.Height, TempImage.Bits, - nil, SrcInfo, nil, MaxColors, ColorReductionMask, nil, [raUpdateHistogram]); - - if Images[I].Bits <> TempImage.Bits then - FreeImage(TempImage); - end; - // Construct reduced color map from the histogram - ReduceColorsMedianCut(0, nil, nil, nil, nil, MaxColors, ColorReductionMask, - Pal, [raMakeColorMap]); - - if ConvertImages then - begin - DstFormat := ifIndex8; - DstInfo := ImageFormatInfos[DstFormat]; - MaxColors := Min(DstInfo.PaletteEntries, MaxColors); - - for I := 0 to Length(Images) - 1 do - begin - SrcInfo := ImageFormatInfos[Images[I].Format]; - if SrcInfo.IsIndexed or SrcInfo.IsSpecial then - begin - // If source image is in format not supported by ReduceColorsMedianCut - // we convert it - ConvertImage(Images[I], ifA8R8G8B8); - SrcInfo := ImageFormatInfos[Images[I].Format]; - end; - - InitImage(Target); - NewImage(Images[I].Width, Images[I].Height, DstFormat, Target); - // We map each input image to reduced palette and replace - // image in array with mapped image - ReduceColorsMedianCut(Images[I].Width * Images[I].Height, Images[I].Bits, - Target.Bits, SrcInfo, DstInfo, MaxColors, 0, nil, [raMapImage]); - Move(Pal^, Target.Palette^, MaxColors * SizeOf(TColor32Rec)); - - FreeImage(Images[I]); - Images[I] := Target; - end; - end; - Result := True; - except - RaiseImaging(SErrorMakePaletteForImages, [MaxColors, Length(Images)]); - end; -end; - -procedure RotateImage(var Image: TImageData; Angle: Single); -var - OldFmt: TImageFormat; - - procedure XShear(var Src, Dst: TImageData; Row, Offset, Weight, Bpp: Integer); - var - I, J, XPos: Integer; - PixSrc, PixLeft, PixOldLeft: TColor32Rec; - LineDst: PByteArray; - SrcPtr: PColor32; - begin - SrcPtr := @PByteArray(Src.Bits)[Row * Src.Width * Bpp]; - LineDst := @PByteArray(Dst.Bits)[Row * Dst.Width * Bpp]; - PixOldLeft.Color := 0; - - for I := 0 to Src.Width - 1 do - begin - CopyPixel(SrcPtr, @PixSrc, Bpp); - for J := 0 to Bpp - 1 do - PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256); - - XPos := I + Offset; - if (XPos >= 0) and (XPos < Dst.Width) then - begin - for J := 0 to Bpp - 1 do - PixSrc.Channels[J] := ClampToByte(PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J])); - CopyPixel(@PixSrc, @LineDst[XPos * Bpp], Bpp); - end; - PixOldLeft := PixLeft; - Inc(PByte(SrcPtr), Bpp); - end; - - XPos := Src.Width + Offset; - if XPos < Dst.Width then - CopyPixel(@PixOldLeft, @LineDst[XPos * Bpp], Bpp); - end; - - procedure YShear(var Src, Dst: TImageData; Col, Offset, Weight, Bpp: Integer); - var - I, J, YPos: Integer; - PixSrc, PixLeft, PixOldLeft: TColor32Rec; - SrcPtr: PByte; - begin - SrcPtr := @PByteArray(Src.Bits)[Col * Bpp]; - PixOldLeft.Color := 0; - - for I := 0 to Src.Height - 1 do - begin - CopyPixel(SrcPtr, @PixSrc, Bpp); - for J := 0 to Bpp - 1 do - PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256); - - YPos := I + Offset; - if (YPos >= 0) and (YPos < Dst.Height) then - begin - for J := 0 to Bpp - 1 do - PixSrc.Channels[J] := ClampToByte(PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J])); - CopyPixel(@PixSrc, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp); - end; - PixOldLeft := PixLeft; - Inc(SrcPtr, Src.Width * Bpp); - end; - - YPos := Src.Height + Offset; - if YPos < Dst.Height then - CopyPixel(@PixOldLeft, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp); - end; - - procedure Rotate45(var Image: TImageData; Angle: Single); - var - TempImage1, TempImage2: TImageData; - AngleRad, AngleTan, AngleSin, AngleCos, Shear: Single; - I, DstWidth, DstHeight, SrcWidth, SrcHeight, Bpp: Integer; - SrcFmt, TempFormat: TImageFormat; - Info: TImageFormatInfo; - begin - AngleRad := Angle * Pi / 180; - AngleSin := Sin(AngleRad); - AngleCos := Cos(AngleRad); - AngleTan := Sin(AngleRad / 2) / Cos(AngleRad / 2); - SrcWidth := Image.Width; - SrcHeight := Image.Height; - SrcFmt := Image.Format; - - if not (SrcFmt in [ifR8G8B8..ifX8R8G8B8, ifGray8..ifGray32, ifA16Gray16]) then - ConvertImage(Image, ifA8R8G8B8); - - TempFormat := Image.Format; - GetImageFormatInfo(TempFormat, Info); - Bpp := Info.BytesPerPixel; - - // 1st shear (horizontal) - DstWidth := Trunc(SrcWidth + SrcHeight * Abs(AngleTan) + 0.5); - DstHeight := SrcHeight; - InitImage(TempImage1); - NewImage(DstWidth, DstHeight, TempFormat, TempImage1); - - for I := 0 to DstHeight - 1 do - begin - if AngleTan >= 0 then - Shear := (I + 0.5) * AngleTan - else - Shear := (I - DstHeight + 0.5) * AngleTan; - XShear(Image, TempImage1, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); - end; - - // 2nd shear (vertical) - FreeImage(Image); - DstHeight := Trunc(SrcWidth * Abs(AngleSin) + SrcHeight * AngleCos + 0.5) + 1; - InitImage(TempImage2); - NewImage(DstWidth, DstHeight, TempFormat, TempImage2); - - if AngleSin >= 0 then - Shear := (SrcWidth - 1) * AngleSin - else - Shear := (SrcWidth - DstWidth) * -AngleSin; - - for I := 0 to DstWidth - 1 do - begin - YShear(TempImage1, TempImage2, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); - Shear := Shear - AngleSin; - end; - - // 3rd shear (horizontal) - FreeImage(TempImage1); - DstWidth := Trunc(SrcHeight * Abs(AngleSin) + SrcWidth * AngleCos + 0.5) + 1; - NewImage(DstWidth, DstHeight, TempFormat, Image); - - if AngleSin >= 0 then - Shear := (SrcWidth - 1) * AngleSin * -AngleTan - else - Shear := ((SrcWidth - 1) * -AngleSin + (1 - DstHeight)) * AngleTan; - - for I := 0 to DstHeight - 1 do - begin - XShear(TempImage2, Image, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); - Shear := Shear + AngleTan; - end; - - FreeImage(TempImage2); - if Image.Format <> SrcFmt then - ConvertImage(Image, SrcFmt); - end; - - procedure RotateMul90(var Image: TImageData; Angle: Integer); - var - RotImage: TImageData; - X, Y, BytesPerPixel: Integer; - RotPix, Pix: PByte; - begin - InitImage(RotImage); - BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel; - - if ((Angle = 90) or (Angle = 270)) and (Image.Width <> Image.Height) then - NewImage(Image.Height, Image.Width, Image.Format, RotImage) - else - NewImage(Image.Width, Image.Height, Image.Format, RotImage); - - RotPix := RotImage.Bits; - case Angle of - 90: - begin - for Y := 0 to RotImage.Height - 1 do - begin - Pix := @PByteArray(Image.Bits)[(Image.Width - Y - 1) * BytesPerPixel]; - for X := 0 to RotImage.Width - 1 do - begin - CopyPixel(Pix, RotPix, BytesPerPixel); - Inc(RotPix, BytesPerPixel); - Inc(Pix, Image.Width * BytesPerPixel); - end; - end; - end; - 180: - begin - Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width + - (Image.Width - 1)) * BytesPerPixel]; - for Y := 0 to RotImage.Height - 1 do - for X := 0 to RotImage.Width - 1 do - begin - CopyPixel(Pix, RotPix, BytesPerPixel); - Inc(RotPix, BytesPerPixel); - Dec(Pix, BytesPerPixel); - end; - end; - 270: - begin - for Y := 0 to RotImage.Height - 1 do - begin - Pix := @PByteArray(Image.Bits)[((Image.Height - 1) * Image.Width + Y) * BytesPerPixel]; - for X := 0 to RotImage.Width - 1 do - begin - CopyPixel(Pix, RotPix, BytesPerPixel); - Inc(RotPix, BytesPerPixel); - Dec(Pix, Image.Width * BytesPerPixel); - end; - end; - end; - end; - - FreeMemNil(Image.Bits); - RotImage.Palette := Image.Palette; - Image := RotImage; - end; - -begin - if TestImage(Image) then - try - while Angle >= 360 do - Angle := Angle - 360; - while Angle < 0 do - Angle := Angle + 360; - - if (Angle = 0) or (Abs(Angle) = 360) then - Exit; - - OldFmt := Image.Format; - if ImageFormatInfos[Image.Format].IsSpecial then - ConvertImage(Image, ifDefault); - - if (Angle > 45) and (Angle <= 135) then - begin - RotateMul90(Image, 90); - Angle := Angle - 90; - end - else if (Angle > 135) and (Angle <= 225) then - begin - RotateMul90(Image, 180); - Angle := Angle - 180; - end - else if (Angle > 225) and (Angle <= 315) then - begin - RotateMul90(Image, 270); - Angle := Angle - 270; - end; - - if Angle <> 0 then - Rotate45(Image, Angle); - - if OldFmt <> Image.Format then - ConvertImage(Image, OldFmt); - - except - raise UpdateExceptMessage(GetExceptObject, SErrorRotateImage, [ImageToStr(Image), Angle]); - end; -end; - -{ Drawing/Pixel functions } - -function CopyRect(const SrcImage: TImageData; SrcX, SrcY, Width, Height: LongInt; - var DstImage: TImageData; DstX, DstY: LongInt): Boolean; -var - Info: PImageFormatInfo; - I, SrcWidthBytes, DstWidthBytes, MoveBytes: LongInt; - SrcPointer, DstPointer: PByte; - WorkImage: TImageData; - OldFormat: TImageFormat; -begin - Result := False; - OldFormat := ifUnknown; - if TestImage(SrcImage) and TestImage(DstImage) then - try - // Make sure we are still copying image to image, not invalid pointer to protected memory - ClipCopyBounds(SrcX, SrcY, Width, Height, DstX, DstY, SrcImage.Width, SrcImage.Height, - Rect(0, 0, DstImage.Width, DstImage.Height)); - - if (Width > 0) and (Height > 0) then - begin - Info := ImageFormatInfos[DstImage.Format]; - if Info.IsSpecial then - begin - // If dest image is in special format we convert it to default - OldFormat := Info.Format; - ConvertImage(DstImage, ifDefault); - Info := ImageFormatInfos[DstImage.Format]; - end; - if SrcImage.Format <> DstImage.Format then - begin - // If images are in different format source is converted to dest's format - InitImage(WorkImage); - CloneImage(SrcImage, WorkImage); - ConvertImage(WorkImage, DstImage.Format); - end - else - WorkImage := SrcImage; - - MoveBytes := Width * Info.BytesPerPixel; - DstWidthBytes := DstImage.Width * Info.BytesPerPixel; - DstPointer := @PByteArray(DstImage.Bits)[DstY * DstWidthBytes + - DstX * Info.BytesPerPixel]; - SrcWidthBytes := WorkImage.Width * Info.BytesPerPixel; - SrcPointer := @PByteArray(WorkImage.Bits)[SrcY * SrcWidthBytes + - SrcX * Info.BytesPerPixel]; - - for I := 0 to Height - 1 do - begin - Move(SrcPointer^, DstPointer^, MoveBytes); - Inc(SrcPointer, SrcWidthBytes); - Inc(DstPointer, DstWidthBytes); - end; - // If dest image was in special format we convert it back - if OldFormat <> ifUnknown then - ConvertImage(DstImage, OldFormat); - // Working image must be freed if it is not the same as source image - if WorkImage.Bits <> SrcImage.Bits then - FreeImage(WorkImage); - - Result := True; - end; - except - RaiseImaging(SErrorCopyRect, [ImageToStr(SrcImage), ImageToStr(DstImage)]); - end; -end; - -function FillRect(var Image: TImageData; X, Y, Width, Height: LongInt; - FillColor: Pointer): Boolean; -var - Info: PImageFormatInfo; - I, J, ImageWidthBytes, RectWidthBytes, Bpp: Longint; - LinePointer, PixPointer: PByte; - OldFmt: TImageFormat; -begin - Result := False; - if TestImage(Image) then - try - ClipRectBounds(X, Y, Width, Height, Rect(0, 0, Image.Width, Image.Height)); - - if (Width > 0) and (Height > 0) then - begin - OldFmt := Image.Format; - if ImageFormatInfos[OldFmt].IsSpecial then - ConvertImage(Image, ifDefault); - - Info := ImageFormatInfos[Image.Format]; - Bpp := Info.BytesPerPixel; - ImageWidthBytes := Image.Width * Bpp; - RectWidthBytes := Width * Bpp; - LinePointer := @PByteArray(Image.Bits)[Y * ImageWidthBytes + X * Bpp]; - - for I := 0 to Height - 1 do - begin - case Bpp of - 1: FillMemoryByte(LinePointer, RectWidthBytes, PByte(FillColor)^); - 2: FillMemoryWord(LinePointer, RectWidthBytes, PWord(FillColor)^); - 4: FillMemoryLongWord(LinePointer, RectWidthBytes, PLongWord(FillColor)^); - else - PixPointer := LinePointer; - for J := 0 to Width - 1 do - begin - CopyPixel(FillColor, PixPointer, Bpp); - Inc(PixPointer, Bpp); - end; - end; - Inc(LinePointer, ImageWidthBytes); - end; - - if OldFmt <> Image.Format then - ConvertImage(Image, OldFmt); - end; - - Result := True; - except - RaiseImaging(SErrorFillRect, [X, Y, Width, Height, ImageToStr(Image)]); - end; -end; - -function ReplaceColor(var Image: TImageData; X, Y, Width, Height: LongInt; - OldColor, NewColor: Pointer): Boolean; -var - Info: PImageFormatInfo; - I, J, WidthBytes, Bpp: Longint; - LinePointer, PixPointer: PByte; - OldFmt: TImageFormat; -begin - Assert((OldColor <> nil) and (NewColor <> nil)); - Result := False; - if TestImage(Image) then - try - ClipRectBounds(X, Y, Width, Height, Rect(0, 0, Image.Width, Image.Height)); - - if (Width > 0) and (Height > 0) then - begin - OldFmt := Image.Format; - if ImageFormatInfos[OldFmt].IsSpecial then - ConvertImage(Image, ifDefault); - - Info := ImageFormatInfos[Image.Format]; - Bpp := Info.BytesPerPixel; - WidthBytes := Image.Width * Bpp; - LinePointer := @PByteArray(Image.Bits)[Y * WidthBytes + X * Bpp]; - - for I := 0 to Height - 1 do - begin - PixPointer := LinePointer; - for J := 0 to Width - 1 do - begin - if ComparePixels(PixPointer, OldColor, Bpp) then - CopyPixel(NewColor, PixPointer, Bpp); - Inc(PixPointer, Bpp); - end; - Inc(LinePointer, WidthBytes); - end; - - if OldFmt <> Image.Format then - ConvertImage(Image, OldFmt); - end; - - Result := True; - except - RaiseImaging(SErrorReplaceColor, [X, Y, Width, Height, ImageToStr(Image)]); - end; -end; - -function StretchRect(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TResizeFilter): Boolean; -var - Info: PImageFormatInfo; - WorkImage: TImageData; - OldFormat: TImageFormat; - Resampling: TSamplingFilter; -begin - Result := False; - OldFormat := ifUnknown; - if TestImage(SrcImage) and TestImage(DstImage) then - try - // Make sure we are still copying image to image, not invalid pointer to protected memory - ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DstX, DstY, DstWidth, DstHeight, - SrcImage.Width, SrcImage.Height, Rect(0, 0, DstImage.Width, DstImage.Height)); - - if (SrcWidth = DstWidth) and (SrcHeight = DstHeight) then - begin - // If source and dest rectangles have the same size call CopyRect - Result := CopyRect(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight, DstImage, DstX, DstY); - end - else if (SrcWidth > 0) and (SrcHeight > 0) and (DstWidth > 0) and (DstHeight > 0) then - begin - // If source and dest rectangles don't have the same size we do stretch - Info := ImageFormatInfos[DstImage.Format]; - - if Info.IsSpecial then - begin - // If dest image is in special format we convert it to default - OldFormat := Info.Format; - ConvertImage(DstImage, ifDefault); - Info := ImageFormatInfos[DstImage.Format]; - end; - - if SrcImage.Format <> DstImage.Format then - begin - // If images are in different format source is converted to dest's format - InitImage(WorkImage); - CloneImage(SrcImage, WorkImage); - ConvertImage(WorkImage, DstImage.Format); - end - else - WorkImage := SrcImage; - - // Only pixel resize is supported for indexed images - if Info.IsIndexed then - Filter := rfNearest; - - if Filter = rfNearest then - begin - StretchNearest(WorkImage, SrcX, SrcY, SrcWidth, SrcHeight, - DstImage, DstX, DstY, DstWidth, DstHeight); - end - else - begin - Resampling := sfNearest; - case Filter of - rfBilinear: Resampling := sfLinear; - rfBicubic: Resampling := DefaultCubicFilter; - rfLanczos: Resampling := sfLanczos; - end; - StretchResample(WorkImage, SrcX, SrcY, SrcWidth, SrcHeight, - DstImage, DstX, DstY, DstWidth, DstHeight, Resampling); - end; - - // If dest image was in special format we convert it back - if OldFormat <> ifUnknown then - ConvertImage(DstImage, OldFormat); - // Working image must be freed if it is not the same as source image - if WorkImage.Bits <> SrcImage.Bits then - FreeImage(WorkImage); - - Result := True; - end; - except - RaiseImaging(SErrorStretchRect, [ImageToStr(SrcImage), ImageToStr(DstImage)]); - end; -end; - -procedure GetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -var - BytesPerPixel: LongInt; -begin - Assert(Pixel <> nil); - BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel; - CopyPixel(@PByteArray(Image.Bits)[(Y * Image.Width + X) * BytesPerPixel], - Pixel, BytesPerPixel); -end; - -procedure SetPixelDirect(const Image: TImageData; X, Y: LongInt; Pixel: Pointer); -var - BytesPerPixel: LongInt; -begin - Assert(Pixel <> nil); - BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel; - CopyPixel(Pixel, @PByteArray(Image.Bits)[(Y * Image.Width + X) * BytesPerPixel], - BytesPerPixel); -end; - -function GetPixel32(const Image: TImageData; X, Y: LongInt): TColor32Rec; -var - Info: PImageFormatInfo; - Data: PByte; -begin - Info := ImageFormatInfos[Image.Format]; - Data := @PByteArray(Image.Bits)[(Y * Image.Width + X) * Info.BytesPerPixel]; - Result := GetPixel32Generic(Data, Info, Image.Palette); -end; - -procedure SetPixel32(const Image: TImageData; X, Y: LongInt; const Color: TColor32Rec); -var - Info: PImageFormatInfo; - Data: PByte; -begin - Info := ImageFormatInfos[Image.Format]; - Data := @PByteArray(Image.Bits)[(Y * Image.Width + X) * Info.BytesPerPixel]; - SetPixel32Generic(Data, Info, Image.Palette, Color); -end; - -function GetPixelFP(const Image: TImageData; X, Y: LongInt): TColorFPRec; -var - Info: PImageFormatInfo; - Data: PByte; -begin - Info := ImageFormatInfos[Image.Format]; - Data := @PByteArray(Image.Bits)[(Y * Image.Width + X) * Info.BytesPerPixel]; - Result := GetPixelFPGeneric(Data, Info, Image.Palette); -end; - -procedure SetPixelFP(const Image: TImageData; X, Y: LongInt; const Color: TColorFPRec); -var - Info: PImageFormatInfo; - Data: PByte; -begin - Info := ImageFormatInfos[Image.Format]; - Data := @PByteArray(Image.Bits)[(Y * Image.Width + X) * Info.BytesPerPixel]; - SetPixelFPGeneric(Data, Info, Image.Palette, Color); -end; - -{ Palette Functions } - -procedure NewPalette(Entries: LongInt; var Pal: PPalette32); -begin - Assert((Entries > 2) and (Entries <= 65535)); - try - GetMem(Pal, Entries * SizeOf(TColor32Rec)); - FillChar(Pal^, Entries * SizeOf(TColor32Rec), $FF); - except - RaiseImaging(SErrorNewPalette, [Entries]); - end; -end; - -procedure FreePalette(var Pal: PPalette32); -begin - try - FreeMemNil(Pal); - except - RaiseImaging(SErrorFreePalette, [Pal]); - end; -end; - -procedure CopyPalette(SrcPal, DstPal: PPalette32; SrcIdx, DstIdx, Count: LongInt); -begin - Assert((SrcPal <> nil) and (DstPal <> nil)); - Assert((SrcIdx >= 0) and (DstIdx >= 0) and (Count >= 0)); - try - Move(SrcPal[SrcIdx], DstPal[DstIdx], Count * SizeOf(TColor32Rec)); - except - RaiseImaging(SErrorCopyPalette, [Count, SrcPal, DstPal]); - end; -end; - -function FindColor(Pal: PPalette32; Entries: LongInt; Color: TColor32): - LongInt; -var - Col: TColor32Rec; - I, MinDif, Dif: LongInt; -begin - Assert(Pal <> nil); - Result := -1; - Col.Color := Color; - try - // First try to find exact match - for I := 0 to Entries - 1 do - with Pal[I] do - begin - if (A = Col.A) and (R = Col.R) and - (G = Col.G) and (B = Col.B) then - begin - Result := I; - Exit; - end; - end; - - // If exact match was not found, find nearest color - MinDif := 1020; - for I := 0 to Entries - 1 do - with Pal[I] do - begin - Dif := Abs(R - Col.R); - if Dif > MinDif then Continue; - Dif := Dif + Abs(G - Col.G); - if Dif > MinDif then Continue; - Dif := Dif + Abs(B - Col.B); - if Dif > MinDif then Continue; - Dif := Dif + Abs(A - Col.A); - if Dif < MinDif then - begin - MinDif := Dif; - Result := I; - end; - end; - except - RaiseImaging(SErrorFindColor, [Pal, Entries]); - end; -end; - -procedure FillGrayscalePalette(Pal: PPalette32; Entries: LongInt); -var - I: LongInt; -begin - Assert(Pal <> nil); - try - for I := 0 to Entries - 1 do - with Pal[I] do - begin - A := $FF; - R := Byte(I); - G := Byte(I); - B := Byte(I); - end; - except - RaiseImaging(SErrorGrayscalePalette, [Pal, Entries]); - end; -end; - -procedure FillCustomPalette(Pal: PPalette32; Entries: LongInt; RBits, GBits, - BBits: Byte; Alpha: Byte = $FF); -var - I, TotalBits, MaxEntries: LongInt; -begin - Assert(Pal <> nil); - TotalBits := RBits + GBits + BBits; - MaxEntries := Min(Pow2Int(TotalBits), Entries); - FillChar(Pal^, Entries * SizeOf(TColor32Rec), 0); - try - for I := 0 to MaxEntries - 1 do - with Pal[I] do - begin - A := Alpha; - if RBits > 0 then - R := ((I shr Max(0, GBits + BBits - 1)) and (1 shl RBits - 1)) * 255 div (1 shl RBits - 1); - if GBits > 0 then - G := ((I shr Max(0, BBits - 1)) and (1 shl GBits - 1)) * 255 div (1 shl GBits - 1); - if BBits > 0 then - B := ((I shr 0) and (1 shl BBits - 1)) * 255 div (1 shl BBits - 1); - end; - except - RaiseImaging(SErrorCustomPalette, [Pal, Entries]); - end; -end; - -procedure SwapChannelsOfPalette(Pal: PPalette32; Entries, SrcChannel, - DstChannel: LongInt); -var - I: LongInt; - Swap: Byte; -begin - Assert(Pal <> nil); - Assert((SrcChannel in [0..3]) and (DstChannel in [0..3])); - try - for I := 0 to Entries - 1 do - with Pal[I] do - begin - Swap := Channels[SrcChannel]; - Channels[SrcChannel] := Channels[DstChannel]; - Channels[DstChannel] := Swap; - end; - except - RaiseImaging(SErrorSwapPalette, [Pal, Entries]); - end; -end; - -{ Options Functions } - -function SetOption(OptionId, Value: LongInt): Boolean; -begin - Result := False; - if (OptionId >= 0) and (OptionId < Length(Options)) and - (Options[OptionID] <> nil) then - begin - Options[OptionID]^ := CheckOptionValue(OptionId, Value); - Result := True; - end; -end; - -function GetOption(OptionId: LongInt): LongInt; -begin - Result := InvalidOption; - if (OptionId >= 0) and (OptionId < Length(Options)) and - (Options[OptionID] <> nil) then - begin - Result := Options[OptionID]^; - end; -end; - -function PushOptions: Boolean; -begin - Result := OptionStack.Push; -end; - -function PopOptions: Boolean; -begin - Result := OptionStack.Pop; -end; - -{ Image Format Functions } - -function GetImageFormatInfo(Format: TImageFormat; out Info: TImageFormatInfo): Boolean; -begin - FillChar(Info, SizeOf(Info), 0); - if ImageFormatInfos[Format] <> nil then - begin - Info := ImageFormatInfos[Format]^; - Result := True; - end - else - Result := False; -end; - -function GetPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - if ImageFormatInfos[Format] <> nil then - Result := ImageFormatInfos[Format].GetPixelsSize(Format, Width, Height) - else - Result := 0; -end; - -{ IO Functions } - -procedure SetUserFileIO(OpenProc: TOpenProc; - CloseProc: TCloseProc; EofProc: TEofProc; SeekProc: TSeekProc; TellProc: - TTellProc; ReadProc: TReadProc; WriteProc: TWriteProc); -begin - FileIO.Open := OpenProc; - FileIO.Close := CloseProc; - FileIO.Eof := EofProc; - FileIO.Seek := SeekProc; - FileIO.Tell := TellProc; - FileIO.Read := ReadProc; - FileIO.Write := WriteProc; -end; - -procedure ResetFileIO; -begin - FileIO := OriginalFileIO; -end; - -{ Raw Image IO Functions } - -procedure ReadRawImage(Handle: TImagingHandle; Width, Height: Integer; - Format: TImageFormat; out Image: TImageData; Offset, RowLength: Integer); -var - WidthBytes, I: Integer; - Info: PImageFormatInfo; -begin - Info := ImageFormatInfos[Format]; - // Calc scanline size - WidthBytes := Info.GetPixelsSize(Format, Width, 1); - if RowLength = 0 then - RowLength := WidthBytes; - // Create new image if needed - don't need to allocate new one if there is already - // one with desired size and format - if (Image.Width <> Width) or (Image.Height <> Height) or (Image.Format <> Format) then - NewImage(Width, Height, Format, Image); - // Move past the header - IO.Seek(Handle, Offset, smFromCurrent); - // Read scanlines from input - for I := 0 to Height - 1 do - begin - IO.Read(Handle, @PByteArray(Image.Bits)[I * WidthBytes], WidthBytes); - IO.Seek(Handle, RowLength - WidthBytes, smFromCurrent); - end; -end; - -procedure ReadRawImageFromFile(const FileName: string; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset, RowLength: Integer); -var - Handle: TImagingHandle; -begin - Assert(FileName <> ''); - // Set IO ops to file ops and open given file - SetFileIO; - Handle := IO.Open(PChar(FileName), omReadOnly); - try - ReadRawImage(Handle, Width, Height, Format, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure ReadRawImageFromStream(Stream: TStream; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset, RowLength: Integer); -var - Handle: TImagingHandle; -begin - Assert(Stream <> nil); - if Stream.Size - Stream.Position = 0 then - RaiseImaging(SErrorEmptyStream, []); - // Set IO ops to stream ops and open given stream - SetStreamIO; - Handle := IO.Open(Pointer(Stream), omReadOnly); - try - ReadRawImage(Handle, Width, Height, Format, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure ReadRawImageFromMemory(Data: Pointer; DataSize: Integer; Width, Height: Integer; - Format: TImageFormat; var Image: TImageData; Offset, RowLength: Integer); -var - Handle: TImagingHandle; - MemRec: TMemoryIORec; -begin - Assert((Data <> nil) and (DataSize > 0)); - // Set IO ops to memory ops and open given stream - SetMemoryIO; - MemRec := PrepareMemIO(Data, DataSize); - Handle := IO.Open(@MemRec, omReadOnly); - try - ReadRawImage(Handle, Width, Height, Format, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure ReadRawImageRect(Data: Pointer; Left, Top, Width, Height: Integer; - var Image: TImageData; Offset, RowLength: Integer); -var - DestScanBytes, RectBytes, I: Integer; - Info: PImageFormatInfo; - Src, Dest: PByte; -begin - Assert(Data <> nil); - Assert((Left + Width <= Image.Width) and (Top + Height <= Image.Height)); - Info := ImageFormatInfos[Image.Format]; - - // Calc scanline size - DestScanBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - RectBytes := Info.GetPixelsSize(Info.Format, Width, 1); - if RowLength = 0 then - RowLength := RectBytes; - - Src := Data; - Dest := @PByteArray(Image.Bits)[Top * DestScanBytes + Info.GetPixelsSize(Info.Format, Left, 1)]; - // Move past the header - Inc(Src, Offset); - - // Read lines into rect in the existing image - for I := 0 to Height - 1 do - begin - Move(Src^, Dest^, RectBytes); - Inc(Src, RowLength); - Inc(Dest, DestScanBytes); - end; -end; - -procedure WriteRawImage(Handle: TImagingHandle; const Image: TImageData; - Offset, RowLength: Integer); -var - WidthBytes, I: Integer; - Info: PImageFormatInfo; -begin - Info := ImageFormatInfos[Image.Format]; - // Calc scanline size - WidthBytes := Info.GetPixelsSize(Image.Format, Image.Width, 1); - if RowLength = 0 then - RowLength := WidthBytes; - // Move past the header - IO.Seek(Handle, Offset, smFromCurrent); - // Write scanlines to output - for I := 0 to Image.Height - 1 do - begin - IO.Write(Handle, @PByteArray(Image.Bits)[I * WidthBytes], WidthBytes); - IO.Seek(Handle, RowLength - WidthBytes, smFromCurrent); - end; -end; - -procedure WriteRawImageToFile(const FileName: string; const Image: TImageData; - Offset, RowLength: Integer); -var - Handle: TImagingHandle; -begin - Assert(FileName <> ''); - // Set IO ops to file ops and open given file - SetFileIO; - Handle := IO.Open(PChar(FileName), omCreate); - try - WriteRawImage(Handle, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure WriteRawImageToStream(Stream: TStream; const Image: TImageData; - Offset, RowLength: Integer); -var - Handle: TImagingHandle; -begin - Assert(Stream <> nil); - // Set IO ops to stream ops and open given stream - SetStreamIO; - Handle := IO.Open(Pointer(Stream), omCreate); - try - WriteRawImage(Handle, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure WriteRawImageToMemory(Data: Pointer; DataSize: Integer; const Image: TImageData; - Offset, RowLength: Integer); -var - Handle: TImagingHandle; - MemRec: TMemoryIORec; -begin - Assert((Data <> nil) and (DataSize > 0)); - // Set IO ops to memory ops and open given stream - SetMemoryIO; - MemRec := PrepareMemIO(Data, DataSize); - Handle := IO.Open(@MemRec, omCreate); - try - WriteRawImage(Handle, Image, Offset, RowLength); - finally - IO.Close(Handle); - end; -end; - -procedure WriteRawImageRect(Data: Pointer; Left, Top, Width, Height: Integer; - const Image: TImageData; Offset, RowLength: Integer); -var - SrcScanBytes, RectBytes, I: Integer; - Info: PImageFormatInfo; - Src, Dest: PByte; -begin - Assert(Data <> nil); - Assert((Left + Width <= Image.Width) and (Top + Height <= Image.Height)); - Info := ImageFormatInfos[Image.Format]; - - // Calc scanline size - SrcScanBytes := Info.GetPixelsSize(Info.Format, Image.Width, 1); - RectBytes := Info.GetPixelsSize(Info.Format, Width, 1); - if RowLength = 0 then - RowLength := RectBytes; - - Src := @PByteArray(Image.Bits)[Top * SrcScanBytes + Info.GetPixelsSize(Info.Format, Left, 1)]; - Dest := Data; - // Move past the header - Inc(Dest, Offset); - - // Write lines from rect of the existing image - for I := 0 to Height - 1 do - begin - Move(Src^, Dest^, RectBytes); - Inc(Dest, RowLength); - Inc(Src, SrcScanBytes); - end; -end; - -{ Convenience/helper Functions } - -procedure ResizeImageToFit(const SrcImage: TImageData; FitWidth, FitHeight: Integer; - Filter: TResizeFilter; var DestImage: TImageData); -var - CurSize, FitSize, DestSize: TSize; -begin - if not TestImage(SrcImage) then - raise EImagingError.Create(SErrorInvalidInputImage); - - FitSize.CX := FitWidth; - FitSize.CY := FitHeight; - CurSize.CX := SrcImage.Width; - CurSize.CY := SrcImage.Height; - DestSize := ImagingUtility.ScaleSizeToFit(CurSize, FitSize); - - NewImage(Max(DestSize.CX, 1), Max(DestSize.CY, 1), SrcImage.Format, DestImage); - if SrcImage.Palette <> nil then - CopyPalette(SrcImage.Palette, DestImage.Palette, 0, 0, ImageFormatInfos[SrcImage.Format].PaletteEntries); - - StretchRect(SrcImage, 0, 0, CurSize.CX, CurSize.CY, DestImage, 0, 0, - DestSize.CX, DestSize.CY, Filter); -end; - -{ ------------------------------------------------------------------------ - Other Imaging Stuff - ------------------------------------------------------------------------} - -function GetFormatName(Format: TImageFormat): string; -begin - if ImageFormatInfos[Format] <> nil then - Result := ImageFormatInfos[Format].Name - else - Result := SUnknownFormat; -end; - -function ImageToStr(const Image: TImageData): string; -var - ImgSize: Integer; -begin - if TestImage(Image) then - with Image do - begin - ImgSize := Size; - if ImgSize > 8192 then - ImgSize := ImgSize div 1024; - Result := SysUtils.Format(SImageInfo, [@Image, Width, Height, - GetFormatName(Format), ImgSize + 0.0, Iff(ImgSize = Size, 'B', 'KiB'), Bits, - Palette]); - end - else - Result := SysUtils.Format(SImageInfoInvalid, [@Image]); -end; - -function GetVersionStr: string; -begin - Result := Format('%.1d.%.2d.%.1d', [ImagingVersionMajor, - ImagingVersionMinor, ImagingVersionPatch]); -end; - -function IffFormat(Condition: Boolean; const TruePart, FalsePart: TImageFormat): TImageFormat; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -procedure RegisterImageFileFormat(AClass: TImageFileFormatClass); -begin - Assert(AClass <> nil); - if ImageFileFormats = nil then - ImageFileFormats := TList.Create; - if GlobalMetadata = nil then - GlobalMetadata := TMetadata.Create; - if ImageFileFormats <> nil then - ImageFileFormats.Add(AClass.Create); -end; - -function RegisterOption(OptionId: LongInt; Variable: PLongInt): Boolean; -begin - Result := False; - if Options = nil then - InitOptions; - - Assert(Variable <> nil); - - if OptionId >= Length(Options) then - SetLength(Options, OptionId + InitialOptions); - if (OptionId >= 0) and (OptionId < Length(Options)) {and (Options[OptionId] = nil) - must be able to override existing } then - begin - Options[OptionId] := Variable; - Result := True; - end; -end; - -function FindImageFileFormatByExt(const Ext: string): TImageFileFormat; -var - I: LongInt; -begin - Result := nil; - for I := ImageFileFormats.Count - 1 downto 0 do - if TImageFileFormat(ImageFileFormats[I]).Extensions.IndexOf(Ext) >= 0 then - begin - Result := TImageFileFormat(ImageFileFormats[I]); - Exit; - end; -end; - -function FindImageFileFormatByName(const FileName: string): TImageFileFormat; -var - I: LongInt; -begin - Result := nil; - for I := ImageFileFormats.Count - 1 downto 0 do - if TImageFileFormat(ImageFileFormats[I]).TestFileName(FileName) then - begin - Result := TImageFileFormat(ImageFileFormats[I]); - Exit; - end; -end; - -function FindImageFileFormatByClass(AClass: TImageFileFormatClass): TImageFileFormat; -var - I: LongInt; -begin - Result := nil; - for I := 0 to ImageFileFormats.Count - 1 do - if TImageFileFormat(ImageFileFormats[I]) is AClass then - begin - Result := TObject(ImageFileFormats[I]) as TImageFileFormat; - Break; - end; -end; - -function GetFileFormatCount: LongInt; -begin - Result := ImageFileFormats.Count; -end; - -function GetFileFormatAtIndex(Index: LongInt): TImageFileFormat; -begin - if (Index >= 0) and (Index < ImageFileFormats.Count) then - Result := TImageFileFormat(ImageFileFormats[Index]) - else - Result := nil; -end; - -function GetImageFileFormatsFilter(OpenFileFilter: Boolean): string; -var - I, J, Count: LongInt; - Descriptions: string; - Filters, CurFilter: string; - FileFormat: TImageFileFormat; -begin - Descriptions := ''; - Filters := ''; - Count := 0; - - for I := 0 to ImageFileFormats.Count - 1 do - begin - FileFormat := TObject(ImageFileFormats[I]) as TImageFileFormat; - - // If we are creating filter for save dialog and this format cannot save - // files the we skip it - if not OpenFileFilter and not FileFormat.CanSave then - Continue; - - CurFilter := ''; - for J := 0 to FileFormat.Masks.Count - 1 do - begin - CurFilter := CurFilter + FileFormat.Masks[J]; - if J < FileFormat.Masks.Count - 1 then - CurFilter := CurFilter + ';'; - end; - - FmtStr(Descriptions, '%s%s (%s)|%2:s', [Descriptions, FileFormat.Name, CurFilter]); - if Filters <> '' then - FmtStr(Filters, '%s;%s', [Filters, CurFilter]) - else - Filters := CurFilter; - - if I < ImageFileFormats.Count - 1 then - Descriptions := Descriptions + '|'; - - Inc(Count); - end; - - if (Count > 1) and OpenFileFilter then - FmtStr(Descriptions, '%s (%s)|%1:s|%s', [SAllFilter, Filters, Descriptions]); - - Result := Descriptions; -end; - -function GetFilterIndexExtension(Index: LongInt; OpenFileFilter: Boolean): string; -var - I, Count: LongInt; - FileFormat: TImageFileFormat; -begin - // -1 because filter indices are in 1..n range - Index := Index - 1; - Result := ''; - if OpenFileFilter then - begin - if Index > 0 then - Index := Index - 1; - end; - - if (Index >= 0) and (Index < ImageFileFormats.Count) then - begin - Count := 0; - for I := 0 to ImageFileFormats.Count - 1 do - begin - FileFormat := TObject(ImageFileFormats[I]) as TImageFileFormat; - if not OpenFileFilter and not FileFormat.CanSave then - Continue; - if Index = Count then - begin - if FileFormat.Extensions.Count > 0 then - Result := FileFormat.Extensions[0]; - Exit; - end; - Inc(Count); - end; - end; -end; - -function GetFileNameFilterIndex(const FileName: string; OpenFileFilter: Boolean): LongInt; -var - I: LongInt; - FileFormat: TImageFileFormat; -begin - Result := 0; - for I := 0 to ImageFileFormats.Count - 1 do - begin - FileFormat := TObject(ImageFileFormats[I]) as TImageFileFormat; - if not OpenFileFilter and not FileFormat.CanSave then - Continue; - if FileFormat.TestFileName(FileName) then - begin - // +1 because filter indices are in 1..n range - Inc(Result); - if OpenFileFilter then - Inc(Result); - Exit; - end; - Inc(Result); - end; - Result := -1; -end; - -function GetIO: TIOFunctions; -begin - Result := IO; -end; - -procedure RaiseImaging(const Msg: string; const Args: array of const); -var - WholeMsg: string; -begin - WholeMsg := Msg; - if GetExceptObject <> nil then - begin - WholeMsg := WholeMsg + ' ' + SExceptMsg + ': ' + - GetExceptObject.Message; - end; - raise EImagingError.CreateFmt(WholeMsg, Args); -end; - -procedure RaiseImaging(const Msg: string); -begin - RaiseImaging(Msg, []); -end; - -{ Internal unit functions } - -function CheckOptionValue(OptionId, Value: LongInt): LongInt; -begin - case OptionId of - ImagingColorReductionMask: - Result := ClampInt(Value, 0, $FF); - ImagingLoadOverrideFormat, ImagingSaveOverrideFormat: - Result := Iff(ImagingFormats.IsImageFormatValid(TImageFormat(Value)), - Value, LongInt(ifUnknown)); - ImagingMipMapFilter: Result := ClampInt(Value, Ord(Low(TSamplingFilter)), - Ord(High(TSamplingFilter))); - else - Result := Value; - end; -end; - -procedure SetFileIO; -begin - IO := FileIO; -end; - -procedure SetStreamIO; -begin - IO := StreamIO; -end; - -procedure SetMemoryIO; -begin - IO := MemoryIO; -end; - -procedure InitImageFormats; -begin - ImagingFormats.InitImageFormats(ImageFormatInfos); -end; - -procedure FreeImageFileFormats; -var - I: LongInt; -begin - if ImageFileFormats <> nil then - for I := 0 to ImageFileFormats.Count - 1 do - TImageFileFormat(ImageFileFormats[I]).Free; - FreeAndNil(ImageFileFormats); -end; - -procedure InitOptions; -begin - SetLength(Options, InitialOptions); - OptionStack := TOptionStack.Create; -end; - -procedure FreeOptions; -begin - SetLength(Options, 0); - FreeAndNil(OptionStack); -end; - -{ - TImageFileFormat class implementation -} - -constructor TImageFileFormat.Create(AMetadata: TMetadata); -begin - inherited Create; - FName := SUnknownFormat; - FExtensions := TStringList.Create; - FMasks := TStringList.Create; - if AMetadata = nil then - FMetadata := GlobalMetadata - else - FMetadata := AMetadata; - Define; -end; - -destructor TImageFileFormat.Destroy; -begin - FExtensions.Free; - FMasks.Free; - inherited Destroy; -end; - -procedure TImageFileFormat.Define; -begin -end; - -function TImageFileFormat.PrepareLoad(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstFrame: Boolean): Boolean; -begin - FMetadata.ClearMetaItems; // Clear old metadata - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := Handle <> nil; -end; - -function TImageFileFormat.PostLoadCheck(var Images: TDynImageDataArray; - LoadResult: Boolean): Boolean; -var - I: LongInt; -begin - if not LoadResult then - begin - FreeImagesInArray(Images); - SetLength(Images, 0); - Result := False; - end - else - begin - Result := (Length(Images) > 0) and TestImagesInArray(Images); - - if Result then - begin - // Convert to overriden format if it is set - if LoadOverrideFormat <> ifUnknown then - for I := Low(Images) to High(Images) do - ConvertImage(Images[I], LoadOverrideFormat); - end; - end; -end; - -function TImageFileFormat.PrepareSave(Handle: TImagingHandle; - const Images: TDynImageDataArray; var Index: Integer): Boolean; -var - Len, I: LongInt; -begin - CheckOptionsValidity; - Result := False; - if CanSave then - begin - Len := Length(Images); - Assert(Len > 0); - - // If there are no images to be saved exit - if Len = 0 then Exit; - - // Check index of image to be saved (-1 as index means save all images) - if IsMultiImageFormat then - begin - if (Index >= Len) then - Index := 0; - - if Index < 0 then - begin - Index := 0; - FFirstIdx := 0; - FLastIdx := Len - 1; - end - else - begin - FFirstIdx := Index; - FLastIdx := Index; - end; - - for I := FFirstIdx to FLastIdx - 1 do - begin - if not TestImage(Images[I]) then - Exit; - end; - end - else - begin - if (Index >= Len) or (Index < 0) then - Index := 0; - if not TestImage(Images[Index]) then - Exit; - end; - - Result := True; - end; -end; - -procedure TImageFileFormat.AddMasks(const AMasks: string); -var - I: LongInt; - Ext: string; -begin - FExtensions.Clear; - FMasks.CommaText := AMasks; - FMasks.Delimiter := ';'; - - for I := 0 to FMasks.Count - 1 do - begin - FMasks[I] := Trim(FMasks[I]); - Ext := GetFileExt(FMasks[I]); - if (Ext <> '') and (Ext <> '*') then - FExtensions.Add(Ext); - end; -end; - -function TImageFileFormat.GetFormatInfo(Format: TImageFormat): TImageFormatInfo; -begin - Result := ImageFormatInfos[Format]^; -end; - -function TImageFileFormat.GetSupportedFormats: TImageFormats; -begin - Result := FSupportedFormats; -end; - -function TImageFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstFrame: Boolean): Boolean; -begin - Result := False; - RaiseImaging(SFileFormatCanNotLoad, [FName]); -end; - -function TImageFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -begin - Result := False; - RaiseImaging(SFileFormatCanNotSave, [FName]); -end; - -procedure TImageFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin -end; - -function TImageFileFormat.IsSupported(const Image: TImageData): Boolean; -begin - Result := Image.Format in GetSupportedFormats; -end; - -function TImageFileFormat.LoadFromFile(const FileName: string; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; -begin - Result := False; - if CanLoad then - try - // Set IO ops to file ops and open given file - SetFileIO; - Handle := IO.Open(PChar(FileName), omReadOnly); - try - // Test if file contains valid image and if so then load it - if TestFormat(Handle) then - begin - Result := PrepareLoad(Handle, Images, OnlyFirstLevel) and - LoadData(Handle, Images, OnlyFirstlevel); - Result := PostLoadCheck(Images, Result); - end - else - RaiseImaging(SFileNotValid, [FileName, Name]); - finally - IO.Close(Handle); - end; - except - RaiseImaging(SErrorLoadingFile, [FileName, FExtensions[0]]); - end; -end; - -function TImageFileFormat.LoadFromStream(Stream: TStream; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; - OldPosition: Int64; -begin - Result := False; - OldPosition := Stream.Position; - if CanLoad then - try - // Set IO ops to stream ops and "open" given memory - SetStreamIO; - Handle := IO.Open(Pointer(Stream), omReadOnly); - try - // Test if stream contains valid image and if so then load it - if TestFormat(Handle) then - begin - Result := PrepareLoad(Handle, Images, OnlyFirstLevel) and - LoadData(Handle, Images, OnlyFirstlevel); - Result := PostLoadCheck(Images, Result); - end - else - RaiseImaging(SStreamNotValid, [@Stream, Name]); - finally - IO.Close(Handle); - end; - except - Stream.Position := OldPosition; - FreeImagesInArray(Images); - RaiseImaging(SErrorLoadingStream, [@Stream, FExtensions[0]]); - end; -end; - -function TImageFileFormat.LoadFromMemory(Data: Pointer; Size: LongInt; var - Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; - IORec: TMemoryIORec; -begin - Result := False; - if CanLoad then - try - // Set IO ops to memory ops and "open" given memory - SetMemoryIO; - IORec := PrepareMemIO(Data, Size); - Handle := IO.Open(@IORec,omReadOnly); - try - // Test if memory contains valid image and if so then load it - if TestFormat(Handle) then - begin - Result := PrepareLoad(Handle, Images, OnlyFirstLevel) and - LoadData(Handle, Images, OnlyFirstlevel); - Result := PostLoadCheck(Images, Result); - end - else - RaiseImaging(SMemoryNotValid, [Data, Size, Name]); - finally - IO.Close(Handle); - end; - except - RaiseImaging(SErrorLoadingMemory, [Data, Size, FExtensions[0]]); - end; -end; - -function TImageFileFormat.SaveToFile(const FileName: string; - const Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; - Len, Index, I: LongInt; - Ext, FName: string; -begin - Result := False; - if CanSave and TestImagesInArray(Images) then - try - SetFileIO; - Len := Length(Images); - if IsMultiImageFormat or - (not IsMultiImageFormat and (OnlyFirstLevel or (Len = 1))) then - begin - Handle := IO.Open(PChar(FileName), GetSaveOpenMode); - try - if OnlyFirstLevel then - Index := 0 - else - Index := -1; - // Write multi image to one file - Result := PrepareSave(Handle, Images, Index) and SaveData(Handle, Images, Index); - finally - IO.Close(Handle); - end; - end - else - begin - // Write multi image to file sequence - Ext := ExtractFileExt(FileName); - FName := ChangeFileExt(FileName, ''); - Result := True; - for I := 0 to Len - 1 do - begin - Handle := IO.Open(PChar(Format(FName + '%.3d' + Ext, [I])), GetSaveOpenMode); - try - Index := I; - Result := Result and PrepareSave(Handle, Images, Index) and - SaveData(Handle, Images, Index); - if not Result then - Break; - finally - IO.Close(Handle); - end; - end; - end; - except - raise UpdateExceptMessage(GetExceptObject, SErrorSavingFile, [FileName, FExtensions[0]]); - end; -end; - -function TImageFileFormat.SaveToStream(Stream: TStream; - const Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; - Len, Index, I: LongInt; - OldPosition: Int64; -begin - Result := False; - OldPosition := Stream.Position; - if CanSave and TestImagesInArray(Images) then - try - SetStreamIO; - Handle := IO.Open(PChar(Stream), GetSaveOpenMode); - try - if IsMultiImageFormat or OnlyFirstLevel then - begin - if OnlyFirstLevel then - Index := 0 - else - Index := -1; - // Write multi image in one run - Result := PrepareSave(Handle, Images, Index) and SaveData(Handle, Images, Index); - end - else - begin - // Write multi image to sequence - Result := True; - Len := Length(Images); - for I := 0 to Len - 1 do - begin - Index := I; - Result := Result and PrepareSave(Handle, Images, Index) and - SaveData(Handle, Images, Index); - if not Result then - Break; - end; - end; - finally - IO.Close(Handle); - end; - except - Stream.Position := OldPosition; - raise UpdateExceptMessage(GetExceptObject, SErrorSavingStream, [@Stream, FExtensions[0]]); - end; -end; - -function TImageFileFormat.SaveToMemory(Data: Pointer; var Size: LongInt; - const Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Handle: TImagingHandle; - Len, Index, I: LongInt; - IORec: TMemoryIORec; -begin - Result := False; - if CanSave and TestImagesInArray(Images) then - try - SetMemoryIO; - IORec := PrepareMemIO(Data, Size); - Handle := IO.Open(PChar(@IORec), GetSaveOpenMode); - try - if IsMultiImageFormat or OnlyFirstLevel then - begin - if OnlyFirstLevel then - Index := 0 - else - Index := -1; - // Write multi image in one run - Result := PrepareSave(Handle, Images, Index) and SaveData(Handle, Images, Index); - end - else - begin - // Write multi image to sequence - Result := True; - Len := Length(Images); - for I := 0 to Len - 1 do - begin - Index := I; - Result := Result and PrepareSave(Handle, Images, Index) and - SaveData(Handle, Images, Index); - if not Result then - Break; - end; - end; - Size := IORec.Position; - finally - IO.Close(Handle); - end; - except - raise UpdateExceptMessage(GetExceptObject, SErrorSavingMemory, [Data, Size, FExtensions[0]]); - end; -end; - -function TImageFileFormat.MakeCompatible(const Image: TImageData; - var Compatible: TImageData; out MustBeFreed: Boolean): Boolean; -begin - InitImage(Compatible); - - if SaveOverrideFormat <> ifUnknown then - begin - // Save format override is active. Clone input and convert it to override format. - CloneImage(Image, Compatible); - ConvertImage(Compatible, SaveOverrideFormat); - // Now check if override format is supported by file format. If it is not - // then file format specific conversion (virtual method) is called. - Result := IsSupported(Compatible); - if not Result then - begin - ConvertToSupported(Compatible, GetFormatInfo(Compatible.Format)); - Result := IsSupported(Compatible); - end; - end // Add IsCompatible function! not only checking by Format - else if IsSupported(Image) then - begin - // No save format override and input is in format supported by this - // file format. Just copy Image's fields to Compatible - Compatible := Image; - Result := True; - end - else - begin - // No override and input's format is not compatible with file format. - // Clone it and the call file format specific conversion (virtual method). - CloneImage(Image, Compatible); - ConvertToSupported(Compatible, GetFormatInfo(Compatible.Format)); - Result := IsSupported(Compatible); - end; - // Tell the user that he must free Compatible after he's done with it - // (if necessary). - MustBeFreed := Image.Bits <> Compatible.Bits; -end; - -function TImageFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -begin - Result := False; -end; - -function TImageFileFormat.TestFileName(const FileName: string): Boolean; -var - I: LongInt; - OnlyName: string; -begin - OnlyName := ExtractFileName(FileName); - // For each mask test if filename matches it - for I := 0 to FMasks.Count - 1 do - if StrMaskMatch(OnlyName, FMasks[I], False) then - begin - Result := True; - Exit; - end; - Result := False; -end; - -procedure TImageFileFormat.CheckOptionsValidity; -begin -end; - -function TImageFileFormat.GetCanLoad: Boolean; -begin - Result := ffLoad in FFeatures; -end; - -function TImageFileFormat.GetCanSave: Boolean; -begin - Result := ffSave in FFeatures; -end; - -function TImageFileFormat.GetIsMultiImageFormat: Boolean; -begin - Result := ffMultiImage in FFeatures; -end; - -function TImageFileFormat.GetSaveOpenMode: TOpenMode; -begin - // TODO: fix - //if ffReadOnSave in FFeatures then - // Result := omReadWrite - //else - Result := omCreate; -end; - -{ TOptionStack class implementation } - -constructor TOptionStack.Create; -begin - inherited Create; - FPosition := -1; -end; - -destructor TOptionStack.Destroy; -var - I: LongInt; -begin - for I := 0 to OptionStackDepth - 1 do - SetLength(FStack[I], 0); - inherited Destroy; -end; - -function TOptionStack.Pop: Boolean; -var - I: LongInt; -begin - Result := False; - if FPosition >= 0 then - begin - SetLength(Options, Length(FStack[FPosition])); - for I := 0 to Length(FStack[FPosition]) - 1 do - if Options[I] <> nil then - Options[I]^ := FStack[FPosition, I]; - Dec(FPosition); - Result := True; - end; -end; - -function TOptionStack.Push: Boolean; -var - I: LongInt; -begin - Result := False; - if FPosition < OptionStackDepth - 1 then - begin - Inc(FPosition); - SetLength(FStack[FPosition], Length(Options)); - for I := 0 to Length(Options) - 1 do - if Options[I] <> nil then - FStack[FPosition, I] := Options[I]^; - Result := True; - end; -end; - -{ TMetadata } - -procedure TMetadata.SetMetaItem(const Id: string; const Value: Variant; - ImageIndex: Integer); -begin - AddMetaToList(FLoadMetaItems, Id, Value, ImageIndex); -end; - -procedure TMetadata.SetMetaItemForSaving(const Id: string; const Value: Variant; - ImageIndex: Integer); -begin - AddMetaToList(FSaveMetaItems, Id, Value, ImageIndex); -end; - -procedure TMetadata.AddMetaToList(List: TStringList; const Id: string; - const Value: Variant; ImageIndex: Integer); -var - Item: TMetadataItem; - Idx: Integer; - FullId: string; -begin - FullId := GetMetaItemName(Id, ImageIndex); - if List.Find(FullId, Idx) then - (List.Objects[Idx] as TMetadataItem).Value := Value - else - begin - Item := TMetadataItem.Create; - Item.Id := Id; - Item.ImageIndex := ImageIndex; - Item.Value := Value; - List.AddObject(FullId, Item); - end; -end; - -procedure TMetadata.ClearMetaItems; -begin - ClearMetaList(FLoadMetaItems); -end; - -procedure TMetadata.ClearMetaItemsForSaving; -begin - ClearMetaList(FSaveMetaItems); -end; - -procedure TMetadata.ClearMetaList(List: TStringList); -var - I: Integer; -begin - for I := 0 to List.Count - 1 do - List.Objects[I].Free; - List.Clear; -end; - -procedure TMetadata.CopyLoadedMetaItemsForSaving; -var - I: Integer; - Copy, Orig: TMetadataItem; -begin - ClearMetaItemsForSaving; - for I := 0 to FLoadMetaItems.Count - 1 do - begin - Orig := TMetadataItem(FLoadMetaItems.Objects[I]); - Copy := TMetadataItem.Create; - Copy.Id := Orig.Id; - Copy.ImageIndex := Orig.ImageIndex; - Copy.Value := Orig.Value; - FSaveMetaItems.AddObject(GetMetaItemName(Copy.Id, Copy.ImageIndex), Copy); - end; -end; - -constructor TMetadata.Create; -begin - inherited; - FLoadMetaItems := TStringList.Create; - FLoadMetaItems.Sorted := True; - FSaveMetaItems := TStringList.Create; - FSaveMetaItems.Sorted := True; -end; - -destructor TMetadata.Destroy; -begin - ClearMetaItems; - ClearMetaItemsForSaving; - FLoadMetaItems.Free; - FSaveMetaItems.Free; - inherited; -end; - -function TMetadata.GetMetaById(const Id: string): Variant; -var - Idx: Integer; -begin - if FLoadMetaItems.Find(Id, Idx) then - Result := (FLoadMetaItems.Objects[Idx] as TMetadataItem).Value - else - Result := Variants.Null; -end; - -function TMetadata.GetMetaByIdMulti(const Id: string; ImageIndex: Integer): Variant; -begin - Result := GetMetaById(GetMetaItemName(Id, ImageIndex)); -end; - -function TMetadata.GetSaveMetaById(const Id: string): Variant; -var - Idx: Integer; -begin - if FSaveMetaItems.Find(Id, Idx) then - Result := (FSaveMetaItems.Objects[Idx] as TMetadataItem).Value - else - Result := Variants.Null; -end; - -function TMetadata.GetSaveMetaByIdMulti(const Id: string; - ImageIndex: Integer): Variant; -begin - Result := GetSaveMetaById(GetMetaItemName(Id, ImageIndex)); -end; - -function TMetadata.GetMetaByIdx(Index: Integer): TMetadataItem; -begin - Result := FLoadMetaItems.Objects[Index] as TMetadataItem; -end; - -function TMetadata.GetMetaCount: Integer; -begin - Result := FLoadMetaItems.Count; -end; - -function TMetadata.GetMetaItemName(const Id: string; - ImageIndex: Integer): string; -begin - Result := Iff(ImageIndex = 0, Id, Format(SMetaIdForSubImage, [Id, ImageIndex])); -end; - -function TMetadata.GetPhysicalPixelSize(ResUnit: TResolutionUnit; var XSize, - YSize: Single; MetaForSave: Boolean; ImageIndex: Integer): Boolean; -type - TGetter = function(const Id: string; ImageIndex: Integer): Variant of object; -var - Getter: TGetter; - XMeta, YMeta: Variant; -begin - if MetaForSave then - Getter := GetSaveMetaByIdMulti - else - Getter := GetMetaByIdMulti; - - XMeta := Getter(SMetaPhysicalPixelSizeX, ImageIndex); - YMeta := Getter(SMetaPhysicalPixelSizeY, ImageIndex); - XSize := -1; - YSize := -1; - - Result := not VarIsNull(XMeta) or not VarIsNull(YMeta); - - if not Result then - Exit; - - if not VarIsNull(XMeta) then - XSize := XMeta; - if not VarIsNull(YMeta) then - YSize := YMeta; - - if XSize < 0 then - XSize := YSize; - if YSize < 0 then - YSize := XSize; - - TranslateUnits(ResUnit, XSize, YSize); -end; - -procedure TMetadata.SetPhysicalPixelSize(ResUnit: TResolutionUnit; XSize, - YSize: Single; MetaForSave: Boolean; ImageIndex: Integer); -type - TAdder = procedure(const Id: string; const Value: Variant; ImageIndex: Integer) of object; -var - Adder: TAdder; -begin - TranslateUnits(ResUnit, XSize, YSize); - - if MetaForSave then - Adder := SetMetaItemForSaving - else - Adder := SetMetaItem; - - Adder(SMetaPhysicalPixelSizeX, XSize, ImageIndex); - Adder(SMetaPhysicalPixelSizeY, YSize, ImageIndex); -end; - -procedure TMetadata.TranslateUnits(ResolutionUnit: TResolutionUnit; var XRes, - YRes: Single); -var - UnitSize: Single; -begin - case ResolutionUnit of - ruDpi: UnitSize := 25400; - ruDpm: UnitSize := 1e06; - ruDpcm: UnitSize := 1e04; - else - UnitSize := 1; - end; - if ResolutionUnit <> ruSizeInMicroMeters then - begin - XRes := UnitSize / XRes; - YRes := UnitSize / YRes; - end; -end; - -function TMetadata.HasMetaItem(const Id: string; ImageIndex: Integer): Boolean; -begin - Result := GetMetaByIdMulti(Id, ImageIndex) <> Variants.Null; -end; - -function TMetadata.HasMetaItemForSaving(const Id: string; ImageIndex: Integer): Boolean; -begin - Result := GetSaveMetaByIdMulti(Id, ImageIndex) <> Variants.Null; -end; - -initialization -{$IFDEF MEMCHECK} - {$IF CompilerVersion >= 18} - System.ReportMemoryLeaksOnShutdown := True; - {$IFEND} -{$ENDIF} - if GlobalMetadata = nil then - GlobalMetadata := TMetadata.Create; - if ImageFileFormats = nil then - ImageFileFormats := TList.Create; - InitImageFormats; - RegisterOption(ImagingColorReductionMask, @ColorReductionMask); - RegisterOption(ImagingLoadOverrideFormat, @LoadOverrideFormat); - RegisterOption(ImagingSaveOverrideFormat, @SaveOverrideFormat); - RegisterOption(ImagingMipMapFilter, @MipMapFilter); - RegisterOption(ImagingBinaryTreshold, @BinaryTreshold); -finalization - FreeOptions; - FreeImageFileFormats; - GlobalMetadata.Free; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - Updated IO Open functions according to changes in ImagingTypes. - - Fixed bug in SplitImage that could cause wrong size of edge chunks. - - Metadata support fixes and extensions (frame delays, animation loops). - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Started reworking exception raising to keep the original class type - (e.g. in NewImage EOutOfMemory could be raised but was hidden - by EImagingError raised afterwards in NewImage try/except). - - Fixed possible AV in Rotate45 subproc of RotateImage. - - Added ReadRawXXX and WriteRawXXX functions for raw image bits IO. - - Implemented ImagingBinaryTreshold option. - - Added support for simple image metadata loading/saving. - - Moved file format definition (name, exts, caps, ...) from - constructor to new Define method. - - Fixed some memory leaks caused by failures during image loading. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Extended RotateImage to allow arbitrary angle rotations. - - Reversed the order file formats list is searched so - if you register a new one it will be found sooner than - built in formats. - - Fixed memory leak in ResizeImage ocurring when resizing - indexed images. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added position/size checks to LoadFromStream functions. - - Changed conditional compilation in impl. uses section to reflect changes - in LINK symbols. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - GenerateMipMaps now generates all smaller levels from - original big image (better results when using more advanced filters). - Also conversion to compatible image format is now done here not - in FillMipMapLevel (that is called for every mipmap level). - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - MakePaletteForImages now works correctly for indexed and special format images - - Fixed bug in StretchRect: Image was not properly stretched if - src and dst dimensions differed only in height. - - ConvertImage now fills new image with zeroes to avoid random data in - some conversions (RGB->XRGB) - - Changed RegisterOption procedure to function - - Changed bunch of palette functions from low level interface to procedure - (there was no reason for them to be functions). - - Changed FreeImage and FreeImagesInArray functions to procedures. - - Added many assertions, come try-finally, other checks, and small code - and doc changes. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - GenerateMipMaps threw failed assertion when input was indexed or special, - fixed. - - Added CheckOptionsValidity to TImageFileFormat and its decendants. - - Unit ImagingExtras which registers file formats in Extras package - is now automatically added to uses clause if LINK_EXTRAS symbol is - defined in ImagingOptions.inc file. - - Added EnumFileFormats function to low level interface. - - Fixed bug in SwapChannels which could cause AV when swapping alpha - channel of A8R8G8B8 images. - - Converting loaded images to ImagingOverrideFormat is now done - in PostLoadCheck method to avoid code duplicity. - - Added GetFileFormatCount and GetFileFormatAtIndex functions - - Bug in ConvertImage: if some format was converted to similar format - only with swapped channels (R16G16B16<>B16G16R16) then channels were - swapped correctly but new data format (swapped one) was not set. - - Made TImageFileFormat.MakeCompatible public non-virtual method - (and modified its function). Created new virtual - ConvertToSupported which should be overriden by descendants. - Main reason for doint this is to avoid duplicate code that was in all - TImageFileFormat's descendants. - - Changed TImageFileFormat.GetFormatInfo's result type to TImageFormatInfo. - - Split overloaded FindImageFileFormat functions to - FindImageFileFormatByClass and FindImageFileFormatByExt and created new - FindImageFileFormatByName which operates on whole filenames. - - Function GetExtensionFilterIndex renamed to GetFileNameFilterIndex - (because it now works with filenames not extensions). - - DetermineFileFormat now first searches by filename and if not found - then by data. - - Added TestFileName method to TImageFileFormat. - - Updated GetImageFileFormatsFilter to uses Masks instead of Extensions - property of TImageFileFormat. Also you can now request - OpenDialog and SaveDialog type filters - - Added Masks property and AddMasks method to TImageFileFormat. - AddMasks replaces AddExtensions, it uses filename masks instead - of sime filename extensions to identify supported files. - - Changed TImageFileFormat.LoadData procedure to function and - moved varios duplicate code from its descandats (check index,...) - here to TImageFileFormat helper methods. - - Changed TImageFileFormat.SaveData procedure to function and - moved varios duplicate code from its descandats (check index,...) - here to TImageFileFormat helper methods. - - Removed RAISE_EXCEPTIONS define, exceptions are now raised everytime - - Added MustBeFreed parameter to TImageFileFormat.MakeComptible method - that indicates that compatible image returned by this method must be - freed after its usage. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed bug in NewImage: if given format was ifDefault it wasn't - replaced with DefaultImageFormat constant which caused problems later - in other units - - fixed bug in RotateImage which caused that rotated special format - images were whole black - - LoadImageFromXXX and LoadMultiImageFromXXX now use DetermineXXXFormat - when choosing proper loader, this eliminated need for Ext parameter - in stream and memory loading functions - - added GetVersionStr function - - fixed bug in ResizeImage which caued indexed images to lose their - palette during process resulting in whole black image - - Clipping in ...Rect functions now uses clipping procs from ImagingUtility, - it also works better - - FillRect optimization for 8, 16, and 32 bit formats - - added pixel set/get functions to low level interface: - GetPixelDirect, SetPixelDirect, GetPixel32, SetPixel32, - GetPixelFP, SetPixelFP - - removed GetPixelBytes low level intf function - redundant - (same data can be obtained by GetImageFormatInfo) - - made small changes in many parts of library to compile - on AMD64 CPU (Linux with FPC) - - changed InitImage to procedure (function was pointless) - - Method TestFormat of TImageFileFormat class made public - (was protected) - - added function IsFileFormatSupported to low level interface - (contributed by Paul Michell) - - fixed some missing format arguments from error strings - which caused Format function to raise exception - - removed forgotten debug code that disabled filtered resizing of images with - channel bitcounts > 8 - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - changed order of parameters of CopyRect function - - GenerateMipMaps now filters mipmap levels - - ResizeImage functions was extended to allow bilinear and bicubic filtering - - added StretchRect function to low level interface - - added functions GetImageFileFormatsFilter, GetFilterIndexExtension, - and GetExtensionFilterIndex - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - added function RotateImage to low level interface - - moved TImageFormatInfo record and types required by it to - ImagingTypes unit, changed GetImageFormatInfo low level - interface function to return TImageFormatInfo instead of short info - - added checking of options values validity before they are used - - fixed possible memory leak in CloneImage - - added ReplaceColor function to low level interface - - new function FindImageFileFormat by class added - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - added DetermineFileFormat, DetermineStreamFormat, DetermineMemoryFormat, - GetPixelsSize functions to low level interface - - added NewPalette, CopyPalette, FreePalette functions - to low level interface - - added MapImageToPalette, FillRect, SplitImage, MakePaletteForImages - functions to low level interface - - fixed buggy FillCustomPalette function (possible div by zero and others) - - added CopyRect function to low level interface - - Member functions of TImageFormatInfo record implemented for all formats - - before saving images TestImagesInArray is called now - - added TestImagesInArray function to low level interface - - added GenerateMipMaps function to low level interface - - stream position in load/save from/to stream is now set to position before - function was called if error occurs - - when error occured during load/save from/to file file handle - was not released - - CloneImage returned always False - -} -end. - diff --git a/3rd/Imaging/Source/ImagingBitmap.pas b/3rd/Imaging/Source/ImagingBitmap.pas deleted file mode 100644 index 81684e4b9..000000000 --- a/3rd/Imaging/Source/ImagingBitmap.pas +++ /dev/null @@ -1,856 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ - This unit contains image format loader/saver for Windows Bitmap images. -} -unit ImagingBitmap; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingUtility, ImagingFormats, ImagingIO; - -type - { Class for loading and saving Windows Bitmap images. - It can load/save 8bit indexed, 16, 24, 32 bit RGB or ARGB - images with or without RLE compression. It can also load 1/4 bit - indexed images and OS2 bitmaps.} - TBitmapFileFormat = class(TImageFileFormat) - protected - FUseRLE: LongBool; - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - { Controls that RLE compression is used during saving. Accessible trough - ImagingBitmapRLE option.} - property UseRLE: LongBool read FUseRLE write FUseRLE; - end; - -implementation - -const - SBitmapFormatName = 'Windows Bitmap Image'; - SBitmapMasks = '*.bmp,*.dib'; - BitmapSupportedFormats: TImageFormats = [ifIndex8, ifA1R5G5B5, ifA4R4G4B4, - ifR5G6B5, ifR8G8B8, ifA8R8G8B8, ifX1R5G5B5, ifX4R4G4B4, ifX8R8G8B8]; - BitmapDefaultRLE = True; - -const - { Bitmap file identifier 'BM'.} - BMMagic: Word = 19778; - - { Constants for the TBitmapInfoHeader.Compression field.} - BI_RGB = 0; - BI_RLE8 = 1; - BI_RLE4 = 2; - BI_BITFIELDS = 3; - - V3InfoHeaderSize = 40; - V4InfoHeaderSize = 108; - -type - { File Header for Windows/OS2 bitmap file.} - TBitmapFileHeader = packed record - ID: Word; // Is always 19778 : 'BM' - Size: LongWord; // Filesize - Reserved1: Word; - Reserved2: Word; - Offset: LongWord; // Offset from start pos to beginning of image bits - end; - - { Info Header for Windows bitmap file version 4.} - TBitmapInfoHeader = packed record - Size: LongWord; - Width: LongInt; - Height: LongInt; - Planes: Word; - BitCount: Word; - Compression: LongWord; - SizeImage: LongWord; - XPelsPerMeter: LongInt; - YPelsPerMeter: LongInt; - ClrUsed: LongInt; - ClrImportant: LongInt; - RedMask: LongWord; - GreenMask: LongWord; - BlueMask: LongWord; - AlphaMask: LongWord; - CSType: LongWord; - EndPoints: array[0..8] of LongWord; - GammaRed: LongWord; - GammaGreen: LongWord; - GammaBlue: LongWord; - end; - - { Info Header for OS2 bitmaps.} - TBitmapCoreHeader = packed record - Size: LongWord; - Width: Word; - Height: Word; - Planes: Word; - BitCount: Word; - end; - - { Used in RLE encoding and decoding.} - TRLEOpcode = packed record - Count: Byte; - Command: Byte; - end; - PRLEOpcode = ^TRLEOpcode; - -{ TBitmapFileFormat class implementation } - -procedure TBitmapFileFormat.Define; -begin - inherited; - FName := SBitmapFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := BitmapSupportedFormats; - - FUseRLE := BitmapDefaultRLE; - - AddMasks(SBitmapMasks); - RegisterOption(ImagingBitmapRLE, @FUseRLE); -end; - -function TBitmapFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - BF: TBitmapFileHeader; - BI: TBitmapInfoHeader; - BC: TBitmapCoreHeader; - IsOS2: Boolean; - PalRGB: PPalette24; - I, FPalSize, AlignedSize, StartPos, HeaderSize, AlignedWidthBytes, WidthBytes: LongInt; - Info: TImageFormatInfo; - Data: Pointer; - - procedure LoadRGB; - var - I: LongInt; - LineBuffer: PByte; - begin - with Images[0], GetIO do - begin - // If BI.Height is < 0 then image data are stored non-flipped - // but default in windows is flipped so if Height is positive we must - // flip it - - if BI.BitCount < 8 then - begin - // For 1 and 4 bit images load aligned data, they will be converted to - // 8 bit and unaligned later - GetMem(Data, AlignedSize); - - if BI.Height < 0 then - Read(Handle, Data, AlignedSize) - else - for I := Height - 1 downto 0 do - Read(Handle, @PByteArray(Data)[I * AlignedWidthBytes], AlignedWidthBytes); - end - else - begin - // Images with pixels of size >= 1 Byte are read line by line and - // copied to image bits without padding bytes - GetMem(LineBuffer, AlignedWidthBytes); - try - if BI.Height < 0 then - for I := 0 to Height - 1 do - begin - Read(Handle, LineBuffer, AlignedWidthBytes); - Move(LineBuffer^, PByteArray(Bits)[I * WidthBytes], WidthBytes); - end - else - for I := Height - 1 downto 0 do - begin - Read(Handle, LineBuffer, AlignedWidthBytes); - Move(LineBuffer^, PByteArray(Bits)[I * WidthBytes], WidthBytes); - end; - finally - FreeMemNil(LineBuffer); - end; - end; - end; - end; - - procedure LoadRLE4; - var - RLESrc: PByteArray; - Row, Col, WriteRow, I: LongInt; - SrcPos: LongWord; - DeltaX, DeltaY, Low, High: Byte; - Pixels: PByteArray; - OpCode: TRLEOpcode; - NegHeightBitmap: Boolean; - begin - GetMem(RLESrc, BI.SizeImage); - GetIO.Read(Handle, RLESrc, BI.SizeImage); - with Images[0] do - try - Low := 0; - Pixels := Bits; - SrcPos := 0; - NegHeightBitmap := BI.Height < 0; - Row := 0; // Current row in dest image - Col := 0; // Current column in dest image - // Row in dest image where actuall writting will be done - WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row); - while (Row < Height) and (SrcPos < BI.SizeImage) do - begin - // Read RLE op-code - OpCode := PRLEOpcode(@RLESrc[SrcPos])^; - Inc(SrcPos, SizeOf(OpCode)); - if OpCode.Count = 0 then - begin - // A byte Count of zero means that this is a special - // instruction. - case OpCode.Command of - 0: - begin - // Move to next row - Inc(Row); - WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row); - Col := 0; - end ; - 1: Break; // Image is finished - 2: - begin - // Move to a new relative position - DeltaX := RLESrc[SrcPos]; - DeltaY := RLESrc[SrcPos + 1]; - Inc(SrcPos, 2); - Inc(Col, DeltaX); - Inc(Row, DeltaY); - end - else - // Do not read data after EOF - if SrcPos + OpCode.Command > BI.SizeImage then - OpCode.Command := BI.SizeImage - SrcPos; - // Take padding bytes and nibbles into account - if Col + OpCode.Command > Width then - OpCode.Command := Width - Col; - // Store absolute data. Command code is the - // number of absolute bytes to store - for I := 0 to OpCode.Command - 1 do - begin - if (I and 1) = 0 then - begin - High := RLESrc[SrcPos] shr 4; - Low := RLESrc[SrcPos] and $F; - Pixels[WriteRow * Width + Col] := High; - Inc(SrcPos); - end - else - Pixels[WriteRow * Width + Col] := Low; - Inc(Col); - end; - // Odd number of bytes is followed by a pad byte - if (OpCode.Command mod 4) in [1, 2] then - Inc(SrcPos); - end; - end - else - begin - // Take padding bytes and nibbles into account - if Col + OpCode.Count > Width then - OpCode.Count := Width - Col; - // Store a run of the same color value - for I := 0 to OpCode.Count - 1 do - begin - if (I and 1) = 0 then - Pixels[WriteRow * Width + Col] := OpCode.Command shr 4 - else - Pixels[WriteRow * Width + Col] := OpCode.Command and $F; - Inc(Col); - end; - end; - end; - finally - FreeMem(RLESrc); - end; - end; - - procedure LoadRLE8; - var - RLESrc: PByteArray; - SrcCount, Row, Col, WriteRow: LongInt; - SrcPos: LongWord; - DeltaX, DeltaY: Byte; - Pixels: PByteArray; - OpCode: TRLEOpcode; - NegHeightBitmap: Boolean; - begin - GetMem(RLESrc, BI.SizeImage); - GetIO.Read(Handle, RLESrc, BI.SizeImage); - with Images[0] do - try - Pixels := Bits; - SrcPos := 0; - NegHeightBitmap := BI.Height < 0; - Row := 0; // Current row in dest image - Col := 0; // Current column in dest image - // Row in dest image where actuall writting will be done - WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row); - while (Row < Height) and (SrcPos < BI.SizeImage) do - begin - // Read RLE op-code - OpCode := PRLEOpcode(@RLESrc[SrcPos])^; - Inc(SrcPos, SizeOf(OpCode)); - if OpCode.Count = 0 then - begin - // A byte Count of zero means that this is a special - // instruction. - case OpCode.Command of - 0: - begin - // Move to next row - Inc(Row); - WriteRow := Iff(NegHeightBitmap, Row, Height - 1 - Row); - Col := 0; - end ; - 1: Break; // Image is finished - 2: - begin - // Move to a new relative position - DeltaX := RLESrc[SrcPos]; - DeltaY := RLESrc[SrcPos + 1]; - Inc(SrcPos, 2); - Inc(Col, DeltaX); - Inc(Row, DeltaY); - end - else - SrcCount := OpCode.Command; - // Do not read data after EOF - if SrcPos + OpCode.Command > BI.SizeImage then - OpCode.Command := BI.SizeImage - SrcPos; - // Take padding bytes into account - if Col + OpCode.Command > Width then - OpCode.Command := Width - Col; - // Store absolute data. Command code is the - // number of absolute bytes to store - Move(RLESrc[SrcPos], Pixels[WriteRow * Width + Col], OpCode.Command); - Inc(SrcPos, SrcCount); - Inc(Col, OpCode.Command); - // Odd number of bytes is followed by a pad byte - if (SrcCount mod 2) = 1 then - Inc(SrcPos); - end; - end - else - begin - // Take padding bytes into account - if Col + OpCode.Count > Width then - OpCode.Count := Width - Col; - // Store a run of the same color value. Count is number of bytes to store - FillChar(Pixels [WriteRow * Width + Col], OpCode.Count, OpCode.Command); - Inc(Col, OpCode.Count); - end; - end; - finally - FreeMem(RLESrc); - end; - end; - -begin - Data := nil; - SetLength(Images, 1); - with GetIO, Images[0] do - try - FillChar(BI, SizeOf(BI), 0); - StartPos := Tell(Handle); - Read(Handle, @BF, SizeOf(BF)); - Read(Handle, @BI.Size, SizeOf(BI.Size)); - IsOS2 := BI.Size = SizeOf(TBitmapCoreHeader); - - // Bitmap Info reading - if IsOS2 then - begin - // OS/2 type bitmap, reads info header without 4 already read bytes - Read(Handle, @PByteArray(@BC)[SizeOf(BI.Size)], - SizeOf(TBitmapCoreHeader) - SizeOf(BI.Size)); - with BI do - begin - ClrUsed := 0; - Compression := BI_RGB; - BitCount := BC.BitCount; - Height := BC.Height; - Width := BC.Width; - end; - end - else - begin - // Windows type bitmap - HeaderSize := Min(BI.Size - SizeOf(BI.Size), SizeOf(BI) - SizeOf(BI.Size)); // do not read more than size of BI! - Read(Handle, @PByteArray(@BI)[SizeOf(BI.Size)], HeaderSize); - // SizeImage can be 0 for BI_RGB images, but it is here because of: - // I saved 8bit bitmap in Paint Shop Pro 8 as OS2 RLE compressed. - // It wrote strange 64 Byte Info header with SizeImage set to 0 - // Some progs were able to open it, some were not. - if BI.SizeImage = 0 then - BI.SizeImage := BF.Size - BF.Offset; - end; - // Bit mask reading. Only read it if there is V3 header, V4 header has - // masks laoded already (only masks for RGB in V3). - if (BI.Compression = BI_BITFIELDS) and (BI.Size = V3InfoHeaderSize) then - Read(Handle, @BI.RedMask, SizeOf(BI.RedMask) * 3); - - case BI.BitCount of - 1, 4, 8: Format := ifIndex8; - 16: - if BI.RedMask = $0F00 then - // Set XRGB4 or ARGB4 according to value of alpha mask - Format := IffFormat(BI.AlphaMask = 0, ifX4R4G4B4, ifA4R4G4B4) - else if BI.RedMask = $F800 then - Format := ifR5G6B5 - else - // R5G5B5 is default 16bit format (with Compression = BI_RGB or masks). - // We set it to A1.. and later there is a check if there are any alpha values - // and if not it is changed to X1R5G5B5 - Format := ifA1R5G5B5; - 24: Format := ifR8G8B8; - 32: Format := ifA8R8G8B8; // As with R5G5B5 there is alpha check later - end; - - NewImage(BI.Width, Abs(BI.Height), Format, Images[0]); - Info := GetFormatInfo(Format); - WidthBytes := Width * Info.BytesPerPixel; - AlignedWidthBytes := (((Width * BI.BitCount) + 31) shr 5) * 4; - AlignedSize := Height * LongInt(AlignedWidthBytes); - - // Palette settings and reading - if BI.BitCount <= 8 then - begin - // Seek to the begining of palette - Seek(Handle, StartPos + SizeOf(TBitmapFileHeader) + LongInt(BI.Size), - smFromBeginning); - if IsOS2 then - begin - // OS/2 type - FPalSize := 1 shl BI.BitCount; - GetMem(PalRGB, FPalSize * SizeOf(TColor24Rec)); - try - Read(Handle, PalRGB, FPalSize * SizeOf(TColor24Rec)); - for I := 0 to FPalSize - 1 do - with PalRGB[I] do - begin - Palette[I].R := R; - Palette[I].G := G; - Palette[I].B := B; - end; - finally - FreeMemNil(PalRGB); - end; - end - else - begin - // Windows type - FPalSize := BI.ClrUsed; - if FPalSize = 0 then - FPalSize := 1 shl BI.BitCount; - Read(Handle, Palette, FPalSize * SizeOf(TColor32Rec)); - end; - for I := 0 to Info.PaletteEntries - 1 do - Palette[I].A := $FF; - end; - - // Seek to the beginning of image bits - Seek(Handle, StartPos + LongInt(BF.Offset), smFromBeginning); - - case BI.Compression of - BI_RGB: LoadRGB; - BI_RLE4: LoadRLE4; - BI_RLE8: LoadRLE8; - BI_BITFIELDS: LoadRGB; - end; - - if BI.AlphaMask = 0 then - begin - // Alpha mask is not stored in file (V3) or not defined. - // Check alpha channels of loaded images if they might contain them. - if Format = ifA1R5G5B5 then - begin - // Check if there is alpha channel present in A1R5GB5 images, if it is not - // change format to X1R5G5B5 - if not Has16BitImageAlpha(Width * Height, Bits) then - Format := ifX1R5G5B5; - end - else if Format = ifA8R8G8B8 then - begin - // Check if there is alpha channel present in A8R8G8B8 images, if it is not - // change format to X8R8G8B8 - if not Has32BitImageAlpha(Width * Height, Bits) then - Format := ifX8R8G8B8; - end; - end; - - if BI.BitCount < 8 then - begin - // 1 and 4 bpp images are supported only for loading which is now - // so we now convert them to 8bpp (and unalign scanlines). - case BI.BitCount of - 1: Convert1To8(Data, Bits, Width, Height, AlignedWidthBytes, False); - 4: - begin - // RLE4 bitmaps are translated to 8bit during RLE decoding - if BI.Compression <> BI_RLE4 then - Convert4To8(Data, Bits, Width, Height, AlignedWidthBytes, False); - end; - end; - // Enlarge palette - ReallocMem(Palette, Info.PaletteEntries * SizeOf(TColor32Rec)); - end; - - Result := True; - finally - FreeMemNil(Data); - end; -end; - -function TBitmapFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - StartPos, EndPos, I, Pad, PadSize, WidthBytes: LongInt; - BF: TBitmapFileHeader; - BI: TBitmapInfoHeader; - Info: TImageFormatInfo; - ImageToSave: TImageData; - MustBeFreed: Boolean; - - procedure SaveRLE8; - const - BufferSize = 8 * 1024; - var - X, Y, I, SrcPos: LongInt; - DiffCount, SameCount: Byte; - Pixels: PByteArray; - Buffer: array[0..BufferSize - 1] of Byte; - BufferPos: LongInt; - - procedure WriteByte(ByteToWrite: Byte); - begin - if BufferPos = BufferSize then - begin - // Flush buffer if necessary - GetIO.Write(Handle, @Buffer, BufferPos); - BufferPos := 0; - end; - Buffer[BufferPos] := ByteToWrite; - Inc(BufferPos); - end; - - begin - BufferPos := 0; - with GetIO, ImageToSave do - begin - for Y := Height - 1 downto 0 do - begin - X := 0; - SrcPos := 0; - Pixels := @PByteArray(Bits)[Y * Width]; - - while X < Width do - begin - SameCount := 1; - DiffCount := 0; - // Determine run length - while X + SameCount < Width do - begin - // If we reach max run length or byte with different value - // we end this run - if (SameCount = 255) or (Pixels[SrcPos + SameCount] <> Pixels[SrcPos]) then - Break; - Inc(SameCount); - end; - - if SameCount = 1 then - begin - // If there are not some bytes with the same value we - // compute how many different bytes are there - while X + DiffCount < Width do - begin - // Stop diff byte counting if there two bytes with the same value - // or DiffCount is too big - if (DiffCount = 255) or (Pixels[SrcPos + DiffCount + 1] = - Pixels[SrcPos + DiffCount]) then - Break; - Inc(DiffCount); - end; - end; - - // Now store absolute data (direct copy image->file) or - // store RLE code only (number of repeats + byte to be repeated) - if DiffCount > 2 then - begin - // Save 'Absolute Data' (0 + number of bytes) but only - // if number is >2 because (0+1) and (0+2) are other special commands - WriteByte(0); - WriteByte(DiffCount); - // Write absolute data to buffer - for I := 0 to DiffCount - 1 do - WriteByte(Pixels[SrcPos + I]); - Inc(X, DiffCount); - Inc(SrcPos, DiffCount); - // Odd number of bytes must be padded - if (DiffCount mod 2) = 1 then - WriteByte(0); - end - else - begin - // Save number of repeats and byte that should be repeated - WriteByte(SameCount); - WriteByte(Pixels[SrcPos]); - Inc(X, SameCount); - Inc(SrcPos, SameCount); - end; - end; - // Save 'End Of Line' command - WriteByte(0); - WriteByte(0); - end; - // Save 'End Of Bitmap' command - WriteByte(0); - WriteByte(1); - // Flush buffer - GetIO.Write(Handle, @Buffer, BufferPos); - end; - end; - -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - StartPos := Tell(Handle); - FillChar(BF, SizeOf(BF), 0); - FillChar(BI, SizeOf(BI), 0); - // Other fields will be filled later - we don't know all values now - BF.ID := BMMagic; - Write(Handle, @BF, SizeOf(BF)); - if Info.HasAlphaChannel and (Info.BytesPerPixel = 2){V4 temp hack} then - // Save images with alpha in V4 format - BI.Size := V4InfoHeaderSize - else - // Save images without alpha in V3 format - for better compatibility - BI.Size := V3InfoHeaderSize; - BI.Width := Width; - BI.Height := Height; - BI.Planes := 1; - BI.BitCount := Info.BytesPerPixel * 8; - BI.XPelsPerMeter := 2835; // 72 dpi - BI.YPelsPerMeter := 2835; // 72 dpi - // Set compression - if (Info.BytesPerPixel = 1) and FUseRLE then - BI.Compression := BI_RLE8 - else if (Info.HasAlphaChannel or - ((BI.BitCount = 16) and (Format <> ifX1R5G5B5))) and (Info.BytesPerPixel = 2){V4 temp hack} then - BI.Compression := BI_BITFIELDS - else - BI.Compression := BI_RGB; - // Write header (first time) - Write(Handle, @BI, BI.Size); - - // Write mask info - if BI.Compression = BI_BITFIELDS then - begin - if BI.BitCount = 16 then - with Info.PixelFormat^ do - begin - BI.RedMask := RBitMask; - BI.GreenMask := GBitMask; - BI.BlueMask := BBitMask; - BI.AlphaMask := ABitMask; - end - else - begin - // Set masks for A8R8G8B8 - BI.RedMask := $00FF0000; - BI.GreenMask := $0000FF00; - BI.BlueMask := $000000FF; - BI.AlphaMask := $FF000000; - end; - // If V3 header is used RGB masks must be written to file separately. - // V4 header has embedded masks (V4 is default for formats with alpha). - if BI.Size = V3InfoHeaderSize then - Write(Handle, @BI.RedMask, SizeOf(BI.RedMask) * 3); - end; - // Write palette - if Palette <> nil then - Write(Handle, Palette, Info.PaletteEntries * SizeOf(TColor32Rec)); - - BF.Offset := Tell(Handle) - StartPos; - - if BI.Compression <> BI_RLE8 then - begin - // Save uncompressed data, scanlines must be filled with pad bytes - // to be multiples of 4, save as bottom-up (Windows native) bitmap - Pad := 0; - WidthBytes := Width * Info.BytesPerPixel; - PadSize := ((Width * BI.BitCount + 31) div 32) * 4 - WidthBytes; - - for I := Height - 1 downto 0 do - begin - Write(Handle, @PByteArray(Bits)[I * WidthBytes], WidthBytes); - if PadSize > 0 then - Write(Handle, @Pad, PadSize); - end; - end - else - begin - // Save data with RLE8 compression - SaveRLE8; - end; - - EndPos := Tell(Handle); - Seek(Handle, StartPos, smFromBeginning); - // Rewrite header with new values - BF.Size := EndPos - StartPos; - BI.SizeImage := BF.Size - BF.Offset; - Write(Handle, @BF, SizeOf(BF)); - Write(Handle, @BI, BI.Size); - Seek(Handle, EndPos, smFromBeginning); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TBitmapFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - // Convert FP image to RGB/ARGB according to presence of alpha channel - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8) - else if Info.HasGrayChannel or Info.IsIndexed then - // Convert all grayscale and indexed images to Index8 unless they have alpha - // (preserve it) - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifIndex8) - else if Info.HasAlphaChannel then - // Convert images with alpha channel to A8R8G8B8 - ConvFormat := ifA8R8G8B8 - else if Info.UsePixelFormat then - // Convert 16bit RGB images (no alpha) to X1R5G5B5 - ConvFormat := ifX1R5G5B5 - else - // Convert all other formats to R8G8B8 - ConvFormat := ifR8G8B8; - - ConvertImage(Image, ConvFormat); -end; - -function TBitmapFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TBitmapFileHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - ReadCount := Read(Handle, @Hdr, SizeOf(Hdr)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (Hdr.ID = BMMagic) and (ReadCount = SizeOf(Hdr)); - end; -end; - -initialization - RegisterImageFileFormat(TBitmapFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - Add option to choose to save V3 or V4 headers. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Fixed problem with indexed BMP loading - some pal entries - could end up with alpha=0. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Now saves bitmaps as bottom-up for better compatibility - (mainly Lazarus' TImage!). - - Fixed crash when loading bitmaps with headers larger than V4. - - Temp hacks to disable V4 headers for 32bit images (compatibility with - other soft). - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Removed temporary data allocation for image with aligned scanlines. - They are now directly written to output so memory requirements are - much lower now. - - Now uses and recognizes BITMAPINFOHEADERV4 when loading/saving. - Mainly for formats with alpha channels. - - Added ifR5G6B5 to supported formats, changed converting to supported - formats little bit. - - Rewritten SaveRLE8 nested procedure. Old code was long and - mysterious - new is short and much more readable. - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Rewritten LoadRLE4 and LoadRLE8 nested procedures. - Should be less buggy an more readable (load inspired by Colosseum Builders' code). - - Made public properties for options registered to SetOption/GetOption - functions. - - Addded alpha check to 32b bitmap loading too (teh same as in 16b - bitmap loading). - - Moved Convert1To8 and Convert4To8 to ImagingFormats - - Changed extensions to filename masks. - - Changed SaveData, LoadData, and MakeCompatible methods according - to changes in base class in Imaging unit. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - fixed wrong const that caused A4R4G4B4 BMPs to load as A1R5G5B5 - - fixed the bug that caused 8bit RLE compressed bitmaps to load as - whole black - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - 16 bit images are usually without alpha but some has alpha - channel and there is no indication of it - so I have added - a check: if all pixels of image are with alpha = 0 image is treated - as X1R5G5B5 otherwise as A1R5G5B5 - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - when loading 1/4 bit images with dword aligned dimensions - there was ugly memory rewritting bug causing image corruption - -} - -end. - diff --git a/3rd/Imaging/Source/ImagingCanvases.pas b/3rd/Imaging/Source/ImagingCanvases.pas deleted file mode 100644 index 4f1776d7a..000000000 --- a/3rd/Imaging/Source/ImagingCanvases.pas +++ /dev/null @@ -1,2111 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains canvas classes for drawing and applying effects.} -unit ImagingCanvases; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Types, Classes, ImagingTypes, Imaging, ImagingClasses, - ImagingFormats, ImagingUtility; - -const - { Color constants in ifA8R8G8B8 format.} - pcClear = $00000000; - pcBlack = $FF000000; - pcWhite = $FFFFFFFF; - pcMaroon = $FF800000; - pcGreen = $FF008000; - pcOlive = $FF808000; - pcNavy = $FF000080; - pcPurple = $FF800080; - pcTeal = $FF008080; - pcGray = $FF808080; - pcSilver = $FFC0C0C0; - pcRed = $FFFF0000; - pcLime = $FF00FF00; - pcYellow = $FFFFFF00; - pcBlue = $FF0000FF; - pcFuchsia = $FFFF00FF; - pcAqua = $FF00FFFF; - pcLtGray = $FFC0C0C0; - pcDkGray = $FF808080; - - MaxPenWidth = 256; - -type - EImagingCanvasError = class(EImagingError); - EImagingCanvasBlendingError = class(EImagingError); - - { Fill mode used when drawing filled objects on canvas.} - TFillMode = ( - fmSolid, // Solid fill using current fill color - fmClear // No filling done - ); - - { Pen mode used when drawing lines, object outlines, and similar on canvas.} - TPenMode = ( - pmSolid, // Draws solid lines using current pen color. - pmClear // No drawing done - ); - - { Source and destination blending factors for drawing functions with blending. - Blending formula: SrcColor * SrcFactor + DestColor * DestFactor } - TBlendingFactor = ( - bfIgnore, // Don't care - bfZero, // For Src and Dest, Factor = (0, 0, 0, 0) - bfOne, // For Src and Dest, Factor = (1, 1, 1, 1) - bfSrcAlpha, // For Src and Dest, Factor = (Src.A, Src.A, Src.A, Src.A) - bfOneMinusSrcAlpha, // For Src and Dest, Factor = (1 - Src.A, 1 - Src.A, 1 - Src.A, 1 - Src.A) - bfDstAlpha, // For Src and Dest, Factor = (Dest.A, Dest.A, Dest.A, Dest.A) - bfOneMinusDstAlpha, // For Src and Dest, Factor = (1 - Dest.A, 1 - Dest.A, 1 - Dest.A, 1 - Dest.A) - bfSrcColor, // For Dest, Factor = (Src.R, Src.R, Src.B, Src.A) - bfOneMinusSrcColor, // For Dest, Factor = (1 - Src.R, 1 - Src.G, 1 - Src.B, 1 - Src.A) - bfDstColor, // For Src, Factor = (Dest.R, Dest.G, Dest.B, Dest.A) - bfOneMinusDstColor // For Src, Factor = (1 - Dest.R, 1 - Dest.G, 1 - Dest.B, 1 - Dest.A) - ); - - { Procedure for custom pixel write modes with blending.} - TPixelWriteProc = procedure(const SrcPix: TColorFPRec; DestPtr: PByte; - DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor); - - { Represents 3x3 convolution filter kernel.} - TConvolutionFilter3x3 = record - Kernel: array[0..2, 0..2] of LongInt; - Divisor: LongInt; - Bias: Single; - end; - - { Represents 5x5 convolution filter kernel.} - TConvolutionFilter5x5 = record - Kernel: array[0..4, 0..4] of LongInt; - Divisor: LongInt; - Bias: Single; - end; - - TPointTransformFunction = function(const Pixel: TColorFPRec; - Param1, Param2, Param3: Single): TColorFPRec; - - TDynFPPixelArray = array of TColorFPRec; - - THistogramArray = array[Byte] of Integer; - - TSelectPixelFunction = function(var Pixels: TDynFPPixelArray): TColorFPRec; - - { Base canvas class for drawing objects, applying effects, and other. - Constructor takes TBaseImage (or pointer to TImageData). Source image - bits are not copied but referenced so all canvas functions affect - source image and vice versa. When you change format or resolution of - source image you must call UpdateCanvasState method (so canvas could - recompute some data size related stuff). - - TImagingCanvas works for all image data formats except special ones - (compressed). Because of this its methods are quite slow (they usually work - with colors in ifA32R32G32B32F format). If you want fast drawing you - can use one of fast canvas clases. These descendants of TImagingCanvas - work only for few select formats (or only one) but they are optimized thus - much faster. - } - TImagingCanvas = class(TObject) - private - FDataSizeOnUpdate: LongInt; - FLineRecursion: Boolean; - function GetPixel32(X, Y: LongInt): TColor32; virtual; - function GetPixelFP(X, Y: LongInt): TColorFPRec; virtual; - function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetPixel32(X, Y: LongInt; const Value: TColor32); virtual; - procedure SetPixelFP(X, Y: LongInt; const Value: TColorFPRec); virtual; - procedure SetPenColor32(const Value: TColor32); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetPenColorFP(const Value: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetPenWidth(const Value: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetFillColor32(const Value: TColor32); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetFillColorFP(const Value: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetClipRect(const Value: TRect); - procedure CheckBeforeBlending(SrcFactor, DestFactor: TBlendingFactor; DestCanvas: TImagingCanvas); - protected - FPData: PImageData; - FClipRect: TRect; - FPenColorFP: TColorFPRec; - FPenColor32: TColor32; - FPenMode: TPenMode; - FPenWidth: LongInt; - FFillColorFP: TColorFPRec; - FFillColor32: TColor32; - FFillMode: TFillMode; - FNativeColor: TColorFPRec; - FFormatInfo: TImageFormatInfo; - - { Returns pointer to pixel at given position.} - function GetPixelPointer(X, Y: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} - { Translates given FP color to native format of canvas and stores it - in FNativeColor field (its bit copy) or user pointer (in overloaded method).} - procedure TranslateFPToNative(const Color: TColorFPRec); overload; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure TranslateFPToNative(const Color: TColorFPRec; Native: Pointer); overload; {$IFDEF USE_INLINE}inline;{$ENDIF} - { Clipping function used by horizontal and vertical line drawing functions.} - function ClipAxisParallelLine(var A1, A2, B: LongInt; - AStart, AStop, BStart, BStop: LongInt): Boolean; - { Internal horizontal line drawer used mainly for filling inside of objects - like ellipses and circles.} - procedure HorzLineInternal(X1, X2, Y: LongInt; Color: Pointer; Bpp: LongInt); virtual; - procedure CopyPixelInternal(X, Y: LongInt; Pixel: Pointer; Bpp: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure DrawInternal(const SrcRect: TRect; DestCanvas: TImagingCanvas; - DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc); - procedure StretchDrawInternal(const SrcRect: TRect; DestCanvas: TImagingCanvas; - const DestRect: TRect; SrcFactor, DestFactor: TBlendingFactor; - Filter: TResizeFilter; PixelWriteProc: TPixelWriteProc); - public - constructor CreateForData(ImageDataPointer: PImageData); - constructor CreateForImage(Image: TBaseImage); - destructor Destroy; override; - - { Call this method when you change size or format of image this canvas - operates on (like calling ResizeImage, ConvertImage, or changing Format - property of TBaseImage descendants).} - procedure UpdateCanvasState; virtual; - { Resets clipping rectangle to Rect(0, 0, ImageWidth, ImageHeight).} - procedure ResetClipRect; - - { Clears entire canvas with current fill color (ignores clipping rectangle - and always uses fmSolid fill mode).} - procedure Clear; - - { Draws horizontal line with current pen settings.} - procedure HorzLine(X1, X2, Y: LongInt); virtual; - { Draws vertical line with current pen settings.} - procedure VertLine(X, Y1, Y2: LongInt); virtual; - { Draws line from [X1, Y1] to [X2, Y2] with current pen settings.} - procedure Line(X1, Y1, X2, Y2: LongInt); virtual; - { Draws a rectangle using current pen settings.} - procedure FrameRect(const Rect: TRect); - { Fills given rectangle with current fill settings.} - procedure FillRect(const Rect: TRect); virtual; - { Fills given rectangle with current fill settings and pixel blending.} - procedure FillRectBlend(const Rect: TRect; SrcFactor, DestFactor: TBlendingFactor); - { Draws rectangle which is outlined by using the current pen settings and - filled by using the current fill settings.} - procedure Rectangle(const Rect: TRect); - { Draws ellipse which is outlined by using the current pen settings and - filled by using the current fill settings. Rect specifies bounding rectangle - of ellipse to be drawn.} - procedure Ellipse(const Rect: TRect); - { Fills area of canvas with current fill color starting at point [X, Y] and - coloring its neighbors. Default flood fill mode changes color of all - neighbors with the same color as pixel [X, Y]. With BoundaryFillMode - set to True neighbors are recolored regardless of their old color, - but area which will be recolored has boundary (specified by current pen color).} - procedure FloodFill(X, Y: Integer; BoundaryFillMode: Boolean = False); - - { Draws contents of this canvas onto another canvas with pixel blending. - Blending factors are chosen using TBlendingFactor parameters. - Resulting destination pixel color is: - SrcColor * SrcFactor + DstColor * DstFactor} - procedure DrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas; - DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor); - { Draws contents of this canvas onto another one with typical alpha - blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)} - procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); virtual; - { Draws contents of this canvas onto another one using additive blending - (source and dest factors are bfOne).} - procedure DrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); - { Draws stretched and filtered contents of this canvas onto another canvas - with pixel blending. Blending factors are chosen using TBlendingFactor parameters. - Resulting destination pixel color is: - SrcColor * SrcFactor + DstColor * DstFactor} - procedure StretchDrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas; - const DestRect: TRect; SrcFactor, DestFactor: TBlendingFactor; - Filter: TResizeFilter = rfBilinear); - { Draws contents of this canvas onto another one with typical alpha - blending (Src 'over' Dest, factors are bfSrcAlpha and bfOneMinusSrcAlpha.)} - procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; - const DestRect: TRect; Filter: TResizeFilter = rfBilinear); virtual; - { Draws contents of this canvas onto another one using additive blending - (source and dest factors are bfOne).} - procedure StretchDrawAdd(const SrcRect: TRect; DestCanvas: TImagingCanvas; - const DestRect: TRect; Filter: TResizeFilter = rfBilinear); - - { Convolves canvas' image with given 3x3 filter kernel. You can use - predefined filter kernels or define your own.} - procedure ApplyConvolution3x3(const Filter: TConvolutionFilter3x3); - { Convolves canvas' image with given 5x5 filter kernel. You can use - predefined filter kernels or define your own.} - procedure ApplyConvolution5x5(const Filter: TConvolutionFilter5x5); - { Computes 2D convolution of canvas' image and given filter kernel. - Kernel is in row format and KernelSize must be odd number >= 3. Divisor - is normalizing value based on Kernel (usually sum of all kernel's cells). - The Bias number shifts each color value by a fixed amount (color values - are usually in range [0, 1] during processing). If ClampChannels - is True all output color values are clamped to [0, 1]. You can use - predefined filter kernels or define your own.} - procedure ApplyConvolution(Kernel: PLongInt; KernelSize, Divisor: LongInt; - Bias: Single = 0.0; ClampChannels: Boolean = True); virtual; - - { Applies custom non-linear filter. Filter size is diameter of pixel - neighborhood. Typical values are 3, 5, or 7. } - procedure ApplyNonLinearFilter(FilterSize: Integer; SelectFunc: TSelectPixelFunction); - { Applies median non-linear filter with user defined pixel neighborhood. - Selects median pixel from the neighborhood as new pixel - (current implementation is quite slow).} - procedure ApplyMedianFilter(FilterSize: Integer); - { Applies min non-linear filter with user defined pixel neighborhood. - Selects min pixel from the neighborhood as new pixel.} - procedure ApplyMinFilter(FilterSize: Integer); - { Applies max non-linear filter with user defined pixel neighborhood. - Selects max pixel from the neighborhood as new pixel.} - procedure ApplyMaxFilter(FilterSize: Integer); - - { Transforms pixels one by one by given function. Pixel neighbors are - not taken into account. Param 1-3 are optional parameters - for transform function.} - procedure PointTransform(Transform: TPointTransformFunction; - Param1, Param2, Param3: Single); - { Modifies image contrast and brightness. Parameters should be - in range <-100; 100>.} - procedure ModifyContrastBrightness(Contrast, Brightness: Single); - { Gamma correction of individual color channels. Range is (0, +inf), - 1.0 means no change.} - procedure GammaCorection(Red, Green, Blue: Single); - { Inverts colors of all image pixels, makes negative image. Ignores alpha channel.} - procedure InvertColors; virtual; - { Simple single level thresholding with threshold level (in range [0, 1]) - for each color channel.} - procedure Threshold(Red, Green, Blue: Single); - { Adjusts the color levels of the image by scaling the - colors falling between specified white and black points to full [0, 1] range. - The black point specifies the darkest color in the image, white point - specifies the lightest color, and mid point is gamma aplied to image. - Black and white point must be in range [0, 1].} - procedure AdjustColorLevels(BlackPoint, WhitePoint: Single; MidPoint: Single = 1.0); - { Premultiplies color channel values by alpha. Needed for some platforms/APIs - to display images with alpha properly.} - procedure PremultiplyAlpha; - { Reverses PremultiplyAlpha operation.} - procedure UnPremultiplyAlpha; - - { Calculates image histogram for each channel and also gray values. Each - channel has 256 values available. Channel values of data formats with higher - precision are scaled and rounded. Example: Red[126] specifies number of pixels - in image with red channel = 126.} - procedure GetHistogram(out Red, Green, Blue, Alpha, Gray: THistogramArray); - { Fills image channel with given value leaving other channels intact. - Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as - channel identifier.} - procedure FillChannel(ChannelId: Integer; NewChannelValue: Byte); overload; - { Fills image channel with given value leaving other channels intact. - Use ChannelAlpha, ChannelRed, etc. constants from ImagingTypes as - channel identifier.} - procedure FillChannelFP(ChannelId: Integer; NewChannelValue: Single); overload; - - { Color used when drawing lines, frames, and outlines of objects.} - property PenColor32: TColor32 read FPenColor32 write SetPenColor32; - { Color used when drawing lines, frames, and outlines of objects.} - property PenColorFP: TColorFPRec read FPenColorFP write SetPenColorFP; - { Pen mode used when drawing lines, object outlines, and similar on canvas.} - property PenMode: TPenMode read FPenMode write FPenMode; - { Width with which objects like lines, frames, etc. (everything which uses - PenColor) are drawn.} - property PenWidth: LongInt read FPenWidth write SetPenWidth; - { Color used for filling when drawing various objects.} - property FillColor32: TColor32 read FFillColor32 write SetFillColor32; - { Color used for filling when drawing various objects.} - property FillColorFP: TColorFPRec read FFillColorFP write SetFillColorFP; - { Fill mode used when drawing filled objects on canvas.} - property FillMode: TFillMode read FFillMode write FFillMode; - { Specifies the current color of the pixels of canvas. Native pixel is - read from canvas and then translated to 32bit ARGB. Reverse operation - is made when setting pixel color.} - property Pixels32[X, Y: LongInt]: TColor32 read GetPixel32 write SetPixel32; - { Specifies the current color of the pixels of canvas. Native pixel is - read from canvas and then translated to FP ARGB. Reverse operation - is made when setting pixel color.} - property PixelsFP[X, Y: LongInt]: TColorFPRec read GetPixelFP write SetPixelFP; - { Clipping rectangle of this canvas. No pixels outside this rectangle are - altered by canvas methods if Clipping property is True. Clip rect gets - reseted when UpdateCanvasState is called.} - property ClipRect: TRect read FClipRect write SetClipRect; - { Extended format information.} - property FormatInfo: TImageFormatInfo read FFormatInfo; - { Indicates that this canvas is in valid state. If False canvas oprations - may crash.} - property Valid: Boolean read GetValid; - - { Returns all formats supported by this canvas class.} - class function GetSupportedFormats: TImageFormats; virtual; - end; - - TImagingCanvasClass = class of TImagingCanvas; - - TScanlineArray = array[0..MaxInt div SizeOf(Pointer) - 1] of PColor32RecArray; - PScanlineArray = ^TScanlineArray; - - { Fast canvas class for ifA8R8G8B8 format images.} - TFastARGB32Canvas = class(TImagingCanvas) - protected - FScanlines: PScanlineArray; - procedure AlphaBlendPixels(SrcPix, DestPix: PColor32Rec); {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetPixel32(X, Y: LongInt): TColor32; override; - procedure SetPixel32(X, Y: LongInt; const Value: TColor32); override; - public - destructor Destroy; override; - - procedure UpdateCanvasState; override; - - procedure DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; DestX, DestY: Integer); override; - procedure StretchDrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; - const DestRect: TRect; Filter: TResizeFilter = rfBilinear); override; - procedure InvertColors; override; - - property Scanlines: PScanlineArray read FScanlines; - - class function GetSupportedFormats: TImageFormats; override; - end; - -const - { Kernel for 3x3 average smoothing filter.} - FilterAverage3x3: TConvolutionFilter3x3 = ( - Kernel: ((1, 1, 1), - (1, 1, 1), - (1, 1, 1)); - Divisor: 9); - - { Kernel for 5x5 average smoothing filter.} - FilterAverage5x5: TConvolutionFilter5x5 = ( - Kernel: ((1, 1, 1, 1, 1), - (1, 1, 1, 1, 1), - (1, 1, 1, 1, 1), - (1, 1, 1, 1, 1), - (1, 1, 1, 1, 1)); - Divisor: 25); - - { Kernel for 3x3 Gaussian smoothing filter.} - FilterGaussian3x3: TConvolutionFilter3x3 = ( - Kernel: ((1, 2, 1), - (2, 4, 2), - (1, 2, 1)); - Divisor: 16); - - { Kernel for 5x5 Gaussian smoothing filter.} - FilterGaussian5x5: TConvolutionFilter5x5 = ( - Kernel: ((1, 4, 6, 4, 1), - (4, 16, 24, 16, 4), - (6, 24, 36, 24, 6), - (4, 16, 24, 16, 4), - (1, 4, 6, 4, 1)); - Divisor: 256); - - { Kernel for 3x3 Sobel horizontal edge detection filter (1st derivative approximation).} - FilterSobelHorz3x3: TConvolutionFilter3x3 = ( - Kernel: (( 1, 2, 1), - ( 0, 0, 0), - (-1, -2, -1)); - Divisor: 1); - - { Kernel for 3x3 Sobel vertical edge detection filter (1st derivative approximation).} - FilterSobelVert3x3: TConvolutionFilter3x3 = ( - Kernel: ((-1, 0, 1), - (-2, 0, 2), - (-1, 0, 1)); - Divisor: 1); - - { Kernel for 3x3 Prewitt horizontal edge detection filter.} - FilterPrewittHorz3x3: TConvolutionFilter3x3 = ( - Kernel: (( 1, 1, 1), - ( 0, 0, 0), - (-1, -1, -1)); - Divisor: 1); - - { Kernel for 3x3 Prewitt vertical edge detection filter.} - FilterPrewittVert3x3: TConvolutionFilter3x3 = ( - Kernel: ((-1, 0, 1), - (-1, 0, 1), - (-1, 0, 1)); - Divisor: 1); - - { Kernel for 3x3 Kirsh horizontal edge detection filter.} - FilterKirshHorz3x3: TConvolutionFilter3x3 = ( - Kernel: (( 5, 5, 5), - (-3, 0, -3), - (-3, -3, -3)); - Divisor: 1); - - { Kernel for 3x3 Kirsh vertical edge detection filter.} - FilterKirshVert3x3: TConvolutionFilter3x3 = ( - Kernel: ((5, -3, -3), - (5, 0, -3), - (5, -3, -3)); - Divisor: 1); - - { Kernel for 3x3 Laplace omni-directional edge detection filter - (2nd derivative approximation).} - FilterLaplace3x3: TConvolutionFilter3x3 = ( - Kernel: ((-1, -1, -1), - (-1, 8, -1), - (-1, -1, -1)); - Divisor: 1); - - { Kernel for 5x5 Laplace omni-directional edge detection filter - (2nd derivative approximation).} - FilterLaplace5x5: TConvolutionFilter5x5 = ( - Kernel: ((-1, -1, -1, -1, -1), - (-1, -1, -1, -1, -1), - (-1, -1, 24, -1, -1), - (-1, -1, -1, -1, -1), - (-1, -1, -1, -1, -1)); - Divisor: 1); - - { Kernel for 3x3 spharpening filter (Laplacian + original color).} - FilterSharpen3x3: TConvolutionFilter3x3 = ( - Kernel: ((-1, -1, -1), - (-1, 9, -1), - (-1, -1, -1)); - Divisor: 1); - - { Kernel for 5x5 spharpening filter (Laplacian + original color).} - FilterSharpen5x5: TConvolutionFilter5x5 = ( - Kernel: ((-1, -1, -1, -1, -1), - (-1, -1, -1, -1, -1), - (-1, -1, 25, -1, -1), - (-1, -1, -1, -1, -1), - (-1, -1, -1, -1, -1)); - Divisor: 1); - - { Kernel for 5x5 glow filter.} - FilterGlow5x5: TConvolutionFilter5x5 = ( - Kernel: (( 1, 2, 2, 2, 1), - ( 2, 0, 0, 0, 2), - ( 2, 0, -20, 0, 2), - ( 2, 0, 0, 0, 2), - ( 1, 2, 2, 2, 1)); - Divisor: 8); - - { Kernel for 3x3 edge enhancement filter.} - FilterEdgeEnhance3x3: TConvolutionFilter3x3 = ( - Kernel: ((-1, -2, -1), - (-2, 16, -2), - (-1, -2, -1)); - Divisor: 4); - - { Kernel for 3x3 contour enhancement filter.} - FilterTraceControur3x3: TConvolutionFilter3x3 = ( - Kernel: ((-6, -6, -2), - (-1, 32, -1), - (-6, -2, -6)); - Divisor: 4; - Bias: 240/255); - - { Kernel for filter that negates all images pixels.} - FilterNegative3x3: TConvolutionFilter3x3 = ( - Kernel: ((0, 0, 0), - (0, -1, 0), - (0, 0, 0)); - Divisor: 1; - Bias: 1); - - { Kernel for 3x3 horz/vert embossing filter.} - FilterEmboss3x3: TConvolutionFilter3x3 = ( - Kernel: ((2, 0, 0), - (0, -1, 0), - (0, 0, -1)); - Divisor: 1; - Bias: 0.5); - - -{ You can register your own canvas class. List of registered canvases is used - by FindBestCanvasForImage functions to find best canvas for given image. - If two different canvases which support the same image data format are - registered then the one that was registered later is returned (so you can - override builtin Imaging canvases).} -procedure RegisterCanvas(CanvasClass: TImagingCanvasClass); -{ Returns best canvas for given TImageFormat.} -function FindBestCanvasForImage(ImageFormat: TImageFormat): TImagingCanvasClass; overload; -{ Returns best canvas for given TImageData.} -function FindBestCanvasForImage(const ImageData: TImageData): TImagingCanvasClass; overload; -{ Returns best canvas for given TBaseImage.} -function FindBestCanvasForImage(Image: TBaseImage): TImagingCanvasClass; overload; - -implementation - -resourcestring - SConstructorInvalidPointer = 'Invalid pointer (%p) to TImageData passed to TImagingCanvas constructor.'; - SConstructorInvalidImage = 'Invalid image data passed to TImagingCanvas constructor (%s).'; - SConstructorUnsupportedFormat = 'Image passed to TImagingCanvas constructor is in unsupported format (%s)'; - -var - // list with all registered TImagingCanvas classes - CanvasClasses: TList = nil; - -procedure RegisterCanvas(CanvasClass: TImagingCanvasClass); -begin - Assert(CanvasClass <> nil); - if CanvasClasses = nil then - CanvasClasses := TList.Create; - if CanvasClasses.IndexOf(CanvasClass) < 0 then - CanvasClasses.Add(CanvasClass); -end; - -function FindBestCanvasForImage(ImageFormat: TImageFormat): TImagingCanvasClass; overload; -var - I: LongInt; -begin - for I := CanvasClasses.Count - 1 downto 0 do - begin - if ImageFormat in TImagingCanvasClass(CanvasClasses[I]).GetSupportedFormats then - begin - Result := TImagingCanvasClass(CanvasClasses[I]); - Exit; - end; - end; - Result := TImagingCanvas; -end; - -function FindBestCanvasForImage(const ImageData: TImageData): TImagingCanvasClass; -begin - Result := FindBestCanvasForImage(ImageData.Format); -end; - -function FindBestCanvasForImage(Image: TBaseImage): TImagingCanvasClass; -begin - Result := FindBestCanvasForImage(Image.Format); -end; - -{ Canvas helper functions } - -procedure PixelBlendProc(const SrcPix: TColorFPRec; DestPtr: PByte; - DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor); -var - DestPix, FSrc, FDst: TColorFPRec; -begin - // Get set pixel color - DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil); - // Determine current blending factors - case SrcFactor of - bfZero: FSrc := ColorFP(0, 0, 0, 0); - bfOne: FSrc := ColorFP(1, 1, 1, 1); - bfSrcAlpha: FSrc := ColorFP(SrcPix.A, SrcPix.A, SrcPix.A, SrcPix.A); - bfOneMinusSrcAlpha: FSrc := ColorFP(1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A); - bfDstAlpha: FSrc := ColorFP(DestPix.A, DestPix.A, DestPix.A, DestPix.A); - bfOneMinusDstAlpha: FSrc := ColorFP(1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A); - bfDstColor: FSrc := ColorFP(DestPix.A, DestPix.R, DestPix.G, DestPix.B); - bfOneMinusDstColor: FSrc := ColorFP(1 - DestPix.A, 1 - DestPix.R, 1 - DestPix.G, 1 - DestPix.B); - end; - case DestFactor of - bfZero: FDst := ColorFP(0, 0, 0, 0); - bfOne: FDst := ColorFP(1, 1, 1, 1); - bfSrcAlpha: FDst := ColorFP(SrcPix.A, SrcPix.A, SrcPix.A, SrcPix.A); - bfOneMinusSrcAlpha: FDst := ColorFP(1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A, 1 - SrcPix.A); - bfDstAlpha: FDst := ColorFP(DestPix.A, DestPix.A, DestPix.A, DestPix.A); - bfOneMinusDstAlpha: FDst := ColorFP(1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A, 1 - DestPix.A); - bfSrcColor: FDst := ColorFP(SrcPix.A, SrcPix.R, SrcPix.G, SrcPix.B); - bfOneMinusSrcColor: FDst := ColorFP(1 - SrcPix.A, 1 - SrcPix.R, 1 - SrcPix.G, 1 - SrcPix.B); - end; - // Compute blending formula - DestPix.R := SrcPix.R * FSrc.R + DestPix.R * FDst.R; - DestPix.G := SrcPix.G * FSrc.G + DestPix.G * FDst.G; - DestPix.B := SrcPix.B * FSrc.B + DestPix.B * FDst.B; - DestPix.A := SrcPix.A * FSrc.A + DestPix.A * FDst.A; - // Write blended pixel - DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix); -end; - -procedure PixelAlphaProc(const SrcPix: TColorFPRec; DestPtr: PByte; - DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor); -var - DestPix: TColorFPRec; - SrcAlpha, DestAlpha: Single; -begin - DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil); - // Blend the two pixels (Src 'over' Dest alpha composition operation) - DestPix.A := SrcPix.A + DestPix.A - SrcPix.A * DestPix.A; - if DestPix.A = 0 then - SrcAlpha := 0 - else - SrcAlpha := SrcPix.A / DestPix.A; - DestAlpha := 1.0 - SrcAlpha; - DestPix.R := SrcPix.R * SrcAlpha + DestPix.R * DestAlpha; - DestPix.G := SrcPix.G * SrcAlpha + DestPix.G * DestAlpha; - DestPix.B := SrcPix.B * SrcAlpha + DestPix.B * DestAlpha; - // Write blended pixel - DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix); -end; - -procedure PixelAddProc(const SrcPix: TColorFPRec; DestPtr: PByte; - DestInfo: PImageFormatInfo; SrcFactor, DestFactor: TBlendingFactor); -var - DestPix: TColorFPRec; -begin - // Just add Src and Dest - DestPix := DestInfo.GetPixelFP(DestPtr, DestInfo, nil); - DestPix.R := SrcPix.R + DestPix.R; - DestPix.G := SrcPix.G + DestPix.G; - DestPix.B := SrcPix.B + DestPix.B; - DestPix.A := SrcPix.A + DestPix.A; - DestInfo.SetPixelFP(DestPtr, DestInfo, nil, DestPix); -end; - -function CompareColors(const C1, C2: TColorFPRec): Single; {$IFDEF USE_INLINE}inline;{$ENDIF} -begin - Result := (C1.R * GrayConv.R + C1.G * GrayConv.G + C1.B * GrayConv.B) - - (C2.R * GrayConv.R + C2.G * GrayConv.G + C2.B * GrayConv.B); -end; - -function MedianSelect(var Pixels: TDynFPPixelArray): TColorFPRec; - - procedure QuickSort(L, R: Integer); - var - I, J: Integer; - P, Temp: TColorFPRec; - begin - repeat - I := L; - J := R; - P := Pixels[(L + R) shr 1]; - repeat - while CompareColors(Pixels[I], P) < 0 do Inc(I); - while CompareColors(Pixels[J], P) > 0 do Dec(J); - if I <= J then - begin - Temp := Pixels[I]; - Pixels[I] := Pixels[J]; - Pixels[J] := Temp; - Inc(I); - Dec(J); - end; - until I > J; - if L < J then - QuickSort(L, J); - L := I; - until I >= R; - end; - -begin - // First sort pixels - QuickSort(0, High(Pixels)); - // Select middle pixel - Result := Pixels[Length(Pixels) div 2]; -end; - -function MinSelect(var Pixels: TDynFPPixelArray): TColorFPRec; -var - I: Integer; -begin - Result := Pixels[0]; - for I := 1 to High(Pixels) do - begin - if CompareColors(Pixels[I], Result) < 0 then - Result := Pixels[I]; - end; -end; - -function MaxSelect(var Pixels: TDynFPPixelArray): TColorFPRec; -var - I: Integer; -begin - Result := Pixels[0]; - for I := 1 to High(Pixels) do - begin - if CompareColors(Pixels[I], Result) > 0 then - Result := Pixels[I]; - end; -end; - -function TransformContrastBrightness(const Pixel: TColorFPRec; C, B, P3: Single): TColorFPRec; -begin - Result.A := Pixel.A; - Result.R := Pixel.R * C + B; - Result.G := Pixel.G * C + B; - Result.B := Pixel.B * C + B; -end; - -function TransformGamma(const Pixel: TColorFPRec; R, G, B: Single): TColorFPRec; -begin - Result.A := Pixel.A; - Result.R := Power(Pixel.R, 1.0 / R); - Result.G := Power(Pixel.G, 1.0 / G); - Result.B := Power(Pixel.B, 1.0 / B); -end; - -function TransformInvert(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec; -begin - Result.A := Pixel.A; - Result.R := 1.0 - Pixel.R; - Result.G := 1.0 - Pixel.G; - Result.B := 1.0 - Pixel.B; -end; - -function TransformThreshold(const Pixel: TColorFPRec; R, G, B: Single): TColorFPRec; -begin - Result.A := Pixel.A; - Result.R := IffFloat(Pixel.R >= R, 1.0, 0.0); - Result.G := IffFloat(Pixel.G >= G, 1.0, 0.0); - Result.B := IffFloat(Pixel.B >= B, 1.0, 0.0); -end; - -function TransformLevels(const Pixel: TColorFPRec; BlackPoint, WhitePoint, Exp: Single): TColorFPRec; -begin - Result.A := Pixel.A; - if Pixel.R > BlackPoint then - Result.R := Power((Pixel.R - BlackPoint) / (WhitePoint - BlackPoint), Exp) - else - Result.R := 0.0; - if Pixel.G > BlackPoint then - Result.G := Power((Pixel.G - BlackPoint) / (WhitePoint - BlackPoint), Exp) - else - Result.G := 0.0; - if Pixel.B > BlackPoint then - Result.B := Power((Pixel.B - BlackPoint) / (WhitePoint - BlackPoint), Exp) - else - Result.B := 0.0; -end; - -function TransformPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec; -begin - Result.A := Pixel.A; - Result.R := Result.R * Pixel.A; - Result.G := Result.G * Pixel.A; - Result.B := Result.B * Pixel.A; -end; - -function TransformUnPremultiplyAlpha(const Pixel: TColorFPRec; P1, P2, P3: Single): TColorFPRec; -begin - Result.A := Pixel.A; - if Pixel.A <> 0.0 then - begin - Result.R := Result.R / Pixel.A; - Result.G := Result.G / Pixel.A; - Result.B := Result.B / Pixel.A; - end - else - begin - Result.R := 0; - Result.G := 0; - Result.B := 0; - end; -end; - - -{ TImagingCanvas class implementation } - -constructor TImagingCanvas.CreateForData(ImageDataPointer: PImageData); -begin - if ImageDataPointer = nil then - raise EImagingCanvasError.CreateFmt(SConstructorInvalidPointer, [ImageDataPointer]); - - if not TestImage(ImageDataPointer^) then - raise EImagingCanvasError.CreateFmt(SConstructorInvalidImage, [Imaging.ImageToStr(ImageDataPointer^)]); - - if not (ImageDataPointer.Format in GetSupportedFormats) then - raise EImagingCanvasError.CreateFmt(SConstructorUnsupportedFormat, [Imaging.ImageToStr(ImageDataPointer^)]); - - FPData := ImageDataPointer; - FPenWidth := 1; - SetPenColor32(pcWhite); - SetFillColor32(pcBlack); - FFillMode := fmSolid; - - UpdateCanvasState; -end; - -constructor TImagingCanvas.CreateForImage(Image: TBaseImage); -begin - CreateForData(Image.ImageDataPointer); -end; - -destructor TImagingCanvas.Destroy; -begin - inherited Destroy; -end; - -function TImagingCanvas.GetPixel32(X, Y: LongInt): TColor32; -begin - Result := Imaging.GetPixel32(FPData^, X, Y).Color; -end; - -function TImagingCanvas.GetPixelFP(X, Y: LongInt): TColorFPRec; -begin - Result := Imaging.GetPixelFP(FPData^, X, Y); -end; - -function TImagingCanvas.GetValid: Boolean; -begin - Result := (FPData <> nil) and (FDataSizeOnUpdate = FPData.Size); -end; - -procedure TImagingCanvas.SetPixel32(X, Y: LongInt; const Value: TColor32); -begin - if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and - (X < FClipRect.Right) and (Y < FClipRect.Bottom) then - begin - Imaging.SetPixel32(FPData^, X, Y, TColor32Rec(Value)); - end; -end; - -procedure TImagingCanvas.SetPixelFP(X, Y: LongInt; const Value: TColorFPRec); -begin - if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and - (X < FClipRect.Right) and (Y < FClipRect.Bottom) then - begin - Imaging.SetPixelFP(FPData^, X, Y, TColorFPRec(Value)); - end; -end; - -procedure TImagingCanvas.SetPenColor32(const Value: TColor32); -begin - FPenColor32 := Value; - TranslatePixel(@FPenColor32, @FPenColorFP, ifA8R8G8B8, ifA32R32G32B32F, nil, nil); -end; - -procedure TImagingCanvas.SetPenColorFP(const Value: TColorFPRec); -begin - FPenColorFP := Value; - TranslatePixel(@FPenColorFP, @FPenColor32, ifA32R32G32B32F, ifA8R8G8B8, nil, nil); -end; - -procedure TImagingCanvas.SetPenWidth(const Value: LongInt); -begin - FPenWidth := ClampInt(Value, 0, MaxPenWidth); -end; - -procedure TImagingCanvas.SetFillColor32(const Value: TColor32); -begin - FFillColor32 := Value; - TranslatePixel(@FFillColor32, @FFillColorFP, ifA8R8G8B8, ifA32R32G32B32F, nil, nil); -end; - -procedure TImagingCanvas.SetFillColorFP(const Value: TColorFPRec); -begin - FFillColorFP := Value; - TranslatePixel(@FFillColorFP, @FFillColor32, ifA32R32G32B32F, ifA8R8G8B8, nil, nil); -end; - -procedure TImagingCanvas.SetClipRect(const Value: TRect); -begin - FClipRect := Value; - SwapMin(FClipRect.Left, FClipRect.Right); - SwapMin(FClipRect.Top, FClipRect.Bottom); - IntersectRect(FClipRect, FClipRect, Rect(0, 0, FPData.Width, FPData.Height)); -end; - -procedure TImagingCanvas.CheckBeforeBlending(SrcFactor, - DestFactor: TBlendingFactor; DestCanvas: TImagingCanvas); -begin - if SrcFactor in [bfSrcColor, bfOneMinusSrcColor] then - raise EImagingCanvasBlendingError.Create('Invalid source blending factor. Check the documentation for TBlendingFactor.'); - if DestFactor in [bfDstColor, bfOneMinusDstColor] then - raise EImagingCanvasBlendingError.Create('Invalid destination blending factor. Check the documentation for TBlendingFactor.'); - if DestCanvas.FormatInfo.IsIndexed then - raise EImagingCanvasBlendingError.Create('Blending destination canvas cannot be in indexed mode.'); -end; - -function TImagingCanvas.GetPixelPointer(X, Y: LongInt): Pointer; -begin - Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * FFormatInfo.BytesPerPixel] -end; - -procedure TImagingCanvas.TranslateFPToNative(const Color: TColorFPRec); -begin - TranslateFPToNative(Color, @FNativeColor); -end; - -procedure TImagingCanvas.TranslateFPToNative(const Color: TColorFPRec; - Native: Pointer); -begin - ImagingFormats.TranslatePixel(@Color, Native, ifA32R32G32B32F, - FPData.Format, nil, FPData.Palette); -end; - -procedure TImagingCanvas.UpdateCanvasState; -begin - FDataSizeOnUpdate := FPData.Size; - ResetClipRect; - Imaging.GetImageFormatInfo(FPData.Format, FFormatInfo) -end; - -procedure TImagingCanvas.ResetClipRect; -begin - FClipRect := Rect(0, 0, FPData.Width, FPData.Height) -end; - -procedure TImagingCanvas.Clear; -begin - TranslateFPToNative(FFillColorFP); - Imaging.FillRect(FPData^, 0, 0, FPData.Width, FPData.Height, @FNativeColor); -end; - -function TImagingCanvas.ClipAxisParallelLine(var A1, A2, B: LongInt; - AStart, AStop, BStart, BStop: LongInt): Boolean; -begin - if (B >= BStart) and (B < BStop) then - begin - SwapMin(A1, A2); - if A1 < AStart then A1 := AStart; - if A2 >= AStop then A2 := AStop - 1; - Result := True; - end - else - Result := False; -end; - -procedure TImagingCanvas.HorzLineInternal(X1, X2, Y: LongInt; Color: Pointer; - Bpp: LongInt); -var - I, WidthBytes: LongInt; - PixelPtr: PByte; -begin - if (Y >= FClipRect.Top) and (Y < FClipRect.Bottom) then - begin - SwapMin(X1, X2); - X1 := Max(X1, FClipRect.Left); - X2 := Min(X2, FClipRect.Right); - PixelPtr := GetPixelPointer(X1, Y); - WidthBytes := (X2 - X1) * Bpp; - case Bpp of - 1: FillMemoryByte(PixelPtr, WidthBytes, PByte(Color)^); - 2: FillMemoryWord(PixelPtr, WidthBytes, PWord(Color)^); - 4: FillMemoryLongWord(PixelPtr, WidthBytes, PLongWord(Color)^); - else - for I := X1 to X2 do - begin - ImagingFormats.CopyPixel(Color, PixelPtr, Bpp); - Inc(PixelPtr, Bpp); - end; - end; - end; -end; - -procedure TImagingCanvas.CopyPixelInternal(X, Y: LongInt; Pixel: Pointer; - Bpp: LongInt); -begin - if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and - (X < FClipRect.Right) and (Y < FClipRect.Bottom) then - begin - ImagingFormats.CopyPixel(Pixel, GetPixelPointer(X, Y), Bpp); - end; -end; - -procedure TImagingCanvas.HorzLine(X1, X2, Y: LongInt); -var - DstRect: TRect; -begin - if FPenMode = pmClear then Exit; - SwapMin(X1, X2); - if IntersectRect(DstRect, Rect(X1, Y - FPenWidth div 2, X2, - Y + FPenWidth div 2 + FPenWidth mod 2), FClipRect) then - begin - TranslateFPToNative(FPenColorFP); - Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, @FNativeColor); - end; -end; - -procedure TImagingCanvas.VertLine(X, Y1, Y2: LongInt); -var - DstRect: TRect; -begin - if FPenMode = pmClear then Exit; - SwapMin(Y1, Y2); - if IntersectRect(DstRect, Rect(X - FPenWidth div 2, Y1, - X + FPenWidth div 2 + FPenWidth mod 2, Y2), FClipRect) then - begin - TranslateFPToNative(FPenColorFP); - Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, @FNativeColor); - end; -end; - -procedure TImagingCanvas.Line(X1, Y1, X2, Y2: LongInt); -var - Steep: Boolean; - Error, YStep, DeltaX, DeltaY, X, Y, I, Bpp, W1, W2, Code1, Code2: LongInt; -begin - if FPenMode = pmClear then Exit; - - // If line is vertical or horizontal just call appropriate method - if X2 = X1 then - begin - VertLine(X1, Y1, Y2); - Exit; - end; - if Y2 = Y1 then - begin - HorzLine(X1, X2, Y1); - Exit; - end; - - // Determine if line is steep (angle with X-axis > 45 degrees) - Steep := Abs(Y2 - Y1) > Abs(X2 - X1); - - // If we need to draw thick line we just draw more 1 pixel lines around - // the one we already drawn. Setting FLineRecursion assures that we - // won't be doing recursions till the end of the world. - if (FPenWidth > 1) and not FLineRecursion then - begin - FLineRecursion := True; - W1 := FPenWidth div 2; - W2 := W1; - if FPenWidth mod 2 = 0 then - Dec(W1); - if Steep then - begin - // Add lines left/right - for I := 1 to W1 do - Line(X1, Y1 - I, X2, Y2 - I); - for I := 1 to W2 do - Line(X1, Y1 + I, X2, Y2 + I); - end - else - begin - // Add lines above/under - for I := 1 to W1 do - Line(X1 - I, Y1, X2 - I, Y2); - for I := 1 to W2 do - Line(X1 + I, Y1, X2 + I, Y2); - end; - FLineRecursion := False; - end; - - with FClipRect do - begin - // Use part of Cohen-Sutherland line clipping to determine if any part of line - // is in ClipRect - Code1 := Ord(X1 < Left) + Ord(X1 > Right) shl 1 + Ord(Y1 < Top) shl 2 + Ord(Y1 > Bottom) shl 3; - Code2 := Ord(X2 < Left) + Ord(X2 > Right) shl 1 + Ord(Y2 < Top) shl 2 + Ord(Y2 > Bottom) shl 3; - end; - - if (Code1 and Code2) = 0 then - begin - TranslateFPToNative(FPenColorFP); - Bpp := FFormatInfo.BytesPerPixel; - - // If line is steep swap X and Y coordinates so later we just have one loop - // of two (where only one is used according to steepness). - if Steep then - begin - SwapValues(X1, Y1); - SwapValues(X2, Y2); - end; - if X1 > X2 then - begin - SwapValues(X1, X2); - SwapValues(Y1, Y2); - end; - - DeltaX := X2 - X1; - DeltaY := Abs(Y2 - Y1); - YStep := Iff(Y2 > Y1, 1, -1); - Error := 0; - Y := Y1; - - // Draw line using Bresenham algorithm. No real line clipping here, - // just don't draw pixels outsize clip rect. - for X := X1 to X2 do - begin - if Steep then - CopyPixelInternal(Y, X, @FNativeColor, Bpp) - else - CopyPixelInternal(X, Y, @FNativeColor, Bpp); - Error := Error + DeltaY; - if Error * 2 >= DeltaX then - begin - Inc(Y, YStep); - Dec(Error, DeltaX); - end; - end; - end; -end; - -procedure TImagingCanvas.FrameRect(const Rect: TRect); -var - HalfPen, PenMod: LongInt; -begin - if FPenMode = pmClear then Exit; - HalfPen := FPenWidth div 2; - PenMod := FPenWidth mod 2; - HorzLine(Rect.Left - HalfPen, Rect.Right + HalfPen + PenMod - 1, Rect.Top); - HorzLine(Rect.Left - HalfPen, Rect.Right + HalfPen + PenMod - 1, Rect.Bottom - 1); - VertLine(Rect.Left, Rect.Top, Rect.Bottom); - VertLine(Rect.Right - 1, Rect.Top, Rect.Bottom); -end; - -procedure TImagingCanvas.FillRect(const Rect: TRect); -var - DstRect: TRect; -begin - if (FFillMode <> fmClear) and IntersectRect(DstRect, Rect, FClipRect) then - begin - TranslateFPToNative(FFillColorFP); - Imaging.FillRect(FPData^, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, - DstRect.Bottom - DstRect.Top, @FNativeColor); - end; -end; - -procedure TImagingCanvas.FillRectBlend(const Rect: TRect; SrcFactor, - DestFactor: TBlendingFactor); -var - DstRect: TRect; - X, Y: Integer; - Line: PByte; -begin - if (FFillMode <> fmClear) and IntersectRect(DstRect, Rect, FClipRect) then - begin - CheckBeforeBlending(SrcFactor, DestFactor, Self); - for Y := DstRect.Top to DstRect.Bottom - 1 do - begin - Line := @PByteArray(FPData.Bits)[(Y * FPData.Width + DstRect.Left) * FFormatInfo.BytesPerPixel]; - for X := DstRect.Left to DstRect.Right - 1 do - begin - PixelBlendProc(FFillColorFP, Line, @FFormatInfo, SrcFactor, DestFactor); - Inc(Line, FFormatInfo.BytesPerPixel); - end; - end; - end; -end; - -procedure TImagingCanvas.Rectangle(const Rect: TRect); -begin - FillRect(Rect); - FrameRect(Rect); -end; - -procedure TImagingCanvas.Ellipse(const Rect: TRect); -var - RadX, RadY, DeltaX, DeltaY, R, RX, RY: LongInt; - X1, X2, Y1, Y2, Bpp, OldY: LongInt; - Fill, Pen: TColorFPRec; -begin - // TODO: Use PenWidth - X1 := Rect.Left; - X2 := Rect.Right; - Y1 := Rect.Top; - Y2 := Rect.Bottom; - - TranslateFPToNative(FPenColorFP, @Pen); - TranslateFPToNative(FFillColorFP, @Fill); - Bpp := FFormatInfo.BytesPerPixel; - - SwapMin(X1, X2); - SwapMin(Y1, Y2); - - RadX := (X2 - X1) div 2; - RadY := (Y2 - Y1) div 2; - - Y1 := Y1 + RadY; - Y2 := Y1; - OldY := Y1; - - DeltaX := (RadX * RadX); - DeltaY := (RadY * RadY); - R := RadX * RadY * RadY; - RX := R; - RY := 0; - - if (FFillMode <> fmClear) then - HorzLineInternal(X1, X2, Y1, @Fill, Bpp); - CopyPixelInternal(X1, Y1, @Pen, Bpp); - CopyPixelInternal(X2, Y1, @Pen, Bpp); - - while RadX > 0 do - begin - if R > 0 then - begin - Inc(Y1); - Dec(Y2); - Inc(RY, DeltaX); - Dec(R, RY); - end; - if R <= 0 then - begin - Dec(RadX); - Inc(X1); - Dec(X2); - Dec(RX, DeltaY); - Inc(R, RX); - end; - - if (OldY <> Y1) and (FFillMode <> fmClear) then - begin - HorzLineInternal(X1, X2, Y1, @Fill, Bpp); - HorzLineInternal(X1, X2, Y2, @Fill, Bpp); - end; - OldY := Y1; - - CopyPixelInternal(X1, Y1, @Pen, Bpp); - CopyPixelInternal(X2, Y1, @Pen, Bpp); - CopyPixelInternal(X1, Y2, @Pen, Bpp); - CopyPixelInternal(X2, Y2, @Pen, Bpp); - end; -end; - -procedure TImagingCanvas.FloodFill(X, Y: Integer; BoundaryFillMode: Boolean); -var - Stack: array of TPoint; - StackPos, Y1: Integer; - OldColor: TColor32; - SpanLeft, SpanRight: Boolean; - - procedure Push(AX, AY: Integer); - begin - if StackPos < High(Stack) then - begin - Inc(StackPos); - Stack[StackPos].X := AX; - Stack[StackPos].Y := AY; - end - else - begin - SetLength(Stack, Length(Stack) + FPData.Width); - Push(AX, AY); - end; - end; - - function Pop(out AX, AY: Integer): Boolean; - begin - if StackPos > 0 then - begin - AX := Stack[StackPos].X; - AY := Stack[StackPos].Y; - Dec(StackPos); - Result := True; - end - else - Result := False; - end; - - function Compare(AX, AY: Integer): Boolean; - var - Color: TColor32; - begin - Color := GetPixel32(AX, AY); - if BoundaryFillMode then - Result := (Color <> FFillColor32) and (Color <> FPenColor32) - else - Result := Color = OldColor; - end; - -begin - // Scanline Floodfill Algorithm With Stack - // http://student.kuleuven.be/~m0216922/CG/floodfill.html - - if not PtInRect(FClipRect, Point(X, Y)) then Exit; - - SetLength(Stack, FPData.Width * 4); - StackPos := 0; - - OldColor := GetPixel32(X, Y); - - Push(X, Y); - - while Pop(X, Y) do - begin - Y1 := Y; - while (Y1 >= FClipRect.Top) and Compare(X, Y1) do - Dec(Y1); - - Inc(Y1); - SpanLeft := False; - SpanRight := False; - - while (Y1 < FClipRect.Bottom) and Compare(X, Y1) do - begin - SetPixel32(X, Y1, FFillColor32); - if not SpanLeft and (X > FClipRect.Left) and Compare(X - 1, Y1) then - begin - Push(X - 1, Y1); - SpanLeft := True; - end - else if SpanLeft and (X > FClipRect.Left) and not Compare(X - 1, Y1) then - SpanLeft := False - else if not SpanRight and (X < FClipRect.Right - 1) and Compare(X + 1, Y1)then - begin - Push(X + 1, Y1); - SpanRight := True; - end - else if SpanRight and (X < FClipRect.Right - 1) and not Compare(X + 1, Y1) then - SpanRight := False; - - Inc(Y1); - end; - end; -end; - -procedure TImagingCanvas.DrawInternal(const SrcRect: TRect; - DestCanvas: TImagingCanvas; DestX, DestY: Integer; SrcFactor, - DestFactor: TBlendingFactor; PixelWriteProc: TPixelWriteProc); -var - X, Y, SrcX, SrcY, Width, Height, SrcBpp, DestBpp: Integer; - PSrc: TColorFPRec; - SrcPointer, DestPointer: PByte; -begin - CheckBeforeBlending(SrcFactor, DestFactor, DestCanvas); - SrcX := SrcRect.Left; - SrcY := SrcRect.Top; - Width := SrcRect.Right - SrcRect.Left; - Height := SrcRect.Bottom - SrcRect.Top; - SrcBpp := FFormatInfo.BytesPerPixel; - DestBpp := DestCanvas.FFormatInfo.BytesPerPixel; - // Clip src and dst rects - ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY, - FPData.Width, FPData.Height, DestCanvas.ClipRect); - - for Y := 0 to Height - 1 do - begin - // Get src and dst scanlines - SrcPointer := @PByteArray(FPData.Bits)[((SrcY + Y) * FPData.Width + SrcX) * SrcBpp]; - DestPointer := @PByteArray(DestCanvas.FPData.Bits)[((DestY + Y) * DestCanvas.FPData.Width + DestX) * DestBpp]; - - for X := 0 to Width - 1 do - begin - PSrc := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, FPData.Palette); - // Call pixel writer procedure - combine source and dest pixels - PixelWriteProc(PSrc, DestPointer, @DestCanvas.FFormatInfo, SrcFactor, DestFactor); - // Increment pixel pointers - Inc(SrcPointer, SrcBpp); - Inc(DestPointer, DestBpp); - end; - end; -end; - -procedure TImagingCanvas.DrawBlend(const SrcRect: TRect; DestCanvas: TImagingCanvas; - DestX, DestY: Integer; SrcFactor, DestFactor: TBlendingFactor); -begin - DrawInternal(SrcRect, DestCanvas, DestX, DestY, SrcFactor, DestFactor, PixelBlendProc); -end; - -procedure TImagingCanvas.DrawAlpha(const SrcRect: TRect; DestCanvas: TImagingCanvas; - DestX, DestY: Integer); -begin - DrawInternal(SrcRect, DestCanvas, DestX, DestY, bfIgnore, bfIgnore, PixelAlphaProc); -end; - -procedure TImagingCanvas.DrawAdd(const SrcRect: TRect; - DestCanvas: TImagingCanvas; DestX, DestY: Integer); -begin - DrawInternal(SrcRect, DestCanvas, DestX, DestY, bfIgnore, bfIgnore, PixelAddProc); -end; - -procedure TImagingCanvas.StretchDrawInternal(const SrcRect: TRect; - DestCanvas: TImagingCanvas; const DestRect: TRect; - SrcFactor, DestFactor: TBlendingFactor; Filter: TResizeFilter; - PixelWriteProc: TPixelWriteProc); -const - FilterMapping: array[TResizeFilter] of TSamplingFilter = - (sfNearest, sfLinear, DefaultCubicFilter, sfLanczos); -var - X, Y, I, J, SrcX, SrcY, SrcWidth, SrcHeight: Integer; - DestX, DestY, DestWidth, DestHeight, SrcBpp, DestBpp: Integer; - SrcPix: TColorFPRec; - MapX, MapY: TMappingTable; - XMinimum, XMaximum: Integer; - LineBuffer: array of TColorFPRec; - ClusterX, ClusterY: TCluster; - Weight, AccumA, AccumR, AccumG, AccumB: Single; - DestLine: PByte; - FilterFunction: TFilterFunction; - Radius: Single; -begin - CheckBeforeBlending(SrcFactor, DestFactor, DestCanvas); - SrcX := SrcRect.Left; - SrcY := SrcRect.Top; - SrcWidth := SrcRect.Right - SrcRect.Left; - SrcHeight := SrcRect.Bottom - SrcRect.Top; - DestX := DestRect.Left; - DestY := DestRect.Top; - DestWidth := DestRect.Right - DestRect.Left; - DestHeight := DestRect.Bottom - DestRect.Top; - SrcBpp := FFormatInfo.BytesPerPixel; - DestBpp := DestCanvas.FFormatInfo.BytesPerPixel; - // Get actual resampling filter and radius - FilterFunction := SamplingFilterFunctions[FilterMapping[Filter]]; - Radius := SamplingFilterRadii[FilterMapping[Filter]]; - // Clip src and dst rects - ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight, - FPData.Width, FPData.Height, DestCanvas.ClipRect); - // Generate mapping tables - MapX := BuildMappingTable(DestX, DestX + DestWidth, SrcX, SrcX + SrcWidth, - FPData.Width, FilterFunction, Radius, False); - MapY := BuildMappingTable(DestY, DestY + DestHeight, SrcY, SrcY + SrcHeight, - FPData.Height, FilterFunction, Radius, False); - FindExtremes(MapX, XMinimum, XMaximum); - SetLength(LineBuffer, XMaximum - XMinimum + 1); - - for J := 0 to DestHeight - 1 do - begin - ClusterY := MapY[J]; - for X := XMinimum to XMaximum do - begin - AccumA := 0.0; - AccumR := 0.0; - AccumG := 0.0; - AccumB := 0.0; - for Y := 0 to Length(ClusterY) - 1 do - begin - Weight := ClusterY[Y].Weight; - SrcPix := FFormatInfo.GetPixelFP(@PByteArray(FPData.Bits)[(ClusterY[Y].Pos * FPData.Width + X) * SrcBpp], - @FFormatInfo, FPData.Palette); - AccumB := AccumB + SrcPix.B * Weight; - AccumG := AccumG + SrcPix.G * Weight; - AccumR := AccumR + SrcPix.R * Weight; - AccumA := AccumA + SrcPix.A * Weight; - end; - with LineBuffer[X - XMinimum] do - begin - A := AccumA; - R := AccumR; - G := AccumG; - B := AccumB; - end; - end; - - DestLine := @PByteArray(DestCanvas.FPData.Bits)[((J + DestY) * DestCanvas.FPData.Width + DestX) * DestBpp]; - - for I := 0 to DestWidth - 1 do - begin - ClusterX := MapX[I]; - AccumA := 0.0; - AccumR := 0.0; - AccumG := 0.0; - AccumB := 0.0; - for X := 0 to Length(ClusterX) - 1 do - begin - Weight := ClusterX[X].Weight; - with LineBuffer[ClusterX[X].Pos - XMinimum] do - begin - AccumB := AccumB + B * Weight; - AccumG := AccumG + G * Weight; - AccumR := AccumR + R * Weight; - AccumA := AccumA + A * Weight; - end; - end; - - SrcPix.A := AccumA; - SrcPix.R := AccumR; - SrcPix.G := AccumG; - SrcPix.B := AccumB; - - // Write resulting blended pixel - PixelWriteProc(SrcPix, DestLine, @DestCanvas.FFormatInfo, SrcFactor, DestFactor); - Inc(DestLine, DestBpp); - end; - end; -end; - -procedure TImagingCanvas.StretchDrawBlend(const SrcRect: TRect; - DestCanvas: TImagingCanvas; const DestRect: TRect; - SrcFactor, DestFactor: TBlendingFactor; Filter: TResizeFilter); -begin - StretchDrawInternal(SrcRect, DestCanvas, DestRect, SrcFactor, DestFactor, Filter, PixelBlendProc); -end; - -procedure TImagingCanvas.StretchDrawAlpha(const SrcRect: TRect; - DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter); -begin - StretchDrawInternal(SrcRect, DestCanvas, DestRect, bfIgnore, bfIgnore, Filter, PixelAlphaProc); -end; - -procedure TImagingCanvas.StretchDrawAdd(const SrcRect: TRect; - DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter); -begin - StretchDrawInternal(SrcRect, DestCanvas, DestRect, bfIgnore, bfIgnore, Filter, PixelAddProc); -end; - -procedure TImagingCanvas.ApplyConvolution(Kernel: PLongInt; KernelSize, - Divisor: LongInt; Bias: Single; ClampChannels: Boolean); -var - X, Y, I, J, PosY, PosX, SizeDiv2, KernelValue, WidthBytes, Bpp: LongInt; - R, G, B, DivFloat: Single; - Pixel: TColorFPRec; - TempImage: TImageData; - DstPointer, SrcPointer: PByte; -begin - SizeDiv2 := KernelSize div 2; - DivFloat := IffFloat(Divisor > 1, 1.0 / Divisor, 1.0); - Bpp := FFormatInfo.BytesPerPixel; - WidthBytes := FPData.Width * Bpp; - - InitImage(TempImage); - CloneImage(FPData^, TempImage); - - try - // For every pixel in clip rect - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - DstPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp]; - - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - // Reset accumulators - R := 0.0; - G := 0.0; - B := 0.0; - - for J := 0 to KernelSize - 1 do - begin - PosY := ClampInt(Y + J - SizeDiv2, FClipRect.Top, FClipRect.Bottom - 1); - - for I := 0 to KernelSize - 1 do - begin - PosX := ClampInt(X + I - SizeDiv2, FClipRect.Left, FClipRect.Right - 1); - SrcPointer := @PByteArray(TempImage.Bits)[PosY * WidthBytes + PosX * Bpp]; - - // Get pixels from neighbourhood of current pixel and add their - // colors to accumulators weighted by filter kernel values - Pixel := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, TempImage.Palette); - KernelValue := PLongIntArray(Kernel)[J * KernelSize + I]; - - R := R + Pixel.R * KernelValue; - G := G + Pixel.G * KernelValue; - B := B + Pixel.B * KernelValue; - end; - end; - - Pixel := FFormatInfo.GetPixelFP(DstPointer, @FFormatInfo, FPData.Palette); - - Pixel.R := R * DivFloat + Bias; - Pixel.G := G * DivFloat + Bias; - Pixel.B := B * DivFloat + Bias; - - if ClampChannels then - ClampFloatPixel(Pixel); - - // Set resulting pixel color - FFormatInfo.SetPixelFP(DstPointer, @FFormatInfo, FPData.Palette, Pixel); - - Inc(DstPointer, Bpp); - end; - end; - - finally - FreeImage(TempImage); - end; -end; - -procedure TImagingCanvas.ApplyConvolution3x3(const Filter: TConvolutionFilter3x3); -begin - ApplyConvolution(@Filter.Kernel, 3, Filter.Divisor, Filter.Bias, True); -end; - -procedure TImagingCanvas.ApplyConvolution5x5(const Filter: TConvolutionFilter5x5); -begin - ApplyConvolution(@Filter.Kernel, 5, Filter.Divisor, Filter.Bias, True); -end; - -procedure TImagingCanvas.ApplyNonLinearFilter(FilterSize: Integer; SelectFunc: TSelectPixelFunction); -var - X, Y, I, J, PosY, PosX, SizeDiv2, WidthBytes, Bpp: LongInt; - Pixel: TColorFPRec; - TempImage: TImageData; - DstPointer, SrcPointer: PByte; - NeighPixels: TDynFPPixelArray; -begin - SizeDiv2 := FilterSize div 2; - Bpp := FFormatInfo.BytesPerPixel; - WidthBytes := FPData.Width * Bpp; - SetLength(NeighPixels, FilterSize * FilterSize); - - InitImage(TempImage); - CloneImage(FPData^, TempImage); - - try - // For every pixel in clip rect - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - DstPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp]; - - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - for J := 0 to FilterSize - 1 do - begin - PosY := ClampInt(Y + J - SizeDiv2, FClipRect.Top, FClipRect.Bottom - 1); - - for I := 0 to FilterSize - 1 do - begin - PosX := ClampInt(X + I - SizeDiv2, FClipRect.Left, FClipRect.Right - 1); - SrcPointer := @PByteArray(TempImage.Bits)[PosY * WidthBytes + PosX * Bpp]; - - // Get pixels from neighbourhood of current pixel and store them - Pixel := FFormatInfo.GetPixelFP(SrcPointer, @FFormatInfo, TempImage.Palette); - NeighPixels[J * FilterSize + I] := Pixel; - end; - end; - - // Choose pixel using custom function - Pixel := SelectFunc(NeighPixels); - // Set resulting pixel color - FFormatInfo.SetPixelFP(DstPointer, @FFormatInfo, FPData.Palette, Pixel); - - Inc(DstPointer, Bpp); - end; - end; - - finally - FreeImage(TempImage); - end; -end; - -procedure TImagingCanvas.ApplyMedianFilter(FilterSize: Integer); -begin - ApplyNonLinearFilter(FilterSize, MedianSelect); -end; - -procedure TImagingCanvas.ApplyMinFilter(FilterSize: Integer); -begin - ApplyNonLinearFilter(FilterSize, MinSelect); -end; - -procedure TImagingCanvas.ApplyMaxFilter(FilterSize: Integer); -begin - ApplyNonLinearFilter(FilterSize, MaxSelect); -end; - -procedure TImagingCanvas.PointTransform(Transform: TPointTransformFunction; - Param1, Param2, Param3: Single); -var - X, Y, Bpp, WidthBytes: Integer; - PixPointer: PByte; - Pixel: TColorFPRec; -begin - Bpp := FFormatInfo.BytesPerPixel; - WidthBytes := FPData.Width * Bpp; - - // For every pixel in clip rect - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - PixPointer := @PByteArray(FPData.Bits)[Y * WidthBytes + FClipRect.Left * Bpp]; - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - Pixel := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette); - - FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette, - Transform(Pixel, Param1, Param2, Param3)); - - Inc(PixPointer, Bpp); - end; - end; -end; - -procedure TImagingCanvas.ModifyContrastBrightness(Contrast, Brightness: Single); -begin - PointTransform(TransformContrastBrightness, 1.0 + Contrast / 100, - Brightness / 100, 0); -end; - -procedure TImagingCanvas.GammaCorection(Red, Green, Blue: Single); -begin - PointTransform(TransformGamma, Red, Green, Blue); -end; - -procedure TImagingCanvas.InvertColors; -begin - PointTransform(TransformInvert, 0, 0, 0); -end; - -procedure TImagingCanvas.Threshold(Red, Green, Blue: Single); -begin - PointTransform(TransformThreshold, Red, Green, Blue); -end; - -procedure TImagingCanvas.AdjustColorLevels(BlackPoint, WhitePoint, MidPoint: Single); -begin - PointTransform(TransformLevels, BlackPoint, WhitePoint, 1.0 / MidPoint); -end; - -procedure TImagingCanvas.PremultiplyAlpha; -begin - PointTransform(TransformPremultiplyAlpha, 0, 0, 0); -end; - -procedure TImagingCanvas.UnPremultiplyAlpha; -begin - PointTransform(TransformUnPremultiplyAlpha, 0, 0, 0); -end; - -procedure TImagingCanvas.GetHistogram(out Red, Green, Blue, Alpha, - Gray: THistogramArray); -var - X, Y, Bpp: Integer; - PixPointer: PByte; - Color32: TColor32Rec; -begin - FillChar(Red, SizeOf(Red), 0); - FillChar(Green, SizeOf(Green), 0); - FillChar(Blue, SizeOf(Blue), 0); - FillChar(Alpha, SizeOf(Alpha), 0); - FillChar(Gray, SizeOf(Gray), 0); - - Bpp := FFormatInfo.BytesPerPixel; - - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp]; - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette); - - Inc(Red[Color32.R]); - Inc(Green[Color32.G]); - Inc(Blue[Color32.B]); - Inc(Alpha[Color32.A]); - Inc(Gray[Round(GrayConv.R * Color32.R + GrayConv.G * Color32.G + GrayConv.B * Color32.B)]); - - Inc(PixPointer, Bpp); - end; - end; -end; - -procedure TImagingCanvas.FillChannel(ChannelId: Integer; NewChannelValue: Byte); -var - X, Y, Bpp: Integer; - PixPointer: PByte; - Color32: TColor32Rec; -begin - Bpp := FFormatInfo.BytesPerPixel; - - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp]; - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - Color32 := FFormatInfo.GetPixel32(PixPointer, @FFormatInfo, FPData.Palette); - Color32.Channels[ChannelId] := NewChannelValue; - FFormatInfo.SetPixel32(PixPointer, @FFormatInfo, FPData.Palette, Color32); - - Inc(PixPointer, Bpp); - end; - end; -end; - -procedure TImagingCanvas.FillChannelFP(ChannelId: Integer; NewChannelValue: Single); -var - X, Y, Bpp: Integer; - PixPointer: PByte; - ColorFP: TColorFPRec; -begin - Bpp := FFormatInfo.BytesPerPixel; - - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - PixPointer := @PByteArray(FPData.Bits)[Y * FPData.Width * Bpp + FClipRect.Left * Bpp]; - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - ColorFP := FFormatInfo.GetPixelFP(PixPointer, @FFormatInfo, FPData.Palette); - ColorFP.Channels[ChannelId] := NewChannelValue; - FFormatInfo.SetPixelFP(PixPointer, @FFormatInfo, FPData.Palette, ColorFP); - - Inc(PixPointer, Bpp); - end; - end; -end; - -class function TImagingCanvas.GetSupportedFormats: TImageFormats; -begin - Result := [ifIndex8..Pred(ifDXT1)]; -end; - -{ TFastARGB32Canvas } - -destructor TFastARGB32Canvas.Destroy; -begin - FreeMem(FScanlines); - inherited Destroy; -end; - -procedure TFastARGB32Canvas.AlphaBlendPixels(SrcPix, DestPix: PColor32Rec); -var - SrcAlpha, DestAlpha, FinalAlpha: Integer; -begin - FinalAlpha := SrcPix.A + 1 + (DestPix.A * (256 - SrcPix.A)) shr 8; - if FinalAlpha = 0 then - SrcAlpha := 0 - else - SrcAlpha := (SrcPix.A shl 8) div FinalAlpha; - DestAlpha := 256 - SrcAlpha; - - DestPix.A := ClampToByte(FinalAlpha); - DestPix.R := (SrcPix.R * SrcAlpha + DestPix.R * DestAlpha) shr 8; - DestPix.G := (SrcPix.G * SrcAlpha + DestPix.G * DestAlpha) shr 8; - DestPix.B := (SrcPix.B * SrcAlpha + DestPix.B * DestAlpha) shr 8; -end; - -procedure TFastARGB32Canvas.DrawAlpha(const SrcRect: TRect; - DestCanvas: TImagingCanvas; DestX, DestY: Integer); -var - X, Y, SrcX, SrcY, Width, Height: Integer; - SrcPix, DestPix: PColor32Rec; -begin - if DestCanvas.ClassType <> Self.ClassType then - begin - inherited; - Exit; - end; - - SrcX := SrcRect.Left; - SrcY := SrcRect.Top; - Width := SrcRect.Right - SrcRect.Left; - Height := SrcRect.Bottom - SrcRect.Top; - ClipCopyBounds(SrcX, SrcY, Width, Height, DestX, DestY, - FPData.Width, FPData.Height, DestCanvas.ClipRect); - - for Y := 0 to Height - 1 do - begin - SrcPix := @FScanlines[SrcY + Y, SrcX]; - DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[DestY + Y, DestX]; - for X := 0 to Width - 1 do - begin - AlphaBlendPixels(SrcPix, DestPix); - Inc(SrcPix); - Inc(DestPix); - end; - end; -end; - -function TFastARGB32Canvas.GetPixel32(X, Y: LongInt): TColor32; -begin - Result := FScanlines[Y, X].Color; -end; - -procedure TFastARGB32Canvas.SetPixel32(X, Y: LongInt; const Value: TColor32); -begin - if (X >= FClipRect.Left) and (Y >= FClipRect.Top) and - (X < FClipRect.Right) and (Y < FClipRect.Bottom) then - begin - FScanlines[Y, X].Color := Value; - end; -end; - -procedure TFastARGB32Canvas.StretchDrawAlpha(const SrcRect: TRect; - DestCanvas: TImagingCanvas; const DestRect: TRect; Filter: TResizeFilter); -var - X, Y, ScaleX, ScaleY, Yp, Xp, Weight1, Weight2, Weight3, Weight4, InvFracY, T1, T2: Integer; - FracX, FracY: Cardinal; - SrcX, SrcY, SrcWidth, SrcHeight: Integer; - DestX, DestY, DestWidth, DestHeight: Integer; - SrcLine, SrcLine2: PColor32RecArray; - DestPix: PColor32Rec; - Accum: TColor32Rec; -begin - if (Filter = rfBicubic) or (DestCanvas.ClassType <> Self.ClassType) then - begin - inherited; - Exit; - end; - - SrcX := SrcRect.Left; - SrcY := SrcRect.Top; - SrcWidth := SrcRect.Right - SrcRect.Left; - SrcHeight := SrcRect.Bottom - SrcRect.Top; - DestX := DestRect.Left; - DestY := DestRect.Top; - DestWidth := DestRect.Right - DestRect.Left; - DestHeight := DestRect.Bottom - DestRect.Top; - // Clip src and dst rects - ClipStretchBounds(SrcX, SrcY, SrcWidth, SrcHeight, DestX, DestY, DestWidth, DestHeight, - FPData.Width, FPData.Height, DestCanvas.ClipRect); - ScaleX := (SrcWidth shl 16) div DestWidth; - ScaleY := (SrcHeight shl 16) div DestHeight; - - // Nearest and linear filtering using fixed point math - - if Filter = rfNearest then - begin - Yp := 0; - for Y := DestY to DestY + DestHeight - 1 do - begin - Xp := 0; - SrcLine := @FScanlines[SrcY + Yp shr 16, SrcX]; - DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX]; - for X := 0 to DestWidth - 1 do - begin - AlphaBlendPixels(@SrcLine[Xp shr 16], DestPix); - Inc(DestPix); - Inc(Xp, ScaleX); - end; - Inc(Yp, ScaleY); - end; - end - else - begin - Yp := (ScaleY shr 1) - $8000; - for Y := DestY to DestY + DestHeight - 1 do - begin - DestPix := @TFastARGB32Canvas(DestCanvas).FScanlines[Y, DestX]; - if Yp < 0 then - begin - T1 := 0; - FracY := 0; - InvFracY := $10000; - end - else - begin - T1 := Yp shr 16; - FracY := Yp and $FFFF; - InvFracY := (not Yp and $FFFF) + 1; - end; - - T2 := Iff(T1 < SrcHeight - 1, T1 + 1, T1); - SrcLine := @Scanlines[T1 + SrcY, SrcX]; - SrcLine2 := @Scanlines[T2 + SrcY, SrcX]; - Xp := (ScaleX shr 1) - $8000; - - for X := 0 to DestWidth - 1 do - begin - if Xp < 0 then - begin - T1 := 0; - FracX := 0; - end - else - begin - T1 := Xp shr 16; - FracX := Xp and $FFFF; - end; - - T2 := Iff(T1 < SrcWidth - 1, T1 + 1, T1); - Weight2:= Integer((Cardinal(InvFracY) * FracX) shr 16); // cast to Card, Int can overflow here - Weight1:= InvFracY - Weight2; - Weight4:= Integer((Cardinal(FracY) * FracX) shr 16); - Weight3:= FracY - Weight4; - - Accum.B := (SrcLine[T1].B * Weight1 + SrcLine[T2].B * Weight2 + - SrcLine2[T1].B * Weight3 + SrcLine2[T2].B * Weight4 + $8000) shr 16; - Accum.G := (SrcLine[T1].G * Weight1 + SrcLine[T2].G * Weight2 + - SrcLine2[T1].G * Weight3 + SrcLine2[T2].G * Weight4 + $8000) shr 16; - Accum.R := (SrcLine[T1].R * Weight1 + SrcLine[T2].R * Weight2 + - SrcLine2[T1].R * Weight3 + SrcLine2[T2].R * Weight4 + $8000) shr 16; - Accum.A := (SrcLine[T1].A * Weight1 + SrcLine[T2].A * Weight2 + - SrcLine2[T1].A * Weight3 + SrcLine2[T2].A * Weight4 + $8000) shr 16; - - AlphaBlendPixels(@Accum, DestPix); - - Inc(Xp, ScaleX); - Inc(DestPix); - end; - Inc(Yp, ScaleY); - end; - end; -end; - -procedure TFastARGB32Canvas.UpdateCanvasState; -var - I: LongInt; - ScanPos: PLongWord; -begin - inherited UpdateCanvasState; - - // Realloc and update scanline array - ReallocMem(FScanlines, FPData.Height * SizeOf(PColor32RecArray)); - ScanPos := FPData.Bits; - - for I := 0 to FPData.Height - 1 do - begin - FScanlines[I] := PColor32RecArray(ScanPos); - Inc(ScanPos, FPData.Width); - end; -end; - -class function TFastARGB32Canvas.GetSupportedFormats: TImageFormats; -begin - Result := [ifA8R8G8B8]; -end; - -procedure TFastARGB32Canvas.InvertColors; -var - X, Y: Integer; - PixPtr: PColor32Rec; -begin - for Y := FClipRect.Top to FClipRect.Bottom - 1 do - begin - PixPtr := @FScanlines[Y, FClipRect.Left]; - for X := FClipRect.Left to FClipRect.Right - 1 do - begin - PixPtr.R := not PixPtr.R; - PixPtr.G := not PixPtr.G; - PixPtr.B := not PixPtr.B; - Inc(PixPtr); - end; - end; -end; - -initialization - RegisterCanvas(TFastARGB32Canvas); - -finalization - FreeAndNil(CanvasClasses); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - more more more ... - - implement pen width everywhere - - more objects (arc, polygon) - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fixed bug that could raise floating point error in DrawAlpha - and StretchDrawAlpha. - - Fixed bug in TImagingCanvas.Line that caused not drawing - of horz or vert lines. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Added some methods to TFastARGB32Canvas (InvertColors, DrawAlpha/StretchDrawAlpha) - - Fixed DrawAlpha/StretchDrawAlpha destination alpha calculation. - - Added PremultiplyAlpha and UnPremultiplyAlpha methods. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added FillChannel methods. - - Added FloodFill method. - - Added GetHistogram method. - - Fixed "Invalid FP operation" in AdjustColorLevels in FPC compiled exes - (thanks to Carlos Gonz�lez). - - Added TImagingCanvas.AdjustColorLevels method. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Fixed error that could cause AV in linear and nonlinear filters. - - Added blended rect filling function FillRectBlend. - - Added drawing function with blending (DrawAlpha, StretchDrawAlpha, - StretchDrawAdd, DrawBlend, StretchDrawBlend, ...) - - Added non-linear filters (min, max, median). - - Added point transforms (invert, contrast, gamma, brightness). - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added some new filter kernels for convolution. - - Added FillMode and PenMode properties. - - Added FrameRect, Rectangle, Ellipse, and Line methods. - - Removed HorzLine and VertLine from TFastARGB32Canvas - new versions - in general canvas is now as fast as those in TFastARGB32Canvas - (only in case of A8R8G8B8 images of course). - - Added PenWidth property, updated HorzLine and VertLine to use it. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added TFastARGB32Canvas - - added convolutions, hline, vline - - unit created, intial stuff added - -} - -end. - diff --git a/3rd/Imaging/Source/ImagingClasses.pas b/3rd/Imaging/Source/ImagingClasses.pas deleted file mode 100644 index 1539d0f77..000000000 --- a/3rd/Imaging/Source/ImagingClasses.pas +++ /dev/null @@ -1,1092 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains class based wrapper to Imaging library.} -unit ImagingClasses; - -{$I ImagingOptions.inc} - -interface - -uses - Types, Classes, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Base abstract high level class wrapper to low level Imaging structures and - functions.} - TBaseImage = class(TPersistent) - private - function GetEmpty: Boolean; - protected - FPData: PImageData; - FOnDataSizeChanged: TNotifyEvent; - FOnPixelsChanged: TNotifyEvent; - function GetFormat: TImageFormat; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetHeight: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetSize: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetWidth: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetBits: Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetPalette: PPalette32; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetPaletteEntries: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetScanline(Index: Integer): Pointer; - function GetPixelPointer(X, Y: Integer): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetScanlineSize: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetFormatInfo: TImageFormatInfo; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetBoundsRect: TRect; - procedure SetFormat(const Value: TImageFormat); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetHeight(const Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetWidth(const Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetPointer; virtual; abstract; - procedure DoDataSizeChanged; virtual; - procedure DoPixelsChanged; virtual; - public - constructor Create; virtual; - constructor CreateFromImage(AImage: TBaseImage); - destructor Destroy; override; - { Returns info about current image.} - function ToString: string; {$IF Defined(DCC) and (CompilerVersion >= 20.0)}override;{$IFEND} - - { Creates a new image data with the given size and format. Old image - data is lost. Works only for the current image of TMultiImage.} - procedure RecreateImageData(AWidth, AHeight: Integer; AFormat: TImageFormat); - { Maps underlying image data to given TImageData record. Both TBaseImage and - TImageData now share some image memory (bits). So don't call FreeImage - on TImageData afterwards since this TBaseImage would get really broken.} - procedure MapImageData(const ImageData: TImageData); - { Deletes current image.} - procedure Clear; - - { Resizes current image with optional resampling.} - procedure Resize(NewWidth, NewHeight: Integer; Filter: TResizeFilter); - - procedure ResizeToFit(FitWidth, FitHeight: Integer; Filter: TResizeFilter; DstImage: TBaseImage); - { Flips current image. Reverses the image along its horizontal axis the top - becomes the bottom and vice versa.} - procedure Flip; - { Mirrors current image. Reverses the image along its vertical axis the left - side becomes the right and vice versa.} - procedure Mirror; - { Rotates image by Angle degrees counterclockwise.} - procedure Rotate(Angle: Single); - { Copies rectangular part of SrcImage to DstImage. No blending is performed - - alpha is simply copied to destination image. Operates also with - negative X and Y coordinates. - Note that copying is fastest for images in the same data format - (and slowest for images in special formats).} - procedure CopyTo(SrcX, SrcY, Width, Height: Integer; DstImage: TBaseImage; DstX, DstY: Integer); - { Stretches the contents of the source rectangle to the destination rectangle - with optional resampling. No blending is performed - alpha is - simply copied/resampled to destination image. Note that stretching is - fastest for images in the same data format (and slowest for - images in special formats).} - procedure StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: Integer; DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: Integer; Filter: TResizeFilter); - { Replaces pixels with OldPixel in the given rectangle by NewPixel. - OldPixel and NewPixel should point to the pixels in the same format - as the given image is in.} - procedure ReplaceColor(X, Y, Width, Height: Integer; OldColor, NewColor: Pointer); - { Swaps SrcChannel and DstChannel color or alpha channels of image. - Use ChannelRed, ChannelBlue, ChannelGreen, ChannelAlpha constants to - identify channels.} - procedure SwapChannels(SrcChannel, DstChannel: Integer); - - { Loads current image data from file.} - procedure LoadFromFile(const FileName: string); virtual; - { Loads current image data from stream.} - procedure LoadFromStream(Stream: TStream); virtual; - - { Saves current image data to file.} - procedure SaveToFile(const FileName: string); - { Saves current image data to stream. Ext identifies desired image file - format (jpg, png, dds, ...)} - procedure SaveToStream(const Ext: string; Stream: TStream); - - { Width of current image in pixels.} - property Width: Integer read GetWidth write SetWidth; - { Height of current image in pixels.} - property Height: Integer read GetHeight write SetHeight; - { Image data format of current image.} - property Format: TImageFormat read GetFormat write SetFormat; - { Size in bytes of current image's data.} - property Size: Integer read GetSize; - { Pointer to memory containing image bits.} - property Bits: Pointer read GetBits; - { Pointer to palette for indexed format images. It is nil for others. - Max palette entry is at index [PaletteEntries - 1].} - property Palette: PPalette32 read GetPalette; - { Number of entries in image's palette} - property PaletteEntries: Integer read GetPaletteEntries; - { Provides indexed access to each line of pixels. Does not work with special - format images (like DXT).} - property Scanline[Index: Integer]: Pointer read GetScanline; - { Returns pointer to image pixel at [X, Y] coordinates.} - property PixelPointer[X, Y: Integer]: Pointer read GetPixelPointer; - { Size/length of one image scanline in bytes.} - property ScanlineSize: Integer read GetScanlineSize; - { Extended image format information.} - property FormatInfo: TImageFormatInfo read GetFormatInfo; - { This gives complete access to underlying TImageData record. - It can be used in functions that take TImageData as parameter - (for example: ReduceColors(SingleImageInstance.ImageData^, 64)).} - property ImageDataPointer: PImageData read FPData; - { Indicates whether the current image is valid (proper format, - allowed dimensions, right size, ...).} - property Valid: Boolean read GetValid; - { Indicates whether image containst any data (size in bytes > 0).} - property Empty: Boolean read GetEmpty; - { Specifies the bounding rectangle of the image.} - property BoundsRect: TRect read GetBoundsRect; - { This event occurs when the image data size has just changed. That means - image width, height, or format has been changed.} - property OnDataSizeChanged: TNotifyEvent read FOnDataSizeChanged write FOnDataSizeChanged; - { This event occurs when some pixels of the image have just changed.} - property OnPixelsChanged: TNotifyEvent read FOnPixelsChanged write FOnPixelsChanged; - end; - - { Extension of TBaseImage which uses single TImageData record to - store image. All methods inherited from TBaseImage work with this record.} - TSingleImage = class(TBaseImage) - protected - FImageData: TImageData; - procedure SetPointer; override; - public - constructor Create; override; - constructor CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault); - constructor CreateFromData(const AData: TImageData); - constructor CreateFromFile(const FileName: string); - constructor CreateFromStream(Stream: TStream); - destructor Destroy; override; - { Assigns single image from another single image or multi image.} - procedure Assign(Source: TPersistent); override; - { Assigns single image from image data record.} - procedure AssignFromImageData(const AImageData: TImageData); - end; - - { Extension of TBaseImage which uses array of TImageData records to - store multiple images. Images are independent on each other and they don't - share any common characteristic. Each can have different size, format, and - palette. All methods inherited from TBaseImage work only with - active image (it could represent mipmap level, animation frame, or whatever). - Methods whose names contain word 'Multi' work with all images in array - (as well as other methods with obvious names).} - TMultiImage = class(TBaseImage) - protected - FDataArray: TDynImageDataArray; - FActiveImage: Integer; - procedure SetActiveImage(Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetImageCount: Integer; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetImageCount(Value: Integer); - function GetAllImagesValid: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} - function GetImage(Index: Integer): TImageData; {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetImage(Index: Integer; Value: TImageData); {$IFDEF USE_INLINE}inline;{$ENDIF} - procedure SetPointer; override; - function PrepareInsert(Index, Count: Integer): Boolean; - procedure DoInsertImages(Index: Integer; const Images: TDynImageDataArray); - procedure DoInsertNew(Index: Integer; AWidth, AHeight: Integer; AFormat: TImageFormat); - public - constructor Create; override; - constructor CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat; ImageCount: Integer); - constructor CreateFromArray(const ADataArray: TDynImageDataArray); - constructor CreateFromFile(const FileName: string); - constructor CreateFromStream(Stream: TStream); - destructor Destroy; override; - { Assigns multi image from another multi image or single image.} - procedure Assign(Source: TPersistent); override; - { Assigns multi image from array of image data records.} - procedure AssignFromArray(const ADataArray: TDynImageDataArray); - - { Adds new image at the end of the image array. } - function AddImage(AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault): Integer; overload; - { Adds existing image at the end of the image array. } - function AddImage(const Image: TImageData): Integer; overload; - { Adds existing image (Active image of a TmultiImage) - at the end of the image array. } - function AddImage(Image: TBaseImage): Integer; overload; - { Adds existing image array ((all images of a multi image)) - at the end of the image array. } - procedure AddImages(const Images: TDynImageDataArray); overload; - { Adds existing MultiImage images at the end of the image array. } - procedure AddImages(Images: TMultiImage); overload; - - { Inserts new image image at the given position in the image array. } - procedure InsertImage(Index, AWidth, AHeight: Integer; AFormat: TImageFormat = ifDefault); overload; - { Inserts existing image at the given position in the image array. } - procedure InsertImage(Index: Integer; const Image: TImageData); overload; - { Inserts existing image (Active image of a TmultiImage) - at the given position in the image array. } - procedure InsertImage(Index: Integer; Image: TBaseImage); overload; - { Inserts existing image at the given position in the image array. } - procedure InsertImages(Index: Integer; const Images: TDynImageDataArray); overload; - { Inserts existing images (all images of a TmultiImage) at - the given position in the image array. } - procedure InsertImages(Index: Integer; Images: TMultiImage); overload; - - { Exchanges two images at the given positions in the image array. } - procedure ExchangeImages(Index1, Index2: Integer); - { Deletes image at the given position in the image array.} - procedure DeleteImage(Index: Integer); - { Rearranges images so that the first image will become last and vice versa.} - procedure ReverseImages; - { Deletes all images.} - procedure ClearAll; - - { Converts all images to another image data format.} - procedure ConvertImages(Format: TImageFormat); - { Resizes all images.} - procedure ResizeImages(NewWidth, NewHeight: Integer; Filter: TResizeFilter); - - { Overloaded loading method that will add new image to multiimage if - image array is empty bero loading. } - procedure LoadFromFile(const FileName: string); override; - { Overloaded loading method that will add new image to multiimage if - image array is empty bero loading. } - procedure LoadFromStream(Stream: TStream); override; - - { Loads whole multi image from file.} - procedure LoadMultiFromFile(const FileName: string); - { Loads whole multi image from stream.} - procedure LoadMultiFromStream(Stream: TStream); - { Saves whole multi image to file.} - procedure SaveMultiToFile(const FileName: string); - { Saves whole multi image to stream. Ext identifies desired - image file format (jpg, png, dds, ...).} - procedure SaveMultiToStream(const Ext: string; Stream: TStream); - - { Indicates active image of this multi image. All methods inherited - from TBaseImage operate on this image only.} - property ActiveImage: Integer read FActiveImage write SetActiveImage; - { Number of images of this multi image.} - property ImageCount: Integer read GetImageCount write SetImageCount; - { This value is True if all images of this TMultiImage are valid.} - property AllImagesValid: Boolean read GetAllImagesValid; - { This gives complete access to underlying TDynImageDataArray. - It can be used in functions that take TDynImageDataArray - as parameter.} - property DataArray: TDynImageDataArray read FDataArray; - { Array property for accessing individual images of TMultiImage. When you - set image at given index the old image is freed and the source is cloned.} - property Images[Index: Integer]: TImageData read GetImage write SetImage; default; - end; - -implementation - -const - DefaultWidth = 16; - Defaultheight = 16; - -function GetArrayFromImageData(const ImageData: TImageData): TDynImageDataArray; -begin - SetLength(Result, 1); - Result[0] := ImageData; -end; - -{ TBaseImage class implementation } - -constructor TBaseImage.Create; -begin - SetPointer; -end; - -constructor TBaseImage.CreateFromImage(AImage: TBaseImage); -begin - Create; - Assign(AImage); -end; - -destructor TBaseImage.Destroy; -begin - inherited Destroy; -end; - -function TBaseImage.GetWidth: Integer; -begin - if Valid then - Result := FPData.Width - else - Result := 0; -end; - -function TBaseImage.GetHeight: Integer; -begin - if Valid then - Result := FPData.Height - else - Result := 0; -end; - -function TBaseImage.GetFormat: TImageFormat; -begin - if Valid then - Result := FPData.Format - else - Result := ifUnknown; -end; - -function TBaseImage.GetScanline(Index: Integer): Pointer; -var - Info: TImageFormatInfo; -begin - if Valid then - begin - Info := GetFormatInfo; - if not Info.IsSpecial then - Result := ImagingFormats.GetScanLine(FPData.Bits, Info, FPData.Width, Index) - else - Result := FPData.Bits; - end - else - Result := nil; -end; - -function TBaseImage.GetScanlineSize: Integer; -begin - if Valid then - Result := FormatInfo.GetPixelsSize(Format, Width, 1) - else - Result := 0; -end; - -function TBaseImage.GetPixelPointer(X, Y: Integer): Pointer; -begin - if Valid then - Result := @PByteArray(FPData.Bits)[(Y * FPData.Width + X) * GetFormatInfo.BytesPerPixel] - else - Result := nil; -end; - -function TBaseImage.GetSize: Integer; -begin - if Valid then - Result := FPData.Size - else - Result := 0; -end; - -function TBaseImage.GetBits: Pointer; -begin - if Valid then - Result := FPData.Bits - else - Result := nil; -end; - -function TBaseImage.GetPalette: PPalette32; -begin - if Valid then - Result := FPData.Palette - else - Result := nil; -end; - -function TBaseImage.GetPaletteEntries: Integer; -begin - Result := GetFormatInfo.PaletteEntries; -end; - -function TBaseImage.GetFormatInfo: TImageFormatInfo; -begin - if Valid then - Imaging.GetImageFormatInfo(FPData.Format, Result) - else - FillChar(Result, SizeOf(Result), 0); -end; - -function TBaseImage.GetValid: Boolean; -begin - Result := Assigned(FPData) and Imaging.TestImage(FPData^); -end; - -function TBaseImage.GetBoundsRect: TRect; -begin - Result := Rect(0, 0, GetWidth, GetHeight); -end; - -function TBaseImage.GetEmpty: Boolean; -begin - Result := FPData.Size = 0; -end; - -procedure TBaseImage.SetWidth(const Value: Integer); -begin - Resize(Value, GetHeight, rfNearest); -end; - -procedure TBaseImage.SetHeight(const Value: Integer); -begin - Resize(GetWidth, Value, rfNearest); -end; - -procedure TBaseImage.SetFormat(const Value: TImageFormat); -begin - if Valid and Imaging.ConvertImage(FPData^, Value) then - DoDataSizeChanged; -end; - -procedure TBaseImage.DoDataSizeChanged; -begin - if Assigned(FOnDataSizeChanged) then - FOnDataSizeChanged(Self); - DoPixelsChanged; -end; - -procedure TBaseImage.DoPixelsChanged; -begin - if Assigned(FOnPixelsChanged) then - FOnPixelsChanged(Self); -end; - -procedure TBaseImage.RecreateImageData(AWidth, AHeight: Integer; AFormat: TImageFormat); -begin - if Assigned(FPData) and Imaging.NewImage(AWidth, AHeight, AFormat, FPData^) then - DoDataSizeChanged; -end; - -procedure TBaseImage.MapImageData(const ImageData: TImageData); -begin - Clear; - FPData.Width := ImageData.Width; - FPData.Height := ImageData.Height; - FPData.Format := ImageData.Format; - FPData.Size := ImageData.Size; - FPData.Bits := ImageData.Bits; - FPData.Palette := ImageData.Palette; -end; - -procedure TBaseImage.Clear; -begin - FreeImage(FPData^); -end; - -procedure TBaseImage.Resize(NewWidth, NewHeight: Integer; Filter: TResizeFilter); -begin - if Valid and Imaging.ResizeImage(FPData^, NewWidth, NewHeight, Filter) then - DoDataSizeChanged; -end; - -procedure TBaseImage.ResizeToFit(FitWidth, FitHeight: Integer; - Filter: TResizeFilter; DstImage: TBaseImage); -begin - if Valid and Assigned(DstImage) then - begin - Imaging.ResizeImageToFit(FPData^, FitWidth, FitHeight, Filter, - DstImage.FPData^); - DstImage.DoDataSizeChanged; - end; -end; - -procedure TBaseImage.Flip; -begin - if Valid and Imaging.FlipImage(FPData^) then - DoPixelsChanged; -end; - -procedure TBaseImage.Mirror; -begin - if Valid and Imaging.MirrorImage(FPData^) then - DoPixelsChanged; -end; - -procedure TBaseImage.Rotate(Angle: Single); -begin - if Valid then - begin - Imaging.RotateImage(FPData^, Angle); - DoPixelsChanged; - end; -end; - -procedure TBaseImage.CopyTo(SrcX, SrcY, Width, Height: Integer; - DstImage: TBaseImage; DstX, DstY: Integer); -begin - if Valid and Assigned(DstImage) and DstImage.Valid then - begin - Imaging.CopyRect(FPData^, SrcX, SrcY, Width, Height, DstImage.FPData^, DstX, DstY); - DstImage.DoPixelsChanged; - end; -end; - -procedure TBaseImage.StretchTo(SrcX, SrcY, SrcWidth, SrcHeight: Integer; - DstImage: TBaseImage; DstX, DstY, DstWidth, DstHeight: Integer; Filter: TResizeFilter); -begin - if Valid and Assigned(DstImage) and DstImage.Valid then - begin - Imaging.StretchRect(FPData^, SrcX, SrcY, SrcWidth, SrcHeight, - DstImage.FPData^, DstX, DstY, DstWidth, DstHeight, Filter); - DstImage.DoPixelsChanged; - end; -end; - -procedure TBaseImage.ReplaceColor(X, Y, Width, Height: Integer; OldColor, - NewColor: Pointer); -begin - if Valid then - begin - Imaging.ReplaceColor(FPData^, X, Y, Width, Height, OldColor, NewColor); - DoPixelsChanged; - end; -end; - -procedure TBaseImage.SwapChannels(SrcChannel, DstChannel: Integer); -begin - if Valid then - begin - Imaging.SwapChannels(FPData^, SrcChannel, DstChannel); - DoPixelsChanged; - end; -end; - -function TBaseImage.ToString: string; -begin - Result := Iff(Valid, Imaging.ImageToStr(FPData^), 'empty image'); -end; - -procedure TBaseImage.LoadFromFile(const FileName: string); -begin - if Assigned(FPData) and Imaging.LoadImageFromFile(FileName, FPData^) then - DoDataSizeChanged; -end; - -procedure TBaseImage.LoadFromStream(Stream: TStream); -begin - if Assigned(FPData) and Imaging.LoadImageFromStream(Stream, FPData^) then - DoDataSizeChanged; -end; - -procedure TBaseImage.SaveToFile(const FileName: string); -begin - if Valid then - Imaging.SaveImageToFile(FileName, FPData^); -end; - -procedure TBaseImage.SaveToStream(const Ext: string; Stream: TStream); -begin - if Valid then - Imaging.SaveImageToStream(Ext, Stream, FPData^); -end; - - -{ TSingleImage class implementation } - -constructor TSingleImage.Create; -begin - inherited Create; - Clear; -end; - -constructor TSingleImage.CreateFromParams(AWidth, AHeight: Integer; AFormat: TImageFormat); -begin - inherited Create; - RecreateImageData(AWidth, AHeight, AFormat); -end; - -constructor TSingleImage.CreateFromData(const AData: TImageData); -begin - inherited Create; - AssignFromImageData(AData); -end; - -constructor TSingleImage.CreateFromFile(const FileName: string); -begin - inherited Create; - LoadFromFile(FileName); -end; - -constructor TSingleImage.CreateFromStream(Stream: TStream); -begin - inherited Create; - LoadFromStream(Stream); -end; - -destructor TSingleImage.Destroy; -begin - Imaging.FreeImage(FImageData); - inherited Destroy; -end; - -procedure TSingleImage.SetPointer; -begin - FPData := @FImageData; -end; - -procedure TSingleImage.Assign(Source: TPersistent); -begin - if Source = nil then - begin - Clear; - end - else if Source is TSingleImage then - begin - AssignFromImageData(TSingleImage(Source).FImageData); - end - else if Source is TMultiImage then - begin - if TMultiImage(Source).Valid then - AssignFromImageData(TMultiImage(Source).FPData^) - else - Clear; - end - else - inherited Assign(Source); -end; - -procedure TSingleImage.AssignFromImageData(const AImageData: TImageData); -begin - if Imaging.TestImage(AImageData) then - begin - Imaging.CloneImage(AImageData, FImageData); - DoDataSizeChanged; - end - else - Clear; -end; - -{ TMultiImage class implementation } - -constructor TMultiImage.Create; -begin - inherited Create; -end; - -constructor TMultiImage.CreateFromParams(AWidth, AHeight: Integer; - AFormat: TImageFormat; ImageCount: Integer); -var - I: Integer; -begin - Imaging.FreeImagesInArray(FDataArray); - SetLength(FDataArray, ImageCount); - for I := 0 to GetImageCount - 1 do - Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[I]); - if GetImageCount > 0 then - SetActiveImage(0); -end; - -constructor TMultiImage.CreateFromArray(const ADataArray: TDynImageDataArray); -begin - AssignFromArray(ADataArray); -end; - -constructor TMultiImage.CreateFromFile(const FileName: string); -begin - LoadMultiFromFile(FileName); -end; - -constructor TMultiImage.CreateFromStream(Stream: TStream); -begin - LoadMultiFromStream(Stream); -end; - -destructor TMultiImage.Destroy; -begin - Imaging.FreeImagesInArray(FDataArray); - inherited Destroy; -end; - -procedure TMultiImage.SetActiveImage(Value: Integer); -begin - FActiveImage := Value; - SetPointer; -end; - -function TMultiImage.GetImageCount: Integer; -begin - Result := Length(FDataArray); -end; - -procedure TMultiImage.SetImageCount(Value: Integer); -var - I, OldCount: Integer; -begin - if Value > GetImageCount then - begin - // Create new empty images if array will be enlarged - OldCount := GetImageCount; - SetLength(FDataArray, Value); - for I := OldCount to Value - 1 do - Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]); - end - else - begin - // Free images that exceed desired count and shrink array - for I := Value to GetImageCount - 1 do - Imaging.FreeImage(FDataArray[I]); - SetLength(FDataArray, Value); - end; - SetPointer; -end; - -function TMultiImage.GetAllImagesValid: Boolean; -begin - Result := (GetImageCount > 0) and TestImagesInArray(FDataArray); -end; - -function TMultiImage.GetImage(Index: Integer): TImageData; -begin - if (Index >= 0) and (Index < GetImageCount) then - Result := FDataArray[Index]; -end; - -procedure TMultiImage.SetImage(Index: Integer; Value: TImageData); -begin - if (Index >= 0) and (Index < GetImageCount) then - Imaging.CloneImage(Value, FDataArray[Index]); -end; - -procedure TMultiImage.SetPointer; -begin - if GetImageCount > 0 then - begin - FActiveImage := ClampInt(FActiveImage, 0, GetImageCount - 1); - FPData := @FDataArray[FActiveImage]; - end - else - begin - FActiveImage := -1; - FPData := nil - end; -end; - -function TMultiImage.PrepareInsert(Index, Count: Integer): Boolean; -var - I: Integer; -begin - // Inserting to empty image will add image at index 0 - if GetImageCount = 0 then - Index := 0; - - if (Index >= 0) and (Index <= GetImageCount) and (Count > 0) then - begin - SetLength(FDataArray, GetImageCount + Count); - if Index < GetImageCount - 1 then - begin - // Move imges to new position - System.Move(FDataArray[Index], FDataArray[Index + Count], - (GetImageCount - Count - Index) * SizeOf(TImageData)); - // Null old images, not free them! - for I := Index to Index + Count - 1 do - InitImage(FDataArray[I]); - end; - Result := True; - end - else - Result := False; -end; - -procedure TMultiImage.DoInsertImages(Index: Integer; const Images: TDynImageDataArray); -var - I, Len: Integer; -begin - Len := Length(Images); - if PrepareInsert(Index, Len) then - begin - for I := 0 to Len - 1 do - Imaging.CloneImage(Images[I], FDataArray[Index + I]); - end; -end; - -procedure TMultiImage.DoInsertNew(Index, AWidth, AHeight: Integer; - AFormat: TImageFormat); -begin - if PrepareInsert(Index, 1) then - Imaging.NewImage(AWidth, AHeight, AFormat, FDataArray[Index]); -end; - -procedure TMultiImage.Assign(Source: TPersistent); -var - Arr: TDynImageDataArray; -begin - if Source = nil then - begin - ClearAll; - end - else if Source is TMultiImage then - begin - AssignFromArray(TMultiImage(Source).FDataArray); - SetActiveImage(TMultiImage(Source).ActiveImage); - end - else if Source is TSingleImage then - begin - SetLength(Arr, 1); - Arr[0] := TSingleImage(Source).FImageData; - AssignFromArray(Arr); - end - else - inherited Assign(Source); -end; - -procedure TMultiImage.AssignFromArray(const ADataArray: TDynImageDataArray); -var - I: Integer; -begin - Imaging.FreeImagesInArray(FDataArray); - SetLength(FDataArray, Length(ADataArray)); - for I := 0 to GetImageCount - 1 do - begin - // Clone only valid images - if Imaging.TestImage(ADataArray[I]) then - Imaging.CloneImage(ADataArray[I], FDataArray[I]) - else - Imaging.NewImage(DefaultWidth, DefaultHeight, ifDefault, FDataArray[I]); - end; - if GetImageCount > 0 then - SetActiveImage(0); -end; - -function TMultiImage.AddImage(AWidth, AHeight: Integer; AFormat: TImageFormat): Integer; -begin - Result := GetImageCount; - DoInsertNew(Result, AWidth, AHeight, AFormat); -end; - -function TMultiImage.AddImage(const Image: TImageData): Integer; -begin - Result := GetImageCount; - DoInsertImages(Result, GetArrayFromImageData(Image)); -end; - -function TMultiImage.AddImage(Image: TBaseImage): Integer; -begin - if Assigned(Image) and Image.Valid then - begin - Result := GetImageCount; - DoInsertImages(Result, GetArrayFromImageData(Image.FPData^)); - end - else - Result := -1; -end; - -procedure TMultiImage.AddImages(const Images: TDynImageDataArray); -begin - DoInsertImages(GetImageCount, Images); -end; - -procedure TMultiImage.AddImages(Images: TMultiImage); -begin - DoInsertImages(GetImageCount, Images.FDataArray); -end; - -procedure TMultiImage.InsertImage(Index, AWidth, AHeight: Integer; - AFormat: TImageFormat); -begin - DoInsertNew(Index, AWidth, AHeight, AFormat); -end; - -procedure TMultiImage.InsertImage(Index: Integer; const Image: TImageData); -begin - DoInsertImages(Index, GetArrayFromImageData(Image)); -end; - -procedure TMultiImage.InsertImage(Index: Integer; Image: TBaseImage); -begin - if Assigned(Image) and Image.Valid then - DoInsertImages(Index, GetArrayFromImageData(Image.FPData^)); -end; - -procedure TMultiImage.InsertImages(Index: Integer; - const Images: TDynImageDataArray); -begin - DoInsertImages(Index, FDataArray); -end; - -procedure TMultiImage.InsertImages(Index: Integer; Images: TMultiImage); -begin - DoInsertImages(Index, Images.FDataArray); -end; - -procedure TMultiImage.ExchangeImages(Index1, Index2: Integer); -var - TempData: TImageData; -begin - if (Index1 >= 0) and (Index1 < GetImageCount) and - (Index2 >= 0) and (Index2 < GetImageCount) then - begin - TempData := FDataArray[Index1]; - FDataArray[Index1] := FDataArray[Index2]; - FDataArray[Index2] := TempData; - end; -end; - -procedure TMultiImage.DeleteImage(Index: Integer); -var - I: Integer; -begin - if (Index >= 0) and (Index < GetImageCount) then - begin - // Free image at index to be deleted - Imaging.FreeImage(FDataArray[Index]); - if Index < GetImageCount - 1 then - begin - // Move images to new indices if necessary - for I := Index to GetImageCount - 2 do - FDataArray[I] := FDataArray[I + 1]; - end; - // Set new array length and update pointer to active image - SetLength(FDataArray, GetImageCount - 1); - SetPointer; - end; -end; - -procedure TMultiImage.ClearAll; -begin - ImageCount := 0; -end; - -procedure TMultiImage.ConvertImages(Format: TImageFormat); -var - I: Integer; -begin - for I := 0 to GetImageCount - 1 do - Imaging.ConvertImage(FDataArray[I], Format); -end; - -procedure TMultiImage.ResizeImages(NewWidth, NewHeight: Integer; - Filter: TResizeFilter); -var - I: Integer; -begin - for I := 0 to GetImageCount - 1 do - Imaging.ResizeImage(FDataArray[I], NewWidth, NewHeight, Filter); -end; - -procedure TMultiImage.ReverseImages; -var - I: Integer; -begin - for I := 0 to GetImageCount div 2 do - ExchangeImages(I, GetImageCount - 1 - I); -end; - -procedure TMultiImage.LoadFromFile(const FileName: string); -begin - if GetImageCount = 0 then - ImageCount := 1; - inherited LoadFromFile(FileName); -end; - -procedure TMultiImage.LoadFromStream(Stream: TStream); -begin - if GetImageCount = 0 then - ImageCount := 1; - inherited LoadFromStream(Stream); -end; - -procedure TMultiImage.LoadMultiFromFile(const FileName: string); -begin - Imaging.LoadMultiImageFromFile(FileName, FDataArray); - SetActiveImage(0); -end; - -procedure TMultiImage.LoadMultiFromStream(Stream: TStream); -begin - Imaging.LoadMultiImageFromStream(Stream, FDataArray); - SetActiveImage(0); -end; - -procedure TMultiImage.SaveMultiToFile(const FileName: string); -begin - Imaging.SaveMultiImageToFile(FileName, FDataArray); -end; - -procedure TMultiImage.SaveMultiToStream(const Ext: string; Stream: TStream); -begin - Imaging.SaveMultiImageToStream(Ext, Stream, FDataArray); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - Added TSingleImage.AssignFromData and TMultiImage.AssigntFromArray - as a replacement for constructors used as methods (that is - compiler error in Delphi XE3). - - Added TBaseImage.ResizeToFit method. - - Changed TMultiImage to have default state with no images. - - TMultiImage.AddImage now returns index of newly added image. - - Fixed img index bug in TMultiImage.ResizeImages - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Added MapImageData method to TBaseImage - - Added Empty property to TBaseImage. - - Added Clear method to TBaseImage. - - Added ScanlineSize property to TBaseImage. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Added TMultiImage.ReverseImages method. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added SwapChannels method to TBaseImage. - - Added ReplaceColor method to TBaseImage. - - Added ToString method to TBaseImage. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Inserting images to empty MultiImage will act as Add method. - - MultiImages with empty arrays will now create one image when - LoadFromFile or LoadFromStream is called. - - Fixed bug that caused AVs when getting props like Width, Height, asn Size - and when inlining was off. There was call to Iff but with inlining disabled - params like FPData.Size were evaluated and when FPData was nil => AV. - - Added many FPData validity checks to many methods. There were AVs - when calling most methods on empty TMultiImage. - - Added AllImagesValid property to TMultiImage. - - Fixed memory leak in TMultiImage.CreateFromParams. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added ResizeImages method to TMultiImage - - removed Ext parameter from various LoadFromStream methods, no - longer needed - - fixed various issues concerning ActiveImage of TMultiImage - (it pointed to invalid location after some operations) - - most of property set/get methods are now inline - - added PixelPointers property to TBaseImage - - added Images default array property to TMultiImage - - renamed methods in TMultiImage to contain 'Image' instead of 'Level' - - added canvas support - - added OnDataSizeChanged and OnPixelsChanged event to TBaseImage - - renamed TSingleImage.NewImage to RecreateImageData, made public, and - moved to TBaseImage - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added props PaletteEntries and ScanLine to TBaseImage - - aded new constructor to TBaseImage that take TBaseImage source - - TMultiImage levels adding and inserting rewritten internally - - added some new functions to TMultiImage: AddLevels, InsertLevels - - added some new functions to TBaseImage: Flip, Mirror, Rotate, - CopyRect, StretchRect - - TBasicImage.Resize has now filter parameter - - new stuff added to TMultiImage (DataArray prop, ConvertLevels) - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - added AddLevel, InsertLevel, ExchangeLevels and DeleteLevel - methods to TMultiImage - - added TBaseImage, TSingleImage and TMultiImage with initial - members -} - -end. - diff --git a/3rd/Imaging/Source/ImagingColors.pas b/3rd/Imaging/Source/ImagingColors.pas deleted file mode 100644 index c7fc81138..000000000 --- a/3rd/Imaging/Source/ImagingColors.pas +++ /dev/null @@ -1,246 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains functions for manipulating and converting color values.} -unit ImagingColors; - -interface - -{$I ImagingOptions.inc} - -uses - SysUtils, ImagingTypes, ImagingUtility; - -{ Converts RGB color to YUV.} -procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); -{ Converts YIV to RGB color.} -procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); - -{ Converts RGB color to YCbCr as used in JPEG.} -procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); -{ Converts YCbCr as used in JPEG to RGB color.} -procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); -{ Converts RGB color to YCbCr as used in JPEG.} -procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); -{ Converts YCbCr as used in JPEG to RGB color.} -procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); - -{ Converts RGB color to CMY.} -procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); -{ Converts CMY to RGB color.} -procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); -{ Converts RGB color to CMY.} -procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word); -{ Converts CMY to RGB color.} -procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); - -{ Converts RGB color to CMYK.} -procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte); -{ Converts CMYK to RGB color.} -procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); -{ Converts RGB color to CMYK.} -procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); -{ Converts CMYK to RGB color.} -procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); - -{ Converts RGB color to YCoCg.} -procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); -{ Converts YCoCg to RGB color.} -procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); - -//procedure RGBToHSL(R, G, B: Byte; var H, S, L: Byte); -//procedure HSLToRGB(H, S, L: Byte; var R, G, B: Byte); - -implementation - -procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); -begin - Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16); - V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128); - U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128); -end; - -procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); -var - CY, CU, CV: LongInt; -begin - CY := Y - 16; - CU := U - 128; - CV := V - 128; - R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV)); - G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV)); - B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV)); -end; - -procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); -begin - Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); - Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128)); - Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128)); -end; - -procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); -begin - R := ClampToByte(Round(Y + 1.40200 * (Cr - 128))); - G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128))); - B := ClampToByte(Round(Y + 1.77200 * (Cb - 128))); -end; - -procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); -begin - Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); - Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768)); - Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768)); -end; - -procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); -begin - R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768))); - G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768))); - B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768))); -end; - -procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); -begin - C := 255 - R; - M := 255 - G; - Y := 255 - B; -end; - -procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); -begin - R := 255 - C; - G := 255 - M; - B := 255 - Y; -end; - -procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word); -begin - C := 65535 - R; - M := 65535 - G; - Y := 65535 - B; -end; - -procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); -begin - R := 65535 - C; - G := 65535 - M; - B := 65535 - Y; -end; - -procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte); -begin - RGBToCMY(R, G, B, C, M, Y); - K := Min(C, Min(M, Y)); - if K = 255 then - begin - C := 0; - M := 0; - Y := 0; - end - else - begin - C := ClampToByte(Round((C - K) / (255 - K) * 255)); - M := ClampToByte(Round((M - K) / (255 - K) * 255)); - Y := ClampToByte(Round((Y - K) / (255 - K) * 255)); - end; -end; - -procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); -begin - R := (255 - (C - MulDiv(C, K, 255) + K)); - G := (255 - (M - MulDiv(M, K, 255) + K)); - B := (255 - (Y - MulDiv(Y, K, 255) + K)); -end; - -procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); -begin - RGBToCMY16(R, G, B, C, M, Y); - K := Min(C, Min(M, Y)); - if K = 65535 then - begin - C := 0; - M := 0; - Y := 0; - end - else - begin - C := ClampToWord(Round((C - K) / (65535 - K) * 65535)); - M := ClampToWord(Round((M - K) / (65535 - K) * 65535)); - Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535)); - end; -end; - -procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); -begin - R := 65535 - (C - MulDiv(C, K, 65535) + K); - G := 65535 - (M - MulDiv(M, K, 65535) + K); - B := 65535 - (Y - MulDiv(Y, K, 65535) + K); -end; - -procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); -begin - // C and Delphi's SHR behaviour differs for negative numbers, use div instead. - Y := ClampToByte(( R + G shl 1 + B + 2) div 4); - Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128); - Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128); -end; - -procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); -var - CoInt, CgInt: Integer; -begin - CoInt := Co - 128; - CgInt := Cg - 128; - R := ClampToByte(Y + CoInt - CgInt); - G := ClampToByte(Y + CgInt); - B := ClampToByte(Y - CoInt - CgInt); -end; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Added RGB<>YCoCg conversion functions. - - Fixed RGB>>CMYK conversions. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added RGB<>CMY(K) converion functions for 16 bit channels - (needed by PSD loading code). - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added some color space conversion functions and LUTs - (RGB/YUV/YCrCb/CMY/CMYK). - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - unit created (empty!) -} - -end. diff --git a/3rd/Imaging/Source/ImagingComponents.pas b/3rd/Imaging/Source/ImagingComponents.pas deleted file mode 100644 index 2e0af75b7..000000000 --- a/3rd/Imaging/Source/ImagingComponents.pas +++ /dev/null @@ -1,1297 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains VCL/LCL TGraphic descendant which uses Imaging library - for saving and loading.} -unit ImagingComponents; - -{$I ImagingOptions.inc} - -interface - -{$IFDEF LCL} - {$DEFINE COMPONENT_SET_LCL} - {$UNDEF COMPONENT_SET_VCL} -{$ENDIF} - -{$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)} -// If no component sets should be used just include empty unit. -//DOC-IGNORE-BEGIN -implementation -//DOC-IGNORE-END -{$ELSE} - -uses - SysUtils, Types, Classes, -{$IFDEF MSWINDOWS} - Windows, -{$ENDIF} -{$IFDEF COMPONENT_SET_VCL} - Graphics, -{$ENDIF} -{$IFDEF COMPONENT_SET_LCL} - InterfaceBase, - GraphType, - Graphics, - LCLType, - LCLIntf, -{$ENDIF} - ImagingTypes, Imaging, ImagingClasses; - -type - { Graphic class which uses Imaging to load images. - It has standard TBitmap class as ancestor and it can - Assign also to/from TImageData structres and TBaseImage - classes. For saving is uses inherited TBitmap methods. - This class is automatically registered to TPicture for all - file extensions supported by Imaging (useful only for loading). - If you just want to load images in various formats you can use this - class or simply use TPicture.LoadFromXXX which will create this class - automatically. For TGraphic class that saves with Imaging look - at TImagingGraphicForSave class.} - TImagingGraphic = class(TBitmap) - protected - procedure ReadDataFromStream(Stream: TStream); virtual; - procedure AssignTo(Dest: TPersistent); override; - public - constructor Create; override; - - { Loads new image from the stream. It can load all image - file formats supported by Imaging (and enabled of course) - even though it is called by descendant class capable of - saving only one file format.} - procedure LoadFromStream(Stream: TStream); override; - { Copies the image contained in Source to this graphic object. - Supports also TBaseImage descendants from ImagingClasses unit. } - procedure Assign(Source: TPersistent); override; - { Copies the image contained in TBaseImage to this graphic object.} - procedure AssignFromImage(Image: TBaseImage); - { Copies the current image to TBaseImage object.} - procedure AssignToImage(Image: TBaseImage); - { Copies the image contained in TImageData structure to this graphic object.} - procedure AssignFromImageData(const ImageData: TImageData); - { Copies the current image to TImageData structure.} - procedure AssignToImageData(var ImageData: TImageData); - end; - - TImagingGraphicClass = class of TImagingGraphic; - - { Base class for file format specific TGraphic classes that use - Imaging for saving. Each descendant class can load all file formats - supported by Imaging but save only one format (TImagingBitmap - for *.bmp, TImagingJpeg for *.jpg). Format specific classes also - allow easy access to Imaging options that affect saving of files - (they are properties here).} - TImagingGraphicForSave = class(TImagingGraphic) - protected - FDefaultFileExt: string; - FSavingFormat: TImageFormat; - procedure WriteDataToStream(Stream: TStream); virtual; - public - constructor Create; override; - { Saves the current image to the stream. It is saved in the - file format according to the DefaultFileExt property. - So each descendant class can save some other file format.} - procedure SaveToStream(Stream: TStream); override; - { Returns TImageFileFormat descendant for this graphic class.} - class function GetFileFormat: TImageFileFormat; virtual; abstract; - {$IFDEF COMPONENT_SET_LCL} - { Returns file extensions of this graphic class.} - class function GetFileExtensions: string; override; - { Returns default MIME type of this graphic class.} - function GetMimeType: string; override; - {$ENDIF} - { Default (the most common) file extension of this graphic class.} - property DefaultFileExt: string read FDefaultFileExt; - end; - - TImagingGraphicForSaveClass = class of TImagingGraphicForSave; - -{$IFNDEF DONT_LINK_BITMAP} - { TImagingGraphic descendant for loading/saving Windows bitmaps. - VCL/CLX/LCL all have native support for bitmaps so you might - want to disable this class (although you can save bitmaps with - RLE compression with this class).} - TImagingBitmap = class(TImagingGraphicForSave) - protected - FUseRLE: Boolean; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - { See ImagingBitmapRLE option for details.} - property UseRLE: Boolean read FUseRLE write FUseRLE; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_JPEG} - { TImagingGraphic descendant for loading/saving JPEG images.} - TImagingJpeg = class(TImagingGraphicForSave) - protected - FQuality: LongInt; - FProgressive: Boolean; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - {$IFDEF COMPONENT_SET_LCL} - function GetMimeType: string; override; - {$ENDIF} - { See ImagingJpegQuality option for details.} - property Quality: LongInt read FQuality write FQuality; - { See ImagingJpegProgressive option for details.} - property Progressive: Boolean read FProgressive write FProgressive; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_PNG} - { TImagingGraphic descendant for loading/saving PNG images.} - TImagingPNG = class(TImagingGraphicForSave) - protected - FPreFilter: LongInt; - FCompressLevel: LongInt; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - { See ImagingPNGPreFilter option for details.} - property PreFilter: LongInt read FPreFilter write FPreFilter; - { See ImagingPNGCompressLevel option for details.} - property CompressLevel: LongInt read FCompressLevel write FCompressLevel; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_GIF} - { TImagingGraphic descendant for loading/saving GIF images.} - TImagingGIF = class(TImagingGraphicForSave) - public - class function GetFileFormat: TImageFileFormat; override; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_TARGA} - { TImagingGraphic descendant for loading/saving Targa images.} - TImagingTarga = class(TImagingGraphicForSave) - protected - FUseRLE: Boolean; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - { See ImagingTargaRLE option for details.} - property UseRLE: Boolean read FUseRLE write FUseRLE; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_DDS} - { Compresssion type used when saving DDS files by TImagingDds.} - TDDSCompresion = (dcNone, dcDXT1, dcDXT3, dcDXT5); - - { TImagingGraphic descendant for loading/saving DDS images.} - TImagingDDS = class(TImagingGraphicForSave) - protected - FCompression: TDDSCompresion; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - { You can choose compression type used when saving DDS file. - dcNone means that file will be saved in the current bitmaps pixel format.} - property Compression: TDDSCompresion read FCompression write FCompression; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_MNG} - { TImagingGraphic descendant for loading/saving MNG images.} - TImagingMNG = class(TImagingGraphicForSave) - protected - FLossyCompression: Boolean; - FLossyAlpha: Boolean; - FPreFilter: LongInt; - FCompressLevel: LongInt; - FQuality: LongInt; - FProgressive: Boolean; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - {$IFDEF COMPONENT_SET_LCL} - function GetMimeType: string; override; - {$ENDIF} - { See ImagingMNGLossyCompression option for details.} - property LossyCompression: Boolean read FLossyCompression write FLossyCompression; - { See ImagingMNGLossyAlpha option for details.} - property LossyAlpha: Boolean read FLossyAlpha write FLossyAlpha; - { See ImagingMNGPreFilter option for details.} - property PreFilter: LongInt read FPreFilter write FPreFilter; - { See ImagingMNGCompressLevel option for details.} - property CompressLevel: LongInt read FCompressLevel write FCompressLevel; - { See ImagingMNGQuality option for details.} - property Quality: LongInt read FQuality write FQuality; - { See ImagingMNGProgressive option for details.} - property Progressive: Boolean read FProgressive write FProgressive; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_JNG} - { TImagingGraphic descendant for loading/saving JNG images.} - TImagingJNG = class(TImagingGraphicForSave) - protected - FLossyAlpha: Boolean; - FAlphaPreFilter: LongInt; - FAlphaCompressLevel: LongInt; - FQuality: LongInt; - FProgressive: Boolean; - public - constructor Create; override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileFormat: TImageFileFormat; override; - { See ImagingJNGLossyAlpha option for details.} - property LossyAlpha: Boolean read FLossyAlpha write FLossyAlpha; - { See ImagingJNGPreFilter option for details.} - property AlphaPreFilter: LongInt read FAlphaPreFilter write FAlphaPreFilter; - { See ImagingJNGCompressLevel option for details.} - property AlphaCompressLevel: LongInt read FAlphaCompressLevel write FAlphaCompressLevel; - { See ImagingJNGQuality option for details.} - property Quality: LongInt read FQuality write FQuality; - { See ImagingJNGProgressive option for details.} - property Progressive: Boolean read FProgressive write FProgressive; - end; -{$ENDIF} - -{ Returns bitmap pixel format with the closest match with given data format.} -function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat; -{ Returns data format with closest match with given bitmap pixel format.} -function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat; - -{ Converts TImageData structure to VCL/CLX/LCL bitmap.} -procedure ConvertDataToBitmap(const Data: TImageData; Bitmap: TBitmap); -{ Converts VCL/CLX/LCL bitmap to TImageData structure.} -procedure ConvertBitmapToData(Bitmap: TBitmap; var Data: TImageData); -{ Converts TBaseImage instance to VCL/CLX/LCL bitmap.} -procedure ConvertImageToBitmap(Image: TBaseImage; Bitmap: TBitmap); -{ Converts VCL/CLX/LCL bitmap to TBaseImage. Image must exist before - procedure is called. It overwrites its current image data. - When Image is TMultiImage only the current image level is overwritten.} -procedure ConvertBitmapToImage(Bitmap: TBitmap; Image: TBaseImage); - -{ Displays image stored in TImageData structure onto TCanvas. This procedure - draws image without converting from Imaging format to TBitmap. - Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this - when you want displaying images that change frequently (because converting to - TBitmap by ConvertImageDataToBitmap is generally slow). Dest and Src - rectangles represent coordinates in the form (X1, Y1, X2, Y2).} -procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect); -{ Displays image onto TCanvas at position [DstX, DstY]. This procedure - draws image without converting from Imaging format to TBitmap. - Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this - when you want displaying images that change frequently (because converting to - TBitmap by ConvertImageDataToBitmap is generally slow).} -procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage); overload; -{ Displays image onto TCanvas to rectangle DstRect. This procedure - draws image without converting from Imaging format to TBitmap. - Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this - when you want displaying images that change frequently (because converting to - TBitmap by ConvertImageDataToBitmap is generally slow).} -procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage); overload; -{ Displays part of the image specified by SrcRect onto TCanvas to rectangle DstRect. - This procedure draws image without converting from Imaging format to TBitmap. - Only [ifA8R8G8B8, ifX8R8G8B8] image formats are supported. Use this - when you want displaying images that change frequently (because converting to - TBitmap by ConvertImageDataToBitmap is generally slow).} -procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage; const SrcRect: TRect); overload; - -{$IFDEF MSWINDOWS} -{ Displays image stored in TImageData structure onto Windows device context. - Behaviour is the same as of DisplayImageData.} -procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect); -{$ENDIF} - -implementation - -uses -{$IF Defined(LCL)} - {$IF Defined(LCLGTK2)} - GLib2, GDK2, GTK2, GTK2Def, GTK2Proc, - {$IFEND} -{$IFEND} -{$IFNDEF DONT_LINK_BITMAP} - ImagingBitmap, -{$ENDIF} -{$IFNDEF DONT_LINK_JPEG} - ImagingJpeg, -{$ENDIF} -{$IFNDEF DONT_LINK_GIF} - ImagingGif, -{$ENDIF} -{$IFNDEF DONT_LINK_TARGA} - ImagingTarga, -{$ENDIF} -{$IFNDEF DONT_LINK_DDS} - ImagingDds, -{$ENDIF} -{$IF not Defined(DONT_LINK_PNG) or not Defined(DONT_LINK_MNG) or not Defined(DONT_LINK_JNG)} - ImagingNetworkGraphics, -{$IFEND} - ImagingFormats, ImagingUtility; - -resourcestring - SBadFormatDataToBitmap = 'Cannot find compatible bitmap format for image %s'; - SBadFormatBitmapToData = 'Cannot find compatible data format for bitmap %p'; - SBadFormatDisplay = 'Unsupported image format passed'; - SUnsupportedLCLWidgetSet = 'This function is not implemented for current LCL widget set'; - SImagingGraphicName = 'Imaging Graphic AllInOne'; - -{ Registers types to VCL/LCL.} -procedure RegisterTypes; -var - I: LongInt; - - procedure RegisterFileFormatAllInOne(Format: TImageFileFormat); - var - I: LongInt; - begin - for I := 0 to Format.Extensions.Count - 1 do - TPicture.RegisterFileFormat(Format.Extensions[I], SImagingGraphicName, - TImagingGraphic); - end; - - procedure RegisterFileFormat(AClass: TImagingGraphicForSaveClass); - var - I: LongInt; - begin - for I := 0 to AClass.GetFileFormat.Extensions.Count - 1 do - TPicture.RegisterFileFormat(AClass.GetFileFormat.Extensions[I], - AClass.GetFileFormat.Name, AClass); - end; - -begin - for I := Imaging.GetFileFormatCount - 1 downto 0 do - RegisterFileFormatAllInOne(Imaging.GetFileFormatAtIndex(I)); - Classes.RegisterClass(TImagingGraphic); - -{$IFNDEF DONT_LINK_TARGA} - RegisterFileFormat(TImagingTarga); - Classes.RegisterClass(TImagingTarga); -{$ENDIF} -{$IFNDEF DONT_LINK_DDS} - RegisterFileFormat(TImagingDDS); - Classes.RegisterClass(TImagingDDS); -{$ENDIF} -{$IFNDEF DONT_LINK_JNG} - RegisterFileFormat(TImagingJNG); - Classes.RegisterClass(TImagingJNG); -{$ENDIF} -{$IFNDEF DONT_LINK_MNG} - RegisterFileFormat(TImagingMNG); - Classes.RegisterClass(TImagingMNG); -{$ENDIF} -{$IFNDEF DONT_LINK_GIF} - RegisterFileFormat(TImagingGIF); - Classes.RegisterClass(TImagingGIF); -{$ENDIF} -{$IFNDEF DONT_LINK_PNG} - {$IFDEF COMPONENT_SET_LCL} - // Unregister Lazarus� default PNG loader which crashes on some PNG files - TPicture.UnregisterGraphicClass(TPortableNetworkGraphic); - {$ENDIF} - RegisterFileFormat(TImagingPNG); - Classes.RegisterClass(TImagingPNG); -{$ENDIF} -{$IFNDEF DONT_LINK_JPEG} - RegisterFileFormat(TImagingJpeg); - Classes.RegisterClass(TImagingJpeg); -{$ENDIF} -{$IFNDEF DONT_LINK_BITMAP} - RegisterFileFormat(TImagingBitmap); - Classes.RegisterClass(TImagingBitmap); -{$ENDIF} -end; - -{ Unregisters types from VCL/LCL.} -procedure UnRegisterTypes; -begin -{$IFNDEF DONT_LINK_BITMAP} - TPicture.UnregisterGraphicClass(TImagingBitmap); - Classes.UnRegisterClass(TImagingBitmap); -{$ENDIF} -{$IFNDEF DONT_LINK_JPEG} - TPicture.UnregisterGraphicClass(TImagingJpeg); - Classes.UnRegisterClass(TImagingJpeg); -{$ENDIF} -{$IFNDEF DONT_LINK_PNG} - TPicture.UnregisterGraphicClass(TImagingPNG); - Classes.UnRegisterClass(TImagingPNG); -{$ENDIF} -{$IFNDEF DONT_LINK_GIF} - TPicture.UnregisterGraphicClass(TImagingGIF); - Classes.UnRegisterClass(TImagingGIF); -{$ENDIF} -{$IFNDEF DONT_LINK_TARGA} - TPicture.UnregisterGraphicClass(TImagingTarga); - Classes.UnRegisterClass(TImagingTarga); -{$ENDIF} -{$IFNDEF DONT_LINK_DDS} - TPicture.UnregisterGraphicClass(TImagingDDS); - Classes.UnRegisterClass(TImagingDDS); -{$ENDIF} - TPicture.UnregisterGraphicClass(TImagingGraphic); - Classes.UnRegisterClass(TImagingGraphic); -end; - -function DataFormatToPixelFormat(Format: TImageFormat): TPixelFormat; -begin - case Format of -{$IFDEF COMPONENT_SET_VCL} - ifIndex8: Result := pf8bit; - ifR5G6B5: Result := pf16bit; - ifR8G8B8: Result := pf24bit; -{$ENDIF} - ifA8R8G8B8, - ifX8R8G8B8: Result := pf32bit; - else - Result := pfCustom; - end; -end; - -function PixelFormatToDataFormat(Format: TPixelFormat): TImageFormat; -begin - case Format of - pf8bit: Result := ifIndex8; - pf15bit: Result := ifA1R5G5B5; - pf16bit: Result := ifR5G6B5; - pf24bit: Result := ifR8G8B8; - pf32bit: Result := ifA8R8G8B8; - else - Result := ifUnknown; - end; -end; - -procedure ConvertDataToBitmap(const Data: TImageData; Bitmap: TBitmap); -var - I, LineBytes: LongInt; - PF: TPixelFormat; - Info: TImageFormatInfo; - WorkData: TImageData; -{$IFDEF COMPONENT_SET_VCL} - LogPalette: TMaxLogPalette; -{$ENDIF} -{$IFDEF COMPONENT_SET_LCL} - RawImage: TRawImage; - ImgHandle, ImgMaskHandle: HBitmap; -{$ENDIF} -begin - PF := DataFormatToPixelFormat(Data.Format); - GetImageFormatInfo(Data.Format, Info); - - if (PF = pf8bit) and PaletteHasAlpha(Data.Palette, Info.PaletteEntries) then - begin - // Some indexed images may have valid alpha data, dont lose it! - // (e.g. transparent 8bit PNG or GIF images) - PF := pfCustom; - end; - - if PF = pfCustom then - begin - // Convert from formats not supported by Graphics unit - Imaging.InitImage(WorkData); - Imaging.CloneImage(Data, WorkData); - if Info.IsFloatingPoint or Info.HasAlphaChannel or Info.IsSpecial then - Imaging.ConvertImage(WorkData, ifA8R8G8B8) - else - begin -{$IFDEF COMPONENT_SET_VCL} - if Info.IsIndexed or Info.HasGrayChannel then - Imaging.ConvertImage(WorkData, ifIndex8) - else if Info.UsePixelFormat then - Imaging.ConvertImage(WorkData, ifR5G6B5) - else - Imaging.ConvertImage(WorkData, ifR8G8B8); -{$ELSE} - Imaging.ConvertImage(WorkData, ifA8R8G8B8); -{$ENDIF} - end; - - PF := DataFormatToPixelFormat(WorkData.Format); - GetImageFormatInfo(WorkData.Format, Info); - end - else - WorkData := Data; - - if PF = pfCustom then - RaiseImaging(SBadFormatDataToBitmap, [ImageToStr(WorkData)]); - - LineBytes := WorkData.Width * Info.BytesPerPixel; - -{$IFDEF COMPONENT_SET_VCL} - Bitmap.Width := WorkData.Width; - Bitmap.Height := WorkData.Height; - Bitmap.PixelFormat := PF; - - if (PF = pf8bit) and (WorkData.Palette <> nil) then - begin - // Copy palette, this must be done before copying bits - FillChar(LogPalette, SizeOf(LogPalette), 0); - LogPalette.palVersion := $300; - LogPalette.palNumEntries := Info.PaletteEntries; - for I := 0 to Info.PaletteEntries - 1 do - with LogPalette do - begin - palPalEntry[I].peRed := WorkData.Palette[I].R; - palPalEntry[I].peGreen := WorkData.Palette[I].G; - palPalEntry[I].peBlue := WorkData.Palette[I].B; - end; - Bitmap.Palette := CreatePalette(PLogPalette(@LogPalette)^); - end; - // Copy scanlines - for I := 0 to WorkData.Height - 1 do - Move(PByteArray(WorkData.Bits)[I * LineBytes], Bitmap.Scanline[I]^, LineBytes); - - // Delphi 2009 and newer support alpha transparency fro TBitmap -{$IF Defined(DELPHI) and (CompilerVersion >= 20.0)} - if Bitmap.PixelFormat = pf32bit then - Bitmap.AlphaFormat := afDefined; -{$IFEND} - -{$ENDIF} -{$IFDEF COMPONENT_SET_LCL} - // Create 32bit raw image from image data - FillChar(RawImage, SizeOf(RawImage), 0); - with RawImage.Description do - begin - Width := WorkData.Width; - Height := WorkData.Height; - BitsPerPixel := 32; - Format := ricfRGBA; - LineEnd := rileDWordBoundary; - BitOrder := riboBitsInOrder; - ByteOrder := riboLSBFirst; - LineOrder := riloTopToBottom; - AlphaPrec := 8; - RedPrec := 8; - GreenPrec := 8; - BluePrec := 8; - AlphaShift := 24; - RedShift := 16; - GreenShift := 8; - BlueShift := 0; - Depth := 32; // Must be 32 for alpha blending (and for working in MacOSX Carbon) - end; - RawImage.Data := WorkData.Bits; - RawImage.DataSize := WorkData.Size; - - // Create bitmap from raw image - if RawImage_CreateBitmaps(RawImage, ImgHandle, ImgMaskHandle) then - begin - Bitmap.Handle := ImgHandle; - Bitmap.MaskHandle := ImgMaskHandle; - end; -{$ENDIF} - if WorkData.Bits <> Data.Bits then - Imaging.FreeImage(WorkData); -end; - -procedure ConvertBitmapToData(Bitmap: TBitmap; var Data: TImageData); -var - I, LineBytes: LongInt; - Format: TImageFormat; - Info: TImageFormatInfo; -{$IFDEF COMPONENT_SET_VCL} - Colors: Word; - LogPalette: TMaxLogPalette; -{$ENDIF} -{$IFDEF COMPONENT_SET_LCL} - RawImage: TRawImage; - LineLazBytes: LongInt; -{$ENDIF} -begin -{$IFDEF COMPONENT_SET_LCL} - // In the current Lazarus 0.9.10 Bitmap.PixelFormat property is useless. - // We cannot change bitmap's format by changing it (it will just release - // old image but not convert it to new format) nor we can determine bitmaps's - // current format (it is usually set to pfDevice). So bitmap's format is obtained - // trough RawImage api and cannot be changed to mirror some Imaging format - // (so formats with no coresponding Imaging format cannot be saved now). - - if RawImage_DescriptionFromBitmap(Bitmap.Handle, RawImage.Description) then - case RawImage.Description.BitsPerPixel of - 8: Format := ifIndex8; - 16: - if RawImage.Description.Depth = 15 then - Format := ifA1R5G5B5 - else - Format := ifR5G6B5; - 24: Format := ifR8G8B8; - 32: Format := ifA8R8G8B8; - 48: Format := ifR16G16B16; - 64: Format := ifA16R16G16B16; - else - Format := ifUnknown; - end; -{$ELSE} - Format := PixelFormatToDataFormat(Bitmap.PixelFormat); - if Format = ifUnknown then - begin - // Convert from formats not supported by Imaging (1/4 bit) - if Bitmap.PixelFormat < pf8bit then - Bitmap.PixelFormat := pf8bit - else - Bitmap.PixelFormat := pf32bit; - Format := PixelFormatToDataFormat(Bitmap.PixelFormat); - end; -{$ENDIF} - - if Format = ifUnknown then - RaiseImaging(SBadFormatBitmapToData, []); - - Imaging.NewImage(Bitmap.Width, Bitmap.Height, Format, Data); - GetImageFormatInfo(Data.Format, Info); - LineBytes := Data.Width * Info.BytesPerPixel; - -{$IFDEF COMPONENT_SET_VCL} - if (Format = ifIndex8) and (GetObject(Bitmap.Palette, SizeOf(Colors), - @Colors) <> 0) then - begin - // Copy palette - GetPaletteEntries(Bitmap.Palette, 0, Colors, LogPalette.palPalEntry); - if Colors > Info.PaletteEntries then - Colors := Info.PaletteEntries; - for I := 0 to Colors - 1 do - with LogPalette do - begin - Data.Palette[I].A := $FF; - Data.Palette[I].R := palPalEntry[I].peRed; - Data.Palette[I].G := palPalEntry[I].peGreen; - Data.Palette[I].B := palPalEntry[I].peBlue; - end; - end; - // Copy scanlines - for I := 0 to Data.Height - 1 do - Move(Bitmap.ScanLine[I]^, PByteArray(Data.Bits)[I * LineBytes], LineBytes); -{$ENDIF} -{$IFDEF COMPONENT_SET_LCL} - // Get raw image from bitmap (mask handle must be 0 or expect violations) - if RawImage_FromBitmap(RawImage, Bitmap.Handle, 0, nil) then - begin - LineLazBytes := GetBytesPerLine(Data.Width, RawImage.Description.BitsPerPixel, - RawImage.Description.LineEnd); - // Copy scanlines - for I := 0 to Data.Height - 1 do - begin - Move(PByteArray(RawImage.Data)[I * LineLazBytes], - PByteArray(Data.Bits)[I * LineBytes], LineBytes); - end; - // May need to swap RB order, depends on wifget set - if RawImage.Description.BlueShift > RawImage.Description.RedShift then - SwapChannels(Data, ChannelRed, ChannelBlue); - - RawImage.FreeData; - end; -{$ENDIF} -end; - -procedure ConvertImageToBitmap(Image: TBaseImage; Bitmap: TBitmap); -begin - ConvertDataToBitmap(Image.ImageDataPointer^, Bitmap); -end; - -procedure ConvertBitmapToImage(Bitmap: TBitmap; Image: TBaseImage); -begin - ConvertBitmapToData(Bitmap, Image.ImageDataPointer^); -end; - -{$IFDEF MSWINDOWS} -procedure DisplayImageDataOnDC(DC: HDC; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect); -var - OldMode: Integer; - BitmapInfo: Windows.TBitmapInfo; - Bmp: TBitmap; -begin - if TestImage(ImageData) then - begin - Assert(ImageData.Format in [ifA8R8G8B8, ifX8R8G8B8], SBadFormatDisplay); - OldMode := Windows.SetStretchBltMode(DC, COLORONCOLOR); - - FillChar(BitmapInfo, SizeOf(BitmapInfo), 0); - with BitmapInfo.bmiHeader do - begin - biSize := SizeOf(TBitmapInfoHeader); - biPlanes := 1; - biBitCount := 32; - biCompression := BI_RGB; - biWidth := ImageData.Width; - biHeight := -ImageData.Height; - biSizeImage := ImageData.Size; - biXPelsPerMeter := 0; - biYPelsPerMeter := 0; - biClrUsed := 0; - biClrImportant := 0; - end; - - try - with SrcRect, ImageData do - if Windows.StretchDIBits(DC, DstRect.Left, DstRect.Top, - DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, Left, - Top, Right - Left, Bottom - Top, Bits, BitmapInfo, DIB_RGB_COLORS, SRCCOPY) <> Height then - begin - // StretchDIBits may fail on some ocassions (error 487, http://support.microsoft.com/kb/269585). - // This fallback is slow but works every time. Thanks to Sergey Galezdinov for the fix. - Bmp := TBitmap.Create; - try - ConvertDataToBitmap(ImageData, Bmp); - StretchBlt(DC, DstRect.Left, DstRect.Top, DstRect.Right - DstRect.Left, DstRect.Bottom - DstRect.Top, - Bmp.Canvas.Handle, 0, 0, Width, Height, SRCCOPY); - finally - Bmp.Free; - end; - end; - finally - Windows.SetStretchBltMode(DC, OldMode); - end; - end; -end; -{$ENDIF} - -procedure DisplayImageData(DstCanvas: TCanvas; const DstRect: TRect; const ImageData: TImageData; const SrcRect: TRect); -{$IF Defined(DCC) or Defined(LCLWIN32)} // Delphi or LCL Win32 -begin - DisplayImageDataOnDC(DstCanvas.Handle, DstRect, ImageData, SrcRect); -end; -{$ELSEIF Defined(LCLGTK2)} - type - TDeviceContext = TGtk2DeviceContext; - - procedure GDKDrawBitmap(Dest: HDC; DstX, DstY: Integer; SrcX, SrcY, - SrcWidth, SrcHeight: Integer; ImageData: TImageData); - var - P: TPoint; - begin - P := TDeviceContext(Dest).Offset; - Inc(DstX, P.X); - Inc(DstY, P.Y); - gdk_draw_rgb_32_image(TDeviceContext(Dest).Drawable, TDeviceContext(Dest).GC, - DstX, DstY, SrcWidth, SrcHeight, GDK_RGB_DITHER_NONE, - @PLongWordArray(ImageData.Bits)[SrcY * ImageData.Width + SrcX], ImageData.Width * 4); - end; - -var - DisplayImage: TImageData; - NewWidth, NewHeight: Integer; - SrcBounds, DstBounds, DstClip: TRect; -begin - if TestImage(ImageData) then - begin - Assert(ImageData.Format in [ifA8R8G8B8, ifX8R8G8B8], SBadFormatDisplay); - InitImage(DisplayImage); - - SrcBounds := RectToBounds(SrcRect); - DstBounds := RectToBounds(DstRect); - WidgetSet.GetClipBox(DstCanvas.Handle, @DstClip); - - ClipStretchBounds(SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, SrcBounds.Bottom, - DstBounds.Left, DstBounds.Top, DstBounds.Right, DstBounds.Bottom, ImageData.Width, - ImageData.Height, DstClip); - - NewWidth := DstBounds.Right; - NewHeight := DstBounds.Bottom; - - if (NewWidth > 0) and (NewHeight > 0) then - begin - if (SrcBounds.Right = NewWidth) and (SrcBounds.Bottom = NewHeight) then - try - CloneImage(ImageData, DisplayImage); - // Swap R-B channels for GTK display compatability! - SwapChannels(DisplayImage, ChannelRed, ChannelBlue); - GDKDrawBitmap(DstCanvas.Handle, DstBounds.Left, DstBounds.Top, - SrcBounds.Left, SrcBounds.Top, NewWidth, NewHeight, DisplayImage); - finally - FreeImage(DisplayImage); - end - else - try - // Create new image with desired dimensions - NewImage(NewWidth, NewHeight, ImageData.Format, DisplayImage); - // Stretch pixels from old image to new one TResizeFilter = (rfNearest, rfBilinear, rfBicubic); - StretchRect(ImageData, SrcBounds.Left, SrcBounds.Top, SrcBounds.Right, - SrcBounds.Bottom, DisplayImage, 0, 0, NewWidth, NewHeight, rfNearest); - // Swap R-B channels for GTK display compatability! - SwapChannels(DisplayImage, ChannelRed, ChannelBlue); - GDKDrawBitmap(DstCanvas.Handle, DstBounds.Left, DstBounds.Top, 0, 0, - NewWidth, NewHeight, DisplayImage); - finally - FreeImage(DisplayImage); - end - end; - end; -end; -{$ELSE} -begin - raise Exception.Create(SUnsupportedLCLWidgetSet); -end; -{$IFEND} - -procedure DisplayImage(DstCanvas: TCanvas; DstX, DstY: LongInt; Image: TBaseImage); -begin - DisplayImageData(DstCanvas, BoundsToRect(DstX, DstY, Image.Width, Image.Height), - Image.ImageDataPointer^, Image.BoundsRect); -end; - -procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage); -begin - DisplayImageData(DstCanvas, DstRect, Image.ImageDataPointer^, Image.BoundsRect); -end; - -procedure DisplayImage(DstCanvas: TCanvas; const DstRect: TRect; Image: TBaseImage; const SrcRect: TRect); -begin - DisplayImageData(DstCanvas, DstRect, Image.ImageDataPointer^, SrcRect); -end; - - -{ TImagingGraphic class implementation } - -constructor TImagingGraphic.Create; -begin - inherited Create; - PixelFormat := pf24Bit; -end; - -procedure TImagingGraphic.LoadFromStream(Stream: TStream); -begin - ReadDataFromStream(Stream); -end; - -procedure TImagingGraphic.ReadDataFromStream(Stream: TStream); -var - Image: TSingleImage; -begin - Image := TSingleImage.Create; - try - Image.LoadFromStream(Stream); - Assign(Image); - finally - Image.Free; - end; -end; - -procedure TImagingGraphic.AssignTo(Dest: TPersistent); -var - Arr: TDynImageDataArray; -begin - if Dest is TSingleImage then - begin - AssignToImage(TSingleImage(Dest)) - end - else if Dest is TMultiImage then - begin - SetLength(Arr, 1); - AssignToImageData(Arr[0]); - TMultiImage(Dest).CreateFromArray(Arr); - Imaging.FreeImagesInArray(Arr); - end - else - inherited AssignTo(Dest); -end; - -procedure TImagingGraphic.Assign(Source: TPersistent); -begin - if Source is TBaseImage then - AssignFromImage(TBaseImage(Source)) - else - inherited Assign(Source); -end; - -procedure TImagingGraphic.AssignFromImage(Image: TBaseImage); -begin - if (Image <> nil) and Image.Valid then - AssignFromImageData(Image.ImageDataPointer^); -end; - -procedure TImagingGraphic.AssignToImage(Image: TBaseImage); -begin - if (Image <> nil) and (Image.ImageDataPointer <> nil) then - AssignToImageData(Image.ImageDataPointer^); -end; - -procedure TImagingGraphic.AssignFromImageData(const ImageData: TImageData); -begin - if Imaging.TestImage(ImageData) then - ConvertDataToBitmap(ImageData, Self); -end; - -procedure TImagingGraphic.AssignToImageData(var ImageData: TImageData); -begin - Imaging.FreeImage(ImageData); - ConvertBitmapToData(Self, ImageData); -end; - - -{ TImagingGraphicForSave class implementation } - -constructor TImagingGraphicForSave.Create; -begin - inherited Create; - FDefaultFileExt := GetFileFormat.Extensions[0]; - FSavingFormat := ifUnknown; - GetFileFormat.CheckOptionsValidity; -end; - -procedure TImagingGraphicForSave.WriteDataToStream(Stream: TStream); -var - Image: TSingleImage; -begin - if FDefaultFileExt <> '' then - begin - Image := TSingleImage.Create; - try - Image.Assign(Self); - if FSavingFormat <> ifUnknown then - Image.Format := FSavingFormat; - Image.SaveToStream(FDefaultFileExt, Stream); - finally - Image.Free; - end; - end; -end; - -procedure TImagingGraphicForSave.SaveToStream(Stream: TStream); -begin - WriteDataToStream(Stream); -end; - -{$IFDEF COMPONENT_SET_LCL} -class function TImagingGraphicForSave.GetFileExtensions: string; -begin - Result := StringReplace(GetFileFormat.Extensions.CommaText, ',', ';', [rfReplaceAll]); -end; - -function TImagingGraphicForSave.GetMimeType: string; -begin - Result := 'image/' + FDefaultFileExt; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_BITMAP} - -{ TImagingBitmap class implementation } - -constructor TImagingBitmap.Create; -begin - inherited Create; - FUseRLE := (GetFileFormat as TBitmapFileFormat).UseRLE; -end; - -class function TImagingBitmap.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TBitmapFileFormat); -end; - -procedure TImagingBitmap.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingBitmapRLE, Ord(FUseRLE)); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_JPEG} - -{ TImagingJpeg class implementation } - -constructor TImagingJpeg.Create; -begin - inherited Create; - FQuality := (GetFileFormat as TJpegFileFormat).Quality; - FProgressive := (GetFileFormat as TJpegFileFormat).Progressive; -end; - -class function TImagingJpeg.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TJpegFileFormat); -end; - -{$IFDEF COMPONENT_SET_LCL} -function TImagingJpeg.GetMimeType: string; -begin - Result := 'image/jpeg'; -end; -{$ENDIF} - -procedure TImagingJpeg.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingJpegQuality, FQuality); - Imaging.SetOption(ImagingJpegProgressive, Ord(FProgressive)); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; - -{$ENDIF} - -{$IFNDEF DONT_LINK_PNG} - -{ TImagingPNG class implementation } - -constructor TImagingPNG.Create; -begin - inherited Create; - FPreFilter := (GetFileFormat as TPNGFileFormat).PreFilter; - FCompressLevel := (GetFileFormat as TPNGFileFormat).CompressLevel; -end; - -class function TImagingPNG.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TPNGFileFormat); -end; - -procedure TImagingPNG.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingPNGPreFilter, FPreFilter); - Imaging.SetOption(ImagingPNGCompressLevel, FCompressLevel); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_GIF} - -{ TImagingGIF class implementation} - -class function TImagingGIF.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TGIFFileFormat); -end; - -{$ENDIF} - -{$IFNDEF DONT_LINK_TARGA} - -{ TImagingTarga class implementation } - -constructor TImagingTarga.Create; -begin - inherited Create; - FUseRLE := (GetFileFormat as TTargaFileFormat).UseRLE; -end; - -class function TImagingTarga.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TTargaFileFormat); -end; - -procedure TImagingTarga.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingTargaRLE, Ord(FUseRLE)); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_DDS} - -{ TImagingDDS class implementation } - -constructor TImagingDDS.Create; -begin - inherited Create; - FCompression := dcNone; -end; - -class function TImagingDDS.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TDDSFileFormat); -end; - -procedure TImagingDDS.SaveToStream(Stream: TStream); -begin - case FCompression of - dcNone: FSavingFormat := ifUnknown; - dcDXT1: FSavingFormat := ifDXT1; - dcDXT3: FSavingFormat := ifDXT3; - dcDXT5: FSavingFormat := ifDXT5; - end; - Imaging.PushOptions; - Imaging.SetOption(ImagingDDSSaveCubeMap, Ord(False)); - Imaging.SetOption(ImagingDDSSaveVolume, Ord(False)); - Imaging.SetOption(ImagingDDSSaveMipMapCount, 1); - Imaging.SetOption(ImagingDDSSaveDepth, 1); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_MNG} - -{ TImagingMNG class implementation } - -constructor TImagingMNG.Create; -begin - inherited Create; - FLossyCompression := (GetFileFormat as TMNGFileFormat).LossyCompression; - FLossyAlpha := (GetFileFormat as TMNGFileFormat).LossyAlpha; - FPreFilter := (GetFileFormat as TMNGFileFormat).PreFilter; - FCompressLevel := (GetFileFormat as TMNGFileFormat).CompressLevel; - FQuality := (GetFileFormat as TMNGFileFormat).Quality; - FProgressive := (GetFileFormat as TMNGFileFormat).Progressive; -end; - -class function TImagingMNG.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TMNGFileFormat); -end; - -{$IFDEF COMPONENT_SET_LCL} -function TImagingMNG.GetMimeType: string; -begin - Result := 'video/mng'; -end; -{$ENDIF} - -procedure TImagingMNG.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingMNGLossyCompression, Ord(FLossyCompression)); - Imaging.SetOption(ImagingMNGLossyAlpha, Ord(FLossyAlpha)); - Imaging.SetOption(ImagingMNGPreFilter, FPreFilter); - Imaging.SetOption(ImagingMNGCompressLevel, FCompressLevel); - Imaging.SetOption(ImagingMNGQuality, FQuality); - Imaging.SetOption(ImagingMNGProgressive, Ord(FProgressive)); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -{$IFNDEF DONT_LINK_JNG} - -{ TImagingJNG class implementation } - -constructor TImagingJNG.Create; -begin - inherited Create; - FLossyAlpha := (GetFileFormat as TJNGFileFormat).LossyAlpha; - FAlphaPreFilter := (GetFileFormat as TJNGFileFormat).PreFilter; - FAlphaCompressLevel := (GetFileFormat as TJNGFileFormat).CompressLevel; - FQuality := (GetFileFormat as TJNGFileFormat).Quality; - FProgressive := (GetFileFormat as TJNGFileFormat).Progressive; -end; - -class function TImagingJNG.GetFileFormat: TImageFileFormat; -begin - Result := FindImageFileFormatByClass(TJNGFileFormat); -end; - -procedure TImagingJNG.SaveToStream(Stream: TStream); -begin - Imaging.PushOptions; - Imaging.SetOption(ImagingJNGLossyALpha, Ord(FLossyAlpha)); - Imaging.SetOption(ImagingJNGAlphaPreFilter, FAlphaPreFilter); - Imaging.SetOption(ImagingJNGAlphaCompressLevel, FAlphaCompressLevel); - Imaging.SetOption(ImagingJNGQuality, FQuality); - Imaging.SetOption(ImagingJNGProgressive, Ord(FProgressive)); - inherited SaveToStream(Stream); - Imaging.PopOptions; -end; -{$ENDIF} - -initialization - RegisterTypes; -finalization - UnRegisterTypes; - -{$IFEND} // {$IF not Defined(COMPONENT_SET_LCL) and not Defined(COMPONENT_SET_VCL)} - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - Fixed bug in ConvertBitmapToData causing images from GTK2 bitmaps - to have swapped RB channels. - - LCL: Removed GTK1 support (deprecated). - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Transparency of 8bit images (like loaded from 8bit PNG or GIF) is - kept intact during conversion to TBitmap in ConvertDataToBitmap - (32bit bitmap is created). - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Setting AlphaFormat property of TBitmap in ConvertDataToBitmap - when using Delphi 2009+. - - Fixed garbled LCL TBitmaps created by ConvertDataToBitmap - in Mac OS X (Carbon). - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Added some more IFDEFs for Lazarus widget sets. - - Removed CLX code. - - GTK version of Unix DisplayImageData only used with LCL GTK so the - the rest of the unit can be used with Qt or other LCL interfaces. - - Fallback mechanism for DisplayImageDataOnDC, it may fail on occasions. - - Changed file format conditional compilation to reflect changes - in LINK symbols. - - Lazarus 0.9.26 compatibility changes. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Fixed wrong IFDEF causing that Imaging wouldn't compile in Lazarus - with GTK2 target. - - Added commnets with code for Lazarus rev. 11861+ regarding - RawImage interface. Replace current code with that in comments - if you use Lazarus from SVN. New RawImage interface will be used by - default after next Lazarus release. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added TImagingGIF. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Uses only high level interface now (except for saving options). - - Slightly changed class hierarchy. TImagingGraphic is now only for loading - and base class for savers is new TImagingGraphicForSave. Also - TImagingGraphic is now registered with all supported file formats - by TPicture's format support. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added DisplayImage procedures (thanks to Paul Michell, modified) - - removed RegisterTypes and UnRegisterTypes from interface section, - they are called automatically - - added procedures: ConvertImageToBitmap and ConvertBitmapToImage - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - LCL data to bitmap conversion didn�t work in Linux, fixed - - added MNG file format - - added JNG file format - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - made it LCL compatible - - made it CLX compatible - - added all initial stuff -} - -end. - diff --git a/3rd/Imaging/Source/ImagingDds.pas b/3rd/Imaging/Source/ImagingDds.pas deleted file mode 100644 index 9bcee5aac..000000000 --- a/3rd/Imaging/Source/ImagingDds.pas +++ /dev/null @@ -1,1145 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for DirectDraw Surface images.} -unit ImagingDds; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingUtility, ImagingFormats; - -type - { Class for loading and saving Microsoft DirectDraw surfaces. - It can load/save all D3D formats which have coresponding - TImageFormat. It supports plain textures, cube textures and - volume textures, all of these can have mipmaps. It can also - load some formats which have no exact TImageFormat, but can be easily - converted to one (bump map formats, etc.). - You can get some information about last loaded DDS file by calling - GetOption with ImagingDDSLoadedXXX options and you can set some - saving options by calling SetOption with ImagingDDSSaveXXX or you can - simply use properties of this class. - Note that when saving cube maps and volumes input image array must contain - at least number of images to build cube/volume based on current - Depth and MipMapCount settings.} - TDDSFileFormat = class(TImageFileFormat) - private - FLoadedCubeMap: LongBool; - FLoadedVolume: LongBool; - FLoadedMipMapCount: LongInt; - FLoadedDepth: LongInt; - FSaveCubeMap: LongBool; - FSaveVolume: LongBool; - FSaveMipMapCount: LongInt; - FSaveDepth: LongInt; - procedure ComputeSubDimensions(Idx, Width, Height, MipMaps, Depth: LongInt; - IsCubeMap, IsVolume: Boolean; var CurWidth, CurHeight: LongInt); - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { True if last loaded DDS file was cube map.} - property LoadedCubeMap: LongBool read FLoadedCubeMap write FLoadedCubeMap; - { True if last loaded DDS file was volume texture.} - property LoadedVolume: LongBool read FLoadedVolume write FLoadedVolume; - { Number of mipmap levels of last loaded DDS image.} - property LoadedMipMapCount: LongInt read FLoadedMipMapCount write FLoadedMipMapCount; - { Depth (slices of volume texture or faces of cube map) of last loaded DDS image.} - property LoadedDepth: LongInt read FLoadedDepth write FLoadedDepth; - { True if next DDS file to be saved should be stored as cube map.} - property SaveCubeMap: LongBool read FSaveCubeMap write FSaveCubeMap; - { True if next DDS file to be saved should be stored as volume texture.} - property SaveVolume: LongBool read FSaveVolume write FSaveVolume; - { Sets the number of mipmaps which should be stored in the next saved DDS file. - Only applies to cube maps and volumes, ordinary 2D textures save all - levels present in input.} - property SaveMipMapCount: LongInt read FSaveMipMapCount write FSaveMipMapCount; - { Sets the depth (slices of volume texture or faces of cube map) - of the next saved DDS file.} - property SaveDepth: LongInt read FSaveDepth write FSaveDepth; - end; - -const - { DDS related metadata Ids } - - { DXGI format of textures stored in DDS files with DX10 extension. Type is - Enum (value corresponding to DXGI_FORMAT enum from DX SDK).} - SMetaDdsDxgiFormat = 'DdsDxgiFormat'; - { Number of mipmaps for each main image in DDS file.} - SMetaDdsMipMapCount = 'DdsMipMapCount'; - { Texture array size stored in DDS file (DX10 extension).} - SMetaDdsArraySize = 'DdsArraySize'; - -implementation - -const - SDDSFormatName = 'DirectDraw Surface'; - SDDSMasks = '*.dds'; - DDSSupportedFormats: TImageFormats = [ifR8G8B8, ifA8R8G8B8, ifX8R8G8B8, - ifA1R5G5B5, ifA4R4G4B4, ifX1R5G5B5, ifX4R4G4B4, ifR5G6B5, ifA16B16G16R16, - ifR32F, ifA32B32G32R32F, ifR16F, ifA16B16G16R16F, ifR3G3B2, ifGray8, ifA8Gray8, - ifGray16, ifDXT1, ifDXT3, ifDXT5, ifATI1N, ifATI2N]; - -const - { Four character codes.} - DDSMagic = LongWord(Byte('D') or (Byte('D') shl 8) or (Byte('S') shl 16) or - (Byte(' ') shl 24)); - FOURCC_DXT1 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or - (Byte('1') shl 24)); - FOURCC_DXT3 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or - (Byte('3') shl 24)); - FOURCC_DXT5 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('T') shl 16) or - (Byte('5') shl 24)); - FOURCC_ATI1 = LongWord(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('1') shl 24)); - FOURCC_ATI2 = LongWord(Byte('A') or (Byte('T') shl 8) or (Byte('I') shl 16) or - (Byte('2') shl 24)); - FOURCC_DX10 = LongWord(Byte('D') or (Byte('X') shl 8) or (Byte('1') shl 16) or - (Byte('0') shl 24)); - - { Some D3DFORMAT values used in DDS files as FourCC value.} - D3DFMT_A16B16G16R16 = 36; - D3DFMT_R32F = 114; - D3DFMT_A32B32G32R32F = 116; - D3DFMT_R16F = 111; - D3DFMT_A16B16G16R16F = 113; - - { Constans used by TDDSurfaceDesc2.Flags.} - DDSD_CAPS = $00000001; - DDSD_HEIGHT = $00000002; - DDSD_WIDTH = $00000004; - DDSD_PITCH = $00000008; - DDSD_PIXELFORMAT = $00001000; - DDSD_MIPMAPCOUNT = $00020000; - DDSD_LINEARSIZE = $00080000; - DDSD_DEPTH = $00800000; - - { Constans used by TDDSPixelFormat.Flags.} - DDPF_ALPHAPIXELS = $00000001; // used by formats which contain alpha - DDPF_FOURCC = $00000004; // used by DXT and large ARGB formats - DDPF_RGB = $00000040; // used by RGB formats - DDPF_LUMINANCE = $00020000; // used by formats like D3DFMT_L16 - DDPF_BUMPLUMINANCE = $00040000; // used by mixed signed-unsigned formats - DDPF_BUMPDUDV = $00080000; // used by signed formats - - { Constans used by TDDSCaps.Caps1.} - DDSCAPS_COMPLEX = $00000008; - DDSCAPS_TEXTURE = $00001000; - DDSCAPS_MIPMAP = $00400000; - - { Constans used by TDDSCaps.Caps2.} - DDSCAPS2_CUBEMAP = $00000200; - DDSCAPS2_POSITIVEX = $00000400; - DDSCAPS2_NEGATIVEX = $00000800; - DDSCAPS2_POSITIVEY = $00001000; - DDSCAPS2_NEGATIVEY = $00002000; - DDSCAPS2_POSITIVEZ = $00004000; - DDSCAPS2_NEGATIVEZ = $00008000; - DDSCAPS2_VOLUME = $00200000; - - { Flags for TDDSurfaceDesc2.Flags used when saving DDS file.} - DDS_SAVE_FLAGS = DDSD_CAPS or DDSD_PIXELFORMAT or DDSD_WIDTH or - DDSD_HEIGHT or DDSD_LINEARSIZE; - -type - { Stores the pixel format information.} - TDDPixelFormat = packed record - Size: LongWord; // Size of the structure = 32 bytes - Flags: LongWord; // Flags to indicate valid fields - FourCC: LongWord; // Four-char code for compressed textures (DXT) - BitCount: LongWord; // Bits per pixel if uncomp. usually 16,24 or 32 - RedMask: LongWord; // Bit mask for the Red component - GreenMask: LongWord; // Bit mask for the Green component - BlueMask: LongWord; // Bit mask for the Blue component - AlphaMask: LongWord; // Bit mask for the Alpha component - end; - - { Specifies capabilities of surface.} - TDDSCaps = packed record - Caps1: LongWord; // Should always include DDSCAPS_TEXTURE - Caps2: LongWord; // For cubic environment maps - Reserved: array[0..1] of LongWord; // Reserved - end; - - { Record describing DDS file contents.} - TDDSurfaceDesc2 = packed record - Size: LongWord; // Size of the structure = 124 Bytes - Flags: LongWord; // Flags to indicate valid fields - Height: LongWord; // Height of the main image in pixels - Width: LongWord; // Width of the main image in pixels - PitchOrLinearSize: LongWord; // For uncomp formats number of bytes per - // scanline. For comp it is the size in - // bytes of the main image - Depth: LongWord; // Only for volume text depth of the volume - MipMaps: LongInt; // Total number of levels in the mipmap chain - Reserved1: array[0..10] of LongWord; // Reserved - PixelFormat: TDDPixelFormat; // Format of the pixel data - Caps: TDDSCaps; // Capabilities - Reserved2: LongWord; // Reserved - end; - - { DDS file header.} - TDDSFileHeader = packed record - Magic: LongWord; // File format magic - Desc: TDDSurfaceDesc2; // Surface description - end; - - { Resoirce types for D3D 10+ } - TD3D10ResourceDimension = ( - D3D10_RESOURCE_DIMENSION_UNKNOWN = 0, - D3D10_RESOURCE_DIMENSION_BUFFER = 1, - D3D10_RESOURCE_DIMENSION_TEXTURE1D = 2, - D3D10_RESOURCE_DIMENSION_TEXTURE2D = 3, - D3D10_RESOURCE_DIMENSION_TEXTURE3D = 4 - ); - - { Texture formats for D3D 10+ } - TDXGIFormat = ( - DXGI_FORMAT_UNKNOWN = 0, - DXGI_FORMAT_R32G32B32A32_TYPELESS = 1, - DXGI_FORMAT_R32G32B32A32_FLOAT = 2, - DXGI_FORMAT_R32G32B32A32_UINT = 3, - DXGI_FORMAT_R32G32B32A32_SINT = 4, - DXGI_FORMAT_R32G32B32_TYPELESS = 5, - DXGI_FORMAT_R32G32B32_FLOAT = 6, - DXGI_FORMAT_R32G32B32_UINT = 7, - DXGI_FORMAT_R32G32B32_SINT = 8, - DXGI_FORMAT_R16G16B16A16_TYPELESS = 9, - DXGI_FORMAT_R16G16B16A16_FLOAT = 10, - DXGI_FORMAT_R16G16B16A16_UNORM = 11, - DXGI_FORMAT_R16G16B16A16_UINT = 12, - DXGI_FORMAT_R16G16B16A16_SNORM = 13, - DXGI_FORMAT_R16G16B16A16_SINT = 14, - DXGI_FORMAT_R32G32_TYPELESS = 15, - DXGI_FORMAT_R32G32_FLOAT = 16, - DXGI_FORMAT_R32G32_UINT = 17, - DXGI_FORMAT_R32G32_SINT = 18, - DXGI_FORMAT_R32G8X24_TYPELESS = 19, - DXGI_FORMAT_D32_FLOAT_S8X24_UINT = 20, - DXGI_FORMAT_R32_FLOAT_X8X24_TYPELESS = 21, - DXGI_FORMAT_X32_TYPELESS_G8X24_UINT = 22, - DXGI_FORMAT_R10G10B10A2_TYPELESS = 23, - DXGI_FORMAT_R10G10B10A2_UNORM = 24, - DXGI_FORMAT_R10G10B10A2_UINT = 25, - DXGI_FORMAT_R11G11B10_FLOAT = 26, - DXGI_FORMAT_R8G8B8A8_TYPELESS = 27, - DXGI_FORMAT_R8G8B8A8_UNORM = 28, - DXGI_FORMAT_R8G8B8A8_UNORM_SRGB = 29, - DXGI_FORMAT_R8G8B8A8_UINT = 30, - DXGI_FORMAT_R8G8B8A8_SNORM = 31, - DXGI_FORMAT_R8G8B8A8_SINT = 32, - DXGI_FORMAT_R16G16_TYPELESS = 33, - DXGI_FORMAT_R16G16_FLOAT = 34, - DXGI_FORMAT_R16G16_UNORM = 35, - DXGI_FORMAT_R16G16_UINT = 36, - DXGI_FORMAT_R16G16_SNORM = 37, - DXGI_FORMAT_R16G16_SINT = 38, - DXGI_FORMAT_R32_TYPELESS = 39, - DXGI_FORMAT_D32_FLOAT = 40, - DXGI_FORMAT_R32_FLOAT = 41, - DXGI_FORMAT_R32_UINT = 42, - DXGI_FORMAT_R32_SINT = 43, - DXGI_FORMAT_R24G8_TYPELESS = 44, - DXGI_FORMAT_D24_UNORM_S8_UINT = 45, - DXGI_FORMAT_R24_UNORM_X8_TYPELESS = 46, - DXGI_FORMAT_X24_TYPELESS_G8_UINT = 47, - DXGI_FORMAT_R8G8_TYPELESS = 48, - DXGI_FORMAT_R8G8_UNORM = 49, - DXGI_FORMAT_R8G8_UINT = 50, - DXGI_FORMAT_R8G8_SNORM = 51, - DXGI_FORMAT_R8G8_SINT = 52, - DXGI_FORMAT_R16_TYPELESS = 53, - DXGI_FORMAT_R16_FLOAT = 54, - DXGI_FORMAT_D16_UNORM = 55, - DXGI_FORMAT_R16_UNORM = 56, - DXGI_FORMAT_R16_UINT = 57, - DXGI_FORMAT_R16_SNORM = 58, - DXGI_FORMAT_R16_SINT = 59, - DXGI_FORMAT_R8_TYPELESS = 60, - DXGI_FORMAT_R8_UNORM = 61, - DXGI_FORMAT_R8_UINT = 62, - DXGI_FORMAT_R8_SNORM = 63, - DXGI_FORMAT_R8_SINT = 64, - DXGI_FORMAT_A8_UNORM = 65, - DXGI_FORMAT_R1_UNORM = 66, - DXGI_FORMAT_R9G9B9E5_SHAREDEXP = 67, - DXGI_FORMAT_R8G8_B8G8_UNORM = 68, - DXGI_FORMAT_G8R8_G8B8_UNORM = 69, - DXGI_FORMAT_BC1_TYPELESS = 70, - DXGI_FORMAT_BC1_UNORM = 71, - DXGI_FORMAT_BC1_UNORM_SRGB = 72, - DXGI_FORMAT_BC2_TYPELESS = 73, - DXGI_FORMAT_BC2_UNORM = 74, - DXGI_FORMAT_BC2_UNORM_SRGB = 75, - DXGI_FORMAT_BC3_TYPELESS = 76, - DXGI_FORMAT_BC3_UNORM = 77, - DXGI_FORMAT_BC3_UNORM_SRGB = 78, - DXGI_FORMAT_BC4_TYPELESS = 79, - DXGI_FORMAT_BC4_UNORM = 80, - DXGI_FORMAT_BC4_SNORM = 81, - DXGI_FORMAT_BC5_TYPELESS = 82, - DXGI_FORMAT_BC5_UNORM = 83, - DXGI_FORMAT_BC5_SNORM = 84, - DXGI_FORMAT_B5G6R5_UNORM = 85, - DXGI_FORMAT_B5G5R5A1_UNORM = 86, - DXGI_FORMAT_B8G8R8A8_UNORM = 87, - DXGI_FORMAT_B8G8R8X8_UNORM = 88, - DXGI_FORMAT_R10G10B10_XR_BIAS_A2_UNORM = 89, - DXGI_FORMAT_B8G8R8A8_TYPELESS = 90, - DXGI_FORMAT_B8G8R8A8_UNORM_SRGB = 91, - DXGI_FORMAT_B8G8R8X8_TYPELESS = 92, - DXGI_FORMAT_B8G8R8X8_UNORM_SRGB = 93, - DXGI_FORMAT_BC6H_TYPELESS = 94, - DXGI_FORMAT_BC6H_UF16 = 95, - DXGI_FORMAT_BC6H_SF16 = 96, - DXGI_FORMAT_BC7_TYPELESS = 97, - DXGI_FORMAT_BC7_UNORM = 98, - DXGI_FORMAT_BC7_UNORM_SRGB = 99, - DXGI_FORMAT_AYUV = 100, - DXGI_FORMAT_Y410 = 101, - DXGI_FORMAT_Y416 = 102, - DXGI_FORMAT_NV12 = 103, - DXGI_FORMAT_P010 = 104, - DXGI_FORMAT_P016 = 105, - DXGI_FORMAT_420_OPAQUE = 106, - DXGI_FORMAT_YUY2 = 107, - DXGI_FORMAT_Y210 = 108, - DXGI_FORMAT_Y216 = 109, - DXGI_FORMAT_NV11 = 110, - DXGI_FORMAT_AI44 = 111, - DXGI_FORMAT_IA44 = 112, - DXGI_FORMAT_P8 = 113, - DXGI_FORMAT_A8P8 = 114, - DXGI_FORMAT_B4G4R4A4_UNORM = 115 - ); - - { DX10 extension header for DDS file format } - TDX10Header = packed record - DXGIFormat: TDXGIFormat; - ResourceDimension: TD3D10ResourceDimension; - MiscFlags: LongWord; - ArraySize: LongWord; - Reserved: LongWord; - end; - -{ TDDSFileFormat class implementation } - -procedure TDDSFileFormat.Define; -begin - inherited; - FName := SDDSFormatName; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FSupportedFormats := DDSSupportedFormats; - - FSaveCubeMap := False; - FSaveVolume := False; - FSaveMipMapCount := 1; - FSaveDepth := 1; - - AddMasks(SDDSMasks); - - RegisterOption(ImagingDDSLoadedCubeMap, @FLoadedCubeMap); - RegisterOption(ImagingDDSLoadedVolume, @FLoadedVolume); - RegisterOption(ImagingDDSLoadedMipMapCount, @FLoadedMipMapCount); - RegisterOption(ImagingDDSLoadedDepth, @FLoadedDepth); - RegisterOption(ImagingDDSSaveCubeMap, @FSaveCubeMap); - RegisterOption(ImagingDDSSaveVolume, @FSaveVolume); - RegisterOption(ImagingDDSSaveMipMapCount, @FSaveMipMapCount); - RegisterOption(ImagingDDSSaveDepth, @FSaveDepth); -end; - -procedure TDDSFileFormat.CheckOptionsValidity; -begin - if FSaveCubeMap then - FSaveVolume := False; - if FSaveVolume then - FSaveCubeMap := False; - if FSaveDepth < 1 then - FSaveDepth := 1; - if FSaveMipMapCount < 1 then - FSaveMipMapCount := 1; -end; - -procedure TDDSFileFormat.ComputeSubDimensions(Idx, Width, Height, MipMaps, Depth: LongInt; - IsCubeMap, IsVolume: Boolean; var CurWidth, CurHeight: LongInt); -var - I, Last, Shift: LongInt; -begin - CurWidth := Width; - CurHeight := Height; - if MipMaps > 1 then - begin - if not IsVolume then - begin - if IsCubeMap then - begin - // Cube maps are stored like this - // Face 0 mimap 0 - // Face 0 mipmap 1 - // ... - // Face 1 mipmap 0 - // Face 1 mipmap 1 - // ... - - // Modify index so later in for loop we iterate less times - Idx := Idx - ((Idx div MipMaps) * MipMaps); - end; - for I := 0 to Idx - 1 do - begin - CurWidth := ClampInt(CurWidth shr 1, 1, CurWidth); - CurHeight := ClampInt(CurHeight shr 1, 1, CurHeight); - end; - end - else - begin - // Volume textures are stored in DDS files like this: - // Slice 0 mipmap 0 - // Slice 1 mipmap 0 - // Slice 2 mipmap 0 - // Slice 3 mipmap 0 - // Slice 0 mipmap 1 - // Slice 1 mipmap 1 - // Slice 0 mipmap 2 - // Slice 0 mipmap 3 ... - Shift := 0; - Last := Depth; - while Idx > Last - 1 do - begin - CurWidth := ClampInt(CurWidth shr 1, 1, CurWidth); - CurHeight := ClampInt(CurHeight shr 1, 1, CurHeight); - if (CurWidth = 1) and (CurHeight = 1) then - Break; - Inc(Shift); - Inc(Last, ClampInt(Depth shr Shift, 1, Depth)); - end; - end; - end; -end; - -function TDDSFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TDDSFileHeader; - HdrDX10: TDX10Header; - SrcFormat: TImageFormat; - FmtInfo: TImageFormatInfo; - NeedsSwapChannels: Boolean; - CurrentWidth, CurrentHeight, ImageCount, LoadSize, I, - PitchOrLinear, MainImageLinearSize: Integer; - Data: PByte; - UseAsPitch: Boolean; - UseAsLinear: Boolean; - - function MasksEqual(const DDPF: TDDPixelFormat; PF: PPixelFormatInfo): Boolean; - begin - Result := (DDPF.AlphaMask = PF.ABitMask) and - (DDPF.RedMask = PF.RBitMask) and (DDPF.GreenMask = PF.GBitMask) and - (DDPF.BlueMask = PF.BBitMask); - end; - - function FindFourCCFormat(FourCC: LongWord): TImageFormat; - begin - // Handle FourCC and large ARGB formats - case FourCC of - D3DFMT_A16B16G16R16: Result := ifA16B16G16R16; - D3DFMT_R32F: Result := ifR32F; - D3DFMT_A32B32G32R32F: Result := ifA32B32G32R32F; - D3DFMT_R16F: Result := ifR16F; - D3DFMT_A16B16G16R16F: Result := ifA16B16G16R16F; - FOURCC_DXT1: Result := ifDXT1; - FOURCC_DXT3: Result := ifDXT3; - FOURCC_DXT5: Result := ifDXT5; - FOURCC_ATI1: Result := ifATI1N; - FOURCC_ATI2: Result := ifATI2N; - else - Result := ifUnknown; - end; - end; - - function FindDX10Format(DXGIFormat: TDXGIFormat; var NeedsSwapChannels: Boolean): TImageFormat; - begin - Result := ifUnknown; - NeedsSwapChannels := False; - - case DXGIFormat of - DXGI_FORMAT_UNKNOWN: ; - DXGI_FORMAT_R32G32B32A32_TYPELESS, DXGI_FORMAT_R32G32B32A32_FLOAT: - Result := ifA32B32G32R32F; - DXGI_FORMAT_R32G32B32A32_UINT: ; - DXGI_FORMAT_R32G32B32A32_SINT: ; - DXGI_FORMAT_R32G32B32_TYPELESS, DXGI_FORMAT_R32G32B32_FLOAT: - Result := ifB32G32R32F; - DXGI_FORMAT_R32G32B32_UINT: ; - DXGI_FORMAT_R32G32B32_SINT: ; - DXGI_FORMAT_R16G16B16A16_FLOAT: - Result := ifA16B16G16R16F; - DXGI_FORMAT_R16G16B16A16_TYPELESS, DXGI_FORMAT_R16G16B16A16_UNORM, - DXGI_FORMAT_R16G16B16A16_UINT, DXGI_FORMAT_R16G16B16A16_SNORM, - DXGI_FORMAT_R16G16B16A16_SINT: - Result := ifA16B16G16R16; - DXGI_FORMAT_R32G32_TYPELESS: ; - DXGI_FORMAT_R32G32_FLOAT: ; - DXGI_FORMAT_R32G32_UINT: ; - DXGI_FORMAT_R32G32_SINT: ; - DXGI_FORMAT_R32G8X24_TYPELESS: ; - DXGI_FORMAT_D32_FLOAT_S8X24_UINT: ; - DXGI_FORMAT_R32_FLOAT_X8X24_TYPELESS: ; - DXGI_FORMAT_X32_TYPELESS_G8X24_UINT: ; - DXGI_FORMAT_R10G10B10A2_TYPELESS: ; - DXGI_FORMAT_R10G10B10A2_UNORM: ; - DXGI_FORMAT_R10G10B10A2_UINT: ; - DXGI_FORMAT_R11G11B10_FLOAT: ; - DXGI_FORMAT_R8G8B8A8_TYPELESS, DXGI_FORMAT_R8G8B8A8_UNORM, - DXGI_FORMAT_R8G8B8A8_UINT, DXGI_FORMAT_R8G8B8A8_SNORM,DXGI_FORMAT_R8G8B8A8_SINT, - DXGI_FORMAT_R8G8B8A8_UNORM_SRGB: - begin - Result := ifA8R8G8B8; - NeedsSwapChannels := True; - end; - DXGI_FORMAT_R16G16_TYPELESS: ; - DXGI_FORMAT_R16G16_FLOAT: ; - DXGI_FORMAT_R16G16_UNORM: ; - DXGI_FORMAT_R16G16_UINT: ; - DXGI_FORMAT_R16G16_SNORM: ; - DXGI_FORMAT_R16G16_SINT: ; - DXGI_FORMAT_R32_TYPELESS, DXGI_FORMAT_R32_UINT, DXGI_FORMAT_R32_SINT: - Result := ifGray32; - DXGI_FORMAT_D32_FLOAT, DXGI_FORMAT_R32_FLOAT: - Result := ifR32F; - DXGI_FORMAT_R24G8_TYPELESS: ; - DXGI_FORMAT_D24_UNORM_S8_UINT: ; - DXGI_FORMAT_R24_UNORM_X8_TYPELESS: ; - DXGI_FORMAT_X24_TYPELESS_G8_UINT: ; - DXGI_FORMAT_R8G8_TYPELESS, DXGI_FORMAT_R8G8_UNORM, DXGI_FORMAT_R8G8_UINT, - DXGI_FORMAT_R8G8_SNORM, DXGI_FORMAT_R8G8_SINT: - Result := ifA8Gray8; - DXGI_FORMAT_R16_TYPELESS, DXGI_FORMAT_D16_UNORM, DXGI_FORMAT_R16_UNORM, - DXGI_FORMAT_R16_UINT, DXGI_FORMAT_R16_SNORM, DXGI_FORMAT_R16_SINT: - Result := ifGray16; - DXGI_FORMAT_R16_FLOAT: - Result := ifR16F; - DXGI_FORMAT_R8_TYPELESS, DXGI_FORMAT_R8_UNORM, DXGI_FORMAT_R8_UINT, - DXGI_FORMAT_R8_SNORM, DXGI_FORMAT_R8_SINT, DXGI_FORMAT_A8_UNORM: - Result := ifGray8; - DXGI_FORMAT_R1_UNORM: ; - DXGI_FORMAT_R9G9B9E5_SHAREDEXP: ; - DXGI_FORMAT_R8G8_B8G8_UNORM: ; - DXGI_FORMAT_G8R8_G8B8_UNORM: ; - DXGI_FORMAT_BC1_TYPELESS, DXGI_FORMAT_BC1_UNORM, DXGI_FORMAT_BC1_UNORM_SRGB: - Result := ifDXT1; - DXGI_FORMAT_BC2_TYPELESS, DXGI_FORMAT_BC2_UNORM, DXGI_FORMAT_BC2_UNORM_SRGB: - Result := ifDXT3; - DXGI_FORMAT_BC3_TYPELESS, DXGI_FORMAT_BC3_UNORM, DXGI_FORMAT_BC3_UNORM_SRGB: - Result := ifDXT5; - DXGI_FORMAT_BC4_TYPELESS, DXGI_FORMAT_BC4_UNORM, DXGI_FORMAT_BC4_SNORM: - Result := ifATI1N; - DXGI_FORMAT_BC5_TYPELESS, DXGI_FORMAT_BC5_UNORM, DXGI_FORMAT_BC5_SNORM: - Result := ifATI2N; - DXGI_FORMAT_B5G6R5_UNORM: - Result := ifR5G6B5; - DXGI_FORMAT_B5G5R5A1_UNORM: - Result := ifA1R5G5B5; - DXGI_FORMAT_B8G8R8A8_UNORM, DXGI_FORMAT_B8G8R8A8_TYPELESS: - Result := ifA8R8G8B8; - DXGI_FORMAT_B8G8R8X8_UNORM, DXGI_FORMAT_B8G8R8X8_TYPELESS: - Result := ifX8R8G8B8; - DXGI_FORMAT_R10G10B10_XR_BIAS_A2_UNORM: ; - DXGI_FORMAT_B8G8R8A8_UNORM_SRGB: ; - DXGI_FORMAT_B8G8R8X8_UNORM_SRGB: ; - DXGI_FORMAT_BC6H_TYPELESS: ; - DXGI_FORMAT_BC6H_UF16: ; - DXGI_FORMAT_BC6H_SF16: ; - DXGI_FORMAT_BC7_TYPELESS: ; - DXGI_FORMAT_BC7_UNORM: ; - DXGI_FORMAT_BC7_UNORM_SRGB: ; - DXGI_FORMAT_P8: ; - DXGI_FORMAT_A8P8: ; - DXGI_FORMAT_B4G4R4A4_UNORM: - Result := ifA4R4G4B4; - end; - end; - -begin - Result := False; - ImageCount := 1; - FLoadedMipMapCount := 1; - FLoadedDepth := 1; - FLoadedVolume := False; - FLoadedCubeMap := False; - ZeroMemory(@HdrDX10, SizeOf(HdrDX10)); - - with GetIO, Hdr, Hdr.Desc.PixelFormat do - begin - Read(Handle, @Hdr, SizeOf(Hdr)); - - SrcFormat := ifUnknown; - NeedsSwapChannels := False; - - // Get image data format - if (Flags and DDPF_FOURCC) = DDPF_FOURCC then - begin - if FourCC = FOURCC_DX10 then - begin - Read(Handle, @HdrDX10, SizeOf(HdrDX10)); - SrcFormat := FindDX10Format(HdrDX10.DXGIFormat, NeedsSwapChannels); - FMetadata.SetMetaItem(SMetaDdsDxgiFormat, HdrDX10.DXGIFormat); - FMetadata.SetMetaItem(SMetaDdsArraySize, HdrDX10.ArraySize); - end - else - SrcFormat := FindFourCCFormat(FourCC); - end - else if (Flags and DDPF_RGB) = DDPF_RGB then - begin - // Handle RGB formats - if (Flags and DDPF_ALPHAPIXELS) = DDPF_ALPHAPIXELS then - begin - // Handle RGB with alpha formats - case BitCount of - 16: - begin - if MasksEqual(Desc.PixelFormat, GetFormatInfo(ifA4R4G4B4).PixelFormat) then - SrcFormat := ifA4R4G4B4; - if MasksEqual(Desc.PixelFormat, GetFormatInfo(ifA1R5G5B5).PixelFormat) then - SrcFormat := ifA1R5G5B5; - end; - 32: - begin - SrcFormat := ifA8R8G8B8; - if BlueMask = $00FF0000 then - NeedsSwapChannels := True; - end; - end; - end - else - begin - // Handle RGB without alpha formats - case BitCount of - 8: - if MasksEqual(Desc.PixelFormat, - GetFormatInfo(ifR3G3B2).PixelFormat) then - SrcFormat := ifR3G3B2; - 16: - begin - if MasksEqual(Desc.PixelFormat, - GetFormatInfo(ifX4R4G4B4).PixelFormat) then - SrcFormat := ifX4R4G4B4; - if MasksEqual(Desc.PixelFormat, - GetFormatInfo(ifX1R5G5B5).PixelFormat) then - SrcFormat := ifX1R5G5B5; - if MasksEqual(Desc.PixelFormat, - GetFormatInfo(ifR5G6B5).PixelFormat) then - SrcFormat := ifR5G6B5; - end; - 24: SrcFormat := ifR8G8B8; - 32: - begin - SrcFormat := ifX8R8G8B8; - if BlueMask = $00FF0000 then - NeedsSwapChannels := True; - end; - end; - end; - end - else if (Flags and DDPF_LUMINANCE) = DDPF_LUMINANCE then - begin - // Handle luminance formats - if (Flags and DDPF_ALPHAPIXELS) = DDPF_ALPHAPIXELS then - begin - // Handle luminance with alpha formats - if BitCount = 16 then - SrcFormat := ifA8Gray8; - end - else - begin - // Handle luminance without alpha formats - case BitCount of - 8: SrcFormat := ifGray8; - 16: SrcFormat := ifGray16; - end; - end; - end - else if (Flags and DDPF_BUMPLUMINANCE) = DDPF_BUMPLUMINANCE then - begin - // Handle mixed bump-luminance formats like D3DFMT_X8L8V8U8 - case BitCount of - 32: - if BlueMask = $00FF0000 then - begin - SrcFormat := ifX8R8G8B8; // D3DFMT_X8L8V8U8 - NeedsSwapChannels := True; - end; - end; - end - else if (Flags and DDPF_BUMPDUDV) = DDPF_BUMPDUDV then - begin - // Handle bumpmap formats like D3DFMT_Q8W8V8U8 - case BitCount of - 16: SrcFormat := ifA8Gray8; // D3DFMT_V8U8 - 32: - if AlphaMask = $FF000000 then - begin - SrcFormat := ifA8R8G8B8; // D3DFMT_Q8W8V8U8 - NeedsSwapChannels := True; - end; - 64: SrcFormat := ifA16B16G16R16; // D3DFMT_Q16W16V16U16 - end; - end; - - // If DDS format is not supported we will exit - if SrcFormat = ifUnknown then - Exit; - - // File contains mipmaps for each subimage. - { Some DDS writers ignore setting proper Caps and Flags so - this check is not usable: - if ((Desc.Caps.Caps1 and DDSCAPS_MIPMAP) = DDSCAPS_MIPMAP) and - ((Desc.Flags and DDSD_MIPMAPCOUNT) = DDSD_MIPMAPCOUNT) then} - if Desc.MipMaps > 1 then - begin - FLoadedMipMapCount := Desc.MipMaps; - FMetadata.SetMetaItem(SMetaDdsMipMapCount, Desc.MipMaps); - ImageCount := Desc.MipMaps; - end; - - // File stores volume texture - if ((Desc.Caps.Caps2 and DDSCAPS2_VOLUME) = DDSCAPS2_VOLUME) and - ((Desc.Flags and DDSD_DEPTH) = DDSD_DEPTH) then - begin - FLoadedVolume := True; - FLoadedDepth := Desc.Depth; - ImageCount := GetVolumeLevelCount(Desc.Depth, ImageCount); - end; - - // File stores cube texture - if (Desc.Caps.Caps2 and DDSCAPS2_CUBEMAP) = DDSCAPS2_CUBEMAP then - begin - FLoadedCubeMap := True; - I := 0; - if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEX) = DDSCAPS2_POSITIVEX then Inc(I); - if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEY) = DDSCAPS2_POSITIVEY then Inc(I); - if (Desc.Caps.Caps2 and DDSCAPS2_POSITIVEZ) = DDSCAPS2_POSITIVEZ then Inc(I); - if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEX) = DDSCAPS2_NEGATIVEX then Inc(I); - if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEY) = DDSCAPS2_NEGATIVEY then Inc(I); - if (Desc.Caps.Caps2 and DDSCAPS2_NEGATIVEZ) = DDSCAPS2_NEGATIVEZ then Inc(I); - FLoadedDepth := I; - ImageCount := ImageCount * I; - end; - - // Allocate and load all images in file - FmtInfo := GetFormatInfo(SrcFormat); - SetLength(Images, ImageCount); - - // Compute the pitch or get if from file if present - UseAsPitch := (Desc.Flags and DDSD_PITCH) = DDSD_PITCH; - UseAsLinear := (Desc.Flags and DDSD_LINEARSIZE) = DDSD_LINEARSIZE; - // Use linear as default if none is set - if not UseAsPitch and not UseAsLinear then - UseAsLinear := True; - // Main image pitch or linear size - PitchOrLinear := Desc.PitchOrLinearSize; - - // Check: some writers just write garbage to pitch/linear size fields and flags - MainImageLinearSize := FmtInfo.GetPixelsSize(SrcFormat, Desc.Width, Desc.Height); - if UseAsLinear and ((PitchOrLinear < MainImageLinearSize) or - (PitchOrLinear * Integer(Desc.Height) = MainImageLinearSize)) then - begin - // Explicitly set linear size - PitchOrLinear := MainImageLinearSize; - end; - - for I := 0 to ImageCount - 1 do - begin - // Compute dimensions of surrent subimage based on texture type and - // number of mipmaps - ComputeSubDimensions(I, Desc.Width, Desc.Height, Desc.MipMaps, Desc.Depth, - FLoadedCubeMap, FLoadedVolume, CurrentWidth, CurrentHeight); - NewImage(CurrentWidth, CurrentHeight, SrcFormat, Images[I]); - - if (I > 0) or (PitchOrLinear = 0) then - begin - // Compute pitch or linear size for mipmap levels, or even for main image - // since some formats do not fill pitch nor size - if UseAsLinear then - PitchOrLinear := FmtInfo.GetPixelsSize(SrcFormat, CurrentWidth, CurrentHeight) - else - PitchOrLinear := (CurrentWidth * FmtInfo.BytesPerPixel + 3) div 4 * 4; // must be DWORD aligned - end; - - if UseAsLinear then - LoadSize := PitchOrLinear - else - LoadSize := CurrentHeight * PitchOrLinear; - - if UseAsLinear or (LoadSize = Images[I].Size) then - begin - // If DDS does not use Pitch we can simply copy data - Read(Handle, Images[I].Bits, LoadSize) - end - else - begin - // If DDS uses Pitch we must load aligned scanlines - // and then remove padding - GetMem(Data, LoadSize); - try - Read(Handle, Data, LoadSize); - RemovePadBytes(Data, Images[I].Bits, CurrentWidth, CurrentHeight, - FmtInfo.BytesPerPixel, PitchOrLinear); - finally - FreeMem(Data); - end; - end; - - if NeedsSwapChannels then - SwapChannels(Images[I], ChannelRed, ChannelBlue); - end; - Result := True; - end; -end; - -function TDDSFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - Hdr: TDDSFileHeader; - MainImage, ImageToSave: TImageData; - I, MainIdx, Len, ImageCount: LongInt; - J: LongWord; - FmtInfo: TImageFormatInfo; - MustBeFreed: Boolean; - Is2DTexture, IsCubeMap, IsVolume: Boolean; - MipMapCount, CurrentWidth, CurrentHeight: LongInt; - NeedsResize: Boolean; - NeedsConvert: Boolean; -begin - Result := False; - FillChar(Hdr, Sizeof(Hdr), 0); - - MainIdx := FFirstIdx; - Len := FLastIdx - MainIdx + 1; - // Some DDS saving rules: - // 2D textures: Len is used as mipmap count (FSaveMipMapCount not used!). - // Cube maps: FSaveDepth * FSaveMipMapCount images are used, if Len is - // smaller than this file is saved as regular 2D texture. - // Volume maps: GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount) images are - // used, if Len is smaller than this file is - // saved as regular 2D texture. - - IsCubeMap := FSaveCubeMap; - IsVolume := FSaveVolume; - MipMapCount := FSaveMipMapCount; - - if IsCubeMap then - begin - // Check if we have enough images on Input to save cube map - if Len < FSaveDepth * FSaveMipMapCount then - IsCubeMap := False; - end - else if IsVolume then - begin - // Check if we have enough images on Input to save volume texture - if Len < GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount) then - IsVolume := False; - end; - - Is2DTexture := not IsCubeMap and not IsVolume; - if Is2DTexture then - begin - // Get number of mipmaps used with 2D texture - MipMapCount := Min(Len, GetNumMipMapLevels(Images[MainIdx].Width, Images[MainIdx].Height)); - end; - - // we create compatible main image and fill headers - if MakeCompatible(Images[MainIdx], MainImage, MustBeFreed) then - with GetIO, MainImage, Hdr do - try - FmtInfo := GetFormatInfo(Format); - Magic := DDSMagic; - Desc.Size := SizeOf(Desc); - Desc.Width := Width; - Desc.Height := Height; - Desc.Flags := DDS_SAVE_FLAGS; - Desc.Caps.Caps1 := DDSCAPS_TEXTURE; - Desc.PixelFormat.Size := SizeOf(Desc.PixelFormat); - Desc.PitchOrLinearSize := MainImage.Size; - ImageCount := MipMapCount; - - if MipMapCount > 1 then - begin - // Set proper flags if we have some mipmaps to be saved - Desc.Flags := Desc.Flags or DDSD_MIPMAPCOUNT; - Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_MIPMAP or DDSCAPS_COMPLEX; - Desc.MipMaps := MipMapCount; - end; - - if IsCubeMap then - begin - // Set proper cube map flags - number of stored faces is taken - // from FSaveDepth - Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_COMPLEX; - Desc.Caps.Caps2 := Desc.Caps.Caps2 or DDSCAPS2_CUBEMAP; - J := DDSCAPS2_POSITIVEX; - for I := 0 to FSaveDepth - 1 do - begin - Desc.Caps.Caps2 := Desc.Caps.Caps2 or J; - J := J shl 1; - end; - ImageCount := FSaveDepth * FSaveMipMapCount; - end - else if IsVolume then - begin - // Set proper flags for volume texture - Desc.Flags := Desc.Flags or DDSD_DEPTH; - Desc.Caps.Caps1 := Desc.Caps.Caps1 or DDSCAPS_COMPLEX; - Desc.Caps.Caps2 := Desc.Caps.Caps2 or DDSCAPS2_VOLUME; - Desc.Depth := FSaveDepth; - ImageCount := GetVolumeLevelCount(FSaveDepth, FSaveMipMapCount); - end; - - // Now we set DDS pixel format for main image - if FmtInfo.IsSpecial or FmtInfo.IsFloatingPoint or - (FmtInfo.BytesPerPixel > 4) then - begin - Desc.PixelFormat.Flags := DDPF_FOURCC; - case Format of - ifA16B16G16R16: Desc.PixelFormat.FourCC := D3DFMT_A16B16G16R16; - ifR32F: Desc.PixelFormat.FourCC := D3DFMT_R32F; - ifA32B32G32R32F: Desc.PixelFormat.FourCC := D3DFMT_A32B32G32R32F; - ifR16F: Desc.PixelFormat.FourCC := D3DFMT_R16F; - ifA16B16G16R16F: Desc.PixelFormat.FourCC := D3DFMT_A16B16G16R16F; - ifDXT1: Desc.PixelFormat.FourCC := FOURCC_DXT1; - ifDXT3: Desc.PixelFormat.FourCC := FOURCC_DXT3; - ifDXT5: Desc.PixelFormat.FourCC := FOURCC_DXT5; - ifATI1N: Desc.PixelFormat.FourCC := FOURCC_ATI1; - ifATI2N: Desc.PixelFormat.FourCC := FOURCC_ATI2; - end; - end - else if FmtInfo.HasGrayChannel then - begin - Desc.PixelFormat.Flags := DDPF_LUMINANCE; - Desc.PixelFormat.BitCount := FmtInfo.BytesPerPixel * 8; - case Format of - ifGray8: Desc.PixelFormat.RedMask := 255; - ifGray16: Desc.PixelFormat.RedMask := 65535; - ifA8Gray8: - begin - Desc.PixelFormat.Flags := Desc.PixelFormat.Flags or DDPF_ALPHAPIXELS; - Desc.PixelFormat.RedMask := 255; - Desc.PixelFormat.AlphaMask := 65280; - end; - end; - end - else - begin - Desc.PixelFormat.Flags := DDPF_RGB; - Desc.PixelFormat.BitCount := FmtInfo.BytesPerPixel * 8; - if FmtInfo.HasAlphaChannel then - begin - Desc.PixelFormat.Flags := Desc.PixelFormat.Flags or DDPF_ALPHAPIXELS; - Desc.PixelFormat.AlphaMask := $FF000000; - end; - if FmtInfo.BytesPerPixel > 2 then - begin - Desc.PixelFormat.RedMask := $00FF0000; - Desc.PixelFormat.GreenMask := $0000FF00; - Desc.PixelFormat.BlueMask := $000000FF; - end - else - begin - Desc.PixelFormat.AlphaMask := FmtInfo.PixelFormat.ABitMask; - Desc.PixelFormat.RedMask := FmtInfo.PixelFormat.RBitMask; - Desc.PixelFormat.GreenMask := FmtInfo.PixelFormat.GBitMask; - Desc.PixelFormat.BlueMask := FmtInfo.PixelFormat.BBitMask; - end; - end; - - // Header and main image are written to output - Write(Handle, @Hdr, SizeOf(Hdr)); - Write(Handle, MainImage.Bits, MainImage.Size); - - // Write the rest of the images and convert them to - // the same format as main image if necessary and ensure proper mipmap - // simensions too. - for I := MainIdx + 1 to MainIdx + ImageCount - 1 do - begin - // Get proper dimensions for this level - ComputeSubDimensions(I, Desc.Width, Desc.Height, Desc.MipMaps, Desc.Depth, - IsCubeMap, IsVolume, CurrentWidth, CurrentHeight); - - // Check if input image for this level has the right size and format - NeedsResize := not ((Images[I].Width = CurrentWidth) and (Images[I].Height = CurrentHeight)); - NeedsConvert := not (Images[I].Format = Format); - - if NeedsResize or NeedsConvert then - begin - // Input image must be resized or converted to different format - // to become valid mipmap level - InitImage(ImageToSave); - CloneImage(Images[I], ImageToSave); - if NeedsConvert then - ConvertImage(ImageToSave, Format); - if NeedsResize then - ResizeImage(ImageToSave, CurrentWidth, CurrentHeight, rfBilinear); - end - else - // Input image can be used without any changes - ImageToSave := Images[I]; - - // Write level data and release temp image if necessary - Write(Handle, ImageToSave.Bits, ImageToSave.Size); - if Images[I].Bits <> ImageToSave.Bits then - FreeImage(ImageToSave); - end; - - Result := True; - finally - if MustBeFreed then - FreeImage(MainImage); - end; -end; - -procedure TDDSFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsIndexed or Info.IsSpecial then - // convert indexed and unsupported special formatd to A8R8G8B8 - ConvFormat := ifA8R8G8B8 - else if Info.IsFloatingPoint then - begin - if Info.Format = ifA16R16G16B16F then - // only swap channels here - ConvFormat := ifA16B16G16R16F - else - // convert other floating point formats to A32B32G32R32F - ConvFormat := ifA32B32G32R32F - end - else if Info.HasGrayChannel then - begin - if Info.HasAlphaChannel then - // convert grayscale with alpha to A8Gray8 - ConvFormat := ifA8Gray8 - else if Info.BytesPerPixel = 1 then - // convert 8bit grayscale to Gray8 - ConvFormat := ifGray8 - else - // convert 16-64bit grayscales to Gray16 - ConvFormat := ifGray16; - end - else if Info.BytesPerPixel > 4 then - ConvFormat := ifA16B16G16R16 - else if Info.HasAlphaChannel then - // convert the other images with alpha channel to A8R8G8B8 - ConvFormat := ifA8R8G8B8 - else - // convert the other formats to X8R8G8B8 - ConvFormat := ifX8R8G8B8; - - ConvertImage(Image, ConvFormat); -end; - -function TDDSFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TDDSFileHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - ReadCount := Read(Handle, @Hdr, SizeOf(Hdr)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (Hdr.Magic = DDSMagic) and (ReadCount = SizeOf(Hdr)) and - ((Hdr.Desc.Caps.Caps1 and DDSCAPS_TEXTURE) = DDSCAPS_TEXTURE); - end; -end; - -initialization - RegisterImageFileFormat(TDDSFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 ---------------------------------------------------- - - Texture and D3D specific info stored in DDS is now available as metadata - (loading). - - Added support for loading DDS files with DX10 extension - (http://msdn.microsoft.com/en-us/library/windows/desktop/bb943991(v=vs.85).aspx) - and few compatibility fixes. - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Added support for 3Dc ATI1/2 formats. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Saved DDS with mipmaps now correctly defineds COMPLEX flag. - - Fixed loading of RGB DDS files that use pitch and have mipmaps - - mipmaps were loaded wrongly. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Changed saving behaviour a bit: mipmaps are inlcuded automatically for - 2D textures if input image array has more than 1 image (no need to - set SaveMipMapCount manually). - - Mipmap levels are now saved with proper dimensions when saving DDS files. - - Made some changes to not be so strict when loading DDS files. - Many programs seem to save them in non-standard format - (by MS DDS File Reference). - - Added missing ifX8R8G8B8 to SupportedFormats, MakeCompatible failed - when image was converted to this format (inside). - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Fixed bug that sometimes saved non-standard DDS files and another - one that caused crash when these files were loaded. - - Changed extensions to filename masks. - - Changed SaveData, LoadData, and MakeCompatible methods according - to changes in base class in Imaging unit. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added support for half-float image formats - - change in LoadData to allow support for more images - in one stream loading - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - fixed bug in TestFormat which does not recognize many DDS files - - changed pitch/linearsize handling in DDS loading code to - load DDS files produced by NVidia's Photoshop plugin -} - -end. - diff --git a/3rd/Imaging/Source/ImagingFormats.pas b/3rd/Imaging/Source/ImagingFormats.pas deleted file mode 100644 index f2b882def..000000000 --- a/3rd/Imaging/Source/ImagingFormats.pas +++ /dev/null @@ -1,4411 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit manages information about all image data formats and contains - low level format conversion, manipulation, and other related functions.} -unit ImagingFormats; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingUtility; - -type - TImageFormatInfoArray = array[TImageFormat] of PImageFormatInfo; - PImageFormatInfoArray = ^TImageFormatInfoArray; - - -{ Additional image manipulation functions (usually used internally by Imaging unit) } - -type - { Color reduction operations.} - TReduceColorsAction = (raCreateHistogram, raUpdateHistogram, raMakeColorMap, - raMapImage); - TReduceColorsActions = set of TReduceColorsAction; -const - AllReduceColorsActions = [raCreateHistogram, raUpdateHistogram, - raMakeColorMap, raMapImage]; -{ Reduces the number of colors of source. Src is bits of source image - (ARGB or floating point) and Dst is in some indexed format. MaxColors - is the number of colors to which reduce and DstPal is palette to which - the resulting colors are written and it must be allocated to at least - MaxColors entries. ChannelMask is 'anded' with every pixel's channel value - when creating color histogram. If $FF is used all 8bits of color channels - are used which can be slow for large images with many colors so you can - use lower masks to speed it up.} -procedure ReduceColorsMedianCut(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; MaxColors: LongInt; ChannelMask: Byte; - DstPal: PPalette32; Actions: TReduceColorsActions = AllReduceColorsActions); -{ Stretches rectangle in source image to rectangle in destination image - using nearest neighbor filtering. It is fast but results look blocky - because there is no interpolation used. SrcImage and DstImage must be - in the same data format. Works for all data formats except special formats.} -procedure StretchNearest(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt); -type - { Built-in sampling filters.} - TSamplingFilter = (sfNearest, sfLinear, sfCosine, sfHermite, sfQuadratic, - sfGaussian, sfSpline, sfLanczos, sfMitchell, sfCatmullRom); - { Type of custom sampling function} - TFilterFunction = function(Value: Single): Single; -const - { Default resampling filter used for bicubic resizing.} - DefaultCubicFilter = sfCatmullRom; -var - { Built-in filter functions.} - SamplingFilterFunctions: array[TSamplingFilter] of TFilterFunction; - { Default radii of built-in filter functions.} - SamplingFilterRadii: array[TSamplingFilter] of Single; - -{ Stretches rectangle in source image to rectangle in destination image - with resampling. One of built-in resampling filters defined by - Filter is used. Set WrapEdges to True for seamlessly tileable images. - SrcImage and DstImage must be in the same data format. - Works for all data formats except special and indexed formats.} -procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TSamplingFilter; WrapEdges: Boolean = False); overload; -{ Stretches rectangle in source image to rectangle in destination image - with resampling. You can use custom sampling function and filter radius. - Set WrapEdges to True for seamlessly tileable images. SrcImage and DstImage - must be in the same data format. - Works for all data formats except special and indexed formats.} -procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TFilterFunction; Radius: Single; - WrapEdges: Boolean = False); overload; -{ Helper for functions that create mipmap levels. BiggerLevel is - valid image and SmallerLevel is empty zeroed image. SmallerLevel is created - with Width and Height dimensions and it is filled with pixels of BiggerLevel - using resampling filter specified by ImagingMipMapFilter option. - Uses StretchNearest and StretchResample internally so the same image data format - limitations apply.} -procedure FillMipMapLevel(const BiggerLevel: TImageData; Width, Height: LongInt; - var SmallerLevel: TImageData); - - -{ Various helper & support functions } - -{ Copies Src pixel to Dest pixel. It is faster than System.Move procedure.} -procedure CopyPixel(Src, Dest: Pointer; BytesPerPixel: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Compares Src pixel and Dest pixel. It is faster than SysUtils.CompareMem function.} -function ComparePixels(PixelA, PixelB: Pointer; BytesPerPixel: LongInt): Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Translates pixel color in SrcFormat to DstFormat.} -procedure TranslatePixel(SrcPixel, DstPixel: Pointer; SrcFormat, - DstFormat: TImageFormat; SrcPalette, DstPalette: PPalette32); -{ Clamps floating point pixel channel values to [0.0, 1.0] range.} -procedure ClampFloatPixel(var PixF: TColorFPRec); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Helper function that converts pixel in any format to 32bit ARGB pixel. - For common formats it's faster than calling GetPixel32 etc.} -procedure ConvertToPixel32(SrcPix: PByte; DestPix: PColor32Rec; - const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32 = nil); {$IFDEF USE_INLINE}inline;{$ENDIF} - -{ Adds padding bytes at the ends of scanlines. Bpp is the number of bytes per - pixel of source and WidthBytes is the number of bytes per scanlines of dest.} -procedure AddPadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height, - Bpp, WidthBytes: LongInt); -{ Removes padding from image with scanlines that have aligned sizes. Bpp is - the number of bytes per pixel of dest and WidthBytes is the number of bytes - per scanlines of source.} -procedure RemovePadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height, - Bpp, WidthBytes: LongInt); - -{ Converts 1bit image data to 8bit. Used mostly by file loaders for formats - supporting 1bit images. Scaling of pixel values to 8bits is optional - (indexed formats don't need this).} -procedure Convert1To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); -{ Converts 2bit image data to 8bit. Used mostly by file loaders for formats - supporting 2bit images. Scaling of pixel values to 8bits is optional - (indexed formats don't need this).} -procedure Convert2To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); -{ Converts 4bit image data to 8bit. Used mostly by file loaders for formats - supporting 4bit images. Scaling of pixel values to 8bits is optional - (indexed formats don't need this).} -procedure Convert4To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); - -{ Helper function for image file loaders. Some 15 bit images (targas, bitmaps) - may contain 1 bit alpha but there is no indication of it. This function checks - all 16 bit(should be X1R5G5B5 or A1R5G5B5 format) pixels and some of them have - alpha bit set it returns True, otherwise False.} -function Has16BitImageAlpha(NumPixels: LongInt; Data: PWord): Boolean; -{ Helper function for image file loaders. This function checks is similar - to Has16BitImageAlpha but works with A8R8G8B8/X8R8G8B8 format.} -function Has32BitImageAlpha(NumPixels: LongInt; Data: PLongWord): Boolean; -{ Checks if there is any relevant alpha data (any entry has alpha <> 255) - in the given palette.} -function PaletteHasAlpha(Palette: PPalette32; PaletteEntries: Integer): Boolean; - -{ Provides indexed access to each line of pixels. Does not work with special - format images.} -function GetScanLine(ImageBits: Pointer; const FormatInfo: TImageFormatInfo; - LineWidth, Index: LongInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns True if Format is valid image data format identifier.} -function IsImageFormatValid(Format: TImageFormat): Boolean; - -{ Converts 16bit half floating point value to 32bit Single.} -function HalfToFloat(Half: THalfFloat): Single; -{ Converts 32bit Single to 16bit half floating point.} -function FloatToHalf(Float: Single): THalfFloat; - -{ Converts half float color value to single-precision floating point color.} -function ColorHalfToFloat(ColorHF: TColorHFRec): TColorFPRec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Converts single-precision floating point color to half float color.} -function ColorFloatToHalf(ColorFP: TColorFPRec): TColorHFRec; {$IFDEF USE_INLINE}inline;{$ENDIF} - -{ Makes image PalEntries x 1 big where each pixel has color of one pal entry.} -procedure VisualizePalette(Pal: PPalette32; Entries: Integer; out PalImage: TImageData); - -type - TPointRec = record - Pos: LongInt; - Weight: Single; - end; - TCluster = array of TPointRec; - TMappingTable = array of TCluster; - -{ Helper function for resampling.} -function BuildMappingTable(DstLow, DstHigh, SrcLow, SrcHigh, SrcImageWidth: LongInt; - Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean): TMappingTable; -{ Helper function for resampling.} -procedure FindExtremes(const Map: TMappingTable; var MinPos, MaxPos: LongInt); - - -{ Pixel readers/writers for different image formats } - -{ Returns pixel of image in any ARGB format. Channel values are scaled to 16 bits.} -procedure ChannelGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Pix: TColor64Rec); -{ Sets pixel of image in any ARGB format. Channel values must be scaled to 16 bits.} -procedure ChannelSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Pix: TColor64Rec); - -{ Returns pixel of image in any grayscale format. Gray value is scaled to 64 bits - and alpha to 16 bits.} -procedure GrayGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Gray: TColor64Rec; var Alpha: Word); -{ Sets pixel of image in any grayscale format. Gray value must be scaled to 64 bits - and alpha to 16 bits.} -procedure GraySetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Gray: TColor64Rec; Alpha: Word); - -{ Returns pixel of image in any floating point format. Channel values are - in range <0.0, 1.0>.} -procedure FloatGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Pix: TColorFPRec); -{ Sets pixel of image in any floating point format. Channel values must be - in range <0.0, 1.0>.} -procedure FloatSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Pix: TColorFPRec); - -{ Returns pixel of image in any indexed format. Returned value is index to - the palette.} -procedure IndexGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Index: LongWord); -{ Sets pixel of image in any indexed format. Index is index to the palette.} -procedure IndexSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - Index: LongWord); - - -{ Pixel readers/writers for 32bit and FP colors} - -{ Function for getting pixel colors. Native pixel is read from Image and - then translated to 32 bit ARGB.} -function GetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32): TColor32Rec; -{ Procedure for setting pixel colors. Input 32 bit ARGB color is translated to - native format and then written to Image.} -procedure SetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32; const Color: TColor32Rec); -{ Function for getting pixel colors. Native pixel is read from Image and - then translated to FP ARGB.} -function GetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32): TColorFPRec; -{ Procedure for setting pixel colors. Input FP ARGB color is translated to - native format and then written to Image.} -procedure SetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32; const Color: TColorFPRec); - - -{ Image format conversion functions } - -{ Converts any ARGB format to any ARGB format.} -procedure ChannelToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any ARGB format to any grayscale format.} -procedure ChannelToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any ARGB format to any floating point format.} -procedure ChannelToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any ARGB format to any indexed format.} -procedure ChannelToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); - -{ Converts any grayscale format to any grayscale format.} -procedure GrayToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any grayscale format to any ARGB format.} -procedure GrayToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any grayscale format to any floating point format.} -procedure GrayToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any grayscale format to any indexed format.} -procedure GrayToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); - -{ Converts any floating point format to any floating point format.} -procedure FloatToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any floating point format to any ARGB format.} -procedure FloatToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any floating point format to any grayscale format.} -procedure FloatToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -{ Converts any floating point format to any indexed format.} -procedure FloatToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); - -{ Converts any indexed format to any indexed format.} -procedure IndexToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal, DstPal: PPalette32); -{ Converts any indexed format to any ARGB format.} -procedure IndexToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); -{ Converts any indexed format to any grayscale format.} -procedure IndexToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); -{ Converts any indexed format to any floating point format.} -procedure IndexToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); - - -{ Color constructor functions } - -{ Constructs TColor24Rec color.} -function Color24(R, G, B: Byte): TColor24Rec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Constructs TColor32Rec color.} -function Color32(A, R, G, B: Byte): TColor32Rec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Constructs TColor48Rec color.} -function Color48(R, G, B: Word): TColor48Rec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Constructs TColor64Rec color.} -function Color64(A, R, G, B: Word): TColor64Rec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Constructs TColorFPRec color.} -function ColorFP(A, R, G, B: Single): TColorFPRec; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Constructs TColorHFRec color.} -function ColorHF(A, R, G, B: THalfFloat): TColorHFRec; {$IFDEF USE_INLINE}inline;{$ENDIF} - - -{ Special formats conversion functions } - -{ Converts image to/from/between special image formats (dxtc, ...).} -procedure ConvertSpecial(var Image: TImageData; SrcInfo, - DstInfo: PImageFormatInfo); - - -{ Inits all image format information. Called internally on startup.} -procedure InitImageFormats(var Infos: TImageFormatInfoArray); - -const - // Grayscale conversion channel weights - GrayConv: TColorFPRec = (B: 0.114; G: 0.587; R: 0.299; A: 0.0); - - // Contants for converting integer colors to floating point - OneDiv8Bit: Single = 1.0 / 255.0; - OneDiv16Bit: Single = 1.0 / 65535.0; - -implementation - -{ TImageFormatInfo member functions } - -{ Returns size in bytes of image in given standard format where - Size = Width * Height * Bpp.} -function GetStdPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward; -{ Checks if Width and Height are valid for given standard format.} -procedure CheckStdDimensions(Format: TImageFormat; var Width, Height: LongInt); forward; -{ Returns size in bytes of image in given DXT format.} -function GetDXTPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward; -{ Checks if Width and Height are valid for given DXT format. If they are - not valid, they are changed to pass the check.} -procedure CheckDXTDimensions(Format: TImageFormat; var Width, Height: LongInt); forward; -{ Returns size in bytes of image in BTC format.} -function GetBTCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward; -{ Returns size in bytes of image in binary format (1bit image).} -function GetBinaryPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; forward; - -{ Optimized pixel readers/writers for 32bit and FP colors to be stored in TImageFormatInfo } - -function GetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; forward; -procedure SetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); forward; -function GetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward; -procedure SetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward; - -function GetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; forward; -procedure SetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); forward; -function GetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward; -procedure SetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward; - -function GetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; forward; -procedure SetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); forward; - -var - PFR3G3B2: TPixelFormatInfo; - PFX5R1G1B1: TPixelFormatInfo; - PFR5G6B5: TPixelFormatInfo; - PFA1R5G5B5: TPixelFormatInfo; - PFA4R4G4B4: TPixelFormatInfo; - PFX1R5G5B5: TPixelFormatInfo; - PFX4R4G4B4: TPixelFormatInfo; - FInfos: PImageFormatInfoArray; - -var - // Free Pascal generates hundreds of warnings here -{$WARNINGS OFF} - - // indexed formats - Index8Info: TImageFormatInfo = ( - Format: ifIndex8; - Name: 'Index8'; - BytesPerPixel: 1; - ChannelCount: 1; - PaletteEntries: 256; - HasAlphaChannel: True; - IsIndexed: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - // grayscale formats - Gray8Info: TImageFormatInfo = ( - Format: ifGray8; - Name: 'Gray8'; - BytesPerPixel: 1; - ChannelCount: 1; - HasGrayChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Channel8Bit; - GetPixelFP: GetPixelFPChannel8Bit; - SetPixel32: SetPixel32Channel8Bit; - SetPixelFP: SetPixelFPChannel8Bit); - - A8Gray8Info: TImageFormatInfo = ( - Format: ifA8Gray8; - Name: 'A8Gray8'; - BytesPerPixel: 2; - ChannelCount: 2; - HasGrayChannel: True; - HasAlphaChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Channel8Bit; - GetPixelFP: GetPixelFPChannel8Bit; - SetPixel32: SetPixel32Channel8Bit; - SetPixelFP: SetPixelFPChannel8Bit); - - Gray16Info: TImageFormatInfo = ( - Format: ifGray16; - Name: 'Gray16'; - BytesPerPixel: 2; - ChannelCount: 1; - HasGrayChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - Gray32Info: TImageFormatInfo = ( - Format: ifGray32; - Name: 'Gray32'; - BytesPerPixel: 4; - ChannelCount: 1; - HasGrayChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - Gray64Info: TImageFormatInfo = ( - Format: ifGray64; - Name: 'Gray64'; - BytesPerPixel: 8; - ChannelCount: 1; - HasGrayChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A16Gray16Info: TImageFormatInfo = ( - Format: ifA16Gray16; - Name: 'A16Gray16'; - BytesPerPixel: 4; - ChannelCount: 2; - HasGrayChannel: True; - HasAlphaChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - // ARGB formats - X5R1G1B1Info: TImageFormatInfo = ( - Format: ifX5R1G1B1; - Name: 'X5R1G1B1'; - BytesPerPixel: 1; - ChannelCount: 3; - UsePixelFormat: True; - PixelFormat: @PFX5R1G1B1; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - R3G3B2Info: TImageFormatInfo = ( - Format: ifR3G3B2; - Name: 'R3G3B2'; - BytesPerPixel: 1; - ChannelCount: 3; - UsePixelFormat: True; - PixelFormat: @PFR3G3B2; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - R5G6B5Info: TImageFormatInfo = ( - Format: ifR5G6B5; - Name: 'R5G6B5'; - BytesPerPixel: 2; - ChannelCount: 3; - UsePixelFormat: True; - PixelFormat: @PFR5G6B5; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A1R5G5B5Info: TImageFormatInfo = ( - Format: ifA1R5G5B5; - Name: 'A1R5G5B5'; - BytesPerPixel: 2; - ChannelCount: 4; - HasAlphaChannel: True; - UsePixelFormat: True; - PixelFormat: @PFA1R5G5B5; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A4R4G4B4Info: TImageFormatInfo = ( - Format: ifA4R4G4B4; - Name: 'A4R4G4B4'; - BytesPerPixel: 2; - ChannelCount: 4; - HasAlphaChannel: True; - UsePixelFormat: True; - PixelFormat: @PFA4R4G4B4; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - X1R5G5B5Info: TImageFormatInfo = ( - Format: ifX1R5G5B5; - Name: 'X1R5G5B5'; - BytesPerPixel: 2; - ChannelCount: 3; - UsePixelFormat: True; - PixelFormat: @PFX1R5G5B5; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - X4R4G4B4Info: TImageFormatInfo = ( - Format: ifX4R4G4B4; - Name: 'X4R4G4B4'; - BytesPerPixel: 2; - ChannelCount: 3; - UsePixelFormat: True; - PixelFormat: @PFX4R4G4B4; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - R8G8B8Info: TImageFormatInfo = ( - Format: ifR8G8B8; - Name: 'R8G8B8'; - BytesPerPixel: 3; - ChannelCount: 3; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Channel8Bit; - GetPixelFP: GetPixelFPChannel8Bit; - SetPixel32: SetPixel32Channel8Bit; - SetPixelFP: SetPixelFPChannel8Bit); - - A8R8G8B8Info: TImageFormatInfo = ( - Format: ifA8R8G8B8; - Name: 'A8R8G8B8'; - BytesPerPixel: 4; - ChannelCount: 4; - HasAlphaChannel: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32ifA8R8G8B8; - GetPixelFP: GetPixelFPifA8R8G8B8; - SetPixel32: SetPixel32ifA8R8G8B8; - SetPixelFP: SetPixelFPifA8R8G8B8); - - X8R8G8B8Info: TImageFormatInfo = ( - Format: ifX8R8G8B8; - Name: 'X8R8G8B8'; - BytesPerPixel: 4; - ChannelCount: 3; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Channel8Bit; - GetPixelFP: GetPixelFPChannel8Bit; - SetPixel32: SetPixel32Channel8Bit; - SetPixelFP: SetPixelFPChannel8Bit); - - R16G16B16Info: TImageFormatInfo = ( - Format: ifR16G16B16; - Name: 'R16G16B16'; - BytesPerPixel: 6; - ChannelCount: 3; - RBSwapFormat: ifB16G16R16; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A16R16G16B16Info: TImageFormatInfo = ( - Format: ifA16R16G16B16; - Name: 'A16R16G16B16'; - BytesPerPixel: 8; - ChannelCount: 4; - HasAlphaChannel: True; - RBSwapFormat: ifA16B16G16R16; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - B16G16R16Info: TImageFormatInfo = ( - Format: ifB16G16R16; - Name: 'B16G16R16'; - BytesPerPixel: 6; - ChannelCount: 3; - IsRBSwapped: True; - RBSwapFormat: ifR16G16B16; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A16B16G16R16Info: TImageFormatInfo = ( - Format: ifA16B16G16R16; - Name: 'A16B16G16R16'; - BytesPerPixel: 8; - ChannelCount: 4; - HasAlphaChannel: True; - IsRBSwapped: True; - RBSwapFormat: ifA16R16G16B16; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - // floating point formats - R32FInfo: TImageFormatInfo = ( - Format: ifR32F; - Name: 'R32F'; - BytesPerPixel: 4; - ChannelCount: 1; - IsFloatingPoint: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPFloat32; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPFloat32); - - A32R32G32B32FInfo: TImageFormatInfo = ( - Format: ifA32R32G32B32F; - Name: 'A32R32G32B32F'; - BytesPerPixel: 16; - ChannelCount: 4; - HasAlphaChannel: True; - IsFloatingPoint: True; - RBSwapFormat: ifA32B32G32R32F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPFloat32; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPFloat32); - - A32B32G32R32FInfo: TImageFormatInfo = ( - Format: ifA32B32G32R32F; - Name: 'A32B32G32R32F'; - BytesPerPixel: 16; - ChannelCount: 4; - HasAlphaChannel: True; - IsFloatingPoint: True; - IsRBSwapped: True; - RBSwapFormat: ifA32R32G32B32F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPFloat32; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPFloat32); - - R16FInfo: TImageFormatInfo = ( - Format: ifR16F; - Name: 'R16F'; - BytesPerPixel: 2; - ChannelCount: 1; - IsFloatingPoint: True; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A16R16G16B16FInfo: TImageFormatInfo = ( - Format: ifA16R16G16B16F; - Name: 'A16R16G16B16F'; - BytesPerPixel: 8; - ChannelCount: 4; - HasAlphaChannel: True; - IsFloatingPoint: True; - RBSwapFormat: ifA16B16G16R16F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - A16B16G16R16FInfo: TImageFormatInfo = ( - Format: ifA16B16G16R16F; - Name: 'A16B16G16R16F'; - BytesPerPixel: 8; - ChannelCount: 4; - HasAlphaChannel: True; - IsFloatingPoint: True; - IsRBSwapped: True; - RBSwapFormat: ifA16R16G16B16F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPGeneric; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPGeneric); - - R32G32B32FInfo: TImageFormatInfo = ( - Format: ifR32G32B32F; - Name: 'R32G32B32F'; - BytesPerPixel: 12; - ChannelCount: 3; - IsFloatingPoint: True; - RBSwapFormat: ifB32G32R32F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPFloat32; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPFloat32); - - B32G32R32FInfo: TImageFormatInfo = ( - Format: ifB32G32R32F; - Name: 'B32G32R32F'; - BytesPerPixel: 12; - ChannelCount: 3; - IsFloatingPoint: True; - IsRBSwapped: True; - RBSwapFormat: ifR32G32B32F; - GetPixelsSize: GetStdPixelsSize; - CheckDimensions: CheckStdDimensions; - GetPixel32: GetPixel32Generic; - GetPixelFP: GetPixelFPFloat32; - SetPixel32: SetPixel32Generic; - SetPixelFP: SetPixelFPFloat32); - - // special formats - DXT1Info: TImageFormatInfo = ( - Format: ifDXT1; - Name: 'DXT1'; - ChannelCount: 4; - HasAlphaChannel: True; - IsSpecial: True; - GetPixelsSize: GetDXTPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifA8R8G8B8); - - DXT3Info: TImageFormatInfo = ( - Format: ifDXT3; - Name: 'DXT3'; - ChannelCount: 4; - HasAlphaChannel: True; - IsSpecial: True; - GetPixelsSize: GetDXTPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifA8R8G8B8); - - DXT5Info: TImageFormatInfo = ( - Format: ifDXT5; - Name: 'DXT5'; - ChannelCount: 4; - HasAlphaChannel: True; - IsSpecial: True; - GetPixelsSize: GetDXTPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifA8R8G8B8); - - BTCInfo: TImageFormatInfo = ( - Format: ifBTC; - Name: 'BTC'; - ChannelCount: 1; - HasAlphaChannel: False; - IsSpecial: True; - GetPixelsSize: GetBTCPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifGray8); - - ATI1NInfo: TImageFormatInfo = ( - Format: ifATI1N; - Name: 'ATI1N'; - ChannelCount: 1; - HasAlphaChannel: False; - IsSpecial: True; - GetPixelsSize: GetDXTPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifGray8); - - ATI2NInfo: TImageFormatInfo = ( - Format: ifATI2N; - Name: 'ATI2N'; - ChannelCount: 2; - HasAlphaChannel: False; - IsSpecial: True; - GetPixelsSize: GetDXTPixelsSize; - CheckDimensions: CheckDXTDimensions; - SpecialNearestFormat: ifA8R8G8B8); - - BinaryInfo: TImageFormatInfo = ( - Format: ifBinary; - Name: 'Binary'; - ChannelCount: 1; - HasAlphaChannel: False; - IsSpecial: True; - GetPixelsSize: GetBinaryPixelsSize; - CheckDimensions: CheckStdDimensions; - SpecialNearestFormat: ifGray8); - -{$WARNINGS ON} - -function PixelFormat(ABitCount, RBitCount, GBitCount, BBitCount: Byte): TPixelFormatInfo; forward; - -procedure InitImageFormats(var Infos: TImageFormatInfoArray); -begin - FInfos := @Infos; - - Infos[ifDefault] := @A8R8G8B8Info; - // indexed formats - Infos[ifIndex8] := @Index8Info; - // grayscale formats - Infos[ifGray8] := @Gray8Info; - Infos[ifA8Gray8] := @A8Gray8Info; - Infos[ifGray16] := @Gray16Info; - Infos[ifGray32] := @Gray32Info; - Infos[ifGray64] := @Gray64Info; - Infos[ifA16Gray16] := @A16Gray16Info; - // ARGB formats - Infos[ifX5R1G1B1] := @X5R1G1B1Info; - Infos[ifR3G3B2] := @R3G3B2Info; - Infos[ifR5G6B5] := @R5G6B5Info; - Infos[ifA1R5G5B5] := @A1R5G5B5Info; - Infos[ifA4R4G4B4] := @A4R4G4B4Info; - Infos[ifX1R5G5B5] := @X1R5G5B5Info; - Infos[ifX4R4G4B4] := @X4R4G4B4Info; - Infos[ifR8G8B8] := @R8G8B8Info; - Infos[ifA8R8G8B8] := @A8R8G8B8Info; - Infos[ifX8R8G8B8] := @X8R8G8B8Info; - Infos[ifR16G16B16] := @R16G16B16Info; - Infos[ifA16R16G16B16] := @A16R16G16B16Info; - Infos[ifB16G16R16] := @B16G16R16Info; - Infos[ifA16B16G16R16] := @A16B16G16R16Info; - // floating point formats - Infos[ifR32F] := @R32FInfo; - Infos[ifA32R32G32B32F] := @A32R32G32B32FInfo; - Infos[ifA32B32G32R32F] := @A32B32G32R32FInfo; - Infos[ifR16F] := @R16FInfo; - Infos[ifA16R16G16B16F] := @A16R16G16B16FInfo; - Infos[ifA16B16G16R16F] := @A16B16G16R16FInfo; - Infos[ifR32G32B32F] := @R32G32B32FInfo; - Infos[ifB32G32R32F] := @B32G32R32FInfo; - // special formats - Infos[ifDXT1] := @DXT1Info; - Infos[ifDXT3] := @DXT3Info; - Infos[ifDXT5] := @DXT5Info; - Infos[ifBTC] := @BTCInfo; - Infos[ifATI1N] := @ATI1NInfo; - Infos[ifATI2N] := @ATI2NInfo; - Infos[ifBinary] := @BinaryInfo; - - PFR3G3B2 := PixelFormat(0, 3, 3, 2); - PFX5R1G1B1 := PixelFormat(0, 1, 1, 1); - PFR5G6B5 := PixelFormat(0, 5, 6, 5); - PFA1R5G5B5 := PixelFormat(1, 5, 5, 5); - PFA4R4G4B4 := PixelFormat(4, 4, 4, 4); - PFX1R5G5B5 := PixelFormat(0, 5, 5, 5); - PFX4R4G4B4 := PixelFormat(0, 4, 4, 4); -end; - - -{ Internal unit helper functions } - -function PixelFormat(ABitCount, RBitCount, GBitCount, BBitCount: Byte): TPixelFormatInfo; -begin - Result.ABitMask := ((1 shl ABitCount) - 1) shl (RBitCount + GBitCount + - BBitCount); - Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount); - Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount); - Result.BBitMask := (1 shl BBitCount) - 1; - Result.ABitCount := ABitCount; - Result.RBitCount := RBitCount; - Result.GBitCount := GBitCount; - Result.BBitCount := BBitCount; - Result.AShift := RBitCount + GBitCount + BBitCount; - Result.RShift := GBitCount + BBitCount; - Result.GShift := BBitCount; - Result.BShift := 0; - Result.ARecDiv := Max(1, Pow2Int(Result.ABitCount) - 1); - Result.RRecDiv := Max(1, Pow2Int(Result.RBitCount) - 1); - Result.GRecDiv := Max(1, Pow2Int(Result.GBitCount) - 1); - Result.BRecDiv := Max(1, Pow2Int(Result.BBitCount) - 1); -end; - -function PixelFormatMask(ABitMask, RBitMask, GBitMask, BBitMask: LongWord): TPixelFormatInfo; - - function GetBitCount(B: LongWord): LongWord; - var - I: LongWord; - begin - I := 0; - while (I < 31) and (((1 shl I) and B) = 0) do - Inc(I); - Result := 0; - while ((1 shl I) and B) <> 0 do - begin - Inc(I); - Inc(Result); - end; - end; - -begin - Result := PixelFormat(GetBitCount(ABitMask), GetBitCount(RBitMask), - GetBitCount(GBitMask), GetBitCount(BBitMask)); -end; - -function PFSetARGB(const PF: TPixelFormatInfo; A, R, G, B: Byte): TColor32; -{$IFDEF USE_INLINE}inline;{$ENDIF} -begin - with PF do - Result := - (A shl ABitCount shr 8 shl AShift) or - (R shl RBitCount shr 8 shl RShift) or - (G shl GBitCount shr 8 shl GShift) or - (B shl BBitCount shr 8 shl BShift); -end; - -procedure PFGetARGB(const PF: TPixelFormatInfo; Color: LongWord; - var A, R, G, B: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF} -begin - with PF do - begin - A := (Color and ABitMask shr AShift) * 255 div ARecDiv; - R := (Color and RBitMask shr RShift) * 255 div RRecDiv; - G := (Color and GBitMask shr GShift) * 255 div GRecDiv; - B := (Color and BBitMask shl BShift) * 255 div BRecDiv; - end; -end; - -function PFSetColor(const PF: TPixelFormatInfo; ARGB: TColor32): LongWord; -{$IFDEF USE_INLINE}inline;{$ENDIF} -begin - with PF do - Result := - (Byte(ARGB shr 24) shl ABitCount shr 8 shl AShift) or - (Byte(ARGB shr 16) shl RBitCount shr 8 shl RShift) or - (Byte(ARGB shr 8) shl GBitCount shr 8 shl GShift) or - (Byte(ARGB) shl BBitCount shr 8 shl BShift); -end; - -function PFGetColor(const PF: TPixelFormatInfo; Color: LongWord): TColor32; -{$IFDEF USE_INLINE}inline;{$ENDIF} -begin - with PF, TColor32Rec(Result) do - begin - A := (Color and ABitMask shr AShift) * 255 div ARecDiv; - R := (Color and RBitMask shr RShift) * 255 div RRecDiv; - G := (Color and GBitMask shr GShift) * 255 div GRecDiv; - B := (Color and BBitMask shl BShift) * 255 div BRecDiv; - end; -end; - - -{ Color constructor functions } - - -function Color24(R, G, B: Byte): TColor24Rec; -begin - Result.R := R; - Result.G := G; - Result.B := B; -end; - -function Color32(A, R, G, B: Byte): TColor32Rec; -begin - Result.A := A; - Result.R := R; - Result.G := G; - Result.B := B; -end; - -function Color48(R, G, B: Word): TColor48Rec; -begin - Result.R := R; - Result.G := G; - Result.B := B; -end; - -function Color64(A, R, G, B: Word): TColor64Rec; -begin - Result.A := A; - Result.R := R; - Result.G := G; - Result.B := B; -end; - -function ColorFP(A, R, G, B: Single): TColorFPRec; -begin - Result.A := A; - Result.R := R; - Result.G := G; - Result.B := B; -end; - -function ColorHF(A, R, G, B: THalfFloat): TColorHFRec; -begin - Result.A := A; - Result.R := R; - Result.G := G; - Result.B := B; -end; - - -{ Additional image manipulation functions (usually used internally by Imaging unit) } - -const - MaxPossibleColors = 4096; - HashSize = 32768; - AlphaWeight = 1024; - RedWeight = 612; - GreenWeight = 1202; - BlueWeight = 234; - -type - PColorBin = ^TColorBin; - TColorBin = record - Color: TColor32Rec; - Number: LongInt; - Next: PColorBin; - end; - - THashTable = array[0..HashSize - 1] of PColorBin; - - TColorBox = record - AMin, AMax, - RMin, RMax, - GMin, GMax, - BMin, BMax: LongInt; - Total: LongInt; - Represented: TColor32Rec; - List: PColorBin; - end; - -var - Table: THashTable; - Box: array[0..MaxPossibleColors - 1] of TColorBox; - Boxes: LongInt; - BoxesCreated: Boolean = False; - -procedure ReduceColorsMedianCut(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; MaxColors: LongInt; ChannelMask: Byte; - DstPal: PPalette32; Actions: TReduceColorsActions); - - procedure CreateHistogram (Src: PByte; SrcInfo: PImageFormatInfo; - ChannelMask: Byte); - var - A, R, G, B: Byte; - I, Addr: LongInt; - PC: PColorBin; - Col: TColor32Rec; - begin - for I := 0 to NumPixels - 1 do - begin - Col := GetPixel32Generic(Src, SrcInfo, nil); - A := Col.A and ChannelMask; - R := Col.R and ChannelMask; - G := Col.G and ChannelMask; - B := Col.B and ChannelMask; - - Addr := (A + 11 * B + 59 * R + 119 * G) mod HashSize; - PC := Table[Addr]; - - while (PC <> nil) and ((PC.Color.R <> R) or (PC.Color.G <> G) or - (PC.Color.B <> B) or (PC.Color.A <> A)) do - PC := PC.Next; - - if PC = nil then - begin - New(PC); - PC.Color.R := R; - PC.Color.G := G; - PC.Color.B := B; - PC.Color.A := A; - PC.Number := 1; - PC.Next := Table[Addr]; - Table[Addr] := PC; - end - else - Inc(PC^.Number); - Inc(Src, SrcInfo.BytesPerPixel); - end; - end; - - procedure InitBox (var Box : TColorBox); - begin - Box.AMin := 256; - Box.RMin := 256; - Box.GMin := 256; - Box.BMin := 256; - Box.AMax := -1; - Box.RMax := -1; - Box.GMax := -1; - Box.BMax := -1; - Box.Total := 0; - Box.List := nil; - end; - - procedure ChangeBox (var Box: TColorBox; const C: TColorBin); - begin - with C.Color do - begin - if A < Box.AMin then Box.AMin := A; - if A > Box.AMax then Box.AMax := A; - if B < Box.BMin then Box.BMin := B; - if B > Box.BMax then Box.BMax := B; - if G < Box.GMin then Box.GMin := G; - if G > Box.GMax then Box.GMax := G; - if R < Box.RMin then Box.RMin := R; - if R > Box.RMax then Box.RMax := R; - end; - Inc(Box.Total, C.Number); - end; - - procedure MakeColormap; - var - I, J: LongInt; - CP, Pom: PColorBin; - Cut, LargestIdx, Largest, Size, S: LongInt; - CutA, CutR, CutG, CutB: Boolean; - SumA, SumR, SumG, SumB: LongInt; - Temp: TColorBox; - begin - I := 0; - Boxes := 1; - LargestIdx := 0; - while (I < HashSize) and (Table[I] = nil) do - Inc(i); - if I < HashSize then - begin - // put all colors into Box[0] - InitBox(Box[0]); - repeat - CP := Table[I]; - while CP.Next <> nil do - begin - ChangeBox(Box[0], CP^); - CP := CP.Next; - end; - ChangeBox(Box[0], CP^); - CP.Next := Box[0].List; - Box[0].List := Table[I]; - Table[I] := nil; - repeat - Inc(I) - until (I = HashSize) or (Table[I] <> nil); - until I = HashSize; - // now all colors are in Box[0] - repeat - // cut one color box - Largest := 0; - for I := 0 to Boxes - 1 do - with Box[I] do - begin - Size := (AMax - AMin) * AlphaWeight; - S := (RMax - RMin) * RedWeight; - if S > Size then - Size := S; - S := (GMax - GMin) * GreenWeight; - if S > Size then - Size := S; - S := (BMax - BMin) * BlueWeight; - if S > Size then - Size := S; - if Size > Largest then - begin - Largest := Size; - LargestIdx := I; - end; - end; - if Largest > 0 then - begin - // cutting Box[LargestIdx] into Box[LargestIdx] and Box[Boxes] - CutR := False; - CutG := False; - CutB := False; - CutA := False; - with Box[LargestIdx] do - begin - if (AMax - AMin) * AlphaWeight = Largest then - begin - Cut := (AMax + AMin) shr 1; - CutA := True; - end - else - if (RMax - RMin) * RedWeight = Largest then - begin - Cut := (RMax + RMin) shr 1; - CutR := True; - end - else - if (GMax - GMin) * GreenWeight = Largest then - begin - Cut := (GMax + GMin) shr 1; - CutG := True; - end - else - begin - Cut := (BMax + BMin) shr 1; - CutB := True; - end; - CP := List; - end; - InitBox(Box[LargestIdx]); - InitBox(Box[Boxes]); - repeat - // distribute one color - Pom := CP.Next; - with CP.Color do - begin - if (CutA and (A <= Cut)) or (CutR and (R <= Cut)) or - (CutG and (G <= Cut)) or (CutB and (B <= Cut)) then - I := LargestIdx - else - I := Boxes; - end; - CP.Next := Box[i].List; - Box[i].List := CP; - ChangeBox(Box[i], CP^); - CP := Pom; - until CP = nil; - Inc(Boxes); - end; - until (Boxes = MaxColors) or (Largest = 0); - // compute box representation - for I := 0 to Boxes - 1 do - begin - SumR := 0; - SumG := 0; - SumB := 0; - SumA := 0; - repeat - CP := Box[I].List; - Inc(SumR, CP.Color.R * CP.Number); - Inc(SumG, CP.Color.G * CP.Number); - Inc(SumB, CP.Color.B * CP.Number); - Inc(SumA, CP.Color.A * CP.Number); - Box[I].List := CP.Next; - Dispose(CP); - until Box[I].List = nil; - with Box[I] do - begin - Represented.A := SumA div Total; - Represented.R := SumR div Total; - Represented.G := SumG div Total; - Represented.B := SumB div Total; - AMin := AMin and ChannelMask; - RMin := RMin and ChannelMask; - GMin := GMin and ChannelMask; - BMin := BMin and ChannelMask; - AMax := (AMax and ChannelMask) + (not ChannelMask); - RMax := (RMax and ChannelMask) + (not ChannelMask); - GMax := (GMax and ChannelMask) + (not ChannelMask); - BMax := (BMax and ChannelMask) + (not ChannelMask); - end; - end; - // sort color boxes - for I := 0 to Boxes - 2 do - begin - Largest := 0; - for J := I to Boxes - 1 do - if Box[J].Total > Largest then - begin - Largest := Box[J].Total; - LargestIdx := J; - end; - if LargestIdx <> I then - begin - Temp := Box[I]; - Box[I] := Box[LargestIdx]; - Box[LargestIdx] := Temp; - end; - end; - end; - end; - - procedure FillOutputPalette; - var - I: LongInt; - begin - FillChar(DstPal^, SizeOf(TColor32Rec) * MaxColors, $FF); - for I := 0 to MaxColors - 1 do - begin - if I < Boxes then - with Box[I].Represented do - begin - DstPal[I].A := A; - DstPal[I].R := R; - DstPal[I].G := G; - DstPal[I].B := B; - end - else - DstPal[I].Color := $FF000000; - end; - end; - - function MapColor(const Col: TColor32Rec) : LongInt; - var - I: LongInt; - begin - I := 0; - with Col do - while (I < Boxes) and ((Box[I].AMin > A) or (Box[I].AMax < A) or - (Box[I].RMin > R) or (Box[I].RMax < R) or (Box[I].GMin > G) or - (Box[I].GMax < G) or (Box[I].BMin > B) or (Box[I].BMax < B)) do - Inc(I); - if I = Boxes then - MapColor := 0 - else - MapColor := I; - end; - - procedure MapImage(Src, Dst: PByte; SrcInfo, DstInfo: PImageFormatInfo); - var - I: LongInt; - Col: TColor32Rec; - begin - for I := 0 to NumPixels - 1 do - begin - Col := GetPixel32Generic(Src, SrcInfo, nil); - IndexSetDstPixel(Dst, DstInfo, MapColor(Col)); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; - end; - -begin - MaxColors := ClampInt(MaxColors, 2, MaxPossibleColors); - - if (raUpdateHistogram in Actions) or (raMapImage in Actions) then - begin - Assert(not SrcInfo.IsSpecial); - Assert(not SrcInfo.IsIndexed); - end; - - if raCreateHistogram in Actions then - FillChar(Table, SizeOf(Table), 0); - - if raUpdateHistogram in Actions then - CreateHistogram(Src, SrcInfo, ChannelMask); - - if raMakeColorMap in Actions then - begin - MakeColorMap; - FillOutputPalette; - end; - - if raMapImage in Actions then - MapImage(Src, Dst, SrcInfo, DstInfo); -end; - -procedure StretchNearest(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt); -var - Info: TImageFormatInfo; - ScaleX, ScaleY, X, Y, Xp, Yp: LongInt; - DstPixel, SrcLine: PByte; -begin - GetImageFormatInfo(SrcImage.Format, Info); - Assert(SrcImage.Format = DstImage.Format); - Assert(not Info.IsSpecial); - // Use integers instead of floats for source image pixel coords - // Xp and Yp coords must be shifted right to get read source image coords - ScaleX := (SrcWidth shl 16) div DstWidth; - ScaleY := (SrcHeight shl 16) div DstHeight; - Yp := 0; - for Y := 0 to DstHeight - 1 do - begin - Xp := 0; - SrcLine := @PByteArray(SrcImage.Bits)[((SrcY + Yp shr 16) * SrcImage.Width + SrcX) * Info.BytesPerPixel]; - DstPixel := @PByteArray(DstImage.Bits)[((DstY + Y) * DstImage.Width + DstX) * Info.BytesPerPixel]; - for X := 0 to DstWidth - 1 do - begin - case Info.BytesPerPixel of - 1: PByte(DstPixel)^ := PByteArray(SrcLine)[Xp shr 16]; - 2: PWord(DstPixel)^ := PWordArray(SrcLine)[Xp shr 16]; - 3: PColor24Rec(DstPixel)^ := PPalette24(SrcLine)[Xp shr 16]; - 4: PColor32(DstPixel)^ := PLongWordArray(SrcLine)[Xp shr 16]; - 6: PColor48Rec(DstPixel)^ := PColor48RecArray(SrcLine)[Xp shr 16]; - 8: PColor64(DstPixel)^ := PInt64Array(SrcLine)[Xp shr 16]; - 16: PColorFPRec(DstPixel)^ := PColorFPRecArray(SrcLine)[Xp shr 16]; - end; - Inc(DstPixel, Info.BytesPerPixel); - Inc(Xp, ScaleX); - end; - Inc(Yp, ScaleY); - end; -end; - -{ Filter function for nearest filtering. Also known as box filter.} -function FilterNearest(Value: Single): Single; -begin - if (Value > -0.5) and (Value <= 0.5) then - Result := 1 - else - Result := 0; -end; - -{ Filter function for linear filtering. Also known as triangle or Bartlett filter.} -function FilterLinear(Value: Single): Single; -begin - if Value < 0.0 then - Value := -Value; - if Value < 1.0 then - Result := 1.0 - Value - else - Result := 0.0; -end; - -{ Cosine filter.} -function FilterCosine(Value: Single): Single; -begin - Result := 0; - if Abs(Value) < 1 then - Result := (Cos(Value * Pi) + 1) / 2; -end; - -{ f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 } -function FilterHermite(Value: Single): Single; -begin - if Value < 0.0 then - Value := -Value; - if Value < 1 then - Result := (2 * Value - 3) * Sqr(Value) + 1 - else - Result := 0; -end; - -{ Quadratic filter. Also known as Bell.} -function FilterQuadratic(Value: Single): Single; -begin - if Value < 0.0 then - Value := -Value; - if Value < 0.5 then - Result := 0.75 - Sqr(Value) - else - if Value < 1.5 then - begin - Value := Value - 1.5; - Result := 0.5 * Sqr(Value); - end - else - Result := 0.0; -end; - -{ Gaussian filter.} -function FilterGaussian(Value: Single): Single; -begin - Result := Exp(-2.0 * Sqr(Value)) * Sqrt(2.0 / Pi); -end; - -{ 4th order (cubic) b-spline filter.} -function FilterSpline(Value: Single): Single; -var - Temp: Single; -begin - if Value < 0.0 then - Value := -Value; - if Value < 1.0 then - begin - Temp := Sqr(Value); - Result := 0.5 * Temp * Value - Temp + 2.0 / 3.0; - end - else - if Value < 2.0 then - begin - Value := 2.0 - Value; - Result := Sqr(Value) * Value / 6.0; - end - else - Result := 0.0; -end; - -{ Lanczos-windowed sinc filter.} -function FilterLanczos(Value: Single): Single; - - function SinC(Value: Single): Single; - begin - if Value <> 0.0 then - begin - Value := Value * Pi; - Result := Sin(Value) / Value; - end - else - Result := 1.0; - end; - -begin - if Value < 0.0 then - Value := -Value; - if Value < 3.0 then - Result := SinC(Value) * SinC(Value / 3.0) - else - Result := 0.0; -end; - -{ Micthell cubic filter.} -function FilterMitchell(Value: Single): Single; -const - B = 1.0 / 3.0; - C = 1.0 / 3.0; -var - Temp: Single; -begin - if Value < 0.0 then - Value := -Value; - Temp := Sqr(Value); - if Value < 1.0 then - begin - Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * Temp)) + - ((-18.0 + 12.0 * B + 6.0 * C) * Temp) + - (6.0 - 2.0 * B)); - Result := Value / 6.0; - end - else - if Value < 2.0 then - begin - Value := (((-B - 6.0 * C) * (Value * Temp)) + - ((6.0 * B + 30.0 * C) * Temp) + - ((-12.0 * B - 48.0 * C) * Value) + - (8.0 * B + 24.0 * C)); - Result := Value / 6.0; - end - else - Result := 0.0; -end; - -{ CatmullRom spline filter.} -function FilterCatmullRom(Value: Single): Single; -begin - if Value < 0.0 then - Value := -Value; - if Value < 1.0 then - Result := 0.5 * (2.0 + Sqr(Value) * (-5.0 + 3.0 * Value)) - else - if Value < 2.0 then - Result := 0.5 * (4.0 + Value * (-8.0 + Value * (5.0 - Value))) - else - Result := 0.0; -end; - -procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TSamplingFilter; WrapEdges: Boolean); -begin - // Calls the other function with filter function and radius defined by Filter - StretchResample(SrcImage, SrcX, SrcY, SrcWidth, SrcHeight, DstImage, DstX, DstY, - DstWidth, DstHeight, SamplingFilterFunctions[Filter], SamplingFilterRadii[Filter], - WrapEdges); -end; - -var - FullEdge: Boolean = True; - -{ The following resampling code is modified and extended code from Graphics32 - library by Alex A. Denisov.} -function BuildMappingTable(DstLow, DstHigh, SrcLow, SrcHigh, SrcImageWidth: LongInt; - Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean): TMappingTable; -var - I, J, K, N: LongInt; - Left, Right, SrcWidth, DstWidth: LongInt; - Weight, Scale, Center, Count: Single; -begin - Result := nil; - K := 0; - SrcWidth := SrcHigh - SrcLow; - DstWidth := DstHigh - DstLow; - - // Check some special cases - if SrcWidth = 1 then - begin - SetLength(Result, DstWidth); - for I := 0 to DstWidth - 1 do - begin - SetLength(Result[I], 1); - Result[I][0].Pos := 0; - Result[I][0].Weight := 1.0; - end; - Exit; - end - else - if (SrcWidth = 0) or (DstWidth = 0) then - Exit; - - if FullEdge then - Scale := DstWidth / SrcWidth - else - Scale := (DstWidth - 1) / (SrcWidth - 1); - - SetLength(Result, DstWidth); - - // Pre-calculate filter contributions for a row or column - if Scale = 0.0 then - begin - Assert(Length(Result) = 1); - SetLength(Result[0], 1); - Result[0][0].Pos := (SrcLow + SrcHigh) div 2; - Result[0][0].Weight := 1.0; - end - else if Scale < 1.0 then - begin - // Sub-sampling - scales from bigger to smaller - Radius := Radius / Scale; - for I := 0 to DstWidth - 1 do - begin - if FullEdge then - Center := SrcLow - 0.5 + (I + 0.5) / Scale - else - Center := SrcLow + I / Scale; - Left := Floor(Center - Radius); - Right := Ceil(Center + Radius); - Count := -1.0; - for J := Left to Right do - begin - Weight := Filter((Center - J) * Scale) * Scale; - if Weight <> 0.0 then - begin - Count := Count + Weight; - K := Length(Result[I]); - SetLength(Result[I], K + 1); - Result[I][K].Pos := ClampInt(J, SrcLow, SrcHigh - 1); - Result[I][K].Weight := Weight; - end; - end; - if Length(Result[I]) = 0 then - begin - SetLength(Result[I], 1); - Result[I][0].Pos := Floor(Center); - Result[I][0].Weight := 1.0; - end - else if Count <> 0.0 then - Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count; - end; - end - else // if Scale > 1.0 then - begin - // Super-sampling - scales from smaller to bigger - Scale := 1.0 / Scale; - for I := 0 to DstWidth - 1 do - begin - if FullEdge then - Center := SrcLow - 0.5 + (I + 0.5) * Scale - else - Center := SrcLow + I * Scale; - Left := Floor(Center - Radius); - Right := Ceil(Center + Radius); - Count := -1.0; - for J := Left to Right do - begin - Weight := Filter(Center - J); - if Weight <> 0.0 then - begin - Count := Count + Weight; - K := Length(Result[I]); - SetLength(Result[I], K + 1); - - if WrapEdges then - begin - if J < 0 then - N := SrcImageWidth + J - else if J >= SrcImageWidth then - N := J - SrcImageWidth - else - N := ClampInt(J, SrcLow, SrcHigh - 1); - end - else - N := ClampInt(J, SrcLow, SrcHigh - 1); - - Result[I][K].Pos := N; - Result[I][K].Weight := Weight; - end; - end; - if Count <> 0.0 then - Result[I][K div 2].Weight := Result[I][K div 2].Weight - Count; - end; - end; -end; - -procedure FindExtremes(const Map: TMappingTable; var MinPos, MaxPos: LongInt); -var - I, J: LongInt; -begin - if Length(Map) > 0 then - begin - MinPos := Map[0][0].Pos; - MaxPos := MinPos; - for I := 0 to Length(Map) - 1 do - for J := 0 to Length(Map[I]) - 1 do - begin - if MinPos > Map[I][J].Pos then - MinPos := Map[I][J].Pos; - if MaxPos < Map[I][J].Pos then - MaxPos := Map[I][J].Pos; - end; - end; -end; - -procedure StretchResample(const SrcImage: TImageData; SrcX, SrcY, SrcWidth, - SrcHeight: LongInt; var DstImage: TImageData; DstX, DstY, DstWidth, - DstHeight: LongInt; Filter: TFilterFunction; Radius: Single; WrapEdges: Boolean); -const - Channel8BitMax: Single = 255.0; -var - MapX, MapY: TMappingTable; - I, J, X, Y: LongInt; - XMinimum, XMaximum: LongInt; - LineBufferFP: array of TColorFPRec; - ClusterX, ClusterY: TCluster; - Weight, AccumA, AccumR, AccumG, AccumB: Single; - DstLine: PByte; - SrcFloat: TColorFPRec; - Info: TImageFormatInfo; - BytesPerChannel: LongInt; -begin - GetImageFormatInfo(SrcImage.Format, Info); - Assert(SrcImage.Format = DstImage.Format); - Assert(not Info.IsSpecial and not Info.IsIndexed); - BytesPerChannel := Info.BytesPerPixel div Info.ChannelCount; - - // Create horizontal and vertical mapping tables - MapX := BuildMappingTable(DstX, DstX + DstWidth, SrcX, SrcX + SrcWidth, - SrcImage.Width, Filter, Radius, WrapEdges); - MapY := BuildMappingTable(DstY, DstY + DstHeight, SrcY, SrcY + SrcHeight, - SrcImage.Height, Filter, Radius, WrapEdges); - - if (MapX = nil) or (MapY = nil) then - Exit; - - ClusterX := nil; - ClusterY := nil; - - try - // Find min and max X coords of pixels that will contribute to target image - FindExtremes(MapX, XMinimum, XMaximum); - - SetLength(LineBufferFP, XMaximum - XMinimum + 1); - // Following code works for the rest of data formats - for J := 0 to DstHeight - 1 do - begin - // First for each pixel in the current line sample vertically - // and store results in LineBuffer. Then sample horizontally - // using values in LineBuffer. - ClusterY := MapY[J]; - for X := XMinimum to XMaximum do - begin - // Clear accumulators - AccumA := 0; - AccumR := 0; - AccumG := 0; - AccumB := 0; - // For each pixel in line compute weighted sum of pixels - // in source column that will contribute to this pixel - for Y := 0 to Length(ClusterY) - 1 do - begin - // Accumulate this pixel's weighted value - Weight := ClusterY[Y].Weight; - SrcFloat := Info.GetPixelFP(@PByteArray(SrcImage.Bits)[(ClusterY[Y].Pos * SrcImage.Width + X) * Info.BytesPerPixel], @Info, nil); - AccumB := AccumB + SrcFloat.B * Weight; - AccumG := AccumG + SrcFloat.G * Weight; - AccumR := AccumR + SrcFloat.R * Weight; - AccumA := AccumA + SrcFloat.A * Weight; - end; - // Store accumulated value for this pixel in buffer - with LineBufferFP[X - XMinimum] do - begin - A := AccumA; - R := AccumR; - G := AccumG; - B := AccumB; - end; - end; - - DstLine := @PByteArray(DstImage.Bits)[((J + DstY) * DstImage.Width + DstX) * Info.BytesPerPixel]; - // Now compute final colors for targte pixels in the current row - // by sampling horizontally - for I := 0 to DstWidth - 1 do - begin - ClusterX := MapX[I]; - // Clear accumulator - AccumA := 0; - AccumR := 0; - AccumG := 0; - AccumB := 0; - // Compute weighted sum of values (which are already - // computed weighted sums of pixels in source columns stored in LineBuffer) - // that will contribute to the current target pixel - for X := 0 to Length(ClusterX) - 1 do - begin - Weight := ClusterX[X].Weight; - with LineBufferFP[ClusterX[X].Pos - XMinimum] do - begin - AccumB := AccumB + B * Weight; - AccumG := AccumG + G * Weight; - AccumR := AccumR + R * Weight; - AccumA := AccumA + A * Weight; - end; - end; - - // Now compute final color to be written to dest image - SrcFloat.A := AccumA; - SrcFloat.R := AccumR; - SrcFloat.G := AccumG; - SrcFloat.B := AccumB; - - Info.SetPixelFP(DstLine, @Info, nil, SrcFloat); - Inc(DstLine, Info.BytesPerPixel); - end; - end; - - finally - MapX := nil; - MapY := nil; - end; -end; - -procedure FillMipMapLevel(const BiggerLevel: TImageData; Width, Height: LongInt; - var SmallerLevel: TImageData); -var - Filter: TSamplingFilter; - Info: TImageFormatInfo; - CompatibleCopy: TImageData; -begin - Assert(TestImage(BiggerLevel)); - Filter := TSamplingFilter(GetOption(ImagingMipMapFilter)); - - // If we have special format image we must create copy to allow pixel access - GetImageFormatInfo(BiggerLevel.Format, Info); - if Info.IsSpecial then - begin - InitImage(CompatibleCopy); - CloneImage(BiggerLevel, CompatibleCopy); - ConvertImage(CompatibleCopy, ifDefault); - end - else - CompatibleCopy := BiggerLevel; - - // Create new smaller image - NewImage(Width, Height, CompatibleCopy.Format, SmallerLevel); - GetImageFormatInfo(CompatibleCopy.Format, Info); - // If input is indexed we must copy its palette - if Info.IsIndexed then - CopyPalette(CompatibleCopy.Palette, SmallerLevel.Palette, 0, 0, Info.PaletteEntries); - - if (Filter = sfNearest) or Info.IsIndexed then - begin - StretchNearest(CompatibleCopy, 0, 0, CompatibleCopy.Width, CompatibleCopy.Height, - SmallerLevel, 0, 0, Width, Height); - end - else - begin - StretchResample(CompatibleCopy, 0, 0, CompatibleCopy.Width, CompatibleCopy.Height, - SmallerLevel, 0, 0, Width, Height, Filter); - end; - - // Free copy and convert result to special format if necessary - if CompatibleCopy.Format <> BiggerLevel.Format then - begin - ConvertImage(SmallerLevel, BiggerLevel.Format); - FreeImage(CompatibleCopy); - end; -end; - - -{ Various format support functions } - -procedure CopyPixel(Src, Dest: Pointer; BytesPerPixel: LongInt); -begin - case BytesPerPixel of - 1: PByte(Dest)^ := PByte(Src)^; - 2: PWord(Dest)^ := PWord(Src)^; - 3: PColor24Rec(Dest)^ := PColor24Rec(Src)^; - 4: PLongWord(Dest)^ := PLongWord(Src)^; - 6: PColor48Rec(Dest)^ := PColor48Rec(Src)^; - 8: PInt64(Dest)^ := PInt64(Src)^; - 12: PColor96FPRec(Dest)^ := PColor96FPRec(Src)^; - 16: PColorFPRec(Dest)^ := PColorFPRec(Src)^; - end; -end; - -function ComparePixels(PixelA, PixelB: Pointer; BytesPerPixel: LongInt): Boolean; -begin - case BytesPerPixel of - 1: Result := PByte(PixelA)^ = PByte(PixelB)^; - 2: Result := PWord(PixelA)^ = PWord(PixelB)^; - 3: Result := (PWord(PixelA)^ = PWord(PixelB)^) and (PColor24Rec(PixelA).R = PColor24Rec(PixelB).R); - 4: Result := PLongWord(PixelA)^ = PLongWord(PixelB)^; - 6: Result := (PLongWord(PixelA)^ = PLongWord(PixelB)^) and (PColor48Rec(PixelA).R = PColor48Rec(PixelB).R); - 8: Result := PInt64(PixelA)^ = PInt64(PixelB)^; - 12: Result := (PFloatHelper(PixelA).Data = PFloatHelper(PixelB).Data) and - (PFloatHelper(PixelA).Data32 = PFloatHelper(PixelB).Data32); - 16: Result := (PFloatHelper(PixelA).Data = PFloatHelper(PixelB).Data) and - (PFloatHelper(PixelA).Data64 = PFloatHelper(PixelB).Data64); - else - Result := False; - end; -end; - -procedure TranslatePixel(SrcPixel, DstPixel: Pointer; SrcFormat, - DstFormat: TImageFormat; SrcPalette, DstPalette: PPalette32); -var - SrcInfo, DstInfo: PImageFormatInfo; - PixFP: TColorFPRec; -begin - SrcInfo := FInfos[SrcFormat]; - DstInfo := FInfos[DstFormat]; - - PixFP := GetPixelFPGeneric(SrcPixel, SrcInfo, SrcPalette); - SetPixelFPGeneric(DstPixel, DstInfo, DstPalette, PixFP); -end; - -procedure ClampFloatPixel(var PixF: TColorFPRec); -begin - if PixF.A > 1.0 then - PixF.A := 1.0; - if PixF.R > 1.0 then - PixF.R := 1.0; - if PixF.G > 1.0 then - PixF.G := 1.0; - if PixF.B > 1.0 then - PixF.B := 1.0; - - if PixF.A < 0.0 then - PixF.A := 0.0; - if PixF.R < 0.0 then - PixF.R := 0.0; - if PixF.G < 0.0 then - PixF.G := 0.0; - if PixF.B < 0.0 then - PixF.B := 0.0; -end; - -procedure ConvertToPixel32(SrcPix: PByte; DestPix: PColor32Rec; - const SrcInfo: TImageFormatInfo; SrcPalette: PPalette32); -begin - case SrcInfo.Format of - ifIndex8: - begin - DestPix^ := SrcPalette[SrcPix^]; - end; - ifGray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := 255; - end; - ifA8Gray8: - begin - DestPix.R := SrcPix^; - DestPix.G := SrcPix^; - DestPix.B := SrcPix^; - DestPix.A := PWordRec(SrcPix).High; - end; - ifGray16: - begin - DestPix.R := PWord(SrcPix)^ shr 8; - DestPix.G := DestPix.R; - DestPix.B := DestPix.R; - DestPix.A := 255; - end; - ifR8G8B8: - begin - DestPix.Color24Rec := PColor24Rec(SrcPix)^; - DestPix.A := 255; - end; - ifA8R8G8B8: - begin - DestPix^ := PColor32Rec(SrcPix)^; - end; - ifR16G16B16: - begin - DestPix.R := PColor48Rec(SrcPix).R shr 8; - DestPix.G := PColor48Rec(SrcPix).G shr 8; - DestPix.B := PColor48Rec(SrcPix).B shr 8; - DestPix.A := 255; - end; - ifA16R16G16B16: - begin - DestPix.R := PColor64Rec(SrcPix).R shr 8; - DestPix.G := PColor64Rec(SrcPix).G shr 8; - DestPix.B := PColor64Rec(SrcPix).B shr 8; - DestPix.A := PColor64Rec(SrcPix).A shr 8; - end; - else - DestPix^ := SrcInfo.GetPixel32(SrcPix, @SrcInfo, SrcPalette); - end; -end; - -procedure AddPadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height, - Bpp, WidthBytes: LongInt); -var - I, W: LongInt; -begin - W := Width * Bpp; - for I := 0 to Height - 1 do - Move(PByteArray(DataIn)[I * W], PByteArray(DataOut)[I * WidthBytes], W); -end; - -procedure RemovePadBytes(DataIn: Pointer; DataOut: Pointer; Width, Height, - Bpp, WidthBytes: LongInt); -var - I, W: LongInt; -begin - W := Width * Bpp; - for I := 0 to Height - 1 do - Move(PByteArray(DataIn)[I * WidthBytes], PByteArray(DataOut)[I * W], W); -end; - -procedure Convert1To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); -const - Mask1: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01); - Shift1: array[0..7] of Byte = (7, 6, 5, 4, 3, 2, 1, 0); - Scaling: Byte = 255; -var - X, Y: LongInt; - InArray: PByteArray absolute DataIn; -begin - for Y := 0 to Height - 1 do - for X := 0 to Width - 1 do - begin - DataOut^ := (InArray[Y * WidthBytes + X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; - if ScaleTo8Bits then - DataOut^ := DataOut^ * Scaling; - Inc(DataOut); - end; -end; - -procedure Convert2To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); -const - Mask2: array[0..3] of Byte = ($C0, $30, $0C, $03); - Shift2: array[0..3] of Byte = (6, 4, 2, 0); - Scaling: Byte = 85; -var - X, Y: LongInt; - InArray: PByteArray absolute DataIn; -begin - for Y := 0 to Height - 1 do - for X := 0 to Width - 1 do - begin - DataOut^ := (InArray[Y * WidthBytes + X shr 2] and Mask2[X and 3]) shr Shift2[X and 3]; - if ScaleTo8Bits then - DataOut^ := DataOut^ * Scaling; - Inc(DataOut); - end; -end; - -procedure Convert4To8(DataIn, DataOut: PByte; Width, Height, - WidthBytes: LongInt; ScaleTo8Bits: Boolean); -const - Mask4: array[0..1] of Byte = ($F0, $0F); - Shift4: array[0..1] of Byte = (4, 0); - Scaling: Byte = 17; -var - X, Y: LongInt; - InArray: PByteArray absolute DataIn; -begin - for Y := 0 to Height - 1 do - for X := 0 to Width - 1 do - begin - DataOut^ := (InArray[Y * WidthBytes + X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]; - if ScaleTo8Bits then - DataOut^ := DataOut^ * Scaling; - Inc(DataOut); - end; -end; - -function Has16BitImageAlpha(NumPixels: LongInt; Data: PWord): Boolean; -var - I: LongInt; -begin - Result := False; - for I := 0 to NumPixels - 1 do - begin - if Data^ >= 1 shl 15 then - begin - Result := True; - Exit; - end; - Inc(Data); - end; -end; - -function Has32BitImageAlpha(NumPixels: LongInt; Data: PLongWord): Boolean; -var - I: LongInt; -begin - Result := False; - for I := 0 to NumPixels - 1 do - begin - if Data^ >= 1 shl 24 then - begin - Result := True; - Exit; - end; - Inc(Data); - end; -end; - -function PaletteHasAlpha(Palette: PPalette32; PaletteEntries: Integer): Boolean; -var - I: Integer; -begin - for I := 0 to PaletteEntries - 1 do - begin - if Palette[I].A <> 255 then - begin - Result := True; - Exit; - end; - end; - Result := False; -end; - -function GetScanLine(ImageBits: Pointer; const FormatInfo: TImageFormatInfo; - LineWidth, Index: LongInt): Pointer; -var - LineBytes: LongInt; -begin - Assert(not FormatInfo.IsSpecial); - LineBytes := FormatInfo.GetPixelsSize(FormatInfo.Format, LineWidth, 1); - Result := @PByteArray(ImageBits)[Index * LineBytes]; -end; - -function IsImageFormatValid(Format: TImageFormat): Boolean; -begin - Result := FInfos[Format] <> nil; -end; - -const - HalfMin: Single = 5.96046448e-08; // Smallest positive half - HalfMinNorm: Single = 6.10351562e-05; // Smallest positive normalized half - HalfMax: Single = 65504.0; // Largest positive half - HalfEpsilon: Single = 0.00097656; // Smallest positive e for which half (1.0 + e) != half (1.0) - HalfNaN: THalfFloat = 65535; - HalfPosInf: THalfFloat = 31744; - HalfNegInf: THalfFloat = 64512; - - -{ - Half/Float conversions inspired by half class from OpenEXR library. - - Float (Pascal Single type) is an IEEE 754 single-precision - floating point number. - - Bit layout of Single: - - 31 (msb) - | - | 30 23 - | | | - | | | 22 0 (lsb) - | | | | | - X XXXXXXXX XXXXXXXXXXXXXXXXXXXXXXX - s e m - - Bit layout of half: - - 15 (msb) - | - | 14 10 - | | | - | | | 9 0 (lsb) - | | | | | - X XXXXX XXXXXXXXXX - s e m - - S is the sign-bit, e is the exponent and m is the significand (mantissa). -} - -function HalfToFloat(Half: THalfFloat): Single; -var - Dst, Sign, Mantissa: LongWord; - Exp: LongInt; -begin - // Extract sign, exponent, and mantissa from half number - Sign := Half shr 15; - Exp := (Half and $7C00) shr 10; - Mantissa := Half and 1023; - - if (Exp > 0) and (Exp < 31) then - begin - // Common normalized number - Exp := Exp + (127 - 15); - Mantissa := Mantissa shl 13; - Dst := (Sign shl 31) or (LongWord(Exp) shl 23) or Mantissa; - // Result := Power(-1, Sign) * Power(2, Exp - 15) * (1 + Mantissa / 1024); - end - else if (Exp = 0) and (Mantissa = 0) then - begin - // Zero - preserve sign - Dst := Sign shl 31; - end - else if (Exp = 0) and (Mantissa <> 0) then - begin - // Denormalized number - renormalize it - while (Mantissa and $00000400) = 0 do - begin - Mantissa := Mantissa shl 1; - Dec(Exp); - end; - Inc(Exp); - Mantissa := Mantissa and not $00000400; - // Now assemble normalized number - Exp := Exp + (127 - 15); - Mantissa := Mantissa shl 13; - Dst := (Sign shl 31) or (LongWord(Exp) shl 23) or Mantissa; - // Result := Power(-1, Sign) * Power(2, -14) * (Mantissa / 1024); - end - else if (Exp = 31) and (Mantissa = 0) then - begin - // +/- infinity - Dst := (Sign shl 31) or $7F800000; - end - else //if (Exp = 31) and (Mantisa <> 0) then - begin - // Not a number - preserve sign and mantissa - Dst := (Sign shl 31) or $7F800000 or (Mantissa shl 13); - end; - - // Reinterpret LongWord as Single - Result := PSingle(@Dst)^; -end; - -function FloatToHalf(Float: Single): THalfFloat; -var - Src: LongWord; - Sign, Exp, Mantissa: LongInt; -begin - Src := PLongWord(@Float)^; - // Extract sign, exponent, and mantissa from Single number - Sign := Src shr 31; - Exp := LongInt((Src and $7F800000) shr 23) - 127 + 15; - Mantissa := Src and $007FFFFF; - - if (Exp > 0) and (Exp < 30) then - begin - // Simple case - round the significand and combine it with the sign and exponent - Result := (Sign shl 15) or (Exp shl 10) or ((Mantissa + $00001000) shr 13); - end - else if Src = 0 then - begin - // Input float is zero - return zero - Result := 0; - end - else - begin - // Difficult case - lengthy conversion - if Exp <= 0 then - begin - if Exp < -10 then - begin - // Input float's value is less than HalfMin, return zero - Result := 0; - end - else - begin - // Float is a normalized Single whose magnitude is less than HalfNormMin. - // We convert it to denormalized half. - Mantissa := (Mantissa or $00800000) shr (1 - Exp); - // Round to nearest - if (Mantissa and $00001000) > 0 then - Mantissa := Mantissa + $00002000; - // Assemble Sign and Mantissa (Exp is zero to get denormalized number) - Result := (Sign shl 15) or (Mantissa shr 13); - end; - end - else if Exp = 255 - 127 + 15 then - begin - if Mantissa = 0 then - begin - // Input float is infinity, create infinity half with original sign - Result := (Sign shl 15) or $7C00; - end - else - begin - // Input float is NaN, create half NaN with original sign and mantissa - Result := (Sign shl 15) or $7C00 or (Mantissa shr 13); - end; - end - else - begin - // Exp is > 0 so input float is normalized Single - - // Round to nearest - if (Mantissa and $00001000) > 0 then - begin - Mantissa := Mantissa + $00002000; - if (Mantissa and $00800000) > 0 then - begin - Mantissa := 0; - Exp := Exp + 1; - end; - end; - - if Exp > 30 then - begin - // Exponent overflow - return infinity half - Result := (Sign shl 15) or $7C00; - end - else - // Assemble normalized half - Result := (Sign shl 15) or (Exp shl 10) or (Mantissa shr 13); - end; - end; -end; - -function ColorHalfToFloat(ColorHF: TColorHFRec): TColorFPRec; -begin - Result.A := HalfToFloat(ColorHF.A); - Result.R := HalfToFloat(ColorHF.R); - Result.G := HalfToFloat(ColorHF.G); - Result.B := HalfToFloat(ColorHF.B); -end; - -function ColorFloatToHalf(ColorFP: TColorFPRec): TColorHFRec; -begin - Result.A := FloatToHalf(ColorFP.A); - Result.R := FloatToHalf(ColorFP.R); - Result.G := FloatToHalf(ColorFP.G); - Result.B := FloatToHalf(ColorFP.B); -end; - -procedure VisualizePalette(Pal: PPalette32; Entries: Integer; out PalImage: TImageData); -var - I: Integer; - Pix: PColor32; -begin - InitImage(PalImage); - NewImage(Entries, 1, ifA8R8G8B8, PalImage); - Pix := PalImage.Bits; - for I := 0 to Entries - 1 do - begin - Pix^ := Pal[I].Color; - Inc(Pix); - end; -end; - - -{ Pixel readers/writers for different image formats } - -procedure ChannelGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Pix: TColor64Rec); -var - A, R, G, B: Byte; -begin - FillChar(Pix, SizeOf(Pix), 0); - // returns 64 bit color value with 16 bits for each channel - case SrcInfo.BytesPerPixel of - 1: - begin - PFGetARGB(SrcInfo.PixelFormat^, Src^, A, R, G, B); - Pix.A := A shl 8; - Pix.R := R shl 8; - Pix.G := G shl 8; - Pix.B := B shl 8; - end; - 2: - begin - PFGetARGB(SrcInfo.PixelFormat^, PWord(Src)^, A, R, G, B); - Pix.A := A shl 8; - Pix.R := R shl 8; - Pix.G := G shl 8; - Pix.B := B shl 8; - end; - 3: - with Pix do - begin - R := MulDiv(PColor24Rec(Src).R, 65535, 255); - G := MulDiv(PColor24Rec(Src).G, 65535, 255); - B := MulDiv(PColor24Rec(Src).B, 65535, 255); - end; - 4: - with Pix do - begin - A := MulDiv(PColor32Rec(Src).A, 65535, 255); - R := MulDiv(PColor32Rec(Src).R, 65535, 255); - G := MulDiv(PColor32Rec(Src).G, 65535, 255); - B := MulDiv(PColor32Rec(Src).B, 65535, 255); - end; - 6: - with Pix do - begin - R := PColor48Rec(Src).R; - G := PColor48Rec(Src).G; - B := PColor48Rec(Src).B; - end; - 8: Pix.Color := PColor64(Src)^; - end; - // if src has no alpha, we set it to max (otherwise we would have to - // test if dest has alpha or not in each ChannelToXXX function) - if not SrcInfo.HasAlphaChannel then - Pix.A := 65535; - - if SrcInfo.IsRBSwapped then - SwapValues(Pix.R, Pix.B); -end; - -procedure ChannelSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Pix: TColor64Rec); -var - PixW: TColor64Rec; -begin - PixW := Pix; - if DstInfo.IsRBSwapped then - SwapValues(PixW.R, PixW.B); - // Pix contains 64 bit color value with 16 bit for each channel - case DstInfo.BytesPerPixel of - 1: Dst^ := PFSetARGB(DstInfo.PixelFormat^, PixW.A shr 8, - PixW.R shr 8, PixW.G shr 8, PixW.B shr 8); - 2: PWord(Dst)^ := PFSetARGB(DstInfo.PixelFormat^, PixW.A shr 8, - PixW.R shr 8, PixW.G shr 8, PixW.B shr 8); - 3: - with PColor24Rec(Dst)^ do - begin - R := MulDiv(PixW.R, 255, 65535); - G := MulDiv(PixW.G, 255, 65535); - B := MulDiv(PixW.B, 255, 65535); - end; - 4: - with PColor32Rec(Dst)^ do - begin - A := MulDiv(PixW.A, 255, 65535); - R := MulDiv(PixW.R, 255, 65535); - G := MulDiv(PixW.G, 255, 65535); - B := MulDiv(PixW.B, 255, 65535); - end; - 6: - with PColor48Rec(Dst)^ do - begin - R := PixW.R; - G := PixW.G; - B := PixW.B; - end; - 8: PColor64(Dst)^ := PixW.Color; - end; -end; - -procedure GrayGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Gray: TColor64Rec; var Alpha: Word); -begin - FillChar(Gray, SizeOf(Gray), 0); - // Source alpha is scaled to 16 bits and stored in Alpha, - // grayscale value is scaled to 64 bits and stored in Gray - case SrcInfo.BytesPerPixel of - 1: Gray.A := MulDiv(Src^, 65535, 255); - 2: - if SrcInfo.HasAlphaChannel then - with PWordRec(Src)^ do - begin - Alpha := MulDiv(High, 65535, 255); - Gray.A := MulDiv(Low, 65535, 255); - end - else - Gray.A := PWord(Src)^; - 4: - if SrcInfo.HasAlphaChannel then - with PLongWordRec(Src)^ do - begin - Alpha := High; - Gray.A := Low; - end - else - with PLongWordRec(Src)^ do - begin - Gray.A := High; - Gray.R := Low; - end; - 8: Gray.Color := PColor64(Src)^; - end; - // if src has no alpha, we set it to max (otherwise we would have to - // test if dest has alpha or not in each GrayToXXX function) - if not SrcInfo.HasAlphaChannel then - Alpha := 65535; -end; - -procedure GraySetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Gray: TColor64Rec; Alpha: Word); -begin - // Gray contains grayscale value scaled to 64 bits, Alpha contains - // alpha value scaled to 16 bits - case DstInfo.BytesPerPixel of - 1: Dst^ := MulDiv(Gray.A, 255, 65535); - 2: - if DstInfo.HasAlphaChannel then - with PWordRec(Dst)^ do - begin - High := MulDiv(Alpha, 255, 65535); - Low := MulDiv(Gray.A, 255, 65535); - end - else - PWord(Dst)^ := Gray.A; - 4: - if DstInfo.HasAlphaChannel then - with PLongWordRec(Dst)^ do - begin - High := Alpha; - Low := Gray.A; - end - else - with PLongWordRec(Dst)^ do - begin - High := Gray.A; - Low := Gray.R; - end; - 8: PColor64(Dst)^ := Gray.Color; - end; -end; - -procedure FloatGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Pix: TColorFPRec); -var - PixHF: TColorHFRec; -begin - Assert(SrcInfo.BytesPerPixel in [2, 4, 8, 12, 16]); - - if SrcInfo.BytesPerPixel in [4, 12, 16] then - begin - // IEEE 754 single-precision channels - FillChar(Pix, SizeOf(Pix), 0); - case SrcInfo.BytesPerPixel of - 4: Pix.R := PSingle(Src)^; - 12: Pix.Color96Rec := PColor96FPRec(Src)^; - 16: Pix := PColorFPRec(Src)^; - end; - end - else - begin - // Half float channels - FillChar(PixHF, SizeOf(PixHF), 0); - case SrcInfo.BytesPerPixel of - 2: PixHF.R := PHalfFloat(Src)^; - 8: PixHF := PColorHFRec(Src)^; - end; - Pix := ColorHalfToFloat(PixHF); - end; - - // If src has no alpha, we set it to max (otherwise we would have to - // test if dest has alpha or not in each FloatToXXX function) - if not SrcInfo.HasAlphaChannel then - Pix.A := 1.0; - if SrcInfo.IsRBSwapped then - SwapValues(Pix.R, Pix.B); -end; - -procedure FloatSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - const Pix: TColorFPRec); -var - PixW: TColorFPRec; - PixHF: TColorHFRec; -begin - Assert(DstInfo.BytesPerPixel in [2, 4, 8, 12, 16]); - - PixW := Pix; - if DstInfo.IsRBSwapped then - SwapValues(PixW.R, PixW.B); - - if DstInfo.BytesPerPixel in [4, 12, 16] then - begin - case DstInfo.BytesPerPixel of - 4: PSingle(Dst)^ := PixW.R; - 12: PColor96FPRec(Dst)^:= PixW.Color96Rec; - 16: PColorFPRec(Dst)^ := PixW; - end; - end - else - begin - PixHF := ColorFloatToHalf(PixW); - case DstInfo.BytesPerPixel of - 2: PHalfFloat(Dst)^ := PixHF.R; - 8: PColorHFRec(Dst)^ := PixHF; - end; - end; -end; - -procedure IndexGetSrcPixel(Src: PByte; SrcInfo: PImageFormatInfo; - var Index: LongWord); -begin - case SrcInfo.BytesPerPixel of - 1: Index := Src^; - end; -end; - -procedure IndexSetDstPixel(Dst: PByte; DstInfo: PImageFormatInfo; - Index: LongWord); -begin - case DstInfo.BytesPerPixel of - 1: Dst^ := Byte(Index); - 2: PWord(Dst)^ := Word(Index); - 4: PLongWord(Dst)^ := Index; - end; -end; - - -{ Pixel readers/writers for 32bit and FP colors} - -function GetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; -var - Pix64: TColor64Rec; - PixF: TColorFPRec; - Alpha: Word; - Index: LongWord; -begin - if Info.Format = ifA8R8G8B8 then - begin - Result := PColor32Rec(Bits)^ - end - else if Info.Format = ifR8G8B8 then - begin - PColor24Rec(@Result)^ := PColor24Rec(Bits)^; - Result.A := $FF; - end - else if Info.IsFloatingPoint then - begin - FloatGetSrcPixel(Bits, Info, PixF); - Result.A := ClampToByte(Round(PixF.A * 255.0)); - Result.R := ClampToByte(Round(PixF.R * 255.0)); - Result.G := ClampToByte(Round(PixF.G * 255.0)); - Result.B := ClampToByte(Round(PixF.B * 255.0)); - end - else if Info.HasGrayChannel then - begin - GrayGetSrcPixel(Bits, Info, Pix64, Alpha); - Result.A := MulDiv(Alpha, 255, 65535); - Result.R := MulDiv(Pix64.A, 255, 65535); - Result.G := MulDiv(Pix64.A, 255, 65535); - Result.B := MulDiv(Pix64.A, 255, 65535); - end - else if Info.IsIndexed then - begin - IndexGetSrcPixel(Bits, Info, Index); - Result := Palette[Index]; - end - else - begin - ChannelGetSrcPixel(Bits, Info, Pix64); - Result.A := MulDiv(Pix64.A, 255, 65535); - Result.R := MulDiv(Pix64.R, 255, 65535); - Result.G := MulDiv(Pix64.G, 255, 65535); - Result.B := MulDiv(Pix64.B, 255, 65535); - end; -end; - -procedure SetPixel32Generic(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); -var - Pix64: TColor64Rec; - PixF: TColorFPRec; - Alpha: Word; - Index: LongWord; -begin - if Info.Format = ifA8R8G8B8 then - begin - PColor32Rec(Bits)^ := Color - end - else if Info.Format = ifR8G8B8 then - begin - PColor24Rec(Bits)^ := Color.Color24Rec; - end - else if Info.IsFloatingPoint then - begin - PixF.A := Color.A * OneDiv8Bit; - PixF.R := Color.R * OneDiv8Bit; - PixF.G := Color.G * OneDiv8Bit; - PixF.B := Color.B * OneDiv8Bit; - FloatSetDstPixel(Bits, Info, PixF); - end - else if Info.HasGrayChannel then - begin - Alpha := MulDiv(Color.A, 65535, 255); - Pix64.Color := 0; - Pix64.A := MulDiv(Round(GrayConv.R * Color.R + GrayConv.G * Color.G + - GrayConv.B * Color.B), 65535, 255); - GraySetDstPixel(Bits, Info, Pix64, Alpha); - end - else if Info.IsIndexed then - begin - Index := FindColor(Palette, Info.PaletteEntries, Color.Color); - IndexSetDstPixel(Bits, Info, Index); - end - else - begin - Pix64.A := MulDiv(Color.A, 65535, 255); - Pix64.R := MulDiv(Color.R, 65535, 255); - Pix64.G := MulDiv(Color.G, 65535, 255); - Pix64.B := MulDiv(Color.B, 65535, 255); - ChannelSetDstPixel(Bits, Info, Pix64); - end; -end; - -function GetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; -var - Pix32: TColor32Rec; - Pix64: TColor64Rec; - Alpha: Word; - Index: LongWord; -begin - if Info.IsFloatingPoint then - begin - FloatGetSrcPixel(Bits, Info, Result); - end - else if Info.HasGrayChannel then - begin - GrayGetSrcPixel(Bits, Info, Pix64, Alpha); - Result.A := Alpha * OneDiv16Bit; - Result.R := Pix64.A * OneDiv16Bit; - Result.G := Pix64.A * OneDiv16Bit; - Result.B := Pix64.A * OneDiv16Bit; - end - else if Info.IsIndexed then - begin - IndexGetSrcPixel(Bits, Info, Index); - Pix32 := Palette[Index]; - Result.A := Pix32.A * OneDiv8Bit; - Result.R := Pix32.R * OneDiv8Bit; - Result.G := Pix32.G * OneDiv8Bit; - Result.B := Pix32.B * OneDiv8Bit; - end - else - begin - ChannelGetSrcPixel(Bits, Info, Pix64); - Result.A := Pix64.A * OneDiv16Bit; - Result.R := Pix64.R * OneDiv16Bit; - Result.G := Pix64.G * OneDiv16Bit; - Result.B := Pix64.B * OneDiv16Bit; - end; -end; - -procedure SetPixelFPGeneric(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); -var - Pix32: TColor32Rec; - Pix64: TColor64Rec; - Alpha: Word; - Index: LongWord; -begin - if Info.IsFloatingPoint then - begin - FloatSetDstPixel(Bits, Info, Color); - end - else if Info.HasGrayChannel then - begin - Alpha := ClampToWord(Round(Color.A * 65535.0)); - Pix64.Color := 0; - Pix64.A := ClampToWord(Round((GrayConv.R * Color.R + GrayConv.G * Color.G + - GrayConv.B * Color.B) * 65535.0)); - GraySetDstPixel(Bits, Info, Pix64, Alpha); - end - else if Info.IsIndexed then - begin - Pix32.A := ClampToByte(Round(Color.A * 255.0)); - Pix32.R := ClampToByte(Round(Color.R * 255.0)); - Pix32.G := ClampToByte(Round(Color.G * 255.0)); - Pix32.B := ClampToByte(Round(Color.B * 255.0)); - Index := FindColor(Palette, Info.PaletteEntries, Pix32.Color); - IndexSetDstPixel(Bits, Info, Index); - end - else - begin - Pix64.A := ClampToWord(Round(Color.A * 65535.0)); - Pix64.R := ClampToWord(Round(Color.R * 65535.0)); - Pix64.G := ClampToWord(Round(Color.G * 65535.0)); - Pix64.B := ClampToWord(Round(Color.B * 65535.0)); - ChannelSetDstPixel(Bits, Info, Pix64); - end; -end; - - -{ Image format conversion functions } - -procedure ChannelToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Pix64: TColor64Rec; -begin - // two most common conversions (RGB->ARGB and ARGB->RGB for 24/32 bit - // images) are made separately from general ARGB conversion to - // make them faster - if (SrcInfo.BytesPerPixel = 3) and (DstInfo.BytesPerPixel = 4) then - for I := 0 to NumPixels - 1 do - begin - PColor24Rec(Dst)^ := PColor24Rec(Src)^; - if DstInfo.HasAlphaChannel then - PColor32Rec(Dst).A := 255; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - if (SrcInfo.BytesPerPixel = 4) and (DstInfo.BytesPerPixel = 3) then - for I := 0 to NumPixels - 1 do - begin - PColor24Rec(Dst)^ := PColor24Rec(Src)^; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - for I := 0 to NumPixels - 1 do - begin - // general ARGB conversion - ChannelGetSrcPixel(Src, SrcInfo, Pix64); - ChannelSetDstPixel(Dst, DstInfo, Pix64); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure ChannelToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Pix64: TColor64Rec; - Alpha: Word; -begin - // two most common conversions (R8G8B8->Gray8 nad A8R8G8B8->Gray8) - // are made separately from general conversions to make them faster - if (SrcInfo.BytesPerPixel in [3, 4]) and (DstInfo.Format = ifGray8) then - for I := 0 to NumPixels - 1 do - begin - Dst^ := Round(GrayConv.R * PColor24Rec(Src).R + GrayConv.G * PColor24Rec(Src).G + - GrayConv.B * PColor24Rec(Src).B); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - for I := 0 to NumPixels - 1 do - begin - ChannelGetSrcPixel(Src, SrcInfo, Pix64); - - // alpha is saved from source pixel to Alpha, - // Gray value is computed and set to highest word of Pix64 so - // Pix64.Color contains grayscale value scaled to 64 bits - Alpha := Pix64.A; - with GrayConv do - Pix64.A := Round(R * Pix64.R + G * Pix64.G + B * Pix64.B); - - GraySetDstPixel(Dst, DstInfo, Pix64, Alpha); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure ChannelToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Pix64: TColor64Rec; - PixF: TColorFPRec; -begin - for I := 0 to NumPixels - 1 do - begin - ChannelGetSrcPixel(Src, SrcInfo, Pix64); - - // floating point channel values are scaled to 1.0 - PixF.A := Pix64.A * OneDiv16Bit; - PixF.R := Pix64.R * OneDiv16Bit; - PixF.G := Pix64.G * OneDiv16Bit; - PixF.B := Pix64.B * OneDiv16Bit; - - FloatSetDstPixel(Dst, DstInfo, PixF); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure ChannelToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); -begin - ReduceColorsMedianCut(NumPixels, Src, Dst, SrcInfo, DstInfo, DstInfo.PaletteEntries, - GetOption(ImagingColorReductionMask), DstPal); -end; - -procedure GrayToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Gray: TColor64Rec; - Alpha: Word; -begin - // two most common conversions (Gray8->Gray16 nad Gray16->Gray8) - // are made separately from general conversions to make them faster - if (SrcInfo.Format = ifGray8) and (DstInfo.Format = ifGray16) then - begin - for I := 0 to NumPixels - 1 do - PWordArray(Dst)[I] := PByteArray(Src)[I] shl 8; - end - else - begin - if (DstInfo.Format = ifGray8) and (SrcInfo.Format = ifGray16) then - begin - for I := 0 to NumPixels - 1 do - PByteArray(Dst)[I] := PWordArray(Src)[I] shr 8; - end - else - for I := 0 to NumPixels - 1 do - begin - // general grayscale conversion - GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha); - GraySetDstPixel(Dst, DstInfo, Gray, Alpha); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; - end; -end; - -procedure GrayToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Pix64: TColor64Rec; - Alpha: Word; -begin - // two most common conversions (Gray8->R8G8B8 nad Gray8->A8R8G8B8) - // are made separately from general conversions to make them faster - if (DstInfo.BytesPerPixel in [3, 4]) and (SrcInfo.Format = ifGray8) then - for I := 0 to NumPixels - 1 do - begin - PColor24Rec(Dst).R := Src^; - PColor24Rec(Dst).G := Src^; - PColor24Rec(Dst).B := Src^; - if DstInfo.HasAlphaChannel then - PColor32Rec(Dst).A := $FF; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - for I := 0 to NumPixels - 1 do - begin - GrayGetSrcPixel(Src, SrcInfo, Pix64, Alpha); - - // most significant word of grayscale value is used for - // each channel and alpha channel is set to Alpha - Pix64.R := Pix64.A; - Pix64.G := Pix64.A; - Pix64.B := Pix64.A; - Pix64.A := Alpha; - - ChannelSetDstPixel(Dst, DstInfo, Pix64); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure GrayToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Gray: TColor64Rec; - PixF: TColorFPRec; - Alpha: Word; -begin - for I := 0 to NumPixels - 1 do - begin - GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha); - // most significant word of grayscale value is used for - // each channel and alpha channel is set to Alpha - // then all is scaled to 0..1 - PixF.R := Gray.A * OneDiv16Bit; - PixF.G := Gray.A * OneDiv16Bit; - PixF.B := Gray.A * OneDiv16Bit; - PixF.A := Alpha * OneDiv16Bit; - - FloatSetDstPixel(Dst, DstInfo, PixF); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure GrayToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); -var - I: LongInt; - Idx: LongWord; - Gray: TColor64Rec; - Alpha, Shift: Word; -begin - FillGrayscalePalette(DstPal, DstInfo.PaletteEntries); - Shift := Log2Int(DstInfo.PaletteEntries); - // most common conversion (Gray8->Index8) - // is made separately from general conversions to make it faster - if (SrcInfo.Format = ifGray8) and (DstInfo.Format = ifIndex8) then - for I := 0 to NumPixels - 1 do - begin - Dst^ := Src^; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - for I := 0 to NumPixels - 1 do - begin - // gray value is read from src and index to precomputed - // grayscale palette is computed and written to dst - // (we assume here that there will be no more than 65536 palette - // entries in dst format, gray value is shifted so the highest - // gray value match the highest possible index in palette) - GrayGetSrcPixel(Src, SrcInfo, Gray, Alpha); - Idx := Gray.A shr (16 - Shift); - IndexSetDstPixel(Dst, DstInfo, Idx); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure FloatToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - PixF: TColorFPRec; -begin - for I := 0 to NumPixels - 1 do - begin - // general floating point conversion - FloatGetSrcPixel(Src, SrcInfo, PixF); - FloatSetDstPixel(Dst, DstInfo, PixF); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure FloatToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - Pix64: TColor64Rec; - PixF: TColorFPRec; -begin - for I := 0 to NumPixels - 1 do - begin - FloatGetSrcPixel(Src, SrcInfo, PixF); - ClampFloatPixel(PixF); - - // floating point channel values are scaled to 1.0 - Pix64.A := ClampToWord(Round(PixF.A * 65535)); - Pix64.R := ClampToWord(Round(PixF.R * 65535)); - Pix64.G := ClampToWord(Round(PixF.G * 65535)); - Pix64.B := ClampToWord(Round(PixF.B * 65535)); - - ChannelSetDstPixel(Dst, DstInfo, Pix64); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure FloatToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo); -var - I: LongInt; - PixF: TColorFPRec; - Gray: TColor64Rec; - Alpha: Word; -begin - for I := 0 to NumPixels - 1 do - begin - FloatGetSrcPixel(Src, SrcInfo, PixF); - ClampFloatPixel(PixF); - - // alpha is saved from source pixel to Alpha, - // Gray value is computed and set to highest word of Pix64 so - // Pix64.Color contains grayscale value scaled to 64 bits - Alpha := ClampToWord(Round(PixF.A * 65535.0)); - Gray.A := ClampToWord(Round((GrayConv.R * PixF.R + GrayConv.G * PixF.G + - GrayConv.B * PixF.B) * 65535.0)); - - GraySetDstPixel(Dst, DstInfo, Gray, Alpha); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure FloatToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; DstPal: PPalette32); -begin - ReduceColorsMedianCut(NumPixels, Src, Dst, SrcInfo, DstInfo, DstInfo.PaletteEntries, - GetOption(ImagingColorReductionMask), DstPal); -end; - -procedure IndexToIndex(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal, DstPal: PPalette32); -var - I: LongInt; -begin - // there is only one indexed format now, so it is just a copy - for I := 0 to NumPixels - 1 do - begin - Dst^ := Src^; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; - for I := 0 to SrcInfo.PaletteEntries - 1 do - DstPal[I] := SrcPal[I]; -end; - -procedure IndexToChannel(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); -var - I: LongInt; - Pix64: TColor64Rec; - Idx: LongWord; -begin - // two most common conversions (Index8->R8G8B8 nad Index8->A8R8G8B8) - // are made separately from general conversions to make them faster - if (SrcInfo.Format = ifIndex8) and (DstInfo.Format in [ifR8G8B8, ifA8R8G8B8]) then - for I := 0 to NumPixels - 1 do - begin - with PColor24Rec(Dst)^ do - begin - R := SrcPal[Src^].R; - G := SrcPal[Src^].G; - B := SrcPal[Src^].B; - end; - if DstInfo.Format = ifA8R8G8B8 then - PColor32Rec(Dst).A := SrcPal[Src^].A; - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - else - for I := 0 to NumPixels - 1 do - begin - // index to palette is read from source and color - // is retrieved from palette entry. Color is then - // scaled to 16bits and written to dest - IndexGetSrcPixel(Src, SrcInfo, Idx); - with Pix64 do - begin - A := SrcPal[Idx].A shl 8; - R := SrcPal[Idx].R shl 8; - G := SrcPal[Idx].G shl 8; - B := SrcPal[Idx].B shl 8; - end; - ChannelSetDstPixel(Dst, DstInfo, Pix64); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure IndexToGray(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); -var - I: LongInt; - Gray: TColor64Rec; - Alpha: Word; - Idx: LongWord; -begin - // most common conversion (Index8->Gray8) - // is made separately from general conversions to make it faster - if (SrcInfo.Format = ifIndex8) and (DstInfo.Format = ifGray8) then - begin - for I := 0 to NumPixels - 1 do - begin - Dst^ := Round(GrayConv.R * SrcPal[Src^].R + GrayConv.G * SrcPal[Src^].G + - GrayConv.B * SrcPal[Src^].B); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end - end - else - for I := 0 to NumPixels - 1 do - begin - // index to palette is read from source and color - // is retrieved from palette entry. Color is then - // transformed to grayscale and assigned to the highest - // byte of Gray value - IndexGetSrcPixel(Src, SrcInfo, Idx); - Alpha := SrcPal[Idx].A shl 8; - Gray.A := MulDiv(Round(GrayConv.R * SrcPal[Idx].R + GrayConv.G * SrcPal[Idx].G + - GrayConv.B * SrcPal[Idx].B), 65535, 255); - GraySetDstPixel(Dst, DstInfo, Gray, Alpha); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - -procedure IndexToFloat(NumPixels: LongInt; Src, Dst: PByte; SrcInfo, - DstInfo: PImageFormatInfo; SrcPal: PPalette32); -var - I: LongInt; - Idx: LongWord; - PixF: TColorFPRec; -begin - for I := 0 to NumPixels - 1 do - begin - // index to palette is read from source and color - // is retrieved from palette entry. Color is then - // scaled to 0..1 and written to dest - IndexGetSrcPixel(Src, SrcInfo, Idx); - with PixF do - begin - A := SrcPal[Idx].A * OneDiv8Bit; - R := SrcPal[Idx].R * OneDiv8Bit; - G := SrcPal[Idx].G * OneDiv8Bit; - B := SrcPal[Idx].B * OneDiv8Bit; - end; - FloatSetDstPixel(Dst, DstInfo, PixF); - Inc(Src, SrcInfo.BytesPerPixel); - Inc(Dst, DstInfo.BytesPerPixel); - end; -end; - - -{ Special formats conversion functions } - -type - // DXT RGB color block - TDXTColorBlock = packed record - Color0, Color1: Word; - Mask: LongWord; - end; - PDXTColorBlock = ^TDXTColorBlock; - - // DXT explicit alpha for a block - TDXTAlphaBlockExp = packed record - Alphas: array[0..3] of Word; - end; - PDXTAlphaBlockExp = ^TDXTAlphaBlockExp; - - // DXT interpolated alpha for a block - TDXTAlphaBlockInt = packed record - Alphas: array[0..7] of Byte; - end; - PDXTAlphaBlockInt = ^TDXTAlphaBlockInt; - - TPixelInfo = record - Color: Word; - Alpha: Byte; - Orig: TColor32Rec; - end; - - TPixelBlock = array[0..15] of TPixelInfo; - -function DecodeCol(Color: Word): TColor32Rec; -{$IFDEF USE_INLINE} inline; {$ENDIF} -begin - Result.A := $FF; -{ Result.R := ((Color and $F800) shr 11) shl 3; - Result.G := ((Color and $07E0) shr 5) shl 2; - Result.B := (Color and $001F) shl 3;} - // this color expansion is slower but gives better results - Result.R := (Color shr 11) * 255 div 31; - Result.G := ((Color shr 5) and $3F) * 255 div 63; - Result.B := (Color and $1F) * 255 div 31; -end; - -procedure DecodeDXT1(SrcBits, DestBits: PByte; Width, Height: LongInt); -var - Sel, X, Y, I, J, K: LongInt; - Block: TDXTColorBlock; - Colors: array[0..3] of TColor32Rec; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - Block := PDXTColorBlock(SrcBits)^; - Inc(SrcBits, SizeOf(Block)); - // we read and decode endpoint colors - Colors[0] := DecodeCol(Block.Color0); - Colors[1] := DecodeCol(Block.Color1); - // and interpolate between them - if Block.Color0 > Block.Color1 then - begin - // interpolation for block without alpha - Colors[2].A := $FF; - Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3; - Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3; - Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3; - Colors[3].A := $FF; - Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3; - Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3; - Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3; - end - else - begin - // interpolation for block with alpha - Colors[2].A := $FF; - Colors[2].R := (Colors[0].R + Colors[1].R) shr 1; - Colors[2].G := (Colors[0].G + Colors[1].G) shr 1; - Colors[2].B := (Colors[0].B + Colors[1].B) shr 1; - Colors[3].A := 0; - Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3; - Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3; - Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3; - end; - - // we distribute the dxt block colors across the 4x4 block of the - // destination image accroding to the dxt block mask - K := 0; - for J := 0 to 3 do - for I := 0 to 3 do - begin - Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1); - if ((X shl 2 + I) < Width) and ((Y shl 2 + J) < Height) then - PPalette32(DestBits)[(Y shl 2 + J) * Width + X shl 2 + I] := - Colors[Sel]; - Inc(K); - end; - end; -end; - -procedure DecodeDXT3(SrcBits, DestBits: PByte; Width, Height: LongInt); -var - Sel, X, Y, I, J, K: LongInt; - Block: TDXTColorBlock; - AlphaBlock: TDXTAlphaBlockExp; - Colors: array[0..3] of TColor32Rec; - AWord: Word; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - AlphaBlock := PDXTAlphaBlockExp(SrcBits)^; - Inc(SrcBits, SizeOf(AlphaBlock)); - Block := PDXTColorBlock(SrcBits)^; - Inc(SrcBits, SizeOf(Block)); - // we read and decode endpoint colors - Colors[0] := DecodeCol(Block.Color0); - Colors[1] := DecodeCol(Block.Color1); - // and interpolate between them - Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3; - Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3; - Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3; - Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3; - Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3; - Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3; - - // we distribute the dxt block colors and alphas - // across the 4x4 block of the destination image - // accroding to the dxt block mask and alpha block - K := 0; - for J := 0 to 3 do - begin - AWord := AlphaBlock.Alphas[J]; - for I := 0 to 3 do - begin - Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1); - if (X shl 2 + I < Width) and (Y shl 2 + J < Height) then - begin - Colors[Sel].A := AWord and $0F; - Colors[Sel].A := Colors[Sel].A or (Colors[Sel].A shl 4); - PPalette32(DestBits)[(Y shl 2 + J) * Width + X shl 2 + I] := - Colors[Sel]; - end; - Inc(K); - AWord := AWord shr 4; - end; - end; - end; -end; - -procedure GetInterpolatedAlphas(var AlphaBlock: TDXTAlphaBlockInt); -begin - with AlphaBlock do - if Alphas[0] > Alphas[1] then - begin - // Interpolation of six alphas - Alphas[2] := (6 * Alphas[0] + 1 * Alphas[1] + 3) div 7; - Alphas[3] := (5 * Alphas[0] + 2 * Alphas[1] + 3) div 7; - Alphas[4] := (4 * Alphas[0] + 3 * Alphas[1] + 3) div 7; - Alphas[5] := (3 * Alphas[0] + 4 * Alphas[1] + 3) div 7; - Alphas[6] := (2 * Alphas[0] + 5 * Alphas[1] + 3) div 7; - Alphas[7] := (1 * Alphas[0] + 6 * Alphas[1] + 3) div 7; - end - else - begin - // Interpolation of four alphas, two alphas are set directly - Alphas[2] := (4 * Alphas[0] + 1 * Alphas[1] + 2) div 5; - Alphas[3] := (3 * Alphas[0] + 2 * Alphas[1] + 2) div 5; - Alphas[4] := (2 * Alphas[0] + 3 * Alphas[1] + 2) div 5; - Alphas[5] := (1 * Alphas[0] + 4 * Alphas[1] + 2) div 5; - Alphas[6] := 0; - Alphas[7] := $FF; - end; -end; - -procedure DecodeDXT5(SrcBits, DestBits: PByte; Width, Height: LongInt); -var - Sel, X, Y, I, J, K: LongInt; - Block: TDXTColorBlock; - AlphaBlock: TDXTAlphaBlockInt; - Colors: array[0..3] of TColor32Rec; - AMask: array[0..1] of LongWord; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - AlphaBlock := PDXTAlphaBlockInt(SrcBits)^; - Inc(SrcBits, SizeOf(AlphaBlock)); - Block := PDXTColorBlock(SrcBits)^; - Inc(SrcBits, SizeOf(Block)); - // we read and decode endpoint colors - Colors[0] := DecodeCol(Block.Color0); - Colors[1] := DecodeCol(Block.Color1); - // and interpolate between them - Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3; - Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3; - Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3; - Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3; - Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3; - Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3; - // 6 bit alpha mask is copied into two long words for - // easier usage - AMask[0] := PLongWord(@AlphaBlock.Alphas[2])^ and $00FFFFFF; - AMask[1] := PLongWord(@AlphaBlock.Alphas[5])^ and $00FFFFFF; - // alpha interpolation between two endpoint alphas - GetInterpolatedAlphas(AlphaBlock); - - // we distribute the dxt block colors and alphas - // across the 4x4 block of the destination image - // accroding to the dxt block mask and alpha block mask - K := 0; - for J := 0 to 3 do - for I := 0 to 3 do - begin - Sel := (Block.Mask and (3 shl (K shl 1))) shr (K shl 1); - if ((X shl 2 + I) < Width) and ((Y shl 2 + J) < Height) then - begin - Colors[Sel].A := AlphaBlock.Alphas[AMask[J shr 1] and 7]; - PPalette32(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] := - Colors[Sel]; - end; - Inc(K); - AMask[J shr 1] := AMask[J shr 1] shr 3; - end; - end; -end; - -procedure GetBlock(var Block: TPixelBlock; SrcBits: Pointer; XPos, YPos, - Width, Height: LongInt); -var - X, Y, I: LongInt; - Src: PColor32Rec; -begin - I := 0; - // 4x4 pixel block is filled with information about every - // pixel in the block: alpha, original color, 565 color - for Y := 0 to 3 do - for X := 0 to 3 do - begin - Src := @PPalette32(SrcBits)[(YPos shl 2 + Y) * Width + XPos shl 2 + X]; - Block[I].Color := ((Src.R shr 3) shl 11) or ((Src.G shr 2) shl 5) or - (Src.B shr 3); - Block[I].Alpha := Src.A; - Block[I].Orig := Src^; - Inc(I); - end; -end; - -function ColorDistance(const C1, C2: TColor32Rec): LongInt; -{$IFDEF USE_INLINE} inline;{$ENDIF} -begin - Result := (C1.R - C2.R) * (C1.R - C2.R) + - (C1.G - C2.G) * (C1.G - C2.G) + (C1.B - C2.B) * (C1.B - C2.B); -end; - -procedure GetEndpoints(const Block: TPixelBlock; var Ep0, Ep1: Word); -var - I, J, Farthest, Dist: LongInt; - Colors: array[0..15] of TColor32Rec; -begin - // we choose two colors from the pixel block which has the - // largest distance between them - for I := 0 to 15 do - Colors[I] := Block[I].Orig; - Farthest := -1; - for I := 0 to 15 do - for J := I + 1 to 15 do - begin - Dist := ColorDistance(Colors[I], Colors[J]); - if Dist > Farthest then - begin - Farthest := Dist; - Ep0 := Block[I].Color; - Ep1 := Block[J].Color; - end; - end; -end; - -procedure GetAlphaEndpoints(const Block: TPixelBlock; var Min, Max: Byte); -var - I: LongInt; -begin - Min := 255; - Max := 0; - // we choose the lowest and the highest alpha values - for I := 0 to 15 do - begin - if Block[I].Alpha < Min then - Min := Block[I].Alpha; - if Block[I].Alpha > Max then - Max := Block[I].Alpha; - end; -end; - -procedure FixEndpoints(var Ep0, Ep1: Word; HasAlpha: Boolean); -var - Temp: Word; -begin - // if dxt block has alpha information, Ep0 must be smaller - // than Ep1, if the block has no alpha Ep1 must be smaller - if HasAlpha then - begin - if Ep0 > Ep1 then - begin - Temp := Ep0; - Ep0 := Ep1; - Ep1 := Temp; - end; - end - else - if Ep0 < Ep1 then - begin - Temp := Ep0; - Ep0 := Ep1; - Ep1 := Temp; - end; -end; - -function GetColorMask(Ep0, Ep1: Word; NumCols: LongInt; - const Block: TPixelBlock): LongWord; -var - I, J, Closest, Dist: LongInt; - Colors: array[0..3] of TColor32Rec; - Mask: array[0..15] of Byte; -begin - // we decode endpoint colors - Colors[0] := DecodeCol(Ep0); - Colors[1] := DecodeCol(Ep1); - // and interpolate colors between (3 for DXT1 with alpha, 4 for the others) - if NumCols = 3 then - begin - Colors[2].R := (Colors[0].R + Colors[1].R) shr 1; - Colors[2].G := (Colors[0].G + Colors[1].G) shr 1; - Colors[2].B := (Colors[0].B + Colors[1].B) shr 1; - Colors[3].R := (Colors[0].R + Colors[1].R) shr 1; - Colors[3].G := (Colors[0].G + Colors[1].G) shr 1; - Colors[3].B := (Colors[0].B + Colors[1].B) shr 1; - end - else - begin - Colors[2].R := (Colors[0].R shl 1 + Colors[1].R + 1) div 3; - Colors[2].G := (Colors[0].G shl 1 + Colors[1].G + 1) div 3; - Colors[2].B := (Colors[0].B shl 1 + Colors[1].B + 1) div 3; - Colors[3].R := (Colors[0].R + Colors[1].R shl 1 + 1) div 3; - Colors[3].G := (Colors[0].G + Colors[1].G shl 1 + 1) div 3; - Colors[3].B := (Colors[0].B + Colors[1].B shl 1 + 1) div 3; - end; - - for I := 0 to 15 do - begin - // this is only for DXT1 with alpha - if (Block[I].Alpha < 128) and (NumCols = 3) then - begin - Mask[I] := 3; - Continue; - end; - // for each of the 16 input pixels the nearest color in the - // 4 dxt colors is found - Closest := MaxInt; - for J := 0 to NumCols - 1 do - begin - Dist := ColorDistance(Block[I].Orig, Colors[J]); - if Dist < Closest then - begin - Closest := Dist; - Mask[I] := J; - end; - end; - end; - - Result := 0; - for I := 0 to 15 do - Result := Result or (Mask[I] shl (I shl 1)); -end; - -procedure GetAlphaMask(Ep0, Ep1: Byte; var Block: TPixelBlock; Mask: PByteArray); -var - Alphas: array[0..7] of Byte; - M: array[0..15] of Byte; - I, J, Closest, Dist: LongInt; -begin - Alphas[0] := Ep0; - Alphas[1] := Ep1; - // interpolation between two given alpha endpoints - // (I use 6 interpolated values mode) - Alphas[2] := (6 * Alphas[0] + 1 * Alphas[1] + 3) div 7; - Alphas[3] := (5 * Alphas[0] + 2 * Alphas[1] + 3) div 7; - Alphas[4] := (4 * Alphas[0] + 3 * Alphas[1] + 3) div 7; - Alphas[5] := (3 * Alphas[0] + 4 * Alphas[1] + 3) div 7; - Alphas[6] := (2 * Alphas[0] + 5 * Alphas[1] + 3) div 7; - Alphas[7] := (1 * Alphas[0] + 6 * Alphas[1] + 3) div 7; - - // the closest interpolated values for each of the input alpha - // is found - for I := 0 to 15 do - begin - Closest := MaxInt; - for J := 0 to 7 do - begin - Dist := Abs(Alphas[J] - Block[I].Alpha); - if Dist < Closest then - begin - Closest := Dist; - M[I] := J; - end; - end; - end; - - Mask[0] := M[0] or (M[1] shl 3) or ((M[2] and 3) shl 6); - Mask[1] := ((M[2] and 4) shr 2) or (M[3] shl 1) or (M[4] shl 4) or - ((M[5] and 1) shl 7); - Mask[2] := ((M[5] and 6) shr 1) or (M[6] shl 2) or (M[7] shl 5); - Mask[3] := M[8] or (M[9] shl 3) or ((M[10] and 3) shl 6); - Mask[4] := ((M[10] and 4) shr 2) or (M[11] shl 1) or (M[12] shl 4) or - ((M[13] and 1) shl 7); - Mask[5] := ((M[13] and 6) shr 1) or (M[14] shl 2) or (M[15] shl 5); -end; - - -procedure EncodeDXT1(SrcBits: PByte; DestBits: PByte; Width, Height: LongInt); -var - X, Y, I: LongInt; - HasAlpha: Boolean; - Block: TDXTColorBlock; - Pixels: TPixelBlock; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - GetBlock(Pixels, SrcBits, X, Y, Width, Height); - HasAlpha := False; - for I := 0 to 15 do - if Pixels[I].Alpha < 128 then - begin - HasAlpha := True; - Break; - end; - GetEndpoints(Pixels, Block.Color0, Block.Color1); - FixEndpoints(Block.Color0, Block.Color1, HasAlpha); - if HasAlpha then - Block.Mask := GetColorMask(Block.Color0, Block.Color1, 3, Pixels) - else - Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels); - PDXTColorBlock(DestBits)^ := Block; - Inc(DestBits, SizeOf(Block)); - end; -end; - -procedure EncodeDXT3(SrcBits: Pointer; DestBits: PByte; Width, Height: LongInt); -var - X, Y, I: LongInt; - Block: TDXTColorBlock; - AlphaBlock: TDXTAlphaBlockExp; - Pixels: TPixelBlock; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - GetBlock(Pixels, SrcBits, X, Y, Width, Height); - for I := 0 to 7 do - PByteArray(@AlphaBlock.Alphas)[I] := - (Pixels[I shl 1].Alpha shr 4) or ((Pixels[I shl 1 + 1].Alpha shr 4) shl 4); - GetEndpoints(Pixels, Block.Color0, Block.Color1); - FixEndpoints(Block.Color0, Block.Color1, False); - Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels); - PDXTAlphaBlockExp(DestBits)^ := AlphaBlock; - Inc(DestBits, SizeOf(AlphaBlock)); - PDXTColorBlock(DestBits)^ := Block; - Inc(DestBits, SizeOf(Block)); - end; -end; - -procedure EncodeDXT5(SrcBits: Pointer; DestBits: PByte; Width, Height: LongInt); -var - X, Y: LongInt; - Block: TDXTColorBlock; - AlphaBlock: TDXTAlphaBlockInt; - Pixels: TPixelBlock; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - GetBlock(Pixels, SrcBits, X, Y, Width, Height); - GetEndpoints(Pixels, Block.Color0, Block.Color1); - FixEndpoints(Block.Color0, Block.Color1, False); - Block.Mask := GetColorMask(Block.Color0, Block.Color1, 4, Pixels); - GetAlphaEndPoints(Pixels, AlphaBlock.Alphas[1], AlphaBlock.Alphas[0]); - GetAlphaMask(AlphaBlock.Alphas[0], AlphaBlock.Alphas[1], Pixels, - PByteArray(@AlphaBlock.Alphas[2])); - PDXTAlphaBlockInt(DestBits)^ := AlphaBlock; - Inc(DestBits, SizeOf(AlphaBlock)); - PDXTColorBlock(DestBits)^ := Block; - Inc(DestBits, SizeOf(Block)); - end; -end; - -type - TBTCBlock = packed record - MLower, MUpper: Byte; - BitField: Word; - end; - PBTCBlock = ^TBTCBlock; - -procedure EncodeBTC(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer); -var - X, Y, I, J: Integer; - Block: TBTCBlock; - M, MLower, MUpper, K: Integer; - Pixels: array[0..15] of Byte; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - M := 0; - MLower := 0; - MUpper := 0; - FillChar(Block, SizeOf(Block), 0); - K := 0; - - // Store 4x4 pixels and compute average, lower, and upper intensity levels - for I := 0 to 3 do - for J := 0 to 3 do - begin - Pixels[K] := PByteArray(SrcBits)[(Y shl 2 + I) * Width + X shl 2 + J]; - Inc(M, Pixels[K]); - Inc(K); - end; - - M := M div 16; - K := 0; - - // Now compute upper and lower levels, number of upper pixels, - // and update bit field (1 when pixel is above avg. level M) - for I := 0 to 15 do - begin - if Pixels[I] > M then - begin - Inc(MUpper, Pixels[I]); - Inc(K); - Block.BitField := Block.BitField or (1 shl I); - end - else - Inc(MLower, Pixels[I]); - end; - - // Scale levels and save them to block - if K > 0 then - Block.MUpper := ClampToByte(MUpper div K) - else - Block.MUpper := 0; - Block.MLower := ClampToByte(MLower div (16 - K)); - - // Finally save block to dest data - PBTCBlock(DestBits)^ := Block; - Inc(DestBits, SizeOf(Block)); - end; -end; - -procedure GetOneChannelBlock(var Block: TPixelBlock; SrcBits: Pointer; XPos, YPos, - Width, Height, BytesPP, ChannelIdx: Integer); -var - X, Y, I: Integer; - Src: PByte; -begin - I := 0; - // 4x4 pixel block is filled with information about every pixel in the block, - // but only one channel value is stored in Alpha field - for Y := 0 to 3 do - for X := 0 to 3 do - begin - Src := @PByteArray(SrcBits)[(YPos * 4 + Y) * Width * BytesPP + - (XPos * 4 + X) * BytesPP + ChannelIdx]; - Block[I].Alpha := Src^; - Inc(I); - end; -end; - -procedure EncodeATI1N(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer); -var - X, Y: Integer; - AlphaBlock: TDXTAlphaBlockInt; - Pixels: TPixelBlock; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - // Encode one channel - GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 1, 0); - GetAlphaEndPoints(Pixels, AlphaBlock.Alphas[1], AlphaBlock.Alphas[0]); - GetAlphaMask(AlphaBlock.Alphas[0], AlphaBlock.Alphas[1], Pixels, - PByteArray(@AlphaBlock.Alphas[2])); - PDXTAlphaBlockInt(DestBits)^ := AlphaBlock; - Inc(DestBits, SizeOf(AlphaBlock)); - end; -end; - -procedure EncodeATI2N(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer); -var - X, Y: Integer; - AlphaBlock: TDXTAlphaBlockInt; - Pixels: TPixelBlock; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - // Encode Red/X channel - GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 4, ChannelRed); - GetAlphaEndPoints(Pixels, AlphaBlock.Alphas[1], AlphaBlock.Alphas[0]); - GetAlphaMask(AlphaBlock.Alphas[0], AlphaBlock.Alphas[1], Pixels, - PByteArray(@AlphaBlock.Alphas[2])); - PDXTAlphaBlockInt(DestBits)^ := AlphaBlock; - Inc(DestBits, SizeOf(AlphaBlock)); - // Encode Green/Y channel - GetOneChannelBlock(Pixels, SrcBits, X, Y, Width, Height, 4, ChannelGreen); - GetAlphaEndPoints(Pixels, AlphaBlock.Alphas[1], AlphaBlock.Alphas[0]); - GetAlphaMask(AlphaBlock.Alphas[0], AlphaBlock.Alphas[1], Pixels, - PByteArray(@AlphaBlock.Alphas[2])); - PDXTAlphaBlockInt(DestBits)^ := AlphaBlock; - Inc(DestBits, SizeOf(AlphaBlock)); - end; -end; - -procedure EncodeBinary(SrcBits: Pointer; DestBits: PByte; Width, Height: Integer); -var - Src: PByte absolute SrcBits; - Bitmap: PByteArray absolute DestBits; - X, Y, WidthBytes: Integer; - PixelTresholded, Treshold: Byte; -begin - Treshold := ClampToByte(GetOption(ImagingBinaryTreshold)); - WidthBytes := (Width + 7) div 8; - - for Y := 0 to Height - 1 do - for X := 0 to Width - 1 do - begin - if Src^ > Treshold then - PixelTresholded := 255 - else - PixelTresholded := 0; - - Bitmap[Y * WidthBytes + X div 8] := Bitmap[Y * WidthBytes + X div 8] or // OR current value of byte with following: - (PixelTresholded and 1) // To make 1 from 255, 0 remains 0 - shl (7 - (X mod 8)); // Put current bit to proper place in byte - - Inc(Src); - end; -end; - -procedure DecodeBTC(SrcBits, DestBits: PByte; Width, Height: Integer); -var - X, Y, I, J, K: Integer; - Block: TBTCBlock; - Dest: PByte; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - Block := PBTCBlock(SrcBits)^; - Inc(SrcBits, SizeOf(Block)); - K := 0; - - // Just write MUpper when there is '1' in bit field and MLower - // when there is '0' - for I := 0 to 3 do - for J := 0 to 3 do - begin - Dest := @PByteArray(DestBits)[(Y shl 2 + I) * Width + X shl 2 + J]; - if Block.BitField and (1 shl K) <> 0 then - Dest^ := Block.MUpper - else - Dest^ := Block.MLower; - Inc(K); - end; - end; -end; - -procedure DecodeATI1N(SrcBits, DestBits: PByte; Width, Height: Integer); -var - X, Y, I, J: Integer; - AlphaBlock: TDXTAlphaBlockInt; - AMask: array[0..1] of LongWord; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - AlphaBlock := PDXTAlphaBlockInt(SrcBits)^; - Inc(SrcBits, SizeOf(AlphaBlock)); - // 6 bit alpha mask is copied into two long words for - // easier usage - AMask[0] := PLongWord(@AlphaBlock.Alphas[2])^ and $00FFFFFF; - AMask[1] := PLongWord(@AlphaBlock.Alphas[5])^ and $00FFFFFF; - // alpha interpolation between two endpoint alphas - GetInterpolatedAlphas(AlphaBlock); - - // we distribute the dxt block alphas - // across the 4x4 block of the destination image - for J := 0 to 3 do - for I := 0 to 3 do - begin - PByteArray(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] := - AlphaBlock.Alphas[AMask[J shr 1] and 7]; - AMask[J shr 1] := AMask[J shr 1] shr 3; - end; - end; -end; - -procedure DecodeATI2N(SrcBits, DestBits: PByte; Width, Height: Integer); -var - X, Y, I, J: Integer; - Color: TColor32Rec; - AlphaBlock1, AlphaBlock2: TDXTAlphaBlockInt; - AMask1: array[0..1] of LongWord; - AMask2: array[0..1] of LongWord; -begin - for Y := 0 to Height div 4 - 1 do - for X := 0 to Width div 4 - 1 do - begin - // Read the first alpha block and get masks - AlphaBlock1 := PDXTAlphaBlockInt(SrcBits)^; - Inc(SrcBits, SizeOf(AlphaBlock1)); - AMask1[0] := PLongWord(@AlphaBlock1.Alphas[2])^ and $00FFFFFF; - AMask1[1] := PLongWord(@AlphaBlock1.Alphas[5])^ and $00FFFFFF; - // Read the secind alpha block and get masks - AlphaBlock2 := PDXTAlphaBlockInt(SrcBits)^; - Inc(SrcBits, SizeOf(AlphaBlock2)); - AMask2[0] := PLongWord(@AlphaBlock2.Alphas[2])^ and $00FFFFFF; - AMask2[1] := PLongWord(@AlphaBlock2.Alphas[5])^ and $00FFFFFF; - // alpha interpolation between two endpoint alphas - GetInterpolatedAlphas(AlphaBlock1); - GetInterpolatedAlphas(AlphaBlock2); - - Color.A := $FF; - Color.B := 0; - - // Distribute alpha block values across 4x4 pixel block, - // first alpha block represents Red channel, second is Green. - for J := 0 to 3 do - for I := 0 to 3 do - begin - Color.R := AlphaBlock1.Alphas[AMask1[J shr 1] and 7]; - Color.G := AlphaBlock2.Alphas[AMask2[J shr 1] and 7]; - PColor32RecArray(DestBits)[(Y shl 2 + J) * Width + (X shl 2 + I)] := Color; - AMask1[J shr 1] := AMask1[J shr 1] shr 3; - AMask2[J shr 1] := AMask2[J shr 1] shr 3; - end; - end; -end; - -procedure DecodeBinary(SrcBits, DestBits: PByte; Width, Height: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} -begin - Convert1To8(SrcBits, DestBits, Width, Height, (Width + 7) div 8, True); -end; - -procedure SpecialToUnSpecial(const SrcImage: TImageData; DestBits: Pointer; - SpecialFormat: TImageFormat); -begin - case SpecialFormat of - ifDXT1: DecodeDXT1(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifDXT3: DecodeDXT3(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifDXT5: DecodeDXT5(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifBTC: DecodeBTC (SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifATI1N: DecodeATI1N(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifATI2N: DecodeATI2N(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - ifBinary: DecodeBinary(SrcImage.Bits, DestBits, SrcImage.Width, SrcImage.Height); - end; -end; - -procedure UnSpecialToSpecial(SrcBits: Pointer; const DestImage: TImageData; - SpecialFormat: TImageFormat); -begin - case SpecialFormat of - ifDXT1: EncodeDXT1(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifDXT3: EncodeDXT3(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifDXT5: EncodeDXT5(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifBTC: EncodeBTC (SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifATI1N: EncodeATI1N(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifATI2N: EncodeATI2N(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - ifBinary: EncodeBinary(SrcBits, DestImage.Bits, DestImage.Width, DestImage.Height); - end; -end; - -procedure ConvertSpecial(var Image: TImageData; - SrcInfo, DstInfo: PImageFormatInfo); -var - WorkImage: TImageData; - - procedure CheckSize(var Img: TImageData; Info: PImageFormatInfo); - var - Width, Height: Integer; - begin - Width := Img.Width; - Height := Img.Height; - DstInfo.CheckDimensions(Info.Format, Width, Height); - ResizeImage(Img, Width, Height, rfNearest); - end; - -begin - if SrcInfo.IsSpecial and DstInfo.IsSpecial then - begin - // Convert source to nearest 'normal' format - InitImage(WorkImage); - NewImage(Image.Width, Image.Height, SrcInfo.SpecialNearestFormat, WorkImage); - SpecialToUnSpecial(Image, WorkImage.Bits, SrcInfo.Format); - FreeImage(Image); - // Make sure output of SpecialToUnSpecial is the same as input of - // UnSpecialToSpecial - if SrcInfo.SpecialNearestFormat <> DstInfo.SpecialNearestFormat then - ConvertImage(WorkImage, DstInfo.SpecialNearestFormat); - // Convert work image to dest special format - CheckSize(WorkImage, DstInfo); - NewImage(WorkImage.Width, WorkImage.Height, DstInfo.Format, Image); - UnSpecialToSpecial(WorkImage.Bits, Image, DstInfo.Format); - FreeImage(WorkImage); - end - else if SrcInfo.IsSpecial and not DstInfo.IsSpecial then - begin - // Convert source to nearest 'normal' format - InitImage(WorkImage); - NewImage(Image.Width, Image.Height, SrcInfo.SpecialNearestFormat, WorkImage); - SpecialToUnSpecial(Image, WorkImage.Bits, SrcInfo.Format); - FreeImage(Image); - // Now convert to dest format - ConvertImage(WorkImage, DstInfo.Format); - Image := WorkImage; - end - else if not SrcInfo.IsSpecial and DstInfo.IsSpecial then - begin - // Convert source to nearest format - WorkImage := Image; - ConvertImage(WorkImage, DstInfo.SpecialNearestFormat); - // Now convert from nearest to dest - CheckSize(WorkImage, DstInfo); - InitImage(Image); - NewImage(WorkImage.Width, WorkImage.Height, DstInfo.Format, Image); - UnSpecialToSpecial(WorkImage.Bits, Image, DstInfo.Format); - FreeImage(WorkImage); - end; -end; - -function GetStdPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - if FInfos[Format] <> nil then - Result := Width * Height * FInfos[Format].BytesPerPixel - else - Result := 0; -end; - -procedure CheckStdDimensions(Format: TImageFormat; var Width, Height: LongInt); -begin -end; - -function GetDXTPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - // DXT can be used only for images with dimensions that are - // multiples of four - CheckDXTDimensions(Format, Width, Height); - Result := Width * Height; - if Format in [ifDXT1, ifATI1N] then - Result := Result div 2; -end; - -procedure CheckDXTDimensions(Format: TImageFormat; var Width, Height: LongInt); -begin - // DXT image dimensions must be multiples of four - Width := (Width + 3) and not 3; // div 4 * 4; - Height := (Height + 3) and not 3; // div 4 * 4; -end; - -function GetBTCPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - // BTC can be used only for images with dimensions that are - // multiples of four - CheckDXTDimensions(Format, Width, Height); - Result := Width * Height div 4; // 2bits/pixel -end; - -function GetBinaryPixelsSize(Format: TImageFormat; Width, Height: LongInt): LongInt; -begin - // Binary images are aligned on BYTE boundary - Result := ((Width + 7) div 8) * Height; // 1bit/pixel -end; - -{ Optimized pixel readers/writers for 32bit and FP colors to be stored in TImageFormatInfo } - -function GetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; -begin - Result.Color := PLongWord(Bits)^; -end; - -procedure SetPixel32ifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); -begin - PLongWord(Bits)^ := Color.Color; -end; - -function GetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; -begin - Result.A := PColor32Rec(Bits).A * OneDiv8Bit; - Result.R := PColor32Rec(Bits).R * OneDiv8Bit; - Result.G := PColor32Rec(Bits).G * OneDiv8Bit; - Result.B := PColor32Rec(Bits).B * OneDiv8Bit; -end; - -procedure SetPixelFPifA8R8G8B8(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); -begin - PColor32Rec(Bits).A := ClampToByte(Round(Color.A * 255.0)); - PColor32Rec(Bits).R := ClampToByte(Round(Color.R * 255.0)); - PColor32Rec(Bits).G := ClampToByte(Round(Color.G * 255.0)); - PColor32Rec(Bits).B := ClampToByte(Round(Color.B * 255.0)); -end; - -function GetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColor32Rec; -begin - case Info.Format of - ifR8G8B8, ifX8R8G8B8: - begin - Result.A := $FF; - PColor24Rec(@Result)^ := PColor24Rec(Bits)^; - end; - ifGray8, ifA8Gray8: - begin - if Info.HasAlphaChannel then - Result.A := PWordRec(Bits).High - else - Result.A := $FF; - Result.R := PWordRec(Bits).Low; - Result.G := PWordRec(Bits).Low; - Result.B := PWordRec(Bits).Low; - end; - end; -end; - -procedure SetPixel32Channel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColor32Rec); -begin - case Info.Format of - ifR8G8B8, ifX8R8G8B8: - begin - PColor24Rec(Bits)^ := PColor24Rec(@Color)^; - end; - ifGray8, ifA8Gray8: - begin - if Info.HasAlphaChannel then - PWordRec(Bits).High := Color.A; - PWordRec(Bits).Low := Round(GrayConv.R * Color.R + GrayConv.G * Color.G + - GrayConv.B * Color.B); - end; - end; -end; - -function GetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; -begin - case Info.Format of - ifR8G8B8, ifX8R8G8B8: - begin - Result.A := 1.0; - Result.R := PColor24Rec(Bits).R * OneDiv8Bit; - Result.G := PColor24Rec(Bits).G * OneDiv8Bit; - Result.B := PColor24Rec(Bits).B * OneDiv8Bit; - end; - ifGray8, ifA8Gray8: - begin - if Info.HasAlphaChannel then - Result.A := PWordRec(Bits).High * OneDiv8Bit - else - Result.A := 1.0; - Result.R := PWordRec(Bits).Low * OneDiv8Bit; - Result.G := PWordRec(Bits).Low * OneDiv8Bit; - Result.B := PWordRec(Bits).Low * OneDiv8Bit; - end; - end; -end; - -procedure SetPixelFPChannel8Bit(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); -begin - case Info.Format of - ifR8G8B8, ifX8R8G8B8: - begin - PColor24Rec(Bits).R := ClampToByte(Round(Color.R * 255.0)); - PColor24Rec(Bits).G := ClampToByte(Round(Color.G * 255.0)); - PColor24Rec(Bits).B := ClampToByte(Round(Color.B * 255.0)); - end; - ifGray8, ifA8Gray8: - begin - if Info.HasAlphaChannel then - PWordRec(Bits).High := ClampToByte(Round(Color.A * 255.0)); - PWordRec(Bits).Low := ClampToByte(Round((GrayConv.R * Color.R + GrayConv.G * Color.G + - GrayConv.B * Color.B) * 255.0)); - end; - end; -end; - -function GetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32): TColorFPRec; -begin - case Info.Format of - ifA32R32G32B32F, ifA32B32G32R32F: - begin - Result := PColorFPRec(Bits)^; - end; - ifR32G32B32F, ifB32G32R32F: - begin - Result.A := 1.0; - Result.Color96Rec := PColor96FPRec(Bits)^; - end; - ifR32F: - begin - Result.A := 1.0; - Result.R := PSingle(Bits)^; - Result.G := 0.0; - Result.B := 0.0; - end; - end; - if Info.IsRBSwapped then - SwapValues(Result.R, Result.B); -end; - -procedure SetPixelFPFloat32(Bits: Pointer; Info: PImageFormatInfo; Palette: PPalette32; const Color: TColorFPRec); -begin - case Info.Format of - ifA32R32G32B32F, ifA32B32G32R32F: - begin - PColorFPRec(Bits)^ := Color; - end; - ifR32G32B32F, ifB32G32R32F: - begin - PColor96FPRec(Bits)^ := Color.Color96Rec; - end; - ifR32F: - begin - PSingle(Bits)^ := Color.R; - end; - end; - if Info.IsRBSwapped then - SwapValues(PColor96FPRec(Bits).R, PColor96FPRec(Bits).B); -end; - -initialization - // Initialize default sampling filter function pointers and radii - SamplingFilterFunctions[sfNearest] := FilterNearest; - SamplingFilterFunctions[sfLinear] := FilterLinear; - SamplingFilterFunctions[sfCosine] := FilterCosine; - SamplingFilterFunctions[sfHermite] := FilterHermite; - SamplingFilterFunctions[sfQuadratic] := FilterQuadratic; - SamplingFilterFunctions[sfGaussian] := FilterGaussian; - SamplingFilterFunctions[sfSpline] := FilterSpline; - SamplingFilterFunctions[sfLanczos] := FilterLanczos; - SamplingFilterFunctions[sfMitchell] := FilterMitchell; - SamplingFilterFunctions[sfCatmullRom] := FilterCatmullRom; - SamplingFilterRadii[sfNearest] := 1.0; - SamplingFilterRadii[sfLinear] := 1.0; - SamplingFilterRadii[sfCosine] := 1.0; - SamplingFilterRadii[sfHermite] := 1.0; - SamplingFilterRadii[sfQuadratic] := 1.5; - SamplingFilterRadii[sfGaussian] := 1.25; - SamplingFilterRadii[sfSpline] := 2.0; - SamplingFilterRadii[sfLanczos] := 3.0; - SamplingFilterRadii[sfMitchell] := 2.0; - SamplingFilterRadii[sfCatmullRom] := 2.0; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 Changes/Bug Fixes ------------------------------------- - - Added ConvertToPixel32 helper function. - - -- 0.26.5 Changes/Bug Fixes ----------------------------------- - - Removed optimized codepatch for few data formats from StretchResample - function. It was quite buggy and not so much faster anyway. - - Added PaletteHasAlpha function. - - Added support functions for ifBinary data format. - - Added optional pixel scaling to Convert1To8, Convert2To8, - abd Convert4To8 functions. - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Filtered resampling ~10% faster now. - - Fixed DXT3 alpha encoding. - - ifIndex8 format now has HasAlphaChannel=True. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Made some resampling stuff public so that it can be used in canvas class. - - Added some color constructors. - - Added VisualizePalette helper function. - - Fixed ConvertSpecial, not very readable before and error when - converting special->special. - - -- 0.24.3 Changes/Bug Fixes ----------------------------------- - - Some refactorings a changes to DXT based formats. - - Added ifATI1N and ifATI2N image data formats support structures and functions. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added ifBTC image format support structures and functions. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - FillMipMapLevel now works well with indexed and special formats too. - - Moved Convert1To8 and Convert4To8 functions from ImagingBitmaps here - and created new Convert2To8 function. They are now used by more than one - file format loader. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - StretchResample now uses pixel get/set functions stored in - TImageFormatInfo so it is much faster for formats that override - them with optimized ones - - added pixel set/get functions optimized for various image formats - (to be stored in TImageFormatInfo) - - bug in ConvertSpecial caused problems when converting DXTC images - to bitmaps in ImagingCoponents - - bug in StretchRect caused that it didn't work with ifR32F and - ifR16F formats - - removed leftover code in FillMipMapLevel which disabled - filtered resizing of images witch ChannelSize <> 8bits - - added half float converting functions and support for half based - image formats where needed - - added TranslatePixel and IsImageFormatValid functions - - fixed possible range overflows when converting from FP to integer images - - added pixel set/get functions: GetPixel32Generic, GetPixelFPGeneric, - SetPixel32Generic, SetPixelFPGeneric - - fixed occasional range overflows in StretchResample - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added StretchNearest, StretchResample and some sampling functions - - added ChannelCount values to TImageFormatInfo constants - - added resolution validity check to GetDXTPixelsSize - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - added RBSwapFormat values to some TImageFromatInfo definitions - - fixed bug in ConvertSpecial (causing DXT images to convert only to 32bit) - - added CopyPixel, ComparePixels helper functions - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - replaced pixel format conversions for colors not to be - darkened when converting from low bit counts - - ReduceColorsMedianCut was updated to support creating one - optimal palette for more images and it is somewhat faster - now too - - there was ugly bug in DXTC dimensions checking -} - -end. - diff --git a/3rd/Imaging/Source/ImagingGif.pas b/3rd/Imaging/Source/ImagingGif.pas deleted file mode 100644 index 13a6555ca..000000000 --- a/3rd/Imaging/Source/ImagingGif.pas +++ /dev/null @@ -1,1291 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for GIF images.} -unit ImagingGif; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Imaging, ImagingTypes, ImagingIO, ImagingUtility; - -type - { GIF (Graphics Interchange Format) loader/saver class. GIF was - (and is still used) popular format for storing images supporting - multiple images per file and single color transparency. - Pixel format is 8 bit indexed where each image frame can have - its own color palette. GIF uses lossless LZW compression - (patent expired few years ago). - Imaging can load and save all GIFs with all frames and supports - transparency. Imaging can load just raw ifIndex8 frames or - also animate them in ifA8R8G8B8 format. See ImagingGIFLoadAnimated option.} - TGIFFileFormat = class(TImageFileFormat) - private - FLoadAnimated: LongBool; - function InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer; - procedure LZWDecompress(Stream: TStream; Handle: TImagingHandle; - Width, Height: Integer; Interlaced: Boolean; Data: Pointer); - procedure LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle; - Width, Height, BitCount: Integer; Interlaced: Boolean; Data: Pointer); - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - property LoadAnimated: LongBool read FLoadAnimated write FLoadAnimated; - end; - -implementation - -const - SGIFFormatName = 'Graphics Interchange Format'; - SGIFMasks = '*.gif'; - GIFSupportedFormats: TImageFormats = [ifIndex8]; - GIFDefaultLoadAnimated = True; - -type - TGIFVersion = (gv87, gv89); - TDisposalMethod = (dmNoRemoval, dmLeave, dmRestoreBackground, - dmRestorePrevious, dmReserved4, dmReserved5, dmReserved6, dmReserved7); - -const - GIFSignature: TChar3 = 'GIF'; - GIFVersions: array[TGIFVersion] of TChar3 = ('87a', '89a'); - GIFDefaultDelay = 65; - - // Masks for accessing fields in PackedFields of TGIFHeader - GIFGlobalColorTable = $80; - GIFColorResolution = $70; - GIFColorTableSorted = $08; - GIFColorTableSize = $07; - - // Masks for accessing fields in PackedFields of TImageDescriptor - GIFLocalColorTable = $80; - GIFInterlaced = $40; - GIFLocalTableSorted = $20; - - // Block identifiers - GIFPlainText: Byte = $01; - GIFGraphicControlExtension: Byte = $F9; - GIFCommentExtension: Byte = $FE; - GIFApplicationExtension: Byte = $FF; - GIFImageDescriptor: Byte = Ord(','); - GIFExtensionIntroducer: Byte = Ord('!'); - GIFTrailer: Byte = Ord(';'); - GIFBlockTerminator: Byte = $00; - - // Masks for accessing fields in PackedFields of TGraphicControlExtension - GIFTransparent = $01; - GIFUserInput = $02; - GIFDisposalMethod = $1C; - -const - // Netscape sub block types - GIFAppLoopExtension = 1; - GIFAppBufferExtension = 2; - -type - TGIFHeader = packed record - // File header part - Signature: TChar3; // Header Signature (always "GIF") - Version: TChar3; // GIF format version("87a" or "89a") - // Logical Screen Descriptor part - ScreenWidth: Word; // Width of Display Screen in Pixels - ScreenHeight: Word; // Height of Display Screen in Pixels - PackedFields: Byte; // Screen and color map information - BackgroundColorIndex: Byte; // Background color index (in global color table) - AspectRatio: Byte; // Pixel aspect ratio, ratio = (AspectRatio + 15) / 64 - end; - - TImageDescriptor = packed record - //Separator: Byte; // leave that out since we always read one bye ahead - Left: Word; // X position of image with respect to logical screen - Top: Word; // Y position - Width: Word; - Height: Word; - PackedFields: Byte; - end; - -const - // GIF extension labels - GIFExtTypeGraphic = $F9; - GIFExtTypePlainText = $01; - GIFExtTypeApplication = $FF; - GIFExtTypeComment = $FE; - -type - TGraphicControlExtension = packed record - BlockSize: Byte; - PackedFields: Byte; - DelayTime: Word; - TransparentColorIndex: Byte; - Terminator: Byte; - end; - -type - TGIFIdentifierCode = array[0..7] of AnsiChar; - TGIFAuthenticationCode = array[0..2] of AnsiChar; - TGIFApplicationRec = packed record - Identifier: TGIFIdentifierCode; - Authentication: TGIFAuthenticationCode; - end; - -const - CodeTableSize = 4096; - HashTableSize = 17777; - -type - TReadContext = record - Inx: Integer; - Size: Integer; - Buf: array [0..255 + 4] of Byte; - CodeSize: Integer; - ReadMask: Integer; - end; - PReadContext = ^TReadContext; - - TWriteContext = record - Inx: Integer; - CodeSize: Integer; - Buf: array [0..255 + 4] of Byte; - end; - PWriteContext = ^TWriteContext; - - TOutputContext = record - W: Integer; - H: Integer; - X: Integer; - Y: Integer; - BitsPerPixel: Integer; - Pass: Integer; - Interlace: Boolean; - LineIdent: Integer; - Data: Pointer; - CurrLineData: Pointer; - end; - - TImageDict = record - Tail: Word; - Index: Word; - Col: Byte; - end; - PImageDict = ^TImageDict; - - PIntCodeTable = ^TIntCodeTable; - TIntCodeTable = array [0..CodeTableSize - 1] of Word; - - TDictTable = array [0..CodeTableSize - 1] of TImageDict; - PDictTable = ^TDictTable; - -resourcestring - SGIFDecodingError = 'Error when decoding GIF LZW data'; - -{ - TGIFFileFormat implementation -} - -procedure TGIFFileFormat.Define; -begin - inherited; - FName := SGIFFormatName; - FFeatures := [ffLoad, ffSave, ffMultiImage]; - FSupportedFormats := GIFSupportedFormats; - FLoadAnimated := GIFDefaultLoadAnimated; - - AddMasks(SGIFMasks); - RegisterOption(ImagingGIFLoadAnimated, @FLoadAnimated); -end; - -function TGIFFileFormat.InterlaceStep(Y, Height: Integer; var Pass: Integer): Integer; -begin - Result := Y; - case Pass of - 0, 1: - Inc(Result, 8); - 2: - Inc(Result, 4); - 3: - Inc(Result, 2); - end; - if Result >= Height then - begin - if Pass = 0 then - begin - Pass := 1; - Result := 4; - if Result < Height then - Exit; - end; - if Pass = 1 then - begin - Pass := 2; - Result := 2; - if Result < Height then - Exit; - end; - if Pass = 2 then - begin - Pass := 3; - Result := 1; - end; - end; -end; - -{ GIF LZW decompresion code is from JVCL JvGIF.pas unit.} -procedure TGIFFileFormat.LZWDecompress(Stream: TStream; Handle: TImagingHandle; Width, Height: Integer; - Interlaced: Boolean; Data: Pointer); -var - MinCodeSize: Byte; - MaxCode, BitMask, InitCodeSize: Integer; - ClearCode, EndingCode, FirstFreeCode, FreeCode: Word; - I, OutCount, Code: Integer; - CurCode, OldCode, InCode, FinalChar: Word; - Prefix, Suffix, OutCode: PIntCodeTable; - ReadCtxt: TReadContext; - OutCtxt: TOutputContext; - TableFull: Boolean; - - function ReadCode(var Context: TReadContext): Integer; - var - RawCode: Integer; - ByteIndex: Integer; - Bytes: Byte; - BytesToLose: Integer; - begin - while (Context.Inx + Context.CodeSize > Context.Size) and - (Stream.Position < Stream.Size) do - begin - // Not enough bits in buffer - refill it - Not very efficient, but infrequently called - BytesToLose := Context.Inx shr 3; - // Note biggest Code Size is 12 bits. And this can at worst span 3 Bytes - Move(Context.Buf[Word(BytesToLose)], Context.Buf[0], 3); - Context.Inx := Context.Inx and 7; - Context.Size := Context.Size - (BytesToLose shl 3); - Stream.Read(Bytes, 1); - if Bytes > 0 then - Stream.Read(Context.Buf[Word(Context.Size shr 3)], Bytes); - Context.Size := Context.Size + (Bytes shl 3); - end; - ByteIndex := Context.Inx shr 3; - RawCode := Context.Buf[Word(ByteIndex)] + - (Word(Context.Buf[Word(ByteIndex + 1)]) shl 8); - if Context.CodeSize > 8 then - RawCode := RawCode + (Integer(Context.Buf[ByteIndex + 2]) shl 16); - RawCode := RawCode shr (Context.Inx and 7); - Context.Inx := Context.Inx + Byte(Context.CodeSize); - Result := RawCode and Context.ReadMask; - end; - - procedure Output(Value: Byte; var Context: TOutputContext); - var - P: PByte; - begin - if Context.Y >= Context.H then - Exit; - - // Only ifIndex8 supported - P := @PByteArray(Context.CurrLineData)[Context.X]; - P^ := Value; - - {case Context.BitsPerPixel of - 1: - begin - P := @PByteArray(Context.CurrLineData)[Context.X shr 3]; - if (Context.X and $07) <> 0 then - P^ := P^ or Word(Value shl (7 - (Word(Context.X and 7)))) - else - P^ := Byte(Value shl 7); - end; - 4: - begin - P := @PByteArray(Context.CurrLineData)[Context.X shr 1]; - if (Context.X and 1) <> 0 then - P^ := P^ or Value - else - P^ := Byte(Value shl 4); - end; - 8: - begin - P := @PByteArray(Context.CurrLineData)[Context.X]; - P^ := Value; - end; - end;} - Inc(Context.X); - - if Context.X < Context.W then - Exit; - Context.X := 0; - if Context.Interlace then - Context.Y := InterlaceStep(Context.Y, Context.H, Context.Pass) - else - Inc(Context.Y); - - Context.CurrLineData := @PByteArray(Context.Data)[Context.Y * Context.LineIdent]; - end; - -begin - OutCount := 0; - OldCode := 0; - FinalChar := 0; - TableFull := False; - GetMem(Prefix, SizeOf(TIntCodeTable)); - GetMem(Suffix, SizeOf(TIntCodeTable)); - GetMem(OutCode, SizeOf(TIntCodeTable) + SizeOf(Word)); - try - Stream.Read(MinCodeSize, 1); - if (MinCodeSize < 2) or (MinCodeSize > 9) then - RaiseImaging(SGIFDecodingError, []); - // Initial read context - ReadCtxt.Inx := 0; - ReadCtxt.Size := 0; - ReadCtxt.CodeSize := MinCodeSize + 1; - ReadCtxt.ReadMask := (1 shl ReadCtxt.CodeSize) - 1; - // Initialise pixel-output context - OutCtxt.X := 0; - OutCtxt.Y := 0; - OutCtxt.Pass := 0; - OutCtxt.W := Width; - OutCtxt.H := Height; - OutCtxt.BitsPerPixel := MinCodeSize; - OutCtxt.Interlace := Interlaced; - OutCtxt.LineIdent := Width; - OutCtxt.Data := Data; - OutCtxt.CurrLineData := Data; - BitMask := (1 shl OutCtxt.BitsPerPixel) - 1; - // 2 ^ MinCodeSize accounts for all colours in file - ClearCode := 1 shl MinCodeSize; - EndingCode := ClearCode + 1; - FreeCode := ClearCode + 2; - FirstFreeCode := FreeCode; - // 2^ (MinCodeSize + 1) includes clear and eoi Code and space too - InitCodeSize := ReadCtxt.CodeSize; - MaxCode := 1 shl ReadCtxt.CodeSize; - Code := ReadCode(ReadCtxt); - while (Code <> EndingCode) and (Code <> $FFFF) and - (OutCtxt.Y < OutCtxt.H) do - begin - if Code = ClearCode then - begin - ReadCtxt.CodeSize := InitCodeSize; - MaxCode := 1 shl ReadCtxt.CodeSize; - ReadCtxt.ReadMask := MaxCode - 1; - FreeCode := FirstFreeCode; - Code := ReadCode(ReadCtxt); - CurCode := Code; - OldCode := Code; - if Code = $FFFF then - Break; - FinalChar := (CurCode and BitMask); - Output(Byte(FinalChar), OutCtxt); - TableFull := False; - end - else - begin - CurCode := Code; - InCode := Code; - if CurCode >= FreeCode then - begin - CurCode := OldCode; - OutCode^[OutCount] := FinalChar; - Inc(OutCount); - end; - while CurCode > BitMask do - begin - if OutCount > CodeTableSize then - RaiseImaging(SGIFDecodingError, []); - OutCode^[OutCount] := Suffix^[CurCode]; - Inc(OutCount); - CurCode := Prefix^[CurCode]; - end; - - FinalChar := CurCode and BitMask; - OutCode^[OutCount] := FinalChar; - Inc(OutCount); - for I := OutCount - 1 downto 0 do - Output(Byte(OutCode^[I]), OutCtxt); - OutCount := 0; - // Update dictionary - if not TableFull then - begin - Prefix^[FreeCode] := OldCode; - Suffix^[FreeCode] := FinalChar; - // Advance to next free slot - Inc(FreeCode); - if FreeCode >= MaxCode then - begin - if ReadCtxt.CodeSize < 12 then - begin - Inc(ReadCtxt.CodeSize); - MaxCode := MaxCode shl 1; - ReadCtxt.ReadMask := (1 shl ReadCtxt.CodeSize) - 1; - end - else - TableFull := True; - end; - end; - OldCode := InCode; - end; - Code := ReadCode(ReadCtxt); - end; - if Code = $FFFF then - RaiseImaging(SGIFDecodingError, []); - finally - FreeMem(Prefix); - FreeMem(OutCode); - FreeMem(Suffix); - end; -end; - -{ GIF LZW compresion code is from JVCL JvGIF.pas unit.} -procedure TGIFFileFormat.LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle; Width, Height, BitCount: Integer; - Interlaced: Boolean; Data: Pointer); -var - LineIdent: Integer; - MinCodeSize, Col: Byte; - InitCodeSize, X, Y: Integer; - Pass: Integer; - MaxCode: Integer; { 1 shl CodeSize } - ClearCode, EndingCode, LastCode, Tail: Integer; - I, HashValue: Integer; - LenString: Word; - Dict: PDictTable; - HashTable: TList; - PData: PByte; - WriteCtxt: TWriteContext; - - function InitHash(P: Integer): Integer; - begin - Result := (P + 3) * 301; - end; - - procedure WriteCode(Code: Integer; var Context: TWriteContext); - var - BufIndex: Integer; - Bytes: Byte; - begin - BufIndex := Context.Inx shr 3; - Code := Code shl (Context.Inx and 7); - Context.Buf[BufIndex] := Context.Buf[BufIndex] or Byte(Code); - Context.Buf[BufIndex + 1] := Byte(Code shr 8); - Context.Buf[BufIndex + 2] := Byte(Code shr 16); - Context.Inx := Context.Inx + Context.CodeSize; - if Context.Inx >= 255 * 8 then - begin - // Flush out full buffer - Bytes := 255; - IO.Write(Handle, @Bytes, 1); - IO.Write(Handle, @Context.Buf, Bytes); - Move(Context.Buf[255], Context.Buf[0], 2); - FillChar(Context.Buf[2], 255, 0); - Context.Inx := Context.Inx - (255 * 8); - end; - end; - - procedure FlushCode(var Context: TWriteContext); - var - Bytes: Byte; - begin - Bytes := (Context.Inx + 7) shr 3; - if Bytes > 0 then - begin - IO.Write(Handle, @Bytes, 1); - IO.Write(Handle, @Context.Buf, Bytes); - end; - // Data block terminator - a block of zero Size - Bytes := 0; - IO.Write(Handle, @Bytes, 1); - end; - -begin - LineIdent := Width; - Tail := 0; - HashValue := 0; - Col := 0; - HashTable := TList.Create; - GetMem(Dict, SizeOf(TDictTable)); - try - for I := 0 to HashTableSize - 1 do - HashTable.Add(nil); - - // Initialise encoder variables - InitCodeSize := BitCount + 1; - if InitCodeSize = 2 then - Inc(InitCodeSize); - MinCodeSize := InitCodeSize - 1; - IO.Write(Handle, @MinCodeSize, 1); - ClearCode := 1 shl MinCodeSize; - EndingCode := ClearCode + 1; - LastCode := EndingCode; - MaxCode := 1 shl InitCodeSize; - LenString := 0; - // Setup write context - WriteCtxt.Inx := 0; - WriteCtxt.CodeSize := InitCodeSize; - FillChar(WriteCtxt.Buf, SizeOf(WriteCtxt.Buf), 0); - WriteCode(ClearCode, WriteCtxt); - Y := 0; - Pass := 0; - - while Y < Height do - begin - PData := @PByteArray(Data)[Y * LineIdent]; - for X := 0 to Width - 1 do - begin - // Only ifIndex8 support - case BitCount of - 8: - begin - Col := PData^; - PData := @PByteArray(PData)[1]; - end; - {4: - begin - if X and 1 <> 0 then - begin - Col := PData^ and $0F; - PData := @PByteArray(PData)[1]; - end - else - Col := PData^ shr 4; - end; - 1: - begin - if X and 7 = 7 then - begin - Col := PData^ and 1; - PData := @PByteArray(PData)[1]; - end - else - Col := (PData^ shr (7 - (X and $07))) and $01; - end;} - end; - Inc(LenString); - if LenString = 1 then - begin - Tail := Col; - HashValue := InitHash(Col); - end - else - begin - HashValue := HashValue * (Col + LenString + 4); - I := HashValue mod HashTableSize; - HashValue := HashValue mod HashTableSize; - while (HashTable[I] <> nil) and - ((PImageDict(HashTable[I])^.Tail <> Tail) or - (PImageDict(HashTable[I])^.Col <> Col)) do - begin - Inc(I); - if I >= HashTableSize then - I := 0; - end; - if HashTable[I] <> nil then // Found in the strings table - Tail := PImageDict(HashTable[I])^.Index - else - begin - // Not found - WriteCode(Tail, WriteCtxt); - Inc(LastCode); - HashTable[I] := @Dict^[LastCode]; - PImageDict(HashTable[I])^.Index := LastCode; - PImageDict(HashTable[I])^.Tail := Tail; - PImageDict(HashTable[I])^.Col := Col; - Tail := Col; - HashValue := InitHash(Col); - LenString := 1; - if LastCode >= MaxCode then - begin - // Next Code will be written longer - MaxCode := MaxCode shl 1; - Inc(WriteCtxt.CodeSize); - end - else - if LastCode >= CodeTableSize - 2 then - begin - // Reset tables - WriteCode(Tail, WriteCtxt); - WriteCode(ClearCode, WriteCtxt); - LenString := 0; - LastCode := EndingCode; - WriteCtxt.CodeSize := InitCodeSize; - MaxCode := 1 shl InitCodeSize; - for I := 0 to HashTableSize - 1 do - HashTable[I] := nil; - end; - end; - end; - end; - if Interlaced then - Y := InterlaceStep(Y, Height, Pass) - else - Inc(Y); - end; - WriteCode(Tail, WriteCtxt); - WriteCode(EndingCode, WriteCtxt); - FlushCode(WriteCtxt); - finally - HashTable.Free; - FreeMem(Dict); - end; -end; - -function TGIFFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -type - TFrameInfo = record - Left, Top: Integer; - Width, Height: Integer; - Disposal: TDisposalMethod; - HasTransparency: Boolean; - HasLocalPal: Boolean; - TransIndex: Integer; - BackIndex: Integer; - end; -var - Header: TGIFHeader; - HasGlobalPal: Boolean; - GlobalPalLength: Integer; - GlobalPal: TPalette32Size256; - ScreenWidth, ScreenHeight, I, CachedIndex: Integer; - BlockID: Byte; - HasGraphicExt: Boolean; - GraphicExt: TGraphicControlExtension; - FrameInfos: array of TFrameInfo; - AppRead: Boolean; - CachedFrame: TImageData; - AnimFrames: TDynImageDataArray; - - function ReadBlockID: Byte; - begin - Result := GIFTrailer; - if GetIO.Read(Handle, @Result, SizeOf(Result)) < SizeOf(Result) then - Result := GIFTrailer; - end; - - procedure ReadExtensions; - var - BlockSize, BlockType, ExtType: Byte; - AppRec: TGIFApplicationRec; - LoopCount: SmallInt; - - procedure SkipBytes; - begin - with GetIO do - repeat - // Read block sizes and skip them - Read(Handle, @BlockSize, SizeOf(BlockSize)); - Seek(Handle, BlockSize, smFromCurrent); - until BlockSize = 0; - end; - - begin - HasGraphicExt := False; - AppRead := False; - - // Read extensions until image descriptor is found. Only graphic extension - // is stored now (for transparency), others are skipped. - while BlockID = GIFExtensionIntroducer do - with GetIO do - begin - Read(Handle, @ExtType, SizeOf(ExtType)); - - while ExtType in [GIFGraphicControlExtension, GIFCommentExtension, GIFApplicationExtension, GIFPlainText] do - begin - if ExtType = GIFGraphicControlExtension then - begin - HasGraphicExt := True; - Read(Handle, @GraphicExt, SizeOf(GraphicExt)); - end - else if (ExtType = GIFApplicationExtension) and not AppRead then - begin - Read(Handle, @BlockSize, SizeOf(BlockSize)); - if BlockSize >= SizeOf(AppRec) then - begin - Read(Handle, @AppRec, SizeOf(AppRec)); - if ((AppRec.Identifier = 'NETSCAPE') and (AppRec.Authentication = '2.0')) or - ((AppRec.Identifier = 'ANIMEXTS') and (AppRec.Authentication = '1.0')) then - begin - Read(Handle, @BlockSize, SizeOf(BlockSize)); - while BlockSize <> 0 do - begin - BlockType := ReadBlockID; - Dec(BlockSize); - - case BlockType of - GIFAppLoopExtension: - if (BlockSize >= SizeOf(LoopCount)) then - begin - // Read loop count - Read(Handle, @LoopCount, SizeOf(LoopCount)); - Dec(BlockSize, SizeOf(LoopCount)); - if LoopCount > 0 then - Inc(LoopCount); // Netscape extension is really "repeats" not "loops" - FMetadata.SetMetaItem(SMetaAnimationLoops, LoopCount); - end; - GIFAppBufferExtension: - begin - Dec(BlockSize, SizeOf(Word)); - Seek(Handle, SizeOf(Word), smFromCurrent); - end; - end; - end; - SkipBytes; - AppRead := True; - end - else - begin - // Revert all bytes reading - Seek(Handle, - SizeOf(AppRec) - SizeOf(BlockSize), smFromCurrent); - SkipBytes; - end; - end - else - begin - Seek(Handle, - BlockSize - SizeOf(BlockSize), smFromCurrent); - SkipBytes; - end; - end - else if ExtType in [GIFCommentExtension, GIFApplicationExtension, GIFPlainText] then - repeat - // Read block sizes and skip them - Read(Handle, @BlockSize, SizeOf(BlockSize)); - Seek(Handle, BlockSize, smFromCurrent); - until BlockSize = 0; - - // Read ID of following block - BlockID := ReadBlockID; - ExtType := BlockID; - end - end; - end; - - procedure CopyLZWData(Dest: TStream); - var - CodeSize, BlockSize: Byte; - InputSize: Integer; - Buff: array[Byte] of Byte; - begin - InputSize := ImagingIO.GetInputSize(GetIO, Handle); - // Copy codesize to stream - GetIO.Read(Handle, @CodeSize, 1); - Dest.Write(CodeSize, 1); - repeat - // Read and write data blocks, last is block term value of 0 - GetIO.Read(Handle, @BlockSize, 1); - Dest.Write(BlockSize, 1); - if BlockSize > 0 then - begin - GetIO.Read(Handle, @Buff[0], BlockSize); - Dest.Write(Buff[0], BlockSize); - end; - until (BlockSize = 0) or (GetIO.Tell(Handle) >= InputSize); - end; - - procedure ReadFrame; - var - ImageDesc: TImageDescriptor; - Interlaced: Boolean; - I, Idx, LocalPalLength: Integer; - LocalPal: TPalette32Size256; - LZWStream: TMemoryStream; - - procedure RemoveBadFrame; - begin - FreeImage(Images[Idx]); - SetLength(Images, Length(Images) - 1); - end; - - begin - Idx := Length(Images); - SetLength(Images, Idx + 1); - SetLength(FrameInfos, Idx + 1); - FillChar(LocalPal, SizeOf(LocalPal), 0); - - with GetIO do - begin - // Read and parse image descriptor - Read(Handle, @ImageDesc, SizeOf(ImageDesc)); - FrameInfos[Idx].HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable; - Interlaced := (ImageDesc.PackedFields and GIFInterlaced) = GIFInterlaced; - LocalPalLength := ImageDesc.PackedFields and GIFColorTableSize; - LocalPalLength := 1 shl (LocalPalLength + 1); // Total pal length is 2^(n+1) - - // From Mozilla source - if (ImageDesc.Width = 0) or (ImageDesc.Width > Header.ScreenWidth) then - ImageDesc.Width := Header.ScreenWidth; - if (ImageDesc.Height = 0) or (ImageDesc.Height > Header.ScreenHeight) then - ImageDesc.Height := Header.ScreenHeight; - - FrameInfos[Idx].Left := ImageDesc.Left; - FrameInfos[Idx].Top := ImageDesc.Top; - FrameInfos[Idx].Width := ImageDesc.Width; - FrameInfos[Idx].Height := ImageDesc.Height; - FrameInfos[Idx].BackIndex := Header.BackgroundColorIndex; - - // Create new image for this frame which would be later pasted onto logical screen - NewImage(ImageDesc.Width, ImageDesc.Height, ifIndex8, Images[Idx]); - - // Load local palette if there is any - if FrameInfos[Idx].HasLocalPal then - for I := 0 to LocalPalLength - 1 do - begin - LocalPal[I].A := 255; - Read(Handle, @LocalPal[I].R, SizeOf(LocalPal[I].R)); - Read(Handle, @LocalPal[I].G, SizeOf(LocalPal[I].G)); - Read(Handle, @LocalPal[I].B, SizeOf(LocalPal[I].B)); - end; - - // Use local pal if present or global pal if present or create - // default pal if neither of them is present - if FrameInfos[Idx].HasLocalPal then - Move(LocalPal, Images[Idx].Palette^, SizeOf(LocalPal)) - else if HasGlobalPal then - Move(GlobalPal, Images[Idx].Palette^, SizeOf(GlobalPal)) - else - FillCustomPalette(Images[Idx].Palette, GlobalPalLength, 3, 3, 2); - - if (ImageDesc.Left <= Header.ScreenWidth + 1) and (ImageDesc.Top <= Header.ScreenHeight + 1) then - begin - // Resize the screen if needed to fit the frame - ScreenWidth := Max(ScreenWidth, ImageDesc.Width + ImageDesc.Left); - ScreenHeight := Max(ScreenHeight, ImageDesc.Height + ImageDesc.Top); - end - else - begin - // Remove frame outside logical screen - RemoveBadFrame; - Exit; - end; - - // If Grahic Control Extension is present make use of it - if HasGraphicExt then - begin - FrameInfos[Idx].HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent; - FrameInfos[Idx].Disposal := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2); - if FrameInfos[Idx].HasTransparency then - begin - FrameInfos[Idx].TransIndex := GraphicExt.TransparentColorIndex; - Images[Idx].Palette[FrameInfos[Idx].TransIndex].A := 0; - end; - FMetadata.SetMetaItem(SMetaFrameDelay, Integer(GraphicExt.DelayTime * 10), Idx); - end - else - FrameInfos[Idx].HasTransparency := False; - - LZWStream := TMemoryStream.Create; - try - try - // Copy LZW data to temp stream, needed for correct decompression - CopyLZWData(LZWStream); - LZWStream.Position := 0; - // Data decompression finally - LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Images[Idx].Bits); - except - RemoveBadFrame; - Exit; - end; - finally - LZWStream.Free; - end; - end; - end; - - procedure CopyFrameTransparent32(const Image, Frame: TImageData; Left, Top: Integer); - var - X, Y: Integer; - Src: PByte; - Dst: PColor32; - begin - Src := Frame.Bits; - - // Copy all pixels from frame to log screen but ignore the transparent ones - for Y := 0 to Frame.Height - 1 do - begin - Dst := @PColor32RecArray(Image.Bits)[(Top + Y) * Image.Width + Left]; - for X := 0 to Frame.Width - 1 do - begin - if (Frame.Palette[Src^].A <> 0) then - Dst^ := Frame.Palette[Src^].Color; - Inc(Src); - Inc(Dst); - end; - end; - end; - - procedure AnimateFrame(Index: Integer; var AnimFrame: TImageData); - var - I, First, Last: Integer; - UseCache: Boolean; - BGColor: TColor32; - begin - // We may need to use raw frame 0 to n to correctly animate n-th frame - Last := Index; - First := Max(0, Last); - // See if we can use last animate frame as a basis for this one - // (so we don't have to use previous raw frames). - UseCache := TestImage(CachedFrame) and (CachedIndex = Index - 1) and (CachedIndex >= 0) and - (FrameInfos[CachedIndex].Disposal <> dmRestorePrevious); - - // Reuse or release cache - if UseCache then - CloneImage(CachedFrame, AnimFrame) - else - FreeImage(CachedFrame); - - // Default color for clearing of the screen - BGColor := Images[Index].Palette[FrameInfos[Index].BackIndex].Color; - - // Now prepare logical screen for drawing of raw frame at Index. - // We may need to use all previous raw frames to get the screen - // to proper state (according to their disposal methods). - - if not UseCache then - begin - if FrameInfos[Index].HasTransparency then - BGColor := Images[Index].Palette[FrameInfos[Index].TransIndex].Color; - // Clear whole screen - FillMemoryLongWord(AnimFrame.Bits, AnimFrame.Size, BGColor); - - // Try to maximize First so we don't have to use all 0 to n raw frames - while First > 0 do - begin - if (ScreenWidth = Images[First].Width) and (ScreenHeight = Images[First].Height) then - begin - if (FrameInfos[First].Disposal = dmRestoreBackground) and (First < Last) then - Break; - end; - Dec(First); - end; - - for I := First to Last - 1 do - begin - case FrameInfos[I].Disposal of - dmNoRemoval, dmLeave: - begin - // Copy previous raw frame onto screen - CopyFrameTransparent32(AnimFrame, Images[I], FrameInfos[I].Left, FrameInfos[I].Top); - end; - dmRestoreBackground: - if (I > First) then - begin - // Restore background color - FillRect(AnimFrame, FrameInfos[I].Left, FrameInfos[I].Top, - FrameInfos[I].Width, FrameInfos[I].Height, @BGColor); - end; - dmRestorePrevious: ; // Do nothing - previous state is already on screen - end; - end; - end - else if FrameInfos[CachedIndex].Disposal = dmRestoreBackground then - begin - // We have our cached result but also need to restore - // background in a place of cached frame - if FrameInfos[CachedIndex].HasTransparency then - BGColor := Images[CachedIndex].Palette[FrameInfos[CachedIndex].TransIndex].Color; - FillRect(AnimFrame, FrameInfos[CachedIndex].Left, FrameInfos[CachedIndex].Top, - FrameInfos[CachedIndex].Width, FrameInfos[CachedIndex].Height, @BGColor); - end; - - // Copy current raw frame to prepared screen - CopyFrameTransparent32(AnimFrame, Images[Index], FrameInfos[Index].Left, FrameInfos[Index].Top); - - // Cache animated result - CloneImage(AnimFrame, CachedFrame); - CachedIndex := Index; - end; - -begin - AppRead := False; - - SetLength(Images, 0); - FillChar(GlobalPal, SizeOf(GlobalPal), 0); - - with GetIO do - begin - // Read GIF header - Read(Handle, @Header, SizeOf(Header)); - ScreenWidth := Header.ScreenWidth; - ScreenHeight := Header.ScreenHeight; - HasGlobalPal := Header.PackedFields and GIFGlobalColorTable = GIFGlobalColorTable; // Bit 7 - GlobalPalLength := Header.PackedFields and GIFColorTableSize; // Bits 0-2 - GlobalPalLength := 1 shl (GlobalPalLength + 1); // Total pal length is 2^(n+1) - - // Read global palette from file if present - if HasGlobalPal then - begin - for I := 0 to GlobalPalLength - 1 do - begin - GlobalPal[I].A := 255; - Read(Handle, @GlobalPal[I].R, SizeOf(GlobalPal[I].R)); - Read(Handle, @GlobalPal[I].G, SizeOf(GlobalPal[I].G)); - Read(Handle, @GlobalPal[I].B, SizeOf(GlobalPal[I].B)); - end; - end; - - // Read ID of the first block - BlockID := ReadBlockID; - - // Now read all data blocks in the file until file trailer is reached - while BlockID <> GIFTrailer do - begin - // Read blocks until we find the one of known type - while not (BlockID in [GIFTrailer, GIFExtensionIntroducer, GIFImageDescriptor]) do - BlockID := ReadBlockID; - // Read supported and skip unsupported extensions - ReadExtensions; - // If image frame is found read it - if BlockID = GIFImageDescriptor then - ReadFrame; - // Read next block's ID - BlockID := ReadBlockID; - // If block ID is unknown set it to end-of-GIF marker - if not (BlockID in [GIFExtensionIntroducer, GIFTrailer, GIFImageDescriptor]) then - BlockID := GIFTrailer; - end; - - if FLoadAnimated then - begin - // Aniated frames will be stored in AnimFrames - SetLength(AnimFrames, Length(Images)); - InitImage(CachedFrame); - CachedIndex := -1; - - for I := 0 to High(Images) do - begin - // Create new logical screen - NewImage(ScreenWidth, ScreenHeight, ifA8R8G8B8, AnimFrames[I]); - // Animate frames to current log screen - AnimateFrame(I, AnimFrames[I]); - end; - - // Now release raw 8bit frames and put animated 32bit ones - // to output array - FreeImage(CachedFrame); - for I := 0 to High(AnimFrames) do - begin - FreeImage(Images[I]); - Images[I] := AnimFrames[I]; - end; - end; - - Result := True; - end; -end; - -function TGIFFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -var - Header: TGIFHeader; - ImageDesc: TImageDescriptor; - ImageToSave: TImageData; - MustBeFreed: Boolean; - I, J: Integer; - GraphicExt: TGraphicControlExtension; - - procedure FindMaxDimensions(var MaxWidth, MaxHeight: Word); - var - I: Integer; - begin - MaxWidth := Images[FFirstIdx].Width; - MaxHeight := Images[FFirstIdx].Height; - - for I := FFirstIdx + 1 to FLastIdx do - begin - MaxWidth := Iff(Images[I].Width > MaxWidth, Images[I].Width, MaxWidth); - MaxHeight := Iff(Images[I].Height > MaxWidth, Images[I].Height, MaxHeight); - end; - end; - - procedure SetFrameDelay(Idx: Integer; var Ext: TGraphicControlExtension); - begin - if FMetadata.HasMetaItemForSaving(SMetaFrameDelay, Idx) then - Ext.DelayTime := FMetadata.MetaItemsForSavingMulti[SMetaFrameDelay, Idx] div 10 - else - Ext.DelayTime := GIFDefaultDelay; - end; - - procedure SaveGlobalMetadata; - var - AppExt: TGIFApplicationRec; - BlockSize, LoopExtId: Byte; - Repeats: Word; - begin - if FMetadata.HasMetaItemForSaving(SMetaAnimationLoops) then - with GetIO do - begin - FillChar(AppExt, SizeOf(AppExt), 0); - AppExt.Identifier := 'NETSCAPE'; - AppExt.Authentication := '2.0'; - Repeats := FMetadata.MetaItemsForSaving[SMetaAnimationLoops]; - if Repeats > 0 then - Dec(Repeats); - LoopExtId := GIFAppLoopExtension; - - Write(Handle, @GIFExtensionIntroducer, SizeOf(GIFExtensionIntroducer)); - Write(Handle, @GIFApplicationExtension, SizeOf(GIFApplicationExtension)); - BlockSize := 11; - Write(Handle, @BlockSize, SizeOf(BlockSize)); - Write(Handle, @AppExt, SizeOf(AppExt)); - BlockSize := 3; - Write(Handle, @BlockSize, SizeOf(BlockSize)); - Write(Handle, @LoopExtId, SizeOf(LoopExtId)); - Write(Handle, @Repeats, SizeOf(Repeats)); - Write(Handle, @GIFBlockTerminator, SizeOf(GIFBlockTerminator)); - end; - end; - -begin - // Fill header with data, select size of largest image in array as - // logical screen size - FillChar(Header, Sizeof(Header), 0); - Header.Signature := GIFSignature; - Header.Version := GIFVersions[gv89]; - FindMaxDimensions(Header.ScreenWidth, Header.ScreenHeight); - Header.PackedFields := GIFColorResolution; // Color resolution is 256 - GetIO.Write(Handle, @Header, SizeOf(Header)); - - // Prepare default GC extension with delay - FillChar(GraphicExt, Sizeof(GraphicExt), 0); - GraphicExt.DelayTime := GIFDefaultDelay; - GraphicExt.BlockSize := 4; - - SaveGlobalMetadata; - - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - // Write Graphic Control Extension with default delay - Write(Handle, @GIFExtensionIntroducer, SizeOf(GIFExtensionIntroducer)); - Write(Handle, @GIFGraphicControlExtension, SizeOf(GIFGraphicControlExtension)); - SetFrameDelay(I, GraphicExt); - Write(Handle, @GraphicExt, SizeOf(GraphicExt)); - // Write frame marker and fill and write image descriptor for this frame - Write(Handle, @GIFImageDescriptor, SizeOf(GIFImageDescriptor)); - FillChar(ImageDesc, Sizeof(ImageDesc), 0); - ImageDesc.Width := Width; - ImageDesc.Height := Height; - ImageDesc.PackedFields := GIFLocalColorTable or GIFColorTableSize; // Use lccal color table with 256 entries - Write(Handle, @ImageDesc, SizeOf(ImageDesc)); - - // Write local color table for each frame - for J := 0 to 255 do - begin - Write(Handle, @Palette[J].R, SizeOf(Palette[J].R)); - Write(Handle, @Palette[J].G, SizeOf(Palette[J].G)); - Write(Handle, @Palette[J].B, SizeOf(Palette[J].B)); - end; - - // Finally compress image data - LZWCompress(GetIO, Handle, Width, Height, 8, False, Bits); - - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; - end; - - GetIO.Write(Handle, @GIFTrailer, SizeOf(GIFTrailer)); - Result := True; -end; - -procedure TGIFFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - ConvertImage(Image, ifIndex8); -end; - -function TGIFFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Header: TGIFHeader; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Header, SizeOf(Header)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Header)) and - (Header.Signature = GIFSignature) and - ((Header.Version = GIFVersions[gv87]) or (Header.Version = GIFVersions[gv89])); - end; -end; - -initialization - RegisterImageFileFormat(TGIFFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 Changes/Bug Fixes ----------------------------------- - - Fixed crash when resaving GIF with animation metadata. - - Writes frame delays of GIF animations from metadata. - - Reads and writes looping of GIF animations stored into/from metadata. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Reads frame delays from GIF animations into metadata. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Fixed bug - loading of GIF with NETSCAPE app extensions - failed with Delphi 2009. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - GIF loading and animation mostly rewritten, based on - modification by Sergey Galezdinov (ExtraGIF in Extras/Contrib). - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - Fixed loading of some rare GIFs, problems with LZW - decompression. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Better solution to transparency for some GIFs. Background not - transparent by default. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Made backround color transparent by default (alpha = 0). - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Fixed other loading bugs (local pal size, transparency). - - Added GIF saving. - - Fixed bug when loading multiframe GIFs and implemented few animation - features (disposal methods, ...). - - Loading of GIFs working. - - Unit created with initial stuff! -} - -end. diff --git a/3rd/Imaging/Source/ImagingIO.pas b/3rd/Imaging/Source/ImagingIO.pas deleted file mode 100644 index 8ac877504..000000000 --- a/3rd/Imaging/Source/ImagingIO.pas +++ /dev/null @@ -1,647 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains default IO functions for reading from/writting to - files, streams and memory.} -unit ImagingIO; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility; - -type - TMemoryIORec = record - Data: ImagingUtility.PByteArray; - Position: LongInt; - Size: LongInt; - end; - PMemoryIORec = ^TMemoryIORec; - -var - OriginalFileIO: TIOFunctions; - FileIO: TIOFunctions; - StreamIO: TIOFunctions; - MemoryIO: TIOFunctions; - -{ Helper function that returns size of input (from current position to the end) - represented by Handle (and opened and operated on by members of IOFunctions).} -function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt; -{ Helper function that initializes TMemoryIORec with given params.} -function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec; -{ Reads one text line from input (CR+LF, CR, or LF as line delimiter).} -function ReadLine(IOFunctions: TIOFunctions; Handle: TImagingHandle; - out Line: AnsiString; FailOnControlChars: Boolean = False): Boolean; -{ Writes one text line to input with optional line delimiter.} -procedure WriteLine(IOFunctions: TIOFunctions; Handle: TImagingHandle; - const Line: AnsiString; const LineEnding: AnsiString = sLineBreak); - -implementation - -const - DefaultBufferSize = 16 * 1024; - -type - { Based on TaaBufferedStream - Copyright (c) Julian M Bucknall 1997, 1999 } - TBufferedStream = class - private - FBuffer: PByteArray; - FBufSize: Integer; - FBufStart: Integer; - FBufPos: Integer; - FBytesInBuf: Integer; - FSize: Integer; - FDirty: Boolean; - FStream: TStream; - function GetPosition: Integer; - function GetSize: Integer; - procedure ReadBuffer; - procedure WriteBuffer; - procedure SetPosition(const Value: Integer); - public - constructor Create(AStream: TStream); - destructor Destroy; override; - function Read(var Buffer; Count: Integer): Integer; - function Write(const Buffer; Count: Integer): Integer; - function Seek(Offset: Integer; Origin: Word): Integer; - procedure Commit; - property Stream: TStream read FStream; - property Position: Integer read GetPosition write SetPosition; - property Size: Integer read GetSize; - end; - -constructor TBufferedStream.Create(AStream: TStream); -begin - inherited Create; - FStream := AStream; - FBufSize := DefaultBufferSize; - GetMem(FBuffer, FBufSize); - FBufPos := 0; - FBytesInBuf := 0; - FBufStart := 0; - FDirty := False; - FSize := AStream.Size; -end; - -destructor TBufferedStream.Destroy; -begin - if FBuffer <> nil then - begin - Commit; - FreeMem(FBuffer); - end; - FStream.Position := Position; // Make sure source stream has right position - inherited Destroy; -end; - -function TBufferedStream.GetPosition: Integer; -begin - Result := FBufStart + FBufPos; -end; - -procedure TBufferedStream.SetPosition(const Value: Integer); -begin - Seek(Value, soFromCurrent); -end; - -function TBufferedStream.GetSize: Integer; -begin - Result := FSize; -end; - -procedure TBufferedStream.ReadBuffer; -var - SeekResult: Integer; -begin - SeekResult := FStream.Seek(FBufStart, 0); - if SeekResult = -1 then - raise Exception.Create('TBufferedStream.ReadBuffer: seek failed'); - FBytesInBuf := FStream.Read(FBuffer^, FBufSize); - if FBytesInBuf <= 0 then - raise Exception.Create('TBufferedStream.ReadBuffer: read failed'); -end; - -procedure TBufferedStream.WriteBuffer; -var - SeekResult: Integer; - BytesWritten: Integer; -begin - SeekResult := FStream.Seek(FBufStart, 0); - if SeekResult = -1 then - raise Exception.Create('TBufferedStream.WriteBuffer: seek failed'); - BytesWritten := FStream.Write(FBuffer^, FBytesInBuf); - if BytesWritten <> FBytesInBuf then - raise Exception.Create('TBufferedStream.WriteBuffer: write failed'); -end; - -procedure TBufferedStream.Commit; -begin - if FDirty then - begin - WriteBuffer; - FDirty := False; - end; -end; - -function TBufferedStream.Read(var Buffer; Count: Integer): Integer; -var - BufAsBytes : TByteArray absolute Buffer; - BufIdx, BytesToGo, BytesToRead: Integer; -begin - // Calculate the actual number of bytes we can read - this depends on - // the current position and size of the stream as well as the number - // of bytes requested. - BytesToGo := Count; - if FSize < (FBufStart + FBufPos + Count) then - BytesToGo := FSize - (FBufStart + FBufPos); - - if BytesToGo <= 0 then - begin - Result := 0; - Exit; - end; - // Remember to return the result of our calculation - Result := BytesToGo; - - BufIdx := 0; - if FBytesInBuf = 0 then - ReadBuffer; - // Calculate the number of bytes we can read prior to the loop - BytesToRead := FBytesInBuf - FBufPos; - if BytesToRead > BytesToGo then - BytesToRead := BytesToGo; - // Copy from the stream buffer to the caller's buffer - Move(FBuffer^[FBufPos], BufAsBytes[BufIdx], BytesToRead); - // Calculate the number of bytes still to read} - Dec(BytesToGo, BytesToRead); - - // while we have bytes to read, read them - while BytesToGo > 0 do - begin - Inc(BufIdx, BytesToRead); - // As we've exhausted this buffer-full, advance to the next, check - // to see whether we need to write the buffer out first - if FDirty then - begin - WriteBuffer; - FDirty := false; - end; - Inc(FBufStart, FBufSize); - FBufPos := 0; - ReadBuffer; - // Calculate the number of bytes we can read in this cycle - BytesToRead := FBytesInBuf; - if BytesToRead > BytesToGo then - BytesToRead := BytesToGo; - // Ccopy from the stream buffer to the caller's buffer - Move(FBuffer^, BufAsBytes[BufIdx], BytesToRead); - // Calculate the number of bytes still to read - Dec(BytesToGo, BytesToRead); - end; - // Remember our new position - Inc(FBufPos, BytesToRead); - if FBufPos = FBufSize then - begin - Inc(FBufStart, FBufSize); - FBufPos := 0; - FBytesInBuf := 0; - end; -end; - -function TBufferedStream.Seek(Offset: Integer; Origin: Word): Integer; -var - NewBufStart, NewPos: Integer; -begin - // Calculate the new position - case Origin of - soFromBeginning : NewPos := Offset; - soFromCurrent : NewPos := FBufStart + FBufPos + Offset; - soFromEnd : NewPos := FSize + Offset; - else - raise Exception.Create('TBufferedStream.Seek: invalid origin'); - end; - - if (NewPos < 0) or (NewPos > FSize) then - begin - //NewPos := ClampInt(NewPos, 0, FSize); don't do this - for writing - end; - // Calculate which page of the file we need to be at - NewBufStart := NewPos and not Pred(FBufSize); - // If the new page is different than the old, mark the buffer as being - // ready to be replenished, and if need be write out any dirty data - if NewBufStart <> FBufStart then - begin - if FDirty then - begin - WriteBuffer; - FDirty := False; - end; - FBufStart := NewBufStart; - FBytesInBuf := 0; - end; - // Save the new position - FBufPos := NewPos - NewBufStart; - Result := NewPos; -end; - -function TBufferedStream.Write(const Buffer; Count: Integer): Integer; -var - BufAsBytes: TByteArray absolute Buffer; - BufIdx, BytesToGo, BytesToWrite: Integer; -begin - // When we write to this stream we always assume that we can write the - // requested number of bytes: if we can't (eg, the disk is full) we'll - // get an exception somewhere eventually. - BytesToGo := Count; - // Remember to return the result of our calculation - Result := BytesToGo; - - BufIdx := 0; - if (FBytesInBuf = 0) and (FSize > FBufStart) then - ReadBuffer; - // Calculate the number of bytes we can write prior to the loop - BytesToWrite := FBufSize - FBufPos; - if BytesToWrite > BytesToGo then - BytesToWrite := BytesToGo; - // Copy from the caller's buffer to the stream buffer - Move(BufAsBytes[BufIdx], FBuffer^[FBufPos], BytesToWrite); - // Mark our stream buffer as requiring a save to the actual stream, - // note that this will suffice for the rest of the routine as well: no - // inner routine will turn off the dirty flag. - FDirty := True; - // Calculate the number of bytes still to write - Dec(BytesToGo, BytesToWrite); - - // While we have bytes to write, write them - while BytesToGo > 0 do - begin - Inc(BufIdx, BytesToWrite); - // As we've filled this buffer, write it out to the actual stream - // and advance to the next buffer, reading it if required - FBytesInBuf := FBufSize; - WriteBuffer; - Inc(FBufStart, FBufSize); - FBufPos := 0; - FBytesInBuf := 0; - if FSize > FBufStart then - ReadBuffer; - // Calculate the number of bytes we can write in this cycle - BytesToWrite := FBufSize; - if BytesToWrite > BytesToGo then - BytesToWrite := BytesToGo; - // Copy from the caller's buffer to our buffer - Move(BufAsBytes[BufIdx], FBuffer^, BytesToWrite); - // Calculate the number of bytes still to write - Dec(BytesToGo, BytesToWrite); - end; - // Remember our new position - Inc(FBufPos, BytesToWrite); - // Make sure the count of valid bytes is correct - if FBytesInBuf < FBufPos then - FBytesInBuf := FBufPos; - // Make sure the stream size is correct - if FSize < (FBufStart + FBytesInBuf) then - FSize := FBufStart + FBytesInBuf; - // If we're at the end of the buffer, write it out and advance to the - // start of the next page - if FBufPos = FBufSize then - begin - WriteBuffer; - FDirty := False; - Inc(FBufStart, FBufSize); - FBufPos := 0; - FBytesInBuf := 0; - end; -end; - -{ File IO functions } - -function FileOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl; -var - Stream: TStream; -begin - Stream := nil; - - case Mode of - omReadOnly: Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - omCreate: Stream := TFileStream.Create(FileName, fmCreate); - omReadWrite: - begin - if FileExists(FileName) then - Stream := TFileStream.Create(FileName, fmOpenReadWrite or fmShareExclusive) - else - Stream := TFileStream.Create(FileName, fmCreate); - end; - end; - - Assert(Stream <> nil); - Result := TBufferedStream.Create(Stream); -end; - -procedure FileClose(Handle: TImagingHandle); cdecl; -var - Stream: TStream; -begin - Stream := TBufferedStream(Handle).Stream; - TBufferedStream(Handle).Free; - Stream.Free; -end; - -function FileEof(Handle: TImagingHandle): Boolean; cdecl; -begin - Result := TBufferedStream(Handle).Position = TBufferedStream(Handle).Size; -end; - -function FileSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): - LongInt; cdecl; -begin - Result := TBufferedStream(Handle).Seek(Offset, LongInt(Mode)); -end; - -function FileTell(Handle: TImagingHandle): LongInt; cdecl; -begin - Result := TBufferedStream(Handle).Position; -end; - -function FileRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -begin - Result := TBufferedStream(Handle).Read(Buffer^, Count); -end; - -function FileWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -begin - Result := TBufferedStream(Handle).Write(Buffer^, Count); -end; - -{ Stream IO functions } - -function StreamOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl; -begin - Result := FileName; -end; - -procedure StreamClose(Handle: TImagingHandle); cdecl; -begin -end; - -function StreamEof(Handle: TImagingHandle): Boolean; cdecl; -begin - Result := TStream(Handle).Position = TStream(Handle).Size; -end; - -function StreamSeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): - LongInt; cdecl; -begin - Result := TStream(Handle).Seek(Offset, LongInt(Mode)); -end; - -function StreamTell(Handle: TImagingHandle): LongInt; cdecl; -begin - Result := TStream(Handle).Position; -end; - -function StreamRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -begin - Result := TStream(Handle).Read(Buffer^, Count); -end; - -function StreamWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -begin - Result := TStream(Handle).Write(Buffer^, Count); -end; - -{ Memory IO functions } - -function MemoryOpen(FileName: PChar; Mode: TOpenMode): TImagingHandle; cdecl; -begin - Result := FileName; -end; - -procedure MemoryClose(Handle: TImagingHandle); cdecl; -begin -end; - -function MemoryEof(Handle: TImagingHandle): Boolean; cdecl; -begin - Result := PMemoryIORec(Handle).Position = PMemoryIORec(Handle).Size; -end; - -function MemorySeek(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): - LongInt; cdecl; -begin - Result := PMemoryIORec(Handle).Position; - case Mode of - smFromBeginning: Result := Offset; - smFromCurrent: Result := PMemoryIORec(Handle).Position + Offset; - smFromEnd: Result := PMemoryIORec(Handle).Size + Offset; - end; - //Result := ClampInt(Result, 0, PMemoryIORec(Handle).Size); don't do this - some file formats use it - PMemoryIORec(Handle).Position := Result; -end; - -function MemoryTell(Handle: TImagingHandle): LongInt; cdecl; -begin - Result := PMemoryIORec(Handle).Position; -end; - -function MemoryRead(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -var - Rec: PMemoryIORec; -begin - Rec := PMemoryIORec(Handle); - Result := Count; - if Rec.Position + Count > Rec.Size then - Result := Rec.Size - Rec.Position; - Move(Rec.Data[Rec.Position], Buffer^, Result); - Rec.Position := Rec.Position + Result; -end; - -function MemoryWrite(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): - LongInt; cdecl; -var - Rec: PMemoryIORec; -begin - Rec := PMemoryIORec(Handle); - Result := Count; - if Rec.Position + Count > Rec.Size then - Result := Rec.Size - Rec.Position; - Move(Buffer^, Rec.Data[Rec.Position], Result); - Rec.Position := Rec.Position + Result; -end; - -{ Helper IO functions } - -function GetInputSize(IOFunctions: TIOFunctions; Handle: TImagingHandle): LongInt; -var - OldPos: Int64; -begin - OldPos := IOFunctions.Tell(Handle); - IOFunctions.Seek(Handle, 0, smFromEnd); - Result := IOFunctions.Tell(Handle); - IOFunctions.Seek(Handle, OldPos, smFromBeginning); -end; - -function PrepareMemIO(Data: Pointer; Size: LongInt): TMemoryIORec; -begin - Result.Data := Data; - Result.Position := 0; - Result.Size := Size; -end; - -function ReadLine(IOFunctions: TIOFunctions; Handle: TImagingHandle; - out Line: AnsiString; FailOnControlChars: Boolean): Boolean; -const - MaxLine = 1024; -var - EolPos, Pos: Integer; - C: AnsiChar; - EolReached: Boolean; - Endings: set of AnsiChar; -begin - Line := ''; - Pos := 0; - EolPos := 0; - EolReached := False; - Endings := [#10, #13]; - Result := True; - - while not IOFunctions.Eof(Handle) do - begin - IOFunctions.Read(Handle, @C, SizeOf(C)); - - if FailOnControlChars and (Byte(C) < $20) then - begin - Break; - end; - - if not (C in Endings) then - begin - if EolReached then - begin - IOFunctions.Seek(Handle, EolPos, smFromBeginning); - Exit; - end - else - begin - SetLength(Line, Length(Line) + 1); - Line[Length(Line)] := C; - end; - end - else if not EolReached then - begin - EolReached := True; - EolPos := IOFunctions.Tell(Handle); - end; - - Inc(Pos); - if Pos >= MaxLine then - begin - Break; - end; - end; - - Result := False; - IOFunctions.Seek(Handle, -Pos, smFromCurrent); -end; - -procedure WriteLine(IOFunctions: TIOFunctions; Handle: TImagingHandle; - const Line: AnsiString; const LineEnding: AnsiString); -var - ToWrite: AnsiString; -begin - ToWrite := Line + LineEnding; - IOFunctions.Write(Handle, @ToWrite[1], Length(ToWrite)); -end; - -initialization - OriginalFileIO.Open := FileOpen; - OriginalFileIO.Close := FileClose; - OriginalFileIO.Eof := FileEof; - OriginalFileIO.Seek := FileSeek; - OriginalFileIO.Tell := FileTell; - OriginalFileIO.Read := FileRead; - OriginalFileIO.Write := FileWrite; - - StreamIO.Open := StreamOpen; - StreamIO.Close := StreamClose; - StreamIO.Eof := StreamEof; - StreamIO.Seek := StreamSeek; - StreamIO.Tell := StreamTell; - StreamIO.Read := StreamRead; - StreamIO.Write := StreamWrite; - - MemoryIO.Open := MemoryOpen; - MemoryIO.Close := MemoryClose; - MemoryIO.Eof := MemoryEof; - MemoryIO.Seek := MemorySeek; - MemoryIO.Tell := MemoryTell; - MemoryIO.Read := MemoryRead; - MemoryIO.Write := MemoryWrite; - - ResetFileIO; - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - Updated IO Open functions according to changes in ImagingTypes. - - Added ReadLine and WriteLine functions. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added merge between buffered read-only and write-only file - stream adapters - TIFF saving needed both reading and writing. - - Fixed bug causing wrong value of TBufferedWriteFile.Size - (needed to add buffer pos to size). - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Removed TMemoryIORec.Written, use Position to get proper memory - position (Written didn't take Seeks into account). - - Added TBufferedReadFile and TBufferedWriteFile classes for - buffered file reading/writting. File IO functions now use these - classes resulting in performance increase mainly in file formats - that read/write many small chunks. - - Added fmShareDenyWrite to FileOpenRead. You can now read - files opened for reading by Imaging from other apps. - - Added GetInputSize and PrepareMemIO helper functions. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - changed behaviour of MemorySeek to act as TStream - based Seeks -} -end. - diff --git a/3rd/Imaging/Source/ImagingJpeg.pas b/3rd/Imaging/Source/ImagingJpeg.pas deleted file mode 100644 index 94f537132..000000000 --- a/3rd/Imaging/Source/ImagingJpeg.pas +++ /dev/null @@ -1,769 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Jpeg images.} -unit ImagingJpeg; - -{$I ImagingOptions.inc} - -{ You can choose which Pascal JpegLib implementation will be used. - IMJPEGLIB is version bundled with Imaging which works with all supported - compilers and platforms. - PASJPEG is original JpegLib translation or version modified for FPC - (and shipped with it). You can use PASJPEG if this version is already - linked with another part of your program and you don't want to have - two quite large almost the same libraries linked to your exe. - This is the case with Lazarus applications for example.} - -{$DEFINE IMJPEGLIB} -{ $DEFINE PASJPEG} - -{ Automatically use FPC's PasJpeg when compiling with Lazarus. But not when - WINDOWS is defined. See http://galfar.vevb.net/imaging/smf/index.php/topic,90.0.html. - Fixed in FPC revision 13963: http://bugs.freepascal.org/view.php?id=14928 } -{$IF Defined(LCL) and not Defined(WINDOWS)} - {$UNDEF IMJPEGLIB} - {$DEFINE PASJPEG} -{$IFEND} - -{ We usually want to skip the rest of the corrupted file when loading JEPG files - instead of getting exception. JpegLib's error handler can only be - exited using setjmp/longjmp ("non-local goto") functions to get error - recovery when loading corrupted JPEG files. This is implemented in assembler - and currently available only for 32bit Delphi targets and FPC.} -{$DEFINE ErrorJmpRecovery} -{$IF Defined(DCC) and not Defined(CPUX86)} - {$UNDEF ErrorJmpRecovery} -{$IFEND} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingColors, -{$IF Defined(IMJPEGLIB)} - imjpeglib, imjmorecfg, imjcomapi, imjdapimin, imjdeferr, imjerror, - imjdapistd, imjcapimin, imjcapistd, imjdmarker, imjcparam, -{$ELSEIF Defined(PASJPEG)} - jpeglib, jmorecfg, jcomapi, jdapimin, jdeferr, jerror, - jdapistd, jcapimin, jcapistd, jdmarker, jcparam, -{$IFEND} - ImagingUtility; - -{$IF Defined(FPC) and Defined(PASJPEG)} - { When using FPC's pasjpeg in FPC the channel order is BGR instead of RGB} - {$DEFINE RGBSWAPPED} -{$IFEND} - -type - { Class for loading/saving Jpeg images. Supports load/save of - 8 bit grayscale and 24 bit RGB images. Jpegs can be saved with optional - progressive encoding. - Based on IJG's JpegLib so doesn't support alpha channels and lossless - coding.} - TJpegFileFormat = class(TImageFileFormat) - private - FGrayScale: Boolean; - protected - FQuality: LongInt; - FProgressive: LongBool; - procedure SetJpegIO(const JpegIO: TIOFunctions); virtual; - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Controls Jpeg save compression quality. It is number in range 1..100. - 1 means small/ugly file, 100 means large/nice file. Accessible trough - ImagingJpegQuality option.} - property Quality: LongInt read FQuality write FQuality; - { If True Jpeg images are saved in progressive format. Accessible trough - ImagingJpegProgressive option.} - property Progressive: LongBool read FProgressive write FProgressive; - end; - -implementation - -const - SJpegFormatName = 'Joint Photographic Experts Group Image'; - SJpegMasks = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif'; - JpegSupportedFormats: TImageFormats = [ifR8G8B8, ifGray8]; - JpegDefaultQuality = 90; - JpegDefaultProgressive = False; - -const - { Jpeg file identifiers.} - JpegMagic: TChar2 = #$FF#$D8; - BufferSize = 16384; - -resourcestring - SJpegError = 'JPEG Error'; - -type - TJpegContext = record - case Byte of - 0: (common: jpeg_common_struct); - 1: (d: jpeg_decompress_struct); - 2: (c: jpeg_compress_struct); - end; - - TSourceMgr = record - Pub: jpeg_source_mgr; - Input: TImagingHandle; - Buffer: JOCTETPTR; - StartOfFile: Boolean; - end; - PSourceMgr = ^TSourceMgr; - - TDestMgr = record - Pub: jpeg_destination_mgr; - Output: TImagingHandle; - Buffer: JOCTETPTR; - end; - PDestMgr = ^TDestMgr; - -var - JIO: TIOFunctions; - JpegErrorMgr: jpeg_error_mgr; - -{ Intenal unit jpeglib support functions } - -{$IFDEF ErrorJmpRecovery} - {$IFDEF DCC} - type - jmp_buf = record - EBX, - ESI, - EDI, - ESP, - EBP, - EIP: LongWord; - end; - pjmp_buf = ^jmp_buf; - - { JmpLib SetJmp/LongJmp Library - (C)Copyright 2003, 2004 Will DeWitt Jr. } - function SetJmp(out jmpb: jmp_buf): Integer; - asm - { -> EAX jmpb } - { <- EAX Result } - MOV EDX, [ESP] // Fetch return address (EIP) - // Save task state - MOV [EAX+jmp_buf.&EBX], EBX - MOV [EAX+jmp_buf.&ESI], ESI - MOV [EAX+jmp_buf.&EDI], EDI - MOV [EAX+jmp_buf.&ESP], ESP - MOV [EAX+jmp_buf.&EBP], EBP - MOV [EAX+jmp_buf.&EIP], EDX - - SUB EAX, EAX - @@1: - end; - - procedure LongJmp(const jmpb: jmp_buf; retval: Integer); - asm - { -> EAX jmpb } - { EDX retval } - { <- EAX Result } - XCHG EDX, EAX - - MOV ECX, [EDX+jmp_buf.&EIP] - // Restore task state - MOV EBX, [EDX+jmp_buf.&EBX] - MOV ESI, [EDX+jmp_buf.&ESI] - MOV EDI, [EDX+jmp_buf.&EDI] - MOV ESP, [EDX+jmp_buf.&ESP] - MOV EBP, [EDX+jmp_buf.&EBP] - MOV [ESP], ECX // Restore return address (EIP) - - TEST EAX, EAX // Ensure retval is <> 0 - JNZ @@1 - MOV EAX, 1 - @@1: - end; - {$ENDIF} - -type - TJmpBuf = jmp_buf; - TErrorClientData = record - JmpBuf: TJmpBuf; - ScanlineReadReached: Boolean; - end; - PErrorClientData = ^TErrorClientData; -{$ENDIF} - -procedure JpegError(CInfo: j_common_ptr); - - procedure RaiseError; - var - Buffer: AnsiString; - begin - // Create the message and raise exception - CInfo.err.format_message(CInfo, Buffer); - // Warning: you can get "Invalid argument index in format" exception when - // using FPC (see http://bugs.freepascal.org/view.php?id=21229). - // Fixed in FPC 2.7.1 - {$IF Defined(FPC) and (FPC_FULLVERSION <= 20701)} - raise EImagingError.CreateFmt(SJPEGError + ' %d', [CInfo.err.msg_code]); - {$ELSE} - raise EImagingError.CreateFmt(SJPEGError + ' %d: ' + string(Buffer), [CInfo.err.msg_code]); - {$IFEND} - end; - -begin -{$IFDEF ErrorJmpRecovery} - // Only recovers on loads and when header is sucessfully loaded - // (error occurs when reading scanlines) - if (CInfo.client_data <> nil) and - PErrorClientData(CInfo.client_data).ScanlineReadReached then - begin - // Non-local jump to error handler in TJpegFileFormat.LoadData - longjmp(PErrorClientData(CInfo.client_data).JmpBuf, 1) - end - else - RaiseError; -{$ELSE} - RaiseError; -{$ENDIF} -end; - -procedure OutputMessage(CurInfo: j_common_ptr); -begin -end; - -procedure ReleaseContext(var jc: TJpegContext); -begin - if jc.common.err = nil then - Exit; - jpeg_destroy(@jc.common); - jpeg_destroy_decompress(@jc.d); - jpeg_destroy_compress(@jc.c); - jc.common.err := nil; -end; - -procedure InitSource(cinfo: j_decompress_ptr); -begin - PSourceMgr(cinfo.src).StartOfFile := True; -end; - -function FillInputBuffer(cinfo: j_decompress_ptr): Boolean; -var - NBytes: LongInt; - Src: PSourceMgr; -begin - Src := PSourceMgr(cinfo.src); - NBytes := JIO.Read(Src.Input, Src.Buffer, BufferSize); - - if NBytes <= 0 then - begin - PByteArray(Src.Buffer)[0] := $FF; - PByteArray(Src.Buffer)[1] := JPEG_EOI; - NBytes := 2; - end; - Src.Pub.next_input_byte := Src.Buffer; - Src.Pub.bytes_in_buffer := NBytes; - Src.StartOfFile := False; - Result := True; -end; - -procedure SkipInputData(cinfo: j_decompress_ptr; num_bytes: LongInt); -var - Src: PSourceMgr; -begin - Src := PSourceMgr(cinfo.src); - if num_bytes > 0 then - begin - while num_bytes > Src.Pub.bytes_in_buffer do - begin - Dec(num_bytes, Src.Pub.bytes_in_buffer); - FillInputBuffer(cinfo); - end; - Src.Pub.next_input_byte := @PByteArray(Src.Pub.next_input_byte)[num_bytes]; - //Inc(LongInt(Src.Pub.next_input_byte), num_bytes); - Dec(Src.Pub.bytes_in_buffer, num_bytes); - end; -end; - -procedure TermSource(cinfo: j_decompress_ptr); -var - Src: PSourceMgr; -begin - Src := PSourceMgr(cinfo.src); - // Move stream position back just after EOI marker so that more that one - // JPEG images can be loaded from one stream - JIO.Seek(Src.Input, -Src.Pub.bytes_in_buffer, smFromCurrent); -end; - -procedure JpegStdioSrc(var cinfo: jpeg_decompress_struct; Handle: - TImagingHandle); -var - Src: PSourceMgr; -begin - if cinfo.src = nil then - begin - cinfo.src := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT, - SizeOf(TSourceMgr)); - Src := PSourceMgr(cinfo.src); - Src.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT, - BufferSize * SizeOf(JOCTET)); - end; - Src := PSourceMgr(cinfo.src); - Src.Pub.init_source := InitSource; - Src.Pub.fill_input_buffer := FillInputBuffer; - Src.Pub.skip_input_data := SkipInputData; - Src.Pub.resync_to_restart := jpeg_resync_to_restart; - Src.Pub.term_source := TermSource; - Src.Input := Handle; - Src.Pub.bytes_in_buffer := 0; - Src.Pub.next_input_byte := nil; -end; - -procedure InitDest(cinfo: j_compress_ptr); -var - Dest: PDestMgr; -begin - Dest := PDestMgr(cinfo.dest); - Dest.Pub.next_output_byte := Dest.Buffer; - Dest.Pub.free_in_buffer := BufferSize; -end; - -function EmptyOutput(cinfo: j_compress_ptr): Boolean; -var - Dest: PDestMgr; -begin - Dest := PDestMgr(cinfo.dest); - JIO.Write(Dest.Output, Dest.Buffer, BufferSize); - Dest.Pub.next_output_byte := Dest.Buffer; - Dest.Pub.free_in_buffer := BufferSize; - Result := True; -end; - -procedure TermDest(cinfo: j_compress_ptr); -var - Dest: PDestMgr; - DataCount: LongInt; -begin - Dest := PDestMgr(cinfo.dest); - DataCount := BufferSize - Dest.Pub.free_in_buffer; - if DataCount > 0 then - JIO.Write(Dest.Output, Dest.Buffer, DataCount); -end; - -procedure JpegStdioDest(var cinfo: jpeg_compress_struct; Handle: - TImagingHandle); -var - Dest: PDestMgr; -begin - if cinfo.dest = nil then - cinfo.dest := cinfo.mem.alloc_small(j_common_ptr(@cinfo), - JPOOL_PERMANENT, SizeOf(TDestMgr)); - Dest := PDestMgr(cinfo.dest); - Dest.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_IMAGE, - BufferSize * SIZEOF(JOCTET)); - Dest.Pub.init_destination := InitDest; - Dest.Pub.empty_output_buffer := EmptyOutput; - Dest.Pub.term_destination := TermDest; - Dest.Output := Handle; -end; - -procedure SetupErrorMgr(var jc: TJpegContext); -begin - // Set standard error handlers and then override some - jc.common.err := jpeg_std_error(JpegErrorMgr); - jc.common.err.error_exit := JpegError; - jc.common.err.output_message := OutputMessage; -end; - -procedure InitDecompressor(Handle: TImagingHandle; var jc: TJpegContext); -begin - jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, sizeof(jc.d)); - JpegStdioSrc(jc.d, Handle); - jpeg_read_header(@jc.d, True); - jc.d.scale_num := 1; - jc.d.scale_denom := 1; - jc.d.do_block_smoothing := True; - if jc.d.out_color_space = JCS_GRAYSCALE then - begin - jc.d.quantize_colors := True; - jc.d.desired_number_of_colors := 256; - end; -end; - -procedure InitCompressor(Handle: TImagingHandle; var jc: TJpegContext; - Saver: TJpegFileFormat); -begin - jpeg_CreateCompress(@jc.c, JPEG_LIB_VERSION, sizeof(jc.c)); - JpegStdioDest(jc.c, Handle); - if Saver.FGrayScale then - jc.c.in_color_space := JCS_GRAYSCALE - else - jc.c.in_color_space := JCS_RGB; - jpeg_set_defaults(@jc.c); - jpeg_set_quality(@jc.c, Saver.FQuality, True); - if Saver.FProgressive then - jpeg_simple_progression(@jc.c); -end; - -{ TJpegFileFormat class implementation } - -procedure TJpegFileFormat.Define; -begin - FName := SJpegFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := JpegSupportedFormats; - - FQuality := JpegDefaultQuality; - FProgressive := JpegDefaultProgressive; - - AddMasks(SJpegMasks); - RegisterOption(ImagingJpegQuality, @FQuality); - RegisterOption(ImagingJpegProgressive, @FProgressive); -end; - -procedure TJpegFileFormat.CheckOptionsValidity; -begin - // Check if option values are valid - if not (FQuality in [1..100]) then - FQuality := JpegDefaultQuality; -end; - -function TJpegFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - PtrInc, LinesPerCall, LinesRead, I: Integer; - Dest: PByte; - jc: TJpegContext; - Info: TImageFormatInfo; - Col32: PColor32Rec; - NeedsRedBlueSwap: Boolean; - Pix: PColor24Rec; -{$IFDEF ErrorJmpRecovery} - ErrorClient: TErrorClientData; -{$ENDIF} - - procedure LoadMetaData; - var - XDensity, YDensity: Single; - ResUnit: TResolutionUnit; - begin - // Density unit: 0 - undef, 1 - inch, 2 - cm - if jc.d.saw_JFIF_marker and (jc.d.density_unit > 0) and - (jc.d.X_density > 0) and (jc.d.Y_density > 0) then - begin - XDensity := jc.d.X_density; - YDensity := jc.d.Y_density; - ResUnit := ruDpi; - if jc.d.density_unit = 2 then - ResUnit := ruDpcm; - FMetadata.SetPhysicalPixelSize(ResUnit, XDensity, YDensity); - end; - end; - -begin - // Copy IO functions to global var used in JpegLib callbacks - Result := False; - SetJpegIO(GetIO); - SetLength(Images, 1); - - with JIO, Images[0] do - try - ZeroMemory(@jc, SizeOf(jc)); - SetupErrorMgr(jc); - {$IFDEF ErrorJmpRecovery} - ZeroMemory(@ErrorClient, SizeOf(ErrorClient)); - jc.common.client_data := @ErrorClient; - if setjmp(ErrorClient.JmpBuf) <> 0 then - begin - Result := True; - Exit; - end; - {$ENDIF} - InitDecompressor(Handle, jc); - - case jc.d.out_color_space of - JCS_GRAYSCALE: Format := ifGray8; - JCS_RGB: Format := ifR8G8B8; - JCS_CMYK: Format := ifA8R8G8B8; - else - Exit; - end; - - NewImage(jc.d.image_width, jc.d.image_height, Format, Images[0]); - jpeg_start_decompress(@jc.d); - GetImageFormatInfo(Format, Info); - PtrInc := Width * Info.BytesPerPixel; - LinesPerCall := 1; - Dest := Bits; - - // If Jpeg's colorspace is RGB and not YCbCr we need to swap - // R and B to get Imaging's native order - NeedsRedBlueSwap := jc.d.jpeg_color_space = JCS_RGB; - {$IFDEF RGBSWAPPED} - // Force R-B swap for FPC's PasJpeg - NeedsRedBlueSwap := True; - {$ENDIF} - - {$IFDEF ErrorJmpRecovery} - ErrorClient.ScanlineReadReached := True; - {$ENDIF} - - while jc.d.output_scanline < jc.d.output_height do - begin - LinesRead := jpeg_read_scanlines(@jc.d, @Dest, LinesPerCall); - if NeedsRedBlueSwap and (Format = ifR8G8B8) then - begin - Pix := PColor24Rec(Dest); - for I := 0 to Width - 1 do - begin - SwapValues(Pix.R, Pix.B); - Inc(Pix); - end; - end; - Inc(Dest, PtrInc * LinesRead); - end; - - if jc.d.out_color_space = JCS_CMYK then - begin - Col32 := Bits; - // Translate from CMYK to RGB - for I := 0 to Width * Height - 1 do - begin - CMYKToRGB(255 - Col32.B, 255 - Col32.G, 255 - Col32.R, 255 - Col32.A, - Col32.R, Col32.G, Col32.B); - Col32.A := 255; - Inc(Col32); - end; - end; - - // Store supported metadata - LoadMetaData; - - jpeg_finish_output(@jc.d); - jpeg_finish_decompress(@jc.d); - Result := True; - finally - ReleaseContext(jc); - end; -end; - -function TJpegFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - PtrInc, LinesWritten: LongInt; - Src, Line: PByte; - jc: TJpegContext; - ImageToSave: TImageData; - Info: TImageFormatInfo; - MustBeFreed: Boolean; -{$IFDEF RGBSWAPPED} - I: LongInt; - Pix: PColor24Rec; -{$ENDIF} - - procedure SaveMetaData; - var - XRes, YRes: Single; - begin - if FMetadata.GetPhysicalPixelSize(ruDpcm, XRes, YRes, True) then - begin - jc.c.density_unit := 2; // Dots per cm - jc.c.X_density := Round(XRes); - jc.c.Y_density := Round(YRes) - end; - end; - -begin - Result := False; - // Copy IO functions to global var used in JpegLib callbacks - SetJpegIO(GetIO); - - // Makes image to save compatible with Jpeg saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with JIO, ImageToSave do - try - ZeroMemory(@jc, SizeOf(jc)); - SetupErrorMgr(jc); - - GetImageFormatInfo(Format, Info); - FGrayScale := Format = ifGray8; - InitCompressor(Handle, jc, Self); - jc.c.image_width := Width; - jc.c.image_height := Height; - if FGrayScale then - begin - jc.c.input_components := 1; - jc.c.in_color_space := JCS_GRAYSCALE; - end - else - begin - jc.c.input_components := 3; - jc.c.in_color_space := JCS_RGB; - end; - - PtrInc := Width * Info.BytesPerPixel; - Src := Bits; - - {$IFDEF RGBSWAPPED} - GetMem(Line, PtrInc); - {$ENDIF} - - // Save supported metadata - SaveMetaData; - - jpeg_start_compress(@jc.c, True); - while (jc.c.next_scanline < jc.c.image_height) do - begin - {$IFDEF RGBSWAPPED} - if Format = ifR8G8B8 then - begin - Move(Src^, Line^, PtrInc); - Pix := PColor24Rec(Line); - for I := 0 to Width - 1 do - begin - SwapValues(Pix.R, Pix.B); - Inc(Pix, 1); - end; - end; - {$ELSE} - Line := Src; - {$ENDIF} - - LinesWritten := jpeg_write_scanlines(@jc.c, @Line, 1); - Inc(Src, PtrInc * LinesWritten); - end; - - jpeg_finish_compress(@jc.c); - Result := True; - finally - ReleaseContext(jc); - if MustBeFreed then - FreeImage(ImageToSave); - {$IFDEF RGBSWAPPED} - FreeMem(Line); - {$ENDIF} - end; -end; - -procedure TJpegFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - if Info.HasGrayChannel then - ConvertImage(Image, ifGray8) - else - ConvertImage(Image, ifR8G8B8); -end; - -function TJpegFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - ID: array[0..9] of AnsiChar; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(ID, SizeOf(ID), 0); - ReadCount := Read(Handle, @ID, SizeOf(ID)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(ID)) and - CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic)); - end; -end; - -procedure TJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions); -begin - JIO := JpegIO; -end; - -initialization - RegisterImageFileFormat(TJpegFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 --------------------------------------------------- - - Able to read corrupted JPEG files - loads partial image - and skips the corrupted parts (FPC and x86 Delphi). - - Fixed reading of physical resolution metadata, could cause - "divided by zero" later on for some files. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Fixed loading of some JPEGs with certain APPN markers (bug in JpegLib). - - Fixed swapped Red-Blue order when loading Jpegs with - jc.d.jpeg_color_space = JCS_RGB. - - Added loading and saving of physical pixel size metadata. - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Changed the Jpeg error manager, messages were not properly formated. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Fixed wrong color space setting in InitCompressor. - - Fixed problem with progressive Jpegs in FPC (modified JpegLib, - can't use FPC's PasJpeg in Windows). - - -- 0.25.0 Changes/Bug Fixes --------------------------------- - - FPC's PasJpeg wasn't really used in last version, fixed. - - -- 0.24.1 Changes/Bug Fixes --------------------------------- - - Fixed loading of CMYK jpeg images. Could cause heap corruption - and loaded image looked wrong. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Removed JFIF/EXIF detection from TestFormat. Found JPEGs - with different headers (Lavc) which weren't recognized. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Made public properties for options registered to SetOption/GetOption - functions. - - Changed extensions to filename masks. - - Changed SaveData, LoadData, and MakeCompatible methods according - to changes in base class in Imaging unit. - - Changes in TestFormat, now reads JFIF and EXIF signatures too. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - input position is now set correctly to the end of the image - after loading is done. Loading of sequence of JPEG files stored in - single stream works now - - when loading and saving images in FPC with PASJPEG read and - blue channels are swapped to have the same chanel order as IMJPEGLIB - - you can now choose between IMJPEGLIB and PASJPEG implementations - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added SetJpegIO method which is used by JNG image format -} -end. - diff --git a/3rd/Imaging/Source/ImagingNetworkGraphics.pas b/3rd/Imaging/Source/ImagingNetworkGraphics.pas deleted file mode 100644 index 9d5a23fbb..000000000 --- a/3rd/Imaging/Source/ImagingNetworkGraphics.pas +++ /dev/null @@ -1,2695 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loaders/savers for Network Graphics image - file formats PNG, MNG, and JNG.} -unit ImagingNetworkGraphics; - -interface - -{$I ImagingOptions.inc} - -{ If MNG support is enabled we must make sure PNG and JNG are enabled too.} -{$IFNDEF DONT_LINK_MNG} - {$UNDEF DONT_LINK_PNG} - {$UNDEF DONT_LINK_JNG} -{$ENDIF} - -uses - Types, SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility, ImagingFormats, dzlib; - -type - { Basic class for Network Graphics file formats loaders/savers.} - TNetworkGraphicsFileFormat = class(TImageFileFormat) - protected - FSignature: TChar8; - FPreFilter: LongInt; - FCompressLevel: LongInt; - FLossyCompression: LongBool; - FLossyAlpha: LongBool; - FQuality: LongInt; - FProgressive: LongBool; - FZLibStategy: Integer; - function GetSupportedFormats: TImageFormats; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - procedure Define; override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - procedure CheckOptionsValidity; override; - published - { Sets precompression filter used when saving images with lossless compression. - Allowed values are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth), - 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images), - 6 (adaptive filtering - use best filter for each scanline - very slow). - Note that filters 3 and 4 are much slower than filters 1 and 2. - Default value is 5.} - property PreFilter: LongInt read FPreFilter write FPreFilter; - { Sets ZLib compression level used when saving images with lossless compression. - Allowed values are in range 0 (no compresstion) to 9 (best compression). - Default value is 5.} - property CompressLevel: LongInt read FCompressLevel write FCompressLevel; - { Specifies whether MNG animation frames are saved with lossy or lossless - compression. Lossless frames are saved as PNG images and lossy frames are - saved as JNG images. Allowed values are 0 (False) and 1 (True). - Default value is 0.} - property LossyCompression: LongBool read FLossyCompression write FLossyCompression; - { Defines whether alpha channel of lossy MNG frames or JNG images - is lossy compressed too. Allowed values are 0 (False) and 1 (True). - Default value is 0.} - property LossyAlpha: LongBool read FLossyAlpha write FLossyAlpha; - { Specifies compression quality used when saving lossy MNG frames or JNG images. - For details look at ImagingJpegQuality option.} - property Quality: LongInt read FQuality write FQuality; - { Specifies whether images are saved in progressive format when saving lossy - MNG frames or JNG images. For details look at ImagingJpegProgressive.} - property Progressive: LongBool read FProgressive write FProgressive; - end; - - { Class for loading Portable Network Graphics Images. - Loads all types of this image format (all images in png test suite) - and saves all types with bitcount >= 8 (non-interlaced only). - Compression level and filtering can be set by options interface. - - Supported ancillary chunks (loading): - tRNS, bKGD - (for indexed images transparency contains alpha values for palette, - RGB/Gray images with transparency are converted to formats with alpha - and pixels with transparent color are replaced with background color - with alpha = 0).} - TPNGFileFormat = class(TNetworkGraphicsFileFormat) - private - FLoadAnimated: LongBool; - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - published - property LoadAnimated: LongBool read FLoadAnimated write FLoadAnimated; - end; - -{$IFNDEF DONT_LINK_MNG} - { Class for loading Multiple Network Graphics files. - This format has complex animation capabilities but Imaging only - extracts frames. Individual frames are stored as standard PNG or JNG - images. Loads all types of these frames stored in IHDR-IEND and - JHDR-IEND streams (Note that there are MNG chunks - like BASI which define images but does not contain image data itself, - those are ignored). - Imaging saves MNG files as MNG-VLC (very low complexity) so it is basicaly - an array of image frames without MNG animation chunks. Frames can be saved - as lossless PNG or lossy JNG images (look at TPNGFileFormat and - TJNGFileFormat for info). Every frame can be in different data format. - - Many frame compression settings can be modified by options interface.} - TMNGFileFormat = class(TNetworkGraphicsFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; -{$ENDIF} - -{$IFNDEF DONT_LINK_JNG} - { Class for loading JPEG Network Graphics Images. - Loads all types of this image format (all images in jng test suite) - and saves all types except 12 bit JPEGs. - Alpha channel in JNG images is stored separately from color/gray data and - can be lossy (as JPEG image) or lossless (as PNG image) compressed. - Type of alpha compression, compression level and quality, - and filtering can be set by options interface. - - Supported ancillary chunks (loading): - tRNS, bKGD - (Images with transparency are converted to formats with alpha - and pixels with transparent color are replaced with background color - with alpha = 0).} - TJNGFileFormat = class(TNetworkGraphicsFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - end; -{$ENDIF} - - -implementation - -uses -{$IFNDEF DONT_LINK_JNG} - ImagingJpeg, ImagingIO, -{$ENDIF} - ImagingCanvases; - -const - NGDefaultPreFilter = 5; - NGDefaultCompressLevel = 5; - NGDefaultLossyAlpha = False; - NGDefaultLossyCompression = False; - NGDefaultProgressive = False; - NGDefaultQuality = 90; - NGLosslessFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, ifGray16, - ifA16Gray16, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, ifA16R16G16B16, ifB16G16R16, - ifA16B16G16R16, ifBinary]; - NGLossyFormats: TImageFormats = [ifGray8, ifA8Gray8, ifR8G8B8, ifA8R8G8B8]; - PNGDefaultLoadAnimated = True; - NGDefaultZLibStartegy = 1; // Z_FILTERED - - SPNGFormatName = 'Portable Network Graphics'; - SPNGMasks = '*.png'; - SMNGFormatName = 'Multiple Network Graphics'; - SMNGMasks = '*.mng'; - SJNGFormatName = 'JPEG Network Graphics'; - SJNGMasks = '*.jng'; - -resourcestring - SErrorLoadingChunk = 'Error when reading %s chunk data. File may be corrupted.'; - -type - { Chunk header.} - TChunkHeader = packed record - DataSize: LongWord; - ChunkID: TChar4; - end; - - { IHDR chunk format - PNG header.} - TIHDR = packed record - Width: LongWord; // Image width - Height: LongWord; // Image height - BitDepth: Byte; // Bits per pixel or bits per sample (for truecolor) - ColorType: Byte; // 0 = grayscale, 2 = truecolor, 3 = palette, - // 4 = gray + alpha, 6 = truecolor + alpha - Compression: Byte; // Compression type: 0 = ZLib - Filter: Byte; // Used precompress filter - Interlacing: Byte; // Used interlacing: 0 = no int, 1 = Adam7 - end; - PIHDR = ^TIHDR; - - { MHDR chunk format - MNG header.} - TMHDR = packed record - FrameWidth: LongWord; // Frame width - FrameHeight: LongWord; // Frame height - TicksPerSecond: LongWord; // FPS of animation - NominalLayerCount: LongWord; // Number of layers in file - NominalFrameCount: LongWord; // Number of frames in file - NominalPlayTime: LongWord; // Play time of animation in ticks - SimplicityProfile: LongWord; // Defines which MNG features are used in this file - end; - PMHDR = ^TMHDR; - - { JHDR chunk format - JNG header.} - TJHDR = packed record - Width: LongWord; // Image width - Height: LongWord; // Image height - ColorType: Byte; // 8 = grayscale (Y), 10 = color (YCbCr), - // 12 = gray + alpha (Y-alpha), 14 = color + alpha (YCbCr-alpha) - SampleDepth: Byte; // 8, 12 or 20 (8 and 12 samples together) bit - Compression: Byte; // Compression type: 8 = Huffman coding - Interlacing: Byte; // 0 = single scan, 8 = progressive - AlphaSampleDepth: Byte; // 0, 1, 2, 4, 8, 16 if alpha compression is 0 (PNG) - // 8 if alpha compression is 8 (JNG) - AlphaCompression: Byte; // 0 = PNG graysscale IDAT, 8 = grayscale 8-bit JPEG - AlphaFilter: Byte; // 0 = PNG filter or no filter (JPEG) - AlphaInterlacing: Byte; // 0 = non interlaced - end; - PJHDR = ^TJHDR; - - { acTL chunk format - APNG animation control.} - TacTL = packed record - NumFrames: LongWord; // Number of frames - NumPlay: LongWord; // Number of times to loop the animation (0 = inf) - end; - PacTL =^TacTL; - - { fcTL chunk format - APNG frame control.} - TfcTL = packed record - SeqNumber: LongWord; // Sequence number of the animation chunk, starting from 0 - Width: LongWord; // Width of the following frame - Height: LongWord; // Height of the following frame - XOffset: LongWord; // X position at which to render the following frame - YOffset: LongWord; // Y position at which to render the following frame - DelayNumer: Word; // Frame delay fraction numerator - DelayDenom: Word; // Frame delay fraction denominator - DisposeOp: Byte; // Type of frame area disposal to be done after rendering this frame - BlendOp: Byte; // Type of frame area rendering for this frame - end; - PfcTL = ^TfcTL; - - { pHYs chunk format - encodes the absolute or relative dimensions of pixels.} - TpHYs = packed record - PixelsPerUnitX: LongWord; - PixelsPerUnitY: LongWord; - UnitSpecifier: Byte; - end; - PpHYs = ^TpHYs; - -const - { PNG file identifier.} - PNGSignature: TChar8 = #$89'PNG'#$0D#$0A#$1A#$0A; - { MNG file identifier.} - MNGSignature: TChar8 = #$8A'MNG'#$0D#$0A#$1A#$0A; - { JNG file identifier.} - JNGSignature: TChar8 = #$8B'JNG'#$0D#$0A#$1A#$0A; - - { Constants for chunk identifiers and signature identifiers. - They are in big-endian format.} - IHDRChunk: TChar4 = 'IHDR'; - IENDChunk: TChar4 = 'IEND'; - MHDRChunk: TChar4 = 'MHDR'; - MENDChunk: TChar4 = 'MEND'; - JHDRChunk: TChar4 = 'JHDR'; - IDATChunk: TChar4 = 'IDAT'; - JDATChunk: TChar4 = 'JDAT'; - JDAAChunk: TChar4 = 'JDAA'; - JSEPChunk: TChar4 = 'JSEP'; - PLTEChunk: TChar4 = 'PLTE'; - BACKChunk: TChar4 = 'BACK'; - DEFIChunk: TChar4 = 'DEFI'; - TERMChunk: TChar4 = 'TERM'; - tRNSChunk: TChar4 = 'tRNS'; - bKGDChunk: TChar4 = 'bKGD'; - gAMAChunk: TChar4 = 'gAMA'; - acTLChunk: TChar4 = 'acTL'; - fcTLChunk: TChar4 = 'fcTL'; - fdATChunk: TChar4 = 'fdAT'; - pHYsChunk: TChar4 = 'pHYs'; - - { APNG frame dispose operations.} - DisposeOpNone = 0; - DisposeOpBackground = 1; - DisposeOpPrevious = 2; - - { APNG frame blending modes} - BlendOpSource = 0; - BlendOpOver = 1; - - { Interlace start and offsets.} - RowStart: array[0..6] of LongInt = (0, 0, 4, 0, 2, 0, 1); - ColumnStart: array[0..6] of LongInt = (0, 4, 0, 2, 0, 1, 0); - RowIncrement: array[0..6] of LongInt = (8, 8, 8, 4, 4, 2, 2); - ColumnIncrement: array[0..6] of LongInt = (8, 8, 4, 4, 2, 2, 1); - -type - { Helper class that holds information about MNG frame in PNG or JNG format.} - TFrameInfo = class - public - Index: Integer; - FrameWidth, FrameHeight: LongInt; - IsJpegFrame: Boolean; - IHDR: TIHDR; - JHDR: TJHDR; - fcTL: TfcTL; - pHYs: TpHYs; - Palette: PPalette24; - PaletteEntries: LongInt; - Transparency: Pointer; - TransparencySize: LongInt; - Background: Pointer; - BackgroundSize: LongInt; - IDATMemory: TMemoryStream; - JDATMemory: TMemoryStream; - JDAAMemory: TMemoryStream; - constructor Create(AIndex: Integer); - destructor Destroy; override; - procedure AssignSharedProps(Source: TFrameInfo); - end; - - { Defines type of Network Graphics file.} - TNGFileType = (ngPNG, ngAPNG, ngMNG, ngJNG); - - TNGFileHandler = class - public - FileFormat: TNetworkGraphicsFileFormat; - FileType: TNGFileType; - Frames: array of TFrameInfo; - MHDR: TMHDR; // Main header for MNG files - acTL: TacTL; // Global anim control for APNG files - GlobalPalette: PPalette24; - GlobalPaletteEntries: LongInt; - GlobalTransparency: Pointer; - GlobalTransparencySize: LongInt; - constructor Create(AFileFormat: TNetworkGraphicsFileFormat); - destructor Destroy; override; - procedure Clear; - function GetLastFrame: TFrameInfo; - function AddFrameInfo: TFrameInfo; - procedure LoadMetaData; - end; - - { Network Graphics file parser and frame converter.} - TNGFileLoader = class(TNGFileHandler) - public - function LoadFile(Handle: TImagingHandle): Boolean; - procedure LoadImageFromPNGFrame(FrameWidth, FrameHeight: LongInt; const IHDR: TIHDR; IDATStream: TMemoryStream; var Image: TImageData); -{$IFNDEF DONT_LINK_JNG} - procedure LoadImageFromJNGFrame(FrameWidth, FrameHeight: LongInt; const JHDR: TJHDR; IDATStream, JDATStream, JDAAStream: TMemoryStream; var Image: TImageData); -{$ENDIF} - procedure ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData); - end; - - TNGFileSaver = class(TNGFileHandler) - public - PreFilter: LongInt; - CompressLevel: LongInt; - LossyAlpha: Boolean; - Quality: LongInt; - Progressive: Boolean; - ZLibStrategy: Integer; - function SaveFile(Handle: TImagingHandle): Boolean; - procedure AddFrame(const Image: TImageData; IsJpegFrame: Boolean); - procedure StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer; FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream); -{$IFNDEF DONT_LINK_JNG} - procedure StoreImageToJNGFrame(const JHDR: TJHDR; const Image: TImageData; IDATStream, JDATStream, JDAAStream: TMemoryStream); -{$ENDIF} - procedure SetFileOptions; - end; - -{$IFNDEF DONT_LINK_JNG} - TCustomIOJpegFileFormat = class(TJpegFileFormat) - protected - FCustomIO: TIOFunctions; - procedure SetJpegIO(const JpegIO: TIOFunctions); override; - procedure SetCustomIO(const CustomIO: TIOFunctions); - end; -{$ENDIF} - - TAPNGAnimator = class - public - class procedure Animate(var Images: TDynImageDataArray; const acTL: TacTL; const SrcFrames: array of TFrameInfo); - end; - -{ Helper routines } - -function PaethPredictor(A, B, C: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -var - P, PA, PB, PC: LongInt; -begin - P := A + B - C; - PA := Abs(P - A); - PB := Abs(P - B); - PC := Abs(P - C); - if (PA <= PB) and (PA <= PC) then - Result := A - else - if PB <= PC then - Result := B - else - Result := C; -end; - -procedure SwapRGB(Line: PByte; Width, SampleDepth, BytesPerPixel: LongInt); -var - I: LongInt; - Tmp: Word; -begin - case SampleDepth of - 8: - for I := 0 to Width - 1 do - with PColor24Rec(Line)^ do - begin - Tmp := R; - R := B; - B := Tmp; - Inc(Line, BytesPerPixel); - end; - 16: - for I := 0 to Width - 1 do - with PColor48Rec(Line)^ do - begin - Tmp := R; - R := B; - B := Tmp; - Inc(Line, BytesPerPixel); - end; - end; - end; - -{$IFNDEF DONT_LINK_JNG} - -{ TCustomIOJpegFileFormat class implementation } - -procedure TCustomIOJpegFileFormat.SetCustomIO(const CustomIO: TIOFunctions); -begin - FCustomIO := CustomIO; -end; - -procedure TCustomIOJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions); -begin - inherited SetJpegIO(FCustomIO); -end; - -{$ENDIF} - -{ TFrameInfo class implementation } - -constructor TFrameInfo.Create(AIndex: Integer); -begin - Index := AIndex; - IDATMemory := TMemoryStream.Create; - JDATMemory := TMemoryStream.Create; - JDAAMemory := TMemoryStream.Create; -end; - -destructor TFrameInfo.Destroy; -begin - FreeMem(Palette); - FreeMem(Transparency); - FreeMem(Background); - IDATMemory.Free; - JDATMemory.Free; - JDAAMemory.Free; - inherited Destroy; -end; - -procedure TFrameInfo.AssignSharedProps(Source: TFrameInfo); -begin - IHDR := Source.IHDR; - JHDR := Source.JHDR; - PaletteEntries := Source.PaletteEntries; - GetMem(Palette, PaletteEntries * SizeOf(TColor24Rec)); - Move(Source.Palette^, Palette^, PaletteEntries * SizeOf(TColor24Rec)); - TransparencySize := Source.TransparencySize; - GetMem(Transparency, TransparencySize); - Move(Source.Transparency^, Transparency^, TransparencySize); -end; - -{ TNGFileHandler class implementation} - -destructor TNGFileHandler.Destroy; -begin - Clear; - inherited Destroy; -end; - -procedure TNGFileHandler.Clear; -var - I: LongInt; -begin - for I := 0 to Length(Frames) - 1 do - Frames[I].Free; - SetLength(Frames, 0); - FreeMemNil(GlobalPalette); - GlobalPaletteEntries := 0; - FreeMemNil(GlobalTransparency); - GlobalTransparencySize := 0; -end; - -constructor TNGFileHandler.Create(AFileFormat: TNetworkGraphicsFileFormat); -begin - FileFormat := AFileFormat; -end; - -function TNGFileHandler.GetLastFrame: TFrameInfo; -var - Len: LongInt; -begin - Len := Length(Frames); - if Len > 0 then - Result := Frames[Len - 1] - else - Result := nil; -end; - -procedure TNGFileHandler.LoadMetaData; -var - I: Integer; - Delay, Denom: Integer; -begin - if FileType = ngAPNG then - begin - // Num plays of APNG animation - FileFormat.FMetadata.SetMetaItem(SMetaAnimationLoops, acTL.NumPlay); - end; - - for I := 0 to High(Frames) do - begin - if Frames[I].pHYs.UnitSpecifier = 1 then - begin - // Store physical pixel dimensions, in PNG stored as pixels per meter DPM - FileFormat.FMetadata.SetPhysicalPixelSize(ruDpm, Frames[I].pHYs.PixelsPerUnitX, - Frames[I].pHYs.PixelsPerUnitY); - end; - if FileType = ngAPNG then - begin - // Store frame delay of APNG file frame - Denom := Frames[I].fcTL.DelayDenom; - if Denom = 0 then - Denom := 100; - Delay := Round(1000 * (Frames[I].fcTL.DelayNumer / Denom)); - FileFormat.FMetadata.SetMetaItem(SMetaFrameDelay, Delay, I); - end; - end; -end; - -function TNGFileHandler.AddFrameInfo: TFrameInfo; -var - Len: LongInt; -begin - Len := Length(Frames); - SetLength(Frames, Len + 1); - Result := TFrameInfo.Create(Len); - Frames[Len] := Result; -end; - -{ TNGFileLoader class implementation} - -function TNGFileLoader.LoadFile(Handle: TImagingHandle): Boolean; -var - Sig: TChar8; - Chunk: TChunkHeader; - ChunkData: Pointer; - ChunkCrc: LongWord; - - procedure ReadChunk; - begin - GetIO.Read(Handle, @Chunk, SizeOf(Chunk)); - Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize); - end; - - procedure ReadChunkData; - var - ReadBytes: LongWord; - begin - FreeMemNil(ChunkData); - GetMem(ChunkData, Chunk.DataSize); - ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize); - GetIO.Read(Handle, @ChunkCrc, SizeOf(ChunkCrc)); - if ReadBytes <> Chunk.DataSize then - RaiseImaging(SErrorLoadingChunk, [string(Chunk.ChunkID)]); - end; - - procedure SkipChunkData; - begin - GetIO.Seek(Handle, Chunk.DataSize + SizeOf(ChunkCrc), smFromCurrent); - end; - - procedure StartNewPNGImage; - var - Frame: TFrameInfo; - begin - ReadChunkData; - - if Chunk.ChunkID = fcTLChunk then - begin - if (Length(Frames) = 1) and (Frames[0].IDATMemory.Size = 0) then - begin - // First fcTL chunk maybe for first IDAT frame which is alredy created - Frame := Frames[0]; - end - else - begin - // Subsequent APNG frames with data in fdAT - Frame := AddFrameInfo; - // Copy some shared props from first frame (IHDR is the same for all APNG frames, palette etc) - Frame.AssignSharedProps(Frames[0]); - end; - Frame.fcTL := PfcTL(ChunkData)^; - SwapEndianLongWord(@Frame.fcTL, 5); - Frame.fcTL.DelayNumer := SwapEndianWord(Frame.fcTL.DelayNumer); - Frame.fcTL.DelayDenom := SwapEndianWord(Frame.fcTL.DelayDenom); - Frame.FrameWidth := Frame.fcTL.Width; - Frame.FrameHeight := Frame.fcTL.Height; - end - else - begin - // This is frame defined by IHDR chunk - Frame := AddFrameInfo; - Frame.IHDR := PIHDR(ChunkData)^; - SwapEndianLongWord(@Frame.IHDR, 2); - Frame.FrameWidth := Frame.IHDR.Width; - Frame.FrameHeight := Frame.IHDR.Height; - end; - Frame.IsJpegFrame := False; - end; - - procedure StartNewJNGImage; - var - Frame: TFrameInfo; - begin - ReadChunkData; - Frame := AddFrameInfo; - Frame.IsJpegFrame := True; - Frame.JHDR := PJHDR(ChunkData)^; - SwapEndianLongWord(@Frame.JHDR, 2); - Frame.FrameWidth := Frame.JHDR.Width; - Frame.FrameHeight := Frame.JHDR.Height; - end; - - procedure AppendIDAT; - begin - ReadChunkData; - // Append current IDAT/fdAT chunk to storage stream - if Chunk.ChunkID = IDATChunk then - GetLastFrame.IDATMemory.Write(ChunkData^, Chunk.DataSize) - else if Chunk.ChunkID = fdATChunk then - GetLastFrame.IDATMemory.Write(PByteArray(ChunkData)[4], Chunk.DataSize - SizeOf(LongWord)); - end; - - procedure AppendJDAT; - begin - ReadChunkData; - // Append current JDAT chunk to storage stream - GetLastFrame.JDATMemory.Write(ChunkData^, Chunk.DataSize); - end; - - procedure AppendJDAA; - begin - ReadChunkData; - // Append current JDAA chunk to storage stream - GetLastFrame.JDAAMemory.Write(ChunkData^, Chunk.DataSize); - end; - - procedure LoadPLTE; - begin - ReadChunkData; - if GetLastFrame = nil then - begin - // Load global palette - GetMem(GlobalPalette, Chunk.DataSize); - Move(ChunkData^, GlobalPalette^, Chunk.DataSize); - GlobalPaletteEntries := Chunk.DataSize div 3; - end - else if GetLastFrame.Palette = nil then - begin - if (Chunk.DataSize = 0) and (GlobalPalette <> nil) then - begin - // Use global palette - GetMem(GetLastFrame.Palette, GlobalPaletteEntries * SizeOf(TColor24Rec)); - Move(GlobalPalette^, GetLastFrame.Palette^, GlobalPaletteEntries * SizeOf(TColor24Rec)); - GetLastFrame.PaletteEntries := GlobalPaletteEntries; - end - else - begin - // Load pal from PLTE chunk - GetMem(GetLastFrame.Palette, Chunk.DataSize); - Move(ChunkData^, GetLastFrame.Palette^, Chunk.DataSize); - GetLastFrame.PaletteEntries := Chunk.DataSize div 3; - end; - end; - end; - - procedure LoadtRNS; - begin - ReadChunkData; - if GetLastFrame = nil then - begin - // Load global transparency - GetMem(GlobalTransparency, Chunk.DataSize); - Move(ChunkData^, GlobalTransparency^, Chunk.DataSize); - GlobalTransparencySize := Chunk.DataSize; - end - else if GetLastFrame.Transparency = nil then - begin - if (Chunk.DataSize = 0) and (GlobalTransparency <> nil) then - begin - // Use global transparency - GetMem(GetLastFrame.Transparency, GlobalTransparencySize); - Move(GlobalTransparency^, GetLastFrame.Transparency^, Chunk.DataSize); - GetLastFrame.TransparencySize := GlobalTransparencySize; - end - else - begin - // Load pal from tRNS chunk - GetMem(GetLastFrame.Transparency, Chunk.DataSize); - Move(ChunkData^, GetLastFrame.Transparency^, Chunk.DataSize); - GetLastFrame.TransparencySize := Chunk.DataSize; - end; - end; - end; - - procedure LoadbKGD; - begin - ReadChunkData; - if GetLastFrame.Background = nil then - begin - GetMem(GetLastFrame.Background, Chunk.DataSize); - Move(ChunkData^, GetLastFrame.Background^, Chunk.DataSize); - GetLastFrame.BackgroundSize := Chunk.DataSize; - end; - end; - - procedure HandleacTL; - begin - FileType := ngAPNG; - ReadChunkData; - acTL := PacTL(ChunkData)^; - SwapEndianLongWord(@acTL, SizeOf(acTL) div SizeOf(LongWord)); - end; - - procedure LoadpHYs; - begin - ReadChunkData; - with GetLastFrame do - begin - pHYs := PpHYs(ChunkData)^; - SwapEndianLongWord(@pHYs, SizeOf(pHYs) div SizeOf(LongWord)); - end; - end; - -begin - Result := False; - Clear; - ChunkData := nil; - with GetIO do - try - Read(Handle, @Sig, SizeOf(Sig)); - // Set file type according to the signature - if Sig = PNGSignature then FileType := ngPNG - else if Sig = MNGSignature then FileType := ngMNG - else if Sig = JNGSignature then FileType := ngJNG - else Exit; - - if FileType = ngMNG then - begin - // Store MNG header if present - ReadChunk; - ReadChunkData; - MHDR := PMHDR(ChunkData)^; - SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord)); - end; - - // Read chunks until ending chunk or EOF is reached - repeat - ReadChunk; - if (Chunk.ChunkID = IHDRChunk) or (Chunk.ChunkID = fcTLChunk) then StartNewPNGImage - else if Chunk.ChunkID = JHDRChunk then StartNewJNGImage - else if (Chunk.ChunkID = IDATChunk) or (Chunk.ChunkID = fdATChunk) then AppendIDAT - else if Chunk.ChunkID = JDATChunk then AppendJDAT - else if Chunk.ChunkID = JDAAChunk then AppendJDAA - else if Chunk.ChunkID = PLTEChunk then LoadPLTE - else if Chunk.ChunkID = tRNSChunk then LoadtRNS - else if Chunk.ChunkID = bKGDChunk then LoadbKGD - else if Chunk.ChunkID = acTLChunk then HandleacTL - else if Chunk.ChunkID = pHYsChunk then LoadpHYs - else SkipChunkData; - until Eof(Handle) or (Chunk.ChunkID = MENDChunk) or - ((FileType <> ngMNG) and (Chunk.ChunkID = IENDChunk)); - - Result := True; - finally - FreeMemNil(ChunkData); - end; -end; - -procedure TNGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight: LongInt; const IHDR: TIHDR; - IDATStream: TMemoryStream; var Image: TImageData); -type - TGetPixelFunc = function(Line: PByteArray; X: LongInt): Byte; -var - LineBuffer: array[Boolean] of PByteArray; - ActLine: Boolean; - Data, TotalBuffer, ZeroLine, PrevLine: Pointer; - BitCount, TotalSize, TotalPos, BytesPerPixel, I, Pass, - SrcDataSize, BytesPerLine, InterlaceLineBytes, InterlaceWidth: LongInt; - Info: TImageFormatInfo; - - procedure DecodeAdam7; - const - BitTable: array[1..8] of LongInt = ($1, $3, 0, $F, 0, 0, 0, $FF); - StartBit: array[1..8] of LongInt = (7, 6, 0, 4, 0, 0, 0, 0); - var - Src, Dst, Dst2: PByte; - CurBit, Col: LongInt; - begin - Src := @LineBuffer[ActLine][1]; - Col := ColumnStart[Pass]; - with Image do - case BitCount of - 1, 2, 4: - begin - Dst := @PByteArray(Data)[I * BytesPerLine]; - repeat - CurBit := StartBit[BitCount]; - repeat - Dst2 := @PByteArray(Dst)[(BitCount * Col) shr 3]; - Dst2^ := Dst2^ or ((Src^ shr CurBit) and BitTable[BitCount]) - shl (StartBit[BitCount] - (Col * BitCount mod 8)); - Inc(Col, ColumnIncrement[Pass]); - Dec(CurBit, BitCount); - until CurBit < 0; - Inc(Src); - until Col >= Width; - end; - else - begin - Dst := @PByteArray(Data)[I * BytesPerLine + Col * BytesPerPixel]; - repeat - CopyPixel(Src, Dst, BytesPerPixel); - Inc(Dst, BytesPerPixel); - Inc(Src, BytesPerPixel); - Inc(Dst, ColumnIncrement[Pass] * BytesPerPixel - BytesPerPixel); - Inc(Col, ColumnIncrement[Pass]); - until Col >= Width; - end; - end; - end; - - procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray; - BytesPerLine: LongInt); - var - I: LongInt; - begin - case Filter of - 0: - begin - // No filter - Move(Line^, Target^, BytesPerLine); - end; - 1: - begin - // Sub filter - Move(Line^, Target^, BytesPerPixel); - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] + Target[I - BytesPerPixel]) and $FF; - end; - 2: - begin - // Up filter - for I := 0 to BytesPerLine - 1 do - Target[I] := (Line[I] + PrevLine[I]) and $FF; - end; - 3: - begin - // Average filter - for I := 0 to BytesPerPixel - 1 do - Target[I] := (Line[I] + PrevLine[I] shr 1) and $FF; - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] + (Target[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF; - end; - 4: - begin - // Paeth filter - for I := 0 to BytesPerPixel - 1 do - Target[I] := (Line[I] + PaethPredictor(0, PrevLine[I], 0)) and $FF; - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] + PaethPredictor(Target[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF; - end; - end; - end; - - procedure TransformLOCOToRGB(Data: PByte; NumPixels, BytesPerPixel: LongInt); - var - I: LongInt; - begin - for I := 0 to NumPixels - 1 do - begin - if IHDR.BitDepth = 8 then - begin - PColor32Rec(Data).R := Byte(PColor32Rec(Data).R + PColor32Rec(Data).G); - PColor32Rec(Data).B := Byte(PColor32Rec(Data).B + PColor32Rec(Data).G); - end - else - begin - PColor64Rec(Data).R := Word(PColor64Rec(Data).R + PColor64Rec(Data).G); - PColor64Rec(Data).B := Word(PColor64Rec(Data).B + PColor64Rec(Data).G); - end; - Inc(Data, BytesPerPixel); - end; - end; - - function CheckBinaryPalette: Boolean; - begin - with GetLastFrame do - Result := (PaletteEntries = 2) and - (Palette[0].R = 0) and (Palette[0].G = 0) and (Palette[0].B = 0) and - (Palette[1].R = 255) and (Palette[1].G = 255) and (Palette[1].B = 255); - end; - -begin - Image.Width := FrameWidth; - Image.Height := FrameHeight; - Image.Format := ifUnknown; - - case IHDR.ColorType of - 0: - begin - // Gray scale image - case IHDR.BitDepth of - 1: Image.Format := ifBinary; - 2, 4, 8: Image.Format := ifGray8; - 16: Image.Format := ifGray16; - end; - BitCount := IHDR.BitDepth; - end; - 2: - begin - // RGB image - case IHDR.BitDepth of - 8: Image.Format := ifR8G8B8; - 16: Image.Format := ifR16G16B16; - end; - BitCount := IHDR.BitDepth * 3; - end; - 3: - begin - // Indexed image - if (IHDR.BitDepth = 1) and CheckBinaryPalette then - Image.Format := ifBinary - else - Image.Format := ifIndex8; - BitCount := IHDR.BitDepth; - end; - 4: - begin - // Grayscale + alpha image - case IHDR.BitDepth of - 8: Image.Format := ifA8Gray8; - 16: Image.Format := ifA16Gray16; - end; - BitCount := IHDR.BitDepth * 2; - end; - 6: - begin - // ARGB image - case IHDR.BitDepth of - 8: Image.Format := ifA8R8G8B8; - 16: Image.Format := ifA16R16G16B16; - end; - BitCount := IHDR.BitDepth * 4; - end; - end; - - GetImageFormatInfo(Image.Format, Info); - BytesPerPixel := (BitCount + 7) div 8; - - LineBuffer[True] := nil; - LineBuffer[False] := nil; - TotalBuffer := nil; - ZeroLine := nil; - ActLine := True; - - // Start decoding - with Image do - try - BytesPerLine := (Width * BitCount + 7) div 8; - SrcDataSize := Height * BytesPerLine; - GetMem(Data, SrcDataSize); - FillChar(Data^, SrcDataSize, 0); - GetMem(ZeroLine, BytesPerLine); - FillChar(ZeroLine^, BytesPerLine, 0); - - if IHDR.Interlacing = 1 then - begin - // Decode interlaced images - TotalPos := 0; - DecompressBuf(IDATStream.Memory, IDATStream.Size, 0, - Pointer(TotalBuffer), TotalSize); - GetMem(LineBuffer[True], BytesPerLine + 1); - GetMem(LineBuffer[False], BytesPerLine + 1); - for Pass := 0 to 6 do - begin - // Prepare next interlace run - if Width <= ColumnStart[Pass] then - Continue; - InterlaceWidth := (Width + ColumnIncrement[Pass] - 1 - - ColumnStart[Pass]) div ColumnIncrement[Pass]; - InterlaceLineBytes := (InterlaceWidth * BitCount + 7) shr 3; - I := RowStart[Pass]; - FillChar(LineBuffer[True][0], BytesPerLine + 1, 0); - FillChar(LineBuffer[False][0], BytesPerLine + 1, 0); - while I < Height do - begin - // Copy line from decompressed data to working buffer - Move(PByteArray(TotalBuffer)[TotalPos], - LineBuffer[ActLine][0], InterlaceLineBytes + 1); - Inc(TotalPos, InterlaceLineBytes + 1); - // Swap red and blue channels if necessary - if (IHDR.ColorType in [2, 6]) then - SwapRGB(@LineBuffer[ActLine][1], InterlaceWidth, IHDR.BitDepth, BytesPerPixel); - // Reverse-filter current scanline - FilterScanline(LineBuffer[ActLine][0], BytesPerPixel, - @LineBuffer[ActLine][1], @LineBuffer[not ActLine][1], - @LineBuffer[ActLine][1], InterlaceLineBytes); - // Decode Adam7 interlacing - DecodeAdam7; - ActLine := not ActLine; - // Continue with next row in interlaced order - Inc(I, RowIncrement[Pass]); - end; - end; - end - else - begin - // Decode non-interlaced images - PrevLine := ZeroLine; - DecompressBuf(IDATStream.Memory, IDATStream.Size, SrcDataSize + Height, - Pointer(TotalBuffer), TotalSize); - for I := 0 to Height - 1 do - begin - // Swap red and blue channels if necessary - if IHDR.ColorType in [2, 6] then - SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], Width, - IHDR.BitDepth, BytesPerPixel); - // reverse-filter current scanline - FilterScanline(PByteArray(TotalBuffer)[I * (BytesPerLine + 1)], - BytesPerPixel, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], - PrevLine, @PByteArray(Data)[I * BytesPerLine], BytesPerLine); - PrevLine := @PByteArray(Data)[I * BytesPerLine]; - end; - end; - - Size := Info.GetPixelsSize(Info.Format, Width, Height); - - if Size <> SrcDataSize then - begin - // If source data size is different from size of image in assigned - // format we must convert it (it is in 1/2/4 bit count) - GetMem(Bits, Size); - case IHDR.BitDepth of - 1: - begin - // Convert only indexed, keep black and white in ifBinary - if IHDR.ColorType <> 0 then - Convert1To8(Data, Bits, Width, Height, BytesPerLine, False); - end; - 2: Convert2To8(Data, Bits, Width, Height, BytesPerLine, IHDR.ColorType = 0); - 4: Convert4To8(Data, Bits, Width, Height, BytesPerLine, IHDR.ColorType = 0); - end; - FreeMem(Data); - end - else - begin - // If source data size is the same as size of - // image Bits in assigned format we simply copy pointer reference - Bits := Data; - end; - - // LOCO transformation was used too (only for color types 2 and 6) - if (IHDR.Filter = 64) and (IHDR.ColorType in [2, 6]) then - TransformLOCOToRGB(Bits, Width * Height, BytesPerPixel); - - // Images with 16 bit channels must be swapped because of PNG's big endianity - if IHDR.BitDepth = 16 then - SwapEndianWord(Bits, Width * Height * BytesPerPixel div SizeOf(Word)); - finally - FreeMem(LineBuffer[True]); - FreeMem(LineBuffer[False]); - FreeMem(TotalBuffer); - FreeMem(ZeroLine); - end; -end; - -{$IFNDEF DONT_LINK_JNG} - -procedure TNGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight: LongInt; const JHDR: TJHDR; IDATStream, - JDATStream, JDAAStream: TMemoryStream; var Image: TImageData); -var - AlphaImage: TImageData; - FakeIHDR: TIHDR; - FmtInfo: TImageFormatInfo; - I: LongInt; - AlphaPtr: PByte; - GrayPtr: PWordRec; - ColorPtr: PColor32Rec; - - procedure LoadJpegFromStream(Stream: TStream; var DestImage: TImageData); - var - JpegFormat: TCustomIOJpegFileFormat; - Handle: TImagingHandle; - DynImages: TDynImageDataArray; - begin - if JHDR.SampleDepth <> 12 then - begin - JpegFormat := TCustomIOJpegFileFormat.Create; - JpegFormat.SetCustomIO(StreamIO); - Stream.Position := 0; - Handle := StreamIO.Open(Pointer(Stream), omReadOnly); - try - JpegFormat.LoadData(Handle, DynImages, True); - DestImage := DynImages[0]; - finally - StreamIO.Close(Handle); - JpegFormat.Free; - SetLength(DynImages, 0); - end; - end - else - NewImage(FrameWidth, FrameHeight, ifR8G8B8, DestImage); - end; - -begin - LoadJpegFromStream(JDATStream, Image); - - // If present separate alpha channel is processed - if (JHDR.ColorType in [12, 14]) and (Image.Format in [ifGray8, ifR8G8B8]) then - begin - InitImage(AlphaImage); - if JHDR.AlphaCompression = 0 then - begin - // Alpha channel is PNG compressed - FakeIHDR.Width := JHDR.Width; - FakeIHDR.Height := JHDR.Height; - FakeIHDR.ColorType := 0; - FakeIHDR.BitDepth := JHDR.AlphaSampleDepth; - FakeIHDR.Filter := JHDR.AlphaFilter; - FakeIHDR.Interlacing := JHDR.AlphaInterlacing; - - LoadImageFromPNGFrame(FrameWidth, FrameHeight, FakeIHDR, IDATStream, AlphaImage); - end - else - begin - // Alpha channel is JPEG compressed - LoadJpegFromStream(JDAAStream, AlphaImage); - end; - - // Check if alpha channel is the same size as image - if (Image.Width <> AlphaImage.Width) and (Image.Height <> AlphaImage.Height) then - ResizeImage(AlphaImage, Image.Width, Image.Height, rfNearest); - - // Check alpha channels data format - GetImageFormatInfo(AlphaImage.Format, FmtInfo); - if (FmtInfo.BytesPerPixel > 1) or (not FmtInfo.HasGrayChannel) then - ConvertImage(AlphaImage, ifGray8); - - // Convert image to fromat with alpha channel - if Image.Format = ifGray8 then - ConvertImage(Image, ifA8Gray8) - else - ConvertImage(Image, ifA8R8G8B8); - - // Combine alpha channel with image - AlphaPtr := AlphaImage.Bits; - if Image.Format = ifA8Gray8 then - begin - GrayPtr := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - GrayPtr.High := AlphaPtr^; - Inc(GrayPtr); - Inc(AlphaPtr); - end; - end - else - begin - ColorPtr := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - ColorPtr.A := AlphaPtr^; - Inc(ColorPtr); - Inc(AlphaPtr); - end; - end; - - FreeImage(AlphaImage); - end; -end; - -{$ENDIF} - -procedure TNGFileLoader.ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData); -var - FmtInfo: TImageFormatInfo; - BackGroundColor: TColor64Rec; - ColorKey: TColor64Rec; - Alphas: PByteArray; - AlphasSize: LongInt; - IsColorKeyPresent: Boolean; - IsBackGroundPresent: Boolean; - IsColorFormat: Boolean; - - procedure ConverttRNS; - begin - if FmtInfo.IsIndexed then - begin - if Alphas = nil then - begin - GetMem(Alphas, Frame.TransparencySize); - Move(Frame.Transparency^, Alphas^, Frame.TransparencySize); - AlphasSize := Frame.TransparencySize; - end; - end - else if not FmtInfo.HasAlphaChannel then - begin - FillChar(ColorKey, SizeOf(ColorKey), 0); - Move(Frame.Transparency^, ColorKey, Min(Frame.TransparencySize, SizeOf(ColorKey))); - if IsColorFormat then - SwapValues(ColorKey.R, ColorKey.B); - SwapEndianWord(@ColorKey, 3); - // 1/2/4 bit images were converted to 8 bit so we must convert color key too - if (not Frame.IsJpegFrame) and (Frame.IHDR.ColorType in [0, 4]) then - case Frame.IHDR.BitDepth of - 1: ColorKey.B := Word(ColorKey.B * 255); - 2: ColorKey.B := Word(ColorKey.B * 85); - 4: ColorKey.B := Word(ColorKey.B * 17); - end; - IsColorKeyPresent := True; - end; - end; - - procedure ConvertbKGD; - begin - FillChar(BackGroundColor, SizeOf(BackGroundColor), 0); - Move(Frame.Background^, BackGroundColor, Min(Frame.BackgroundSize, SizeOf(BackGroundColor))); - if IsColorFormat then - SwapValues(BackGroundColor.R, BackGroundColor.B); - SwapEndianWord(@BackGroundColor, 3); - // 1/2/4 bit images were converted to 8 bit so we must convert back color too - if (not Frame.IsJpegFrame) and (Frame.IHDR.ColorType in [0, 4]) then - case Frame.IHDR.BitDepth of - 1: BackGroundColor.B := Word(BackGroundColor.B * 255); - 2: BackGroundColor.B := Word(BackGroundColor.B * 85); - 4: BackGroundColor.B := Word(BackGroundColor.B * 17); - end; - IsBackGroundPresent := True; - end; - - procedure ReconstructPalette; - var - I: LongInt; - begin - with Image do - begin - GetMem(Palette, FmtInfo.PaletteEntries * SizeOf(TColor32Rec)); - FillChar(Palette^, FmtInfo.PaletteEntries * SizeOf(TColor32Rec), $FF); - // if RGB palette was loaded from file then use it - if Frame.Palette <> nil then - for I := 0 to Min(Frame.PaletteEntries, FmtInfo.PaletteEntries) - 1 do - with Palette[I] do - begin - R := Frame.Palette[I].B; - G := Frame.Palette[I].G; - B := Frame.Palette[I].R; - end; - // if palette alphas were loaded from file then use them - if Alphas <> nil then - begin - for I := 0 to Min(AlphasSize, FmtInfo.PaletteEntries) - 1 do - Palette[I].A := Alphas[I]; - end; - end; - end; - - procedure ApplyColorKey; - var - DestFmt: TImageFormat; - Col32, Bkg32: TColor32Rec; - OldPixel, NewPixel: Pointer; - begin - case Image.Format of - ifGray8: DestFmt := ifA8Gray8; - ifGray16: DestFmt := ifA16Gray16; - ifR8G8B8: DestFmt := ifA8R8G8B8; - ifR16G16B16: DestFmt := ifA16R16G16B16; - else - DestFmt := ifUnknown; - end; - - if DestFmt <> ifUnknown then - begin - if not IsBackGroundPresent then - BackGroundColor := ColorKey; - ConvertImage(Image, DestFmt); - - // Now back color and color key must be converted to image's data format, looks ugly - case Image.Format of - ifA8Gray8: - begin - Col32 := Color32(0, 0, $FF, Byte(ColorKey.B)); - Bkg32 := Color32(0, 0, 0, Byte(BackGroundColor.B)); - end; - ifA16Gray16: - begin - ColorKey.G := $FFFF; - end; - ifA8R8G8B8: - begin - Col32 := Color32($FF, Byte(ColorKey.R), Byte(ColorKey.G), Byte(ColorKey.B)); - Bkg32 := Color32(0, Byte(BackGroundColor.R), Byte(BackGroundColor.G), Byte(BackGroundColor.B)); - end; - ifA16R16G16B16: - begin - ColorKey.A := $FFFF; - end; - end; - - if Image.Format in [ifA8Gray8, ifA8R8G8B8] then - begin - OldPixel := @Col32; - NewPixel := @Bkg32; - end - else - begin - OldPixel := @ColorKey; - NewPixel := @BackGroundColor; - end; - - ReplaceColor(Image, 0, 0, Image.Width, Image.Height, OldPixel, NewPixel); - end; - end; - -begin - Alphas := nil; - IsColorKeyPresent := False; - IsBackGroundPresent := False; - GetImageFormatInfo(Image.Format, FmtInfo); - - IsColorFormat := (Frame.IsJpegFrame and (Frame.JHDR.ColorType in [10, 14])) or - (not Frame.IsJpegFrame and (Frame.IHDR.ColorType in [2, 6])); - - // Convert some chunk data to useful format - if Frame.TransparencySize > 0 then - ConverttRNS; - if Frame.BackgroundSize > 0 then - ConvertbKGD; - - // Build palette for indexed images - if FmtInfo.IsIndexed then - ReconstructPalette; - - // Apply color keying - if IsColorKeyPresent and not FmtInfo.HasAlphaChannel then - ApplyColorKey; - - FreeMemNil(Alphas); -end; - -{ TNGFileSaver class implementation } - -procedure TNGFileSaver.StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer; - FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream); -var - TotalBuffer, CompBuffer, ZeroLine, PrevLine: Pointer; - FilterLines: array[0..4] of PByteArray; - TotalSize, CompSize, I, BytesPerLine, BytesPerPixel: LongInt; - Filter: Byte; - Adaptive: Boolean; - - procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray); - var - I: LongInt; - begin - case Filter of - 0: - begin - // No filter - Move(Line^, Target^, BytesPerLine); - end; - 1: - begin - // Sub filter - Move(Line^, Target^, BytesPerPixel); - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] - Line[I - BytesPerPixel]) and $FF; - end; - 2: - begin - // Up filter - for I := 0 to BytesPerLine - 1 do - Target[I] := (Line[I] - PrevLine[I]) and $FF; - end; - 3: - begin - // Average filter - for I := 0 to BytesPerPixel - 1 do - Target[I] := (Line[I] - PrevLine[I] shr 1) and $FF; - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] - (Line[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF; - end; - 4: - begin - // Paeth filter - for I := 0 to BytesPerPixel - 1 do - Target[I] := (Line[I] - PaethPredictor(0, PrevLine[I], 0)) and $FF; - for I := BytesPerPixel to BytesPerLine - 1 do - Target[I] := (Line[I] - PaethPredictor(Line[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF; - end; - end; - end; - - procedure AdaptiveFilter(var Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray); - var - I, J, BestTest: LongInt; - Sums: array[0..4] of LongInt; - begin - // Compute the output scanline using all five filters, - // and select the filter that gives the smallest sum of - // absolute values of outputs - FillChar(Sums, SizeOf(Sums), 0); - BestTest := MaxInt; - for I := 0 to 4 do - begin - FilterScanline(I, BytesPerPixel, Line, PrevLine, FilterLines[I]); - for J := 0 to BytesPerLine - 1 do - Sums[I] := Sums[I] + Abs(ShortInt(FilterLines[I][J])); - if Sums[I] < BestTest then - begin - Filter := I; - BestTest := Sums[I]; - end; - end; - Move(FilterLines[Filter]^, Target^, BytesPerLine); - end; - -begin - // Select precompression filter and compression level - Adaptive := False; - Filter := 0; - case PreFilter of - 6: - if not ((IHDR.BitDepth < 8) or (IHDR.ColorType = 3)) then - Adaptive := True; - 0..4: Filter := PreFilter; - else - if IHDR.ColorType in [2, 6] then - Filter := 4 - end; - - // Prepare data for compression - CompBuffer := nil; - FillChar(FilterLines, SizeOf(FilterLines), 0); - BytesPerPixel := Max(1, FmtInfo.BytesPerPixel); - BytesPerLine := FmtInfo.GetPixelsSize(FmtInfo.Format, LongInt(IHDR.Width), 1); - TotalSize := (BytesPerLine + 1) * LongInt(IHDR.Height); - GetMem(TotalBuffer, TotalSize); - GetMem(ZeroLine, BytesPerLine); - FillChar(ZeroLine^, BytesPerLine, 0); - PrevLine := ZeroLine; - - if Adaptive then - begin - for I := 0 to 4 do - GetMem(FilterLines[I], BytesPerLine); - end; - - try - // Process next scanlines - for I := 0 to IHDR.Height - 1 do - begin - // Filter scanline - if Adaptive then - begin - AdaptiveFilter(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine], - PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]); - end - else - begin - FilterScanline(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine], - PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]); - end; - PrevLine := @PByteArray(Bits)[I * BytesPerLine]; - // Swap red and blue if necessary - if (IHDR.ColorType in [2, 6]) and not FmtInfo.IsRBSwapped then - begin - SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], - IHDR.Width, IHDR.BitDepth, BytesPerPixel); - end; - // Images with 16 bit channels must be swapped because of PNG's big endianess - if IHDR.BitDepth = 16 then - begin - SwapEndianWord(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], - BytesPerLine div SizeOf(Word)); - end; - // Set filter used for this scanline - PByteArray(TotalBuffer)[I * (BytesPerLine + 1)] := Filter; - end; - // Compress IDAT data - CompressBuf(TotalBuffer, TotalSize, CompBuffer, CompSize, - CompressLevel, ZLibStrategy); - // Write IDAT data to stream - IDATStream.WriteBuffer(CompBuffer^, CompSize); - finally - FreeMem(TotalBuffer); - FreeMem(CompBuffer); - FreeMem(ZeroLine); - if Adaptive then - for I := 0 to 4 do - FreeMem(FilterLines[I]); - end; -end; - -{$IFNDEF DONT_LINK_JNG} - -procedure TNGFileSaver.StoreImageToJNGFrame(const JHDR: TJHDR; - const Image: TImageData; IDATStream, JDATStream, - JDAAStream: TMemoryStream); -var - ColorImage, AlphaImage: TImageData; - FmtInfo: TImageFormatInfo; - AlphaPtr: PByte; - GrayPtr: PWordRec; - ColorPtr: PColor32Rec; - I: LongInt; - FakeIHDR: TIHDR; - - procedure SaveJpegToStream(Stream: TStream; const Image: TImageData); - var - JpegFormat: TCustomIOJpegFileFormat; - Handle: TImagingHandle; - DynImages: TDynImageDataArray; - begin - JpegFormat := TCustomIOJpegFileFormat.Create; - JpegFormat.SetCustomIO(StreamIO); - // Only JDAT stream can be saved progressive - if Stream = JDATStream then - JpegFormat.FProgressive := Progressive - else - JpegFormat.FProgressive := False; - JpegFormat.FQuality := Quality; - SetLength(DynImages, 1); - DynImages[0] := Image; - Handle := StreamIO.Open(Pointer(Stream), omCreate); - try - JpegFormat.SaveData(Handle, DynImages, 0); - finally - StreamIO.Close(Handle); - SetLength(DynImages, 0); - JpegFormat.Free; - end; - end; - -begin - GetImageFormatInfo(Image.Format, FmtInfo); - InitImage(ColorImage); - InitImage(AlphaImage); - - if FmtInfo.HasAlphaChannel then - begin - // Create new image for alpha channel and color image without alpha - CloneImage(Image, ColorImage); - NewImage(Image.Width, Image.Height, ifGray8, AlphaImage); - case Image.Format of - ifA8Gray8: ConvertImage(ColorImage, ifGray8); - ifA8R8G8B8: ConvertImage(ColorImage, ifR8G8B8); - end; - - // Store source image's alpha to separate image - AlphaPtr := AlphaImage.Bits; - if Image.Format = ifA8Gray8 then - begin - GrayPtr := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - AlphaPtr^ := GrayPtr.High; - Inc(GrayPtr); - Inc(AlphaPtr); - end; - end - else - begin - ColorPtr := Image.Bits; - for I := 0 to Image.Width * Image.Height - 1 do - begin - AlphaPtr^ := ColorPtr.A; - Inc(ColorPtr); - Inc(AlphaPtr); - end; - end; - - // Write color image to stream as JPEG - SaveJpegToStream(JDATStream, ColorImage); - - if LossyAlpha then - begin - // Write alpha image to stream as JPEG - SaveJpegToStream(JDAAStream, AlphaImage); - end - else - begin - // Alpha channel is PNG compressed - FakeIHDR.Width := JHDR.Width; - FakeIHDR.Height := JHDR.Height; - FakeIHDR.ColorType := 0; - FakeIHDR.BitDepth := JHDR.AlphaSampleDepth; - FakeIHDR.Filter := JHDR.AlphaFilter; - FakeIHDR.Interlacing := JHDR.AlphaInterlacing; - - GetImageFormatInfo(AlphaImage.Format, FmtInfo); - StoreImageToPNGFrame(FakeIHDR, AlphaImage.Bits, FmtInfo, IDATStream); - end; - - FreeImage(ColorImage); - FreeImage(AlphaImage); - end - else - begin - // Simply write JPEG to stream - SaveJpegToStream(JDATStream, Image); - end; -end; - -{$ENDIF} - -procedure TNGFileSaver.AddFrame(const Image: TImageData; IsJpegFrame: Boolean); -var - Frame: TFrameInfo; - FmtInfo: TImageFormatInfo; - Index: Integer; - - procedure StorePalette; - var - Pal: PPalette24; - Alphas: PByteArray; - I, PalBytes: LongInt; - AlphasDiffer: Boolean; - begin - // Fill and save RGB part of palette to PLTE chunk - PalBytes := FmtInfo.PaletteEntries * SizeOf(TColor24Rec); - GetMem(Pal, PalBytes); - AlphasDiffer := False; - for I := 0 to FmtInfo.PaletteEntries - 1 do - begin - Pal[I].B := Image.Palette[I].R; - Pal[I].G := Image.Palette[I].G; - Pal[I].R := Image.Palette[I].B; - if Image.Palette[I].A < 255 then - AlphasDiffer := True; - end; - Frame.Palette := Pal; - Frame.PaletteEntries := FmtInfo.PaletteEntries; - // Fill and save alpha part (if there are any alphas < 255) of palette to tRNS chunk - if AlphasDiffer then - begin - PalBytes := FmtInfo.PaletteEntries * SizeOf(Byte); - GetMem(Alphas, PalBytes); - for I := 0 to FmtInfo.PaletteEntries - 1 do - Alphas[I] := Image.Palette[I].A; - Frame.Transparency := Alphas; - Frame.TransparencySize := PalBytes; - end; - end; - - procedure FillFrameControlChunk(const IHDR: TIHDR; var fcTL: TfcTL); - var - Delay: Integer; - begin - fcTL.SeqNumber := 0; // Decided when writing to file - fcTL.Width := IHDR.Width; - fcTL.Height := IHDR.Height; - fcTL.XOffset := 0; - fcTL.YOffset := 0; - fcTL.DelayNumer := 1; - fcTL.DelayDenom := 3; - if FileFormat.FMetadata.HasMetaItemForSaving(SMetaFrameDelay, Index) then - begin - // Metadata contains frame delay information in milliseconds - Delay := FileFormat.FMetadata.MetaItemsForSavingMulti[SMetaFrameDelay, Index]; - fcTL.DelayNumer := Delay; - fcTL.DelayDenom := 1000; - end; - fcTL.DisposeOp := DisposeOpNone; - fcTL.BlendOp := BlendOpSource; - SwapEndianLongWord(@fcTL, 5); - fcTL.DelayNumer := SwapEndianWord(fcTL.DelayNumer); - fcTL.DelayDenom := SwapEndianWord(fcTL.DelayDenom); - end; - -begin - // Add new frame - Frame := AddFrameInfo; - Frame.IsJpegFrame := IsJpegFrame; - Index := Length(Frames) - 1; - - with Frame do - begin - GetImageFormatInfo(Image.Format, FmtInfo); - - if IsJpegFrame then - begin -{$IFNDEF DONT_LINK_JNG} - // Fill JNG header - JHDR.Width := Image.Width; - JHDR.Height := Image.Height; - case Image.Format of - ifGray8: JHDR.ColorType := 8; - ifR8G8B8: JHDR.ColorType := 10; - ifA8Gray8: JHDR.ColorType := 12; - ifA8R8G8B8: JHDR.ColorType := 14; - end; - JHDR.SampleDepth := 8; // 8-bit samples and quantization tables - JHDR.Compression := 8; // Huffman coding - JHDR.Interlacing := Iff(Progressive, 8, 0); - JHDR.AlphaSampleDepth := Iff(FmtInfo.HasAlphaChannel, 8, 0); - JHDR.AlphaCompression := Iff(LossyAlpha, 8, 0); - JHDR.AlphaFilter := 0; - JHDR.AlphaInterlacing := 0; - - StoreImageToJNGFrame(JHDR, Image, IDATMemory, JDATMemory, JDAAMemory); - - // Finally swap endian - SwapEndianLongWord(@JHDR, 2); -{$ENDIF} - end - else - begin - // Fill PNG header - IHDR.Width := Image.Width; - IHDR.Height := Image.Height; - IHDR.Compression := 0; - IHDR.Filter := 0; - IHDR.Interlacing := 0; - IHDR.BitDepth := FmtInfo.BytesPerPixel * 8; - - // Select appropiate PNG color type and modify bitdepth - if FmtInfo.HasGrayChannel then - begin - IHDR.ColorType := 0; - if FmtInfo.HasAlphaChannel then - begin - IHDR.ColorType := 4; - IHDR.BitDepth := IHDR.BitDepth div 2; - end; - end - else if FmtInfo.Format = ifBinary then - begin - IHDR.ColorType := 0; - IHDR.BitDepth := 1; - end - else if FmtInfo.IsIndexed then - IHDR.ColorType := 3 - else if FmtInfo.HasAlphaChannel then - begin - IHDR.ColorType := 6; - IHDR.BitDepth := IHDR.BitDepth div 4; - end - else - begin - IHDR.ColorType := 2; - IHDR.BitDepth := IHDR.BitDepth div 3; - end; - - if FileType = ngAPNG then - begin - // Fill fcTL chunk of APNG file - FillFrameControlChunk(IHDR, fcTL); - end; - - // Compress PNG image and store it to stream - StoreImageToPNGFrame(IHDR, Image.Bits, FmtInfo, IDATMemory); - // Store palette if necesary - if FmtInfo.IsIndexed then - StorePalette; - - // Finally swap endian - SwapEndianLongWord(@IHDR, 2); - end; - end; -end; - -function TNGFileSaver.SaveFile(Handle: TImagingHandle): Boolean; -var - I: LongInt; - Chunk: TChunkHeader; - SeqNo: LongWord; - - function GetNextSeqNo: LongWord; - begin - // Seq numbers of fcTL and fdAT are "interleaved" as they share the counter. - // Example: first fcTL for IDAT has seq=0, next is fcTL for seond frame with - // seq=1, then first fdAT with seq=2, fcTL seq=3, fdAT=4, ... - Result := SwapEndianLongWord(SeqNo); - Inc(SeqNo); - end; - - function CalcChunkCrc(const ChunkHdr: TChunkHeader; Data: Pointer; - Size: LongInt): LongWord; - begin - Result := $FFFFFFFF; - CalcCrc32(Result, @ChunkHdr.ChunkID, SizeOf(ChunkHdr.ChunkID)); - CalcCrc32(Result, Data, Size); - Result := SwapEndianLongWord(Result xor $FFFFFFFF); - end; - - procedure WriteChunk(var Chunk: TChunkHeader; ChunkData: Pointer); - var - ChunkCrc: LongWord; - SizeToWrite: LongInt; - begin - SizeToWrite := Chunk.DataSize; - Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize); - ChunkCrc := CalcChunkCrc(Chunk, ChunkData, SizeToWrite); - GetIO.Write(Handle, @Chunk, SizeOf(Chunk)); - if SizeToWrite <> 0 then - GetIO.Write(Handle, ChunkData, SizeToWrite); - GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc)); - end; - - procedure WritefdAT(Frame: TFrameInfo); - var - ChunkCrc: LongWord; - ChunkSeqNo: LongWord; - begin - Chunk.ChunkID := fdATChunk; - ChunkSeqNo := GetNextSeqNo; - // fdAT saves seq number LongWord before compressed pixels - Chunk.DataSize := Frame.IDATMemory.Size + SizeOf(LongWord); - Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize); - // Calc CRC - ChunkCrc := $FFFFFFFF; - CalcCrc32(ChunkCrc, @Chunk.ChunkID, SizeOf(Chunk.ChunkID)); - CalcCrc32(ChunkCrc, @ChunkSeqNo, SizeOf(ChunkSeqNo)); - CalcCrc32(ChunkCrc, Frame.IDATMemory.Memory, Frame.IDATMemory.Size); - ChunkCrc := SwapEndianLongWord(ChunkCrc xor $FFFFFFFF); - // Write out all fdAT data - GetIO.Write(Handle, @Chunk, SizeOf(Chunk)); - GetIO.Write(Handle, @ChunkSeqNo, SizeOf(ChunkSeqNo)); - GetIO.Write(Handle, Frame.IDATMemory.Memory, Frame.IDATMemory.Size); - GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc)); - end; - - procedure WriteGlobalMetaDataChunks(Frame: TFrameInfo); - var - XRes, YRes: Single; - begin - if FileFormat.FMetadata.GetPhysicalPixelSize(ruDpm, XRes, YRes, True) then - begin - // Save pHYs chunk - Frame.pHYs.UnitSpecifier := 1; - // PNG stores physical resolution as dots per meter - Frame.pHYs.PixelsPerUnitX := Round(XRes); - Frame.pHYs.PixelsPerUnitY := Round(YRes); - - Chunk.DataSize := SizeOf(Frame.pHYs); - Chunk.ChunkID := pHYsChunk; - SwapEndianLongWord(@Frame.pHYs, SizeOf(Frame.pHYs) div SizeOf(LongWord)); - WriteChunk(Chunk, @Frame.pHYs); - end; - end; - - procedure WritePNGMainImageChunks(Frame: TFrameInfo); - begin - with Frame do - begin - // Write IHDR chunk - Chunk.DataSize := SizeOf(IHDR); - Chunk.ChunkID := IHDRChunk; - WriteChunk(Chunk, @IHDR); - // Write PLTE chunk if data is present - if Palette <> nil then - begin - Chunk.DataSize := PaletteEntries * SizeOf(TColor24Rec); - Chunk.ChunkID := PLTEChunk; - WriteChunk(Chunk, Palette); - end; - // Write tRNS chunk if data is present - if Transparency <> nil then - begin - Chunk.DataSize := TransparencySize; - Chunk.ChunkID := tRNSChunk; - WriteChunk(Chunk, Transparency); - end; - end; - // Write metadata related chunks - WriteGlobalMetaDataChunks(Frame); - end; - -begin - Result := False; - SeqNo := 0; - - case FileType of - ngPNG, ngAPNG: GetIO.Write(Handle, @PNGSignature, SizeOf(TChar8)); - ngMNG: GetIO.Write(Handle, @MNGSignature, SizeOf(TChar8)); - ngJNG: GetIO.Write(Handle, @JNGSignature, SizeOf(TChar8)); - end; - - if FileType = ngMNG then - begin - // MNG - main header before frames - SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord)); - Chunk.DataSize := SizeOf(MHDR); - Chunk.ChunkID := MHDRChunk; - WriteChunk(Chunk, @MHDR); - end - else if FileType = ngAPNG then - begin - // APNG - IHDR and global chunks for all frames, then acTL chunk, then frames - // (fcTL+IDAT, fcTL+fdAT, fcTL+fdAT, fcTL+fdAT, ....) - WritePNGMainImageChunks(Frames[0]); - - // Animation control chunk - acTL.NumFrames := Length(Frames); - if FileFormat.FMetadata.HasMetaItemForSaving(SMetaAnimationLoops) then - begin - // Number of plays of APNG animation - acTL.NumPlay:= FileFormat.FMetadata.MetaItemsForSaving[SMetaAnimationLoops]; - end - else - acTL.NumPlay := 0; - SwapEndianLongWord(@acTL, SizeOf(acTL) div SizeOf(LongWord)); - - Chunk.DataSize := SizeOf(acTL); - Chunk.ChunkID := acTLChunk; - WriteChunk(Chunk, @acTL); - end; - - for I := 0 to Length(Frames) - 1 do - with Frames[I] do - begin - if IsJpegFrame then - begin - // Write JHDR chunk - Chunk.DataSize := SizeOf(JHDR); - Chunk.ChunkID := JHDRChunk; - WriteChunk(Chunk, @JHDR); - // Write metadata related chunks - WriteGlobalMetaDataChunks(Frames[I]); - // Write JNG image data - Chunk.DataSize := JDATMemory.Size; - Chunk.ChunkID := JDATChunk; - WriteChunk(Chunk, JDATMemory.Memory); - // Write alpha channel if present - if JHDR.AlphaSampleDepth > 0 then - begin - if JHDR.AlphaCompression = 0 then - begin - // Alpha is PNG compressed - Chunk.DataSize := IDATMemory.Size; - Chunk.ChunkID := IDATChunk; - WriteChunk(Chunk, IDATMemory.Memory); - end - else - begin - // Alpha is JNG compressed - Chunk.DataSize := JDAAMemory.Size; - Chunk.ChunkID := JDAAChunk; - WriteChunk(Chunk, JDAAMemory.Memory); - end; - end; - // Write image end - Chunk.DataSize := 0; - Chunk.ChunkID := IENDChunk; - WriteChunk(Chunk, nil); - end - else if FileType <> ngAPNG then - begin - // Regular PNG frame (single PNG image or MNG frame) - WritePNGMainImageChunks(Frames[I]); - // Write PNG image data - Chunk.DataSize := IDATMemory.Size; - Chunk.ChunkID := IDATChunk; - WriteChunk(Chunk, IDATMemory.Memory); - // Write image end - Chunk.DataSize := 0; - Chunk.ChunkID := IENDChunk; - WriteChunk(Chunk, nil); - end - else if FileType = ngAPNG then - begin - // APNG frame - Write fcTL before frame data - Chunk.DataSize := SizeOf(fcTL); - Chunk.ChunkID := fcTLChunk; - fcTl.SeqNumber := GetNextSeqNo; - WriteChunk(Chunk, @fcTL); - // Write data - IDAT for first frame and fdAT for following ones - if I = 0 then - begin - Chunk.DataSize := IDATMemory.Size; - Chunk.ChunkID := IDATChunk; - WriteChunk(Chunk, IDATMemory.Memory); - end - else - WritefdAT(Frames[I]); - // Write image end after last frame - if I = Length(Frames) - 1 then - begin - Chunk.DataSize := 0; - Chunk.ChunkID := IENDChunk; - WriteChunk(Chunk, nil); - end; - end; - end; - - if FileType = ngMNG then - begin - Chunk.DataSize := 0; - Chunk.ChunkID := MENDChunk; - WriteChunk(Chunk, nil); - end; -end; - -procedure TNGFileSaver.SetFileOptions; -begin - PreFilter := FileFormat.FPreFilter; - CompressLevel := FileFormat.FCompressLevel; - LossyAlpha := FileFormat.FLossyAlpha; - Quality := FileFormat.FQuality; - Progressive := FileFormat.FProgressive; - ZLibStrategy := FileFormat.FZLibStategy; -end; - -{ TAPNGAnimator class implementation } - -class procedure TAPNGAnimator.Animate(var Images: TDynImageDataArray; - const acTL: TacTL; const SrcFrames: array of TFrameInfo); -var - I, SrcIdx, Offset, Len: Integer; - DestFrames: TDynImageDataArray; - SrcCanvas, DestCanvas: TImagingCanvas; - PreviousCache: TImageData; - - function AnimatingNeeded: Boolean; - var - I: Integer; - begin - Result := False; - for I := 0 to Len - 1 do - with SrcFrames[I] do - begin - if (FrameWidth <> Integer(IHDR.Width)) or (FrameHeight <> Integer(IHDR.Height)) or (Len <> Integer(acTL.NumFrames)) or - (not ((fcTL.DisposeOp = DisposeOpNone) and (fcTL.BlendOp = BlendOpSource)) and - not ((fcTL.DisposeOp = DisposeOpBackground) and (fcTL.BlendOp = BlendOpSource)) and - not ((fcTL.DisposeOp = DisposeOpBackground) and (fcTL.BlendOp = BlendOpOver))) then - begin - Result := True; - Exit; - end; - end; - end; - -begin - Len := Length(SrcFrames); - if (Len = 0) or not AnimatingNeeded then - Exit; - - if (Len = Integer(acTL.NumFrames) + 1) and (SrcFrames[0].fcTL.Width = 0) then - begin - // If default image (stored in IDAT chunk) isn't part of animation we ignore it - Offset := 1; - Len := Len - 1; - end - else - Offset := 0; - - SetLength(DestFrames, Len); - DestCanvas := ImagingCanvases.FindBestCanvasForImage(Images[0]).Create; - SrcCanvas := ImagingCanvases.FindBestCanvasForImage(Images[0]).Create; - InitImage(PreviousCache); - NewImage(SrcFrames[0].IHDR.Width, SrcFrames[0].IHDR.Height, Images[0].Format, PreviousCache); - - for I := 0 to Len - 1 do - begin - SrcIdx := I + Offset; - NewImage(SrcFrames[SrcIdx].IHDR.Width, SrcFrames[SrcIdx].IHDR.Height, - Images[SrcIdx].Format, DestFrames[I]); - if DestFrames[I].Format = ifIndex8 then - Move(Images[SrcIdx].Palette^, DestFrames[I].Palette^, 256 * SizeOf(TColor32)); - DestCanvas.CreateForData(@DestFrames[I]); - - if (SrcFrames[SrcIdx].fcTL.DisposeOp = DisposeOpPrevious) and (SrcFrames[SrcIdx - 1].fcTL.DisposeOp <> DisposeOpPrevious) then - begin - // Cache current output buffer so we may return to it later (previous dispose op) - CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height, - PreviousCache, 0, 0); - end; - - if (I = 0) or (SrcIdx = 0) then - begin - // Clear whole frame with transparent black color (default for first frame) - DestCanvas.FillColor32 := pcClear; - DestCanvas.Clear; - end - else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpBackground then - begin - // Restore background color (clear) on previous frame's area and leave previous content outside of it - CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height, - DestFrames[I], 0, 0); - DestCanvas.FillColor32 := pcClear; - DestCanvas.FillRect(BoundsToRect(SrcFrames[SrcIdx - 1].fcTL.XOffset, SrcFrames[SrcIdx - 1].fcTL.YOffset, - SrcFrames[SrcIdx - 1].FrameWidth, SrcFrames[SrcIdx - 1].FrameHeight)); - end - else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpNone then - begin - // Clone previous frame - no change to output buffer - CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height, - DestFrames[I], 0, 0); - end - else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpPrevious then - begin - // Revert to previous frame (cached, can't just restore DestFrames[I - 2]) - CopyRect(PreviousCache, 0, 0, PreviousCache.Width, PreviousCache.Height, - DestFrames[I], 0, 0); - end; - - // Copy pixels or alpha blend them over - if SrcFrames[SrcIdx].fcTL.BlendOp = BlendOpSource then - begin - CopyRect(Images[SrcIdx], 0, 0, Images[SrcIdx].Width, Images[SrcIdx].Height, - DestFrames[I], SrcFrames[SrcIdx].fcTL.XOffset, SrcFrames[SrcIdx].fcTL.YOffset); - end - else if SrcFrames[SrcIdx].fcTL.BlendOp = BlendOpOver then - begin - SrcCanvas.CreateForData(@Images[SrcIdx]); - SrcCanvas.DrawAlpha(SrcCanvas.ClipRect, DestCanvas, - SrcFrames[SrcIdx].fcTL.XOffset, SrcFrames[SrcIdx].fcTL.YOffset); - end; - - FreeImage(Images[SrcIdx]); - end; - - DestCanvas.Free; - SrcCanvas.Free; - FreeImage(PreviousCache); - - // Assign dest frames to final output images - Images := DestFrames; -end; - -{ TNetworkGraphicsFileFormat class implementation } - -procedure TNetworkGraphicsFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave]; - - FPreFilter := NGDefaultPreFilter; - FCompressLevel := NGDefaultCompressLevel; - FLossyAlpha := NGDefaultLossyAlpha; - FLossyCompression := NGDefaultLossyCompression; - FQuality := NGDefaultQuality; - FProgressive := NGDefaultProgressive; - FZLibStategy := NGDefaultZLibStartegy; -end; - -procedure TNetworkGraphicsFileFormat.CheckOptionsValidity; -begin - // Just check if save options has valid values - if not (FPreFilter in [0..6]) then - FPreFilter := NGDefaultPreFilter; - if not (FCompressLevel in [0..9]) then - FCompressLevel := NGDefaultCompressLevel; - if not (FQuality in [1..100]) then - FQuality := NGDefaultQuality; -end; - -function TNetworkGraphicsFileFormat.GetSupportedFormats: TImageFormats; -begin - if FLossyCompression then - Result := NGLossyFormats - else - Result := NGLosslessFormats; -end; - -procedure TNetworkGraphicsFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if not FLossyCompression then - begin - // Convert formats for lossless compression - if Info.HasGrayChannel then - begin - if Info.HasAlphaChannel then - begin - if Info.BytesPerPixel <= 2 then - // Convert <= 16bit grayscale images with alpha to ifA8Gray8 - ConvFormat := ifA8Gray8 - else - // Convert > 16bit grayscale images with alpha to ifA16Gray16 - ConvFormat := ifA16Gray16 - end - else - // Convert grayscale images without alpha to ifGray16 - ConvFormat := ifGray16; - end - else - if Info.IsFloatingPoint then - // Convert floating point images to 64 bit ARGB (or RGB if no alpha) - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16B16G16R16, ifB16G16R16) - else if Info.HasAlphaChannel or Info.IsSpecial then - // Convert all other images with alpha or special images to A8R8G8B8 - ConvFormat := ifA8R8G8B8 - else - // Convert images without alpha to R8G8B8 - ConvFormat := ifR8G8B8; - end - else - begin - // Convert formats for lossy compression - if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8Gray8, ifGray8) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8); - end; - - ConvertImage(Image, ConvFormat); -end; - -function TNetworkGraphicsFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - ReadCount: LongInt; - Sig: TChar8; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - FillChar(Sig, SizeOf(Sig), 0); - ReadCount := Read(Handle, @Sig, SizeOf(Sig)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(Sig)) and (Sig = FSignature); - end; -end; - -{ TPNGFileFormat class implementation } - -procedure TPNGFileFormat.Define; -begin - inherited; - FName := SPNGFormatName; - FFeatures := FFeatures + [ffMultiImage]; - FLoadAnimated := PNGDefaultLoadAnimated; - AddMasks(SPNGMasks); - - FSignature := PNGSignature; - - RegisterOption(ImagingPNGPreFilter, @FPreFilter); - RegisterOption(ImagingPNGCompressLevel, @FCompressLevel); - RegisterOption(ImagingPNGLoadAnimated, @FLoadAnimated); - RegisterOption(ImagingPNGZLibStrategy, @FZLibStategy); -end; - -function TPNGFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - I, Len: LongInt; - NGFileLoader: TNGFileLoader; -begin - Result := False; - NGFileLoader := TNGFileLoader.Create(Self); - try - // Use NG file parser to load file - if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then - begin - Len := Length(NGFileLoader.Frames); - SetLength(Images, Len); - for I := 0 to Len - 1 do - with NGFileLoader.Frames[I] do - begin - // Build actual image bits - if not IsJpegFrame then - NGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight, IHDR, IDATMemory, Images[I]); - // Build palette, aply color key or background - - NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]); - Result := True; - end; - // Animate APNG images - if (NGFileLoader.FileType = ngAPNG) and FLoadAnimated then - TAPNGAnimator.Animate(Images, NGFileLoader.acTL, NGFileLoader.Frames); - end; - finally - NGFileLoader.LoadMetaData; // Store metadata - NGFileLoader.Free; - end; -end; - -function TPNGFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - I: Integer; - ImageToSave: TImageData; - MustBeFreed: Boolean; - NGFileSaver: TNGFileSaver; - DefaultFormat: TImageFormat; - Screen: TImageData; - AnimWidth, AnimHeight: Integer; -begin - Result := False; - DefaultFormat := ifDefault; - AnimWidth := 0; - AnimHeight := 0; - NGFileSaver := TNGFileSaver.Create(Self); - - // Save images with more frames as APNG format - if Length(Images) > 1 then - begin - NGFileSaver.FileType := ngAPNG; - // Get max dimensions of frames - AnimWidth := Images[FFirstIdx].Width; - AnimHeight := Images[FFirstIdx].Height; - for I := FFirstIdx + 1 to FLastIdx do - begin - AnimWidth := Max(AnimWidth, Images[I].Width); - AnimHeight := Max(AnimHeight, Images[I].Height); - end; - end - else - NGFileSaver.FileType := ngPNG; - - NGFileSaver.SetFileOptions; - - with NGFileSaver do - try - // Store all frames to be saved frames file saver - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - try - if FileType = ngAPNG then - begin - // IHDR chunk is shared for all frames so all frames must have the - // same data format as the first image. - if I = FFirstIdx then - begin - DefaultFormat := ImageToSave.Format; - // Subsequenet frames may be bigger than the first one. - // APNG doens't support this - max allowed size is what's written in - // IHDR - size of main/default/first image. If some frame is - // bigger than the first one we need to resize (create empty bigger - // image and copy) the first frame so all following frames could fit to - // its area. - if (ImageToSave.Width <> AnimWidth) or (ImageToSave.Height <> AnimHeight) then - begin - InitImage(Screen); - NewImage(AnimWidth, AnimHeight, ImageToSave.Format, Screen); - CopyRect(ImageToSave, 0, 0, ImageToSave.Width, ImageToSave.Height, Screen, 0, 0); - if MustBeFreed then - FreeImage(ImageToSave); - ImageToSave := Screen; - end; - end - else if ImageToSave.Format <> DefaultFormat then - begin - if MustBeFreed then - ConvertImage(ImageToSave, DefaultFormat) - else - begin - CloneImage(Images[I], ImageToSave); - ConvertImage(ImageToSave, DefaultFormat); - MustBeFreed := True; - end; - end; - end; - - // Add image as PNG frame - AddFrame(ImageToSave, False); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end - else - Exit; - end; - - // Finally save PNG file - SaveFile(Handle); - Result := True; - finally - NGFileSaver.Free; - end; -end; - -{$IFNDEF DONT_LINK_MNG} - -{ TMNGFileFormat class implementation } - -procedure TMNGFileFormat.Define; -begin - inherited; - FName := SMNGFormatName; - FFeatures := FFeatures + [ffMultiImage]; - AddMasks(SMNGMasks); - - FSignature := MNGSignature; - - RegisterOption(ImagingMNGLossyCompression, @FLossyCompression); - RegisterOption(ImagingMNGLossyAlpha, @FLossyAlpha); - RegisterOption(ImagingMNGPreFilter, @FPreFilter); - RegisterOption(ImagingMNGCompressLevel, @FCompressLevel); - RegisterOption(ImagingMNGQuality, @FQuality); - RegisterOption(ImagingMNGProgressive, @FProgressive); -end; - -function TMNGFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - NGFileLoader: TNGFileLoader; - I, Len: LongInt; -begin - Result := False; - NGFileLoader := TNGFileLoader.Create(Self); - try - // Use NG file parser to load file - if NGFileLoader.LoadFile(Handle) then - begin - Len := Length(NGFileLoader.Frames); - if Len > 0 then - begin - SetLength(Images, Len); - for I := 0 to Len - 1 do - with NGFileLoader.Frames[I] do - begin - // Build actual image bits - if IsJpegFrame then - NGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight, JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[I]) - else - NGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight, IHDR, IDATMemory, Images[I]); - // Build palette, aply color key or background - NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]); - end; - end - else - begin - // Some MNG files (with BASI-IEND streams) dont have actual pixel data - SetLength(Images, 1); - NewImage(NGFileLoader.MHDR.FrameWidth, NGFileLoader.MHDR.FrameWidth, ifDefault, Images[0]); - end; - Result := True; - end; - finally - NGFileLoader.LoadMetaData; // Store metadata - NGFileLoader.Free; - end; -end; - -function TMNGFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - NGFileSaver: TNGFileSaver; - I, LargestWidth, LargestHeight: LongInt; - ImageToSave: TImageData; - MustBeFreed: Boolean; -begin - Result := False; - LargestWidth := 0; - LargestHeight := 0; - - NGFileSaver := TNGFileSaver.Create(Self); - NGFileSaver.FileType := ngMNG; - NGFileSaver.SetFileOptions; - - with NGFileSaver do - try - // Store all frames to be saved frames file saver - for I := FFirstIdx to FLastIdx do - begin - if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then - try - // Add image as PNG or JNG frame - AddFrame(ImageToSave, FLossyCompression); - // Remember largest frame width and height - LargestWidth := Iff(LargestWidth < ImageToSave.Width, ImageToSave.Width, LargestWidth); - LargestHeight := Iff(LargestHeight < ImageToSave.Height, ImageToSave.Height, LargestHeight); - finally - if MustBeFreed then - FreeImage(ImageToSave); - end - else - Exit; - end; - - // Fill MNG header - MHDR.FrameWidth := LargestWidth; - MHDR.FrameHeight := LargestHeight; - MHDR.TicksPerSecond := 0; - MHDR.NominalLayerCount := 0; - MHDR.NominalFrameCount := Length(Frames); - MHDR.NominalPlayTime := 0; - MHDR.SimplicityProfile := 473; // 111011001 binary, defines MNG-VLC with transparency and JNG support - - // Finally save MNG file - SaveFile(Handle); - Result := True; - finally - NGFileSaver.Free; - end; -end; - -{$ENDIF} - -{$IFNDEF DONT_LINK_JNG} - -{ TJNGFileFormat class implementation } - -procedure TJNGFileFormat.Define; -begin - inherited; - FName := SJNGFormatName; - AddMasks(SJNGMasks); - - FSignature := JNGSignature; - FLossyCompression := True; - - RegisterOption(ImagingJNGLossyAlpha, @FLossyAlpha); - RegisterOption(ImagingJNGAlphaPreFilter, @FPreFilter); - RegisterOption(ImagingJNGAlphaCompressLevel, @FCompressLevel); - RegisterOption(ImagingJNGQuality, @FQuality); - RegisterOption(ImagingJNGProgressive, @FProgressive); - -end; - -function TJNGFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - NGFileLoader: TNGFileLoader; -begin - Result := False; - NGFileLoader := TNGFileLoader.Create(Self); - try - // Use NG file parser to load file - if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then - with NGFileLoader.Frames[0] do - begin - SetLength(Images, 1); - // Build actual image bits - if IsJpegFrame then - NGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight, JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[0]); - // Build palette, aply color key or background - NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]); - Result := True; - end; - finally - NGFileLoader.LoadMetaData; // Store metadata - NGFileLoader.Free; - end; -end; - -function TJNGFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - NGFileSaver: TNGFileSaver; - ImageToSave: TImageData; - MustBeFreed: Boolean; -begin - // Make image JNG compatible, store it in saver, and save it to file - Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed); - if Result then - begin - NGFileSaver := TNGFileSaver.Create(Self); - with NGFileSaver do - try - FileType := ngJNG; - SetFileOptions; - AddFrame(ImageToSave, True); - SaveFile(Handle); - finally - // Free NG saver and compatible image - NGFileSaver.Free; - if MustBeFreed then - FreeImage(ImageToSave); - end; - end; -end; - -{$ENDIF} - -initialization - RegisterImageFileFormat(TPNGFileFormat); -{$IFNDEF DONT_LINK_MNG} - RegisterImageFileFormat(TMNGFileFormat); -{$ENDIF} -{$IFNDEF DONT_LINK_JNG} - RegisterImageFileFormat(TJNGFileFormat); -{$ENDIF} -finalization - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77 Changes/Bug Fixes ----------------------------------- - - Reads and writes APNG animation loop count metadata. - - Writes frame delays of APNG from metadata. - - Fixed color keys in 8bit depth PNG/MNG loading. - - Fixed needless (and sometimes buggy) conversion to format with alpha - channel in FPC (GetMem(0) <> nil!). - - Added support for optional ZLib compression strategy. - - Added loading and saving of ifBinary (1bit black and white) - format images. During loading grayscale 1bpp and indexed 1bpp - (with only black and white colors in palette) are treated as ifBinary. - ifBinary are saved as 1bpp grayscale PNGs. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Reads frame delays from APNG files into metadata. - - Added loading and saving of metadata from these chunks: pHYs. - - Simplified decoding of 1/2/4 bit images a bit (less code). - - -- 0.26.3 Changes/Bug Fixes --------------------------------- - - Added APNG saving support. - - Added APNG support to NG loader and animating to PNG loader. - - -- 0.26.1 Changes/Bug Fixes --------------------------------- - - Changed file format conditional compilation to reflect changes - in LINK symbols. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Changes for better thread safety. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added loading of global palettes and transparencies in MNG files - (and by doing so fixed crash when loading images with global PLTE or tRNS). - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Small changes in converting to supported formats. - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Made public properties for options registered to SetOption/GetOption - functions. - - Changed extensions to filename masks. - - Changed SaveData, LoadData, and MakeCompatible methods according - to changes in base class in Imaging unit. - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - MNG and JNG support added, PNG support redesigned to support NG file handlers - - added classes for working with NG file formats - - stuff from old ImagingPng unit added and that unit was deleted - - unit created and initial stuff added - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - when saving indexed images save alpha to tRNS? - - added some defines and ifdefs to dzlib unit to allow choosing - impaszlib, fpc's paszlib, zlibex or other zlib implementation - - added colorkeying support - - fixed 16bit channel image handling - pixels were not swapped - - fixed arithmetic overflow (in paeth filter) in FPC - - data of unknown chunks are skipped and not needlesly loaded - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - adaptive filtering added to PNG saving - - TPNGFileFormat class added -} - -end. diff --git a/3rd/Imaging/Source/ImagingOptions.inc b/3rd/Imaging/Source/ImagingOptions.inc deleted file mode 100644 index 36ffcae1b..000000000 --- a/3rd/Imaging/Source/ImagingOptions.inc +++ /dev/null @@ -1,214 +0,0 @@ -{ - User Options - Following defines and options can be changed by user. -} - -{ Source options } - -{$DEFINE USE_INLINE} // Use function inlining for some functions - // works in Free Pascal and Delphi 9+. -{$DEFINE USE_ASM} // Ff defined, assembler versions of some - // functions will be used (only for x86). - - // Debug options: If none of these two are defined - // your project settings are used. -{ $DEFINE IMAGING_DEBUG} // If defined, debug info, range/IO/overflow - // checking, stack frames, assertions, and - // other debugging options will be turned on. -{ $DEFINE IMAGING_RELEASE} // If defined, all debug info is off. - - - -(* File format support linking options. - Define formats which you don't want to be registred automatically. - Default: all formats are registered = no symbols defined. - Example: If you want to disable JPEG support just uncomment //{$DEFINE DONT_LINK_JPEG} line -*) - -//{$DEFINE DONT_LINK_JPEG} // link support for Jpeg images -//{$DEFINE DONT_LINK_PNG} // link support for PNG images -//{$DEFINE DONT_LINK_TARGA} // link support for Targa images -//{$DEFINE DONT_LINK_BITMAP} // link support for Windows Bitmap images -//{$DEFINE DONT_LINK_DDS} // link support for DDS images -//{$DEFINE DONT_LINK_GIF} // link support for GIF images -//{$DEFINE DONT_LINK_MNG} // link support for MNG images -//{$DEFINE DONT_LINK_JNG} // link support for JNG images -//{$DEFINE DONT_LINK_PNM} // link support for PortableMap images (PBM, PGM, PPM, PAM, PFM) -//{$DEFINE DONT_LINK_RADHDR} // link support for Radiance HDR/RGBE file format - -//{$DEFINE DONT_LINK_EXTRAS} // link support for file formats defined in - // Extras package. Exactly which formats will be - // registered depends on settings in - // ImagingExtras.pas unit. - -{ Component set used in ImagignComponents.pas unit. You usually don't need - to be concerned with this - proper component library is selected automatically - according to your compiler. } - -{$DEFINE COMPONENT_SET_VCL} // use Delphi VCL -{ $DEFINE COMPONENT_SET_LCL} // use Lazarus LCL (set automatically when compiling with FPC) - -{ - Auto Options - Following options and defines are set automatically and some - are required for Imaging to compile successfully. Do not change - anything here if you don't know what you are doing. -} - -{ Compiler options } - -{$ALIGN ON} // Field alignment: 8 Bytes (in D6+) -{$BOOLEVAL OFF} // Boolean eval: off -{$EXTENDEDSYNTAX ON} // Extended syntax: on -{$LONGSTRINGS ON} // string = AnsiString: on -{$MINENUMSIZE 4} // Min enum size: 4 B -{$TYPEDADDRESS OFF} // Typed pointers: off -{$WRITEABLECONST OFF} // Writeable constants: off - -{$IFNDEF FPC} - {$DEFINE DCC} // if not using FPC then DCC compiler is used (Delphi/BCB) - // others are not supported -{$ENDIF} - -{$IFDEF DCC} - {$DEFINE DELPHI} -{$ENDIF} - -{$IF (Defined(DCC) and (CompilerVersion >= 18.5))} - {$IFDEF RELEASE} - {$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set - // DEBUG/RELEASE mode in project options and RELEASE - // is currently set we undef DEBUG mode - {$ENDIF} -{$IFEND} - -{$IF Defined(IMAGING_DEBUG)} - {$ASSERTIONS ON} - {$DEBUGINFO ON} - {$RANGECHECKS ON} - {$IOCHECKS ON} - {$OVERFLOWCHECKS ON} - {$IFDEF DCC} - {$OPTIMIZATION OFF} - {$STACKFRAMES ON} - {$LOCALSYMBOLS ON} - {$DEFINE MEMCHECK} - {$ENDIF} - {$IFDEF FPC} - {$S+} - {$CHECKPOINTER ON} - {$ENDIF} -{$ELSEIF Defined(IMAGING_RELEASE)} - {$ASSERTIONS OFF} - {$DEBUGINFO OFF} - {$RANGECHECKS OFF} - {$IOCHECKS OFF} - {$OVERFLOWCHECKS OFF} - {$IFDEF DCC} - {$OPTIMIZATION ON} - {$STACKFRAMES OFF} - {$LOCALSYMBOLS OFF} - {$ENDIF} - {$IFDEF FPC} - {$S-} - {$ENDIF} -{$IFEND} - -{$IF Defined (CPU86) and not Defined(CPUX86)} - {$DEFINE CPUX86} // Compatibility with Delphi -{$IFEND} - -{$IF Defined (CPUX86_64) and not Defined(CPUX64)} - {$DEFINE CPUX64} // Compatibility with Delphi -{$IFEND} - -{$IF Defined (DARWIN) and not Defined(MACOSX)} - {$DEFINE MACOS} // Compatibility with Delphi -{$IFEND} - -{$IF Defined(DCC) and (CompilerVersion < 23)} - {$DEFINE CPUX86} // Compatibility with older Delphi -{$IFEND} - -{ Compiler capabilities } - -// Define if compiler supports inlining of functions and procedures -{$IF (Defined(DCC) and (CompilerVersion >= 17)) or Defined(FPC)} - {$DEFINE HAS_INLINE} -{$IFEND} - -// Define if compiler supports advanced records with methods -{$IF (Defined(DCC) and (CompilerVersion >= 18)) or - (Defined(FPC) and (FPC_FULLVERSION >= 20600))} - {$DEFINE HAS_ADVANCED_RECORDS} -{$IFEND} - -// Define if compiler supports operator overloading -// (unfortunately Delphi and FPC operator overloading is not compatible). -// FPC supports Delphi compatible operator overloads since 2.6.0 -{$IF (Defined(DCC) and (CompilerVersion >= 18)) or - (Defined(FPC) and (FPC_FULLVERSION >= 20600))} - {$DEFINE HAS_OPERATOR_OVERLOADING} -{$IFEND} - -// Anonymous methods -{$IF Defined(DCC) and (CompilerVersion >= 20) } - {$DEFINE HAS_ANON_METHODS} -{$IFEND} - -// Generic types (Delphi and FPC implementations incompatible). -// Update: FPC supports Delphi compatible generics since 2.6.0 -{$IF (Defined(DCC) and (CompilerVersion >= 20)) or - (Defined(FPC) and (FPC_FULLVERSION >= 20600))} - {$DEFINE HAS_GENERICS} -{$IFEND} - -{ Imaging options check} - -{$IFNDEF HAS_INLINE} - {$UNDEF USE_INLINE} -{$ENDIF} - -{$IF not Defined(CPUX86)} - {$UNDEF USE_ASM} -{$IFEND} - -{$IFDEF FPC} - {$DEFINE COMPONENT_SET_LCL} - {$UNDEF COMPONENT_SET_VCL} -{$ENDIF} - -{$IFDEF DELPHI} - {$UNDEF COMPONENT_SET_LCL} - {$DEFINE COMPONENT_SET_VCL} -{$ENDIF} - -{ Platform options } - -{$IF Defined(WIN32) or Defined(WIN64)} - {$DEFINE MSWINDOWS} -{$IFEND} - -{$IFDEF LINUX} - {$DEFINE UNIX} -{$ENDIF} - -{ More compiler options } - -{$IFDEF FPC} // Free Pascal options - some options set above (like min enum size) - // are reset to defaults by setting {$MODE} so they are - // redeclared here - {$MODE DELPHI} // compatible with delphi - {$GOTO ON} // alow goto - {$PACKRECORDS 8} // same as ALING 8 for Delphi - {$PACKENUM 4} // Min enum size: 4 B - {$IFDEF CPU86} - {$ASMMODE INTEL} // intel assembler mode - {$ENDIF} -{$ENDIF} - -{$IFDEF HAS_INLINE} - {$INLINE ON} // turns inlining on for compilers that support it -{$ENDIF} - - diff --git a/3rd/Imaging/Source/ImagingPortableMaps.pas b/3rd/Imaging/Source/ImagingPortableMaps.pas deleted file mode 100644 index 531c1b277..000000000 --- a/3rd/Imaging/Source/ImagingPortableMaps.pas +++ /dev/null @@ -1,977 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains loader/saver for Portable Maps file format family (or PNM). - That includes PBM, PGM, PPM, PAM, and PFM formats.} -unit ImagingPortableMaps; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Types of pixels of PNM images.} - TTupleType = (ttInvalid, ttBlackAndWhite, ttGrayScale, ttRGB, ttBlackAndWhiteAlpha, - ttGrayScaleAlpha, ttRGBAlpha, ttGrayScaleFP, ttRGBFP); - - { Record with info about PNM image used in both loading and saving functions.} - TPortableMapInfo = record - Width: LongInt; - Height: LongInt; - FormatId: AnsiChar; - MaxVal: LongInt; - BitCount: LongInt; - Depth: LongInt; - TupleType: TTupleType; - Binary: Boolean; - HasPAMHeader: Boolean; - IsBigEndian: Boolean; - end; - - { Base class for Portable Map file formats (or Portable AnyMaps or PNM). - There are several types of PNM file formats that share common - (simple) structure. This class can actually load all supported PNM formats. - Saving is also done by this class but descendants (each for different PNM - format) control it.} - TPortableMapFileFormat = class(TImageFileFormat) - protected - FIdNumbers: TChar2; - FSaveBinary: LongBool; - FUSFormat: TFormatSettings; - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveDataInternal(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt; var MapInfo: TPortableMapInfo): Boolean; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - { If set to True images will be saved in binary format. If it is False - they will be saved in text format (which could result in 5-10x bigger file). - Default is value True. Note that PAM and PFM files are always saved in binary.} - property SaveBinary: LongBool read FSaveBinary write FSaveBinary; - end; - - { Portable Bit Map is used to store monochrome 1bit images. Raster data - can be saved as text or binary data. Either way value of 0 represents white - and 1 is black. As Imaging does not have support for 1bit data formats - PBM images can be loaded but not saved. Loaded images are returned in - ifGray8 format (witch pixel values scaled from 1bit to 8bit).} - TPBMFileFormat = class(TPortableMapFileFormat) - protected - procedure Define; override; - end; - - { Portable Gray Map is used to store grayscale 8bit or 16bit images. - Raster data can be saved as text or binary data.} - TPGMFileFormat = class(TPortableMapFileFormat) - protected - procedure Define; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - end; - - { Portable Pixel Map is used to store RGB images with 8bit or 16bit channels. - Raster data can be saved as text or binary data.} - TPPMFileFormat = class(TPortableMapFileFormat) - protected - procedure Define; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - end; - - { Portable Arbitrary Map is format that can store image data formats - of PBM, PGM, and PPM formats with optional alpha channel. Raster data - can be stored only in binary format. All data formats supported - by this format are ifGray8, ifGray16, ifA8Gray8, ifA16Gray16, - ifR8G8B8, ifR16G16R16, ifA8R8G8B8, and ifA16R16G16B16.} - TPAMFileFormat = class(TPortableMapFileFormat) - protected - procedure Define; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - end; - - { Portable Float Map is unofficial extension of PNM format family which - can store images with floating point pixels. Raster data is saved in - binary format as array of IEEE 32 bit floating point numbers. One channel - or RGB images are supported by PFM format (so no alpha).} - TPFMFileFormat = class(TPortableMapFileFormat) - protected - procedure Define; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - end; - -implementation - -const - PortableMapDefaultBinary = True; - - SPBMFormatName = 'Portable Bit Map'; - SPBMMasks = '*.pbm'; - SPGMFormatName = 'Portable Gray Map'; - SPGMMasks = '*.pgm'; - PGMSupportedFormats = [ifGray8, ifGray16]; - SPPMFormatName = 'Portable Pixel Map'; - SPPMMasks = '*.ppm'; - PPMSupportedFormats = [ifR8G8B8, ifR16G16B16]; - SPAMFormatName = 'Portable Arbitrary Map'; - SPAMMasks = '*.pam'; - PAMSupportedFormats = [ifGray8, ifGray16, ifA8Gray8, ifA16Gray16, - ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16]; - SPFMFormatName = 'Portable Float Map'; - SPFMMasks = '*.pfm'; - PFMSupportedFormats = [ifR32F, ifB32G32R32F]; - -const - { TAB, CR, LF, and Space are used as seperators in Portable map headers and data.} - WhiteSpaces = [#9, #10, #13, #32]; - SPAMWidth = 'WIDTH'; - SPAMHeight = 'HEIGHT'; - SPAMDepth = 'DEPTH'; - SPAMMaxVal = 'MAXVAL'; - SPAMTupleType = 'TUPLTYPE'; - SPAMEndHdr = 'ENDHDR'; - - { Size of buffer used to speed up text PNM loading/saving.} - LineBufferCapacity = 16 * 1024; - - TupleTypeNames: array[TTupleType] of string = ( - 'INVALID', 'BLACKANDWHITE', 'GRAYSCALE', 'RGB', - 'BLACKANDWHITE_ALPHA', 'GRAYSCALE_ALPHA', 'RGB_ALPHA', 'GRAYSCALEFP', - 'RGBFP'); - -{ TPortableMapFileFormat } - -procedure TPortableMapFileFormat.Define; -begin - inherited; - FFeatures := [ffLoad, ffSave]; - FSaveBinary := PortableMapDefaultBinary; - FUSFormat := GetFormatSettingsForFloats; -end; - -function TPortableMapFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - I, ScanLineSize, MonoSize: LongInt; - Dest: PByte; - MonoData: Pointer; - Info: TImageFormatInfo; - LineBuffer: array[0..LineBufferCapacity - 1] of AnsiChar; - LineEnd, LinePos: LongInt; - MapInfo: TPortableMapInfo; - LineBreak: string; - - procedure CheckBuffer; - begin - if (LineEnd = 0) or (LinePos = LineEnd) then - begin - // Reload buffer if its is empty or its end was reached - LineEnd := GetIO.Read(Handle, @LineBuffer[0], LineBufferCapacity); - LinePos := 0; - end; - end; - - procedure FixInputPos; - begin - // Sets input's position to its real pos as it would be without buffering - if LineEnd > 0 then - begin - GetIO.Seek(Handle, -LineEnd + LinePos, smFromCurrent); - LineEnd := 0; - end; - end; - - function ReadString: string; - var - S: AnsiString; - C: AnsiChar; - begin - // First skip all whitespace chars - SetLength(S, 1); - repeat - CheckBuffer; - S[1] := LineBuffer[LinePos]; - Inc(LinePos); - if S[1] = '#' then - repeat - // Comment detected, skip everything until next line is reached - CheckBuffer; - S[1] := LineBuffer[LinePos]; - Inc(LinePos); - until S[1] = #10; - until not(S[1] in WhiteSpaces); - // Now we have reached some chars other than white space, read them until - // there is whitespace again - repeat - SetLength(S, Length(S) + 1); - CheckBuffer; - S[Length(S)] := LineBuffer[LinePos]; - Inc(LinePos); - // Repeat until current char is whitespace or end of file is reached - // (Line buffer has 0 bytes which happens only on EOF) - until (S[Length(S)] in WhiteSpaces) or (LineEnd = 0); - // Get rid of last char - whitespace or null - SetLength(S, Length(S) - 1); - // Move position to the beginning of next string (skip white space - needed - // to make the loader stop at the right input position) - repeat - CheckBuffer; - C := LineBuffer[LinePos]; - Inc(LinePos); - until not (C in WhiteSpaces) or (LineEnd = 0); - // Dec pos, current is the begining of the the string - Dec(LinePos); - - Result := string(S); - end; - - function ReadIntValue: LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} - begin - Result := StrToInt(ReadString); - end; - - procedure FindLineBreak; - var - C: AnsiChar; - begin - LineBreak := #10; - repeat - CheckBuffer; - C := LineBuffer[LinePos]; - Inc(LinePos); - - if C = #13 then - LineBreak := #13#10; - - until C = #10; - end; - - function ParseHeader: Boolean; - var - Id: TChar2; - I: TTupleType; - TupleTypeName: string; - Scale: Single; - begin - Result := False; - with GetIO do - begin - FillChar(MapInfo, SizeOf(MapInfo), 0); - Read(Handle, @Id, SizeOf(Id)); - FindLineBreak; - - if Id[1] in ['1'..'6'] then - begin - // Read header for PBM, PGM, and PPM files - MapInfo.Width := ReadIntValue; - MapInfo.Height := ReadIntValue; - - if Id[1] in ['1', '4'] then - begin - MapInfo.MaxVal := 1; - MapInfo.BitCount := 1 - end - else - begin - // Read channel max value, <=255 for 8bit images, >255 for 16bit images - // but some programs think its max colors so put <=256 here - MapInfo.MaxVal := ReadIntValue; - MapInfo.BitCount := Iff(MapInfo.MaxVal <= 256, 8, 16); - end; - - MapInfo.Depth := 1; - case Id[1] of - '1', '4': MapInfo.TupleType := ttBlackAndWhite; - '2', '5': MapInfo.TupleType := ttGrayScale; - '3', '6': - begin - MapInfo.TupleType := ttRGB; - MapInfo.Depth := 3; - end; - end; - end - else if Id[1] = '7' then - begin - // Read values from PAM header - // WIDTH - if (ReadString <> SPAMWidth) then Exit; - MapInfo.Width := ReadIntValue; - // HEIGHT - if (ReadString <> SPAMheight) then Exit; - MapInfo.Height := ReadIntValue; - // DEPTH - if (ReadString <> SPAMDepth) then Exit; - MapInfo.Depth := ReadIntValue; - // MAXVAL - if (ReadString <> SPAMMaxVal) then Exit; - MapInfo.MaxVal := ReadIntValue; - MapInfo.BitCount := Iff(MapInfo.MaxVal <= 256, 8, 16); - // TUPLETYPE - if (ReadString <> SPAMTupleType) then Exit; - TupleTypeName := ReadString; - for I := Low(TTupleType) to High(TTupleType) do - if SameText(TupleTypeName, TupleTypeNames[I]) then - begin - MapInfo.TupleType := I; - Break; - end; - // ENDHDR - if (ReadString <> SPAMEndHdr) then Exit; - end - else if Id[1] in ['F', 'f'] then - begin - // Read header of PFM file - MapInfo.Width := ReadIntValue; - MapInfo.Height := ReadIntValue; - Scale := StrToFloatDef(ReadString, 0, FUSFormat); - MapInfo.IsBigEndian := Scale > 0.0; - if Id[1] = 'F' then - MapInfo.TupleType := ttRGBFP - else - MapInfo.TupleType := ttGrayScaleFP; - MapInfo.Depth := Iff(MapInfo.TupleType = ttRGBFP, 3, 1); - MapInfo.BitCount := Iff(MapInfo.TupleType = ttRGBFP, 96, 32); - end; - - FixInputPos; - MapInfo.Binary := (Id[1] in ['4', '5', '6', '7', 'F', 'f']); - - if MapInfo.Binary and not (Id[1] in ['F', 'f']) then - begin - // Mimic the behaviour of Photoshop and other editors/viewers: - // If linenreaks in file are DOS CR/LF 16bit binary values are - // little endian, Unix LF only linebreak indicates big endian. - MapInfo.IsBigEndian := LineBreak = #10; - end; - - // Check if values found in header are valid - Result := (MapInfo.Width > 0) and (MapInfo.Height > 0) and - (MapInfo.BitCount in [1, 8, 16, 32, 96]) and (MapInfo.TupleType <> ttInvalid); - // Now check if image has proper number of channels (PAM) - if Result then - case MapInfo.TupleType of - ttBlackAndWhite, ttGrayScale: Result := MapInfo.Depth = 1; - ttBlackAndWhiteAlpha, ttGrayScaleAlpha: Result := MapInfo.Depth = 2; - ttRGB: Result := MapInfo.Depth = 3; - ttRGBAlpha: Result := MapInfo.Depth = 4; - end; - end; - end; - -begin - Result := False; - LineEnd := 0; - LinePos := 0; - SetLength(Images, 1); - - with GetIO, Images[0] do - begin - Format := ifUnknown; - // Try to parse file header - if not ParseHeader then Exit; - // Select appropriate data format based on values read from file header - case MapInfo.TupleType of - ttBlackAndWhite: Format := ifGray8; - ttBlackAndWhiteAlpha: Format := ifA8Gray8; - ttGrayScale: Format := IffFormat(MapInfo.BitCount = 8, ifGray8, ifGray16); - ttGrayScaleAlpha: Format := IffFormat(MapInfo.BitCount = 8, ifA8Gray8, ifA16Gray16); - ttRGB: Format := IffFormat(MapInfo.BitCount = 8, ifR8G8B8, ifR16G16B16); - ttRGBAlpha: Format := IffFormat(MapInfo.BitCount = 8, ifA8R8G8B8, ifA16R16G16B16); - ttGrayScaleFP: Format := ifR32F; - ttRGBFP: Format := ifB32G32R32F; - end; - // Exit if no matching data format was found - if Format = ifUnknown then Exit; - - NewImage(MapInfo.Width, MapInfo.Height, Format, Images[0]); - Info := GetFormatInfo(Format); - - // Now read pixels from file to dest image - if not MapInfo.Binary then - begin - Dest := Bits; - for I := 0 to Width * Height - 1 do - begin - case Format of - ifGray8: - begin - Dest^ := ReadIntValue; - if MapInfo.BitCount = 1 then - // If source is 1bit mono image (where 0=white, 1=black) - // we must scale it to 8bits - Dest^ := 255 - Dest^ * 255; - end; - ifGray16: PWord(Dest)^ := ReadIntValue; - ifR8G8B8: - with PColor24Rec(Dest)^ do - begin - R := ReadIntValue; - G := ReadIntValue; - B := ReadIntValue; - end; - ifR16G16B16: - with PColor48Rec(Dest)^ do - begin - R := ReadIntValue; - G := ReadIntValue; - B := ReadIntValue; - end; - end; - Inc(Dest, Info.BytesPerPixel); - end; - end - else - begin - if MapInfo.BitCount > 1 then - begin - if not (MapInfo.TupleType in [ttGrayScaleFP, ttRGBFP]) then - begin - // Just copy bytes from binary Portable Maps (non 1bit, non FP) - Read(Handle, Bits, Size); - end - else - begin - Dest := Bits; - // FP images are in BGR order and endian swap maybe needed. - // Some programs store scanlines in bottom-up order but - // I will stick with Photoshops behaviour here - Read(Handle, Bits, Size); - if MapInfo.IsBigEndian then - SwapEndianLongWord(PLongWord(Dest), Size div SizeOf(LongWord)); - end; - - if MapInfo.TupleType in [ttBlackAndWhite, ttBlackAndWhiteAlpha] then - begin - // Black and white PAM files must be scaled to 8bits. Note that - // in PAM files 1=white, 0=black (reverse of PBM) - for I := 0 to Width * Height * Iff(MapInfo.TupleType = ttBlackAndWhiteAlpha, 2, 1) - 1 do - PByteArray(Bits)[I] := PByteArray(Bits)[I] * 255; - end - else if MapInfo.TupleType in [ttRGB, ttRGBAlpha] then - begin - // Swap channels of RGB/ARGB images. Binary RGB image files use BGR order. - SwapChannels(Images[0], ChannelBlue, ChannelRed); - end; - - // Swap byte order if needed - if (MapInfo.BitCount = 16) and MapInfo.IsBigEndian then - SwapEndianWord(Bits, Width * Height * Info.BytesPerPixel div SizeOf(Word)); - end - else - begin - // Handle binary PBM files (ttBlackAndWhite 1bit) - ScanLineSize := (Width + 7) div 8; - // Get total binary data size, read it from file to temp - // buffer and convert the data to Gray8 - MonoSize := ScanLineSize * Height; - GetMem(MonoData, MonoSize); - try - Read(Handle, MonoData, MonoSize); - Convert1To8(MonoData, Bits, Width, Height, ScanLineSize, False); - // 1bit mono images must be scaled to 8bit, but inverted (where 0=white, 1=black) - for I := 0 to Width * Height - 1 do - PByteArray(Bits)[I] := 255 - PByteArray(Bits)[I] * 255; - finally - FreeMem(MonoData); - end; - end; - end; - - FixInputPos; - - if (MapInfo.MaxVal <> Pow2Int(MapInfo.BitCount) - 1) and - (MapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha, ttRGB, ttRGBAlpha]) then - begin - Dest := Bits; - // Scale color values according to MaxVal we got from header - // if necessary. - for I := 0 to Width * Height * Info.BytesPerPixel div (MapInfo.BitCount shr 3) - 1 do - begin - if MapInfo.BitCount = 8 then - Dest^ := Dest^ * 255 div MapInfo.MaxVal - else - PWord(Dest)^ := PWord(Dest)^ * 65535 div MapInfo.MaxVal; - Inc(Dest, MapInfo.BitCount shr 3); - end; - end; - - Result := True; - end; -end; - -function TPortableMapFileFormat.SaveDataInternal(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer; var MapInfo: TPortableMapInfo): Boolean; -const - // Use Unix linebreak, for many viewers/editors it means that - // 16bit samples are stored as big endian - so we need to swap byte order - // before saving - LineDelimiter = #10; - PixelDelimiter = #32; -var - ImageToSave: TImageData; - MustBeFreed: Boolean; - Info: TImageFormatInfo; - I, LineLength: LongInt; - Src: PByte; - Pixel32: TColor32Rec; - Pixel64: TColor64Rec; - W: Word; - - procedure WriteString(S: string; Delimiter: Char = LineDelimiter); - begin - SetLength(S, Length(S) + 1); - S[Length(S)] := Delimiter; - {$IF Defined(DCC) and Defined(UNICODE)} - GetIO.Write(Handle, @AnsiString(S)[1], Length(S)); - {$ELSE} - GetIO.Write(Handle, @S[1], Length(S)); - {$IFEND} - Inc(LineLength, Length(S)); - end; - - procedure WriteHeader; - begin - WriteString('P' + MapInfo.FormatId); - if not MapInfo.HasPAMHeader then - begin - // Write header of PGM, PPM, and PFM files - WriteString(IntToStr(ImageToSave.Width)); - WriteString(IntToStr(ImageToSave.Height)); - case MapInfo.TupleType of - ttGrayScale, ttRGB: WriteString(IntToStr(Pow2Int(MapInfo.BitCount) - 1)); - ttGrayScaleFP, ttRGBFP: - begin - // Negative value indicates that raster data is saved in little endian - WriteString(FloatToStr(-1.0, FUSFormat)); - end; - end; - end - else - begin - // Write PAM file header - WriteString(Format('%s %d', [SPAMWidth, ImageToSave.Width])); - WriteString(Format('%s %d', [SPAMHeight, ImageToSave.Height])); - WriteString(Format('%s %d', [SPAMDepth, MapInfo.Depth])); - WriteString(Format('%s %d', [SPAMMaxVal, Pow2Int(MapInfo.BitCount) - 1])); - WriteString(Format('%s %s', [SPAMTupleType, TupleTypeNames[MapInfo.TupleType]])); - WriteString(SPAMEndHdr); - end; - end; - -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - Info := GetFormatInfo(Format); - // Fill values of MapInfo record that were not filled by - // descendants in their SaveData methods - MapInfo.BitCount := (Info.BytesPerPixel div Info.ChannelCount) * 8; - MapInfo.Depth := Info.ChannelCount; - if MapInfo.TupleType = ttInvalid then - begin - if Info.HasGrayChannel then - begin - if Info.HasAlphaChannel then - MapInfo.TupleType := ttGrayScaleAlpha - else - MapInfo.TupleType := ttGrayScale; - end - else - begin - if Info.HasAlphaChannel then - MapInfo.TupleType := ttRGBAlpha - else - MapInfo.TupleType := ttRGB; - end; - end; - // Write file header - WriteHeader; - - if not MapInfo.Binary then - begin - Src := Bits; - LineLength := 0; - // For each pixel find its text representation and write it to file - for I := 0 to Width * Height - 1 do - begin - case Format of - ifGray8: WriteString(IntToStr(Src^), PixelDelimiter); - ifGray16: WriteString(IntToStr(PWord(Src)^), PixelDelimiter); - ifR8G8B8: - with PColor24Rec(Src)^ do - WriteString(SysUtils.Format('%d %d %d', [R, G, B]), PixelDelimiter); - ifR16G16B16: - with PColor48Rec(Src)^ do - WriteString(SysUtils.Format('%d %d %d', [R, G, B]), PixelDelimiter); - end; - // Lines in text PNM images should have length <70 - if LineLength > 65 then - begin - LineLength := 0; - WriteString('', LineDelimiter); - end; - Inc(Src, Info.BytesPerPixel); - end; - end - else - begin - // Write binary images - if not (MapInfo.TupleType in [ttGrayScaleFP, ttRGBFP]) then - begin - // Save integer binary images - if MapInfo.BitCount = 8 then - begin - if MapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha] then - begin - // 8bit grayscale images can be written in one Write call - Write(Handle, Bits, Size); - end - else - begin - // 8bit RGB/ARGB images: red and blue must be swapped and - // 3 or 4 bytes must be written - Src := Bits; - for I := 0 to Width * Height - 1 do - with PColor32Rec(Src)^ do - begin - if MapInfo.TupleType = ttRGBAlpha then - Pixel32.A := A; - Pixel32.R := B; - Pixel32.G := G; - Pixel32.B := R; - Write(Handle, @Pixel32, Info.BytesPerPixel); - Inc(Src, Info.BytesPerPixel); - end; - end; - end - else - begin - // Images with 16bit channels: make sure that channel values are saved in big endian - Src := Bits; - if MapInfo.TupleType in [ttGrayScale, ttGrayScaleAlpha] then - begin - // 16bit grayscale image - for I := 0 to Width * Height * Info.BytesPerPixel div SizeOf(Word) - 1 do - begin - W := SwapEndianWord(PWord(Src)^); - Write(Handle, @W, SizeOf(Word)); - Inc(Src, SizeOf(Word)); - end; - end - else - begin - // RGB images with 16bit channels: swap RB and endian too - for I := 0 to Width * Height - 1 do - with PColor64Rec(Src)^ do - begin - if MapInfo.TupleType = ttRGBAlpha then - Pixel64.A := SwapEndianWord(A); - Pixel64.R := SwapEndianWord(B); - Pixel64.G := SwapEndianWord(G); - Pixel64.B := SwapEndianWord(R); - Write(Handle, @Pixel64, Info.BytesPerPixel); - Inc(Src, Info.BytesPerPixel); - end; - end; - end; - end - else - begin - // Floating point images (no need to swap endian here - little - // endian is specified in file header) - Write(Handle, Bits, Size); - end; - end; - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -function TPortableMapFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Id: TChar4; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - with GetIO do - begin - ReadCount := Read(Handle, @Id, SizeOf(Id)); - Seek(Handle, -ReadCount, smFromCurrent); - Result := (Id[0] = 'P') and (Id[1] in [FIdNumbers[0], FIdNumbers[1]]) and - (Id[2] in WhiteSpaces); - end; -end; - -{ TPBMFileFormat } - -procedure TPBMFileFormat.Define; -begin - inherited; - FName := SPBMFormatName; - FFeatures := [ffLoad]; - AddMasks(SPBMMasks); - FIdNumbers := '14'; -end; - -{ TPGMFileFormat } - -procedure TPGMFileFormat.Define; -begin - inherited; - FName := SPGMFormatName; - FSupportedFormats := PGMSupportedFormats; - AddMasks(SPGMMasks); - RegisterOption(ImagingPGMSaveBinary, @FSaveBinary); - FIdNumbers := '25'; -end; - -function TPGMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -var - MapInfo: TPortableMapInfo; -begin - FillChar(MapInfo, SizeOf(MapInfo), 0); - if FSaveBinary then - MapInfo.FormatId := FIdNumbers[1] - else - MapInfo.FormatId := FIdNumbers[0]; - MapInfo.Binary := FSaveBinary; - Result := SaveDataInternal(Handle, Images, Index, MapInfo); -end; - -procedure TPGMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - // All FP images go to 16bit - ConvFormat := ifGray16 - else if Info.HasGrayChannel then - // Grayscale will be 8 or 16 bit - depends on input's bitcount - ConvFormat := IffFormat(Info.BytesPerPixel div Info.ChannelCount > 1, - ifGray16, ifGray8) - else if Info.BytesPerPixel > 4 then - // Large bitcounts -> 16bit - ConvFormat := ifGray16 - else - // Rest of the formats -> 8bit - ConvFormat := ifGray8; - - ConvertImage(Image, ConvFormat); -end; - -{ TPPMFileFormat } - -procedure TPPMFileFormat.Define; -begin - inherited; - FName := SPPMFormatName; - FSupportedFormats := PPMSupportedFormats; - AddMasks(SPPMMasks); - RegisterOption(ImagingPPMSaveBinary, @FSaveBinary); - FIdNumbers := '36'; -end; - -function TPPMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -var - MapInfo: TPortableMapInfo; -begin - FillChar(MapInfo, SizeOf(MapInfo), 0); - if FSaveBinary then - MapInfo.FormatId := FIdNumbers[1] - else - MapInfo.FormatId := FIdNumbers[0]; - MapInfo.Binary := FSaveBinary; - Result := SaveDataInternal(Handle, Images, Index, MapInfo); -end; - -procedure TPPMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - // All FP images go to 48bit RGB - ConvFormat := ifR16G16B16 - else if Info.HasGrayChannel then - // Grayscale will be 24 or 48 bit RGB - depends on input's bitcount - ConvFormat := IffFormat(Info.BytesPerPixel div Info.ChannelCount > 1, - ifR16G16B16, ifR8G8B8) - else if Info.BytesPerPixel > 4 then - // Large bitcounts -> 48bit RGB - ConvFormat := ifR16G16B16 - else - // Rest of the formats -> 24bit RGB - ConvFormat := ifR8G8B8; - - ConvertImage(Image, ConvFormat); -end; - -{ TPAMFileFormat } - -procedure TPAMFileFormat.Define; -begin - inherited; - FName := SPAMFormatName; - FSupportedFormats := PAMSupportedFormats; - AddMasks(SPAMMasks); - FIdNumbers := '77'; -end; - -function TPAMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -var - MapInfo: TPortableMapInfo; -begin - FillChar(MapInfo, SizeOf(MapInfo), 0); - MapInfo.FormatId := FIdNumbers[0]; - MapInfo.Binary := True; - MapInfo.HasPAMHeader := True; - Result := SaveDataInternal(Handle, Images, Index, MapInfo); -end; - -procedure TPAMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.IsFloatingPoint then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16) - else if Info.HasGrayChannel then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16) - else - begin - if Info.BytesPerPixel <= 4 then - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8) - else - ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16); - end; - ConvertImage(Image, ConvFormat); -end; - -{ TPFMFileFormat } - -procedure TPFMFileFormat.Define; -begin - inherited; - FName := SPFMFormatName; - AddMasks(SPFMMasks); - FIdNumbers := 'Ff'; - FSupportedFormats := PFMSupportedFormats; -end; - -function TPFMFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -var - Info: TImageFormatInfo; - MapInfo: TPortableMapInfo; -begin - FillChar(MapInfo, SizeOf(MapInfo), 0); - Info := GetFormatInfo(Images[Index].Format); - - if (Info.ChannelCount > 1) or Info.IsIndexed then - MapInfo.TupleType := ttRGBFP - else - MapInfo.TupleType := ttGrayScaleFP; - - if MapInfo.TupleType = ttGrayScaleFP then - MapInfo.FormatId := FIdNumbers[1] - else - MapInfo.FormatId := FIdNumbers[0]; - - MapInfo.Binary := True; - Result := SaveDataInternal(Handle, Images, Index, MapInfo); -end; - -procedure TPFMFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - if (Info.ChannelCount > 1) or Info.IsIndexed then - ConvertImage(Image, ifB32G32R32F) - else - ConvertImage(Image, ifR32F); -end; - -initialization - RegisterImageFileFormat(TPBMFileFormat); - RegisterImageFileFormat(TPGMFileFormat); - RegisterImageFileFormat(TPPMFileFormat); - RegisterImageFileFormat(TPAMFileFormat); - RegisterImageFileFormat(TPFMFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 Changes/Bug Fixes ----------------------------------- - - Native RGB floating point format of PFM is now supported by Imaging - so we use it now for saving instead of A32B32G32B32. - - String to float formatting changes (don't change global settings). - - -- 0.26.3 Changes/Bug Fixes ----------------------------------- - - Fixed D2009 Unicode related bug in PNM saving. - - -- 0.24.3 Changes/Bug Fixes ----------------------------------- - - Improved compatibility of 16bit/component image loading. - - Changes for better thread safety. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Made modifications to ASCII PNM loading to be more "stream-safe". - - Fixed bug: indexed images saved as grayscale in PFM. - - Changed converting to supported formats little bit. - - Added scaling of channel values (non-FP and non-mono images) according - to MaxVal. - - Added buffering to loading of PNM files. More than 10x faster now - for text files. - - Added saving support to PGM, PPM, PAM, and PFM format. - - Added PFM file format. - - Initial version created. -} - -end. diff --git a/3rd/Imaging/Source/ImagingRadiance.pas b/3rd/Imaging/Source/ImagingRadiance.pas deleted file mode 100644 index 122e0c226..000000000 --- a/3rd/Imaging/Source/ImagingRadiance.pas +++ /dev/null @@ -1,497 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Radiance HDR/RGBE images.} -unit ImagingRadiance; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Imaging, ImagingTypes, ImagingUtility; - -type - { Radiance is a suite of tools for performing lighting simulation. It's - development started in 1985 and it pioneered the concept of - high dynamic range imaging. Radiance defined an image format for storing - HDR images, now described as RGBE image format. Since it was the first - HDR image format, this format is supported by many other software packages. - - Radiance image file consists of three sections: a header, resolution string, - followed by the pixel data. Each pixel is stored as 4 bytes, one byte - mantissa for each r, g, b and a shared one byte exponent. - The pixel data may be stored uncompressed or using run length encoding. - - Imaging translates RGBE pixels to original float values and stores them - in ifR32G32B32F data format. It can read both compressed and uncompressed - files, and saves files as compressed.} - THdrFileFormat = class(TImageFileFormat) - protected - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - end; - -implementation - -uses - Math, ImagingIO; - -const - SHdrFormatName = 'Radiance HDR/RGBE'; - SHdrMasks = '*.hdr'; - HdrSupportedFormats: TImageFormats = [ifR32G32B32F]; - -type - TSignature = array[0..9] of AnsiChar; - THdrFormat = (hfRgb, hfXyz); - - THdrHeader = record - Format: THdrFormat; - Width: Integer; - Height: Integer; - end; - - TRgbe = packed record - R, G, B, E: Byte; - end; - PRgbe = ^TRgbe; - TDynRgbeArray = array of TRgbe; - -const - RadianceSignature: TSignature = '#?RADIANCE'; - RgbeSignature: TSignature = '#?RGBE'; - MaxLineLength = 256; - SFmtRgbeRle = '32-bit_rle_rgbe'; - SFmtXyzeRle = '32-bit_rle_xyze'; - -resourcestring - SErrorBadHeader = 'Bad HDR/RGBE header format.'; - SWrongScanLineWidth = 'Wrong scanline width.'; - SXyzNotSupported = 'XYZ color space not supported.'; - -{ THdrFileFormat } - -procedure THdrFileFormat.Define; -begin - inherited; - FName := SHdrFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := HdrSupportedFormats; - - AddMasks(SHdrMasks); -end; - -function THdrFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Header: THdrHeader; - IO: TIOFunctions; - - function ReadHeader: Boolean; - const - CommentIds: TAnsiCharSet = ['#', '!']; - var - Line: AnsiString; - HasResolution: Boolean; - Count, Idx: Integer; - ValStr, NativeLine: string; - ValFloat: Double; - begin - Result := False; - HasResolution := False; - Count := 0; - - repeat - if not ReadLine(IO, Handle, Line) then - Exit; - - Inc(Count); - if Count > 16 then // Too long header for HDR - Exit; - - if Length(Line) = 0 then - Continue; - if Line[1] in CommentIds then - Continue; - - NativeLine := string(Line); - - if StrMaskMatch(NativeLine, 'Format=*') then - begin - // Data format parsing - ValStr := Copy(NativeLine, 8, MaxInt); - if ValStr = SFmtRgbeRle then - Header.Format := hfRgb - else if ValStr = SFmtXyzeRle then - Header.Format := hfXyz - else - Exit; - end; - - if StrMaskMatch(NativeLine, 'Gamma=*') then - begin - ValStr := Copy(NativeLine, 7, MaxInt); - if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then - FMetadata.SetMetaItem(SMetaGamma, ValFloat); - end; - - if StrMaskMatch(NativeLine, 'Exposure=*') then - begin - ValStr := Copy(NativeLine, 10, MaxInt); - if TryStrToFloat(ValStr, ValFloat, GetFormatSettingsForFloats) then - FMetadata.SetMetaItem(SMetaExposure, ValFloat); - end; - - if StrMaskMatch(NativeLine, '?Y * ?X *') then - begin - Idx := Pos('X', NativeLine); - ValStr := SubString(NativeLine, 4, Idx - 2); - if not TryStrToInt(ValStr, Header.Height) then - Exit; - ValStr := Copy(NativeLine, Idx + 2, MaxInt); - if not TryStrToInt(ValStr, Header.Width) then - Exit; - - if (NativeLine[1] = '-') then - Header.Height := -Header.Height; - if (NativeLine[Idx - 1] = '-') then - Header.Width := -Header.Width; - - HasResolution := True; - end; - - until HasResolution; - Result := True; - end; - - procedure DecodeRgbe(const Src: TRgbe; Dest: PColor96FPRec); {$IFDEF USE_INLINE}inline;{$ENDIF} - var - Mult: Single; - begin - if Src.E > 0 then - begin - Mult := Math.Ldexp(1, Src.E - 128); - Dest.R := Src.R / 255 * Mult; - Dest.G := Src.G / 255 * Mult; - Dest.B := Src.B / 255 * Mult; - end - else - begin - Dest.R := 0; - Dest.G := 0; - Dest.B := 0; - end; - end; - - procedure ReadCompressedLine(Width, Y: Integer; var DestBuffer: TDynRgbeArray); - var - Pos: Integer; - I, X, Count: Integer; - Code, Value: Byte; - LineBuff: TDynByteArray; - Rgbe: TRgbe; - Ptr: PByte; - begin - SetLength(LineBuff, Width); - IO.Read(Handle, @Rgbe, SizeOf(Rgbe)); - - if ((Rgbe.B shl 8) or Rgbe.E) <> Width then - RaiseImaging(SWrongScanLineWidth); - - for I := 0 to 3 do - begin - Pos := 0; - while Pos < Width do - begin - IO.Read(Handle, @Code, SizeOf(Byte)); - if Code > 128 then - begin - Count := Code - 128; - IO.Read(Handle, @Value, SizeOf(Byte)); - FillMemoryByte(@LineBuff[Pos], Count, Value); - end - else - begin - Count := Code; - IO.Read(Handle, @LineBuff[Pos], Count * SizeOf(Byte)); - end; - Inc(Pos, Count); - end; - - Ptr := @PByteArray(@DestBuffer[0])[I]; - for X := 0 to Width - 1 do - begin - Ptr^ := LineBuff[X]; - Inc(Ptr, 4); - end; - end; - end; - - procedure ReadPixels(var Image: TImageData); - var - Y, X, SrcLineLen: Integer; - Dest: PColor96FPRec; - Compressed: Boolean; - Rgbe: TRgbe; - Buffer: TDynRgbeArray; - begin - Dest := Image.Bits; - Compressed := not ((Image.Width < 8) or (Image.Width > $7FFFF)); - SrcLineLen := Image.Width * SizeOf(TRgbe); - - IO.Read(Handle, @Rgbe, SizeOf(Rgbe)); - IO.Seek(Handle, -SizeOf(Rgbe), smFromCurrent); - - if (Rgbe.R <> 2) or (Rgbe.G <> 2) or ((Rgbe.B and 128) > 0) then - Compressed := False; - - SetLength(Buffer, Image.Width); - - for Y := 0 to Image.Height - 1 do - begin - if Compressed then - ReadCompressedLine(Image.Width, Y, Buffer) - else - IO.Read(Handle, @Buffer[0], SrcLineLen); - - for X := 0 to Image.Width - 1 do - begin - DecodeRgbe(Buffer[X], Dest); - Inc(Dest); - end; - end; - end; - -begin - IO := GetIO; - SetLength(Images, 1); - - // Read header, allocate new image and, then read and convert the pixels - if not ReadHeader then - RaiseImaging(SErrorBadHeader); - if (Header.Format = hfXyz) then - RaiseImaging(SXyzNotSupported); - - NewImage(Abs(Header.Width), Abs(Header.Height), ifR32G32B32F, Images[0]); - ReadPixels(Images[0]); - - // Flip/mirror the image as needed (height < 0 is default top-down) - if Header.Width < 0 then - MirrorImage(Images[0]); - if Header.Height > 0 then - FlipImage(Images[0]); - - Result := True; -end; - -function THdrFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: Integer): Boolean; -const - LineEnd = #$0A; - SPrgComment = '#Made with Vampyre Imaging Library'; - SSizeFmt = '-Y %d +X %d'; -var - ImageToSave: TImageData; - MustBeFreed: Boolean; - IO: TIOFunctions; - - procedure SaveHeader; - begin - WriteLine(IO, Handle, RadianceSignature, LineEnd); - WriteLine(IO, Handle, SPrgComment, LineEnd); - WriteLine(IO, Handle, 'FORMAT=' + SFmtRgbeRle, LineEnd + LineEnd); - WriteLine(IO, Handle, AnsiString(Format(SSizeFmt, [ImageToSave.Height, ImageToSave.Width])), LineEnd); - end; - - procedure EncodeRgbe(const Src: TColor96FPRec; var DestR, DestG, DestB, DestE: Byte); {$IFDEF USE_INLINE}inline;{$ENDIF} - var - V, M: {$IFDEF FPC}Float{$ELSE}Extended{$ENDIF}; - E: Integer; - begin - V := Src.R; - if (Src.G > V) then - V := Src.G; - if (Src.B > V) then - V := Src.B; - - if V < 1e-32 then - begin - DestR := 0; - DestG := 0; - DestB := 0; - DestE := 0; - end - else - begin - Frexp(V, M, E); - V := M * 256.0 / V; - DestR := ClampToByte(Round(Src.R * V)); - DestG := ClampToByte(Round(Src.G * V)); - DestB := ClampToByte(Round(Src.B * V)); - DestE := ClampToByte(E + 128); - end; - end; - - procedure WriteRleLine(const Line: array of Byte; Width: Integer); - const - MinRunLength = 4; - var - Cur, BeginRun, RunCount, OldRunCount, NonRunCount: Integer; - Buf: array[0..1] of Byte; - begin - Cur := 0; - while Cur < Width do - begin - BeginRun := Cur; - RunCount := 0; - OldRunCount := 0; - while (RunCount < MinRunLength) and (BeginRun < Width) do - begin - Inc(BeginRun, RunCount); - OldRunCount := RunCount; - RunCount := 1; - while (BeginRun + RunCount < Width) and (RunCount < 127) and (Line[BeginRun] = Line[BeginRun + RunCount]) do - Inc(RunCount); - end; - if (OldRunCount > 1) and (OldRunCount = BeginRun - Cur) then - begin - Buf[0] := 128 + OldRunCount; - Buf[1] := Line[Cur]; - IO.Write(Handle, @Buf, 2); - Cur := BeginRun; - end; - while Cur < BeginRun do - begin - NonRunCount := Min(128, BeginRun - Cur); - Buf[0] := NonRunCount; - IO.Write(Handle, @Buf, 1); - IO.Write(Handle, @Line[Cur], NonRunCount); - Inc(Cur, NonRunCount); - end; - if RunCount >= MinRunLength then - begin - Buf[0] := 128 + RunCount; - Buf[1] := Line[BeginRun]; - IO.Write(Handle, @Buf, 2); - Inc(Cur, RunCount); - end; - end; - end; - - procedure SavePixels; - var - Y, X, I, Width: Integer; - SrcPtr: PColor96FPRecArray; - Components: array of array of Byte; - StartLine: array[0..3] of Byte; - begin - Width := ImageToSave.Width; - // Save using RLE, each component is compressed separately - SetLength(Components, 4, Width); - - for Y := 0 to ImageToSave.Height - 1 do - begin - SrcPtr := @PColor96FPRecArray(ImageToSave.Bits)[ImageToSave.Width * Y]; - - // Identify line as using "new" RLE scheme (separate components) - StartLine[0] := 2; - StartLine[1] := 2; - StartLine[2] := Width shr 8; - StartLine[3] := Width and $FF; - IO.Write(Handle, @StartLine, SizeOf(StartLine)); - - for X := 0 to Width - 1 do - begin - EncodeRgbe(SrcPtr[X], Components[0, X], Components[1, X], - Components[2, X], Components[3, X]); - end; - - for I := 0 to 3 do - WriteRleLine(Components[I], Width); - end; - end; - -begin - Result := False; - IO := GetIO; - // Makes image to save compatible with Jpeg saving capabilities - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with ImageToSave do - try - // Save header - SaveHeader; - // Save uncompressed pixels - SavePixels; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure THdrFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -begin - ConvertImage(Image, ifR32G32B32F); -end; - -function THdrFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - FileSig: TSignature; - ReadCount: Integer; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @FileSig, SizeOf(FileSig)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount = SizeOf(FileSig)) and - ((FileSig = RadianceSignature) or CompareMem(@FileSig, @RgbeSignature, 6)); - end; -end; - -initialization - RegisterImageFileFormat(THdrFileFormat); - -{ - File Notes: - - -- 0.77.1 --------------------------------------------------- - - Added RLE compression to saving. - - Added image saving. - - Unit created with initial stuff (loading only). - -} - -end. diff --git a/3rd/Imaging/Source/ImagingTarga.pas b/3rd/Imaging/Source/ImagingTarga.pas deleted file mode 100644 index a1d4c753b..000000000 --- a/3rd/Imaging/Source/ImagingTarga.pas +++ /dev/null @@ -1,620 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains image format loader/saver for Targa images.} -unit ImagingTarga; - -{$I ImagingOptions.inc} - -interface - -uses - ImagingTypes, Imaging, ImagingFormats, ImagingUtility; - -type - { Class for loading and saving Truevision Targa images. - It can load/save 8bit indexed or grayscale, 16 bit RGB or grayscale, - 24 bit RGB and 32 bit ARGB images with or without RLE compression.} - TTargaFileFormat = class(TImageFileFormat) - protected - FUseRLE: LongBool; - procedure Define; override; - function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray; - OnlyFirstLevel: Boolean): Boolean; override; - function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray; - Index: LongInt): Boolean; override; - procedure ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); override; - public - function TestFormat(Handle: TImagingHandle): Boolean; override; - published - { Controls that RLE compression is used during saving. Accessible trough - ImagingTargaRLE option.} - property UseRLE: LongBool read FUseRLE write FUseRLE; - end; - -implementation - -const - STargaFormatName = 'Truevision Targa Image'; - STargaMasks = '*.tga'; - TargaSupportedFormats: TImageFormats = [ifIndex8, ifGray8, ifA1R5G5B5, - ifR8G8B8, ifA8R8G8B8]; - TargaDefaultRLE = False; - -const - STargaSignature = 'TRUEVISION-XFILE'; - -type - { Targa file header.} - TTargaHeader = packed record - IDLength: Byte; - ColorMapType: Byte; - ImageType: Byte; - ColorMapOff: Word; - ColorMapLength: Word; - ColorEntrySize: Byte; - XOrg: SmallInt; - YOrg: SmallInt; - Width: SmallInt; - Height: SmallInt; - PixelSize: Byte; - Desc: Byte; - end; - - { Footer at the end of TGA file.} - TTargaFooter = packed record - ExtOff: LongWord; // Extension Area Offset - DevDirOff: LongWord; // Developer Directory Offset - Signature: TChar16; // TRUEVISION-XFILE - Reserved: Byte; // ASCII period '.' - NullChar: Byte; // 0 - end; - - -{ TTargaFileFormat class implementation } - -procedure TTargaFileFormat.Define; -begin - inherited; - FName := STargaFormatName; - FFeatures := [ffLoad, ffSave]; - FSupportedFormats := TargaSupportedFormats; - - FUseRLE := TargaDefaultRLE; - - AddMasks(STargaMasks); - RegisterOption(ImagingTargaRLE, @FUseRLE); -end; - -function TTargaFileFormat.LoadData(Handle: TImagingHandle; - var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean; -var - Hdr: TTargaHeader; - Foo: TTargaFooter; - FooterFound, ExtFound: Boolean; - I, PSize, PalSize: LongWord; - Pal: Pointer; - FmtInfo: TImageFormatInfo; - WordValue: Word; - - procedure LoadRLE; - var - I, CPixel, Cnt: LongInt; - Bpp, Rle: Byte; - Buffer, Dest, Src: PByte; - BufSize: LongInt; - begin - with GetIO, Images[0] do - begin - // Alocates buffer large enough to hold the worst case - // RLE compressed data and reads then from input - BufSize := Width * Height * FmtInfo.BytesPerPixel; - BufSize := BufSize + BufSize div 2 + 1; - GetMem(Buffer, BufSize); - Src := Buffer; - Dest := Bits; - BufSize := Read(Handle, Buffer, BufSize); - - Cnt := Width * Height; - Bpp := FmtInfo.BytesPerPixel; - CPixel := 0; - while CPixel < Cnt do - begin - Rle := Src^; - Inc(Src); - if Rle < 128 then - begin - // Process uncompressed pixel - Rle := Rle + 1; - CPixel := CPixel + Rle; - for I := 0 to Rle - 1 do - begin - // Copy pixel from src to dest - case Bpp of - 1: Dest^ := Src^; - 2: PWord(Dest)^ := PWord(Src)^; - 3: PColor24Rec(Dest)^ := PColor24Rec(Src)^; - 4: PLongWord(Dest)^ := PLongWord(Src)^; - end; - Inc(Src, Bpp); - Inc(Dest, Bpp); - end; - end - else - begin - // Process compressed pixels - Rle := Rle - 127; - CPixel := CPixel + Rle; - // Copy one pixel from src to dest (many times there) - for I := 0 to Rle - 1 do - begin - case Bpp of - 1: Dest^ := Src^; - 2: PWord(Dest)^ := PWord(Src)^; - 3: PColor24Rec(Dest)^ := PColor24Rec(Src)^; - 4: PLongWord(Dest)^ := PLongWord(Src)^; - end; - Inc(Dest, Bpp); - end; - Inc(Src, Bpp); - end; - end; - // set position in source to real end of compressed data - Seek(Handle, -(BufSize - LongInt(LongWord(Src) - LongWord(Buffer))), - smFromCurrent); - FreeMem(Buffer); - end; - end; - -begin - SetLength(Images, 1); - with GetIO, Images[0] do - begin - // Read targa header - Read(Handle, @Hdr, SizeOf(Hdr)); - // Skip image ID info - Seek(Handle, Hdr.IDLength, smFromCurrent); - // Determine image format - Format := ifUnknown; - case Hdr.ImageType of - 1, 9: Format := ifIndex8; - 2, 10: case Hdr.PixelSize of - 15: Format := ifX1R5G5B5; - 16: Format := ifA1R5G5B5; - 24: Format := ifR8G8B8; - 32: Format := ifA8R8G8B8; - end; - 3, 11: Format := ifGray8; - end; - // Format was not assigned by previous testing (it should be in - // well formed targas), so formats which reflects bit dept are selected - if Format = ifUnknown then - case Hdr.PixelSize of - 8: Format := ifGray8; - 15: Format := ifX1R5G5B5; - 16: Format := ifA1R5G5B5; - 24: Format := ifR8G8B8; - 32: Format := ifA8R8G8B8; - end; - NewImage(Hdr.Width, Hdr.Height, Format, Images[0]); - FmtInfo := GetFormatInfo(Format); - - if (Hdr.ColorMapType = 1) and (Hdr.ImageType in [1, 9]) then - begin - // Read palette - PSize := Hdr.ColorMapLength * (Hdr.ColorEntrySize shr 3); - GetMem(Pal, PSize); - try - Read(Handle, Pal, PSize); - // Process palette - PalSize := Iff(Hdr.ColorMapLength > FmtInfo.PaletteEntries, - FmtInfo.PaletteEntries, Hdr.ColorMapLength); - for I := 0 to PalSize - 1 do - case Hdr.ColorEntrySize of - 24: - with Palette[I] do - begin - A := $FF; - R := PPalette24(Pal)[I].R; - G := PPalette24(Pal)[I].G; - B := PPalette24(Pal)[I].B; - end; - // I've never seen tga with these palettes so they are untested - 16: - with Palette[I] do - begin - A := (PWordArray(Pal)[I] and $8000) shr 12; - R := (PWordArray(Pal)[I] and $FC00) shr 7; - G := (PWordArray(Pal)[I] and $03E0) shr 2; - B := (PWordArray(Pal)[I] and $001F) shl 3; - end; - 32: - with Palette[I] do - begin - A := PPalette32(Pal)[I].A; - R := PPalette32(Pal)[I].R; - G := PPalette32(Pal)[I].G; - B := PPalette32(Pal)[I].B; - end; - end; - finally - FreeMemNil(Pal); - end; - end; - - case Hdr.ImageType of - 0, 1, 2, 3: - // Load uncompressed mode images - Read(Handle, Bits, Size); - 9, 10, 11: - // Load RLE compressed mode images - LoadRLE; - end; - - // Check if there is alpha channel present in A1R5GB5 images, if it is not - // change format to X1R5G5B5 - if Format = ifA1R5G5B5 then - begin - if not Has16BitImageAlpha(Width * Height, Bits) then - Format := ifX1R5G5B5; - end; - - // We must find true end of file and set input' position to it - // paint programs appends extra info at the end of Targas - // some of them multiple times (PSP Pro 8) - repeat - ExtFound := False; - FooterFound := False; - - if Read(Handle, @WordValue, 2) = 2 then - begin - // 495 = size of Extension Area - if WordValue = 495 then - begin - Seek(Handle, 493, smFromCurrent); - ExtFound := True; - end - else - Seek(Handle, -2, smFromCurrent); - end; - - if Read(Handle, @Foo, SizeOf(Foo)) = SizeOf(Foo) then - begin - if Foo.Signature = STargaSignature then - FooterFound := True - else - Seek(Handle, -SizeOf(Foo), smFromCurrent); - end; - until (not ExtFound) and (not FooterFound); - - // Some editors save targas flipped - if Hdr.Desc < 31 then - FlipImage(Images[0]); - - Result := True; - end; -end; - -function TTargaFileFormat.SaveData(Handle: TImagingHandle; - const Images: TDynImageDataArray; Index: LongInt): Boolean; -var - I: LongInt; - Hdr: TTargaHeader; - FmtInfo: TImageFormatInfo; - Pal: PPalette24; - ImageToSave: TImageData; - MustBeFreed: Boolean; - - procedure SaveRLE; - var - Dest: PByte; - WidthBytes, Written, I, Total, DestSize: LongInt; - - function CountDiff(Data: PByte; Bpp, PixelCount: Longint): LongInt; - var - Pixel: LongWord; - NextPixel: LongWord; - N: LongInt; - begin - N := 0; - Pixel := 0; - NextPixel := 0; - if PixelCount = 1 then - begin - Result := PixelCount; - Exit; - end; - case Bpp of - 1: Pixel := Data^; - 2: Pixel := PWord(Data)^; - 3: PColor24Rec(@Pixel)^ := PColor24Rec(Data)^; - 4: Pixel := PLongWord(Data)^; - end; - while PixelCount > 1 do - begin - Inc(Data, Bpp); - case Bpp of - 1: NextPixel := Data^; - 2: NextPixel := PWord(Data)^; - 3: PColor24Rec(@NextPixel)^ := PColor24Rec(Data)^; - 4: NextPixel := PLongWord(Data)^; - end; - if NextPixel = Pixel then - Break; - Pixel := NextPixel; - N := N + 1; - PixelCount := PixelCount - 1; - end; - if NextPixel = Pixel then - Result := N - else - Result := N + 1; - end; - - function CountSame(Data: PByte; Bpp, PixelCount: LongInt): LongInt; - var - Pixel: LongWord; - NextPixel: LongWord; - N: LongInt; - begin - N := 1; - Pixel := 0; - NextPixel := 0; - case Bpp of - 1: Pixel := Data^; - 2: Pixel := PWord(Data)^; - 3: PColor24Rec(@Pixel)^ := PColor24Rec(Data)^; - 4: Pixel := PLongWord(Data)^; - end; - PixelCount := PixelCount - 1; - while PixelCount > 0 do - begin - Inc(Data, Bpp); - case Bpp of - 1: NextPixel := Data^; - 2: NextPixel := PWord(Data)^; - 3: PColor24Rec(@NextPixel)^ := PColor24Rec(Data)^; - 4: NextPixel := PLongWord(Data)^; - end; - if NextPixel <> Pixel then - Break; - N := N + 1; - PixelCount := PixelCount - 1; - end; - Result := N; - end; - - procedure RleCompressLine(Data: PByte; PixelCount, Bpp: LongInt; Dest: - PByte; var Written: LongInt); - const - MaxRun = 128; - var - DiffCount: LongInt; - SameCount: LongInt; - RleBufSize: LongInt; - begin - RleBufSize := 0; - while PixelCount > 0 do - begin - DiffCount := CountDiff(Data, Bpp, PixelCount); - SameCount := CountSame(Data, Bpp, PixelCount); - if (DiffCount > MaxRun) then - DiffCount := MaxRun; - if (SameCount > MaxRun) then - SameCount := MaxRun; - if (DiffCount > 0) then - begin - Dest^ := Byte(DiffCount - 1); - Inc(Dest); - PixelCount := PixelCount - DiffCount; - RleBufSize := RleBufSize + (DiffCount * Bpp) + 1; - Move(Data^, Dest^, DiffCount * Bpp); - Inc(Data, DiffCount * Bpp); - Inc(Dest, DiffCount * Bpp); - end; - if SameCount > 1 then - begin - Dest^ := Byte((SameCount - 1) or $80); - Inc(Dest); - PixelCount := PixelCount - SameCount; - RleBufSize := RleBufSize + Bpp + 1; - Inc(Data, (SameCount - 1) * Bpp); - case Bpp of - 1: Dest^ := Data^; - 2: PWord(Dest)^ := PWord(Data)^; - 3: PColor24Rec(Dest)^ := PColor24Rec(Data)^; - 4: PLongWord(Dest)^ := PLongWord(Data)^; - end; - Inc(Data, Bpp); - Inc(Dest, Bpp); - end; - end; - Written := RleBufSize; - end; - - begin - with ImageToSave do - begin - // Allocate enough space to hold the worst case compression - // result and then compress source's scanlines - WidthBytes := Width * FmtInfo.BytesPerPixel; - DestSize := WidthBytes * Height; - DestSize := DestSize + DestSize div 2 + 1; - GetMem(Dest, DestSize); - Total := 0; - try - for I := 0 to Height - 1 do - begin - RleCompressLine(@PByteArray(Bits)[I * WidthBytes], Width, - FmtInfo.BytesPerPixel, @PByteArray(Dest)[Total], Written); - Total := Total + Written; - end; - GetIO.Write(Handle, Dest, Total); - finally - FreeMem(Dest); - end; - end; - end; - -begin - Result := False; - if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then - with GetIO, ImageToSave do - try - FmtInfo := GetFormatInfo(Format); - // Fill targa header - FillChar(Hdr, SizeOf(Hdr), 0); - Hdr.IDLength := 0; - Hdr.ColorMapType := Iff(FmtInfo.PaletteEntries > 0, 1, 0); - Hdr.Width := Width; - Hdr.Height := Height; - Hdr.PixelSize := FmtInfo.BytesPerPixel * 8; - Hdr.ColorMapLength := FmtInfo.PaletteEntries; - Hdr.ColorEntrySize := Iff(FmtInfo.PaletteEntries > 0, 24, 0); - Hdr.ColorMapOff := 0; - // This indicates that targa is stored in top-left format - // as our images -> no flipping is needed. - Hdr.Desc := 32; - // Set alpha channel size in descriptor (mostly ignored by other software though) - if Format = ifA8R8G8B8 then - Hdr.Desc := Hdr.Desc or 8 - else if Format = ifA1R5G5B5 then - Hdr.Desc := Hdr.Desc or 1; - - // Choose image type - if FmtInfo.IsIndexed then - Hdr.ImageType := Iff(FUseRLE, 9, 1) - else - if FmtInfo.HasGrayChannel then - Hdr.ImageType := Iff(FUseRLE, 11, 3) - else - Hdr.ImageType := Iff(FUseRLE, 10, 2); - - Write(Handle, @Hdr, SizeOf(Hdr)); - - // Write palette - if FmtInfo.PaletteEntries > 0 then - begin - GetMem(Pal, FmtInfo.PaletteEntries * SizeOf(TColor24Rec)); - try - for I := 0 to FmtInfo.PaletteEntries - 1 do - with Pal[I] do - begin - R := Palette[I].R; - G := Palette[I].G; - B := Palette[I].B; - end; - Write(Handle, Pal, FmtInfo.PaletteEntries * SizeOf(TColor24Rec)); - finally - FreeMemNil(Pal); - end; - end; - - if FUseRLE then - // Save rle compressed mode images - SaveRLE - else - // Save uncompressed mode images - Write(Handle, Bits, Size); - - Result := True; - finally - if MustBeFreed then - FreeImage(ImageToSave); - end; -end; - -procedure TTargaFileFormat.ConvertToSupported(var Image: TImageData; - const Info: TImageFormatInfo); -var - ConvFormat: TImageFormat; -begin - if Info.HasGrayChannel then - // Convert all grayscale images to Gray8 (preserve alpha of AxGrayx formats) - ConvFormat := IffFormat(not Info.HasAlphaChannel, ifGray8, ifA8R8G8B8) - else if Info.IsIndexed then - // Convert all indexed images to Index8 - ConvFormat := ifIndex8 - else if Info.HasAlphaChannel then - // Convert images with alpha channel to A8R8G8B8 - ConvFormat := ifA8R8G8B8 - else if Info.UsePixelFormat then - // Convert 16bit images (without alpha channel) to A1R5G5B5 - ConvFormat := ifA1R5G5B5 - else - // Convert all other formats to R8G8B8 - ConvFormat := ifR8G8B8; - - ConvertImage(Image, ConvFormat); -end; - -function TTargaFileFormat.TestFormat(Handle: TImagingHandle): Boolean; -var - Hdr: TTargaHeader; - ReadCount: LongInt; -begin - Result := False; - if Handle <> nil then - begin - ReadCount := GetIO.Read(Handle, @Hdr, SizeOf(Hdr)); - GetIO.Seek(Handle, -ReadCount, smFromCurrent); - Result := (ReadCount >= SizeOf(Hdr)) and - (Hdr.ImageType in [0, 1, 2, 3, 9, 10, 11]) and - (Hdr.PixelSize in [1, 8, 15, 16, 24, 32]) and - (Hdr.ColorEntrySize in [0, 16, 24, 32]); - end; -end; - -initialization - RegisterImageFileFormat(TTargaFileFormat); - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - MakeCompatible method moved to base class, put ConvertToSupported here. - GetSupportedFormats removed, it is now set in constructor. - - Made public properties for options registered to SetOption/GetOption - functions. - - Changed extensions to filename masks. - - Changed SaveData, LoadData, and MakeCompatible methods according - to changes in base class in Imaging unit. - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - 16 bit images are usually without alpha but some has alpha - channel and there is no indication of it - so I have added - a check: if all pixels of image are with alpha = 0 image is treated - as X1R5G5B5 otherwise as A1R5G5B5 - - fixed problems with some nonstandard 15 bit images -} - -end. - diff --git a/3rd/Imaging/Source/ImagingTypes.pas b/3rd/Imaging/Source/ImagingTypes.pas deleted file mode 100644 index e5da35fa7..000000000 --- a/3rd/Imaging/Source/ImagingTypes.pas +++ /dev/null @@ -1,567 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains basic types and constants used by Imaging library.} -unit ImagingTypes; - -{$I ImagingOptions.inc} - -interface - -const - { Current Major version of Imaging.} - ImagingVersionMajor = 0; - { Current Minor version of Imaging.} - ImagingVersionMinor = 77; - { Current patch of Imaging.} - ImagingVersionPatch = 1; - - { Imaging Option Ids whose values can be set/get by SetOption/ - GetOption functions.} - - { Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large). - Default value is 90.} - ImagingJpegQuality = 10; - { Specifies whether Jpeg images are saved in progressive format, - can be 0 or 1. Default value is 0.} - ImagingJpegProgressive = 11; - - { Specifies whether Windows Bitmaps are saved using RLE compression - (only for 1/4/8 bit images), can be 0 or 1. Default value is 1.} - ImagingBitmapRLE = 12; - - { Specifies whether Targa images are saved using RLE compression, - can be 0 or 1. Default value is 0.} - ImagingTargaRLE = 13; - - { Value of this option is non-zero if last loaded DDS file was cube map.} - ImagingDDSLoadedCubeMap = 14; - { Value of this option is non-zero if last loaded DDS file was volume texture.} - ImagingDDSLoadedVolume = 15; - { Value of this option is number of mipmap levels of last loaded DDS image.} - ImagingDDSLoadedMipMapCount = 16; - { Value of this option is depth (slices of volume texture or faces of - cube map) of last loaded DDS image.} - ImagingDDSLoadedDepth = 17; - { If it is non-zero next saved DDS file should be stored as cube map.} - ImagingDDSSaveCubeMap = 18; - { If it is non-zero next saved DDS file should be stored as volume texture.} - ImagingDDSSaveVolume = 19; - { Sets the number of mipmaps which should be stored in the next saved DDS file. - Only applies to cube maps and volumes, ordinary 2D textures save all - levels present in input.} - ImagingDDSSaveMipMapCount = 20; - { Sets the depth (slices of volume texture or faces of cube map) - of the next saved DDS file.} - ImagingDDSSaveDepth = 21; - - { Sets precompression filter used when saving PNG images. Allowed values - are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth), - 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images), - 6 (adaptive filtering - use best filter for each scanline - very slow). - Note that filters 3 and 4 are much slower than filters 1 and 2. - Default value is 5.} - ImagingPNGPreFilter = 25; - { Sets ZLib compression level used when saving PNG images. - Allowed values are in range 0 (no compresstion) to 9 (best compression). - Default value is 5.} - ImagingPNGCompressLevel = 26; - { Boolean option that specifies whether PNG images with more frames (APNG format) - are animated by Imaging (according to frame disposal/blend methods) or just - raw frames are loaded and sent to user (if you want to animate APNG yourself). - Default value is 1.} - ImagingPNGLoadAnimated = 27; - { Sets ZLib compression strategy used when saving PNG files (see deflateInit2() - in ZLib for details). Allowed values are: 0 (default), 1 (filtered), - 2 (huffman only). Default value is 0.} - ImagingPNGZLibStrategy = 28; - - { Specifies whether MNG animation frames are saved with lossy or lossless - compression. Lossless frames are saved as PNG images and lossy frames are - saved as JNG images. Allowed values are 0 (False) and 1 (True). - Default value is 0.} - ImagingMNGLossyCompression = 32; - { Defines whether alpha channel of lossy compressed MNG frames - (when ImagingMNGLossyCompression is 1) is lossy compressed too. - Allowed values are 0 (False) and 1 (True). Default value is 0.} - ImagingMNGLossyAlpha = 33; - { Sets precompression filter used when saving MNG frames as PNG images. - For details look at ImagingPNGPreFilter.} - ImagingMNGPreFilter = 34; - { Sets ZLib compression level used when saving MNG frames as PNG images. - For details look at ImagingPNGCompressLevel.} - ImagingMNGCompressLevel = 35; - { Specifies compression quality used when saving MNG frames as JNG images. - For details look at ImagingJpegQuality.} - ImagingMNGQuality = 36; - { Specifies whether images are saved in progressive format when saving MNG - frames as JNG images. For details look at ImagingJpegProgressive.} - ImagingMNGProgressive = 37; - - { Specifies whether alpha channels of JNG images are lossy compressed. - Allowed values are 0 (False) and 1 (True). Default value is 0.} - ImagingJNGLossyAlpha = 40; - { Sets precompression filter used when saving lossless alpha channels. - For details look at ImagingPNGPreFilter.} - ImagingJNGAlphaPreFilter = 41; - { Sets ZLib compression level used when saving lossless alpha channels. - For details look at ImagingPNGCompressLevel.} - ImagingJNGAlphaCompressLevel = 42; - { Defines compression quality used when saving JNG images (and lossy alpha channels). - For details look at ImagingJpegQuality.} - ImagingJNGQuality = 43; - { Specifies whether JNG images are saved in progressive format. - For details look at ImagingJpegProgressive.} - ImagingJNGProgressive = 44; - - { Specifies whether PGM files are stored in text or in binary format. - Allowed values are 0 (store as text - very! large files) and 1 (save binary). - Default value is 1.} - ImagingPGMSaveBinary = 50; - - { Specifies whether PPM files are stored in text or in binary format. - Allowed values are 0 (store as text - very! large files) and 1 (save binary). - Default value is 1.} - ImagingPPMSaveBinary = 51; - - { Boolean option that specifies whether GIF images with more frames - are animated by Imaging (according to frame disposal methods) or just - raw frames are loaded and sent to user (if you want to animate GIF yourself). - Default value is 1. - Raw frames are 256 color indexed images (ifIndex8), whereas - animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).} - ImagingGIFLoadAnimated = 56; - - { This option is used when reducing number of colors used in - image (mainly when converting from ARGB image to indexed - format). Mask is 'anded' (bitwise AND) with every pixel's - channel value when creating color histogram. If $FF is used - all 8bits of color channels are used which can result in very - slow proccessing of large images with many colors so you can - use lower masks to speed it up (FC, F8 and F0 are good - choices). Allowed values are in range <0, $FF> and default is - $FE. } - ImagingColorReductionMask = 128; - { This option can be used to override image data format during image - loading. If set to format different from ifUnknown all loaded images - are automaticaly converted to this format. Useful when you have - many files in various formats but you want them all in one format for - further proccessing. Allowed values are in - range and - default value is ifUnknown.} - ImagingLoadOverrideFormat = 129; - { This option can be used to override image data format during image - saving. If set to format different from ifUnknown all images - to be saved are automaticaly internaly converted to this format. - Note that image file formats support only a subset of Imaging data formats - so final saved file may in different format than this override. - Allowed values are in range - and default value is ifUnknown.} - ImagingSaveOverrideFormat = 130; - { Specifies resampling filter used when generating mipmaps. It is used - in GenerateMipMaps low level function and Direct3D and OpenGL extensions. - Allowed values are in range - - and default value is 1 (linear filter).} - ImagingMipMapFilter = 131; - { Specifies treshold value used when automatically converting images to - ifBinary format. For adaptive tresholding see ImagingBinary.pas unit. - Default value is 128 and allowed range is 0..255.} - ImagingBinaryTreshold = 132; - - { Returned by GetOption if given Option Id is invalid.} - InvalidOption = -$7FFFFFFF; - - { Indices that can be used to access channel values in array parts - of structures like TColor32Rec. Note that this order can be - used only for ARGB images. For ABGR image you must swap Red and Blue.} - ChannelBlue = 0; - ChannelGreen = 1; - ChannelRed = 2; - ChannelAlpha = 3; - -type - { Enum defining image data format. In formats with more channels, - first channel after "if" is stored in the most significant bits and channel - before end is stored in the least significant.} - TImageFormat = ( - ifUnknown = 0, - ifDefault = 1, - { Indexed formats using palette } - ifIndex8 = 10, - { Grayscale/Luminance formats } - ifGray8 = 40, - ifA8Gray8 = 41, - ifGray16 = 42, - ifGray32 = 43, - ifGray64 = 44, - ifA16Gray16 = 45, - { ARGB formats } - ifX5R1G1B1 = 80, - ifR3G3B2 = 81, - ifR5G6B5 = 82, - ifA1R5G5B5 = 83, - ifA4R4G4B4 = 84, - ifX1R5G5B5 = 85, - ifX4R4G4B4 = 86, - ifR8G8B8 = 87, - ifA8R8G8B8 = 88, - ifX8R8G8B8 = 89, - ifR16G16B16 = 90, - ifA16R16G16B16 = 91, - ifB16G16R16 = 92, - ifA16B16G16R16 = 93, - { Floating point formats } - ifR32F = 160, - ifA32R32G32B32F = 161, - ifA32B32G32R32F = 162, - ifR16F = 163, - ifA16R16G16B16F = 164, - ifA16B16G16R16F = 165, - ifR32G32B32F = 166, - ifB32G32R32F = 167, - { Special formats } - ifDXT1 = 200, - ifDXT3 = 201, - ifDXT5 = 202, - ifBTC = 203, - ifATI1N = 204, - ifATI2N = 205, - ifBinary = 206, - { Passtrough formats } - ifETC1 = 220, - ifETC2RGB = 221, - ifETC2RGBA = 222, - ifETC2PA = 223, - ifDXBC6 = 224, - ifDXBC7 = 225, - ifMono = 250, - ifIndex2 = 251, - ifIndex4 = 252 - ); - - { Color value for 32 bit images.} - TColor32 = LongWord; - PColor32 = ^TColor32; - - { Color value for 64 bit images.} - TColor64 = type Int64; - PColor64 = ^TColor64; - - { Color record for 24 bit images, which allows access to individual color - channels.} - TColor24Rec = packed record - case LongInt of - 0: (B, G, R: Byte); - 1: (Channels: array[0..2] of Byte); - end; - PColor24Rec = ^TColor24Rec; - TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec; - PColor24RecArray = ^TColor24RecArray; - - { Color record for 32 bit images, which allows access to individual color - channels.} - TColor32Rec = packed record - case LongInt of - 0: (Color: TColor32); - 1: (B, G, R, A: Byte); - 2: (Channels: array[0..3] of Byte); - 3: (Color24Rec: TColor24Rec); - end; - PColor32Rec = ^TColor32Rec; - TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec; - PColor32RecArray = ^TColor32RecArray; - - { Color record for 48 bit images, which allows access to individual color - channels.} - TColor48Rec = packed record - case LongInt of - 0: (B, G, R: Word); - 1: (Channels: array[0..2] of Word); - end; - PColor48Rec = ^TColor48Rec; - TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec; - PColor48RecArray = ^TColor48RecArray; - - { Color record for 64 bit images, which allows access to individual color - channels.} - TColor64Rec = packed record - case LongInt of - 0: (Color: TColor64); - 1: (B, G, R, A: Word); - 2: (Channels: array[0..3] of Word); - 3: (Color48Rec: TColor48Rec); - end; - PColor64Rec = ^TColor64Rec; - TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec; - PColor64RecArray = ^TColor64RecArray; - - { Color record for 96 bit floating point images, which allows access to - individual color channels.} - TColor96FPRec = packed record - case Integer of - 0: (B, G, R: Single); - 1: (Channels: array[0..2] of Single); - end; - PColor96FPRec = ^TColor96FPRec; - TColor96FPRecArray = array[0..MaxInt div SizeOf(TColor96FPRec) - 1] of TColor96FPRec; - PColor96FPRecArray = ^TColor96FPRecArray; - - { Color record for 128 bit floating point images, which allows access to - individual color channels.} - TColorFPRec = packed record - case LongInt of - 0: (B, G, R, A: Single); - 1: (Channels: array[0..3] of Single); - 2: (Color96Rec: TColor96FPRec); - end; - PColorFPRec = ^TColorFPRec; - TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec; - PColorFPRecArray = ^TColorFPRecArray; - - { 16 bit floating-point value. It has 1 sign bit, 5 exponent bits, - and 10 mantissa bits.} - THalfFloat = type Word; - PHalfFloat = ^THalfFloat; - - { Color record for 64 bit floating point images, which allows access to - individual color channels.} - TColorHFRec = packed record - case LongInt of - 0: (B, G, R, A: THalfFloat); - 1: (Channels: array[0..3] of THalfFloat); - end; - PColorHFRec = ^TColorHFRec; - TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec; - PColorHFRecArray = ^TColorHFRecArray; - - { Palette for indexed mode images with 32 bit colors.} - TPalette32 = TColor32RecArray; - TPalette32Size256 = array[0..255] of TColor32Rec; - PPalette32 = ^TPalette32; - - { Palette for indexd mode images with 24 bit colors.} - TPalette24 = TColor24RecArray; - TPalette24Size256 = array[0..255] of TColor24Rec; - PPalette24 = ^TPalette24; - - { Record that stores single image data and information describing it.} - TImageData = packed record - Width: LongInt; // Width of image in pixels - Height: LongInt; // Height of image in pixels - Format: TImageFormat; // Data format of image - Size: LongInt; // Size of image bits in Bytes - Bits: Pointer; // Pointer to memory containing image bits - Palette: PPalette32; // Image palette for indexed images - Tag: Pointer; // User data - end; - PImageData = ^TImageData; - - { Pixel format information used in conversions to/from 16 and 8 bit ARGB - image formats.} - TPixelFormatInfo = packed record - ABitCount, RBitCount, GBitCount, BBitCount: Byte; - ABitMask, RBitMask, GBitMask, BBitMask: LongWord; - AShift, RShift, GShift, BShift: Byte; - ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte; - end; - PPixelFormatInfo = ^TPixelFormatInfo; - - PImageFormatInfo = ^TImageFormatInfo; - - { Look at TImageFormatInfo.GetPixelsSize for details.} - TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width, - Height: LongInt): LongInt; - { Look at TImageFormatInfo.CheckDimensions for details.} - TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width, - Height: LongInt); - { Function for getting pixel colors. Native pixel is read from Image and - then translated to 32 bit ARGB.} - TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32): TColor32Rec; - { Function for getting pixel colors. Native pixel is read from Image and - then translated to FP ARGB.} - TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32): TColorFPRec; - { Procedure for setting pixel colors. Input 32 bit ARGB color is translated to - native format and then written to Image.} - TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32;const Color: TColor32Rec); - { Procedure for setting pixel colors. Input FP ARGB color is translated to - native format and then written to Image.} - TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo; - Palette: PPalette32; const Color: TColorFPRec); - - { Additional information for each TImageFormat value.} - TImageFormatInfo = packed record - Format: TImageFormat; // Format described by this record - Name: array[0..15] of Char; // Symbolic name of format - BytesPerPixel: LongInt; // Number of bytes per pixel (note: it is - // 0 for formats where BitsPerPixel < 8 (e.g. DXT). - // Use GetPixelsSize function to get size of - // image data. - ChannelCount: LongInt; // Number of image channels (R, G, B, A, Gray) - PaletteEntries: LongInt; // Number of palette entries - HasGrayChannel: Boolean; // True if image has grayscale channel - HasAlphaChannel: Boolean; // True if image has alpha channel - IsFloatingPoint: Boolean; // True if image has floating point pixels - UsePixelFormat: Boolean; // True if image uses pixel format - IsRBSwapped: Boolean; // True if Red and Blue channels are swapped - // e.g. A16B16G16R16 has IsRBSwapped True - RBSwapFormat: TImageFormat; // Indicates supported format with swapped - // Red and Blue channels, ifUnknown if such - // format does not exist - IsIndexed: Boolean; // True if image uses palette - IsSpecial: Boolean; // True if image is in special format - IsPasstrough: Boolean; // True if image is in passtrough program (Imaging - // iself doesn't know how to decode and encode it - - // complex texture compressions etc.) - PixelFormat: PPixelFormatInfo; // Pixel format structure - GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of - // Width * Height pixels of image - CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited - // values of Width and Height. This - // procedure checks and changes dimensions - // to be valid for given format. - GetPixel32: TGetPixel32Func; // 32bit ARGB pixel get function - GetPixelFP: TGetPixelFPFunc; // FP ARGB pixel get function - SetPixel32: TSetPixel32Proc; // 32bit ARGB pixel set procedure - SetPixelFP: TSetPixelFPProc; // FP ARGB pixel set procedure - SpecialNearestFormat: TImageFormat; // Regular image format used when - // compressing/decompressing special images - // as source/target - end; - - { Handle to list of image data records.} - TImageDataList = Pointer; - PImageDataList = ^TImageDataList; - - { Handle to input/output.} - TImagingHandle = Pointer; - - { Filters used in functions that resize images or their portions.} - TResizeFilter = ( - rfNearest = 0, - rfBilinear = 1, - rfBicubic = 2, - rfLanczos = 3); - - { Seek origin mode for IO function Seek.} - TSeekMode = ( - smFromBeginning = 0, - smFromCurrent = 1, - smFromEnd = 2); - - TOpenMode = ( - omReadOnly = 0, // Opens file for reading only - omCreate = 1, // Creates new file (overwriting any existing) and opens it for writing - omReadWrite = 2 // Opens for reading and writing. Non existing file is created. - ); - - { IO functions used for reading and writing images from/to input/output.} - TOpenProc = function(Source: PChar; Mode: TOpenMode): TImagingHandle; cdecl; - TCloseProc = procedure(Handle: TImagingHandle); cdecl; - TEofProc = function(Handle: TImagingHandle): Boolean; cdecl; - TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl; - TTellProc = function(Handle: TImagingHandle): LongInt; cdecl; - TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl; - TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl; - -{$IFNDEF FPC} -type -{$IF CompilerVersion <= 18.5} - PtrUInt = LongWord; -{$ELSE} - PtrUInt = NativeUInt; -{$IFEND} -{$ENDIF} - -implementation - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - add lookup tables to pixel formats for fast conversions - - -- 0.77.1 --------------------------------------------------- - - Added "Passtrough" image data formats. - - Added Tag to TImageData for storing user data. - - Added ImagingPNGZLibStrategy option. - - Changed IO functions. Merged open functions to one - and added third open mode R/W (for TIFF append etc.). - - Added new image data formats and related structures: - ifR32G32B32F, ifB32G32G32F. - - -- 0.26.5 Changes/Bug Fixes --------------------------------- - - Added ifBinary image format and ImagingBinaryTreshold option. - - Lanczos filter added to TResizeFilter enum. - - -- 0.24.3 Changes/Bug Fixes --------------------------------- - - Added ifATI1N and ifATI2N image data formats. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added ifBTC image format and SpecialNearestFormat field - to TImageFormatInfo. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Added option constants for PGM and PPM file formats. - - Added TPalette32Size256 and TPalette24Size256 types. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added ImagingVersionPatch constant so bug fix only releases - can be distinguished from ordinary major/minor releases - - renamed TPixelFormat to TPixelFormatInfo to avoid name collisions - with Graphics.TPixelFormat - - added new image data formats: ifR16F, ifA16R16G16B16F, - ifA16B16G16R16F - - added pixel get/set function pointers to TImageFormatInfo - - added 16bit half float type and color record - - renamed TColorFRec to TColorFPRec (and related types too) - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - added option ImagingMipMapFilter which now controls resampling filter - used when generating mipmaps - - added TResizeFilter type - - added ChannelCount to TImageFormatInfo - - added new option constants for MNG and JNG images - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - added RBSwapFormat to TImageFormatInfo for faster conversions - between swapped formats (it just calls SwapChannels now if - RBSwapFormat is not ifUnknown) - - moved TImageFormatInfo and required types from Imaging unit - here, removed TImageFormatShortInfo - - added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - new ImagingColorReductionMask option added - - new image format added: ifA16Gray16 - -} - -end. diff --git a/3rd/Imaging/Source/ImagingUtility.pas b/3rd/Imaging/Source/ImagingUtility.pas deleted file mode 100644 index 00f43e747..000000000 --- a/3rd/Imaging/Source/ImagingUtility.pas +++ /dev/null @@ -1,1693 +0,0 @@ -{ - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - The contents of this file are used with permission, subject to the Mozilla - Public License Version 1.1 (the "License"); you may not use this file except - in compliance with the License. You may obtain a copy of the License at - http://www.mozilla.org/MPL/MPL-1.1.html - - Software distributed under the License is distributed on an "AS IS" basis, - WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for - the specific language governing rights and limitations under the License. - - Alternatively, the contents of this file may be used under the terms of the - GNU Lesser General Public License (the "LGPL License"), in which case the - provisions of the LGPL License are applicable instead of those above. - If you wish to allow use of your version of this file only under the terms - of the LGPL License and not to allow others to use your version of this file - under the MPL, indicate your decision by deleting the provisions above and - replace them with the notice and other provisions required by the LGPL - License. If you do not delete the provisions above, a recipient may use - your version of this file under either the MPL or the LGPL License. - - For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html -} - -{ This unit contains utility functions and types for Imaging library.} -unit ImagingUtility; - -{$I ImagingOptions.inc} - -interface - -uses - SysUtils, Classes, Types; - -const - STrue = 'True'; - SFalse = 'False'; - -type - TByteArray = array[0..MaxInt - 1] of Byte; - PByteArray = ^TByteArray; - TWordArray = array[0..MaxInt div 2 - 1] of Word; - PWordArray = ^TWordArray; - TLongIntArray = array[0..MaxInt div 4 - 1] of LongInt; - PLongIntArray = ^TLongIntArray; - TLongWordArray = array[0..MaxInt div 4 - 1] of LongWord; - PLongWordArray = ^TLongWordArray; - TInt64Array = array[0..MaxInt div 8 - 1] of Int64; - PInt64Array = ^TInt64Array; - TSingleArray = array[0..MaxInt div 4 - 1] of Single; - PSingleArray = ^TSingleArray; - TBooleanArray = array[0..MaxInt - 1] of Boolean; - PBooleanArray = ^TBooleanArray; - - TDynByteArray = array of Byte; - TDynIntegerArray = array of Integer; - TDynBooleanArray = array of Boolean; - TDynStringArray = array of string; - - TWordRec = packed record - case Integer of - 0: (WordValue: Word); - 1: (Low, High: Byte); - end; - PWordRec = ^TWordRec; - TWordRecArray = array[0..MaxInt div 2 - 1] of TWordRec; - PWordRecArray = ^TWordRecArray; - - TLongWordRec = packed record - case Integer of - 0: (LongWordValue: LongWord); - 1: (Low, High: Word); - { Array variants - Index 0 means lowest significant byte (word, ...).} - 2: (Words: array[0..1] of Word); - 3: (Bytes: array[0..3] of Byte); - end; - PLongWordRec = ^TLongWordRec; - TLongWordRecArray = array[0..MaxInt div 4 - 1] of TLongWordRec; - PLongWordRecArray = ^TLongWordRecArray; - - TInt64Rec = packed record - case Integer of - 0: (Int64Value: Int64); - 1: (Low, High: LongWord); - { Array variants - Index 0 means lowest significant byte (word, ...).} - 2: (Words: array[0..3] of Word); - 3: (Bytes: array[0..7] of Byte); - end; - PInt64Rec = ^TInt64Rec; - TInt64RecArray = array[0..MaxInt div 8 - 1] of TInt64Rec; - PInt64RecArray = ^TInt64RecArray; - - TFloatHelper = record - Data: Int64; - case Integer of - 0: (Data64: Int64); - 1: (Data32: LongWord); - end; - PFloatHelper = ^TFloatHelper; - - TFloatRect = record - Left, Top, Right, Bottom: Single; - end; - - TChar2 = array[0..1] of AnsiChar; - TChar3 = array[0..2] of AnsiChar; - TChar4 = array[0..3] of AnsiChar; - TChar8 = array[0..7] of AnsiChar; - TChar16 = array[0..15] of AnsiChar; - TAnsiCharSet = set of AnsiChar; - - ENotImplemented = class(Exception) - public - constructor Create; - end; - - { Options for BuildFileList function: - flFullNames - file names in result will have full path names - (ExtractFileDir(Path) + FileName) - flRelNames - file names in result will have names relative to - ExtractFileDir(Path) dir - flRecursive - adds files in subdirectories found in Path.} - TFileListOption = (flFullNames, flRelNames, flRecursive); - TFileListOptions = set of TFileListOption; - - -{ Frees class instance and sets its reference to nil.} -procedure FreeAndNil(var Obj); -{ Frees pointer and sets it to nil.} -procedure FreeMemNil(var P); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Replacement of standard System.FreeMem procedure which checks if P is nil - (this is only needed for Free Pascal, Delphi makes checks in its FreeMem).} -procedure FreeMem(P: Pointer); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns current exception object. Do not call outside exception handler.} -function GetExceptObject: Exception; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns time value with microsecond resolution.} -function GetTimeMicroseconds: Int64; -{ Returns time value with milisecond resolution.} -function GetTimeMilliseconds: Int64; - -{ Returns file extension (without "." dot)} -function GetFileExt(const FileName: string): string; -{ Returns file name of application's executable.} -function GetAppExe: string; -{ Returns directory where application's exceutable is located without - path delimiter at the end.} -function GetAppDir: string; -{ Works like SysUtils.ExtractFileName but supports '/' and '\' dir delimiters - at the same time (whereas ExtractFileName supports on default delimiter on current platform).} -function GetFileName(const FileName: string): string; -{ Works like SysUtils.ExtractFileDir but supports '/' and '\' dir delimiters - at the same time (whereas ExtractFileDir supports on default delimiter on current platform).} -function GetFileDir(const FileName: string): string; -{ Returns True if Subject matches given Mask with optional case sensitivity. - Mask can contain ? and * special characters: ? matches - one character, * matches zero or more characters.} -function StrMaskMatch(const Subject, Mask: string; CaseSensitive: Boolean = False): Boolean; -{ This function fills Files string list with names of files found - with FindFirst/FindNext functions (See details on Path/Atrr here). - - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns - list of all files (only name.ext - no path) on C drive - - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns - list of all directories (d:\dirxxx) in root of D drive.} -function BuildFileList(Path: string; Attr: LongInt; Files: TStrings; - Options: TFileListOptions = []): Boolean; -{ Similar to RTL's Pos function but with optional Offset where search will start. - This function is in the RTL StrUtils unit but } -function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt; -{ Same as PosEx but without case sensitivity.} -function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns a sub-string from S which is followed by - Sep separator and deletes the sub-string from S including the separator.} -function StrToken(var S: string; Sep: Char): string; -{ Same as StrToken but searches from the end of S string.} -function StrTokenEnd(var S: string; Sep: Char): string; -{ Fills instance of TStrings with tokens from string S where tokens are separated by - one of Seps characters.} -procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings); -{ Returns string representation of integer number (with digit grouping). - Uses current locale.} -function IntToStrFmt(const I: Int64): string; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns string representation of float number (with digit grouping). - Uses current locale.} -function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns format settings for parsing floats (dot as decimal separator). - Useful when fomatting/parsing floats etc.} -function GetFormatSettingsForFloats: TFormatSettings; -{ Returns True if S contains at least one of the substrings in SubStrs array. Case sensitive.} -function ContainsAnySubStr(const S: string; const SubStrs: array of string): Boolean; -{ Extracts substring starting at IdxStart ending at IdxEnd. - S[IdxEnd] is not included in the result.} -function SubString(const S: string; IdxStart, IdxEnd: Integer): string; {$IFDEF USE_INLINE}inline;{$ENDIF} - -{ Clamps integer value to range } -function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Clamps float value to range } -function ClampFloat(Number: Single; Min, Max: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Clamps integer value to Byte boundaries.} -function ClampToByte(Value: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Clamps integer value to Word boundaries.} -function ClampToWord(Value: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns True if Num is power of 2.} -function IsPow2(Num: LongInt): Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns next power of 2 greater than or equal to Num - (if Num itself is power of 2 then it retuns Num).} -function NextPow2(Num: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Raises 2 to the given integer power (in range [0, 30]).} -function Pow2Int(Exponent: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Raises Base to any power.} -function Power(const Base, Exponent: Single): Single; -{ Returns log base 2 of integer X (max 2^30) or -1 if X is not power of 2.} -function Log2Int(X: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns log base 2 of X.} -function Log2(X: Single): Single; -{ Returns log base 10 of X.} -function Log10(X: Single): Single; -{ Returns largest integer <= Val (for 5.9 returns 5).} -function Floor(Value: Single): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns smallest integer >= Val (for 5.1 returns 6).} -function Ceil(Value: Single): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns lesser of two integer numbers.} -function Min(A, B: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns lesser of two float numbers.} -function MinFloat(A, B: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns greater of two integer numbers.} -function Max(A, B: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns greater of two float numbers.} -function MaxFloat(A, B: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns result from multiplying Number by Numerator and then dividing by Denominator. - Denominator must be greater than 0.} -function MulDiv(Number, Numerator, Denominator: Word): Word; {$IFDEF USE_INLINE}inline;{$ENDIF} - -{ Switches Boolean value.} -procedure Switch(var Value: Boolean); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition: Boolean; TruePart, FalsePart: LongInt): LongInt; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function IffUnsigned(Condition: Boolean; TruePart, FalsePart: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition, TruePart, FalsePart: Boolean): Boolean; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition: Boolean; const TruePart, FalsePart: string): string; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition: Boolean; TruePart, FalsePart: Char): Char; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ If Condition is True then TruePart is retured, otherwise - FalsePart is returned.} -function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Swaps two Boolean values} -procedure SwapValues(var A, B: Boolean); overload; -{ Swaps two Byte values} -procedure SwapValues(var A, B: Byte); overload; -{ Swaps two Word values} -procedure SwapValues(var A, B: Word); overload; -{ Swaps two LongInt values} -procedure SwapValues(var A, B: LongInt); overload; -{ Swaps two Single values} -procedure SwapValues(var A, B: Single); overload; -{ Swaps two LongInt values if necessary to ensure that Min <= Max.} -procedure SwapMin(var Min, Max: LongInt); {$IFDEF USE_INLINE}inline;{$ENDIF} -{ This function returns True if running on little endian machine.} -function IsLittleEndian: Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Swaps byte order of Word value.} -function SwapEndianWord(Value: Word): Word; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Swaps byte order of multiple Word values.} -procedure SwapEndianWord(P: PWordArray; Count: LongInt); overload; -{ Swaps byte order of LongWord value.} -function SwapEndianLongWord(Value: LongWord): LongWord; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Swaps byte order of multiple LongWord values.} -procedure SwapEndianLongWord(P: PLongWord; Count: LongInt); overload; - -{ Calculates CRC32 for the given data.} -procedure CalcCrc32(var Crc: LongWord; Data: Pointer; Size: LongInt); -{ Fills given memory with given Byte value. Size is size of buffer in bytes.} -procedure FillMemoryByte(Data: Pointer; Size: LongInt; Value: Byte); -{ Fills given memory with given Word value. Size is size of buffer in bytes.} -procedure FillMemoryWord(Data: Pointer; Size: LongInt; Value: Word); -{ Fills given memory with given LongWord value. Size is size of buffer in bytes.} -procedure FillMemoryLongWord(Data: Pointer; Size: LongInt; Value: LongWord); -{ Fills given memory zeroes.} -{$EXTERNALSYM ZeroMemory} // Conflicts with WinAPI ZeroMemory in C++ Builder -procedure ZeroMemory(Data: Pointer; Size: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF} - -{ Returns how many mipmap levels can be created for image of given size.} -function GetNumMipMapLevels(Width, Height: LongInt): LongInt; -{ Returns total number of levels of volume texture with given depth and - mipmap count (this is not depth * mipmaps!).} -function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt; -{ Returns rectangle (X, Y, X + Width, Y + Height).} -function BoundsToRect(X, Y, Width, Height: LongInt): TRect; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns rectangle (R.Left, R.Top, R.Left + R.Right, R.Top + R.Bottom).} -function BoundsToRect(const R: TRect): TRect; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Returns rectangle (R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top).} -function RectToBounds(const R: TRect): TRect; overload; {$IFDEF USE_INLINE}inline;{$ENDIF} -{ Clips given bounds to Clip rectangle.} -procedure ClipRectBounds(var X, Y, Width, Height: LongInt; const Clip: TRect); -{ Clips given source bounds and dest position. It is used by various CopyRect - functions that copy rect from one image to another. It handles clipping the same way - as Win32 BitBlt function. } -procedure ClipCopyBounds(var SrcX, SrcY, Width, Height, DstX, DstY: LongInt; - SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect); -{ Clips given source bounds and dest bounds. It is used by various StretchRect - functions that stretch rectangle of pixels from one image to another. - It handles clipping the same way as Win32 StretchBlt function. } -procedure ClipStretchBounds(var SrcX, SrcY, SrcWidth, SrcHeight, DstX, DstY, - DstWidth, DstHeight: LongInt; SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect); -{ Scales one rectangle to fit into another. Proportions are preserved so - it could be used for 'Stretch To Fit Window' image drawing for instance.} -function ScaleRectToRect(const SourceRect, TargetRect: TRect): TRect; -{ Scales given size to fit into max size while keeping the original ascpect ration. - Useful for calculating thumbnail dimensions etc.} -function ScaleSizeToFit(const CurrentSize, MaxSize: TSize): TSize; -{ Returns width of given rect. Part of RTL in newer Delphi.} -function RectWidth(const Rect: TRect): Integer; -{ Returns height of given rect. Part of RTL in newer Delphi.} -function RectHeight(const Rect: TRect): Integer; -{ Returns True if R1 fits into R2.} -function RectInRect(const R1, R2: TRect): Boolean; -{ Returns True if R1 and R2 intersects.} -function RectIntersects(const R1, R2: TRect): Boolean; - -{ Converts pixel size in micrometers to corrensponding DPI.} -function PixelSizeToDpi(SizeInMicroMeters: Single): Single; -{ Converts DPI to corrensponding pixel size in micrometers.} -function DpiToPixelSize(Dpi: Single): Single; - -function FloatRect(ALeft, ATop, ARight, ABottom: Single): TFloatRect; -function FloatRectWidth(const R: TFloatRect): Single; -function FloatRectHeight(const R: TFloatRect): Single; - -{ Formats given message for usage in Exception.Create(..). Use only - in except block - returned message contains message of last raised exception.} -function FormatExceptMsg(const Msg: string; const Args: array of const): string; -{ Outputs debug message - shows message dialog in Windows and writes to console - in Linux/Unix.} -procedure DebugMsg(const Msg: string; const Args: array of const); - -implementation - -uses -{$IF Defined(MSWINDOWS)} - Windows; -{$ELSEIF Defined(FPC)} - Dos, BaseUnix, Unix; -{$ELSEIF Defined(DELPHI)} - Posix.SysTime; -{$IFEND} - -var - FloatFormatSettings: TFormatSettings; - -constructor ENotImplemented.Create; -begin - inherited Create('Not implemented'); -end; - -procedure FreeAndNil(var Obj); -var - Temp: TObject; -begin - Temp := TObject(Obj); - Pointer(Obj) := nil; - Temp.Free; -end; - -procedure FreeMemNil(var P); -begin - FreeMem(Pointer(P)); - Pointer(P) := nil; -end; - -procedure FreeMem(P: Pointer); -begin - if P <> nil then - System.FreeMem(P); -end; - -function GetExceptObject: Exception; -begin - Result := Exception(ExceptObject); -end; - -{$IF Defined(MSWINDOWS)} -var - PerfFrequency: Int64; - InvPerfFrequency: Single; - -function GetTimeMicroseconds: Int64; -var - Time: Int64; -begin - QueryPerformanceCounter(Time); - Result := Round(1000000 * InvPerfFrequency * Time); -end; -{$ELSEIF Defined(DELPHI)} -function GetTimeMicroseconds: Int64; -var - Time: TimeVal; -begin - Posix.SysTime.GetTimeOfDay(Time, nil); - Result := Int64(Time.tv_sec) * 1000000 + Time.tv_usec; -end; -{$ELSEIF Defined(FPC)} -function GetTimeMicroseconds: Int64; -var - TimeVal: TTimeVal; -begin - fpGetTimeOfDay(@TimeVal, nil); - Result := Int64(TimeVal.tv_sec) * 1000000 + TimeVal.tv_usec; -end; -{$IFEND} - -function GetTimeMilliseconds: Int64; -begin - Result := GetTimeMicroseconds div 1000; -end; - -function GetFileExt(const FileName: string): string; -begin - Result := ExtractFileExt(FileName); - if Length(Result) > 1 then - Delete(Result, 1, 1); -end; - -function GetAppExe: string; -{$IF Defined(MSWINDOWS)} -var - FileName: array[0..MAX_PATH] of Char; -begin - SetString(Result, FileName, - Windows.GetModuleFileName(MainInstance, FileName, SizeOf(FileName))); -{$ELSEIF Defined(DELPHI)} // Delphi non Win targets -var - FileName: array[0..1024] of Char; -begin - SetString(Result, FileName, - System.GetModuleFileName(MainInstance, FileName, SizeOf(FileName))); -{$ELSE} -begin - Result := ParamStr(0); -{$IFEND} -end; - -function GetAppDir: string; -begin - Result := ExtractFileDir(GetAppExe); -end; - -function GetFileName(const FileName: string): string; -var - I: Integer; -begin - I := LastDelimiter('\/' + DriveDelim, FileName); - Result := Copy(FileName, I + 1, MaxInt); -end; - -function GetFileDir(const FileName: string): string; -const - Delims = '\/' + DriveDelim; -var - I: Integer; -begin - I := LastDelimiter(Delims, Filename); - if (I > 1) and - ((FileName[I] = Delims[1]) or (FileName[I] = Delims[2])) and - (not IsDelimiter(Delims, FileName, I - 1)) then Dec(I); - Result := Copy(FileName, 1, I); -end; - -function StrMaskMatch(const Subject, Mask: string; CaseSensitive: Boolean): Boolean; -var - MaskLen, KeyLen : LongInt; - - function CharMatch(A, B: Char): Boolean; - begin - if CaseSensitive then - Result := A = B - else - Result := AnsiUpperCase (A) = AnsiUpperCase (B); - end; - - function MatchAt(MaskPos, KeyPos: LongInt): Boolean; - begin - while (MaskPos <= MaskLen) and (KeyPos <= KeyLen) do - begin - case Mask[MaskPos] of - '?' : - begin - Inc(MaskPos); - Inc(KeyPos); - end; - '*' : - begin - while (MaskPos <= MaskLen) and (Mask[MaskPos] = '*') do - Inc(MaskPos); - if MaskPos > MaskLen then - begin - Result := True; - Exit; - end; - repeat - if MatchAt(MaskPos, KeyPos) then - begin - Result := True; - Exit; - end; - Inc(KeyPos); - until KeyPos > KeyLen; - Result := False; - Exit; - end; - else - if not CharMatch(Mask[MaskPos], Subject[KeyPos]) then - begin - Result := False; - Exit; - end - else - begin - Inc(MaskPos); - Inc(KeyPos); - end; - end; - end; - - while (MaskPos <= MaskLen) and (AnsiChar(Mask[MaskPos]) in ['?', '*']) do - Inc(MaskPos); - if (MaskPos <= MaskLen) or (KeyPos <= KeyLen) then - begin - Result := False; - Exit; - end; - - Result := True; - end; - -begin - MaskLen := Length(Mask); - KeyLen := Length(Subject); - if MaskLen = 0 then - begin - Result := True; - Exit; - end; - Result := MatchAt(1, 1); -end; - -function BuildFileList(Path: string; Attr: LongInt; - Files: TStrings; Options: TFileListOptions): Boolean; -var - FileMask: string; - RootDir: string; - Folders: TStringList; - CurrentItem: LongInt; - Counter: LongInt; - LocAttr: LongInt; - - procedure BuildFolderList; - var - FindInfo: TSearchRec; - Rslt: LongInt; - begin - Counter := Folders.Count - 1; - CurrentItem := 0; - while CurrentItem <= Counter do - begin - // Searching for subfolders - Rslt := SysUtils.FindFirst(Folders[CurrentItem] + '*', faDirectory, FindInfo); - try - while Rslt = 0 do - begin - if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and - (FindInfo.Attr and faDirectory = faDirectory) then - Folders.Add(Folders[CurrentItem] + FindInfo.Name + PathDelim); - Rslt := SysUtils.FindNext(FindInfo); - end; - finally - SysUtils.FindClose(FindInfo); - end; - Counter := Folders.Count - 1; - Inc(CurrentItem); - end; - end; - - procedure FillFileList(CurrentCounter: LongInt); - var - FindInfo: TSearchRec; - Res: LongInt; - CurrentFolder: string; - begin - CurrentFolder := Folders[CurrentCounter]; - Res := SysUtils.FindFirst(CurrentFolder + FileMask, LocAttr, FindInfo); - if flRelNames in Options then - CurrentFolder := ExtractRelativePath(RootDir, CurrentFolder); - try - while Res = 0 do - begin - if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') then - begin - if (flFullNames in Options) or (flRelNames in Options) then - Files.Add(CurrentFolder + FindInfo.Name) - else - Files.Add(FindInfo.Name); - end; - Res := SysUtils.FindNext(FindInfo); - end; - finally - SysUtils.FindClose(FindInfo); - end; - end; - -begin - FileMask := ExtractFileName(Path); - RootDir := ExtractFilePath(Path); - Folders := TStringList.Create; - Folders.Add(RootDir); - Files.Clear; -{$IFDEF DCC} - {$WARN SYMBOL_PLATFORM OFF} -{$ENDIF} - if Attr = faAnyFile then - LocAttr := faSysFile or faHidden or faArchive or faReadOnly - else - LocAttr := Attr; -{$IFDEF DCC} - {$WARN SYMBOL_PLATFORM ON} -{$ENDIF} - // Here's the recursive search for nested folders - if flRecursive in Options then - BuildFolderList; - if Attr <> faDirectory then - for Counter := 0 to Folders.Count - 1 do - FillFileList(Counter) - else - Files.AddStrings(Folders); - Folders.Free; - Result := True; -end; - -function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt; -var - I, X: LongInt; - Len, LenSubStr: LongInt; -begin - I := Offset; - LenSubStr := Length(SubStr); - Len := Length(S) - LenSubStr + 1; - while I <= Len do - begin - if S[I] = SubStr[1] then - begin - X := 1; - while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do - Inc(X); - if (X = LenSubStr) then - begin - Result := I; - Exit; - end; - end; - Inc(I); - end; - Result := 0; -end; - -function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt; -begin - Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset); -end; - -function StrToken(var S: string; Sep: Char): string; -var - I: LongInt; -begin - I := Pos(Sep, S); - if I <> 0 then - begin - Result := Copy(S, 1, I - 1); - Delete(S, 1, I); - end - else - begin - Result := S; - S := ''; - end; -end; - -function StrTokenEnd(var S: string; Sep: Char): string; -var - I, J: LongInt; -begin - J := 0; - I := Pos(Sep, S); - while I <> 0 do - begin - J := I; - I := PosEx(Sep, S, J + 1); - end; - if J <> 0 then - begin - Result := Copy(S, J + 1, MaxInt); - Delete(S, J, MaxInt); - end - else - begin - Result := S; - S := ''; - end; -end; - -procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings); -var - Token, Str: string; -begin - Tokens.Clear; - Str := S; - while Str <> '' do - begin - Token := StrToken(Str, Sep); - Tokens.Add(Token); - end; -end; - -function IntToStrFmt(const I: Int64): string; -begin - Result := Format('%.0n', [I * 1.0]); -end; - -function FloatToStrFmt(const F: Double; Precision: Integer): string; -begin - Result := Format('%.' + IntToStr(Precision) + 'n', [F]); -end; - -function GetFormatSettingsForFloats: TFormatSettings; -begin - Result := FloatFormatSettings; -end; - -function ContainsAnySubStr(const S: string; const SubStrs: array of string): Boolean; -var - I: Integer; -begin - Result := False; - for I := 0 to High(SubStrs) do - begin - Result := Pos(SubStrs[I], S) > 0; - if Result then - Exit; - end; -end; - -function SubString(const S: string; IdxStart, IdxEnd: Integer): string; -begin - Result := Copy(S, IdxStart, IdxEnd - IdxStart); -end; - -function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; -begin - Result := Number; - if Result < Min then - Result := Min - else if Result > Max then - Result := Max; -end; - -function ClampFloat(Number: Single; Min, Max: Single): Single; -begin - Result := Number; - if Result < Min then - Result := Min - else if Result > Max then - Result := Max; -end; - -function ClampToByte(Value: LongInt): LongInt; -begin - Result := Value; - if Result > 255 then - Result := 255 - else if Result < 0 then - Result := 0; -end; - -function ClampToWord(Value: LongInt): LongInt; -begin - Result := Value; - if Result > 65535 then - Result := 65535 - else if Result < 0 then - Result := 0; -end; - -function IsPow2(Num: LongInt): Boolean; -begin - Result := (Num and -Num) = Num; -end; - -function NextPow2(Num: LongInt): LongInt; -begin - Result := Num and -Num; - while Result < Num do - Result := Result shl 1; -end; - -function Pow2Int(Exponent: LongInt): LongInt; -begin - Result := 1 shl Exponent; -end; - -function Power(const Base, Exponent: Single): Single; -begin - if Exponent = 0.0 then - Result := 1.0 - else if (Base = 0.0) and (Exponent > 0.0) then - Result := 0.0 - else - Result := Exp(Exponent * Ln(Base)); -end; - -function Log2Int(X: LongInt): LongInt; -begin - case X of - 1: Result := 0; - 2: Result := 1; - 4: Result := 2; - 8: Result := 3; - 16: Result := 4; - 32: Result := 5; - 64: Result := 6; - 128: Result := 7; - 256: Result := 8; - 512: Result := 9; - 1024: Result := 10; - 2048: Result := 11; - 4096: Result := 12; - 8192: Result := 13; - 16384: Result := 14; - 32768: Result := 15; - 65536: Result := 16; - 131072: Result := 17; - 262144: Result := 18; - 524288: Result := 19; - 1048576: Result := 20; - 2097152: Result := 21; - 4194304: Result := 22; - 8388608: Result := 23; - 16777216: Result := 24; - 33554432: Result := 25; - 67108864: Result := 26; - 134217728: Result := 27; - 268435456: Result := 28; - 536870912: Result := 29; - 1073741824: Result := 30; - else - Result := -1; - end; -end; - -function Log2(X: Single): Single; -{$IFDEF USE_ASM} -asm - FLD1 - FLD X - FYL2X - FWAIT -end; -{$ELSE} -const - Ln2: Single = 0.6931471; -begin - Result := Ln(X) / Ln2; -end; -{$ENDIF} - -function Log10(X: Single): Single; -{$IFDEF USE_ASM} -asm - FLDLG2 - FLD X - FYL2X - FWAIT -end; -{$ELSE} -const - Ln10: Single = 2.30258509299405; -begin - Result := Ln(X) / Ln10; -end; -{$ENDIF} - -function Floor(Value: Single): LongInt; -begin - Result := Trunc(Value); - if Frac(Value) < 0.0 then - Dec(Result); -end; - -function Ceil(Value: Single): LongInt; -begin - Result := Trunc(Value); - if Frac(Value) > 0.0 then - Inc(Result); -end; - -procedure Switch(var Value: Boolean); -begin - Value := not Value; -end; - -function Iff(Condition: Boolean; TruePart, FalsePart: LongInt): LongInt; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function IffUnsigned(Condition: Boolean; TruePart, FalsePart: LongWord): LongWord; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function Iff(Condition, TruePart, FalsePart: Boolean): Boolean; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function Iff(Condition: Boolean; const TruePart, FalsePart: string): string; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function Iff(Condition: Boolean; TruePart, FalsePart: Char): Char; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single; -begin - if Condition then - Result := TruePart - else - Result := FalsePart; -end; - -procedure SwapValues(var A, B: Boolean); -var - Tmp: Boolean; -begin - Tmp := A; - A := B; - B := Tmp; -end; - -procedure SwapValues(var A, B: Byte); -var - Tmp: Byte; -begin - Tmp := A; - A := B; - B := Tmp; -end; - -procedure SwapValues(var A, B: Word); -var - Tmp: Word; -begin - Tmp := A; - A := B; - B := Tmp; -end; - -procedure SwapValues(var A, B: LongInt); -var - Tmp: LongInt; -begin - Tmp := A; - A := B; - B := Tmp; -end; - -procedure SwapValues(var A, B: Single); -var - Tmp: Single; -begin - Tmp := A; - A := B; - B := Tmp; -end; - -procedure SwapMin(var Min, Max: LongInt); -var - Tmp: LongInt; -begin - if Min > Max then - begin - Tmp := Min; - Min := Max; - Max := Tmp; - end; -end; - -function Min(A, B: LongInt): LongInt; -begin - if A < B then - Result := A - else - Result := B; -end; - -function MinFloat(A, B: Single): Single; -begin - if A < B then - Result := A - else - Result := B; -end; - -function Max(A, B: LongInt): LongInt; -begin - if A > B then - Result := A - else - Result := B; -end; - -function MaxFloat(A, B: Single): Single; -begin - if A > B then - Result := A - else - Result := B; -end; - -function MulDiv(Number, Numerator, Denominator: Word): Word; -{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))} -asm - MUL DX - DIV CX -end; -{$ELSE} -begin - Result := Number * Numerator div Denominator; -end; -{$IFEND} - -function IsLittleEndian: Boolean; -var - W: Word; -begin - W := $00FF; - Result := PByte(@W)^ = $FF; -end; - -function SwapEndianWord(Value: Word): Word; -{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))} -asm - XCHG AH, AL -end; -{$ELSE} -begin - TWordRec(Result).Low := TWordRec(Value).High; - TWordRec(Result).High := TWordRec(Value).Low; -end; -{$IFEND} - -procedure SwapEndianWord(P: PWordArray; Count: LongInt); -{$IFDEF USE_ASM} -asm -@Loop: - MOV CX, [EAX] - XCHG CH, CL - MOV [EAX], CX - ADD EAX, 2 - DEC EDX - JNZ @Loop -end; -{$ELSE} -var - I: LongInt; - Temp: Word; -begin - for I := 0 to Count - 1 do - begin - Temp := P[I]; - TWordRec(P[I]).Low := TWordRec(Temp).High; - TWordRec(P[I]).High := TWordRec(Temp).Low; - end; -end; -{$ENDIF} - -function SwapEndianLongWord(Value: LongWord): LongWord; -{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))} -asm - BSWAP EAX -end; -{$ELSE} -begin - TLongWordRec(Result).Bytes[0] := TLongWordRec(Value).Bytes[3]; - TLongWordRec(Result).Bytes[1] := TLongWordRec(Value).Bytes[2]; - TLongWordRec(Result).Bytes[2] := TLongWordRec(Value).Bytes[1]; - TLongWordRec(Result).Bytes[3] := TLongWordRec(Value).Bytes[0]; -end; -{$IFEND} - -procedure SwapEndianLongWord(P: PLongWord; Count: LongInt); -{$IFDEF USE_ASM} -asm -@Loop: - MOV ECX, [EAX] - BSWAP ECX - MOV [EAX], ECX - ADD EAX, 4 - DEC EDX - JNZ @Loop -end; -{$ELSE} -var - I: LongInt; - Temp: LongWord; -begin - for I := 0 to Count - 1 do - begin - Temp := PLongWordArray(P)[I]; - TLongWordRec(PLongWordArray(P)[I]).Bytes[0] := TLongWordRec(Temp).Bytes[3]; - TLongWordRec(PLongWordArray(P)[I]).Bytes[1] := TLongWordRec(Temp).Bytes[2]; - TLongWordRec(PLongWordArray(P)[I]).Bytes[2] := TLongWordRec(Temp).Bytes[1]; - TLongWordRec(PLongWordArray(P)[I]).Bytes[3] := TLongWordRec(Temp).Bytes[0]; - end; -end; -{$ENDIF} - -type - TCrcTable = array[Byte] of LongWord; -var - CrcTable: TCrcTable; - -procedure InitCrcTable; -const - Polynom = $EDB88320; -var - I, J: LongInt; - C: LongWord; -begin - for I := 0 to 255 do - begin - C := I; - for J := 0 to 7 do - begin - if (C and $01) <> 0 then - C := Polynom xor (C shr 1) - else - C := C shr 1; - end; - CrcTable[I] := C; - end; -end; - -procedure CalcCrc32(var Crc: LongWord; Data: Pointer; Size: LongInt); -var - I: LongInt; - B: PByte; -begin - B := Data; - for I := 0 to Size - 1 do - begin - Crc := (Crc shr 8) xor CrcTable[B^ xor Byte(Crc)]; - Inc(B); - end -end; - -procedure FillMemoryByte(Data: Pointer; Size: LongInt; Value: Byte); -{$IFDEF USE_ASM} -asm - PUSH EDI - MOV EDI, EAX - MOV EAX, ECX - MOV AH, AL - MOV CX, AX - SHL EAX, 16 - MOV AX, CX - MOV ECX, EDX - SAR ECX, 2 - JS @Exit - REP STOSD - MOV ECX, EDX - AND ECX, 3 - REP STOSB - POP EDI -@Exit: -end; -{$ELSE} -begin - FillChar(Data^, Size, Value); -end; -{$ENDIF} - -procedure FillMemoryWord(Data: Pointer; Size: LongInt; Value: Word); -{$IFDEF USE_ASM} -asm - PUSH EDI - PUSH EBX - MOV EBX, EDX - MOV EDI, EAX - MOV EAX, ECX - MOV CX, AX - SHL EAX, 16 - MOV AX, CX - MOV ECX, EDX - SHR ECX, 2 - JZ @Word - REP STOSD -@Word: - MOV ECX, EBX - AND ECX, 2 - JZ @Byte - MOV [EDI], AX - ADD EDI, 2 -@Byte: - MOV ECX, EBX - AND ECX, 1 - JZ @Exit - MOV [EDI], AL -@Exit: - POP EBX - POP EDI -end; -{$ELSE} -var - I, V: LongWord; -begin - V := Value * $10000 + Value; - for I := 0 to Size div 4 - 1 do - PLongWordArray(Data)[I] := V; - case Size mod 4 of - 1: PByteArray(Data)[Size - 1] := Lo(Value); - 2: PWordArray(Data)[Size div 2] := Value; - 3: - begin - PWordArray(Data)[Size div 2 - 1] := Value; - PByteArray(Data)[Size - 1] := Lo(Value); - end; - end; -end; -{$ENDIF} - -procedure FillMemoryLongWord(Data: Pointer; Size: LongInt; Value: LongWord); -{$IFDEF USE_ASM} -asm - PUSH EDI - PUSH EBX - MOV EBX, EDX - MOV EDI, EAX - MOV EAX, ECX - MOV ECX, EDX - SHR ECX, 2 - JZ @Word - REP STOSD -@Word: - MOV ECX, EBX - AND ECX, 2 - JZ @Byte - MOV [EDI], AX - ADD EDI, 2 -@Byte: - MOV ECX, EBX - AND ECX, 1 - JZ @Exit - MOV [EDI], AL -@Exit: - POP EBX - POP EDI -end; -{$ELSE} -var - I: LongInt; -begin - for I := 0 to Size div 4 - 1 do - PLongWordArray(Data)[I] := Value; - case Size mod 4 of - 1: PByteArray(Data)[Size - 1] := TLongWordRec(Value).Bytes[0]; - 2: PWordArray(Data)[Size div 2] := TLongWordRec(Value).Words[0]; - 3: - begin - PWordArray(Data)[Size div 2 - 1] := TLongWordRec(Value).Words[0]; - PByteArray(Data)[Size - 1] := TLongWordRec(Value).Bytes[0]; - end; - end; -end; -{$ENDIF} - -procedure ZeroMemory(Data: Pointer; Size: Integer); -begin - FillMemoryByte(Data, Size, 0); -end; - -function GetNumMipMapLevels(Width, Height: LongInt): LongInt; -begin - Result := 0; - if (Width > 0) and (Height > 0) then - begin - Result := 1; - while (Width <> 1) or (Height <> 1) do - begin - Width := Width div 2; - Height := Height div 2; - if Width < 1 then Width := 1; - if Height < 1 then Height := 1; - Inc(Result); - end; - end; -end; - -function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt; -var - I: LongInt; -begin - Result := Depth; - for I := 1 to MipMaps - 1 do - Inc(Result, ClampInt(Depth shr I, 1, Depth)); -end; - -function BoundsToRect(X, Y, Width, Height: LongInt): TRect; -begin - Result.Left := X; - Result.Top := Y; - Result.Right := X + Width; - Result.Bottom := Y + Height; -end; - -function BoundsToRect(const R: TRect): TRect; -begin - Result.Left := R.Left; - Result.Top := R.Top; - Result.Right := R.Left + R.Right; - Result.Bottom := R.Top + R.Bottom; -end; - -function RectToBounds(const R: TRect): TRect; -begin - Result.Left := R.Left; - Result.Top := R.Top; - Result.Right := R.Right - R.Left; - Result.Bottom := R.Bottom - R.Top; -end; - -procedure ClipRectBounds(var X, Y, Width, Height: LongInt; const Clip: TRect); - - procedure ClipDim(var AStart, ALength: LongInt; ClipMin, ClipMax: LongInt); - begin - if AStart < ClipMin then - begin - ALength := ALength - (ClipMin - AStart); - AStart := ClipMin; - end; - if AStart + ALength > ClipMax then ALength := Max(0, ClipMax - AStart); - end; - -begin - ClipDim(X, Width, Clip.Left, Clip.Right); - ClipDim(Y, Height, Clip.Top, Clip.Bottom); -end; - -procedure ClipCopyBounds(var SrcX, SrcY, Width, Height, DstX, DstY: LongInt; SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect); - - procedure ClipDim(var SrcPos, DstPos, Size: LongInt; SrcClipMax, - DstClipMin, DstClipMax: LongInt); - var - OldDstPos: LongInt; - Diff: LongInt; - begin - OldDstPos := Iff(DstPos < 0, DstPos, 0); - if DstPos < DstClipMin then - begin - Diff := DstClipMin - DstPos; - Size := Size - Diff; - SrcPos := SrcPos + Diff; - DstPos := DstClipMin; - end; - if SrcPos < 0 then - begin - Size := Size + SrcPos - OldDstPos; - DstPos := DstPos - SrcPos + OldDstPos; - SrcPos := 0; - end; - if SrcPos + Size > SrcClipMax then Size := SrcClipMax - SrcPos; - if DstPos + Size > DstClipMax then Size := DstClipMax - DstPos; - end; - -begin - ClipDim(SrcX, DstX, Width, SrcImageWidth, DstClip.Left, DstClip.Right); - ClipDim(SrcY, DstY, Height, SrcImageHeight, DstClip.Top, DstClip.Bottom); -end; - -procedure ClipStretchBounds(var SrcX, SrcY, SrcWidth, SrcHeight, DstX, DstY, - DstWidth, DstHeight: LongInt; SrcImageWidth, SrcImageHeight: LongInt; const DstClip: TRect); - - procedure ClipDim(var SrcPos, DstPos, SrcSize, DstSize: LongInt; SrcClipMax, - DstClipMin, DstClipMax: LongInt); - var - OldSize: LongInt; - Diff: LongInt; - Scale: Single; - begin - Scale := DstSize / SrcSize; - if DstPos < DstClipMin then - begin - Diff := DstClipMin - DstPos; - DstSize := DstSize - Diff; - SrcPos := SrcPos + Round(Diff / Scale); - SrcSize := SrcSize - Round(Diff / Scale); - DstPos := DstClipMin; - end; - if SrcPos < 0 then - begin - SrcSize := SrcSize + SrcPos; - DstPos := DstPos - Round(SrcPos * Scale); - DstSize := DstSize + Round(SrcPos * Scale); - SrcPos := 0; - end; - if SrcPos + SrcSize > SrcClipMax then - begin - OldSize := SrcSize; - SrcSize := SrcClipMax - SrcPos; - DstSize := Round(DstSize * (SrcSize / OldSize)); - end; - if DstPos + DstSize > DstClipMax then - begin - OldSize := DstSize; - DstSize := DstClipMax - DstPos; - SrcSize := Round(SrcSize * (DstSize / OldSize)); - end; - end; - -begin - ClipDim(SrcX, DstX, SrcWidth, DstWidth, SrcImageWidth, DstClip.Left, DstClip.Right); - ClipDim(SrcY, DstY, SrcHeight, DstHeight, SrcImageHeight, DstClip.Top, DstClip.Bottom); -end; - -function ScaleRectToRect(const SourceRect, TargetRect: TRect): TRect; -var - SourceWidth: LongInt; - SourceHeight: LongInt; - TargetWidth: LongInt; - TargetHeight: LongInt; - ScaledWidth: LongInt; - ScaledHeight: LongInt; -begin - SourceWidth := SourceRect.Right - SourceRect.Left; - SourceHeight := SourceRect.Bottom - SourceRect.Top; - TargetWidth := TargetRect.Right - TargetRect.Left; - TargetHeight := TargetRect.Bottom - TargetRect.Top; - - if SourceWidth * TargetHeight < SourceHeight * TargetWidth then - begin - ScaledWidth := (SourceWidth * TargetHeight) div SourceHeight; - Result := BoundsToRect(TargetRect.Left + ((TargetWidth - ScaledWidth) div 2), - TargetRect.Top, ScaledWidth, TargetHeight); - end - else - begin - ScaledHeight := (SourceHeight * TargetWidth) div SourceWidth; - Result := BoundsToRect(TargetRect.Left, TargetRect.Top + ((TargetHeight - ScaledHeight) div 2), - TargetWidth, ScaledHeight); - end; -end; - -function ScaleSizeToFit(const CurrentSize, MaxSize: Types.TSize): Types.TSize; -var - SR, TR, ScaledRect: TRect; -begin - SR := Types.Rect(0, 0, CurrentSize.CX, CurrentSize.CY); - TR := Types.Rect(0, 0, MaxSize.CX, MaxSize.CY); - ScaledRect := ScaleRectToRect(SR, TR); - Result.CX := ScaledRect.Right - ScaledRect.Left; - Result.CY := ScaledRect.Bottom - ScaledRect.Top; -end; - -function RectWidth(const Rect: TRect): Integer; -begin - Result := Rect.Right - Rect.Left; -end; - -function RectHeight(const Rect: TRect): Integer; -begin - Result := Rect.Bottom - Rect.Top; -end; - -function RectInRect(const R1, R2: TRect): Boolean; -begin - Result:= - (R1.Left >= R2.Left) and - (R1.Top >= R2.Top) and - (R1.Right <= R2.Right) and - (R1.Bottom <= R2.Bottom); -end; - -function RectIntersects(const R1, R2: TRect): Boolean; -begin - Result := - not (R1.Left > R2.Right) and - not (R1.Top > R2.Bottom) and - not (R1.Right < R2.Left) and - not (R1.Bottom < R2.Top); -end; - -function PixelSizeToDpi(SizeInMicroMeters: Single): Single; -begin - Result := 25400 / SizeInMicroMeters; -end; - -function DpiToPixelSize(Dpi: Single): Single; -begin - Result := 1e03 / (Dpi / 25.4); -end; - -function FloatRect(ALeft, ATop, ARight, ABottom: Single): TFloatRect; -begin - with Result do - begin - Left := ALeft; - Top := ATop; - Right := ARight; - Bottom := ABottom; - end; -end; - -function FloatRectWidth(const R: TFloatRect): Single; -begin - Result := R.Right - R.Left; -end; - -function FloatRectHeight(const R: TFloatRect): Single; -begin - Result := R.Bottom - R.Top; -end; - -function FormatExceptMsg(const Msg: string; const Args: array of const): string; -begin - Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args); -end; - -procedure DebugMsg(const Msg: string; const Args: array of const); -var - FmtMsg: string; -begin - FmtMsg := Format(Msg, Args); -{$IFDEF MSWINDOWS} - if IsConsole then - WriteLn('DebugMsg: ' + FmtMsg) - else - MessageBox(GetActiveWindow, PChar(FmtMsg), 'DebugMsg', MB_OK); -{$ENDIF} -{$IFDEF UNIX} - WriteLn('DebugMsg: ' + FmtMsg); -{$ENDIF} -{$IFDEF MSDOS} - WriteLn('DebugMsg: ' + FmtMsg); -{$ENDIF} -end; - -initialization - InitCrcTable; -{$IFDEF MSWINDOWS} - QueryPerformanceFrequency(PerfFrequency); - InvPerfFrequency := 1.0 / PerfFrequency; -{$ENDIF} - -{$IF Defined(DELPHI)} - {$IF CompilerVersion >= 23} - FloatFormatSettings := TFormatSettings.Create('en-US'); - {$ELSE} - GetLocaleFormatSettings(1033, FloatFormatSettings); - {$IFEND} -{$ELSE FPC} - FloatFormatSettings := DefaultFormatSettings; - FloatFormatSettings.DecimalSeparator := '.'; -{$IFEND} - -{ - File Notes: - - -- TODOS ---------------------------------------------------- - - nothing now - - -- 0.77.1 ---------------------------------------------------- - - Added GetFileName, GetFileDir, RectWidth, RectHeight function. - - Added ScaleSizeToFit function. - - Added ZeroMemory and SwapValues for Booleans. - - Added Substring function. - - Renamed MatchFileNameMask to StrMaskMatch (it's for general use not - just filenames). - - Delphi XE2 new targets (Win64, OSX32) compatibility changes. - - Added GetFormatSettingsForFloats function. - - -- 0.26.5 Changes/Bug Fixes ----------------------------------- - - Added Log10 function. - - Added TFloatRect type and helper functions FloatRect, FloatRectWidth, - FloatRectHeight. - - Added string function ContainsAnySubStr. - - Added functions PixelSizeToDpi, DpiToPixelSize. - - -- 0.26.1 Changes/Bug Fixes ----------------------------------- - - Some formatting changes. - - Changed some string functions to work with localized strings. - - ASM version of PosEx had bugs, removed it. - - Added StrTokensToList function. - - -- 0.25.0 Changes/Bug Fixes ----------------------------------- - - Fixed error in ClipCopyBounds which was causing ... bad clipping! - - -- 0.24.3 Changes/Bug Fixes ----------------------------------- - - Added GetTimeMilliseconds function. - - Added IntToStrFmt and FloatToStrFmt helper functions. - - -- 0.23 Changes/Bug Fixes ----------------------------------- - - Added RectInRect and RectIntersects functions - - Added some string utils: StrToken, StrTokenEnd, PosEx, PosNoCase. - - Moved BuildFileList here from DemoUtils. - - -- 0.21 Changes/Bug Fixes ----------------------------------- - - Moved GetVolumeLevelCount from ImagingDds here. - - Renamed FillMemory to FillMemoryByte to avoid name collision in C++ Builder. - - Added Iff function for Char, Pointer, and Int64 types. - - Added IsLittleEndian function. - - Added array types for TWordRec, TLongWordRec, and TInt64Rec. - - Added MatchFileNameMask function. - - -- 0.19 Changes/Bug Fixes ----------------------------------- - - added ScaleRectToRect (thanks to Paul Michell) - - added BoundsToRect, ClipBounds, ClipCopyBounds, ClipStretchBounds functions - - added MulDiv function - - FreeAndNil is not inline anymore - caused AV in one program - - -- 0.17 Changes/Bug Fixes ----------------------------------- - - - GetAppExe didn't return absolute path in FreeBSD, fixed - - added debug message output - - fixed Unix compatibility issues (thanks to Ales Katona). - Imaging now compiles in FreeBSD and maybe in other Unixes as well. - - -- 0.15 Changes/Bug Fixes ----------------------------------- - - added some new utility functions - - -- 0.13 Changes/Bug Fixes ----------------------------------- - - added many new utility functions - - minor change in SwapEndian to avoid range check error - -} -end. - - diff --git a/3rd/Imaging/Source/JpegLib/imjcapimin.pas b/3rd/Imaging/Source/JpegLib/imjcapimin.pas deleted file mode 100644 index d8be056f7..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcapimin.pas +++ /dev/null @@ -1,401 +0,0 @@ -unit imjcapimin; -{$N+} -{ This file contains application interface code for the compression half - of the JPEG library. These are the "minimum" API routines that may be - needed in either the normal full-compression case or the transcoding-only - case. - - Most of the routines intended to be called directly by an application - are in this file or in jcapistd.c. But also see jcparam.c for - parameter-setup helper routines, jcomapi.c for routines shared by - compression and decompression, and jctrans.c for the transcoding case. } - -{ jcapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjcomapi, - imjmemmgr, - imjcmarker; - -{ Initialization of JPEG compression objects. - Nomssi: This is a macro in the original code. - - jpeg_create_compress() and jpeg_create_decompress() are the exported - names that applications should call. These expand to calls on - jpeg_CreateCompress and jpeg_CreateDecompress with additional information - passed for version mismatch checking. - NB: you must set up the error-manager BEFORE calling jpeg_create_xxx. } - -procedure jpeg_create_compress(cinfo : j_compress_ptr); - - -{ Initialization of a JPEG compression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateCompress (cinfo : j_compress_ptr; - version : int; - structsize : size_t); - -{ Destruction of a JPEG compression object } - -{GLOBAL} -procedure jpeg_destroy_compress (cinfo : j_compress_ptr); - - -{ Abort processing of a JPEG compression operation, - but don't destroy the object itself. } - -{GLOBAL} -procedure jpeg_abort_compress (cinfo : j_compress_ptr); - - -{ Forcibly suppress or un-suppress all quantization and Huffman tables. - Marks all currently defined tables as already written (if suppress) - or not written (if !suppress). This will control whether they get emitted - by a subsequent jpeg_start_compress call. - - This routine is exported for use by applications that want to produce - abbreviated JPEG datastreams. It logically belongs in jcparam.c, but - since it is called by jpeg_start_compress, we put it here --- otherwise - jcparam.o would be linked whether the application used it or not. } - -{GLOBAL} -procedure jpeg_suppress_tables (cinfo : j_compress_ptr; - suppress : boolean); - - -{ Finish JPEG compression. - - If a multipass operating mode was selected, this may do a great deal of - work including most of the actual output. } - -{GLOBAL} -procedure jpeg_finish_compress (cinfo : j_compress_ptr); - -{ Write a special marker. - This is only recommended for writing COM or APPn markers. - Must be called after jpeg_start_compress() and before - first call to jpeg_write_scanlines() or jpeg_write_raw_data(). } - -{GLOBAL} -procedure jpeg_write_marker (cinfo : j_compress_ptr; - marker : int; - dataptr : JOCTETptr; - datalen : uInt); - -{GLOBAL} -procedure jpeg_write_m_header (cinfo : j_compress_ptr; - marker : int; - datalen : uint); -{GLOBAL} -procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int); - -{ Alternate compression function: just write an abbreviated table file. - Before calling this, all parameters and a data destination must be set up. - - To produce a pair of files containing abbreviated tables and abbreviated - image data, one would proceed as follows: - - initialize JPEG object - set JPEG parameters - set destination to table file - jpeg_write_tables(cinfo); - set destination to image file - jpeg_start_compress(cinfo, FALSE); - write data... - jpeg_finish_compress(cinfo); - - jpeg_write_tables has the side effect of marking all tables written - (same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress - will not re-emit the tables unless it is passed write_all_tables=TRUE. } - - - -{GLOBAL} -procedure jpeg_write_tables (cinfo : j_compress_ptr); - -implementation - -procedure jpeg_create_compress(cinfo : j_compress_ptr); -begin - jpeg_CreateCompress(cinfo, JPEG_LIB_VERSION, - size_t(sizeof(jpeg_compress_struct))); -end; - -{ Initialization of a JPEG compression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateCompress (cinfo : j_compress_ptr; - version : int; - structsize : size_t); -var - i : int; -var - err : jpeg_error_mgr_ptr; - client_data : voidp; -begin - - { Guard against version mismatches between library and caller. } - cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called } - if (version <> JPEG_LIB_VERSION) then - ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version); - if (structsize <> SIZEOF(jpeg_compress_struct)) then - ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE, - int(SIZEOF(jpeg_compress_struct)), int(structsize)); - - { For debugging purposes, we zero the whole master structure. - But the application has already set the err pointer, and may have set - client_data, so we have to save and restore those fields. - Note: if application hasn't set client_data, tools like Purify may - complain here. } - - err := cinfo^.err; - client_data := cinfo^.client_data; { ignore Purify complaint here } - MEMZERO(cinfo, SIZEOF(jpeg_compress_struct)); - cinfo^.err := err; - cinfo^.is_decompressor := FALSE; - - { Initialize a memory manager instance for this object } - jinit_memory_mgr(j_common_ptr(cinfo)); - - { Zero out pointers to permanent structures. } - cinfo^.progress := NIL; - cinfo^.dest := NIL; - - cinfo^.comp_info := NIL; - - for i := 0 to pred(NUM_QUANT_TBLS) do - cinfo^.quant_tbl_ptrs[i] := NIL; - - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - cinfo^.dc_huff_tbl_ptrs[i] := NIL; - cinfo^.ac_huff_tbl_ptrs[i] := NIL; - end; - - cinfo^.script_space := NIL; - - cinfo^.input_gamma := 1.0; { in case application forgets } - - { OK, I'm ready } - cinfo^.global_state := CSTATE_START; -end; - - -{ Destruction of a JPEG compression object } - -{GLOBAL} -procedure jpeg_destroy_compress (cinfo : j_compress_ptr); -begin - jpeg_destroy(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Abort processing of a JPEG compression operation, - but don't destroy the object itself. } - -{GLOBAL} -procedure jpeg_abort_compress (cinfo : j_compress_ptr); -begin - jpeg_abort(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Forcibly suppress or un-suppress all quantization and Huffman tables. - Marks all currently defined tables as already written (if suppress) - or not written (if !suppress). This will control whether they get emitted - by a subsequent jpeg_start_compress call. - - This routine is exported for use by applications that want to produce - abbreviated JPEG datastreams. It logically belongs in jcparam.c, but - since it is called by jpeg_start_compress, we put it here --- otherwise - jcparam.o would be linked whether the application used it or not. } - -{GLOBAL} -procedure jpeg_suppress_tables (cinfo : j_compress_ptr; - suppress : boolean); -var - i : int; - qtbl : JQUANT_TBL_PTR; - htbl : JHUFF_TBL_PTR; -begin - for i := 0 to pred(NUM_QUANT_TBLS) do - begin - qtbl := cinfo^.quant_tbl_ptrs[i]; - if (qtbl <> NIL) then - qtbl^.sent_table := suppress; - end; - - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - htbl := cinfo^.dc_huff_tbl_ptrs[i]; - if (htbl <> NIL) then - htbl^.sent_table := suppress; - htbl := cinfo^.ac_huff_tbl_ptrs[i]; - if (htbl <> NIL) then - htbl^.sent_table := suppress; - end; -end; - - -{ Finish JPEG compression. - - If a multipass operating mode was selected, this may do a great deal of - work including most of the actual output. } - -{GLOBAL} -procedure jpeg_finish_compress (cinfo : j_compress_ptr); -var - iMCU_row : JDIMENSION; -begin - if (cinfo^.global_state = CSTATE_SCANNING) or - (cinfo^.global_state = CSTATE_RAW_OK) then - begin - { Terminate first pass } - if (cinfo^.next_scanline < cinfo^.image_height) then - ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA); - cinfo^.master^.finish_pass (cinfo); - end - else - if (cinfo^.global_state <> CSTATE_WRCOEFS) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - { Perform any remaining passes } - while (not cinfo^.master^.is_last_pass) do - begin - cinfo^.master^.prepare_for_pass (cinfo); - for iMCU_row := 0 to pred(cinfo^.total_iMCU_rows) do - begin - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long (iMCU_row); - cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - { We bypass the main controller and invoke coef controller directly; - all work is being done from the coefficient buffer. } - - if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(NIL))) then - ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); - end; - cinfo^.master^.finish_pass (cinfo); - end; - { Write EOI, do final cleanup } - cinfo^.marker^.write_file_trailer (cinfo); - cinfo^.dest^.term_destination (cinfo); - { We can use jpeg_abort to release memory and reset global_state } - jpeg_abort(j_common_ptr(cinfo)); -end; - - -{ Write a special marker. - This is only recommended for writing COM or APPn markers. - Must be called after jpeg_start_compress() and before - first call to jpeg_write_scanlines() or jpeg_write_raw_data(). } - -{GLOBAL} -procedure jpeg_write_marker (cinfo : j_compress_ptr; - marker : int; - dataptr : JOCTETptr; - datalen : uInt); -var - write_marker_byte : procedure(info : j_compress_ptr; val : int); -begin - if (cinfo^.next_scanline <> 0) or - ((cinfo^.global_state <> CSTATE_SCANNING) and - (cinfo^.global_state <> CSTATE_RAW_OK) and - (cinfo^.global_state <> CSTATE_WRCOEFS)) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - cinfo^.marker^.write_marker_header (cinfo, marker, datalen); - write_marker_byte := cinfo^.marker^.write_marker_byte; { copy for speed } - while (datalen <> 0) do - begin - Dec(datalen); - write_marker_byte (cinfo, dataptr^); - Inc(dataptr); - end; -end; - -{ Same, but piecemeal. } - -{GLOBAL} -procedure jpeg_write_m_header (cinfo : j_compress_ptr; - marker : int; - datalen : uint); -begin - if (cinfo^.next_scanline <> 0) or - ((cinfo^.global_state <> CSTATE_SCANNING) and - (cinfo^.global_state <> CSTATE_RAW_OK) and - (cinfo^.global_state <> CSTATE_WRCOEFS)) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - cinfo^.marker^.write_marker_header (cinfo, marker, datalen); -end; - -{GLOBAL} -procedure jpeg_write_m_byte (cinfo : j_compress_ptr; val : int); -begin - cinfo^.marker^.write_marker_byte (cinfo, val); -end; - - -{ Alternate compression function: just write an abbreviated table file. - Before calling this, all parameters and a data destination must be set up. - - To produce a pair of files containing abbreviated tables and abbreviated - image data, one would proceed as follows: - - initialize JPEG object - set JPEG parameters - set destination to table file - jpeg_write_tables(cinfo); - set destination to image file - jpeg_start_compress(cinfo, FALSE); - write data... - jpeg_finish_compress(cinfo); - - jpeg_write_tables has the side effect of marking all tables written - (same as jpeg_suppress_tables(..., TRUE)). Thus a subsequent start_compress - will not re-emit the tables unless it is passed write_all_tables=TRUE. } - -{GLOBAL} -procedure jpeg_write_tables (cinfo : j_compress_ptr); -begin - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { (Re)initialize error mgr and destination modules } - cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); - cinfo^.dest^.init_destination (cinfo); - { Initialize the marker writer ... bit of a crock to do it here. } - jinit_marker_writer(cinfo); - { Write them tables! } - cinfo^.marker^.write_tables_only (cinfo); - { And clean up. } - cinfo^.dest^.term_destination (cinfo); - - { In library releases up through v6a, we called jpeg_abort() here to free - any working memory allocated by the destination manager and marker - writer. Some applications had a problem with that: they allocated space - of their own from the library memory manager, and didn't want it to go - away during write_tables. So now we do nothing. This will cause a - memory leak if an app calls write_tables repeatedly without doing a full - compression cycle or otherwise resetting the JPEG object. However, that - seems less bad than unexpectedly freeing memory in the normal case. - An app that prefers the old behavior can call jpeg_abort for itself after - each call to jpeg_write_tables(). } -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcapistd.pas b/3rd/Imaging/Source/JpegLib/imjcapistd.pas deleted file mode 100644 index f9ae61392..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcapistd.pas +++ /dev/null @@ -1,222 +0,0 @@ -unit imjcapistd; - -{ Original : jcapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains application interface code for the compression half - of the JPEG library. These are the "standard" API routines that are - used in the normal full-compression case. They are not used by a - transcoding-only application. Note that if an application links in - jpeg_start_compress, it will end up linking in the entire compressor. - We thus must separate this file from jcapimin.c to avoid linking the - whole compression library into a transcoder. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjcapimin, imjcinit; - - - -{ Compression initialization. - Before calling this, all parameters and a data destination must be set up. - - We require a write_all_tables parameter as a failsafe check when writing - multiple datastreams from the same compression object. Since prior runs - will have left all the tables marked sent_table=TRUE, a subsequent run - would emit an abbreviated stream (no tables) by default. This may be what - is wanted, but for safety's sake it should not be the default behavior: - programmers should have to make a deliberate choice to emit abbreviated - images. Therefore the documentation and examples should encourage people - to pass write_all_tables=TRUE; then it will take active thought to do the - wrong thing. } - -{GLOBAL} -procedure jpeg_start_compress (cinfo : j_compress_ptr; - write_all_tables : boolean); - - -{ Write some scanlines of data to the JPEG compressor. - - The return value will be the number of lines actually written. - This should be less than the supplied num_lines only in case that - the data destination module has requested suspension of the compressor, - or if more than image_height scanlines are passed in. - - Note: we warn about excess calls to jpeg_write_scanlines() since - this likely signals an application programmer error. However, - excess scanlines passed in the last valid call are *silently* ignored, - so that the application need not adjust num_lines for end-of-image - when using a multiple-scanline buffer. } - -{GLOBAL} -function jpeg_write_scanlines (cinfo : j_compress_ptr; - scanlines : JSAMPARRAY; - num_lines : JDIMENSION) : JDIMENSION; - -{ Alternate entry point to write raw data. - Processes exactly one iMCU row per call, unless suspended. } - -{GLOBAL} -function jpeg_write_raw_data (cinfo : j_compress_ptr; - data : JSAMPIMAGE; - num_lines : JDIMENSION) : JDIMENSION; - -implementation - -{ Compression initialization. - Before calling this, all parameters and a data destination must be set up. - - We require a write_all_tables parameter as a failsafe check when writing - multiple datastreams from the same compression object. Since prior runs - will have left all the tables marked sent_table=TRUE, a subsequent run - would emit an abbreviated stream (no tables) by default. This may be what - is wanted, but for safety's sake it should not be the default behavior: - programmers should have to make a deliberate choice to emit abbreviated - images. Therefore the documentation and examples should encourage people - to pass write_all_tables=TRUE; then it will take active thought to do the - wrong thing. } - -{GLOBAL} -procedure jpeg_start_compress (cinfo : j_compress_ptr; - write_all_tables : boolean); -begin - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - if (write_all_tables) then - jpeg_suppress_tables(cinfo, FALSE); { mark all tables to be written } - - { (Re)initialize error mgr and destination modules } - cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); - cinfo^.dest^.init_destination (cinfo); - { Perform master selection of active modules } - jinit_compress_master(cinfo); - { Set up for the first pass } - cinfo^.master^.prepare_for_pass (cinfo); - { Ready for application to drive first pass through jpeg_write_scanlines - or jpeg_write_raw_data. } - - cinfo^.next_scanline := 0; - if cinfo^.raw_data_in then - cinfo^.global_state := CSTATE_RAW_OK - else - cinfo^.global_state := CSTATE_SCANNING; -end; - - -{ Write some scanlines of data to the JPEG compressor. - - The return value will be the number of lines actually written. - This should be less than the supplied num_lines only in case that - the data destination module has requested suspension of the compressor, - or if more than image_height scanlines are passed in. - - Note: we warn about excess calls to jpeg_write_scanlines() since - this likely signals an application programmer error. However, - excess scanlines passed in the last valid call are *silently* ignored, - so that the application need not adjust num_lines for end-of-image - when using a multiple-scanline buffer. } - -{GLOBAL} -function jpeg_write_scanlines (cinfo : j_compress_ptr; - scanlines : JSAMPARRAY; - num_lines : JDIMENSION) : JDIMENSION; -var - row_ctr, rows_left : JDIMENSION; -begin - if (cinfo^.global_state <> CSTATE_SCANNING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - if (cinfo^.next_scanline >= cinfo^.image_height) then - WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); - - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long (cinfo^.next_scanline); - cinfo^.progress^.pass_limit := long (cinfo^.image_height); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - - { Give master control module another chance if this is first call to - jpeg_write_scanlines. This lets output of the frame/scan headers be - delayed so that application can write COM, etc, markers between - jpeg_start_compress and jpeg_write_scanlines. } - if (cinfo^.master^.call_pass_startup) then - cinfo^.master^.pass_startup (cinfo); - - { Ignore any extra scanlines at bottom of image. } - rows_left := cinfo^.image_height - cinfo^.next_scanline; - if (num_lines > rows_left) then - num_lines := rows_left; - - row_ctr := 0; - cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, num_lines); - Inc(cinfo^.next_scanline, row_ctr); - jpeg_write_scanlines := row_ctr; -end; - - -{ Alternate entry point to write raw data. - Processes exactly one iMCU row per call, unless suspended. } - -{GLOBAL} -function jpeg_write_raw_data (cinfo : j_compress_ptr; - data : JSAMPIMAGE; - num_lines : JDIMENSION) : JDIMENSION; -var - lines_per_iMCU_row : JDIMENSION; -begin - if (cinfo^.global_state <> CSTATE_RAW_OK) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - if (cinfo^.next_scanline >= cinfo^.image_height) then - begin - WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); - jpeg_write_raw_data := 0; - exit; - end; - - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long(cinfo^.next_scanline); - cinfo^.progress^.pass_limit := long(cinfo^.image_height); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - - { Give master control module another chance if this is first call to - jpeg_write_raw_data. This lets output of the frame/scan headers be - delayed so that application can write COM, etc, markers between - jpeg_start_compress and jpeg_write_raw_data. } - - if (cinfo^.master^.call_pass_startup) then - cinfo^.master^.pass_startup (cinfo); - - { Verify that at least one iMCU row has been passed. } - lines_per_iMCU_row := cinfo^.max_v_samp_factor * DCTSIZE; - if (num_lines < lines_per_iMCU_row) then - ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE); - - { Directly compress the row. } - if (not cinfo^.coef^.compress_data (cinfo, data)) then - begin - { If compressor did not consume the whole row, suspend processing. } - jpeg_write_raw_data := 0; - exit; - end; - - { OK, we processed one iMCU row. } - Inc(cinfo^.next_scanline, lines_per_iMCU_row); - jpeg_write_raw_data := lines_per_iMCU_row; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjccoefct.pas b/3rd/Imaging/Source/JpegLib/imjccoefct.pas deleted file mode 100644 index 7dd97e5e8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjccoefct.pas +++ /dev/null @@ -1,521 +0,0 @@ -unit imjccoefct; - -{ This file contains the coefficient buffer controller for compression. - This controller is the top level of the JPEG compressor proper. - The coefficient buffer lies between forward-DCT and entropy encoding steps.} - -{ Original: jccoefct.c; Copyright (C) 1994-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjerror, - imjdeferr, - imjutils, - imjpeglib; - -{ We use a full-image coefficient buffer when doing Huffman optimization, - and also for writing multiple-scan JPEG files. In all cases, the DCT - step is run during the first pass, and subsequent passes need only read - the buffered coefficients. } -{$ifdef ENTROPY_OPT_SUPPORTED} - {$define FULL_COEF_BUFFER_SUPPORTED} -{$else} - {$ifdef C_MULTISCAN_FILES_SUPPORTED} - {$define FULL_COEF_BUFFER_SUPPORTED} - {$endif} -{$endif} - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_c_coef_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); - -implementation - -{ Private buffer controller object } - -type - my_coef_ptr = ^my_coef_controller; - my_coef_controller = record - pub : jpeg_c_coef_controller; { public fields } - - iMCU_row_num : JDIMENSION; { iMCU row # within image } - mcu_ctr : JDIMENSION; { counts MCUs processed in current row } - MCU_vert_offset : int; { counts MCU rows within iMCU row } - MCU_rows_per_iMCU_row : int; { number of such rows needed } - - { For single-pass compression, it's sufficient to buffer just one MCU - (although this may prove a bit slow in practice). We allocate a - workspace of C_MAX_BLOCKS_IN_MCU coefficient blocks, and reuse it for each - MCU constructed and sent. (On 80x86, the workspace is FAR even though - it's not really very big; this is to keep the module interfaces unchanged - when a large coefficient buffer is necessary.) - In multi-pass modes, this array points to the current MCU's blocks - within the virtual arrays. } - - MCU_buffer : array[0..C_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; - - { In multi-pass modes, we need a virtual block array for each component. } - whole_image : array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; - end; - - -{ Forward declarations } -{METHODDEF} -function compress_data(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{$ifdef FULL_COEF_BUFFER_SUPPORTED} -{METHODDEF} -function compress_first_pass(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{METHODDEF} -function compress_output(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; forward; -{$endif} - - -{LOCAL} -procedure start_iMCU_row (cinfo : j_compress_ptr); -{ Reset within-iMCU-row counters for a new row } -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { In an interleaved scan, an MCU row is the same as an iMCU row. - In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. - But at the bottom of the image, process only what's left. } - if (cinfo^.comps_in_scan > 1) then - begin - coef^.MCU_rows_per_iMCU_row := 1; - end - else - begin - if (coef^.iMCU_row_num < (cinfo^.total_iMCU_rows-1)) then - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor - else - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; - end; - - coef^.mcu_ctr := 0; - coef^.MCU_vert_offset := 0; -end; - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_coef (cinfo : j_compress_ptr; - pass_mode : J_BUF_MODE); -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - coef^.iMCU_row_num := 0; - start_iMCU_row(cinfo); - - case (pass_mode) of - JBUF_PASS_THRU: - begin - if (coef^.whole_image[0] <> NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_data; - end; -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - JBUF_SAVE_AND_PASS: - begin - if (coef^.whole_image[0] = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_first_pass; - end; - JBUF_CRANK_DEST: - begin - if (coef^.whole_image[0] = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - coef^.pub.compress_data := compress_output; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; -end; - - -{ Process some data in the single-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the image. - Returns TRUE if the iMCU row is completed, FALSE if suspended. - - NB: input_buf contains a plane for each component in image, - which we index according to the component's SOF position. } - - -{METHODDEF} -function compress_data (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - last_MCU_col : JDIMENSION; - last_iMCU_row : JDIMENSION; - blkn, bi, ci, yindex, yoffset, blockcnt : int; - ypos, xpos : JDIMENSION; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_MCU_col := cinfo^.MCUs_per_row - 1; - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Loop to write as much as one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.mcu_ctr to last_MCU_col do - begin - { Determine where data comes from in input_buf and do the DCT thing. - Each call on forward_DCT processes a horizontal row of DCT blocks - as wide as an MCU; we rely on having allocated the MCU_buffer[] blocks - sequentially. Dummy blocks at the right or bottom edge are filled in - specially. The data in them does not matter for image reconstruction, - so we fill them with values that will encode to the smallest amount of - data, viz: all zeroes in the AC entries, DC entries equal to previous - block's DC value. (Thanks to Thomas Kinsman for this idea.) } - - blkn := 0; - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - if (MCU_col_num < last_MCU_col) then - blockcnt := compptr^.MCU_width - else - blockcnt := compptr^.last_col_width; - xpos := MCU_col_num * JDIMENSION(compptr^.MCU_sample_width); - ypos := yoffset * DCTSIZE; { ypos = (yoffset+yindex) * DCTSIZE } - for yindex := 0 to pred(compptr^.MCU_height) do - begin - if (coef^.iMCU_row_num < last_iMCU_row) or - (yoffset+yindex < compptr^.last_row_height) then - begin - cinfo^.fdct^.forward_DCT (cinfo, compptr, - input_buf^[compptr^.component_index], - coef^.MCU_buffer[blkn], - ypos, xpos, JDIMENSION (blockcnt)); - - if (blockcnt < compptr^.MCU_width) then - begin - { Create some dummy blocks at the right edge of the image. } - jzero_far({FAR}pointer(coef^.MCU_buffer[blkn + blockcnt]), - (compptr^.MCU_width - blockcnt) * SIZEOF(JBLOCK)); - for bi := blockcnt to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn+bi-1]^[0][0]; - end; - end; - end - else - begin - { Create a row of dummy blocks at the bottom of the image. } - jzero_far({FAR}pointer(coef^.MCU_buffer[blkn]), - compptr^.MCU_width * SIZEOF(JBLOCK)); - for bi := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn+bi]^[0][0] := coef^.MCU_buffer[blkn-1]^[0][0]; - end; - end; - Inc(blkn, compptr^.MCU_width); - Inc(ypos, DCTSIZE); - end; - end; - { Try to write the MCU. In event of a suspension failure, we will - re-DCT the MCU on restart (a bit inefficient, could be fixed...) } - - if (not cinfo^.entropy^.encode_mcu (cinfo, JBLOCKARRAY(@coef^.MCU_buffer)^)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.mcu_ctr := MCU_col_num; - compress_data := FALSE; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.mcu_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(coef^.iMCU_row_num); - start_iMCU_row(cinfo); - compress_data := TRUE; -end; - - -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - -{ Process some data in the first pass of a multi-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the image. - This amount of data is read from the source buffer, DCT'd and quantized, - and saved into the virtual arrays. We also generate suitable dummy blocks - as needed at the right and lower edges. (The dummy blocks are constructed - in the virtual arrays, which have been padded appropriately.) This makes - it possible for subsequent passes not to worry about real vs. dummy blocks. - - We must also emit the data to the entropy encoder. This is conveniently - done by calling compress_output() after we've loaded the current strip - of the virtual arrays. - - NB: input_buf contains a plane for each component in image. All - components are DCT'd and loaded into the virtual arrays in this pass. - However, it may be that only a subset of the components are emitted to - the entropy encoder during this first pass; be careful about looking - at the scan-dependent variables (MCU dimensions, etc). } - -{METHODDEF} -function compress_first_pass (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - blocks_across, MCUs_across, MCUindex : JDIMENSION; - bi, ci, h_samp_factor, block_row, block_rows, ndummy : int; - lastDC : JCOEF; - compptr : jpeg_component_info_ptr; - buffer : JBLOCKARRAY; - thisblockrow, lastblockrow : JBLOCKROW; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Align the virtual buffer for this component. } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr(cinfo), coef^.whole_image[ci], - coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), - JDIMENSION (compptr^.v_samp_factor), TRUE); - { Count non-dummy DCT block rows in this iMCU row. } - if (coef^.iMCU_row_num < last_iMCU_row) then - block_rows := compptr^.v_samp_factor - else - begin - { NB: can't use last_row_height here, since may not be set! } - block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - end; - blocks_across := compptr^.width_in_blocks; - h_samp_factor := compptr^.h_samp_factor; - { Count number of dummy blocks to be added at the right margin. } - ndummy := int (blocks_across) mod h_samp_factor; - if (ndummy > 0) then - ndummy := h_samp_factor - ndummy; - { Perform DCT for all non-dummy blocks in this iMCU row. Each call - on forward_DCT processes a complete horizontal row of DCT blocks. } - - for block_row := 0 to pred(block_rows) do - begin - thisblockrow := buffer^[block_row]; - cinfo^.fdct^.forward_DCT (cinfo, compptr, - input_buf^[ci], - thisblockrow, - JDIMENSION (block_row * DCTSIZE), - JDIMENSION (0), - blocks_across); - if (ndummy > 0) then - begin - { Create dummy blocks at the right edge of the image. } - Inc(JBLOCK_PTR(thisblockrow), blocks_across); { => first dummy block } - jzero_far({FAR}pointer(thisblockrow), ndummy * SIZEOF(JBLOCK)); - {lastDC := thisblockrow^[-1][0];} - { work around Range Checking } - Dec(JBLOCK_PTR(thisblockrow)); - lastDC := thisblockrow^[0][0]; - Inc(JBLOCK_PTR(thisblockrow)); - - for bi := 0 to pred(ndummy) do - begin - thisblockrow^[bi][0] := lastDC; - end; - end; - end; - { If at end of image, create dummy block rows as needed. - The tricky part here is that within each MCU, we want the DC values - of the dummy blocks to match the last real block's DC value. - This squeezes a few more bytes out of the resulting file... } - - if (coef^.iMCU_row_num = last_iMCU_row) then - begin - Inc(blocks_across, ndummy); { include lower right corner } - MCUs_across := blocks_across div JDIMENSION(h_samp_factor); - for block_row := block_rows to pred(compptr^.v_samp_factor) do - begin - thisblockrow := buffer^[block_row]; - lastblockrow := buffer^[block_row-1]; - jzero_far({FAR} pointer(thisblockrow), - size_t(blocks_across * SIZEOF(JBLOCK))); - for MCUindex := 0 to pred(MCUs_across) do - begin - lastDC := lastblockrow^[h_samp_factor-1][0]; - for bi := 0 to pred(h_samp_factor) do - begin - thisblockrow^[bi][0] := lastDC; - end; - Inc(JBLOCK_PTR(thisblockrow), h_samp_factor); { advance to next MCU in row } - Inc(JBLOCK_PTR(lastblockrow), h_samp_factor); - end; - end; - end; - Inc(compptr); - end; - { NB: compress_output will increment iMCU_row_num if successful. - A suspension return will result in redoing all the work above next time.} - - - { Emit data to the entropy encoder, sharing code with subsequent passes } - compress_first_pass := compress_output(cinfo, input_buf); -end; - - -{ Process some data in subsequent passes of a multi-pass case. - We process the equivalent of one fully interleaved MCU row ("iMCU" row) - per call, ie, v_samp_factor block rows for each component in the scan. - The data is obtained from the virtual arrays and fed to the entropy coder. - Returns TRUE if the iMCU row is completed, FALSE if suspended. - - NB: input_buf is ignored; it is likely to be a NIL pointer. } - -{METHODDEF} -function compress_output (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - blkn, ci, xindex, yindex, yoffset : int; - start_col : JDIMENSION; - buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { Align the virtual buffers for the components used in this scan. - NB: during first pass, this is safe only because the buffers will - already be aligned properly, so jmemmgr.c won't need to do any I/O. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - buffer[ci] := cinfo^.mem^.access_virt_barray ( - j_common_ptr(cinfo), coef^.whole_image[compptr^.component_index], - coef^.iMCU_row_num * JDIMENSION(compptr^.v_samp_factor), - JDIMENSION (compptr^.v_samp_factor), FALSE); - end; - - { Loop to process one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.mcu_ctr to pred(cinfo^.MCUs_per_row) do - begin - { Construct list of pointers to DCT blocks belonging to this MCU } - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - start_col := MCU_col_num * JDIMENSION(compptr^.MCU_width); - for yindex := 0 to pred(compptr^.MCU_height) do - begin - buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); - for xindex := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn] := buffer_ptr; - Inc(blkn); - Inc(JBLOCK_PTR(buffer_ptr)); - end; - end; - end; - { Try to write the MCU. } - if (not cinfo^.entropy^.encode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.mcu_ctr := MCU_col_num; - compress_output := FALSE; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.mcu_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(coef^.iMCU_row_num); - start_iMCU_row(cinfo); - compress_output := TRUE; -end; - -{$endif} { FULL_COEF_BUFFER_SUPPORTED } - - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_c_coef_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); -var - coef : my_coef_ptr; -var - buffer : JBLOCKROW; - i : int; -var - ci : int; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_coef_controller)) ); - cinfo^.coef := jpeg_c_coef_controller_ptr(coef); - coef^.pub.start_pass := start_pass_coef; - - { Create the coefficient buffer. } - if (need_full_buffer) then - begin -{$ifdef FULL_COEF_BUFFER_SUPPORTED} - { Allocate a full-image virtual array for each component, } - { padded to a multiple of samp_factor DCT blocks in each direction. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray - (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, - JDIMENSION (jround_up( long (compptr^.width_in_blocks), - long (compptr^.h_samp_factor) )), - JDIMENSION (jround_up(long (compptr^.height_in_blocks), - long (compptr^.v_samp_factor))), - JDIMENSION (compptr^.v_samp_factor)); - Inc(compptr); - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); -{$endif} - end - else - begin - { We only need a single-MCU buffer. } - buffer := JBLOCKROW ( - cinfo^.mem^.alloc_large (j_common_ptr(cinfo), JPOOL_IMAGE, - C_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); - for i := 0 to pred(C_MAX_BLOCKS_IN_MCU) do - begin - coef^.MCU_buffer[i] := JBLOCKROW(@ buffer^[i]); - end; - coef^.whole_image[0] := NIL; { flag for no virtual arrays } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjccolor.pas b/3rd/Imaging/Source/JpegLib/imjccolor.pas deleted file mode 100644 index 0e8e16a8b..000000000 --- a/3rd/Imaging/Source/JpegLib/imjccolor.pas +++ /dev/null @@ -1,530 +0,0 @@ -unit imjccolor; - -{ This file contains input colorspace conversion routines. } - -{ Original : jccolor.c ; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib; - -{ Module initialization routine for input colorspace conversion. } - -{GLOBAL} -procedure jinit_color_converter (cinfo : j_compress_ptr); - -implementation - -{ Private subobject } -type - INT32_FIELD = array[0..MaxInt div SizeOf(INT32) - 1] of INT32; - INT32_FIELD_PTR = ^INT32_FIELD; - -type - my_cconvert_ptr = ^my_color_converter; - my_color_converter = record - pub : jpeg_color_converter; { public fields } - - { Private state for RGB -> YCC conversion } - rgb_ycc_tab : INT32_FIELD_PTR; { => table for RGB to YCbCr conversion } - end; {my_color_converter;} - - -{*************** RGB -> YCbCr conversion: most common case *************} - -{ - YCbCr is defined per CCIR 601-1, except that Cb and Cr are - normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. - The conversion equations to be implemented are therefore - Y = 0.29900 * R + 0.58700 * G + 0.11400 * B - Cb = -0.16874 * R - 0.33126 * G + 0.50000 * B + CENTERJSAMPLE - Cr = 0.50000 * R - 0.41869 * G - 0.08131 * B + CENTERJSAMPLE - (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) - Note: older versions of the IJG code used a zero offset of MAXJSAMPLE/2, - rather than CENTERJSAMPLE, for Cb and Cr. This gave equal positive and - negative swings for Cb/Cr, but meant that grayscale values (Cb=Cr=0) - were not represented exactly. Now we sacrifice exact representation of - maximum red and maximum blue in order to get exact grayscales. - - To avoid floating-point arithmetic, we represent the fractional constants - as integers scaled up by 2^16 (about 4 digits precision); we have to divide - the products by 2^16, with appropriate rounding, to get the correct answer. - - For even more speed, we avoid doing any multiplications in the inner loop - by precalculating the constants times R,G,B for all possible values. - For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); - for 12-bit samples it is still acceptable. It's not very reasonable for - 16-bit samples, but if you want lossless storage you shouldn't be changing - colorspace anyway. - The CENTERJSAMPLE offsets and the rounding fudge-factor of 0.5 are included - in the tables to save adding them separately in the inner loop. } -const - SCALEBITS = 16; { speediest right-shift on some machines } - CBCR_OFFSET = INT32(CENTERJSAMPLE shl SCALEBITS); - ONE_HALF = INT32(1) shl (SCALEBITS-1); - - -{ We allocate one big table and divide it up into eight parts, instead of - doing eight alloc_small requests. This lets us use a single table base - address, which can be held in a register in the inner loops on many - machines (more than can hold all eight addresses, anyway). } - - R_Y_OFF = 0; { offset to R => Y section } - G_Y_OFF = 1*(MAXJSAMPLE+1); { offset to G => Y section } - B_Y_OFF = 2*(MAXJSAMPLE+1); { etc. } - R_CB_OFF = 3*(MAXJSAMPLE+1); - G_CB_OFF = 4*(MAXJSAMPLE+1); - B_CB_OFF = 5*(MAXJSAMPLE+1); - R_CR_OFF = B_CB_OFF; { B=>Cb, R=>Cr are the same } - G_CR_OFF = 6*(MAXJSAMPLE+1); - B_CR_OFF = 7*(MAXJSAMPLE+1); - TABLE_SIZE = 8*(MAXJSAMPLE+1); - - -{ Initialize for RGB->YCC colorspace conversion. } - -{METHODDEF} -procedure rgb_ycc_start (cinfo : j_compress_ptr); -const - FIX_0_29900 = INT32(Round(0.29900 * (1 shl SCALEBITS))); - FIX_0_58700 = INT32(Round(0.58700 * (1 shl SCALEBITS))); - FIX_0_11400 = INT32(Round(0.11400 * (1 shl SCALEBITS))); - FIX_0_16874 = INT32(Round(0.16874 * (1 shl SCALEBITS))); - FIX_0_33126 = INT32(Round(0.33126 * (1 shl SCALEBITS))); - FIX_0_50000 = INT32(Round(0.50000 * (1 shl SCALEBITS))); - FIX_0_41869 = INT32(Round(0.41869 * (1 shl SCALEBITS))); - FIX_0_08131 = INT32(Round(0.08131 * (1 shl SCALEBITS))); -var - cconvert : my_cconvert_ptr; - rgb_ycc_tab : INT32_FIELD_PTR; - i : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - - { Allocate and fill in the conversion tables. } - rgb_ycc_tab := INT32_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - (TABLE_SIZE * SIZEOF(INT32))) ); - cconvert^.rgb_ycc_tab := rgb_ycc_tab; - - for i := 0 to MAXJSAMPLE do - begin - rgb_ycc_tab^[i+R_Y_OFF] := FIX_0_29900 * i; - rgb_ycc_tab^[i+G_Y_OFF] := FIX_0_58700 * i; - rgb_ycc_tab^[i+B_Y_OFF] := FIX_0_11400 * i + ONE_HALF; - rgb_ycc_tab^[i+R_CB_OFF] := (-FIX_0_16874) * i; - rgb_ycc_tab^[i+G_CB_OFF] := (-FIX_0_33126) * i; - { We use a rounding fudge-factor of 0.5-epsilon for Cb and Cr. - This ensures that the maximum output will round to MAXJSAMPLE - not MAXJSAMPLE+1, and thus that we don't have to range-limit. } - - rgb_ycc_tab^[i+B_CB_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; -{ B=>Cb and R=>Cr tables are the same - rgb_ycc_tab^[i+R_CR_OFF] := FIX_0_50000 * i + CBCR_OFFSET + ONE_HALF-1; -} - rgb_ycc_tab^[i+G_CR_OFF] := (-FIX_0_41869) * i; - rgb_ycc_tab^[i+B_CR_OFF] := (-FIX_0_08131) * i; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - - Note that we change from the application's interleaved-pixel format - to our internal noninterleaved, one-plane-per-component format. - The input buffer is therefore three times as wide as the output buffer. - - A starting row offset is provided only for the output buffer. The caller - can easily adjust the passed input_buf value to accommodate any row - offset required on that side. } - -{METHODDEF} -procedure rgb_ycc_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab : INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr0, outptr1, outptr2 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr0 := output_buf^[0]^[output_row]; - outptr1 := output_buf^[1]^[output_row]; - outptr2 := output_buf^[2]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - r := GETJSAMPLE(inptr^[RGB_RED]); - g := GETJSAMPLE(inptr^[RGB_GREEN]); - b := GETJSAMPLE(inptr^[RGB_BLUE]); - Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); - { If the inputs are 0..MAXJSAMPLE, the outputs of these equations - must be too; we do not need an explicit range-limiting operation. - Hence the value being shifted is never negative, and we don't - need the general RIGHT_SHIFT macro. } - - { Y } - outptr0^[col] := JSAMPLE( - ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) - shr SCALEBITS) ); - { Cb } - outptr1^[col] := JSAMPLE( - ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) - shr SCALEBITS) ); - { Cr } - outptr2^[col] := JSAMPLE( - ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) - shr SCALEBITS) ); - end; - end; -end; - - -{*************** Cases other than RGB -> YCbCr *************} - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles RGB -> grayscale conversion, which is the same - as the RGB -> Y portion of RGB -> YCbCr. - We assume rgb_ycc_start has been called (we only use the Y tables). } - -{METHODDEF} -procedure rgb_gray_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab :INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr := output_buf[0][output_row]; - Inc(output_row); - for col := 0 to num_cols - 1 do - begin - r := GETJSAMPLE(inptr[RGB_RED]); - g := GETJSAMPLE(inptr[RGB_GREEN]); - b := GETJSAMPLE(inptr[RGB_BLUE]); - Inc(JSAMPLE_PTR(inptr), RGB_PIXELSIZE); - (* Y *) - // kylix 3 compiler crashes on this - // it also crashes Delphi OSX compiler 9 years later :( - {$IF not (Defined(DCC) and not Defined(MSWINDOWS))} - outptr[col] := JSAMPLE(((ctab[r+R_Y_OFF] + ctab[g+G_Y_OFF] + ctab[b+B_Y_OFF]) shr SCALEBITS)); - {$IFEND} - end; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles Adobe-style CMYK -> YCCK conversion, - where we convert R=1-C, G=1-M, and B=1-Y to YCbCr using the same - conversion as above, while passing K (black) unchanged. - We assume rgb_ycc_start has been called. } - -{METHODDEF} -procedure cmyk_ycck_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} r, g, b : int; - {register} ctab : INT32_FIELD_PTR; - {register} inptr : JSAMPROW; - {register} outptr0, outptr1, outptr2, outptr3 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - ctab := cconvert^.rgb_ycc_tab; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr0 := output_buf^[0]^[output_row]; - outptr1 := output_buf^[1]^[output_row]; - outptr2 := output_buf^[2]^[output_row]; - outptr3 := output_buf^[3]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - r := MAXJSAMPLE - GETJSAMPLE(inptr^[0]); - g := MAXJSAMPLE - GETJSAMPLE(inptr^[1]); - b := MAXJSAMPLE - GETJSAMPLE(inptr^[2]); - { K passes through as-is } - outptr3^[col] := inptr^[3]; { don't need GETJSAMPLE here } - Inc(JSAMPLE_PTR(inptr), 4); - { If the inputs are 0..MAXJSAMPLE, the outputs of these equations - must be too; we do not need an explicit range-limiting operation. - Hence the value being shifted is never negative, and we don't - need the general RIGHT_SHIFT macro. } - - { Y } - outptr0^[col] := JSAMPLE ( - ((ctab^[r+R_Y_OFF] + ctab^[g+G_Y_OFF] + ctab^[b+B_Y_OFF]) - shr SCALEBITS) ); - { Cb } - outptr1^[col] := JSAMPLE( - ((ctab^[r+R_CB_OFF] + ctab^[g+G_CB_OFF] + ctab^[b+B_CB_OFF]) - shr SCALEBITS) ); - { Cr } - outptr2^[col] := JSAMPLE ( - ((ctab^[r+R_CR_OFF] + ctab^[g+G_CR_OFF] + ctab^[b+B_CR_OFF]) - shr SCALEBITS) ); - end; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles grayscale output with no conversion. - The source can be either plain grayscale or YCbCr (since Y = gray). } - -{METHODDEF} -procedure grayscale_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows: int); -var - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - num_cols :JDIMENSION; - instride : int; -begin - num_cols := cinfo^.image_width; - instride := cinfo^.input_components; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr := input_buf^[0]; - Inc(JSAMPROW_PTR(input_buf)); - outptr := output_buf^[0]^[output_row]; - Inc(output_row); - for col := 0 to pred(num_cols) do - begin - outptr^[col] := inptr^[0]; { don't need GETJSAMPLE() here } - Inc(JSAMPLE_PTR(inptr), instride); - end; - end; -end; - - -{ Convert some rows of samples to the JPEG colorspace. - This version handles multi-component colorspaces without conversion. - We assume input_components = num_components. } - -{METHODDEF} -procedure null_convert (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); -var - {register} inptr : JSAMPROW; - {register} outptr : JSAMPROW; - {register} col : JDIMENSION; - {register} ci : int; - nc : int; - num_cols : JDIMENSION; -begin - nc := cinfo^.num_components; - num_cols := cinfo^.image_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - { It seems fastest to make a separate pass for each component. } - for ci := 0 to pred(nc) do - begin - inptr := input_buf^[0]; - outptr := output_buf^[ci]^[output_row]; - for col := 0 to pred(num_cols) do - begin - outptr^[col] := inptr^[ci]; { don't need GETJSAMPLE() here } - Inc(JSAMPLE_PTR(inptr), nc); - end; - end; - Inc(JSAMPROW_PTR(input_buf)); - Inc(output_row); - end; -end; - - -{ Empty method for start_pass. } - -{METHODDEF} -procedure null_method (cinfo : j_compress_ptr); -begin - { no work needed } -end; - - -{ Module initialization routine for input colorspace conversion. } - -{GLOBAL} -procedure jinit_color_converter (cinfo : j_compress_ptr); -var - cconvert : my_cconvert_ptr; -begin - cconvert := my_cconvert_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_color_converter)) ); - cinfo^.cconvert := jpeg_color_converter_ptr(cconvert); - { set start_pass to null method until we find out differently } - cconvert^.pub.start_pass := null_method; - - { Make sure input_components agrees with in_color_space } - case (cinfo^.in_color_space) of - JCS_GRAYSCALE: - if (cinfo^.input_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - -{$ifdef RGB_PIXELSIZE <> 3} - JCS_RGB: - if (cinfo^.input_components <> RGB_PIXELSIZE) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); -{$else} { share code with YCbCr } - JCS_RGB, -{$endif} - JCS_YCbCr: - if (cinfo^.input_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - - JCS_CMYK, - JCS_YCCK: - if (cinfo^.input_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - - else { JCS_UNKNOWN can be anything } - if (cinfo^.input_components < 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - end; - - { Check num_components, set conversion method based on requested space } - case (cinfo^.jpeg_color_space) of - JCS_GRAYSCALE: - begin - if (cinfo^.num_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_GRAYSCALE) then - cconvert^.pub.color_convert := grayscale_convert - else - if (cinfo^.in_color_space = JCS_RGB) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := rgb_gray_convert; - end - else - if (cinfo^.in_color_space = JCS_YCbCr) then - cconvert^.pub.color_convert := grayscale_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_RGB: - begin - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_YCbCr: - begin - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_RGB) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := rgb_ycc_convert; - end - else - if (cinfo^.in_color_space = JCS_YCbCr) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_CMYK: - begin - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_CMYK) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_YCCK: - begin - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - if (cinfo^.in_color_space = JCS_CMYK) then - begin - cconvert^.pub.start_pass := rgb_ycc_start; - cconvert^.pub.color_convert := cmyk_ycck_convert; - end - else - if (cinfo^.in_color_space = JCS_YCCK) then - cconvert^.pub.color_convert := null_convert - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - else { allow null conversion of JCS_UNKNOWN } - begin - if (cinfo^.jpeg_color_space <> cinfo^.in_color_space) or - (cinfo^.num_components <> cinfo^.input_components) then - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - cconvert^.pub.color_convert := null_convert; - end; - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcdctmgr.pas b/3rd/Imaging/Source/JpegLib/imjcdctmgr.pas deleted file mode 100644 index 29c1dda99..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcdctmgr.pas +++ /dev/null @@ -1,514 +0,0 @@ -unit imjcdctmgr; - -{ Original : jcdctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains the forward-DCT management logic. - This code selects a particular DCT implementation to be used, - and it performs related housekeeping chores including coefficient - quantization. } - -interface - -{$N+} -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjdct, { Private declarations for DCT subsystem } - imjfdctint, imjfdctfst, imjfdctflt; - -{ Initialize FDCT manager. } - -{GLOBAL} -procedure jinit_forward_dct (cinfo : j_compress_ptr); - -implementation - - -{ Private subobject for this module } - -type - my_fdct_ptr = ^my_fdct_controller; - my_fdct_controller = record - pub : jpeg_forward_dct; { public fields } - - { Pointer to the DCT routine actually in use } - do_dct : forward_DCT_method_ptr; - - { The actual post-DCT divisors --- not identical to the quant table - entries, because of scaling (especially for an unnormalized DCT). - Each table is given in normal array order. } - - divisors : array[0..NUM_QUANT_TBLS-1] of DCTELEM_FIELD_PTR; - - {$ifdef DCT_FLOAT_SUPPORTED} - { Same as above for the floating-point case. } - do_float_dct : float_DCT_method_ptr; - float_divisors : array[0..NUM_QUANT_TBLS-1] of FAST_FLOAT_FIELD_PTR; - {$endif} - end; - - -{ Initialize for a processing pass. - Verify that all referenced Q-tables are present, and set up - the divisor table for each one. - In the current implementation, DCT of all components is done during - the first pass, even if only some components will be output in the - first scan. Hence all components should be examined here. } - -{METHODDEF} -procedure start_pass_fdctmgr (cinfo : j_compress_ptr); -var - fdct : my_fdct_ptr; - ci, qtblno, i : int; - compptr : jpeg_component_info_ptr; - qtbl : JQUANT_TBL_PTR; - dtbl : DCTELEM_FIELD_PTR; -{$ifdef DCT_IFAST_SUPPORTED} -const - CONST_BITS = 14; - aanscales : array[0..DCTSIZE2-1] of INT16 = - ({ precomputed values scaled up by 14 bits } - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270, - 21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906, - 19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315, - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552, - 8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446, - 4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247); - {SHIFT_TEMPS} - - { Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - - function DESCALE(x : INT32; n : int) : INT32; - var - shift_temp : INT32; - begin - shift_temp := x + (INT32(1) shl (n-1)); - {$ifdef RIGHT_SHIFT_IS_UNSIGNED} - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - {$endif} - Descale := (shift_temp shr n); - end; - -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} -var - fdtbl : FAST_FLOAT_FIELD_PTR; - row, col : int; -const - aanscalefactor : array[0..DCTSIZE-1] of double = - (1.0, 1.387039845, 1.306562965, 1.175875602, - 1.0, 0.785694958, 0.541196100, 0.275899379); -{$endif} -begin - fdct := my_fdct_ptr (cinfo^.fdct); - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - qtblno := compptr^.quant_tbl_no; - { Make sure specified quantization table is present } - if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or - (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno); - qtbl := cinfo^.quant_tbl_ptrs[qtblno]; - { Compute divisors for this quant table } - { We may do this more than once for same table, but it's not a big deal } - case (cinfo^.dct_method) of -{$ifdef DCT_ISLOW_SUPPORTED} - JDCT_ISLOW: - begin - { For LL&M IDCT method, divisors are equal to raw quantization - coefficients multiplied by 8 (to counteract scaling). } - - if (fdct^.divisors[qtblno] = NIL) then - begin - fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(DCTELEM)) ); - end; - dtbl := fdct^.divisors[qtblno]; - for i := 0 to pred(DCTSIZE2) do - begin - dtbl^[i] := (DCTELEM(qtbl^.quantval[i])) shl 3; - end; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - { For AA&N IDCT method, divisors are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 - We apply a further scale factor of 8. } - - - if (fdct^.divisors[qtblno] = NIL) then - begin - fdct^.divisors[qtblno] := DCTELEM_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(DCTELEM)) ); - end; - dtbl := fdct^.divisors[qtblno]; - for i := 0 to pred(DCTSIZE2) do - begin - dtbl^[i] := DCTELEM( - {MULTIPLY16V16} - DESCALE( INT32(qtbl^.quantval[i]) * INT32 (aanscales[i]), - CONST_BITS-3) ); - end; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - - JDCT_FLOAT: - begin - { For float AA&N IDCT method, divisors are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 - We apply a further scale factor of 8. - What's actually stored is 1/divisor so that the inner loop can - use a multiplication rather than a division. } - - if (fdct^.float_divisors[qtblno] = NIL) then - begin - fdct^.float_divisors[qtblno] := FAST_FLOAT_FIELD_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - DCTSIZE2 * SIZEOF(FAST_FLOAT)) ); - end; - fdtbl := fdct^.float_divisors[qtblno]; - i := 0; - for row := 0 to pred(DCTSIZE) do - begin - for col := 0 to pred(DCTSIZE) do - begin - fdtbl^[i] := {FAST_FLOAT} - (1.0 / (( {double}(qtbl^.quantval[i]) * - aanscalefactor[row] * aanscalefactor[col] * 8.0))); - Inc(i); - end; - end; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - Inc(compptr); - end; -end; - - -{ Perform forward DCT on one or more blocks of a component. - - The input samples are taken from the sample_data[] array starting at - position start_row/start_col, and moving to the right for any additional - blocks. The quantized coefficients are returned in coef_blocks[]. } - -{METHODDEF} -procedure forward_DCT (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); -{ This version is used for integer DCT implementations. } -var - { This routine is heavily used, so it's worth coding it tightly. } - fdct : my_fdct_ptr; - do_dct : forward_DCT_method_ptr; - divisors : DCTELEM_FIELD_PTR; - workspace : array[0..DCTSIZE2-1] of DCTELEM; { work area for FDCT subroutine } - bi : JDIMENSION; -var - {register} workspaceptr : DCTELEMPTR; - {register} elemptr : JSAMPLE_PTR; - {register} elemr : int; -{$ifndef DCTSIZE_IS_8} -var - {register} elemc : int; -{$endif} -var - {register} temp, qval : DCTELEM; - {register} i : int; - {register} output_ptr : JCOEFPTR; -begin - fdct := my_fdct_ptr (cinfo^.fdct); - do_dct := fdct^.do_dct; - divisors := fdct^.divisors[compptr^.quant_tbl_no]; - - Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } - - for bi := 0 to pred(num_blocks) do - begin - - { Load data into workspace, applying unsigned->signed conversion } - - workspaceptr := @workspace[0]; - for elemr := 0 to pred(DCTSIZE) do - begin - elemptr := @sample_data^[elemr]^[start_col]; -{$ifdef DCTSIZE_IS_8} { unroll the inner loop } - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - {Inc(elemptr); - Value never used } -{$else} - for elemc := pred(DCTSIZE) downto 0 do - begin - workspaceptr^ := GETJSAMPLE(elemptr^) - CENTERJSAMPLE; - Inc(workspaceptr); - Inc(elemptr); - end; -{$endif} - end; - - { Perform the DCT } - do_dct (workspace); - - { Quantize/descale the coefficients, and store into coef_blocks[] } - - output_ptr := JCOEFPTR(@coef_blocks^[bi]); - for i := 0 to pred(DCTSIZE2) do - begin - qval := divisors^[i]; - temp := workspace[i]; - { Divide the coefficient value by qval, ensuring proper rounding. - Since C does not specify the direction of rounding for negative - quotients, we have to force the dividend positive for portability. - - In most files, at least half of the output values will be zero - (at default quantization settings, more like three-quarters...) - so we should ensure that this case is fast. On many machines, - a comparison is enough cheaper than a divide to make a special test - a win. Since both inputs will be nonnegative, we need only test - for a < b to discover whether a/b is 0. - If your machine's division is fast enough, define FAST_DIVIDE. } - - if (temp < 0) then - begin - temp := -temp; - Inc(temp, qval shr 1); { for rounding } - {DIVIDE_BY(temp, qval);} - {$ifdef FAST_DIVIDE} - temp := temp div qval; - {$else} - if (temp >= qval) then - temp := temp div qval - else - temp := 0; - {$endif} - temp := -temp; - end - else - begin - Inc(temp, qval shr 1); { for rounding } - {DIVIDE_BY(temp, qval);} - {$ifdef FAST_DIVIDE} - temp := temp div qval; - {$else} - if (temp >= qval) then - temp := temp div qval - else - temp := 0; - {$endif} - end; - output_ptr^[i] := JCOEF (temp); - end; - Inc(start_col, DCTSIZE); - end; -end; - - -{$ifdef DCT_FLOAT_SUPPORTED} - -{METHODDEF} -procedure forward_DCT_float (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); -{ This version is used for floating-point DCT implementations. } -var - { This routine is heavily used, so it's worth coding it tightly. } - fdct : my_fdct_ptr; - do_dct : float_DCT_method_ptr; - divisors : FAST_FLOAT_FIELD_PTR; - workspace : array[0..DCTSIZE2-1] of FAST_FLOAT; { work area for FDCT subroutine } - bi : JDIMENSION; -var - {register} workspaceptr : FAST_FLOAT_PTR; - {register} elemptr : JSAMPLE_PTR; - {register} elemr : int; -{$ifndef DCTSIZE_IS_8} -var - {register} elemc : int; -{$endif} -var - {register} temp : FAST_FLOAT; - {register} i : int; - {register} output_ptr : JCOEFPTR; -begin - fdct := my_fdct_ptr (cinfo^.fdct); - do_dct := fdct^.do_float_dct; - divisors := fdct^.float_divisors[compptr^.quant_tbl_no]; - - Inc(JSAMPROW_PTR(sample_data), start_row); { fold in the vertical offset once } - - for bi := 0 to pred(num_blocks) do - begin - { Load data into workspace, applying unsigned->signed conversion } - - workspaceptr := @workspace[0]; - for elemr := 0 to pred(DCTSIZE) do - begin - elemptr := @(sample_data^[elemr]^[start_col]); -{$ifdef DCTSIZE_IS_8} { unroll the inner loop } - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - Inc(elemptr); - workspaceptr^ := {FAST_FLOAT}(GETJSAMPLE(elemptr^) - CENTERJSAMPLE); - Inc(workspaceptr); - {Inc(elemptr); - value never used } -{$else} - for elemc := pred(DCTSIZE) downto 0 do - begin - workspaceptr^ := {FAST_FLOAT}( - (GETJSAMPLE(elemptr^) - CENTERJSAMPLE) ); - Inc(workspaceptr); - Inc(elemptr); - end; -{$endif} - end; - - - { Perform the DCT } - do_dct (workspace); - - { Quantize/descale the coefficients, and store into coef_blocks[] } - - output_ptr := JCOEFPTR(@(coef_blocks^[bi])); - - for i := 0 to pred(DCTSIZE2) do - begin - { Apply the quantization and scaling factor } - temp := workspace[i] * divisors^[i]; - { Round to nearest integer. - Since C does not specify the direction of rounding for negative - quotients, we have to force the dividend positive for portability. - The maximum coefficient size is +-16K (for 12-bit data), so this - code should work for either 16-bit or 32-bit ints. } - output_ptr^[i] := JCOEF ( int(Trunc (temp + {FAST_FLOAT}(16384.5))) - 16384); - end; - Inc(start_col, DCTSIZE); - end; -end; - -{$endif} { DCT_FLOAT_SUPPORTED } - - -{ Initialize FDCT manager. } - -{GLOBAL} -procedure jinit_forward_dct (cinfo : j_compress_ptr); -var - fdct : my_fdct_ptr; - i : int; -begin - fdct := my_fdct_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_fdct_controller)) ); - cinfo^.fdct := jpeg_forward_dct_ptr (fdct); - fdct^.pub.start_pass := start_pass_fdctmgr; - - case (cinfo^.dct_method) of -{$ifdef DCT_ISLOW_SUPPORTED} - JDCT_ISLOW: - begin - fdct^.pub.forward_DCT := forward_DCT; - fdct^.do_dct := jpeg_fdct_islow; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - fdct^.pub.forward_DCT := forward_DCT; - fdct^.do_dct := jpeg_fdct_ifast; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - JDCT_FLOAT: - begin - fdct^.pub.forward_DCT := forward_DCT_float; - fdct^.do_float_dct := jpeg_fdct_float; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - - { Mark divisor tables unallocated } - for i := 0 to pred(NUM_QUANT_TBLS) do - begin - fdct^.divisors[i] := NIL; -{$ifdef DCT_FLOAT_SUPPORTED} - fdct^.float_divisors[i] := NIL; -{$endif} - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjchuff.pas b/3rd/Imaging/Source/JpegLib/imjchuff.pas deleted file mode 100644 index ff004a416..000000000 --- a/3rd/Imaging/Source/JpegLib/imjchuff.pas +++ /dev/null @@ -1,1116 +0,0 @@ -unit imjchuff; - -{ This file contains Huffman entropy encoding routines. - - Much of the complexity here has to do with supporting output suspension. - If the data destination module demands suspension, we want to be able to - back up to the start of the current MCU. To do this, we copy state - variables into local working storage, and update them back to the - permanent JPEG objects only upon successful completion of an MCU. } - -{ Original: jchuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, { longptr definition missing } - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjinclude, - imjcomapi; - -{ The legal range of a DCT coefficient is - -1024 .. +1023 for 8-bit data; - -16384 .. +16383 for 12-bit data. - Hence the magnitude should always fit in 10 or 14 bits respectively. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - MAX_COEF_BITS = 10; -{$else} -const - MAX_COEF_BITS = 14; -{$endif} - -{ Derived data constructed for each Huffman table } -{ Declarations shared with jcphuff.c } -type - c_derived_tbl_ptr = ^c_derived_tbl; - c_derived_tbl = record - ehufco : array[0..256-1] of uInt; { code for each symbol } - ehufsi : array[0..256-1] of byte; { length of code for each symbol } - { If no code has been allocated for a symbol S, ehufsi[S] contains 0 } - end; -{ for JCHUFF und JCPHUFF } -type - TLongTable = array[0..256] of long; - TLongTablePtr = ^TLongTable; - -{ Compute the derived values for a Huffman table. - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : c_derived_tbl_ptr); - -{ Generate the optimal coding for the given counts, fill htbl. - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; - htbl : JHUFF_TBL_PTR; - var freq : TLongTable); { Nomssi } - -{ Module initialization routine for Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_huff_encoder (cinfo : j_compress_ptr); - -implementation - -{ Expanded entropy encoder object for Huffman encoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - put_buffer : INT32; { current bit-accumulation buffer } - put_bits : int; { # of bits now in it } - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - end; - - -type - huff_entropy_ptr = ^huff_entropy_encoder; - huff_entropy_encoder = record - pub : jpeg_entropy_encoder; { public fields } - - saved : savable_state; { Bit buffer & DC state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - next_restart_num : int; { next restart number to write (0-7) } - - { Pointers to derived tables (these workspaces have image lifespan) } - dc_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - ac_derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - - {$ifdef ENTROPY_OPT_SUPPORTED} { Statistics tables for optimization } - dc_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - ac_count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - {$endif} - end; - - - -{ Working state while writing an MCU. - This struct contains all the fields that are needed by subroutines. } - -type - working_state = record - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - cur : savable_state; { Current bit buffer & DC state } - cinfo : j_compress_ptr; { dump_buffer needs access to this } - end; - - -{ Forward declarations } -{METHODDEF} -function encode_mcu_huff (cinfo : j_compress_ptr; - const MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -procedure finish_pass_huff (cinfo : j_compress_ptr); forward; -{$ifdef ENTROPY_OPT_SUPPORTED} -{METHODDEF} -function encode_mcu_gather (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; - -{METHODDEF} -procedure finish_pass_gather (cinfo : j_compress_ptr); forward; -{$endif} - - -{ Initialize for a Huffman-compressed scan. - If gather_statistics is TRUE, we do not output anything during the scan, - just count the Huffman symbols used and generate Huffman code tables. } - -{METHODDEF} -procedure start_pass_huff (cinfo : j_compress_ptr; - gather_statistics : boolean); -var - entropy : huff_entropy_ptr; - ci, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - if (gather_statistics) then - begin -{$ifdef ENTROPY_OPT_SUPPORTED} - entropy^.pub.encode_mcu := encode_mcu_gather; - entropy^.pub.finish_pass := finish_pass_gather; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - entropy^.pub.encode_mcu := encode_mcu_huff; - entropy^.pub.finish_pass := finish_pass_huff; - end; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - if (gather_statistics) then - begin -{$ifdef ENTROPY_OPT_SUPPORTED} - { Check for invalid table indexes } - { (make_c_derived_tbl does this in the other path) } - if (dctbl < 0) or (dctbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, dctbl); - if (actbl < 0) or (actbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, actbl); - { Allocate and zero the statistics tables } - { Note that jpeg_gen_optimal_table expects 257 entries in each table! } - if (entropy^.dc_count_ptrs[dctbl] = NIL) then - entropy^.dc_count_ptrs[dctbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.dc_count_ptrs[dctbl], 257 * SIZEOF(long)); - if (entropy^.ac_count_ptrs[actbl] = NIL) then - entropy^.ac_count_ptrs[actbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.ac_count_ptrs[actbl], 257 * SIZEOF(long)); -{$endif} - end - else - begin - { Compute derived values for Huffman tables } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_c_derived_tbl(cinfo, TRUE, dctbl, - entropy^.dc_derived_tbls[dctbl]); - jpeg_make_c_derived_tbl(cinfo, FALSE, actbl, - entropy^.ac_derived_tbls[actbl]); - end; - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Initialize bit buffer to empty } - entropy^.saved.put_buffer := 0; - entropy^.saved.put_bits := 0; - - { Initialize restart stuff } - entropy^.restarts_to_go := cinfo^.restart_interval; - entropy^.next_restart_num := 0; -end; - - -{ Compute the derived values for a Huffman table. - This routine also performs some validation checks on the table. - - Note this is also used by jcphuff.c. } - -{GLOBAL} -procedure jpeg_make_c_derived_tbl (cinfo : j_compress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : c_derived_tbl_ptr); -var - htbl : JHUFF_TBL_PTR; - dtbl : c_derived_tbl_ptr; - p, i, l, lastp, si, maxsymbol : int; - huffsize : array[0..257-1] of byte; - huffcode : array[0..257-1] of uInt; - code : uInt; -begin - { Note that huffsize[] and huffcode[] are filled in code-length order, - paralleling the order of the symbols themselves in htbl->huffval[]. } - - { Find the input Huffman table } - if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - if isDC then - htbl := cinfo^.dc_huff_tbl_ptrs[tblno] - else - htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - - { Allocate a workspace if we haven't already done so. } - if (pdtbl = NIL) then - pdtbl := c_derived_tbl_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(c_derived_tbl)) ); - dtbl := pdtbl; - - { Figure C.1: make table of Huffman code length for each symbol } - - p := 0; - for l := 1 to 16 do - begin - i := int(htbl^.bits[l]); - if (i < 0) and (p + i > 256) then { protect against table overrun } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - while (i > 0) do - begin - huffsize[p] := byte(l); - Inc(p); - Dec(i); - end; - end; - huffsize[p] := 0; - lastp := p; - - { Figure C.2: generate the codes themselves } - { We also validate that the counts represent a legal Huffman code tree. } - - code := 0; - si := huffsize[0]; - p := 0; - while (huffsize[p] <> 0) do - begin - while (( int(huffsize[p]) ) = si) do - begin - huffcode[p] := code; - Inc(p); - Inc(code); - end; - { code is now 1 more than the last code used for codelength si; but - it must still fit in si bits, since no code is allowed to be all ones. } - - if (INT32(code) >= (INT32(1) shl si)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - code := code shl 1; - Inc(si); - end; - - { Figure C.3: generate encoding tables } - { These are code and size indexed by symbol value } - - { Set all codeless symbols to have code length 0; - this lets us detect duplicate VAL entries here, and later - allows emit_bits to detect any attempt to emit such symbols. } - - MEMZERO(@dtbl^.ehufsi, SIZEOF(dtbl^.ehufsi)); - - { This is also a convenient place to check for out-of-range - and duplicated VAL entries. We allow 0..255 for AC symbols - but only 0..15 for DC. (We could constrain them further - based on data depth and mode, but this seems enough.) } - - if isDC then - maxsymbol := 15 - else - maxsymbol := 255; - - for p := 0 to pred(lastp) do - begin - i := htbl^.huffval[p]; - if (i < 0) or (i > maxsymbol) or (dtbl^.ehufsi[i] <> 0) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - dtbl^.ehufco[i] := huffcode[p]; - dtbl^.ehufsi[i] := huffsize[p]; - end; -end; - - -{ Outputting bytes to the file } - - -{LOCAL} -function dump_buffer (var state : working_state) : boolean; -{ Empty the output buffer; return TRUE if successful, FALSE if must suspend } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := state.cinfo^.dest; - - if (not dest^.empty_output_buffer (state.cinfo)) then - begin - dump_buffer := FALSE; - exit; - end; - { After a successful buffer dump, must reset buffer pointers } - state.next_output_byte := dest^.next_output_byte; - state.free_in_buffer := dest^.free_in_buffer; - dump_buffer := TRUE; -end; - - -{ Outputting bits to the file } - -{ Only the right 24 bits of put_buffer are used; the valid bits are - left-justified in this part. At most 16 bits can be passed to emit_bits - in one call, and we never retain more than 7 bits in put_buffer - between calls, so 24 bits are sufficient. } - - -{LOCAL} -function emit_bits (var state : working_state; - code : uInt; - size : int) : boolean; {INLINE} -{ Emit some bits; return TRUE if successful, FALSE if must suspend } -var - { This routine is heavily used, so it's worth coding tightly. } - {register} put_buffer : INT32; - {register} put_bits : int; -var - c : int; -begin - put_buffer := INT32 (code); - put_bits := state.cur.put_bits; - - { if size is 0, caller used an invalid Huffman table entry } - if (size = 0) then - ERREXIT(j_common_ptr(state.cinfo), JERR_HUFF_MISSING_CODE); - - put_buffer := put_buffer and pred(INT32(1) shl size); - { mask off any extra bits in code } - - Inc(put_bits, size); { new number of bits in buffer } - - put_buffer := put_buffer shl (24 - put_bits); - { align incoming bits } - put_buffer := put_buffer or state.cur.put_buffer; - { and merge with old buffer contents } - while (put_bits >= 8) do - begin - c := int ((put_buffer shr 16) and $FF); - - {emit_byte(state, c, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET (c); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_bits := FALSE; - exit; - end; - - if (c = $FF) then { need to stuff a zero byte? } - begin - {emit_byte(state, 0, return FALSE);} - state.next_output_byte^ := JOCTET (0); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_bits := FALSE; - exit; - end; - - end; - put_buffer := put_buffer shl 8; - Dec(put_bits, 8); - end; - - state.cur.put_buffer := put_buffer; { update state variables } - state.cur.put_bits := put_bits; - - emit_bits := TRUE; -end; - - -{LOCAL} -function flush_bits (var state : working_state) : boolean; -begin - if (not emit_bits(state, $7F, 7)) then { fill any partial byte with ones } - begin - flush_bits := FALSE; - exit; - end; - state.cur.put_buffer := 0; { and reset bit-buffer to empty } - state.cur.put_bits := 0; - flush_bits := TRUE; -end; - - -{ Encode a single block's worth of coefficients } - -{LOCAL} -function encode_one_block (var state : working_state; - const block : JBLOCK; - last_dc_val : int; - dctbl : c_derived_tbl_ptr; - actbl : c_derived_tbl_ptr) : boolean; -var - {register} temp, temp2 : int; - {register} nbits : int; - {register} k, r, i : int; -begin - { Encode the DC coefficient difference per section F.1.2.1 } - - temp2 := block[0] - last_dc_val; - temp := temp2; - - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { For a negative input, want temp2 := bitwise complement of abs(input) } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); - - { Emit the Huffman-coded symbol for the number of bits } - if not emit_bits(state, dctbl^.ehufco[nbits], dctbl^.ehufsi[nbits]) then - begin - encode_one_block := FALSE; - exit; - end; - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if (nbits <> 0) then { emit_bits rejects calls with size 0 } - if not emit_bits(state, uInt(temp2), nbits) then - begin - encode_one_block := FALSE; - exit; - end; - - { Encode the AC coefficients per section F.1.2.2 } - - r := 0; { r := run length of zeros } - - for k := 1 to pred(DCTSIZE2) do - begin - temp := block[jpeg_natural_order[k]]; - if (temp = 0) then - begin - Inc(r); - end - else - begin - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - if not emit_bits(state, actbl^.ehufco[$F0], actbl^.ehufsi[$F0]) then - begin - encode_one_block := FALSE; - exit; - end; - Dec(r, 16); - end; - - temp2 := temp; - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - { Check for out-of-range coefficient values } - if (nbits > MAX_COEF_BITS) then - ERREXIT(j_common_ptr(state.cinfo), JERR_BAD_DCT_COEF); - - { Emit Huffman symbol for run length / number of bits } - i := (r shl 4) + nbits; - if not emit_bits(state, actbl^.ehufco[i], actbl^.ehufsi[i]) then - begin - encode_one_block := FALSE; - exit; - end; - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if not emit_bits(state, uInt(temp2), nbits) then - begin - encode_one_block := FALSE; - exit; - end; - - r := 0; - end; - end; - - { If the last coef(s) were zero, emit an end-of-block code } - if (r > 0) then - if not emit_bits(state, actbl^.ehufco[0], actbl^.ehufsi[0]) then - begin - encode_one_block := FALSE; - exit; - end; - - encode_one_block := TRUE; -end; - - -{ Emit a restart marker & resynchronize predictions. } - -{LOCAL} -function emit_restart (var state : working_state; - restart_num : int) : boolean; -var - ci : int; -begin - if (not flush_bits(state)) then - begin - emit_restart := FALSE; - exit; - end; - - {emit_byte(state, $FF, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET ($FF); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_restart := FALSE; - exit; - end; - - {emit_byte(state, JPEG_RST0 + restart_num, return FALSE);} - { Emit a byte, return FALSE if must suspend. } - state.next_output_byte^ := JOCTET (JPEG_RST0 + restart_num); - Inc(state.next_output_byte); - Dec(state.free_in_buffer); - if (state.free_in_buffer = 0) then - if not dump_buffer(state) then - begin - emit_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(state.cinfo^.comps_in_scan) do - state.cur.last_dc_val[ci] := 0; - - { The restart counter is not updated until we successfully write the MCU. } - - emit_restart := TRUE; -end; - - -{ Encode and output one MCU's worth of Huffman-compressed coefficients. } - -{METHODDEF} -function encode_mcu_huff (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : huff_entropy_ptr; - state : working_state; - blkn, ci : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - { Load up working state } - state.next_output_byte := cinfo^.dest^.next_output_byte; - state.free_in_buffer := cinfo^.dest^.free_in_buffer; - {ASSIGN_STATE(state.cur, entropy^.saved);} - state.cur := entropy^.saved; - state.cinfo := cinfo; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if not emit_restart(state, entropy^.next_restart_num) then - begin - encode_mcu_huff := FALSE; - exit; - end; - end; - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - if not encode_one_block(state, - MCU_data[blkn]^[0], - state.cur.last_dc_val[ci], - entropy^.dc_derived_tbls[compptr^.dc_tbl_no], - entropy^.ac_derived_tbls[compptr^.ac_tbl_no]) then - begin - encode_mcu_huff := FALSE; - exit; - end; - { Update last_dc_val } - state.cur.last_dc_val[ci] := MCU_data[blkn]^[0][0]; - end; - - { Completed MCU, so update state } - cinfo^.dest^.next_output_byte := state.next_output_byte; - cinfo^.dest^.free_in_buffer := state.free_in_buffer; - {ASSIGN_STATE(entropy^.saved, state.cur);} - entropy^.saved := state.cur; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_huff := TRUE; -end; - - -{ Finish up at the end of a Huffman-compressed scan. } - -{METHODDEF} -procedure finish_pass_huff (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - state : working_state; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Load up working state ... flush_bits needs it } - state.next_output_byte := cinfo^.dest^.next_output_byte; - state.free_in_buffer := cinfo^.dest^.free_in_buffer; - {ASSIGN_STATE(state.cur, entropy^.saved);} - state.cur := entropy^.saved; - state.cinfo := cinfo; - - { Flush out the last data } - if not flush_bits(state) then - ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); - - { Update state } - cinfo^.dest^.next_output_byte := state.next_output_byte; - cinfo^.dest^.free_in_buffer := state.free_in_buffer; - {ASSIGN_STATE(entropy^.saved, state.cur);} - entropy^.saved := state.cur; -end; - - -{ Huffman coding optimization. - - We first scan the supplied data and count the number of uses of each symbol - that is to be Huffman-coded. (This process MUST agree with the code above.) - Then we build a Huffman coding tree for the observed counts. - Symbols which are not needed at all for the particular image are not - assigned any code, which saves space in the DHT marker as well as in - the compressed data. } - -{$ifdef ENTROPY_OPT_SUPPORTED} - - -{ Process a single block's worth of coefficients } - -{LOCAL} -procedure htest_one_block (cinfo : j_compress_ptr; - const block : JBLOCK; - last_dc_val : int; - dc_counts : TLongTablePtr; - ac_counts : TLongTablePtr); - -var - {register} temp : int; - {register} nbits : int; - {register} k, r : int; -begin - { Encode the DC coefficient difference per section F.1.2.1 } - temp := block[0] - last_dc_val; - if (temp < 0) then - temp := -temp; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count the Huffman symbol for the number of bits } - Inc(dc_counts^[nbits]); - - { Encode the AC coefficients per section F.1.2.2 } - - r := 0; { r := run length of zeros } - - for k := 1 to pred(DCTSIZE2) do - begin - temp := block[jpeg_natural_order[k]]; - if (temp = 0) then - begin - Inc(r); - end - else - begin - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - Inc(ac_counts^[$F0]); - Dec(r, 16); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - if (temp < 0) then - temp := -temp; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - - { Count Huffman symbol for run length / number of bits } - Inc(ac_counts^[(r shl 4) + nbits]); - - r := 0; - end; - end; - - { If the last coef(s) were zero, emit an end-of-block code } - if (r > 0) then - Inc(ac_counts^[0]); -end; - - -{ Trial-encode one MCU's worth of Huffman-compressed coefficients. - No data is actually output, so no suspension return is possible. } - -{METHODDEF} -function encode_mcu_gather (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : huff_entropy_ptr; - blkn, ci : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - { Take care of restart intervals if needed } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - { Update restart state } - entropy^.restarts_to_go := cinfo^.restart_interval; - end; - Dec(entropy^.restarts_to_go); - end; - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - htest_one_block(cinfo, MCU_data[blkn]^[0], - entropy^.saved.last_dc_val[ci], - entropy^.dc_count_ptrs[compptr^.dc_tbl_no], - entropy^.ac_count_ptrs[compptr^.ac_tbl_no]); - entropy^.saved.last_dc_val[ci] := MCU_data[blkn]^[0][0]; - end; - - encode_mcu_gather := TRUE; -end; - - -{ Generate the best Huffman code table for the given counts, fill htbl. - Note this is also used by jcphuff.c. - - The JPEG standard requires that no symbol be assigned a codeword of all - one bits (so that padding bits added at the end of a compressed segment - can't look like a valid code). Because of the canonical ordering of - codewords, this just means that there must be an unused slot in the - longest codeword length category. Section K.2 of the JPEG spec suggests - reserving such a slot by pretending that symbol 256 is a valid symbol - with count 1. In theory that's not optimal; giving it count zero but - including it in the symbol set anyway should give a better Huffman code. - But the theoretically better code actually seems to come out worse in - practice, because it produces more all-ones bytes (which incur stuffed - zero bytes in the final file). In any case the difference is tiny. - - The JPEG standard requires Huffman codes to be no more than 16 bits long. - If some symbols have a very small but nonzero probability, the Huffman tree - must be adjusted to meet the code length restriction. We currently use - the adjustment method suggested in JPEG section K.2. This method is *not* - optimal; it may not choose the best possible limited-length code. But - typically only very-low-frequency symbols will be given less-than-optimal - lengths, so the code is almost optimal. Experimental comparisons against - an optimal limited-length-code algorithm indicate that the difference is - microscopic --- usually less than a hundredth of a percent of total size. - So the extra complexity of an optimal algorithm doesn't seem worthwhile. } - - -{GLOBAL} -procedure jpeg_gen_optimal_table (cinfo : j_compress_ptr; - htbl : JHUFF_TBL_PTR; - var freq : TLongTable); -const - MAX_CLEN = 32; { assumed maximum initial code length } -var - bits : array[0..MAX_CLEN+1-1] of UINT8; { bits[k] := # of symbols with code length k } - codesize : array[0..257-1] of int; { codesize[k] := code length of symbol k } - others : array[0..257-1] of int; { next symbol in current branch of tree } - c1, c2 : int; - p, i, j : int; - v : long; -begin - { This algorithm is explained in section K.2 of the JPEG standard } - - MEMZERO(@bits, SIZEOF(bits)); - MEMZERO(@codesize, SIZEOF(codesize)); - for i := 0 to 256 do - others[i] := -1; { init links to empty } - - freq[256] := 1; { make sure 256 has a nonzero count } - { Including the pseudo-symbol 256 in the Huffman procedure guarantees - that no real symbol is given code-value of all ones, because 256 - will be placed last in the largest codeword category. } - - { Huffman's basic algorithm to assign optimal code lengths to symbols } - - while TRUE do - begin - { Find the smallest nonzero frequency, set c1 := its symbol } - { In case of ties, take the larger symbol number } - c1 := -1; - v := long(1000000000); - for i := 0 to 256 do - begin - if (freq[i] <> 0) and (freq[i] <= v) then - begin - v := freq[i]; - c1 := i; - end; - end; - - { Find the next smallest nonzero frequency, set c2 := its symbol } - { In case of ties, take the larger symbol number } - c2 := -1; - v := long(1000000000); - for i := 0 to 256 do - begin - if (freq[i] <> 0) and (freq[i] <= v) and (i <> c1) then - begin - v := freq[i]; - c2 := i; - end; - end; - - { Done if we've merged everything into one frequency } - if (c2 < 0) then - break; - - { Else merge the two counts/trees } - Inc(freq[c1], freq[c2]); - freq[c2] := 0; - - { Increment the codesize of everything in c1's tree branch } - Inc(codesize[c1]); - while (others[c1] >= 0) do - begin - c1 := others[c1]; - Inc(codesize[c1]); - end; - - others[c1] := c2; { chain c2 onto c1's tree branch } - - { Increment the codesize of everything in c2's tree branch } - Inc(codesize[c2]); - while (others[c2] >= 0) do - begin - c2 := others[c2]; - Inc(codesize[c2]); - end; - end; - - { Now count the number of symbols of each code length } - for i := 0 to 256 do - begin - if (codesize[i]<>0) then - begin - { The JPEG standard seems to think that this can't happen, } - { but I'm paranoid... } - if (codesize[i] > MAX_CLEN) then - ERREXIT(j_common_ptr(cinfo), JERR_HUFF_CLEN_OVERFLOW); - - Inc(bits[codesize[i]]); - end; - end; - - { JPEG doesn't allow symbols with code lengths over 16 bits, so if the pure - Huffman procedure assigned any such lengths, we must adjust the coding. - Here is what the JPEG spec says about how this next bit works: - Since symbols are paired for the longest Huffman code, the symbols are - removed from this length category two at a time. The prefix for the pair - (which is one bit shorter) is allocated to one of the pair; then, - skipping the BITS entry for that prefix length, a code word from the next - shortest nonzero BITS entry is converted into a prefix for two code words - one bit longer. } - - for i := MAX_CLEN downto 17 do - begin - while (bits[i] > 0) do - begin - j := i - 2; { find length of new prefix to be used } - while (bits[j] = 0) do - Dec(j); - - Dec(bits[i], 2); { remove two symbols } - Inc(bits[i-1]); { one goes in this length } - Inc(bits[j+1], 2); { two new symbols in this length } - Dec(bits[j]); { symbol of this length is now a prefix } - end; - end; - - { Delphi 2: FOR-loop variable 'i' may be undefined after loop } - i := 16; { Nomssi: work around } - - { Remove the count for the pseudo-symbol 256 from the largest codelength } - while (bits[i] = 0) do { find largest codelength still in use } - Dec(i); - Dec(bits[i]); - - { Return final symbol counts (only for lengths 0..16) } - MEMCOPY(@htbl^.bits, @bits, SIZEOF(htbl^.bits)); - - { Return a list of the symbols sorted by code length } - { It's not real clear to me why we don't need to consider the codelength - changes made above, but the JPEG spec seems to think this works. } - - p := 0; - for i := 1 to MAX_CLEN do - begin - for j := 0 to 255 do - begin - if (codesize[j] = i) then - begin - htbl^.huffval[p] := UINT8 (j); - Inc(p); - end; - end; - end; - - { Set sent_table FALSE so updated table will be written to JPEG file. } - htbl^.sent_table := FALSE; -end; - - -{ Finish up a statistics-gathering pass and create the new Huffman tables. } - -{METHODDEF} -procedure finish_pass_gather (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - ci, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; - htblptr : ^JHUFF_TBL_PTR; - did_dc : array[0..NUM_HUFF_TBLS-1] of boolean; - did_ac : array[0..NUM_HUFF_TBLS-1] of boolean; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { It's important not to apply jpeg_gen_optimal_table more than once - per table, because it clobbers the input frequency counts! } - - MEMZERO(@did_dc, SIZEOF(did_dc)); - MEMZERO(@did_ac, SIZEOF(did_ac)); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - if (not did_dc[dctbl]) then - begin - htblptr := @(cinfo^.dc_huff_tbl_ptrs[dctbl]); - if ( htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.dc_count_ptrs[dctbl]^); - did_dc[dctbl] := TRUE; - end; - if (not did_ac[actbl]) then - begin - htblptr := @(cinfo^.ac_huff_tbl_ptrs[actbl]); - if ( htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.ac_count_ptrs[actbl]^); - did_ac[actbl] := TRUE; - end; - end; -end; - -{$endif} { ENTROPY_OPT_SUPPORTED } - - -{ Module initialization routine for Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_huff_encoder (cinfo : j_compress_ptr); -var - entropy : huff_entropy_ptr; - i : int; -begin - entropy := huff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(huff_entropy_encoder)) ); - cinfo^.entropy := jpeg_entropy_encoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_huff; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.ac_derived_tbls[i] := NIL; - entropy^.dc_derived_tbls[i] := NIL; -{$ifdef ENTROPY_OPT_SUPPORTED} - entropy^.ac_count_ptrs[i] := NIL; - entropy^.dc_count_ptrs[i] := NIL; -{$endif} - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcinit.pas b/3rd/Imaging/Source/JpegLib/imjcinit.pas deleted file mode 100644 index 2a844e6b8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcinit.pas +++ /dev/null @@ -1,95 +0,0 @@ -unit imjcinit; - -{ Original: jcinit.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -{ This file contains initialization logic for the JPEG compressor. - This routine is in charge of selecting the modules to be executed and - making an initialization call to each one. - - Logically, this code belongs in jcmaster.c. It's split out because - linking this routine implies linking the entire compression library. - For a transcoding-only application, we want to be able to use jcmaster.c - without linking in the whole library. } - -interface - -{$I imjconfig.inc} - -uses - imjinclude, - imjdeferr, - imjerror, - imjpeglib, -{$ifdef C_PROGRESSIVE_SUPPORTED} - imjcphuff, -{$endif} - imjchuff, imjcmaster, imjccolor, imjcsample, imjcprepct, - imjcdctmgr, imjccoefct, imjcmainct, imjcmarker; - -{ Master selection of compression modules. - This is done once at the start of processing an image. We determine - which modules will be used and give them appropriate initialization calls. } - -{GLOBAL} -procedure jinit_compress_master (cinfo : j_compress_ptr); - -implementation - - - -{ Master selection of compression modules. - This is done once at the start of processing an image. We determine - which modules will be used and give them appropriate initialization calls. } - -{GLOBAL} -procedure jinit_compress_master (cinfo : j_compress_ptr); -begin - { Initialize master control (includes parameter checking/processing) } - jinit_c_master_control(cinfo, FALSE { full compression }); - - { Preprocessing } - if (not cinfo^.raw_data_in) then - begin - jinit_color_converter(cinfo); - jinit_downsampler(cinfo); - jinit_c_prep_controller(cinfo, FALSE { never need full buffer here }); - end; - { Forward DCT } - jinit_forward_dct(cinfo); - { Entropy encoding: either Huffman or arithmetic coding. } - if (cinfo^.arith_code) then - begin - ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL); - end - else - begin - if (cinfo^.progressive_mode) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - jinit_phuff_encoder(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - jinit_huff_encoder(cinfo); - end; - - { Need a full-image coefficient buffer in any multi-pass mode. } - jinit_c_coef_controller(cinfo, - (cinfo^.num_scans > 1) or (cinfo^.optimize_coding)); - jinit_c_main_controller(cinfo, FALSE { never need full buffer here }); - - jinit_marker_writer(cinfo); - - { We can now tell the memory manager to allocate virtual arrays. } - cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo)); - - { Write the datastream header (SOI) immediately. - Frame and scan headers are postponed till later. - This lets application insert special markers after the SOI. } - - cinfo^.marker^.write_file_header (cinfo); -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcmainct.pas b/3rd/Imaging/Source/JpegLib/imjcmainct.pas deleted file mode 100644 index 196fad413..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcmainct.pas +++ /dev/null @@ -1,343 +0,0 @@ -unit imjcmainct; - -{ This file contains the main buffer controller for compression. - The main buffer lies between the pre-processor and the JPEG - compressor proper; it holds downsampled data in the JPEG colorspace. } - -{ Original : jcmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -{ Note: currently, there is no operating mode in which a full-image buffer - is needed at this step. If there were, that mode could not be used with - "raw data" input, since this module is bypassed in that case. However, - we've left the code here for possible use in special applications. } - -{$undef FULL_MAIN_BUFFER_SUPPORTED} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - imjutils, -{$endif} - imjpeglib; - -{ Initialize main buffer controller. } - -{GLOBAL} -procedure jinit_c_main_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); - -implementation - - -{ Private buffer controller object } - -type - my_main_ptr = ^my_main_controller; - my_main_controller = record - pub : jpeg_c_main_controller; { public fields } - - cur_iMCU_row : JDIMENSION; { number of current iMCU row } - rowgroup_ctr : JDIMENSION; { counts row groups received in iMCU row } - suspended : boolean; { remember if we suspended output } - pass_mode : J_BUF_MODE; { current operating mode } - - { If using just a strip buffer, this points to the entire set of buffers - (we allocate one for each component). In the full-image case, this - points to the currently accessible strips of the virtual arrays. } - - buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - {$ifdef FULL_MAIN_BUFFER_SUPPORTED} - { If using full-image storage, this array holds pointers to virtual-array - control blocks for each component. Unused if not full-image storage. } - - whole_image : array[0..MAX_COMPONENTS-1] of jvirt_sarray_ptr; - {$endif} - end; {my_main_controller} - - -{ Forward declarations } -{METHODDEF} -procedure process_data_simple_main(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr: JDIMENSION; - in_rows_avail : JDIMENSION); forward; - -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} -{METHODDEF} -procedure process_data_buffer_main(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION); forward; -{$endif} - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_main (cinfo : j_compress_ptr; - pass_mode : J_BUF_MODE); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - { Do nothing in raw-data mode. } - if (cinfo^.raw_data_in) then - exit; - - main^.cur_iMCU_row := 0; { initialize counters } - main^.rowgroup_ctr := 0; - main^.suspended := FALSE; - main^.pass_mode := pass_mode; { save mode for use by process_data } - - case (pass_mode) of - JBUF_PASS_THRU: - begin -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - if (main^.whole_image[0] <> NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); -{$endif} - main^.pub.process_data := process_data_simple_main; - end; -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - JBUF_SAVE_SOURCE, - JBUF_CRANK_DEST, - JBUF_SAVE_AND_PASS: - begin - if (main^.whole_image[0] = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - main^.pub.process_data := process_data_buffer_main; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; -end; - - -{ Process some data. - This routine handles the simple pass-through mode, - where we have only a strip buffer. } - -{METHODDEF} -procedure process_data_simple_main (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do - begin - { Read input data if we haven't filled the main buffer yet } - if (main^.rowgroup_ctr < DCTSIZE) then - cinfo^.prep^.pre_process_data (cinfo, - input_buf, - in_row_ctr, - in_rows_avail, - JSAMPIMAGE(@main^.buffer), - main^.rowgroup_ctr, - JDIMENSION(DCTSIZE)); - - { If we don't have a full iMCU row buffered, return to application for - more data. Note that preprocessor will always pad to fill the iMCU row - at the bottom of the image. } - if (main^.rowgroup_ctr <> DCTSIZE) then - exit; - - { Send the completed row to the compressor } - if (not cinfo^.coef^.compress_data (cinfo, JSAMPIMAGE(@main^.buffer))) then - begin - { If compressor did not consume the whole row, then we must need to - suspend processing and return to the application. In this situation - we pretend we didn't yet consume the last input row; otherwise, if - it happened to be the last row of the image, the application would - think we were done. } - - if (not main^.suspended) then - begin - Dec(in_row_ctr); - main^.suspended := TRUE; - end; - exit; - end; - { We did finish the row. Undo our little suspension hack if a previous - call suspended; then mark the main buffer empty. } - - if (main^.suspended) then - begin - Inc(in_row_ctr); - main^.suspended := FALSE; - end; - main^.rowgroup_ctr := 0; - Inc(main^.cur_iMCU_row); - end; -end; - - -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - -{ Process some data. - This routine handles all of the modes that use a full-size buffer. } - -{METHODDEF} -procedure process_data_buffer_main (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION); -var - main : my_main_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - writing : boolean; -begin - main := my_main_ptr (cinfo^.main); - writing := (main^.pass_mode <> JBUF_CRANK_DEST); - - while (main^.cur_iMCU_row < cinfo^.total_iMCU_rows) do - begin - { Realign the virtual buffers if at the start of an iMCU row. } - if (main^.rowgroup_ctr = 0) then - begin - compptr := cinfo^.comp_info; - for ci := 0 to pred(cinfo^.num_components) do - begin - main^.buffer[ci] := cinfo^.mem^.access_virt_sarray - (j_common_ptr (cinfo), main^.whole_image[ci], - main^.cur_iMCU_row * (compptr^.v_samp_factor * DCTSIZE), - JDIMENSION (compptr^.v_samp_factor * DCTSIZE), writing); - Inc(compptr); - end; - { In a read pass, pretend we just read some source data. } - if (not writing) then - begin - Inc(in_row_ctr, cinfo^.max_v_samp_factor * DCTSIZE); - main^.rowgroup_ctr := DCTSIZE; - end; - end; - - { If a write pass, read input data until the current iMCU row is full. } - { Note: preprocessor will pad if necessary to fill the last iMCU row. } - if (writing) then - begin - cinfo^.prep^.pre_process_data (cinfo, - input_buf, in_row_ctr, in_rows_avail, - JSAMPIMAGE(@main^.buffer), - main^.rowgroup_ctr, - JDIMENSION (DCTSIZE)); - - { Return to application if we need more data to fill the iMCU row. } - if (main^.rowgroup_ctr < DCTSIZE) then - exit; - end; - - { Emit data, unless this is a sink-only pass. } - if (main^.pass_mode <> JBUF_SAVE_SOURCE) then - begin - if (not cinfo^.coef^.compress_data (cinfo, - JSAMPIMAGE(@main^.buffer))) then - begin - { If compressor did not consume the whole row, then we must need to - suspend processing and return to the application. In this situation - we pretend we didn't yet consume the last input row; otherwise, if - it happened to be the last row of the image, the application would - think we were done. } - - if (not main^.suspended) then - begin - Dec(in_row_ctr); - main^.suspended := TRUE; - end; - exit; - end; - { We did finish the row. Undo our little suspension hack if a previous - call suspended; then mark the main buffer empty. } - - if (main^.suspended) then - begin - Inc(in_row_ctr); - main^.suspended := FALSE; - end; - end; - - { If get here, we are done with this iMCU row. Mark buffer empty. } - main^.rowgroup_ctr := 0; - Inc(main^.cur_iMCU_row); - end; -end; - -{$endif} { FULL_MAIN_BUFFER_SUPPORTED } - - -{ Initialize main buffer controller. } - -{GLOBAL} -procedure jinit_c_main_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); -var - main : my_main_ptr; - ci : int; - compptr : jpeg_component_info_ptr; -begin - main := my_main_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_main_controller)) ); - cinfo^.main := jpeg_c_main_controller_ptr(main); - main^.pub.start_pass := start_pass_main; - - { We don't need to create a buffer in raw-data mode. } - if (cinfo^.raw_data_in) then - exit; - - { Create the buffer. It holds downsampled data, so each component - may be of a different size. } - - if (need_full_buffer) then - begin -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - { Allocate a full-image virtual array for each component } - { Note we pad the bottom to a multiple of the iMCU height } - compptr := cinfo^.comp_info; - for ci := 0 to pred(cinfo^.num_components) do - begin - main^.whole_image[ci] := cinfo^.mem^.request_virt_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, - compptr^.width_in_blocks * DCTSIZE, - JDIMENSION (jround_up( long (compptr^.height_in_blocks), - long (compptr^.v_samp_factor)) * DCTSIZE), - JDIMENSION (compptr^.v_samp_factor * DCTSIZE)); - Inc(compptr); - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); -{$endif} - end - else - begin -{$ifdef FULL_MAIN_BUFFER_SUPPORTED} - main^.whole_image[0] := NIL; { flag for no virtual arrays } -{$endif} - { Allocate a strip buffer for each component } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - main^.buffer[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - compptr^.width_in_blocks * DCTSIZE, - JDIMENSION (compptr^.v_samp_factor * DCTSIZE)); - Inc(compptr); - end; - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcmarker.pas b/3rd/Imaging/Source/JpegLib/imjcmarker.pas deleted file mode 100644 index d41560761..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcmarker.pas +++ /dev/null @@ -1,724 +0,0 @@ -unit imjcmarker; - -{ This file contains routines to write JPEG datastream markers. } - -{ Original: jcmarker.c; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjinclude, imjmorecfg, imjerror, - imjdeferr, imjpeglib, imjutils; - - -const - { JPEG marker codes } - M_SOF0 = $c0; - M_SOF1 = $c1; - M_SOF2 = $c2; - M_SOF3 = $c3; - - M_SOF5 = $c5; - M_SOF6 = $c6; - M_SOF7 = $c7; - - M_JPG = $c8; - M_SOF9 = $c9; - M_SOF10 = $ca; - M_SOF11 = $cb; - - M_SOF13 = $cd; - M_SOF14 = $ce; - M_SOF15 = $cf; - - M_DHT = $c4; - - M_DAC = $cc; - - M_RST0 = $d0; - M_RST1 = $d1; - M_RST2 = $d2; - M_RST3 = $d3; - M_RST4 = $d4; - M_RST5 = $d5; - M_RST6 = $d6; - M_RST7 = $d7; - - M_SOI = $d8; - M_EOI = $d9; - M_SOS = $da; - M_DQT = $db; - M_DNL = $dc; - M_DRI = $dd; - M_DHP = $de; - M_EXP = $df; - - M_APP0 = $e0; - M_APP1 = $e1; - M_APP2 = $e2; - M_APP3 = $e3; - M_APP4 = $e4; - M_APP5 = $e5; - M_APP6 = $e6; - M_APP7 = $e7; - M_APP8 = $e8; - M_APP9 = $e9; - M_APP10 = $ea; - M_APP11 = $eb; - M_APP12 = $ec; - M_APP13 = $ed; - M_APP14 = $ee; - M_APP15 = $ef; - - M_JPG0 = $f0; - M_JPG13 = $fd; - M_COM = $fe; - - M_TEM = $01; - - M_ERROR = $100; - -type - JPEG_MARKER = Word; - -{ Private state } - -type - my_marker_ptr = ^my_marker_writer; - my_marker_writer = record - pub : jpeg_marker_writer; { public fields } - - last_restart_interval : uint; { last DRI value emitted; 0 after SOI } - end; - - - - -{GLOBAL} -procedure jinit_marker_writer (cinfo : j_compress_ptr); - -implementation - -{ Basic output routines. - - Note that we do not support suspension while writing a marker. - Therefore, an application using suspension must ensure that there is - enough buffer space for the initial markers (typ. 600-700 bytes) before - calling jpeg_start_compress, and enough space to write the trailing EOI - (a few bytes) before calling jpeg_finish_compress. Multipass compression - modes are not supported at all with suspension, so those two are the only - points where markers will be written. } - - -{LOCAL} -procedure emit_byte (cinfo : j_compress_ptr; val : int); -{ Emit a byte } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := cinfo^.dest; - - dest^.next_output_byte^ := JOCTET(val); - Inc(dest^.next_output_byte); - - Dec(dest^.free_in_buffer); - if (dest^.free_in_buffer = 0) then - begin - if not dest^.empty_output_buffer(cinfo) then - ERREXIT(j_common_ptr(cinfo), JERR_CANT_SUSPEND); - end; -end; - - -{LOCAL} -procedure emit_marker(cinfo : j_compress_ptr; mark : JPEG_MARKER); -{ Emit a marker code } -begin - emit_byte(cinfo, $FF); - emit_byte(cinfo, int(mark)); -end; - - -{LOCAL} -procedure emit_2bytes (cinfo : j_compress_ptr; value : int); -{ Emit a 2-byte integer; these are always MSB first in JPEG files } -begin - emit_byte(cinfo, (value shr 8) and $FF); - emit_byte(cinfo, value and $FF); -end; - - -{ Routines to write specific marker types. } - -{LOCAL} -function emit_dqt (cinfo : j_compress_ptr; index : int) : int; -{ Emit a DQT marker } -{ Returns the precision used (0 = 8bits, 1 = 16bits) for baseline checking } -var - qtbl : JQUANT_TBL_PTR; - prec : int; - i : int; -var - qval : uint; -begin - qtbl := cinfo^.quant_tbl_ptrs[index]; - if (qtbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, index); - - prec := 0; - for i := 0 to Pred(DCTSIZE2) do - begin - if (qtbl^.quantval[i] > 255) then - prec := 1; - end; - - if not qtbl^.sent_table then - begin - emit_marker(cinfo, M_DQT); - - if (prec <> 0) then - emit_2bytes(cinfo, DCTSIZE2*2 + 1 + 2) - else - emit_2bytes(cinfo, DCTSIZE2 + 1 + 2); - - emit_byte(cinfo, index + (prec shl 4)); - - for i := 0 to Pred(DCTSIZE2) do - begin - { The table entries must be emitted in zigzag order. } - qval := qtbl^.quantval[jpeg_natural_order[i]]; - if (prec <> 0) then - emit_byte(cinfo, int(qval shr 8)); - emit_byte(cinfo, int(qval and $FF)); - end; - - qtbl^.sent_table := TRUE; - end; - - emit_dqt := prec; -end; - - -{LOCAL} -procedure emit_dht (cinfo : j_compress_ptr; index : int; is_ac : boolean); -{ Emit a DHT marker } -var - htbl : JHUFF_TBL_PTR; - length, i : int; -begin - if (is_ac) then - begin - htbl := cinfo^.ac_huff_tbl_ptrs[index]; - index := index + $10; { output index has AC bit set } - end - else - begin - htbl := cinfo^.dc_huff_tbl_ptrs[index]; - end; - - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, index); - - if not htbl^.sent_table then - begin - emit_marker(cinfo, M_DHT); - - length := 0; - for i := 1 to 16 do - length := length + htbl^.bits[i]; - - emit_2bytes(cinfo, length + 2 + 1 + 16); - emit_byte(cinfo, index); - - for i := 1 to 16 do - emit_byte(cinfo, htbl^.bits[i]); - - for i := 0 to Pred(length) do - emit_byte(cinfo, htbl^.huffval[i]); - - htbl^.sent_table := TRUE; - end; -end; - - -{LOCAL} -procedure emit_dac (cinfo : j_compress_ptr); -{ Emit a DAC marker } -{ Since the useful info is so small, we want to emit all the tables in } -{ one DAC marker. Therefore this routine does its own scan of the table. } -{$ifdef C_ARITH_CODING_SUPPORTED} -var - dc_in_use : array[0..NUM_ARITH_TBLS] of byte; - ac_in_use : array[0..NUM_ARITH_TBLS] of byte; - length, i : int; - compptr : jpeg_component_info_ptr; -begin - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - dc_in_use[i] := 0; - ac_in_use[i] := 0; - end; - - for i := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - dc_in_use[compptr^.dc_tbl_no] := 1; - ac_in_use[compptr^.ac_tbl_no] := 1; - end; - - length := 0; - for i := 0 to pred(NUM_ARITH_TBLS) do - Inc(length, dc_in_use[i] + ac_in_use[i]); - - emit_marker(cinfo, M_DAC); - - emit_2bytes(cinfo, length*2 + 2); - - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - if (dc_in_use[i] <> 0) then - begin - emit_byte(cinfo, i); - emit_byte(cinfo, cinfo^.arith_dc_L[i] + (cinfo^.arith_dc_U[i] shl 4)); - end; - if (ac_in_use[i] <> 0) then - begin - emit_byte(cinfo, i + $10); - emit_byte(cinfo, cinfo^.arith_ac_K[i]); - end; - end; -end; -{$else} -begin -end; -{$endif} {C_ARITH_CODING_SUPPORTED} - - -{LOCAL} -procedure emit_dri (cinfo : j_compress_ptr); -{ Emit a DRI marker } -begin - emit_marker(cinfo, M_DRI); - - emit_2bytes(cinfo, 4); { fixed length } - - emit_2bytes(cinfo, int(cinfo^.restart_interval)); -end; - - -{LOCAL} -procedure emit_sof (cinfo : j_compress_ptr; code : JPEG_MARKER); -{ Emit a SOF marker } -var - ci : int; - compptr : jpeg_component_info_ptr; -begin - emit_marker(cinfo, code); - - emit_2bytes(cinfo, 3 * cinfo^.num_components + 2 + 5 + 1); { length } - - { Make sure image isn't bigger than SOF field can handle } - if (long(cinfo^.image_height) > long(65535)) or - (long(cinfo^.image_width) > long(65535)) then - ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(65535)); - - emit_byte(cinfo, cinfo^.data_precision); - emit_2bytes(cinfo, int(cinfo^.image_height)); - emit_2bytes(cinfo, int(cinfo^.image_width)); - - emit_byte(cinfo, cinfo^.num_components); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - emit_byte(cinfo, compptr^.component_id); - emit_byte(cinfo, (compptr^.h_samp_factor shl 4) + compptr^.v_samp_factor); - emit_byte(cinfo, compptr^.quant_tbl_no); - Inc(compptr); - end; -end; - - -{LOCAL} -procedure emit_sos (cinfo : j_compress_ptr); -{ Emit a SOS marker } -var - i, td, ta : int; - compptr : jpeg_component_info_ptr; -begin - emit_marker(cinfo, M_SOS); - - emit_2bytes(cinfo, 2 * cinfo^.comps_in_scan + 2 + 1 + 3); { length } - - emit_byte(cinfo, cinfo^.comps_in_scan); - - for i := 0 to Pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - emit_byte(cinfo, compptr^.component_id); - td := compptr^.dc_tbl_no; - ta := compptr^.ac_tbl_no; - if (cinfo^.progressive_mode) then - begin - { Progressive mode: only DC or only AC tables are used in one scan; - furthermore, Huffman coding of DC refinement uses no table at all. - We emit 0 for unused field(s); this is recommended by the P&M text - but does not seem to be specified in the standard. } - - if (cinfo^.Ss = 0) then - begin - ta := 0; { DC scan } - if (cinfo^.Ah <> 0) and not cinfo^.arith_code then - td := 0; { no DC table either } - end - else - begin - td := 0; { AC scan } - end; - end; - emit_byte(cinfo, (td shl 4) + ta); - end; - - emit_byte(cinfo, cinfo^.Ss); - emit_byte(cinfo, cinfo^.Se); - emit_byte(cinfo, (cinfo^.Ah shl 4) + cinfo^.Al); -end; - - -{LOCAL} -procedure emit_jfif_app0 (cinfo : j_compress_ptr); -{ Emit a JFIF-compliant APP0 marker } -{ - Length of APP0 block (2 bytes) - Block ID (4 bytes - ASCII "JFIF") - Zero byte (1 byte to terminate the ID string) - Version Major, Minor (2 bytes - major first) - Units (1 byte - $00 = none, $01 = inch, $02 = cm) - Xdpu (2 bytes - dots per unit horizontal) - Ydpu (2 bytes - dots per unit vertical) - Thumbnail X size (1 byte) - Thumbnail Y size (1 byte) -} -begin - emit_marker(cinfo, M_APP0); - - emit_2bytes(cinfo, 2 + 4 + 1 + 2 + 1 + 2 + 2 + 1 + 1); { length } - - emit_byte(cinfo, $4A); { Identifier: ASCII "JFIF" } - emit_byte(cinfo, $46); - emit_byte(cinfo, $49); - emit_byte(cinfo, $46); - emit_byte(cinfo, 0); - emit_byte(cinfo, cinfo^.JFIF_major_version); { Version fields } - emit_byte(cinfo, cinfo^.JFIF_minor_version); - emit_byte(cinfo, cinfo^.density_unit); { Pixel size information } - emit_2bytes(cinfo, int(cinfo^.X_density)); - emit_2bytes(cinfo, int(cinfo^.Y_density)); - emit_byte(cinfo, 0); { No thumbnail image } - emit_byte(cinfo, 0); -end; - - -{LOCAL} -procedure emit_adobe_app14 (cinfo : j_compress_ptr); -{ Emit an Adobe APP14 marker } -{ - Length of APP14 block (2 bytes) - Block ID (5 bytes - ASCII "Adobe") - Version Number (2 bytes - currently 100) - Flags0 (2 bytes - currently 0) - Flags1 (2 bytes - currently 0) - Color transform (1 byte) - - Although Adobe TN 5116 mentions Version = 101, all the Adobe files - now in circulation seem to use Version = 100, so that's what we write. - - We write the color transform byte as 1 if the JPEG color space is - YCbCr, 2 if it's YCCK, 0 otherwise. Adobe's definition has to do with - whether the encoder performed a transformation, which is pretty useless. -} -begin - emit_marker(cinfo, M_APP14); - - emit_2bytes(cinfo, 2 + 5 + 2 + 2 + 2 + 1); { length } - - emit_byte(cinfo, $41); { Identifier: ASCII "Adobe" } - emit_byte(cinfo, $64); - emit_byte(cinfo, $6F); - emit_byte(cinfo, $62); - emit_byte(cinfo, $65); - emit_2bytes(cinfo, 100); { Version } - emit_2bytes(cinfo, 0); { Flags0 } - emit_2bytes(cinfo, 0); { Flags1 } - case (cinfo^.jpeg_color_space) of - JCS_YCbCr: - emit_byte(cinfo, 1); { Color transform = 1 } - JCS_YCCK: - emit_byte(cinfo, 2); { Color transform = 2 } - else - emit_byte(cinfo, 0); { Color transform = 0 } - end; -end; - - -{ These routines allow writing an arbitrary marker with parameters. - The only intended use is to emit COM or APPn markers after calling - write_file_header and before calling write_frame_header. - Other uses are not guaranteed to produce desirable results. - Counting the parameter bytes properly is the caller's responsibility. } - -{METHODDEF} -procedure write_marker_header (cinfo : j_compress_ptr; - marker : int; - datalen : uint); -{ Emit an arbitrary marker header } -begin - if (datalen > uint(65533)) then { safety check } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - emit_marker(cinfo, JPEG_MARKER(marker)); - - emit_2bytes(cinfo, int(datalen + 2)); { total length } -end; - -{METHODDEF} -procedure write_marker_byte (cinfo : j_compress_ptr; val : int); -{ Emit one byte of marker parameters following write_marker_header } -begin - emit_byte(cinfo, val); -end; - -{ Write datastream header. - This consists of an SOI and optional APPn markers. - We recommend use of the JFIF marker, but not the Adobe marker, - when using YCbCr or grayscale data. The JFIF marker should NOT - be used for any other JPEG colorspace. The Adobe marker is helpful - to distinguish RGB, CMYK, and YCCK colorspaces. - Note that an application can write additional header markers after - jpeg_start_compress returns. } - - -{METHODDEF} -procedure write_file_header (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; -begin - marker := my_marker_ptr(cinfo^.marker); - - emit_marker(cinfo, M_SOI); { first the SOI } - - { SOI is defined to reset restart interval to 0 } - marker^.last_restart_interval := 0; - - if (cinfo^.write_JFIF_header) then { next an optional JFIF APP0 } - emit_jfif_app0(cinfo); - if (cinfo^.write_Adobe_marker) then { next an optional Adobe APP14 } - emit_adobe_app14(cinfo); -end; - - -{ Write frame header. - This consists of DQT and SOFn markers. - Note that we do not emit the SOF until we have emitted the DQT(s). - This avoids compatibility problems with incorrect implementations that - try to error-check the quant table numbers as soon as they see the SOF. } - - -{METHODDEF} -procedure write_frame_header (cinfo : j_compress_ptr); -var - ci, prec : int; - is_baseline : boolean; - compptr : jpeg_component_info_ptr; -begin - { Emit DQT for each quantization table. - Note that emit_dqt() suppresses any duplicate tables. } - - prec := 0; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - prec := prec + emit_dqt(cinfo, compptr^.quant_tbl_no); - Inc(compptr); - end; - { now prec is nonzero iff there are any 16-bit quant tables. } - - { Check for a non-baseline specification. - Note we assume that Huffman table numbers won't be changed later. } - - if (cinfo^.arith_code) or (cinfo^.progressive_mode) - or (cinfo^.data_precision <> 8) then - begin - is_baseline := FALSE; - end - else - begin - is_baseline := TRUE; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - if (compptr^.dc_tbl_no > 1) or (compptr^.ac_tbl_no > 1) then - is_baseline := FALSE; - Inc(compptr); - end; - if (prec <> 0) and (is_baseline) then - begin - is_baseline := FALSE; - { If it's baseline except for quantizer size, warn the user } - {$IFDEF DEBUG} - TRACEMS(j_common_ptr(cinfo), 0, JTRC_16BIT_TABLES); - {$ENDIF} - end; - end; - - { Emit the proper SOF marker } - if (cinfo^.arith_code) then - begin - emit_sof(cinfo, M_SOF9); { SOF code for arithmetic coding } - end - else - begin - if (cinfo^.progressive_mode) then - emit_sof(cinfo, M_SOF2) { SOF code for progressive Huffman } - else if (is_baseline) then - emit_sof(cinfo, M_SOF0) { SOF code for baseline implementation } - else - emit_sof(cinfo, M_SOF1); { SOF code for non-baseline Huffman file } - end; -end; - - -{ Write scan header. - This consists of DHT or DAC markers, optional DRI, and SOS. - Compressed data will be written following the SOS. } - -{METHODDEF} -procedure write_scan_header (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; - i : int; - compptr : jpeg_component_info_ptr; -begin - marker := my_marker_ptr(cinfo^.marker); - if (cinfo^.arith_code) then - begin - { Emit arith conditioning info. We may have some duplication - if the file has multiple scans, but it's so small it's hardly - worth worrying about. } - emit_dac(cinfo); - end - else - begin - { Emit Huffman tables. - Note that emit_dht() suppresses any duplicate tables. } - for i := 0 to Pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[i]; - if (cinfo^.progressive_mode) then - begin - { Progressive mode: only DC or only AC tables are used in one scan } - if (cinfo^.Ss = 0) then - begin - if (cinfo^.Ah = 0) then { DC needs no table for refinement scan } - emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); - end - else - begin - emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); - end; - end - else - begin - { Sequential mode: need both DC and AC tables } - emit_dht(cinfo, compptr^.dc_tbl_no, FALSE); - emit_dht(cinfo, compptr^.ac_tbl_no, TRUE); - end; - end; - end; - - { Emit DRI if required --- note that DRI value could change for each scan. - We avoid wasting space with unnecessary DRIs, however. } - - if (cinfo^.restart_interval <> marker^.last_restart_interval) then - begin - emit_dri(cinfo); - marker^.last_restart_interval := cinfo^.restart_interval; - end; - - emit_sos(cinfo); -end; - - - -{ Write datastream trailer. } - - -{METHODDEF} -procedure write_file_trailer (cinfo : j_compress_ptr); -begin - emit_marker(cinfo, M_EOI); -end; - - -{ Write an abbreviated table-specification datastream. - This consists of SOI, DQT and DHT tables, and EOI. - Any table that is defined and not marked sent_table = TRUE will be - emitted. Note that all tables will be marked sent_table = TRUE at exit. } - - -{METHODDEF} -procedure write_tables_only (cinfo : j_compress_ptr); -var - i : int; -begin - emit_marker(cinfo, M_SOI); - - for i := 0 to Pred(NUM_QUANT_TBLS) do - begin - if (cinfo^.quant_tbl_ptrs[i] <> NIL) then - emit_dqt(cinfo, i); { dummy := ... } - end; - - if (not cinfo^.arith_code) then - begin - for i := 0 to Pred(NUM_HUFF_TBLS) do - begin - if (cinfo^.dc_huff_tbl_ptrs[i] <> NIL) then - emit_dht(cinfo, i, FALSE); - if (cinfo^.ac_huff_tbl_ptrs[i] <> NIL) then - emit_dht(cinfo, i, TRUE); - end; - end; - - emit_marker(cinfo, M_EOI); -end; - - -{ Initialize the marker writer module. } - -{GLOBAL} -procedure jinit_marker_writer (cinfo : j_compress_ptr); -var - marker : my_marker_ptr; -begin - { Create the subobject } - marker := my_marker_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_marker_writer)) ); - cinfo^.marker := jpeg_marker_writer_ptr(marker); - { Initialize method pointers } - marker^.pub.write_file_header := write_file_header; - marker^.pub.write_frame_header := write_frame_header; - marker^.pub.write_scan_header := write_scan_header; - marker^.pub.write_file_trailer := write_file_trailer; - marker^.pub.write_tables_only := write_tables_only; - marker^.pub.write_marker_header := write_marker_header; - marker^.pub.write_marker_byte := write_marker_byte; - { Initialize private state } - marker^.last_restart_interval := 0; -end; - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcmaster.pas b/3rd/Imaging/Source/JpegLib/imjcmaster.pas deleted file mode 100644 index 90faeb5f8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcmaster.pas +++ /dev/null @@ -1,701 +0,0 @@ -unit imjcmaster; - -{ This file contains master control logic for the JPEG compressor. - These routines are concerned with parameter validation, initial setup, - and inter-pass control (determining the number of passes and the work - to be done in each pass). } - -{ Original: jcmaster.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{ Initialize master compression control. } - -{GLOBAL} -procedure jinit_c_master_control (cinfo : j_compress_ptr; - transcode_only : boolean); - -implementation - -{ Private state } - -type - c_pass_type = ( - main_pass, { input data, also do first output step } - huff_opt_pass, { Huffman code optimization pass } - output_pass { data output pass } - ); - -type - my_master_ptr = ^my_comp_master; - my_comp_master = record - pub : jpeg_comp_master; { public fields } - - pass_type : c_pass_type; { the type of the current pass } - - pass_number : int; { # of passes completed } - total_passes : int; { total # of passes needed } - - scan_number : int; { current index in scan_info[] } - end; - - -{ Support routines that do various essential calculations. } - -{LOCAL} -procedure initial_setup (cinfo : j_compress_ptr); -{ Do computations that are needed before master selection phase } -var - ci : int; - compptr : jpeg_component_info_ptr; - samplesperrow : long; - jd_samplesperrow : JDIMENSION; -begin - - { Sanity check on image dimensions } - if (cinfo^.image_height <= 0) or (cinfo^.image_width <= 0) or - (cinfo^.num_components <= 0) or (cinfo^.input_components <= 0) then - ERREXIT(j_common_ptr(cinfo), JERR_EMPTY_IMAGE); - - { Make sure image isn't bigger than I can handle } - if ( long(cinfo^.image_height) > long(JPEG_MAX_DIMENSION)) or - ( long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then - ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, - uInt(JPEG_MAX_DIMENSION)); - - { Width of an input scanline must be representable as JDIMENSION. } - samplesperrow := long (cinfo^.image_width) * long (cinfo^.input_components); - jd_samplesperrow := JDIMENSION (samplesperrow); - if ( long(jd_samplesperrow) <> samplesperrow) then - ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); - - { For now, precision must match compiled-in value... } - if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision); - - { Check that number of components won't exceed internal array sizes } - if (cinfo^.num_components > MAX_COMPONENTS) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, - MAX_COMPONENTS); - - { Compute maximum sampling factors; check factor validity } - cinfo^.max_h_samp_factor := 1; - cinfo^.max_v_samp_factor := 1; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR) - or (compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING); - { MAX } - if cinfo^.max_h_samp_factor > compptr^.h_samp_factor then - cinfo^.max_h_samp_factor := cinfo^.max_h_samp_factor - else - cinfo^.max_h_samp_factor := compptr^.h_samp_factor; - { MAX } - if cinfo^.max_v_samp_factor > compptr^.v_samp_factor then - cinfo^.max_v_samp_factor := cinfo^.max_v_samp_factor - else - cinfo^.max_v_samp_factor := compptr^.v_samp_factor; - Inc(compptr); - end; - - { Compute dimensions of components } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Fill in the correct component_index value; don't rely on application } - compptr^.component_index := ci; - { For compression, we never do DCT scaling. } - compptr^.DCT_scaled_size := DCTSIZE; - { Size in DCT blocks } - compptr^.width_in_blocks := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_width) * long (compptr^.h_samp_factor), - long (cinfo^.max_h_samp_factor * DCTSIZE)) ); - compptr^.height_in_blocks := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * long (compptr^.v_samp_factor), - long (cinfo^.max_v_samp_factor * DCTSIZE)) ); - { Size in samples } - compptr^.downsampled_width := JDIMENSION ( - jdiv_round_up(long(cinfo^.image_width) * long(compptr^.h_samp_factor), - long(cinfo^.max_h_samp_factor)) ); - compptr^.downsampled_height := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor), - long (cinfo^.max_v_samp_factor)) ); - { Mark component needed (this flag isn't actually used for compression) } - compptr^.component_needed := TRUE; - Inc(compptr); - end; - - { Compute number of fully interleaved MCU rows (number of times that - main controller will call coefficient controller). } - - cinfo^.total_iMCU_rows := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height), - long (cinfo^.max_v_samp_factor*DCTSIZE)) ); -end; - - -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - -{LOCAL} -procedure validate_script (cinfo : j_compress_ptr); -{ Verify that the scan script in cinfo^.scan_info[] is valid; also - determine whether it uses progressive JPEG, and set cinfo^.progressive_mode. } -type - IntRow = array[0..DCTSIZE2-1] of int; - introw_ptr = ^IntRow; -var - {const}scanptr : jpeg_scan_info_ptr; - scanno, ncomps, ci, coefi, thisi : int; - Ss, Se, Ah, Al : int; - component_sent : array[0..MAX_COMPONENTS-1] of boolean; -{$ifdef C_PROGRESSIVE_SUPPORTED} - last_bitpos_int_ptr : int_ptr; - last_bitpos_ptr : introw_ptr; - last_bitpos : array[0..MAX_COMPONENTS-1] of IntRow; - { -1 until that coefficient has been seen; then last Al for it } - { The JPEG spec simply gives the ranges 0..13 for Ah and Al, but that - seems wrong: the upper bound ought to depend on data precision. - Perhaps they really meant 0..N+1 for N-bit precision. - Here we allow 0..10 for 8-bit data; Al larger than 10 results in - out-of-range reconstructed DC values during the first DC scan, - which might cause problems for some decoders. } -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - MAX_AH_AL = 10; -{$else} -const - MAX_AH_AL = 13; -{$endif} -{$endif} -begin - - if (cinfo^.num_scans <= 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, 0); - - { For sequential JPEG, all scans must have Ss=0, Se=DCTSIZE2-1; - for progressive JPEG, no scan can have this. } - - scanptr := cinfo^.scan_info; - if (scanptr^.Ss <> 0) or (scanptr^.Se <> DCTSIZE2-1) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - cinfo^.progressive_mode := TRUE; - last_bitpos_int_ptr := @(last_bitpos[0][0]); - for ci := 0 to pred(cinfo^.num_components) do - for coefi := 0 to pred(DCTSIZE2) do - begin - last_bitpos_int_ptr^ := -1; - Inc(last_bitpos_int_ptr); - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - cinfo^.progressive_mode := FALSE; - for ci := 0 to pred(cinfo^.num_components) do - component_sent[ci] := FALSE; - end; - - for scanno := 1 to cinfo^.num_scans do - begin - { Validate component indexes } - ncomps := scanptr^.comps_in_scan; - if (ncomps <= 0) or (ncomps > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, ncomps, MAX_COMPS_IN_SCAN); - for ci := 0 to pred(ncomps) do - begin - thisi := scanptr^.component_index[ci]; - if (thisi < 0) or (thisi >= cinfo^.num_components) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - { Components must appear in SOF order within each scan } - if (ci > 0) and (thisi <= scanptr^.component_index[ci-1]) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - end; - { Validate progression parameters } - Ss := scanptr^.Ss; - Se := scanptr^.Se; - Ah := scanptr^.Ah; - Al := scanptr^.Al; - if (cinfo^.progressive_mode) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) or - (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - - if (Ss < 0) or (Ss >= DCTSIZE2) or (Se < Ss) or (Se >= DCTSIZE2) - or (Ah < 0) or (Ah > MAX_AH_AL) or (Al < 0) or (Al > MAX_AH_AL) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - if (Ss = 0) then - begin - if (Se <> 0) then { DC and AC together not OK } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end - else - begin - if (ncomps <> 1) then { AC scans must be for only one component } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end; - for ci := 0 to pred(ncomps) do - begin - last_bitpos_ptr := @( last_bitpos[scanptr^.component_index[ci]]); - if (Ss <> 0) and (last_bitpos_ptr^[0] < 0) then { AC without prior DC scan } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - for coefi := Ss to Se do - begin - if (last_bitpos_ptr^[coefi] < 0) then - begin - { first scan of this coefficient } - if (Ah <> 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end - else - begin - { not first scan } - if (Ah <> last_bitpos_ptr^[coefi]) or (Al <> Ah-1) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - end; - last_bitpos_ptr^[coefi] := Al; - end; - end; -{$endif} - end - else - begin - { For sequential JPEG, all progression parameters must be these: } - if (Ss <> 0) or (Se <> DCTSIZE2-1) or (Ah <> 0) or (Al <> 0) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PROG_SCRIPT, scanno); - { Make sure components are not sent twice } - for ci := 0 to pred(ncomps) do - begin - thisi := scanptr^.component_index[ci]; - if (component_sent[thisi]) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_SCAN_SCRIPT, scanno); - component_sent[thisi] := TRUE; - end; - end; - Inc(scanptr); - end; - - { Now verify that everything got sent. } - if (cinfo^.progressive_mode) then - begin -{$ifdef C_PROGRESSIVE_SUPPORTED} - { For progressive mode, we only check that at least some DC data - got sent for each component; the spec does not require that all bits - of all coefficients be transmitted. Would it be wiser to enforce - transmission of all coefficient bits?? } - - for ci := 0 to pred(cinfo^.num_components) do - begin - if (last_bitpos[ci][0] < 0) then - ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); - end; -{$endif} - end - else - begin - for ci := 0 to pred(cinfo^.num_components) do - begin - if (not component_sent[ci]) then - ERREXIT(j_common_ptr(cinfo), JERR_MISSING_DATA); - end; - end; -end; - -{$endif} { C_MULTISCAN_FILES_SUPPORTED } - - -{LOCAL} -procedure select_scan_parameters (cinfo : j_compress_ptr); -{ Set up the scan parameters for the current scan } -var - master : my_master_ptr; - {const} scanptr : jpeg_scan_info_ptr; - ci : int; -var - comp_infos : jpeg_component_info_list_ptr; -begin -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - if (cinfo^.scan_info <> NIL) then - begin - { Prepare for current scan --- the script is already validated } - master := my_master_ptr (cinfo^.master); - scanptr := cinfo^.scan_info; - Inc(scanptr, master^.scan_number); - - cinfo^.comps_in_scan := scanptr^.comps_in_scan; - comp_infos := cinfo^.comp_info; - for ci := 0 to pred(scanptr^.comps_in_scan) do - begin - cinfo^.cur_comp_info[ci] := - @(comp_infos^[scanptr^.component_index[ci]]); - end; - cinfo^.Ss := scanptr^.Ss; - cinfo^.Se := scanptr^.Se; - cinfo^.Ah := scanptr^.Ah; - cinfo^.Al := scanptr^.Al; - end - else -{$endif} - begin - { Prepare for single sequential-JPEG scan containing all components } - if (cinfo^.num_components > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, - MAX_COMPS_IN_SCAN); - cinfo^.comps_in_scan := cinfo^.num_components; - comp_infos := cinfo^.comp_info; - for ci := 0 to pred(cinfo^.num_components) do - begin - cinfo^.cur_comp_info[ci] := @(comp_infos^[ci]); - end; - cinfo^.Ss := 0; - cinfo^.Se := DCTSIZE2-1; - cinfo^.Ah := 0; - cinfo^.Al := 0; - end; -end; - - -{LOCAL} -procedure per_scan_setup (cinfo : j_compress_ptr); -{ Do computations that are needed before processing a JPEG scan } -{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] are already set } -var - ci, mcublks, tmp : int; - compptr : jpeg_component_info_ptr; - nominal : long; -begin - if (cinfo^.comps_in_scan = 1) then - begin - - { Noninterleaved (single-component) scan } - compptr := cinfo^.cur_comp_info[0]; - - { Overall image size in MCUs } - cinfo^.MCUs_per_row := compptr^.width_in_blocks; - cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks; - - { For noninterleaved scan, always one block per MCU } - compptr^.MCU_width := 1; - compptr^.MCU_height := 1; - compptr^.MCU_blocks := 1; - compptr^.MCU_sample_width := DCTSIZE; - compptr^.last_col_width := 1; - { For noninterleaved scans, it is convenient to define last_row_height - as the number of block rows present in the last iMCU row. } - - tmp := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; - if (tmp = 0) then - tmp := compptr^.v_samp_factor; - compptr^.last_row_height := tmp; - - { Prepare array describing MCU composition } - cinfo^.blocks_in_MCU := 1; - cinfo^.MCU_membership[0] := 0; - - end - else - begin - - { Interleaved (multi-component) scan } - if (cinfo^.comps_in_scan <= 0) or - (cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, - cinfo^.comps_in_scan, MAX_COMPS_IN_SCAN); - - { Overall image size in MCUs } - cinfo^.MCUs_per_row := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_width), - long (cinfo^.max_h_samp_factor*DCTSIZE)) ); - cinfo^.MCU_rows_in_scan := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_height), - long (cinfo^.max_v_samp_factor*DCTSIZE)) ); - - cinfo^.blocks_in_MCU := 0; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Sampling factors give # of blocks of component in each MCU } - compptr^.MCU_width := compptr^.h_samp_factor; - compptr^.MCU_height := compptr^.v_samp_factor; - compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height; - compptr^.MCU_sample_width := compptr^.MCU_width * DCTSIZE; - { Figure number of non-dummy blocks in last MCU column & row } - tmp := int (compptr^.width_in_blocks) mod compptr^.MCU_width; - if (tmp = 0) then - tmp := compptr^.MCU_width; - compptr^.last_col_width := tmp; - tmp := int (compptr^.height_in_blocks) mod compptr^.MCU_height; - if (tmp = 0) then - tmp := compptr^.MCU_height; - compptr^.last_row_height := tmp; - { Prepare array describing MCU composition } - mcublks := compptr^.MCU_blocks; - if (cinfo^.blocks_in_MCU + mcublks > C_MAX_BLOCKS_IN_MCU) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE); - while (mcublks > 0) do - begin - Dec(mcublks); - cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci; - Inc(cinfo^.blocks_in_MCU); - end; - end; - - end; - - { Convert restart specified in rows to actual MCU count. } - { Note that count must fit in 16 bits, so we provide limiting. } - if (cinfo^.restart_in_rows > 0) then - begin - nominal := long(cinfo^.restart_in_rows) * long(cinfo^.MCUs_per_row); - if nominal < long(65535) then - cinfo^.restart_interval := uInt (nominal) - else - cinfo^.restart_interval := long(65535); - end; -end; - - -{ Per-pass setup. - This is called at the beginning of each pass. We determine which modules - will be active during this pass and give them appropriate start_pass calls. - We also set is_last_pass to indicate whether any more passes will be - required. } - -{METHODDEF} -procedure prepare_for_pass (cinfo : j_compress_ptr); -var - master : my_master_ptr; -var - fallthrough : boolean; -begin - master := my_master_ptr (cinfo^.master); - fallthrough := true; - - case (master^.pass_type) of - main_pass: - begin - { Initial pass: will collect input data, and do either Huffman - optimization or data output for the first scan. } - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - if (not cinfo^.raw_data_in) then - begin - cinfo^.cconvert^.start_pass (cinfo); - cinfo^.downsample^.start_pass (cinfo); - cinfo^.prep^.start_pass (cinfo, JBUF_PASS_THRU); - end; - cinfo^.fdct^.start_pass (cinfo); - cinfo^.entropy^.start_pass (cinfo, cinfo^.optimize_coding); - if master^.total_passes > 1 then - cinfo^.coef^.start_pass (cinfo, JBUF_SAVE_AND_PASS) - else - cinfo^.coef^.start_pass (cinfo, JBUF_PASS_THRU); - cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); - if (cinfo^.optimize_coding) then - begin - { No immediate data output; postpone writing frame/scan headers } - master^.pub.call_pass_startup := FALSE; - end - else - begin - { Will write frame/scan headers at first jpeg_write_scanlines call } - master^.pub.call_pass_startup := TRUE; - end; - end; -{$ifdef ENTROPY_OPT_SUPPORTED} - huff_opt_pass, - output_pass: - begin - if (master^.pass_type = huff_opt_pass) then - begin - { Do Huffman optimization for a scan after the first one. } - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - if (cinfo^.Ss <> 0) or (cinfo^.Ah = 0) or (cinfo^.arith_code) then - begin - cinfo^.entropy^.start_pass (cinfo, TRUE); - cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); - master^.pub.call_pass_startup := FALSE; - fallthrough := false; - end; - { Special case: Huffman DC refinement scans need no Huffman table - and therefore we can skip the optimization pass for them. } - if fallthrough then - begin - master^.pass_type := output_pass; - Inc(master^.pass_number); - {FALLTHROUGH} - end; - end; -{$else} - output_pass: - begin -{$endif} - if fallthrough then - begin - { Do a data-output pass. } - { We need not repeat per-scan setup if prior optimization pass did it. } - if (not cinfo^.optimize_coding) then - begin - select_scan_parameters(cinfo); - per_scan_setup(cinfo); - end; - cinfo^.entropy^.start_pass (cinfo, FALSE); - cinfo^.coef^.start_pass (cinfo, JBUF_CRANK_DEST); - { We emit frame/scan headers now } - if (master^.scan_number = 0) then - cinfo^.marker^.write_frame_header (cinfo); - cinfo^.marker^.write_scan_header (cinfo); - master^.pub.call_pass_startup := FALSE; - end; - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - - master^.pub.is_last_pass := (master^.pass_number = master^.total_passes-1); - - { Set up progress monitor's pass info if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.completed_passes := master^.pass_number; - cinfo^.progress^.total_passes := master^.total_passes; - end; -end; - - -{ Special start-of-pass hook. - This is called by jpeg_write_scanlines if call_pass_startup is TRUE. - In single-pass processing, we need this hook because we don't want to - write frame/scan headers during jpeg_start_compress; we want to let the - application write COM markers etc. between jpeg_start_compress and the - jpeg_write_scanlines loop. - In multi-pass processing, this routine is not used. } - -{METHODDEF} -procedure pass_startup (cinfo : j_compress_ptr); -begin - cinfo^.master^.call_pass_startup := FALSE; { reset flag so call only once } - - cinfo^.marker^.write_frame_header (cinfo); - cinfo^.marker^.write_scan_header (cinfo); -end; - - -{ Finish up at end of pass. } - -{METHODDEF} -procedure finish_pass_master (cinfo : j_compress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - { The entropy coder always needs an end-of-pass call, - either to analyze statistics or to flush its output buffer. } - cinfo^.entropy^.finish_pass (cinfo); - - { Update state for next pass } - case (master^.pass_type) of - main_pass: - begin - { next pass is either output of scan 0 (after optimization) - or output of scan 1 (if no optimization). } - - master^.pass_type := output_pass; - if (not cinfo^.optimize_coding) then - Inc(master^.scan_number); - end; - huff_opt_pass: - { next pass is always output of current scan } - master^.pass_type := output_pass; - output_pass: - begin - { next pass is either optimization or output of next scan } - if (cinfo^.optimize_coding) then - master^.pass_type := huff_opt_pass; - Inc(master^.scan_number); - end; - end; - - Inc(master^.pass_number); -end; - - -{ Initialize master compression control. } - -{GLOBAL} -procedure jinit_c_master_control (cinfo : j_compress_ptr; - transcode_only : boolean); -var - master : my_master_ptr; -begin - master := my_master_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_comp_master)) ); - cinfo^.master := jpeg_comp_master_ptr(master); - master^.pub.prepare_for_pass := prepare_for_pass; - master^.pub.pass_startup := pass_startup; - master^.pub.finish_pass := finish_pass_master; - master^.pub.is_last_pass := FALSE; - - { Validate parameters, determine derived values } - initial_setup(cinfo); - - if (cinfo^.scan_info <> NIL) then - begin -{$ifdef C_MULTISCAN_FILES_SUPPORTED} - validate_script(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - cinfo^.progressive_mode := FALSE; - cinfo^.num_scans := 1; - end; - - if (cinfo^.progressive_mode) then { TEMPORARY HACK ??? } - cinfo^.optimize_coding := TRUE; { assume default tables no good for progressive mode } - - { Initialize my private state } - if (transcode_only) then - begin - { no main pass in transcoding } - if (cinfo^.optimize_coding) then - master^.pass_type := huff_opt_pass - else - master^.pass_type := output_pass; - end - else - begin - { for normal compression, first pass is always this type: } - master^.pass_type := main_pass; - end; - master^.scan_number := 0; - master^.pass_number := 0; - if (cinfo^.optimize_coding) then - master^.total_passes := cinfo^.num_scans * 2 - else - master^.total_passes := cinfo^.num_scans; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcomapi.pas b/3rd/Imaging/Source/JpegLib/imjcomapi.pas deleted file mode 100644 index c58a7ae8f..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcomapi.pas +++ /dev/null @@ -1,130 +0,0 @@ -unit imjcomapi; - -{ This file contains application interface routines that are used for both - compression and decompression. } - -{ Original: jcomapi.c; Copyright (C) 1994-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib; - -{ Abort processing of a JPEG compression or decompression operation, - but don't destroy the object itself. } - -{GLOBAL} -procedure jpeg_abort (cinfo : j_common_ptr); - - -{ Destruction of a JPEG object. } - -{GLOBAL} -procedure jpeg_destroy (cinfo : j_common_ptr); - -{GLOBAL} -function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR; - -{GLOBAL} -function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR; - -implementation - -{ Abort processing of a JPEG compression or decompression operation, - but don't destroy the object itself. - - For this, we merely clean up all the nonpermanent memory pools. - Note that temp files (virtual arrays) are not allowed to belong to - the permanent pool, so we will be able to close all temp files here. - Closing a data source or destination, if necessary, is the application's - responsibility. } - - -{GLOBAL} -procedure jpeg_abort (cinfo : j_common_ptr); -var - pool : int; -begin - { Do nothing if called on a not-initialized or destroyed JPEG object. } - if (cinfo^.mem = NIL) then - exit; - - { Releasing pools in reverse order might help avoid fragmentation - with some (brain-damaged) malloc libraries. } - - for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT+1 do - begin - cinfo^.mem^.free_pool (cinfo, pool); - end; - - { Reset overall state for possible reuse of object } - if (cinfo^.is_decompressor) then - begin - cinfo^.global_state := DSTATE_START; - { Try to keep application from accessing now-deleted marker list. - A bit kludgy to do it here, but this is the most central place. } - j_decompress_ptr(cinfo)^.marker_list := NIL; - end - else - begin - cinfo^.global_state := CSTATE_START; - end; -end; - - -{ Destruction of a JPEG object. - - Everything gets deallocated except the master jpeg_compress_struct itself - and the error manager struct. Both of these are supplied by the application - and must be freed, if necessary, by the application. (Often they are on - the stack and so don't need to be freed anyway.) - Closing a data source or destination, if necessary, is the application's - responsibility. } - - -{GLOBAL} -procedure jpeg_destroy (cinfo : j_common_ptr); -begin - { We need only tell the memory manager to release everything. } - { NB: mem pointer is NIL if memory mgr failed to initialize. } - if (cinfo^.mem <> NIL) then - cinfo^.mem^.self_destruct (cinfo); - cinfo^.mem := NIL; { be safe if jpeg_destroy is called twice } - cinfo^.global_state := 0; { mark it destroyed } -end; - - -{ Convenience routines for allocating quantization and Huffman tables. - (Would jutils.c be a more reasonable place to put these?) } - - -{GLOBAL} -function jpeg_alloc_quant_table (cinfo : j_common_ptr) : JQUANT_TBL_PTR; -var - tbl : JQUANT_TBL_PTR; -begin - tbl := JQUANT_TBL_PTR( - cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JQUANT_TBL)) - ); - tbl^.sent_table := FALSE; { make sure this is false in any new table } - jpeg_alloc_quant_table := tbl; -end; - - -{GLOBAL} -function jpeg_alloc_huff_table (cinfo : j_common_ptr) : JHUFF_TBL_PTR; -var - tbl : JHUFF_TBL_PTR; -begin - tbl := JHUFF_TBL_PTR( - cinfo^.mem^.alloc_small (cinfo, JPOOL_PERMANENT, SIZEOF(JHUFF_TBL)) - ); - tbl^.sent_table := FALSE; { make sure this is false in any new table } - jpeg_alloc_huff_table := tbl; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjconfig.inc b/3rd/Imaging/Source/JpegLib/imjconfig.inc deleted file mode 100644 index bf5a0cf4f..000000000 --- a/3rd/Imaging/Source/JpegLib/imjconfig.inc +++ /dev/null @@ -1,126 +0,0 @@ -{ ----------------------- JPEG_INTERNAL_OPTIONS ---------------------- } - - -{ These defines indicate whether to include various optional functions. - Undefining some of these symbols will produce a smaller but less capable - library. Note that you can leave certain source files out of the - compilation/linking process if you've #undef'd the corresponding symbols. - (You may HAVE to do that if your compiler doesn't like null source files.)} - - -{ Arithmetic coding is unsupported for legal reasons. Complaints to IBM. } - -{ Capability options common to encoder and decoder: } - -{$define DCT_ISLOW_SUPPORTED} { slow but accurate integer algorithm } -{$define DCT_IFAST_SUPPORTED} { faster, less accurate integer method } -{$define DCT_FLOAT_SUPPORTED} { floating-point: accurate, fast on fast HW } - -{ Encoder capability options: } - -{$undef C_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? } -{$define C_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? } -{$define C_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)} -{$define ENTROPY_OPT_SUPPORTED} { Optimization of entropy coding parms? } -{ Note: if you selected 12-bit data precision, it is dangerous to turn off - ENTROPY_OPT_SUPPORTED. The standard Huffman tables are only good for 8-bit - precision, so jchuff.c normally uses entropy optimization to compute - usable tables for higher precision. If you don't want to do optimization, - you'll have to supply different default Huffman tables. - The exact same statements apply for progressive JPEG: the default tables - don't work for progressive mode. (This may get fixed, however.) } - -{$define INPUT_SMOOTHING_SUPPORTED} { Input image smoothing option? } - -{ Decoder capability options: } - -{$undef D_ARITH_CODING_SUPPORTED} { Arithmetic coding back end? } -{$define D_MULTISCAN_FILES_SUPPORTED} { Multiple-scan JPEG files? } -{$define D_PROGRESSIVE_SUPPORTED} { Progressive JPEG? (Requires MULTISCAN)} -{$define SAVE_MARKERS_SUPPORTED} { jpeg_save_markers() needed? } -{$define BLOCK_SMOOTHING_SUPPORTED} { Block smoothing? (Progressive only) } -{$define IDCT_SCALING_SUPPORTED} { Output rescaling via IDCT? } -{$undef UPSAMPLE_SCALING_SUPPORTED} { Output rescaling at upsample stage? } -{$define UPSAMPLE_MERGING_SUPPORTED} { Fast path for sloppy upsampling? } -{$define QUANT_1PASS_SUPPORTED} { 1-pass color quantization? } -{$define QUANT_2PASS_SUPPORTED} { 2-pass color quantization? } - -{ If you happen not to want the image transform support, disable it here } -{$define TRANSFORMS_SUPPORTED} - -{ more capability options later, no doubt } - -{$ifopt I+} {$define IOcheck} {$endif} - -{ ------------------------------------------------------------------------ } - -{$define USE_FMEM} { Borland has _fmemcpy() and _fmemset() } - -{$define FMEMCOPY} -{$define FMEMZERO} - -{$define DCTSIZE_IS_8} { e.g. unroll the inner loop } -{$define RIGHT_SHIFT_IS_UNSIGNED} -{$undef AVOID_TABLES} -{$undef FAST_DIVIDE} - -{$define BITS_IN_JSAMPLE_IS_8} - -{----------------------------------------------------------------} -{ for test of 12 bit JPEG code only. !! } -{-- $undef BITS_IN_JSAMPLE_IS_8} -{----------------------------------------------------------------} - -//{$define RGB_RED_IS_0} -{ !CHANGE: This must be defined for Delphi/Kylix/FPC } -{$define RGB_RED_IS_2} { RGB byte order } - - -{$define RGB_PIXELSIZE_IS_3} -{$define SLOW_SHIFT_32} -{$undef NO_ZERO_ROW_TEST} - -{$define USE_MSDOS_MEMMGR} { Define this if you use jmemdos.c } -{$define XMS_SUPPORTED} -{$define EMS_SUPPORTED} - -{$undef MEM_STATS} { Write out memory usage } -{$define AM_MEMORY_MANAGER} { we define jvirt_Xarray_control structs } - -{$undef FULL_MAIN_BUFFER_SUPPORTED} - -{$define PROGRESS_REPORT} -{$define TWO_FILE_COMMANDLINE} -{$undef BMP_SUPPORTED} -{$undef PPM_SUPPORTED} -{$undef GIF_SUPPORTED} -{$undef RLE_SUPPORTED} -{$undef TARGA_SUPPORTED} -{$define EXT_SWITCH} - -{$ifndef BITS_IN_JSAMPLE_IS_8} { for 12 bit samples } -{$undef BMP_SUPPORTED} -{$undef RLE_SUPPORTED} -{$undef TARGA_SUPPORTED} -{$endif} - - -{!CHANGE: Allowed only for Delphi} -{$undef BASM16} { for TP7 - use BASM for fast multiply } -{$ifdef Win32} - {$ifndef FPC} - {$define BASM} { jidctint with BASM for Delphi 2/3 } - {$undef RGB_RED_IS_0} { BGR byte order in JQUANT2 } - {$endif} -{$endif} - -{$ifdef FPC} - {$MODE DELPHI} -{$endif} - -{!CHANGE: Added this} -{$define Delphi_Stream} -{$Q-} -{$MINENUMSIZE 4} -{$ALIGN 8} - diff --git a/3rd/Imaging/Source/JpegLib/imjcparam.pas b/3rd/Imaging/Source/JpegLib/imjcparam.pas deleted file mode 100644 index 345fc32ff..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcparam.pas +++ /dev/null @@ -1,701 +0,0 @@ -unit imjcparam; - -{ This file contains optional default-setting code for the JPEG compressor. - Applications do not have to use this file, but those that don't use it - must know a lot more about the innards of the JPEG code. } - -{ Original: jcparam.c ; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjcomapi, - imjpeglib; - -{ Quantization table setup routines } - -{GLOBAL} -procedure jpeg_add_quant_table (cinfo : j_compress_ptr; - which_tbl : int; - const basic_table : array of uInt; - scale_factor : int; - force_baseline : boolean); - -{GLOBAL} -procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; - scale_factor : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables - and a straight percentage-scaling quality scale. In most cases it's better - to use jpeg_set_quality (below); this entry point is provided for - applications that insist on a linear percentage scaling. } - -{GLOBAL} -function jpeg_quality_scaling (quality : int) : int; -{ Convert a user-specified quality rating to a percentage scaling factor - for an underlying quantization table, using our recommended scaling curve. - The input 'quality' factor should be 0 (terrible) to 100 (very good). } - -{GLOBAL} -procedure jpeg_set_quality (cinfo : j_compress_ptr; - quality : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables. - This is the standard quality-adjusting entry point for typical user - interfaces; only those who want detailed control over quantization tables - would use the preceding three routines directly. } - -{GLOBAL} -procedure jpeg_set_defaults (cinfo : j_compress_ptr); - -{ Create a recommended progressive-JPEG script. - cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } - -{ Set the JPEG colorspace, and choose colorspace-dependent default values. } - -{GLOBAL} -procedure jpeg_set_colorspace (cinfo : j_compress_ptr; - colorspace : J_COLOR_SPACE); - -{ Select an appropriate JPEG colorspace for in_color_space. } - -{GLOBAL} -procedure jpeg_default_colorspace (cinfo : j_compress_ptr); - -{GLOBAL} -procedure jpeg_simple_progression (cinfo : j_compress_ptr); - - -implementation - -{ Quantization table setup routines } - -{GLOBAL} -procedure jpeg_add_quant_table (cinfo : j_compress_ptr; - which_tbl : int; - const basic_table : array of uInt; - scale_factor : int; - force_baseline : boolean); -{ Define a quantization table equal to the basic_table times - a scale factor (given as a percentage). - If force_baseline is TRUE, the computed quantization table entries - are limited to 1..255 for JPEG baseline compatibility. } -var - qtblptr :^JQUANT_TBL_PTR; - i : int; - temp : long; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - if (which_tbl < 0) or (which_tbl >= NUM_QUANT_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_DQT_INDEX, which_tbl); - - qtblptr := @(cinfo^.quant_tbl_ptrs[which_tbl]); - - if (qtblptr^ = NIL) then - qtblptr^ := jpeg_alloc_quant_table(j_common_ptr(cinfo)); - - for i := 0 to pred(DCTSIZE2) do - begin - temp := (long(basic_table[i]) * scale_factor + long(50)) div long(100); - { limit the values to the valid range } - if (temp <= long(0)) then - temp := long(1); - if (temp > long(32767)) then - temp := long(32767); { max quantizer needed for 12 bits } - if (force_baseline) and (temp > long(255)) then - temp := long(255); { limit to baseline range if requested } - (qtblptr^)^.quantval[i] := UINT16 (temp); - end; - - { Initialize sent_table FALSE so table will be written to JPEG file. } - (qtblptr^)^.sent_table := FALSE; -end; - - -{GLOBAL} -procedure jpeg_set_linear_quality (cinfo : j_compress_ptr; - scale_factor : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables - and a straight percentage-scaling quality scale. In most cases it's better - to use jpeg_set_quality (below); this entry point is provided for - applications that insist on a linear percentage scaling. } - -{ These are the sample quantization tables given in JPEG spec section K.1. - The spec says that the values given produce "good" quality, and - when divided by 2, "very good" quality. } - -const - std_luminance_quant_tbl : array[0..DCTSIZE2-1] of uInt = - (16, 11, 10, 16, 24, 40, 51, 61, - 12, 12, 14, 19, 26, 58, 60, 55, - 14, 13, 16, 24, 40, 57, 69, 56, - 14, 17, 22, 29, 51, 87, 80, 62, - 18, 22, 37, 56, 68, 109, 103, 77, - 24, 35, 55, 64, 81, 104, 113, 92, - 49, 64, 78, 87, 103, 121, 120, 101, - 72, 92, 95, 98, 112, 100, 103, 99); - -const - std_chrominance_quant_tbl : array[0..DCTSIZE2-1] of uInt = - (17, 18, 24, 47, 99, 99, 99, 99, - 18, 21, 26, 66, 99, 99, 99, 99, - 24, 26, 56, 99, 99, 99, 99, 99, - 47, 66, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99, - 99, 99, 99, 99, 99, 99, 99, 99); -begin - { Set up two quantization tables using the specified scaling } - jpeg_add_quant_table(cinfo, 0, std_luminance_quant_tbl, - scale_factor, force_baseline); - jpeg_add_quant_table(cinfo, 1, std_chrominance_quant_tbl, - scale_factor, force_baseline); -end; - - -{GLOBAL} -function jpeg_quality_scaling (quality : int) : int; -{ Convert a user-specified quality rating to a percentage scaling factor - for an underlying quantization table, using our recommended scaling curve. - The input 'quality' factor should be 0 (terrible) to 100 (very good). } -begin - { Safety limit on quality factor. Convert 0 to 1 to avoid zero divide. } - if (quality <= 0) then - quality := 1; - if (quality > 100) then - quality := 100; - - { The basic table is used as-is (scaling 100) for a quality of 50. - Qualities 50..100 are converted to scaling percentage 200 - 2*Q; - note that at Q=100 the scaling is 0, which will cause jpeg_add_quant_table - to make all the table entries 1 (hence, minimum quantization loss). - Qualities 1..50 are converted to scaling percentage 5000/Q. } - if (quality < 50) then - quality := 5000 div quality - else - quality := 200 - quality*2; - - jpeg_quality_scaling := quality; -end; - - -{GLOBAL} -procedure jpeg_set_quality (cinfo : j_compress_ptr; - quality : int; - force_baseline : boolean); -{ Set or change the 'quality' (quantization) setting, using default tables. - This is the standard quality-adjusting entry point for typical user - interfaces; only those who want detailed control over quantization tables - would use the preceding three routines directly. } -begin - { Convert user 0-100 rating to percentage scaling } - quality := jpeg_quality_scaling(quality); - - { Set up standard quality tables } - jpeg_set_linear_quality(cinfo, quality, force_baseline); -end; - - -{ Huffman table setup routines } - -{LOCAL} -procedure add_huff_table (cinfo : j_compress_ptr; - var htblptr : JHUFF_TBL_PTR; - var bits : array of UINT8; - var val : array of UINT8); -{ Define a Huffman table } -var - nsymbols, len : int; -begin - if (htblptr = NIL) then - htblptr := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - - { Copy the number-of-symbols-of-each-code-length counts } - MEMCOPY(@htblptr^.bits, @bits, SIZEOF(htblptr^.bits)); - - - { Validate the counts. We do this here mainly so we can copy the right - number of symbols from the val[] array, without risking marching off - the end of memory. jchuff.c will do a more thorough test later. } - - nsymbols := 0; - for len := 1 to 16 do - Inc(nsymbols, bits[len]); - if (nsymbols < 1) or (nsymbols > 256) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - - MEMCOPY(@htblptr^.huffval, @val, nsymbols * SIZEOF(UINT8)); - - { Initialize sent_table FALSE so table will be written to JPEG file. } - (htblptr)^.sent_table := FALSE; -end; - - -{$J+} -{LOCAL} -procedure std_huff_tables (cinfo : j_compress_ptr); -{ Set up the standard Huffman tables (cf. JPEG standard section K.3) } -{ IMPORTANT: these are only valid for 8-bit data precision! } - const bits_dc_luminance : array[0..17-1] of UINT8 = - ({ 0-base } 0, 0, 1, 5, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0); - const val_dc_luminance : array[0..11] of UINT8 = - (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11); - - const bits_dc_chrominance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 ); - const val_dc_chrominance : array[0..11] of UINT8 = - ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 ); - - const bits_ac_luminance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 2, 1, 3, 3, 2, 4, 3, 5, 5, 4, 4, 0, 0, 1, $7d ); - const val_ac_luminance : array[0..161] of UINT8 = - ( $01, $02, $03, $00, $04, $11, $05, $12, - $21, $31, $41, $06, $13, $51, $61, $07, - $22, $71, $14, $32, $81, $91, $a1, $08, - $23, $42, $b1, $c1, $15, $52, $d1, $f0, - $24, $33, $62, $72, $82, $09, $0a, $16, - $17, $18, $19, $1a, $25, $26, $27, $28, - $29, $2a, $34, $35, $36, $37, $38, $39, - $3a, $43, $44, $45, $46, $47, $48, $49, - $4a, $53, $54, $55, $56, $57, $58, $59, - $5a, $63, $64, $65, $66, $67, $68, $69, - $6a, $73, $74, $75, $76, $77, $78, $79, - $7a, $83, $84, $85, $86, $87, $88, $89, - $8a, $92, $93, $94, $95, $96, $97, $98, - $99, $9a, $a2, $a3, $a4, $a5, $a6, $a7, - $a8, $a9, $aa, $b2, $b3, $b4, $b5, $b6, - $b7, $b8, $b9, $ba, $c2, $c3, $c4, $c5, - $c6, $c7, $c8, $c9, $ca, $d2, $d3, $d4, - $d5, $d6, $d7, $d8, $d9, $da, $e1, $e2, - $e3, $e4, $e5, $e6, $e7, $e8, $e9, $ea, - $f1, $f2, $f3, $f4, $f5, $f6, $f7, $f8, - $f9, $fa ); - - const bits_ac_chrominance : array[0..17-1] of UINT8 = - ( { 0-base } 0, 0, 2, 1, 2, 4, 4, 3, 4, 7, 5, 4, 4, 0, 1, 2, $77 ); - const val_ac_chrominance : array[0..161] of UINT8 = - ( $00, $01, $02, $03, $11, $04, $05, $21, - $31, $06, $12, $41, $51, $07, $61, $71, - $13, $22, $32, $81, $08, $14, $42, $91, - $a1, $b1, $c1, $09, $23, $33, $52, $f0, - $15, $62, $72, $d1, $0a, $16, $24, $34, - $e1, $25, $f1, $17, $18, $19, $1a, $26, - $27, $28, $29, $2a, $35, $36, $37, $38, - $39, $3a, $43, $44, $45, $46, $47, $48, - $49, $4a, $53, $54, $55, $56, $57, $58, - $59, $5a, $63, $64, $65, $66, $67, $68, - $69, $6a, $73, $74, $75, $76, $77, $78, - $79, $7a, $82, $83, $84, $85, $86, $87, - $88, $89, $8a, $92, $93, $94, $95, $96, - $97, $98, $99, $9a, $a2, $a3, $a4, $a5, - $a6, $a7, $a8, $a9, $aa, $b2, $b3, $b4, - $b5, $b6, $b7, $b8, $b9, $ba, $c2, $c3, - $c4, $c5, $c6, $c7, $c8, $c9, $ca, $d2, - $d3, $d4, $d5, $d6, $d7, $d8, $d9, $da, - $e2, $e3, $e4, $e5, $e6, $e7, $e8, $e9, - $ea, $f2, $f3, $f4, $f5, $f6, $f7, $f8, - $f9, $fa ); -begin - add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[0], - bits_dc_luminance, val_dc_luminance); - add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[0], - bits_ac_luminance, val_ac_luminance); - add_huff_table(cinfo, cinfo^.dc_huff_tbl_ptrs[1], - bits_dc_chrominance, val_dc_chrominance); - add_huff_table(cinfo, cinfo^.ac_huff_tbl_ptrs[1], - bits_ac_chrominance, val_ac_chrominance); -end; - - -{ Default parameter setup for compression. - - Applications that don't choose to use this routine must do their - own setup of all these parameters. Alternately, you can call this - to establish defaults and then alter parameters selectively. This - is the recommended approach since, if we add any new parameters, - your code will still work (they'll be set to reasonable defaults). } - -{GLOBAL} -procedure jpeg_set_defaults (cinfo : j_compress_ptr); -var - i : int; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(J_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { Allocate comp_info array large enough for maximum component count. - Array is made permanent in case application wants to compress - multiple images at same param settings. } - - if (cinfo^.comp_info = NIL) then - cinfo^.comp_info := jpeg_component_info_list_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - MAX_COMPONENTS * SIZEOF(jpeg_component_info)) ); - - { Initialize everything not dependent on the color space } - - cinfo^.data_precision := BITS_IN_JSAMPLE; - { Set up two quantization tables using default quality of 75 } - jpeg_set_quality(cinfo, 75, TRUE); - { Set up two Huffman tables } - std_huff_tables(cinfo); - - { Initialize default arithmetic coding conditioning } - for i := 0 to pred(NUM_ARITH_TBLS) do - begin - cinfo^.arith_dc_L[i] := 0; - cinfo^.arith_dc_U[i] := 1; - cinfo^.arith_ac_K[i] := 5; - end; - - { Default is no multiple-scan output } - cinfo^.scan_info := NIL; - cinfo^.num_scans := 0; - - { Expect normal source image, not raw downsampled data } - cinfo^.raw_data_in := FALSE; - - { Use Huffman coding, not arithmetic coding, by default } - cinfo^.arith_code := FALSE; - - { By default, don't do extra passes to optimize entropy coding } - cinfo^.optimize_coding := FALSE; - { The standard Huffman tables are only valid for 8-bit data precision. - If the precision is higher, force optimization on so that usable - tables will be computed. This test can be removed if default tables - are supplied that are valid for the desired precision. } - - if (cinfo^.data_precision > 8) then - cinfo^.optimize_coding := TRUE; - - { By default, use the simpler non-cosited sampling alignment } - cinfo^.CCIR601_sampling := FALSE; - - { No input smoothing } - cinfo^.smoothing_factor := 0; - - { DCT algorithm preference } - cinfo^.dct_method := JDCT_DEFAULT; - - { No restart markers } - cinfo^.restart_interval := 0; - cinfo^.restart_in_rows := 0; - - { Fill in default JFIF marker parameters. Note that whether the marker - will actually be written is determined by jpeg_set_colorspace. - - By default, the library emits JFIF version code 1.01. - An application that wants to emit JFIF 1.02 extension markers should set - JFIF_minor_version to 2. We could probably get away with just defaulting - to 1.02, but there may still be some decoders in use that will complain - about that; saying 1.01 should minimize compatibility problems. } - - cinfo^.JFIF_major_version := 1; { Default JFIF version = 1.01 } - cinfo^.JFIF_minor_version := 1; - cinfo^.density_unit := 0; { Pixel size is unknown by default } - cinfo^.X_density := 1; { Pixel aspect ratio is square by default } - cinfo^.Y_density := 1; - - { Choose JPEG colorspace based on input space, set defaults accordingly } - - jpeg_default_colorspace(cinfo); -end; - - -{ Select an appropriate JPEG colorspace for in_color_space. } - -{GLOBAL} -procedure jpeg_default_colorspace (cinfo : j_compress_ptr); -begin - case (cinfo^.in_color_space) of - JCS_GRAYSCALE: - jpeg_set_colorspace(cinfo, JCS_GRAYSCALE); - JCS_RGB: - jpeg_set_colorspace(cinfo, JCS_YCbCr); - JCS_YCbCr: - jpeg_set_colorspace(cinfo, JCS_YCbCr); - JCS_CMYK: - jpeg_set_colorspace(cinfo, JCS_CMYK); { By default, no translation } - JCS_YCCK: - jpeg_set_colorspace(cinfo, JCS_YCCK); - JCS_UNKNOWN: - jpeg_set_colorspace(cinfo, JCS_UNKNOWN); - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_IN_COLORSPACE); - end; -end; - - -{ Set the JPEG colorspace, and choose colorspace-dependent default values. } - -{GLOBAL} -procedure jpeg_set_colorspace (cinfo : j_compress_ptr; - colorspace : J_COLOR_SPACE); - { macro } - procedure SET_COMP(index,id,hsamp,vsamp,quant,dctbl,actbl : int); - begin - with cinfo^.comp_info^[index] do - begin - component_id := (id); - h_samp_factor := (hsamp); - v_samp_factor := (vsamp); - quant_tbl_no := (quant); - dc_tbl_no := (dctbl); - ac_tbl_no := (actbl); - end; - end; - -var - ci : int; -begin - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { For all colorspaces, we use Q and Huff tables 0 for luminance components, - tables 1 for chrominance components. } - - cinfo^.jpeg_color_space := colorspace; - - cinfo^.write_JFIF_header := FALSE; { No marker for non-JFIF colorspaces } - cinfo^.write_Adobe_marker := FALSE; { write no Adobe marker by default } - - case (colorspace) of - JCS_GRAYSCALE: - begin - cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } - cinfo^.num_components := 1; - { JFIF specifies component ID 1 } - SET_COMP(0, 1, 1,1, 0, 0,0); - end; - JCS_RGB: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag RGB } - cinfo^.num_components := 3; - SET_COMP(0, $52 { 'R' }, 1,1, 0, 0,0); - SET_COMP(1, $47 { 'G' }, 1,1, 0, 0,0); - SET_COMP(2, $42 { 'B' }, 1,1, 0, 0,0); - end; - JCS_YCbCr: - begin - cinfo^.write_JFIF_header := TRUE; { Write a JFIF marker } - cinfo^.num_components := 3; - { JFIF specifies component IDs 1,2,3 } - { We default to 2x2 subsamples of chrominance } - SET_COMP(0, 1, 2,2, 0, 0,0); - SET_COMP(1, 2, 1,1, 1, 1,1); - SET_COMP(2, 3, 1,1, 1, 1,1); - end; - JCS_CMYK: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag CMYK } - cinfo^.num_components := 4; - SET_COMP(0, $43 { 'C' }, 1,1, 0, 0,0); - SET_COMP(1, $4D { 'M' }, 1,1, 0, 0,0); - SET_COMP(2, $59 { 'Y' }, 1,1, 0, 0,0); - SET_COMP(3, $4B { 'K' }, 1,1, 0, 0,0); - end; - JCS_YCCK: - begin - cinfo^.write_Adobe_marker := TRUE; { write Adobe marker to flag YCCK } - cinfo^.num_components := 4; - SET_COMP(0, 1, 2,2, 0, 0,0); - SET_COMP(1, 2, 1,1, 1, 1,1); - SET_COMP(2, 3, 1,1, 1, 1,1); - SET_COMP(3, 4, 2,2, 0, 0,0); - end; - JCS_UNKNOWN: - begin - cinfo^.num_components := cinfo^.input_components; - if (cinfo^.num_components < 1) - or (cinfo^.num_components > MAX_COMPONENTS) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, - cinfo^.num_components, MAX_COMPONENTS); - for ci := 0 to pred(cinfo^.num_components) do - begin - SET_COMP(ci, ci, 1,1, 0, 0,0); - end; - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - end; -end; - - -{$ifdef C_PROGRESSIVE_SUPPORTED} - -{LOCAL} -function fill_a_scan (scanptr : jpeg_scan_info_ptr; - ci : int; Ss : int; - Se : int; Ah : int; - Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate one scan for specified component } -begin - scanptr^.comps_in_scan := 1; - scanptr^.component_index[0] := ci; - scanptr^.Ss := Ss; - scanptr^.Se := Se; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - fill_a_scan := scanptr; -end; - -{LOCAL} -function fill_scans (scanptr : jpeg_scan_info_ptr; - ncomps : int; - Ss : int; Se : int; - Ah : int; Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate one scan for each component } -var - ci : int; -begin - - for ci := 0 to pred(ncomps) do - begin - scanptr^.comps_in_scan := 1; - scanptr^.component_index[0] := ci; - scanptr^.Ss := Ss; - scanptr^.Se := Se; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - end; - fill_scans := scanptr; -end; - -{LOCAL} -function fill_dc_scans (scanptr : jpeg_scan_info_ptr; - ncomps : int; - Ah : int; Al : int) : jpeg_scan_info_ptr; -{ Support routine: generate interleaved DC scan if possible, else N scans } -var - ci : int; -begin - - if (ncomps <= MAX_COMPS_IN_SCAN) then - begin - { Single interleaved DC scan } - scanptr^.comps_in_scan := ncomps; - for ci := 0 to pred(ncomps) do - scanptr^.component_index[ci] := ci; - scanptr^.Ss := 0; - scanptr^.Se := 0; - scanptr^.Ah := Ah; - scanptr^.Al := Al; - Inc(scanptr); - end - else - begin - { Noninterleaved DC scan for each component } - scanptr := fill_scans(scanptr, ncomps, 0, 0, Ah, Al); - end; - fill_dc_scans := scanptr; -end; - - -{ Create a recommended progressive-JPEG script. - cinfo^.num_components and cinfo^.jpeg_color_space must be correct. } - -{GLOBAL} -procedure jpeg_simple_progression (cinfo : j_compress_ptr); -var - ncomps : int; - nscans : int; - scanptr : jpeg_scan_info_ptr; -begin - ncomps := cinfo^.num_components; - - { Safety check to ensure start_compress not called yet. } - if (cinfo^.global_state <> CSTATE_START) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - { Figure space needed for script. Calculation must match code below! } - if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - { Custom script for YCbCr color images. } - nscans := 10; - end - else - begin - { All-purpose script for other color spaces. } - if (ncomps > MAX_COMPS_IN_SCAN) then - nscans := 6 * ncomps { 2 DC + 4 AC scans per component } - else - nscans := 2 + 4 * ncomps; { 2 DC scans; 4 AC scans per component } - end; - - { Allocate space for script. - We need to put it in the permanent pool in case the application performs - multiple compressions without changing the settings. To avoid a memory - leak if jpeg_simple_progression is called repeatedly for the same JPEG - object, we try to re-use previously allocated space, and we allocate - enough space to handle YCbCr even if initially asked for grayscale. } - - if (cinfo^.script_space = NIL) or (cinfo^.script_space_size < nscans) then - begin - if nscans > 10 then - cinfo^.script_space_size := nscans - else - cinfo^.script_space_size := 10; - - cinfo^.script_space := jpeg_scan_info_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - cinfo^.script_space_size * SIZEOF(jpeg_scan_info)) ); - end; - scanptr := cinfo^.script_space; - - cinfo^.scan_info := scanptr; - cinfo^.num_scans := nscans; - - if (ncomps = 3) and (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - { Custom script for YCbCr color images. } - { Initial DC scan } - scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); - { Initial AC scan: get some luma data out in a hurry } - scanptr := fill_a_scan(scanptr, 0, 1, 5, 0, 2); - { Chroma data is too small to be worth expending many scans on } - scanptr := fill_a_scan(scanptr, 2, 1, 63, 0, 1); - scanptr := fill_a_scan(scanptr, 1, 1, 63, 0, 1); - { Complete spectral selection for luma AC } - scanptr := fill_a_scan(scanptr, 0, 6, 63, 0, 2); - { Refine next bit of luma AC } - scanptr := fill_a_scan(scanptr, 0, 1, 63, 2, 1); - { Finish DC successive approximation } - scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); - { Finish AC successive approximation } - scanptr := fill_a_scan(scanptr, 2, 1, 63, 1, 0); - scanptr := fill_a_scan(scanptr, 1, 1, 63, 1, 0); - { Luma bottom bit comes last since it's usually largest scan } - scanptr := fill_a_scan(scanptr, 0, 1, 63, 1, 0); - end - else - begin - { All-purpose script for other color spaces. } - { Successive approximation first pass } - scanptr := fill_dc_scans(scanptr, ncomps, 0, 1); - scanptr := fill_scans(scanptr, ncomps, 1, 5, 0, 2); - scanptr := fill_scans(scanptr, ncomps, 6, 63, 0, 2); - { Successive approximation second pass } - scanptr := fill_scans(scanptr, ncomps, 1, 63, 2, 1); - { Successive approximation final pass } - scanptr := fill_dc_scans(scanptr, ncomps, 1, 0); - scanptr := fill_scans(scanptr, ncomps, 1, 63, 1, 0); - end; -end; - -{$endif} -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcphuff.pas b/3rd/Imaging/Source/JpegLib/imjcphuff.pas deleted file mode 100644 index 2b779ef51..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcphuff.pas +++ /dev/null @@ -1,962 +0,0 @@ -unit imjcphuff; - -{ This file contains Huffman entropy encoding routines for progressive JPEG. - - We do not support output suspension in this module, since the library - currently does not allow multiple-scan files to be written with output - suspension. } - -{ Original: jcphuff.c; Copyright (C) 1995-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjcomapi, - imjchuff; { Declarations shared with jchuff.c } - -{ Module initialization routine for progressive Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_phuff_encoder (cinfo : j_compress_ptr); - -implementation - -{ Expanded entropy encoder object for progressive Huffman encoding. } -type - phuff_entropy_ptr = ^phuff_entropy_encoder; - phuff_entropy_encoder = record - pub : jpeg_entropy_encoder; { public fields } - - { Mode flag: TRUE for optimization, FALSE for actual data output } - gather_statistics : boolean; - - { Bit-level coding status. - next_output_byte/free_in_buffer are local copies of cinfo^.dest fields.} - - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - put_buffer : INT32; { current bit-accumulation buffer } - put_bits : int; { # of bits now in it } - cinfo : j_compress_ptr; { link to cinfo (needed for dump_buffer) } - - { Coding status for DC components } - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - - { Coding status for AC components } - ac_tbl_no : int; { the table number of the single component } - EOBRUN : uInt; { run length of EOBs } - BE : uInt; { # of buffered correction bits before MCU } - bit_buffer : JBytePtr; { buffer for correction bits (1 per char) } - { packing correction bits tightly would save some space but cost time... } - - restarts_to_go : uInt; { MCUs left in this restart interval } - next_restart_num : int; { next restart number to write (0-7) } - - { Pointers to derived tables (these workspaces have image lifespan). - Since any one scan codes only DC or only AC, we only need one set - of tables, not one for DC and one for AC. } - - derived_tbls : array[0..NUM_HUFF_TBLS-1] of c_derived_tbl_ptr; - - { Statistics tables for optimization; again, one set is enough } - count_ptrs : array[0..NUM_HUFF_TBLS-1] of TLongTablePtr; - end; - - -{ MAX_CORR_BITS is the number of bits the AC refinement correction-bit - buffer can hold. Larger sizes may slightly improve compression, but - 1000 is already well into the realm of overkill. - The minimum safe size is 64 bits. } - -const - MAX_CORR_BITS = 1000; { Max # of correction bits I can buffer } - - -{ Forward declarations } -{METHODDEF} -function encode_mcu_DC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_AC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_DC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function encode_mcu_AC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - forward; - -{METHODDEF} -procedure finish_pass_phuff (cinfo : j_compress_ptr); forward; - -{METHODDEF} -procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); forward; - - -{ Initialize for a Huffman-compressed scan using progressive JPEG. } - -{METHODDEF} -procedure start_pass_phuff (cinfo : j_compress_ptr; - gather_statistics : boolean); -var - entropy : phuff_entropy_ptr; - is_DC_band : boolean; - ci, tbl : int; - compptr : jpeg_component_info_ptr; -begin - tbl := 0; - entropy := phuff_entropy_ptr (cinfo^.entropy); - - entropy^.cinfo := cinfo; - entropy^.gather_statistics := gather_statistics; - - is_DC_band := (cinfo^.Ss = 0); - - { We assume jcmaster.c already validated the scan parameters. } - - { Select execution routines } - if (cinfo^.Ah = 0) then - begin - if (is_DC_band) then - entropy^.pub.encode_mcu := encode_mcu_DC_first - else - entropy^.pub.encode_mcu := encode_mcu_AC_first; - end - else - begin - if (is_DC_band) then - entropy^.pub.encode_mcu := encode_mcu_DC_refine - else - begin - entropy^.pub.encode_mcu := encode_mcu_AC_refine; - { AC refinement needs a correction bit buffer } - if (entropy^.bit_buffer = NIL) then - entropy^.bit_buffer := JBytePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - MAX_CORR_BITS * SIZEOF(byte)) ); - end; - end; - if (gather_statistics) then - entropy^.pub.finish_pass := finish_pass_gather_phuff - else - entropy^.pub.finish_pass := finish_pass_phuff; - - { Only DC coefficients may be interleaved, so cinfo^.comps_in_scan = 1 - for AC coefficients. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Initialize DC predictions to 0 } - entropy^.last_dc_val[ci] := 0; - { Get table index } - if (is_DC_band) then - begin - if (cinfo^.Ah <> 0) then { DC refinement needs no table } - continue; - tbl := compptr^.dc_tbl_no; - end - else - begin - tbl := compptr^.ac_tbl_no; - entropy^.ac_tbl_no := tbl; - end; - if (gather_statistics) then - begin - { Check for invalid table index } - { (make_c_derived_tbl does this in the other path) } - if (tbl < 0) or (tbl >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tbl); - { Allocate and zero the statistics tables } - { Note that jpeg_gen_optimal_table expects 257 entries in each table! } - if (entropy^.count_ptrs[tbl] = NIL) then - entropy^.count_ptrs[tbl] := TLongTablePtr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 257 * SIZEOF(long)) ); - MEMZERO(entropy^.count_ptrs[tbl], 257 * SIZEOF(long)); - end else - begin - { Compute derived values for Huffman table } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_c_derived_tbl(cinfo, is_DC_band, tbl, - entropy^.derived_tbls[tbl]); - end; - end; - - { Initialize AC stuff } - entropy^.EOBRUN := 0; - entropy^.BE := 0; - - { Initialize bit buffer to empty } - entropy^.put_buffer := 0; - entropy^.put_bits := 0; - - { Initialize restart stuff } - entropy^.restarts_to_go := cinfo^.restart_interval; - entropy^.next_restart_num := 0; -end; - - - - -{LOCAL} -procedure dump_buffer (entropy : phuff_entropy_ptr); -{ Empty the output buffer; we do not support suspension in this module. } -var - dest : jpeg_destination_mgr_ptr; -begin - dest := entropy^.cinfo^.dest; - - if (not dest^.empty_output_buffer (entropy^.cinfo)) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_CANT_SUSPEND); - { After a successful buffer dump, must reset buffer pointers } - entropy^.next_output_byte := dest^.next_output_byte; - entropy^.free_in_buffer := dest^.free_in_buffer; -end; - - -{ Outputting bits to the file } - -{ Only the right 24 bits of put_buffer are used; the valid bits are - left-justified in this part. At most 16 bits can be passed to emit_bits - in one call, and we never retain more than 7 bits in put_buffer - between calls, so 24 bits are sufficient. } - - -{LOCAL} -procedure emit_bits (entropy : phuff_entropy_ptr; - code : uInt; - size : int); {INLINE} -{ Emit some bits, unless we are in gather mode } -var - {register} put_buffer : INT32; - {register} put_bits : int; -var - c : int; -begin - { This routine is heavily used, so it's worth coding tightly. } - put_buffer := INT32 (code); - put_bits := entropy^.put_bits; - - { if size is 0, caller used an invalid Huffman table entry } - if (size = 0) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); - - if (entropy^.gather_statistics) then - exit; { do nothing if we're only getting stats } - - put_buffer := put_buffer and ((INT32(1) shl size) - 1); - { mask off any extra bits in code } - - Inc(put_bits, size); { new number of bits in buffer } - - put_buffer := put_buffer shl (24 - put_bits); { align incoming bits } - - put_buffer := put_buffer or entropy^.put_buffer; - { and merge with old buffer contents } - - while (put_bits >= 8) do - begin - c := int ((put_buffer shr 16) and $FF); - - {emit_byte(entropy, c);} - { Outputting bytes to the file. - NB: these must be called only when actually outputting, - that is, entropy^.gather_statistics = FALSE. } - { Emit a byte } - entropy^.next_output_byte^ := JOCTET(c); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - - if (c = $FF) then - begin { need to stuff a zero byte? } - {emit_byte(entropy, 0);} - entropy^.next_output_byte^ := JOCTET(0); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - end; - put_buffer := put_buffer shl 8; - Dec(put_bits, 8); - end; - - entropy^.put_buffer := put_buffer; { update variables } - entropy^.put_bits := put_bits; -end; - - -{LOCAL} -procedure flush_bits (entropy : phuff_entropy_ptr); -begin - emit_bits(entropy, $7F, 7); { fill any partial byte with ones } - entropy^.put_buffer := 0; { and reset bit-buffer to empty } - entropy^.put_bits := 0; -end; - -{ Emit (or just count) a Huffman symbol. } - - -{LOCAL} -procedure emit_symbol (entropy : phuff_entropy_ptr; - tbl_no : int; - symbol : int); {INLINE} -var - tbl : c_derived_tbl_ptr; -begin - if (entropy^.gather_statistics) then - Inc(entropy^.count_ptrs[tbl_no]^[symbol]) - else - begin - tbl := entropy^.derived_tbls[tbl_no]; - emit_bits(entropy, tbl^.ehufco[symbol], tbl^.ehufsi[symbol]); - end; -end; - - -{ Emit bits from a correction bit buffer. } - -{LOCAL} -procedure emit_buffered_bits (entropy : phuff_entropy_ptr; - bufstart : JBytePtr; - nbits : uInt); -var - bufptr : byteptr; -begin - if (entropy^.gather_statistics) then - exit; { no real work } - - bufptr := byteptr(bufstart); - while (nbits > 0) do - begin - emit_bits(entropy, uInt(bufptr^), 1); - Inc(bufptr); - Dec(nbits); - end; -end; - - -{ Emit any pending EOBRUN symbol. } - -{LOCAL} -procedure emit_eobrun (entropy : phuff_entropy_ptr); -var - {register} temp, nbits : int; -begin - if (entropy^.EOBRUN > 0) then - begin { if there is any pending EOBRUN } - temp := entropy^.EOBRUN; - nbits := 0; - temp := temp shr 1; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { safety check: shouldn't happen given limited correction-bit buffer } - if (nbits > 14) then - ERREXIT(j_common_ptr(entropy^.cinfo), JERR_HUFF_MISSING_CODE); - - emit_symbol(entropy, entropy^.ac_tbl_no, nbits shl 4); - if (nbits <> 0) then - emit_bits(entropy, entropy^.EOBRUN, nbits); - - entropy^.EOBRUN := 0; - - { Emit any buffered correction bits } - emit_buffered_bits(entropy, entropy^.bit_buffer, entropy^.BE); - entropy^.BE := 0; - end; -end; - - -{ Emit a restart marker & resynchronize predictions. } - -{LOCAL} -procedure emit_restart (entropy : phuff_entropy_ptr; - restart_num : int); -var - ci : int; -begin - emit_eobrun(entropy); - - if (not entropy^.gather_statistics) then - begin - flush_bits(entropy); - {emit_byte(entropy, $FF);} - { Outputting bytes to the file. - NB: these must be called only when actually outputting, - that is, entropy^.gather_statistics = FALSE. } - - entropy^.next_output_byte^ := JOCTET($FF); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - - {emit_byte(entropy, JPEG_RST0 + restart_num);} - entropy^.next_output_byte^ := JOCTET(JPEG_RST0 + restart_num); - Inc(entropy^.next_output_byte); - Dec(entropy^.free_in_buffer); - if (entropy^.free_in_buffer = 0) then - dump_buffer(entropy); - end; - - if (entropy^.cinfo^.Ss = 0) then - begin - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(entropy^.cinfo^.comps_in_scan) do - entropy^.last_dc_val[ci] := 0; - end - else - begin - { Re-initialize all AC-related fields to 0 } - entropy^.EOBRUN := 0; - entropy^.BE := 0; - end; -end; - - -{ MCU encoding for DC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function encode_mcu_DC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp, temp2 : int; - {register} nbits : int; - blkn, ci : int; - Al : int; - block : JBLOCK_PTR; - compptr : jpeg_component_info_ptr; - ishift_temp : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - - { Compute the DC value after the required point transform by Al. - This is simply an arithmetic right shift. } - - {temp2 := IRIGHT_SHIFT( int(block^[0]), Al);} - {IRIGHT_SHIFT_IS_UNSIGNED} - ishift_temp := int(block^[0]); - if ishift_temp < 0 then - temp2 := (ishift_temp shr Al) or ((not 0) shl (16-Al)) - else - temp2 := ishift_temp shr Al; - - - { DC differences are figured on the point-transformed values. } - temp := temp2 - entropy^.last_dc_val[ci]; - entropy^.last_dc_val[ci] := temp2; - - { Encode the DC coefficient difference per section G.1.2.1 } - temp2 := temp; - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - { For a negative input, want temp2 := bitwise complement of abs(input) } - { This code assumes we are on a two's complement machine } - Dec(temp2); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; - while (temp <> 0) do - begin - Inc(nbits); - temp := temp shr 1; - end; - - { Check for out-of-range coefficient values. - Since we're encoding a difference, the range limit is twice as much. } - - if (nbits > MAX_COEF_BITS+1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count/emit the Huffman-coded symbol for the number of bits } - emit_symbol(entropy, compptr^.dc_tbl_no, nbits); - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - if (nbits <> 0) then { emit_bits rejects calls with size 0 } - emit_bits(entropy, uInt(temp2), nbits); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_DC_first := TRUE; -end; - - -{ MCU encoding for AC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function encode_mcu_AC_first (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp, temp2 : int; - {register} nbits : int; - {register} r, k : int; - Se : int; - Al : int; - block : JBLOCK_PTR; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data block } - block := JBLOCK_PTR(MCU_data[0]); - - { Encode the AC coefficients per section G.1.2.2, fig. G.3 } - - r := 0; { r := run length of zeros } - - for k := cinfo^.Ss to Se do - begin - temp := (block^[jpeg_natural_order[k]]); - if (temp = 0) then - begin - Inc(r); - continue; - end; - { We must apply the point transform by Al. For AC coefficients this - is an integer division with rounding towards 0. To do this portably - in C, we shift after obtaining the absolute value; so the code is - interwoven with finding the abs value (temp) and output bits (temp2). } - - if (temp < 0) then - begin - temp := -temp; { temp is abs value of input } - temp := temp shr Al; { apply the point transform } - { For a negative coef, want temp2 := bitwise complement of abs(coef) } - temp2 := not temp; - end - else - begin - temp := temp shr Al; { apply the point transform } - temp2 := temp; - end; - { Watch out for case that nonzero coef is zero after point transform } - if (temp = 0) then - begin - Inc(r); - continue; - end; - - { Emit any pending EOBRUN } - if (entropy^.EOBRUN > 0) then - emit_eobrun(entropy); - { if run length > 15, must emit special run-length-16 codes ($F0) } - while (r > 15) do - begin - emit_symbol(entropy, entropy^.ac_tbl_no, $F0); - Dec(r, 16); - end; - - { Find the number of bits needed for the magnitude of the coefficient } - nbits := 0; { there must be at least one 1 bit } - repeat - Inc(nbits); - temp := temp shr 1; - until (temp = 0); - - { Check for out-of-range coefficient values } - if (nbits > MAX_COEF_BITS) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_DCT_COEF); - - { Count/emit Huffman symbol for run length / number of bits } - emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + nbits); - - { Emit that number of bits of the value, if positive, } - { or the complement of its magnitude, if negative. } - emit_bits(entropy, uInt(temp2), nbits); - - r := 0; { reset zero run length } - end; - - if (r > 0) then - begin { If there are trailing zeroes, } - Inc(entropy^.EOBRUN); { count an EOB } - if (entropy^.EOBRUN = $7FFF) then - emit_eobrun(entropy); { force it out to avoid overflow } - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_AC_first := TRUE; -end; - - -{ MCU encoding for DC successive approximation refinement scan. - Note: we assume such scans can be multi-component, although the spec - is not very clear on the point. } - -{METHODDEF} -function encode_mcu_DC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; -var - entropy : phuff_entropy_ptr; - {register} temp : int; - blkn : int; - Al : int; - block : JBLOCK_PTR; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data blocks } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - - { We simply emit the Al'th bit of the DC coefficient value. } - temp := block^[0]; - emit_bits(entropy, uInt(temp shr Al), 1); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_DC_refine := TRUE; -end; - - -{ MCU encoding for AC successive approximation refinement scan. } - -{METHODDEF} -function encode_mcu_AC_refine (cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - -var - entropy : phuff_entropy_ptr; - {register} temp : int; - {register} r, k : int; - EOB : int; - BR_buffer : JBytePtr; - BR : uInt; - Se : int; - Al : int; - block : JBLOCK_PTR; - absvalues : array[0..DCTSIZE2-1] of int; -begin - entropy := phuff_entropy_ptr(cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Emit restart marker if needed } - if (cinfo^.restart_interval <> 0) then - if (entropy^.restarts_to_go = 0) then - emit_restart(entropy, entropy^.next_restart_num); - - { Encode the MCU data block } - block := JBLOCK_PTR(MCU_data[0]); - - { It is convenient to make a pre-pass to determine the transformed - coefficients' absolute values and the EOB position. } - - EOB := 0; - for k := cinfo^.Ss to Se do - begin - temp := block^[jpeg_natural_order[k]]; - { We must apply the point transform by Al. For AC coefficients this - is an integer division with rounding towards 0. To do this portably - in C, we shift after obtaining the absolute value. } - - if (temp < 0) then - temp := -temp; { temp is abs value of input } - temp := temp shr Al; { apply the point transform } - absvalues[k] := temp; { save abs value for main pass } - if (temp = 1) then - EOB := k; { EOB := index of last newly-nonzero coef } - end; - - { Encode the AC coefficients per section G.1.2.3, fig. G.7 } - - r := 0; { r := run length of zeros } - BR := 0; { BR := count of buffered bits added now } - BR_buffer := JBytePtr(@(entropy^.bit_buffer^[entropy^.BE])); - { Append bits to buffer } - - for k := cinfo^.Ss to Se do - begin - temp := absvalues[k]; - if (temp = 0) then - begin - Inc(r); - continue; - end; - - { Emit any required ZRLs, but not if they can be folded into EOB } - while (r > 15) and (k <= EOB) do - begin - { emit any pending EOBRUN and the BE correction bits } - emit_eobrun(entropy); - { Emit ZRL } - emit_symbol(entropy, entropy^.ac_tbl_no, $F0); - Dec(r, 16); - { Emit buffered correction bits that must be associated with ZRL } - emit_buffered_bits(entropy, BR_buffer, BR); - BR_buffer := entropy^.bit_buffer; { BE bits are gone now } - BR := 0; - end; - - { If the coef was previously nonzero, it only needs a correction bit. - NOTE: a straight translation of the spec's figure G.7 would suggest - that we also need to test r > 15. But if r > 15, we can only get here - if k > EOB, which implies that this coefficient is not 1. } - if (temp > 1) then - begin - { The correction bit is the next bit of the absolute value. } - BR_buffer^[BR] := byte (temp and 1); - Inc(BR); - continue; - end; - - { Emit any pending EOBRUN and the BE correction bits } - emit_eobrun(entropy); - - { Count/emit Huffman symbol for run length / number of bits } - emit_symbol(entropy, entropy^.ac_tbl_no, (r shl 4) + 1); - - { Emit output bit for newly-nonzero coef } - if (block^[jpeg_natural_order[k]] < 0) then - temp := 0 - else - temp := 1; - emit_bits(entropy, uInt(temp), 1); - - { Emit buffered correction bits that must be associated with this code } - emit_buffered_bits(entropy, BR_buffer, BR); - BR_buffer := entropy^.bit_buffer; { BE bits are gone now } - BR := 0; - r := 0; { reset zero run length } - end; - - if (r > 0) or (BR > 0) then - begin { If there are trailing zeroes, } - Inc(entropy^.EOBRUN); { count an EOB } - Inc(entropy^.BE, BR); { concat my correction bits to older ones } - { We force out the EOB if we risk either: - 1. overflow of the EOB counter; - 2. overflow of the correction bit buffer during the next MCU. } - - if (entropy^.EOBRUN = $7FFF) or - (entropy^.BE > (MAX_CORR_BITS-DCTSIZE2+1)) then - emit_eobrun(entropy); - end; - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; - - { Update restart-interval state too } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - begin - entropy^.restarts_to_go := cinfo^.restart_interval; - Inc(entropy^.next_restart_num); - with entropy^ do - next_restart_num := next_restart_num and 7; - end; - Dec(entropy^.restarts_to_go); - end; - - encode_mcu_AC_refine := TRUE; -end; - - -{ Finish up at the end of a Huffman-compressed progressive scan. } - -{METHODDEF} -procedure finish_pass_phuff (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - entropy^.next_output_byte := cinfo^.dest^.next_output_byte; - entropy^.free_in_buffer := cinfo^.dest^.free_in_buffer; - - { Flush out any buffered data } - emit_eobrun(entropy); - flush_bits(entropy); - - cinfo^.dest^.next_output_byte := entropy^.next_output_byte; - cinfo^.dest^.free_in_buffer := entropy^.free_in_buffer; -end; - - -{ Finish up a statistics-gathering pass and create the new Huffman tables. } - -{METHODDEF} -procedure finish_pass_gather_phuff (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; - is_DC_band : boolean; - ci, tbl : int; - compptr : jpeg_component_info_ptr; - htblptr : ^JHUFF_TBL_PTR; - did : array[0..NUM_HUFF_TBLS-1] of boolean; -begin - tbl := 0; - entropy := phuff_entropy_ptr (cinfo^.entropy); - - { Flush out buffered data (all we care about is counting the EOB symbol) } - emit_eobrun(entropy); - - is_DC_band := (cinfo^.Ss = 0); - - { It's important not to apply jpeg_gen_optimal_table more than once - per table, because it clobbers the input frequency counts! } - - MEMZERO(@did, SIZEOF(did)); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - if (is_DC_band) then - begin - if (cinfo^.Ah <> 0) then { DC refinement needs no table } - continue; - tbl := compptr^.dc_tbl_no; - end - else - begin - tbl := compptr^.ac_tbl_no; - end; - if (not did[tbl]) then - begin - if (is_DC_band) then - htblptr := @(cinfo^.dc_huff_tbl_ptrs[tbl]) - else - htblptr := @(cinfo^.ac_huff_tbl_ptrs[tbl]); - if (htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - jpeg_gen_optimal_table(cinfo, htblptr^, entropy^.count_ptrs[tbl]^); - did[tbl] := TRUE; - end; - end; -end; - - -{ Module initialization routine for progressive Huffman entropy encoding. } - -{GLOBAL} -procedure jinit_phuff_encoder (cinfo : j_compress_ptr); -var - entropy : phuff_entropy_ptr; - i : int; -begin - entropy := phuff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(phuff_entropy_encoder)) ); - cinfo^.entropy := jpeg_entropy_encoder_ptr(entropy); - entropy^.pub.start_pass := start_pass_phuff; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.derived_tbls[i] := NIL; - entropy^.count_ptrs[i] := NIL; - end; - entropy^.bit_buffer := NIL; { needed only in AC refinement scan } -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcprepct.pas b/3rd/Imaging/Source/JpegLib/imjcprepct.pas deleted file mode 100644 index 97506527f..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcprepct.pas +++ /dev/null @@ -1,406 +0,0 @@ -unit imjcprepct; - -{ Original : jcprepct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file contains the compression preprocessing controller. - This controller manages the color conversion, downsampling, - and edge expansion steps. - - Most of the complexity here is associated with buffering input rows - as required by the downsampler. See the comments at the head of - jcsample.c for the downsampler's needs. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjpeglib, - imjdeferr, - imjerror, - imjinclude, - imjutils; - -{GLOBAL} -procedure jinit_c_prep_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); - -implementation - - -{ At present, jcsample.c can request context rows only for smoothing. - In the future, we might also need context rows for CCIR601 sampling - or other more-complex downsampling procedures. The code to support - context rows should be compiled only if needed. } - -{$ifdef INPUT_SMOOTHING_SUPPORTED} - {$define CONTEXT_ROWS_SUPPORTED} -{$endif} - - -{ For the simple (no-context-row) case, we just need to buffer one - row group's worth of pixels for the downsampling step. At the bottom of - the image, we pad to a full row group by replicating the last pixel row. - The downsampler's last output row is then replicated if needed to pad - out to a full iMCU row. - - When providing context rows, we must buffer three row groups' worth of - pixels. Three row groups are physically allocated, but the row pointer - arrays are made five row groups high, with the extra pointers above and - below "wrapping around" to point to the last and first real row groups. - This allows the downsampler to access the proper context rows. - At the top and bottom of the image, we create dummy context rows by - copying the first or last real pixel row. This copying could be avoided - by pointer hacking as is done in jdmainct.c, but it doesn't seem worth the - trouble on the compression side. } - - -{ Private buffer controller object } - -type - my_prep_ptr = ^my_prep_controller; - my_prep_controller = record - pub : jpeg_c_prep_controller; { public fields } - - { Downsampling input buffer. This buffer holds color-converted data - until we have enough to do a downsample step. } - - color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - rows_to_go : JDIMENSION; { counts rows remaining in source image } - next_buf_row : int; { index of next row to store in color_buf } - - {$ifdef CONTEXT_ROWS_SUPPORTED} { only needed for context case } - this_row_group : int; { starting row index of group to process } - next_buf_stop : int; { downsample when we reach this index } - {$endif} - end; {my_prep_controller;} - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_prep (cinfo : j_compress_ptr; - pass_mode : J_BUF_MODE ); -var - prep : my_prep_ptr; -begin - prep := my_prep_ptr (cinfo^.prep); - - if (pass_mode <> JBUF_PASS_THRU) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - - { Initialize total-height counter for detecting bottom of image } - prep^.rows_to_go := cinfo^.image_height; - { Mark the conversion buffer empty } - prep^.next_buf_row := 0; -{$ifdef CONTEXT_ROWS_SUPPORTED} - { Preset additional state variables for context mode. - These aren't used in non-context mode, so we needn't test which mode. } - prep^.this_row_group := 0; - { Set next_buf_stop to stop after two row groups have been read in. } - prep^.next_buf_stop := 2 * cinfo^.max_v_samp_factor; -{$endif} -end; - - -{ Expand an image vertically from height input_rows to height output_rows, - by duplicating the bottom row. } - -{LOCAL} -procedure expand_bottom_edge (image_data : JSAMPARRAY; - num_cols : JDIMENSION; - input_rows : int; - output_rows : int); -var - {register} row : int; -begin - for row := input_rows to pred(output_rows) do - begin - jcopy_sample_rows(image_data, input_rows-1, image_data, row, - 1, num_cols); - end; -end; - - -{ Process some data in the simple no-context case. - - Preprocessor output data is counted in "row groups". A row group - is defined to be v_samp_factor sample rows of each component. - Downsampling will produce this much data from each max_v_samp_factor - input rows. } - -{METHODDEF} -procedure pre_process_data (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION; - output_buf : JSAMPIMAGE; - var out_row_group_ctr : JDIMENSION; - out_row_groups_avail : JDIMENSION); -var - prep : my_prep_ptr; - numrows, ci : int; - inrows : JDIMENSION; - compptr : jpeg_component_info_ptr; -var - local_input_buf : JSAMPARRAY; -begin - prep := my_prep_ptr (cinfo^.prep); - - while (in_row_ctr < in_rows_avail) and - (out_row_group_ctr < out_row_groups_avail) do - begin - { Do color conversion to fill the conversion buffer. } - inrows := in_rows_avail - in_row_ctr; - numrows := cinfo^.max_v_samp_factor - prep^.next_buf_row; - {numrows := int( MIN(JDIMENSION(numrows), inrows) );} - if inrows < JDIMENSION(numrows) then - numrows := int(inrows); - local_input_buf := JSAMPARRAY(@(input_buf^[in_row_ctr])); - cinfo^.cconvert^.color_convert (cinfo, local_input_buf, - JSAMPIMAGE(@prep^.color_buf), - JDIMENSION(prep^.next_buf_row), - numrows); - Inc(in_row_ctr, numrows); - Inc(prep^.next_buf_row, numrows); - Dec(prep^.rows_to_go, numrows); - { If at bottom of image, pad to fill the conversion buffer. } - if (prep^.rows_to_go = 0) and - (prep^.next_buf_row < cinfo^.max_v_samp_factor) then - begin - for ci := 0 to pred(cinfo^.num_components) do - begin - expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width, - prep^.next_buf_row, cinfo^.max_v_samp_factor); - end; - prep^.next_buf_row := cinfo^.max_v_samp_factor; - end; - { If we've filled the conversion buffer, empty it. } - if (prep^.next_buf_row = cinfo^.max_v_samp_factor) then - begin - cinfo^.downsample^.downsample (cinfo, - JSAMPIMAGE(@prep^.color_buf), - JDIMENSION (0), - output_buf, - out_row_group_ctr); - prep^.next_buf_row := 0; - Inc(out_row_group_ctr);; - end; - { If at bottom of image, pad the output to a full iMCU height. - Note we assume the caller is providing a one-iMCU-height output buffer! } - if (prep^.rows_to_go = 0) and - (out_row_group_ctr < out_row_groups_avail) then - begin - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - expand_bottom_edge(output_buf^[ci], - compptr^.width_in_blocks * DCTSIZE, - int (out_row_group_ctr) * compptr^.v_samp_factor, - int (out_row_groups_avail) * compptr^.v_samp_factor); - Inc(compptr); - end; - out_row_group_ctr := out_row_groups_avail; - break; { can exit outer loop without test } - end; - end; -end; - - -{$ifdef CONTEXT_ROWS_SUPPORTED} - -{ Process some data in the context case. } - -{METHODDEF} -procedure pre_process_context (cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION; - output_buf : JSAMPIMAGE; - var out_row_group_ctr : JDIMENSION; - out_row_groups_avail : JDIMENSION); -var - prep : my_prep_ptr; - numrows, ci : int; - buf_height : int; - inrows : JDIMENSION; -var - row : int; - -begin - prep := my_prep_ptr (cinfo^.prep); - buf_height := cinfo^.max_v_samp_factor * 3; - - while (out_row_group_ctr < out_row_groups_avail) do - begin - if (in_row_ctr < in_rows_avail) then - begin - { Do color conversion to fill the conversion buffer. } - inrows := in_rows_avail - in_row_ctr; - numrows := prep^.next_buf_stop - prep^.next_buf_row; - {numrows := int ( MIN( JDIMENSION(numrows), inrows) );} - if inrows < JDIMENSION(numrows) then - numrows := int(inrows); - cinfo^.cconvert^.color_convert (cinfo, - JSAMPARRAY(@input_buf^[in_row_ctr]), - JSAMPIMAGE(@prep^.color_buf), - JDIMENSION (prep^.next_buf_row), - numrows); - { Pad at top of image, if first time through } - if (prep^.rows_to_go = cinfo^.image_height) then - begin - for ci := 0 to pred(cinfo^.num_components) do - begin - for row := 1 to cinfo^.max_v_samp_factor do - begin - jcopy_sample_rows(prep^.color_buf[ci], 0, - prep^.color_buf[ci], -row, - 1, cinfo^.image_width); - end; - end; - end; - Inc(in_row_ctr, numrows); - Inc(prep^.next_buf_row, numrows); - Dec(prep^.rows_to_go, numrows); - end - else - begin - { Return for more data, unless we are at the bottom of the image. } - if (prep^.rows_to_go <> 0) then - break; - { When at bottom of image, pad to fill the conversion buffer. } - if (prep^.next_buf_row < prep^.next_buf_stop) then - begin - for ci := 0 to pred(cinfo^.num_components) do - begin - expand_bottom_edge(prep^.color_buf[ci], cinfo^.image_width, - prep^.next_buf_row, prep^.next_buf_stop); - end; - prep^.next_buf_row := prep^.next_buf_stop; - end; - end; - { If we've gotten enough data, downsample a row group. } - if (prep^.next_buf_row = prep^.next_buf_stop) then - begin - cinfo^.downsample^.downsample (cinfo, - JSAMPIMAGE(@prep^.color_buf), - JDIMENSION(prep^.this_row_group), - output_buf, - out_row_group_ctr); - Inc(out_row_group_ctr); - { Advance pointers with wraparound as necessary. } - Inc(prep^.this_row_group, cinfo^.max_v_samp_factor); - if (prep^.this_row_group >= buf_height) then - prep^.this_row_group := 0; - if (prep^.next_buf_row >= buf_height) then - prep^.next_buf_row := 0; - prep^.next_buf_stop := prep^.next_buf_row + cinfo^.max_v_samp_factor; - end; - end; -end; - - -{ Create the wrapped-around downsampling input buffer needed for context mode. } - -{LOCAL} -procedure create_context_buffer (cinfo : j_compress_ptr); -var - prep : my_prep_ptr; - rgroup_height : int; - ci, i : int; - compptr : jpeg_component_info_ptr; - true_buffer, fake_buffer : JSAMPARRAY; -begin - prep := my_prep_ptr (cinfo^.prep); - rgroup_height := cinfo^.max_v_samp_factor; - { Grab enough space for fake row pointers for all the components; - we need five row groups' worth of pointers for each component. } - - fake_buffer := JSAMPARRAY( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - (cinfo^.num_components * 5 * rgroup_height) * - SIZEOF(JSAMPROW)) ); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Allocate the actual buffer space (3 row groups) for this component. - We make the buffer wide enough to allow the downsampler to edge-expand - horizontally within the buffer, if it so chooses. } - true_buffer := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE * - cinfo^.max_h_samp_factor) div compptr^.h_samp_factor), - JDIMENSION (3 * rgroup_height)); - { Copy true buffer row pointers into the middle of the fake row array } - MEMCOPY(JSAMPARRAY(@ fake_buffer^[rgroup_height]), true_buffer, - 3 * rgroup_height * SIZEOF(JSAMPROW)); - { Fill in the above and below wraparound pointers } - for i := 0 to pred(rgroup_height) do - begin - fake_buffer^[i] := true_buffer^[2 * rgroup_height + i]; - fake_buffer^[4 * rgroup_height + i] := true_buffer^[i]; - end; - prep^.color_buf[ci] := JSAMPARRAY(@ fake_buffer^[rgroup_height]); - Inc(JSAMPROW_PTR(fake_buffer), 5 * rgroup_height); { point to space for next component } - Inc(compptr); - end; -end; - -{$endif} { CONTEXT_ROWS_SUPPORTED } - - -{ Initialize preprocessing controller. } - -{GLOBAL} -procedure jinit_c_prep_controller (cinfo : j_compress_ptr; - need_full_buffer : boolean); -var - prep : my_prep_ptr; - ci : int; - compptr : jpeg_component_info_ptr; -begin - - if (need_full_buffer) then { safety check } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - - prep := my_prep_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_prep_controller)) ); - cinfo^.prep := jpeg_c_prep_controller_ptr(prep); - prep^.pub.start_pass := start_pass_prep; - - { Allocate the color conversion buffer. - We make the buffer wide enough to allow the downsampler to edge-expand - horizontally within the buffer, if it so chooses. } - - if (cinfo^.downsample^.need_context_rows) then - begin - { Set up to provide context rows } -{$ifdef CONTEXT_ROWS_SUPPORTED} - prep^.pub.pre_process_data := pre_process_context; - create_context_buffer(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - { No context, just make it tall enough for one row group } - prep^.pub.pre_process_data := pre_process_data; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - prep^.color_buf[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION (( long(compptr^.width_in_blocks) * DCTSIZE * - cinfo^.max_h_samp_factor) div compptr^.h_samp_factor), - JDIMENSION(cinfo^.max_v_samp_factor) ); - Inc(compptr); - end; - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjcsample.pas b/3rd/Imaging/Source/JpegLib/imjcsample.pas deleted file mode 100644 index 5be2e8069..000000000 --- a/3rd/Imaging/Source/JpegLib/imjcsample.pas +++ /dev/null @@ -1,631 +0,0 @@ -unit imjcsample; - -{ This file contains downsampling routines. - - Downsampling input data is counted in "row groups". A row group - is defined to be max_v_samp_factor pixel rows of each component, - from which the downsampler produces v_samp_factor sample rows. - A single row group is processed in each call to the downsampler module. - - The downsampler is responsible for edge-expansion of its output data - to fill an integral number of DCT blocks horizontally. The source buffer - may be modified if it is helpful for this purpose (the source buffer is - allocated wide enough to correspond to the desired output width). - The caller (the prep controller) is responsible for vertical padding. - - The downsampler may request "context rows" by setting need_context_rows - during startup. In this case, the input arrays will contain at least - one row group's worth of pixels above and below the passed-in data; - the caller will create dummy rows at image top and bottom by replicating - the first or last real pixel row. - - An excellent reference for image resampling is - Digital Image Warping, George Wolberg, 1990. - Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7. - - The downsampling algorithm used here is a simple average of the source - pixels covered by the output pixel. The hi-falutin sampling literature - refers to this as a "box filter". In general the characteristics of a box - filter are not very good, but for the specific cases we normally use (1:1 - and 2:1 ratios) the box is equivalent to a "triangle filter" which is not - nearly so bad. If you intend to use other sampling ratios, you'd be well - advised to improve this code. - - A simple input-smoothing capability is provided. This is mainly intended - for cleaning up color-dithered GIF input files (if you find it inadequate, - we suggest using an external filtering program such as pnmconvol). When - enabled, each input pixel P is replaced by a weighted sum of itself and its - eight neighbors. P's weight is 1-8*SF and each neighbor's weight is SF, - where SF := (smoothing_factor / 1024). - Currently, smoothing is only supported for 2h2v sampling factors. } - -{ Original: jcsample.c ; Copyright (C) 1991-1996, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjdeferr, - imjerror, - imjpeglib; - - -{ Module initialization routine for downsampling. - Note that we must select a routine for each component. } - -{GLOBAL} -procedure jinit_downsampler (cinfo : j_compress_ptr); - -implementation - -{ Pointer to routine to downsample a single component } -type - downsample1_ptr = procedure(cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); - -{ Private subobject } - -type - my_downsample_ptr = ^my_downsampler; - my_downsampler = record - pub : jpeg_downsampler; { public fields } - - { Downsampling method pointers, one per component } - methods : array[0..MAX_COMPONENTS-1] of downsample1_ptr; - end; - -{ Initialize for a downsampling pass. } - -{METHODDEF} -procedure start_pass_downsample (cinfo : j_compress_ptr); -begin - { no work for now } -end; - - -{ Expand a component horizontally from width input_cols to width output_cols, - by duplicating the rightmost samples. } - -{LOCAL} -procedure expand_right_edge (image_data : JSAMPARRAY; - num_rows : int; - input_cols : JDIMENSION; - output_cols : JDIMENSION); -var - {register} ptr : JSAMPLE_PTR; - {register} pixval : JSAMPLE; - {register} count : int; - row : int; - numcols : int; -begin - numcols := int (output_cols - input_cols); - - if (numcols > 0) then - begin - for row := 0 to pred(num_rows) do - begin - ptr := JSAMPLE_PTR(@(image_data^[row]^[input_cols-1])); - pixval := ptr^; { don't need GETJSAMPLE() here } - for count := pred(numcols) downto 0 do - begin - Inc(ptr); - ptr^ := pixval; - end; - end; - end; -end; - - -{ Do downsampling for a whole row group (all components). - - In this version we simply downsample each component independently. } - -{METHODDEF} -procedure sep_downsample (cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE; - in_row_index : JDIMENSION; - output_buf : JSAMPIMAGE; - out_row_group_index : JDIMENSION); -var - downsample : my_downsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - in_ptr, out_ptr : JSAMPARRAY; -begin - downsample := my_downsample_ptr (cinfo^.downsample); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - in_ptr := JSAMPARRAY(@ input_buf^[ci]^[in_row_index]); - out_ptr := JSAMPARRAY(@ output_buf^[ci]^ - [out_row_group_index * JDIMENSION(compptr^.v_samp_factor)]); - downsample^.methods[ci] (cinfo, compptr, in_ptr, out_ptr); - Inc(compptr); - end; -end; - - -{ Downsample pixel values of a single component. - One row group is processed per call. - This version handles arbitrary integral sampling ratios, without smoothing. - Note that this version is not actually used for customary sampling ratios. } - -{METHODDEF} -procedure int_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow, h_expand, v_expand, numpix, numpix2, h, v : int; - outcol, outcol_h : JDIMENSION; { outcol_h = outcol*h_expand } - output_cols : JDIMENSION; - inptr, - outptr : JSAMPLE_PTR; - outvalue : INT32; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - h_expand := cinfo^.max_h_samp_factor div compptr^.h_samp_factor; - v_expand := cinfo^.max_v_samp_factor div compptr^.v_samp_factor; - numpix := h_expand * v_expand; - numpix2 := numpix div 2; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * JDIMENSION(h_expand)); - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - outcol_h := 0; - for outcol := 0 to pred(output_cols) do - begin - outvalue := 0; - for v := 0 to pred(v_expand) do - begin - inptr := @(input_data^[inrow+v]^[outcol_h]); - for h := 0 to pred(h_expand) do - begin - Inc(outvalue, INT32 (GETJSAMPLE(inptr^)) ); - Inc(inptr); - end; - end; - outptr^ := JSAMPLE ((outvalue + numpix2) div numpix); - Inc(outptr); - Inc(outcol_h, h_expand); - end; - Inc(inrow, v_expand); - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the special case of a full-size component, - without smoothing. } - -{METHODDEF} -procedure fullsize_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -begin - { Copy the data } - jcopy_sample_rows(input_data, 0, output_data, 0, - cinfo^.max_v_samp_factor, cinfo^.image_width); - { Edge-expand } - expand_right_edge(output_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, compptr^.width_in_blocks * DCTSIZE); -end; - - -{ Downsample pixel values of a single component. - This version handles the common case of 2:1 horizontal and 1:1 vertical, - without smoothing. - - A note about the "bias" calculations: when rounding fractional values to - integer, we do not want to always round 0.5 up to the next integer. - If we did that, we'd introduce a noticeable bias towards larger values. - Instead, this code is arranged so that 0.5 will be rounded up or down at - alternate pixel locations (a simple ordered dither pattern). } - -{METHODDEF} -procedure h2v1_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - outrow : int; - outcol : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr, outptr : JSAMPLE_PTR; - {register} bias : int; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * 2); - - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr := JSAMPLE_PTR(input_data^[outrow]); - bias := 0; { bias := 0,1,0,1,... for successive samples } - for outcol := 0 to pred(output_cols) do - begin - outptr^ := JSAMPLE ((GETJSAMPLE(inptr^) + - GETJSAMPLE(JSAMPROW(inptr)^[1]) + bias) shr 1); - Inc(outptr); - bias := bias xor 1; { 0=>1, 1=>0 } - Inc(inptr, 2); - end; - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the standard case of 2:1 horizontal and 2:1 vertical, - without smoothing. } - -{METHODDEF} -procedure h2v2_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow : int; - outcol : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr0, inptr1, outptr : JSAMPLE_PTR; - {register} bias : int; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - expand_right_edge(input_data, cinfo^.max_v_samp_factor, - cinfo^.image_width, output_cols * 2); - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - bias := 1; { bias := 1,2,1,2,... for successive samples } - for outcol := 0 to pred(output_cols) do - begin - outptr^ := JSAMPLE ((GETJSAMPLE(inptr0^) + - GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + - GETJSAMPLE(JSAMPROW(inptr1)^[1]) + bias) shr 2); - Inc(outptr); - bias := bias xor 3; { 1=>2, 2=>1 } - Inc(inptr0, 2); - Inc(inptr1, 2); - end; - Inc(inrow, 2); - end; -end; - - -{$ifdef INPUT_SMOOTHING_SUPPORTED} - -{ Downsample pixel values of a single component. - This version handles the standard case of 2:1 horizontal and 2:1 vertical, - with smoothing. One row of context is required. } - -{METHODDEF} -procedure h2v2_smooth_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - inrow, outrow : int; - colctr : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr0, inptr1, above_ptr, below_ptr, outptr : JSAMPLE_PTR; - membersum, neighsum, memberscale, neighscale : INT32; -var - prev_input_data : JSAMPARRAY; - prev_inptr0, prev_inptr1, prev_above_ptr, prev_below_ptr : JSAMPLE_PTR; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - prev_input_data := input_data; - Dec(JSAMPROW_PTR(prev_input_data)); - expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, - cinfo^.image_width, output_cols * 2); - - { We don't bother to form the individual "smoothed" input pixel values; - we can directly compute the output which is the average of the four - smoothed values. Each of the four member pixels contributes a fraction - (1-8*SF) to its own smoothed image and a fraction SF to each of the three - other smoothed pixels, therefore a total fraction (1-5*SF)/4 to the final - output. The four corner-adjacent neighbor pixels contribute a fraction - SF to just one smoothed pixel, or SF/4 to the final output; while the - eight edge-adjacent neighbors contribute SF to each of two smoothed - pixels, or SF/2 overall. In order to use integer arithmetic, these - factors are scaled by 2^16 := 65536. - Also recall that SF := smoothing_factor / 1024. } - - memberscale := 16384 - cinfo^.smoothing_factor * 80; { scaled (1-5*SF)/4 } - neighscale := cinfo^.smoothing_factor * 16; { scaled SF/4 } - - inrow := 0; - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - above_ptr := JSAMPLE_PTR(input_data^[inrow-1]); - below_ptr := JSAMPLE_PTR(input_data^[inrow+2]); - - { Special case for first column: pretend column -1 is same as column 0 } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); - Inc(neighsum, neighsum); - Inc(neighsum, GETJSAMPLE(above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + - GETJSAMPLE(below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - prev_inptr0 := inptr0; - prev_inptr1 := inptr1; - Inc(prev_inptr0); - Inc(prev_inptr1); - Inc(inptr0, 2); - Inc(inptr1, 2); - prev_above_ptr := above_ptr; - prev_below_ptr := below_ptr; - Inc(above_ptr, 2); - Inc(below_ptr, 2); - Inc(prev_above_ptr, 1); - Inc(prev_below_ptr, 1); - - for colctr := pred(output_cols - 2) downto 0 do - begin - { sum of pixels directly mapped to this output element } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - { sum of edge-neighbor pixels } - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[2]) + - GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[2]); - { The edge-neighbors count twice as much as corner-neighbors } - Inc(neighsum, neighsum); - { Add in the corner-neighbors } - Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[2]) + - GETJSAMPLE(prev_below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[2]) ); - { form final output scaled up by 2^16 } - membersum := membersum * memberscale + neighsum * neighscale; - { round, descale and output it } - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - Inc(inptr0, 2); - Inc(inptr1, 2); - Inc(prev_inptr0, 2); - Inc(prev_inptr1, 2); - Inc(above_ptr, 2); - Inc(below_ptr, 2); - Inc(prev_above_ptr, 2); - Inc(prev_below_ptr, 2); - end; - - { Special case for last column } - membersum := GETJSAMPLE(inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - neighsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(below_ptr^) + GETJSAMPLE(JSAMPROW(below_ptr)^[1]) + - GETJSAMPLE(prev_inptr0^) + GETJSAMPLE(JSAMPROW(inptr0)^[1]) + - GETJSAMPLE(prev_inptr1^) + GETJSAMPLE(JSAMPROW(inptr1)^[1]); - Inc(neighsum, neighsum); - Inc(neighsum, GETJSAMPLE(prev_above_ptr^) + - GETJSAMPLE(JSAMPROW(above_ptr)^[1]) + - GETJSAMPLE(prev_below_ptr^) + - GETJSAMPLE(JSAMPROW(below_ptr)^[1]) ); - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - - Inc(inrow, 2); - end; -end; - - -{ Downsample pixel values of a single component. - This version handles the special case of a full-size component, - with smoothing. One row of context is required. } - -{METHODDEF} -procedure fullsize_smooth_downsample (cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - output_data : JSAMPARRAY); -var - outrow : int; - colctr : JDIMENSION; - output_cols : JDIMENSION; - {register} inptr, above_ptr, below_ptr, outptr : JSAMPLE_PTR; - membersum, neighsum, memberscale, neighscale : INT32; - colsum, lastcolsum, nextcolsum : int; -var - prev_input_data : JSAMPARRAY; -begin - output_cols := compptr^.width_in_blocks * DCTSIZE; - - { Expand input data enough to let all the output samples be generated - by the standard loop. Special-casing padded output would be more - efficient. } - - prev_input_data := input_data; - Dec(JSAMPROW_PTR(prev_input_data)); - expand_right_edge(prev_input_data, cinfo^.max_v_samp_factor + 2, - cinfo^.image_width, output_cols); - - { Each of the eight neighbor pixels contributes a fraction SF to the - smoothed pixel, while the main pixel contributes (1-8*SF). In order - to use integer arithmetic, these factors are multiplied by 2^16 := 65536. - Also recall that SF := smoothing_factor / 1024. } - - memberscale := long(65536) - cinfo^.smoothing_factor * long(512); { scaled 1-8*SF } - neighscale := cinfo^.smoothing_factor * 64; { scaled SF } - - for outrow := 0 to pred(compptr^.v_samp_factor) do - begin - outptr := JSAMPLE_PTR(output_data^[outrow]); - inptr := JSAMPLE_PTR(input_data^[outrow]); - above_ptr := JSAMPLE_PTR(input_data^[outrow-1]); - below_ptr := JSAMPLE_PTR(input_data^[outrow+1]); - - { Special case for first column } - colsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - Inc(above_ptr); - Inc(below_ptr); - membersum := GETJSAMPLE(inptr^); - Inc(inptr); - nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - neighsum := colsum + (colsum - membersum) + nextcolsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - lastcolsum := colsum; colsum := nextcolsum; - - for colctr := pred(output_cols - 2) downto 0 do - begin - membersum := GETJSAMPLE(inptr^); - Inc(inptr); - Inc(above_ptr); - Inc(below_ptr); - nextcolsum := GETJSAMPLE(above_ptr^) + GETJSAMPLE(below_ptr^) + - GETJSAMPLE(inptr^); - neighsum := lastcolsum + (colsum - membersum) + nextcolsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - Inc(outptr); - lastcolsum := colsum; colsum := nextcolsum; - end; - - { Special case for last column } - membersum := GETJSAMPLE(inptr^); - neighsum := lastcolsum + (colsum - membersum) + colsum; - membersum := membersum * memberscale + neighsum * neighscale; - outptr^ := JSAMPLE ((membersum + 32768) shr 16); - end; -end; - -{$endif} { INPUT_SMOOTHING_SUPPORTED } - - -{ Module initialization routine for downsampling. - Note that we must select a routine for each component. } - -{GLOBAL} -procedure jinit_downsampler (cinfo : j_compress_ptr); -var - downsample : my_downsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - smoothok : boolean; -begin - smoothok := TRUE; - - downsample := my_downsample_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_downsampler)) ); - cinfo^.downsample := jpeg_downsampler_ptr (downsample); - downsample^.pub.start_pass := start_pass_downsample; - downsample^.pub.downsample := sep_downsample; - downsample^.pub.need_context_rows := FALSE; - - if (cinfo^.CCIR601_sampling) then - ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); - - { Verify we can handle the sampling factors, and set up method pointers } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - if (compptr^.h_samp_factor = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then - begin -{$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) then - begin - downsample^.methods[ci] := fullsize_smooth_downsample; - downsample^.pub.need_context_rows := TRUE; - end - else -{$endif} - downsample^.methods[ci] := fullsize_downsample; - end - else - if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor = cinfo^.max_v_samp_factor) then - begin - smoothok := FALSE; - downsample^.methods[ci] := h2v1_downsample; - end - else - if (compptr^.h_samp_factor * 2 = cinfo^.max_h_samp_factor) and - (compptr^.v_samp_factor * 2 = cinfo^.max_v_samp_factor) then - begin - {$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) then - begin - downsample^.methods[ci] := h2v2_smooth_downsample; - downsample^.pub.need_context_rows := TRUE; - end - else - {$endif} - downsample^.methods[ci] := h2v2_downsample; - end - else - if ((cinfo^.max_h_samp_factor mod compptr^.h_samp_factor) = 0) and - ((cinfo^.max_v_samp_factor mod compptr^.v_samp_factor) = 0) then - begin - smoothok := FALSE; - downsample^.methods[ci] := int_downsample; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); - Inc(compptr); - end; - -{$ifdef INPUT_SMOOTHING_SUPPORTED} - if (cinfo^.smoothing_factor <> 0) and (not smoothok) then - TRACEMS(j_common_ptr(cinfo), 0, JTRC_SMOOTH_NOTIMPL); -{$endif} -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdapimin.pas b/3rd/Imaging/Source/JpegLib/imjdapimin.pas deleted file mode 100644 index 367128eb8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdapimin.pas +++ /dev/null @@ -1,505 +0,0 @@ -unit imjdapimin; - -{$N+} { Nomssi: cinfo^.output_gamma } - -{ This file contains application interface code for the decompression half - of the JPEG library. These are the "minimum" API routines that may be - needed in either the normal full-decompression case or the - transcoding-only case. - - Most of the routines intended to be called directly by an application - are in this file or in jdapistd.c. But also see jcomapi.c for routines - shared by compression and decompression, and jdtrans.c for the transcoding - case. } - -{ Original : jdapimin.c ; Copyright (C) 1994-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjmemmgr, imjdmarker, imjdinput, imjcomapi; - -{ Nomssi } -procedure jpeg_create_decompress(cinfo : j_decompress_ptr); - -{ Initialization of a JPEG decompression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr; - version : int; - structsize : size_t); - -{ Destruction of a JPEG decompression object } - -{GLOBAL} -procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); - - -{ Decompression startup: read start of JPEG datastream to see what's there. - Need only initialize JPEG object and supply a data source before calling. - - This routine will read as far as the first SOS marker (ie, actual start of - compressed data), and will save all tables and parameters in the JPEG - object. It will also initialize the decompression parameters to default - values, and finally return JPEG_HEADER_OK. On return, the application may - adjust the decompression parameters and then call jpeg_start_decompress. - (Or, if the application only wanted to determine the image parameters, - the data need not be decompressed. In that case, call jpeg_abort or - jpeg_destroy to release any temporary space.) - If an abbreviated (tables only) datastream is presented, the routine will - return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then - re-use the JPEG object to read the abbreviated image datastream(s). - It is unnecessary (but OK) to call jpeg_abort in this case. - The JPEG_SUSPENDED return code only occurs if the data source module - requests suspension of the decompressor. In this case the application - should load more source data and then re-call jpeg_read_header to resume - processing. - If a non-suspending data source is used and require_image is TRUE, then the - return code need not be inspected since only JPEG_HEADER_OK is possible. - - This routine is now just a front end to jpeg_consume_input, with some - extra error checking. } - -{GLOBAL} -function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; - -{ Consume data in advance of what the decompressor requires. - This can be called at any time once the decompressor object has - been created and a data source has been set up. - - This routine is essentially a state machine that handles a couple - of critical state-transition actions, namely initial setup and - transition from header scanning to ready-for-start_decompress. - All the actual input is done via the input controller's consume_input - method. } - -{GLOBAL} -function jpeg_consume_input (cinfo : j_decompress_ptr) : int; - -{ Have we finished reading the input file? } - -{GLOBAL} -function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; - -{ Is there more than one scan? } - -{GLOBAL} -function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; - - -{ Finish JPEG decompression. - - This will normally just verify the file trailer and release temp storage. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; - -implementation - -procedure jpeg_create_decompress(cinfo : j_decompress_ptr); -begin - jpeg_CreateDecompress(cinfo, JPEG_LIB_VERSION, - size_t(sizeof(jpeg_decompress_struct))); -end; - -{ Initialization of a JPEG decompression object. - The error manager must already be set up (in case memory manager fails). } - -{GLOBAL} -procedure jpeg_CreateDecompress (cinfo : j_decompress_ptr; - version : int; - structsize : size_t); -var - i : int; -var - err : jpeg_error_mgr_ptr; - client_data : voidp; -begin - { Guard against version mismatches between library and caller. } - cinfo^.mem := NIL; { so jpeg_destroy knows mem mgr not called } - if (version <> JPEG_LIB_VERSION) then - ERREXIT2(j_common_ptr(cinfo), JERR_BAD_LIB_VERSION, JPEG_LIB_VERSION, version); - if (structsize <> SIZEOF(jpeg_decompress_struct)) then - ERREXIT2(j_common_ptr(cinfo), JERR_BAD_STRUCT_SIZE, - int(SIZEOF(jpeg_decompress_struct)), int(structsize)); - - { For debugging purposes, we zero the whole master structure. - But the application has already set the err pointer, and may have set - client_data, so we have to save and restore those fields. - Note: if application hasn't set client_data, tools like Purify may - complain here. } - begin - err := cinfo^.err; - client_data := cinfo^.client_data; { ignore Purify complaint here } - MEMZERO(j_common_ptr(cinfo), SIZEOF(jpeg_decompress_struct)); - cinfo^.err := err; - cinfo^.client_data := client_data; - end; - cinfo^.is_decompressor := TRUE; - - { Initialize a memory manager instance for this object } - jinit_memory_mgr(j_common_ptr(cinfo)); - - { Zero out pointers to permanent structures. } - cinfo^.progress := NIL; - cinfo^.src := NIL; - - for i := 0 to pred(NUM_QUANT_TBLS) do - cinfo^.quant_tbl_ptrs[i] := NIL; - - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - cinfo^.dc_huff_tbl_ptrs[i] := NIL; - cinfo^.ac_huff_tbl_ptrs[i] := NIL; - end; - - { Initialize marker processor so application can override methods - for COM, APPn markers before calling jpeg_read_header. } - cinfo^.marker_list := NIL; - jinit_marker_reader(cinfo); - - { And initialize the overall input controller. } - jinit_input_controller(cinfo); - - { OK, I'm ready } - cinfo^.global_state := DSTATE_START; -end; - - -{ Destruction of a JPEG decompression object } - -{GLOBAL} -procedure jpeg_destroy_decompress (cinfo : j_decompress_ptr); -begin - jpeg_destroy(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Abort processing of a JPEG decompression operation, - but don't destroy the object itself. } - -{GLOBAL} -procedure jpeg_abort_decompress (cinfo : j_decompress_ptr); -begin - jpeg_abort(j_common_ptr(cinfo)); { use common routine } -end; - - -{ Set default decompression parameters. } - -{LOCAL} -procedure default_decompress_parms (cinfo : j_decompress_ptr); -var - cid0 : int; - cid1 : int; - cid2 : int; -begin - { Guess the input colorspace, and set output colorspace accordingly. } - { (Wish JPEG committee had provided a real way to specify this...) } - { Note application may override our guesses. } - case (cinfo^.num_components) of - 1: begin - cinfo^.jpeg_color_space := JCS_GRAYSCALE; - cinfo^.out_color_space := JCS_GRAYSCALE; - end; - - 3: begin - if (cinfo^.saw_JFIF_marker) then - begin - cinfo^.jpeg_color_space := JCS_YCbCr; { JFIF implies YCbCr } - end - else - if (cinfo^.saw_Adobe_marker) then - begin - case (cinfo^.Adobe_transform) of - 0: cinfo^.jpeg_color_space := JCS_RGB; - 1: cinfo^.jpeg_color_space := JCS_YCbCr; - else - begin - WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); - cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } - end; - end; - end - else - begin - { Saw no special markers, try to guess from the component IDs } - cid0 := cinfo^.comp_info^[0].component_id; - cid1 := cinfo^.comp_info^[1].component_id; - cid2 := cinfo^.comp_info^[2].component_id; - - if (cid0 = 1) and (cid1 = 2) and (cid2 = 3) then - cinfo^.jpeg_color_space := JCS_YCbCr { assume JFIF w/out marker } - else - if (cid0 = 82) and (cid1 = 71) and (cid2 = 66) then - cinfo^.jpeg_color_space := JCS_RGB { ASCII 'R', 'G', 'B' } - else - begin - {$IFDEF DEBUG} - TRACEMS3(j_common_ptr(cinfo), 1, JTRC_UNKNOWN_IDS, cid0, cid1, cid2); - {$ENDIF} - cinfo^.jpeg_color_space := JCS_YCbCr; { assume it's YCbCr } - end; - end; - { Always guess RGB is proper output colorspace. } - cinfo^.out_color_space := JCS_RGB; - end; - - 4: begin - if (cinfo^.saw_Adobe_marker) then - begin - case (cinfo^.Adobe_transform) of - 0: cinfo^.jpeg_color_space := JCS_CMYK; - 2: cinfo^.jpeg_color_space := JCS_YCCK; - else - begin - WARNMS1(j_common_ptr(cinfo), JWRN_ADOBE_XFORM, cinfo^.Adobe_transform); - cinfo^.jpeg_color_space := JCS_YCCK; { assume it's YCCK } - end; - end; - end - else - begin - { No special markers, assume straight CMYK. } - cinfo^.jpeg_color_space := JCS_CMYK; - end; - cinfo^.out_color_space := JCS_CMYK; - end; - - else - begin - cinfo^.jpeg_color_space := JCS_UNKNOWN; - cinfo^.out_color_space := JCS_UNKNOWN; - end; - end; - - { Set defaults for other decompression parameters. } - cinfo^.scale_num := 1; { 1:1 scaling } - cinfo^.scale_denom := 1; - cinfo^.output_gamma := 1.0; - cinfo^.buffered_image := FALSE; - cinfo^.raw_data_out := FALSE; - cinfo^.dct_method := JDCT_DEFAULT; - cinfo^.do_fancy_upsampling := TRUE; - cinfo^.do_block_smoothing := TRUE; - cinfo^.quantize_colors := FALSE; - { We set these in case application only sets quantize_colors. } - cinfo^.dither_mode := JDITHER_FS; -{$ifdef QUANT_2PASS_SUPPORTED} - cinfo^.two_pass_quantize := TRUE; -{$else} - cinfo^.two_pass_quantize := FALSE; -{$endif} - cinfo^.desired_number_of_colors := 256; - cinfo^.colormap := NIL; - { Initialize for no mode change in buffered-image mode. } - cinfo^.enable_1pass_quant := FALSE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; -end; - - -{ Decompression startup: read start of JPEG datastream to see what's there. - Need only initialize JPEG object and supply a data source before calling. - - This routine will read as far as the first SOS marker (ie, actual start of - compressed data), and will save all tables and parameters in the JPEG - object. It will also initialize the decompression parameters to default - values, and finally return JPEG_HEADER_OK. On return, the application may - adjust the decompression parameters and then call jpeg_start_decompress. - (Or, if the application only wanted to determine the image parameters, - the data need not be decompressed. In that case, call jpeg_abort or - jpeg_destroy to release any temporary space.) - If an abbreviated (tables only) datastream is presented, the routine will - return JPEG_HEADER_TABLES_ONLY upon reaching EOI. The application may then - re-use the JPEG object to read the abbreviated image datastream(s). - It is unnecessary (but OK) to call jpeg_abort in this case. - The JPEG_SUSPENDED return code only occurs if the data source module - requests suspension of the decompressor. In this case the application - should load more source data and then re-call jpeg_read_header to resume - processing. - If a non-suspending data source is used and require_image is TRUE, then the - return code need not be inspected since only JPEG_HEADER_OK is possible. - - This routine is now just a front end to jpeg_consume_input, with some - extra error checking. } - -{GLOBAL} -function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; -var - retcode : int; -begin - if (cinfo^.global_state <> DSTATE_START) and - (cinfo^.global_state <> DSTATE_INHEADER) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - retcode := jpeg_consume_input(cinfo); - - case (retcode) of - JPEG_REACHED_SOS: - retcode := JPEG_HEADER_OK; - JPEG_REACHED_EOI: - begin - if (require_image) then { Complain if application wanted an image } - ERREXIT(j_common_ptr(cinfo), JERR_NO_IMAGE); - { Reset to start state; it would be safer to require the application to - call jpeg_abort, but we can't change it now for compatibility reasons. - A side effect is to free any temporary memory (there shouldn't be any). } - - jpeg_abort(j_common_ptr(cinfo)); { sets state := DSTATE_START } - retcode := JPEG_HEADER_TABLES_ONLY; - end; - JPEG_SUSPENDED: ; { no work } - end; - - jpeg_read_header := retcode; -end; - - -{ Consume data in advance of what the decompressor requires. - This can be called at any time once the decompressor object has - been created and a data source has been set up. - - This routine is essentially a state machine that handles a couple - of critical state-transition actions, namely initial setup and - transition from header scanning to ready-for-start_decompress. - All the actual input is done via the input controller's consume_input - method. } - -{GLOBAL} -function jpeg_consume_input (cinfo : j_decompress_ptr) : int; -var - retcode : int; -begin - retcode := JPEG_SUSPENDED; - - { NB: every possible DSTATE value should be listed in this switch } - - if (cinfo^.global_state) = DSTATE_START then - begin {work around the FALLTHROUGH} - { Start-of-datastream actions: reset appropriate modules } - cinfo^.inputctl^.reset_input_controller (cinfo); - { Initialize application's data source module } - cinfo^.src^.init_source (cinfo); - cinfo^.global_state := DSTATE_INHEADER; - end; - - case (cinfo^.global_state) of - DSTATE_START, - DSTATE_INHEADER: - begin - retcode := cinfo^.inputctl^.consume_input (cinfo); - if (retcode = JPEG_REACHED_SOS) then - begin { Found SOS, prepare to decompress } - { Set up default parameters based on header data } - default_decompress_parms(cinfo); - { Set global state: ready for start_decompress } - cinfo^.global_state := DSTATE_READY; - end; - end; - DSTATE_READY: - { Can't advance past first SOS until start_decompress is called } - retcode := JPEG_REACHED_SOS; - - DSTATE_PRELOAD, - DSTATE_PRESCAN, - DSTATE_SCANNING, - DSTATE_RAW_OK, - DSTATE_BUFIMAGE, - DSTATE_BUFPOST, - DSTATE_STOPPING: - retcode := cinfo^.inputctl^.consume_input (cinfo); - else - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - end; - jpeg_consume_input := retcode; -end; - - -{ Have we finished reading the input file? } - -{GLOBAL} -function jpeg_input_complete (cinfo : j_decompress_ptr) : boolean; -begin - { Check for valid jpeg object } - if (cinfo^.global_state < DSTATE_START) or - (cinfo^.global_state > DSTATE_STOPPING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - jpeg_input_complete := cinfo^.inputctl^.eoi_reached; -end; - - -{ Is there more than one scan? } - -{GLOBAL} -function jpeg_has_multiple_scans (cinfo : j_decompress_ptr) : boolean; -begin - { Only valid after jpeg_read_header completes } - if (cinfo^.global_state < DSTATE_READY) or - (cinfo^.global_state > DSTATE_STOPPING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - jpeg_has_multiple_scans := cinfo^.inputctl^.has_multiple_scans; -end; - - -{ Finish JPEG decompression. - - This will normally just verify the file trailer and release temp storage. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_decompress (cinfo : j_decompress_ptr) : boolean; -begin - if ((cinfo^.global_state = DSTATE_SCANNING) or - (cinfo^.global_state = DSTATE_RAW_OK) and (not cinfo^.buffered_image)) then - begin - { Terminate final pass of non-buffered mode } - if (cinfo^.output_scanline < cinfo^.output_height) then - ERREXIT(j_common_ptr(cinfo), JERR_TOO_LITTLE_DATA); - cinfo^.master^.finish_output_pass (cinfo); - cinfo^.global_state := DSTATE_STOPPING; - end - else - if (cinfo^.global_state = DSTATE_BUFIMAGE) then - begin - { Finishing after a buffered-image operation } - cinfo^.global_state := DSTATE_STOPPING; - end - else - if (cinfo^.global_state <> DSTATE_STOPPING) then - begin - { STOPPING := repeat call after a suspension, anything else is error } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - end; - { Read until EOI } - while (not cinfo^.inputctl^.eoi_reached) do - begin - if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then - begin - jpeg_finish_decompress := FALSE; { Suspend, come back later } - exit; - end; - end; - { Do final cleanup } - cinfo^.src^.term_source (cinfo); - { We can use jpeg_abort to release memory and reset global_state } - jpeg_abort(j_common_ptr(cinfo)); - jpeg_finish_decompress := TRUE; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdapistd.pas b/3rd/Imaging/Source/JpegLib/imjdapistd.pas deleted file mode 100644 index cef249bec..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdapistd.pas +++ /dev/null @@ -1,377 +0,0 @@ -unit imjdapistd; - -{ Original : jdapistd.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains application interface code for the decompression half - of the JPEG library. These are the "standard" API routines that are - used in the normal full-decompression case. They are not used by a - transcoding-only application. Note that if an application links in - jpeg_start_decompress, it will end up linking in the entire decompressor. - We thus must separate this file from jdapimin.c to avoid linking the - whole decompression library into a transcoder. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjdmaster; - -{ Read some scanlines of data from the JPEG decompressor. - - The return value will be the number of lines actually read. - This may be less than the number requested in several cases, - including bottom of image, data source suspension, and operating - modes that emit multiple scanlines at a time. - - Note: we warn about excess calls to jpeg_read_scanlines() since - this likely signals an application programmer error. However, - an oversize buffer (max_lines > scanlines remaining) is not an error. } - -{GLOBAL} -function jpeg_read_scanlines (cinfo : j_decompress_ptr; - scanlines : JSAMPARRAY; - max_lines : JDIMENSION) : JDIMENSION; - - -{ Alternate entry point to read raw data. - Processes exactly one iMCU row per call, unless suspended. } - -{GLOBAL} -function jpeg_read_raw_data (cinfo : j_decompress_ptr; - data : JSAMPIMAGE; - max_lines : JDIMENSION) : JDIMENSION; - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Initialize for an output pass in buffered-image mode. } - -{GLOBAL} -function jpeg_start_output (cinfo : j_decompress_ptr; - scan_number : int) : boolean; - -{ Finish up after an output pass in buffered-image mode. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - -{ Decompression initialization. - jpeg_read_header must be completed before calling this. - - If a multipass operating mode was selected, this will do all but the - last pass, and thus may take a great deal of time. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean; - - -implementation - -{ Forward declarations } -{LOCAL} -function output_pass_setup (cinfo : j_decompress_ptr) : boolean; forward; - -{ Decompression initialization. - jpeg_read_header must be completed before calling this. - - If a multipass operating mode was selected, this will do all but the - last pass, and thus may take a great deal of time. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_start_decompress (cinfo : j_decompress_ptr) : boolean; -var - retcode : int; -begin - if (cinfo^.global_state = DSTATE_READY) then - begin - { First call: initialize master control, select active modules } - jinit_master_decompress(cinfo); - if (cinfo^.buffered_image) then - begin - { No more work here; expecting jpeg_start_output next } - cinfo^.global_state := DSTATE_BUFIMAGE; - jpeg_start_decompress := TRUE; - exit; - end; - cinfo^.global_state := DSTATE_PRELOAD; - end; - if (cinfo^.global_state = DSTATE_PRELOAD) then - begin - { If file has multiple scans, absorb them all into the coef buffer } - if (cinfo^.inputctl^.has_multiple_scans) then - begin -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - while TRUE do - begin - - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - { Absorb some more input } - retcode := cinfo^.inputctl^.consume_input (cinfo); - if (retcode = JPEG_SUSPENDED) then - begin - jpeg_start_decompress := FALSE; - exit; - end; - if (retcode = JPEG_REACHED_EOI) then - break; - { Advance progress counter if appropriate } - if (cinfo^.progress <> NIL) and - ((retcode = JPEG_ROW_COMPLETED) or (retcode = JPEG_REACHED_SOS)) then - begin - Inc(cinfo^.progress^.pass_counter); - if (cinfo^.progress^.pass_counter >= cinfo^.progress^.pass_limit) then - begin - { jdmaster underestimated number of scans; ratchet up one scan } - Inc(cinfo^.progress^.pass_limit, long(cinfo^.total_iMCU_rows)); - end; - end; - end; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - end; - cinfo^.output_scan_number := cinfo^.input_scan_number; - end - else - if (cinfo^.global_state <> DSTATE_PRESCAN) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - { Perform any dummy output passes, and set up for the final pass } - jpeg_start_decompress := output_pass_setup(cinfo); -end; - - -{ Set up for an output pass, and perform any dummy pass(es) needed. - Common subroutine for jpeg_start_decompress and jpeg_start_output. - Entry: global_state := DSTATE_PRESCAN only if previously suspended. - Exit: If done, returns TRUE and sets global_state for proper output mode. - If suspended, returns FALSE and sets global_state := DSTATE_PRESCAN. } - -{LOCAL} -function output_pass_setup (cinfo : j_decompress_ptr) : boolean; -var - last_scanline : JDIMENSION; -begin - if (cinfo^.global_state <> DSTATE_PRESCAN) then - begin - { First call: do pass setup } - cinfo^.master^.prepare_for_output_pass (cinfo); - cinfo^.output_scanline := 0; - cinfo^.global_state := DSTATE_PRESCAN; - end; - { Loop over any required dummy passes } - while (cinfo^.master^.is_dummy_pass) do - begin -{$ifdef QUANT_2PASS_SUPPORTED} - { Crank through the dummy pass } - while (cinfo^.output_scanline < cinfo^.output_height) do - begin - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); - cinfo^.progress^.pass_limit := long (cinfo^.output_height); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - { Process some data } - last_scanline := cinfo^.output_scanline; - cinfo^.main^.process_data (cinfo, JSAMPARRAY(NIL), - cinfo^.output_scanline, {var} - JDIMENSION(0)); - if (cinfo^.output_scanline = last_scanline) then - begin - output_pass_setup := FALSE; { No progress made, must suspend } - exit; - end; - end; - { Finish up dummy pass, and set up for another one } - cinfo^.master^.finish_output_pass (cinfo); - cinfo^.master^.prepare_for_output_pass (cinfo); - cinfo^.output_scanline := 0; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} { QUANT_2PASS_SUPPORTED } - end; - { Ready for application to drive output pass through - jpeg_read_scanlines or jpeg_read_raw_data. } - if cinfo^.raw_data_out then - cinfo^.global_state := DSTATE_RAW_OK - else - cinfo^.global_state := DSTATE_SCANNING; - output_pass_setup := TRUE; -end; - - -{ Read some scanlines of data from the JPEG decompressor. - - The return value will be the number of lines actually read. - This may be less than the number requested in several cases, - including bottom of image, data source suspension, and operating - modes that emit multiple scanlines at a time. - - Note: we warn about excess calls to jpeg_read_scanlines() since - this likely signals an application programmer error. However, - an oversize buffer (max_lines > scanlines remaining) is not an error. } - -{GLOBAL} -function jpeg_read_scanlines (cinfo : j_decompress_ptr; - scanlines : JSAMPARRAY; - max_lines : JDIMENSION) : JDIMENSION; -var - row_ctr : JDIMENSION; -begin - if (cinfo^.global_state <> DSTATE_SCANNING) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - if (cinfo^.output_scanline >= cinfo^.output_height) then - begin - WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); - jpeg_read_scanlines := 0; - exit; - end; - - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); - cinfo^.progress^.pass_limit := long (cinfo^.output_height); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - - { Process some data } - row_ctr := 0; - cinfo^.main^.process_data (cinfo, scanlines, {var}row_ctr, max_lines); - Inc(cinfo^.output_scanline, row_ctr); - jpeg_read_scanlines := row_ctr; -end; - - -{ Alternate entry point to read raw data. - Processes exactly one iMCU row per call, unless suspended. } - -{GLOBAL} -function jpeg_read_raw_data (cinfo : j_decompress_ptr; - data : JSAMPIMAGE; - max_lines : JDIMENSION) : JDIMENSION; -var - lines_per_iMCU_row : JDIMENSION; -begin - if (cinfo^.global_state <> DSTATE_RAW_OK) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - if (cinfo^.output_scanline >= cinfo^.output_height) then - begin - WARNMS(j_common_ptr(cinfo), JWRN_TOO_MUCH_DATA); - jpeg_read_raw_data := 0; - exit; - end; - - { Call progress monitor hook if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.pass_counter := long (cinfo^.output_scanline); - cinfo^.progress^.pass_limit := long (cinfo^.output_height); - cinfo^.progress^.progress_monitor (j_common_ptr(cinfo)); - end; - - { Verify that at least one iMCU row can be returned. } - lines_per_iMCU_row := cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size; - if (max_lines < lines_per_iMCU_row) then - ERREXIT(j_common_ptr(cinfo), JERR_BUFFER_SIZE); - - { Decompress directly into user's buffer. } - if (cinfo^.coef^.decompress_data (cinfo, data) = 0) then - begin - jpeg_read_raw_data := 0; { suspension forced, can do nothing more } - exit; - end; - - { OK, we processed one iMCU row. } - Inc(cinfo^.output_scanline, lines_per_iMCU_row); - jpeg_read_raw_data := lines_per_iMCU_row; -end; - - -{ Additional entry points for buffered-image mode. } - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Initialize for an output pass in buffered-image mode. } - -{GLOBAL} -function jpeg_start_output (cinfo : j_decompress_ptr; - scan_number : int) : boolean; -begin - if (cinfo^.global_state <> DSTATE_BUFIMAGE) and - (cinfo^.global_state <> DSTATE_PRESCAN) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - { Limit scan number to valid range } - if (scan_number <= 0) then - scan_number := 1; - if (cinfo^.inputctl^.eoi_reached) and - (scan_number > cinfo^.input_scan_number) then - scan_number := cinfo^.input_scan_number; - cinfo^.output_scan_number := scan_number; - { Perform any dummy output passes, and set up for the real pass } - jpeg_start_output := output_pass_setup(cinfo); -end; - - -{ Finish up after an output pass in buffered-image mode. - - Returns FALSE if suspended. The return value need be inspected only if - a suspending data source is used. } - -{GLOBAL} -function jpeg_finish_output (cinfo : j_decompress_ptr) : boolean; -begin - if ((cinfo^.global_state = DSTATE_SCANNING) or - (cinfo^.global_state = DSTATE_RAW_OK) and cinfo^.buffered_image) then - begin - { Terminate this pass. } - { We do not require the whole pass to have been completed. } - cinfo^.master^.finish_output_pass (cinfo); - cinfo^.global_state := DSTATE_BUFPOST; - end - else - if (cinfo^.global_state <> DSTATE_BUFPOST) then - begin - { BUFPOST := repeat call after a suspension, anything else is error } - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - end; - { Read markers looking for SOS or EOI } - while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and - (not cinfo^.inputctl^.eoi_reached) do - begin - if (cinfo^.inputctl^.consume_input (cinfo) = JPEG_SUSPENDED) then - begin - jpeg_finish_output := FALSE; { Suspend, come back later } - exit; - end; - end; - cinfo^.global_state := DSTATE_BUFIMAGE; - jpeg_finish_output := TRUE; -end; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - -end. - diff --git a/3rd/Imaging/Source/JpegLib/imjdcoefct.pas b/3rd/Imaging/Source/JpegLib/imjdcoefct.pas deleted file mode 100644 index caa69a2ad..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdcoefct.pas +++ /dev/null @@ -1,895 +0,0 @@ -unit imjdcoefct; - -{ This file contains the coefficient buffer controller for decompression. - This controller is the top level of the JPEG decompressor proper. - The coefficient buffer lies between entropy decoding and inverse-DCT steps. - - In buffered-image mode, this controller is the interface between - input-oriented processing and output-oriented processing. - Also, the input side (only) is used when reading a file for transcoding. } - -{ Original: jdcoefct.c ; Copyright (C) 1994-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{GLOBAL} -procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); - - -implementation - - -{ Block smoothing is only applicable for progressive JPEG, so: } -{$ifndef D_PROGRESSIVE_SUPPORTED} -{$undef BLOCK_SMOOTHING_SUPPORTED} -{$endif} - -{ Private buffer controller object } - -{$ifdef BLOCK_SMOOTHING_SUPPORTED} -const - SAVED_COEFS = 6; { we save coef_bits[0..5] } -type - Latch = array[0..SAVED_COEFS-1] of int; - Latch_ptr = ^Latch; -{$endif} - -type - my_coef_ptr = ^my_coef_controller; - my_coef_controller = record - pub : jpeg_d_coef_controller; { public fields } - - { These variables keep track of the current location of the input side. } - { cinfo^.input_iMCU_row is also used for this. } - MCU_ctr : JDIMENSION; { counts MCUs processed in current row } - MCU_vert_offset : int; { counts MCU rows within iMCU row } - MCU_rows_per_iMCU_row : int; { number of such rows needed } - - { The output side's location is represented by cinfo^.output_iMCU_row. } - - { In single-pass modes, it's sufficient to buffer just one MCU. - We allocate a workspace of D_MAX_BLOCKS_IN_MCU coefficient blocks, - and let the entropy decoder write into that workspace each time. - (On 80x86, the workspace is FAR even though it's not really very big; - this is to keep the module interfaces unchanged when a large coefficient - buffer is necessary.) - In multi-pass modes, this array points to the current MCU's blocks - within the virtual arrays; it is used only by the input side. } - - MCU_buffer : array[0..D_MAX_BLOCKS_IN_MCU-1] of JBLOCKROW; - - {$ifdef D_MULTISCAN_FILES_SUPPORTED} - { In multi-pass modes, we need a virtual block array for each component. } - whole_image : jvirt_barray_tbl; - {$endif} - - {$ifdef BLOCK_SMOOTHING_SUPPORTED} - { When doing block smoothing, we latch coefficient Al values here } - coef_bits_latch : Latch_Ptr; - {$endif} - end; - -{ Forward declarations } -{METHODDEF} -function decompress_onepass (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$ifdef D_MULTISCAN_FILES_SUPPORTED} -{METHODDEF} -function decompress_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$endif} -{$ifdef BLOCK_SMOOTHING_SUPPORTED} -{LOCAL} -function smoothing_ok (cinfo : j_decompress_ptr) : boolean; forward; - -{METHODDEF} -function decompress_smooth_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; forward; -{$endif} - - -{LOCAL} -procedure start_iMCU_row (cinfo : j_decompress_ptr); -{ Reset within-iMCU-row counters for a new row (input side) } -var - coef : my_coef_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { In an interleaved scan, an MCU row is the same as an iMCU row. - In a noninterleaved scan, an iMCU row has v_samp_factor MCU rows. - But at the bottom of the image, process only what's left. } - - if (cinfo^.comps_in_scan > 1) then - begin - coef^.MCU_rows_per_iMCU_row := 1; - end - else - begin - if (cinfo^.input_iMCU_row < (cinfo^.total_iMCU_rows-1)) then - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.v_samp_factor - else - coef^.MCU_rows_per_iMCU_row := cinfo^.cur_comp_info[0]^.last_row_height; - end; - - coef^.MCU_ctr := 0; - coef^.MCU_vert_offset := 0; -end; - - -{ Initialize for an input processing pass. } - -{METHODDEF} -procedure start_input_pass (cinfo : j_decompress_ptr); -begin - cinfo^.input_iMCU_row := 0; - start_iMCU_row(cinfo); -end; - - -{ Initialize for an output processing pass. } - -{METHODDEF} -procedure start_output_pass (cinfo : j_decompress_ptr); -var - coef : my_coef_ptr; -begin -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - coef := my_coef_ptr (cinfo^.coef); - - { If multipass, check to see whether to use block smoothing on this pass } - if (coef^.pub.coef_arrays <> NIL) then - begin - if (cinfo^.do_block_smoothing) and smoothing_ok(cinfo) then - coef^.pub.decompress_data := decompress_smooth_data - else - coef^.pub.decompress_data := decompress_data; - end; -{$endif} - cinfo^.output_iMCU_row := 0; -end; - - -{ Decompress and return some data in the single-pass case. - Always attempts to emit one fully interleaved MCU row ("iMCU" row). - Input and output must run in lockstep since we have only a one-MCU buffer. - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. - - NB: output_buf contains a plane for each component in image, - which we index according to the component's SOF position.} - -{METHODDEF} -function decompress_onepass (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - last_MCU_col : JDIMENSION; - last_iMCU_row : JDIMENSION; - blkn, ci, xindex, yindex, yoffset, useful_width : int; - output_ptr : JSAMPARRAY; - start_col, output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_MCU_col := cinfo^.MCUs_per_row - 1; - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Loop to process as much as one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.MCU_ctr to last_MCU_col do - begin - { Try to fetch an MCU. Entropy decoder expects buffer to be zeroed. } - jzero_far( coef^.MCU_buffer[0], - size_t (cinfo^.blocks_in_MCU * SIZEOF(JBLOCK))); - if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.MCU_ctr := MCU_col_num; - decompress_onepass := JPEG_SUSPENDED; - exit; - end; - { Determine where data should go in output_buf and do the IDCT thing. - We skip dummy blocks at the right and bottom edges (but blkn gets - incremented past them!). Note the inner loop relies on having - allocated the MCU_buffer[] blocks sequentially. } - - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - begin - Inc(blkn, compptr^.MCU_blocks); - continue; - end; - inverse_DCT := cinfo^.idct^.inverse_DCT[compptr^.component_index]; - if (MCU_col_num < last_MCU_col) then - useful_width := compptr^.MCU_width - else - useful_width := compptr^.last_col_width; - - output_ptr := JSAMPARRAY(@ output_buf^[compptr^.component_index]^ - [yoffset * compptr^.DCT_scaled_size]); - start_col := LongInt(MCU_col_num) * compptr^.MCU_sample_width; - for yindex := 0 to pred(compptr^.MCU_height) do - begin - if (cinfo^.input_iMCU_row < last_iMCU_row) or - (yoffset+yindex < compptr^.last_row_height) then - begin - output_col := start_col; - for xindex := 0 to pred(useful_width) do - begin - inverse_DCT (cinfo, compptr, - JCOEFPTR(coef^.MCU_buffer[blkn+xindex]), - output_ptr, output_col); - Inc(output_col, compptr^.DCT_scaled_size); - end; - end; - Inc(blkn, compptr^.MCU_width); - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.MCU_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(cinfo^.output_iMCU_row); - - Inc(cinfo^.input_iMCU_row); - if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then - begin - start_iMCU_row(cinfo); - decompress_onepass := JPEG_ROW_COMPLETED; - exit; - end; - { Completed the scan } - cinfo^.inputctl^.finish_input_pass (cinfo); - decompress_onepass := JPEG_SCAN_COMPLETED; -end; - -{ Dummy consume-input routine for single-pass operation. } - -{METHODDEF} -function dummy_consume_data (cinfo : j_decompress_ptr) : int; -begin - dummy_consume_data := JPEG_SUSPENDED; { Always indicate nothing was done } -end; - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Consume input data and store it in the full-image coefficient buffer. - We read as much as one fully interleaved MCU row ("iMCU" row) per call, - ie, v_samp_factor block rows for each component in the scan. - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED.} - -{METHODDEF} -function consume_data (cinfo : j_decompress_ptr) : int; -var - coef : my_coef_ptr; - MCU_col_num : JDIMENSION; { index of current MCU within row } - blkn, ci, xindex, yindex, yoffset : int; - start_col : JDIMENSION; - buffer : array[0..MAX_COMPS_IN_SCAN-1] of JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - compptr : jpeg_component_info_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - - { Align the virtual buffers for the components used in this scan. } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - buffer[ci] := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[compptr^.component_index], - LongInt(cinfo^.input_iMCU_row) * compptr^.v_samp_factor, - JDIMENSION (compptr^.v_samp_factor), TRUE); - { Note: entropy decoder expects buffer to be zeroed, - but this is handled automatically by the memory manager - because we requested a pre-zeroed array. } - - end; - - { Loop to process one whole iMCU row } - for yoffset := coef^.MCU_vert_offset to pred(coef^.MCU_rows_per_iMCU_row) do - begin - for MCU_col_num := coef^.MCU_ctr to pred(cinfo^.MCUs_per_row) do - begin - { Construct list of pointers to DCT blocks belonging to this MCU } - blkn := 0; { index of current DCT block within MCU } - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - start_col := LongInt(MCU_col_num) * compptr^.MCU_width; - for yindex := 0 to pred(compptr^.MCU_height) do - begin - buffer_ptr := JBLOCKROW(@ buffer[ci]^[yindex+yoffset]^[start_col]); - for xindex := 0 to pred(compptr^.MCU_width) do - begin - coef^.MCU_buffer[blkn] := buffer_ptr; - Inc(blkn); - Inc(JBLOCK_PTR(buffer_ptr)); - end; - end; - end; - { Try to fetch the MCU. } - if (not cinfo^.entropy^.decode_mcu (cinfo, coef^.MCU_buffer)) then - begin - { Suspension forced; update state counters and exit } - coef^.MCU_vert_offset := yoffset; - coef^.MCU_ctr := MCU_col_num; - consume_data := JPEG_SUSPENDED; - exit; - end; - end; - { Completed an MCU row, but perhaps not an iMCU row } - coef^.MCU_ctr := 0; - end; - { Completed the iMCU row, advance counters for next one } - Inc(cinfo^.input_iMCU_row); - if (cinfo^.input_iMCU_row < cinfo^.total_iMCU_rows) then - begin - start_iMCU_row(cinfo); - consume_data := JPEG_ROW_COMPLETED; - exit; - end; - { Completed the scan } - cinfo^.inputctl^.finish_input_pass (cinfo); - consume_data := JPEG_SCAN_COMPLETED; -end; - - -{ Decompress and return some data in the multi-pass case. - Always attempts to emit one fully interleaved MCU row ("iMCU" row). - Return value is JPEG_ROW_COMPLETED, JPEG_SCAN_COMPLETED, or JPEG_SUSPENDED. - - NB: output_buf contains a plane for each component in image. } - -{METHODDEF} -function decompress_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - block_num : JDIMENSION; - ci, block_row, block_rows : int; - buffer : JBLOCKARRAY; - buffer_ptr : JBLOCKROW; - output_ptr : JSAMPARRAY; - output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Force some input to be done if we are getting ahead of the input. } - while (cinfo^.input_scan_number < cinfo^.output_scan_number) or - ((cinfo^.input_scan_number = cinfo^.output_scan_number) and - (LongInt(cinfo^.input_iMCU_row) <= cinfo^.output_iMCU_row)) do - begin - if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then - begin - decompress_data := JPEG_SUSPENDED; - exit; - end; - end; - - { OK, output from the virtual arrays. } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - continue; - { Align the virtual buffer for this component. } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - cinfo^.output_iMCU_row * compptr^.v_samp_factor, - JDIMENSION (compptr^.v_samp_factor), FALSE); - { Count non-dummy DCT block rows in this iMCU row. } - if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then - block_rows := compptr^.v_samp_factor - else - begin - { NB: can't use last_row_height here; it is input-side-dependent! } - block_rows := int(LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor); - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - end; - inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; - output_ptr := output_buf^[ci]; - { Loop over all DCT blocks to be processed. } - for block_row := 0 to pred(block_rows) do - begin - buffer_ptr := buffer^[block_row]; - output_col := 0; - for block_num := 0 to pred(compptr^.width_in_blocks) do - begin - inverse_DCT (cinfo, compptr, JCOEFPTR (buffer_ptr), - output_ptr, output_col); - Inc(JBLOCK_PTR(buffer_ptr)); - Inc(output_col, compptr^.DCT_scaled_size); - end; - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - Inc(compptr); - end; - - Inc(cinfo^.output_iMCU_row); - if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then - begin - decompress_data := JPEG_ROW_COMPLETED; - exit; - end; - decompress_data := JPEG_SCAN_COMPLETED; -end; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - - -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - -{ This code applies interblock smoothing as described by section K.8 - of the JPEG standard: the first 5 AC coefficients are estimated from - the DC values of a DCT block and its 8 neighboring blocks. - We apply smoothing only for progressive JPEG decoding, and only if - the coefficients it can estimate are not yet known to full precision. } - -{ Natural-order array positions of the first 5 zigzag-order coefficients } -const - Q01_POS = 1; - Q10_POS = 8; - Q20_POS = 16; - Q11_POS = 9; - Q02_POS = 2; - -{ Determine whether block smoothing is applicable and safe. - We also latch the current states of the coef_bits[] entries for the - AC coefficients; otherwise, if the input side of the decompressor - advances into a new scan, we might think the coefficients are known - more accurately than they really are. } - -{LOCAL} -function smoothing_ok (cinfo : j_decompress_ptr) : boolean; -var - coef : my_coef_ptr; - smoothing_useful : boolean; - ci, coefi : int; - compptr : jpeg_component_info_ptr; - qtable : JQUANT_TBL_PTR; - coef_bits : coef_bits_ptr; - coef_bits_latch : Latch_Ptr; -begin - coef := my_coef_ptr (cinfo^.coef); - smoothing_useful := FALSE; - - if (not cinfo^.progressive_mode) or (cinfo^.coef_bits = NIL) then - begin - smoothing_ok := FALSE; - exit; - end; - - { Allocate latch area if not already done } - if (coef^.coef_bits_latch = NIL) then - coef^.coef_bits_latch := Latch_Ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - cinfo^.num_components * - (SAVED_COEFS * SIZEOF(int))) ); - coef_bits_latch := (coef^.coef_bits_latch); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { All components' quantization values must already be latched. } - qtable := compptr^.quant_table; - if (qtable = NIL) then - begin - smoothing_ok := FALSE; - exit; - end; - { Verify DC & first 5 AC quantizers are nonzero to avoid zero-divide. } - if (qtable^.quantval[0] = 0) or - (qtable^.quantval[Q01_POS] = 0) or - (qtable^.quantval[Q10_POS] = 0) or - (qtable^.quantval[Q20_POS] = 0) or - (qtable^.quantval[Q11_POS] = 0) or - (qtable^.quantval[Q02_POS] = 0) then - begin - smoothing_ok := FALSE; - exit; - end; - { DC values must be at least partly known for all components. } - coef_bits := @cinfo^.coef_bits^[ci]; { Nomssi } - if (coef_bits^[0] < 0) then - begin - smoothing_ok := FALSE; - exit; - end; - { Block smoothing is helpful if some AC coefficients remain inaccurate. } - for coefi := 1 to 5 do - begin - coef_bits_latch^[coefi] := coef_bits^[coefi]; - if (coef_bits^[coefi] <> 0) then - smoothing_useful := TRUE; - end; - Inc(coef_bits_latch {SAVED_COEFS}); - Inc(compptr); - end; - - smoothing_ok := smoothing_useful; -end; - - -{ Variant of decompress_data for use when doing block smoothing. } - -{METHODDEF} -function decompress_smooth_data (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; -var - coef : my_coef_ptr; - last_iMCU_row : JDIMENSION; - block_num, last_block_column : JDIMENSION; - ci, block_row, block_rows, access_rows : int; - buffer : JBLOCKARRAY; - buffer_ptr, prev_block_row, next_block_row : JBLOCKROW; - output_ptr : JSAMPARRAY; - output_col : JDIMENSION; - compptr : jpeg_component_info_ptr; - inverse_DCT : inverse_DCT_method_ptr; - first_row, last_row : boolean; - workspace : JBLOCK; - coef_bits : Latch_Ptr; { coef_bits_ptr; } - quanttbl : JQUANT_TBL_PTR; - Q00,Q01,Q02,Q10,Q11,Q20, num : INT32; - DC1,DC2,DC3,DC4,DC5,DC6,DC7,DC8,DC9 : int; - Al, pred : int; -var - delta : JDIMENSION; -begin - coef := my_coef_ptr (cinfo^.coef); - last_iMCU_row := cinfo^.total_iMCU_rows - 1; - - { Force some input to be done if we are getting ahead of the input. } - while (cinfo^.input_scan_number <= cinfo^.output_scan_number) and - (not cinfo^.inputctl^.eoi_reached) do - begin - if (cinfo^.input_scan_number = cinfo^.output_scan_number) then - begin - { If input is working on current scan, we ordinarily want it to - have completed the current row. But if input scan is DC, - we want it to keep one row ahead so that next block row's DC - values are up to date. } - - if (cinfo^.Ss = 0) then - delta := 1 - else - delta := 0; - if (LongInt(cinfo^.input_iMCU_row) > cinfo^.output_iMCU_row+LongInt(delta)) then - break; - end; - if (cinfo^.inputctl^.consume_input(cinfo) = JPEG_SUSPENDED) then - begin - decompress_smooth_data := JPEG_SUSPENDED; - exit; - end; - end; - - { OK, output from the virtual arrays. } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to (cinfo^.num_components-1) do - begin - { Don't bother to IDCT an uninteresting component. } - if (not compptr^.component_needed) then - continue; - { Count non-dummy DCT block rows in this iMCU row. } - if (cinfo^.output_iMCU_row < LongInt(last_iMCU_row)) then - begin - block_rows := compptr^.v_samp_factor; - access_rows := block_rows * 2; { this and next iMCU row } - last_row := FALSE; - end - else - begin - { NB: can't use last_row_height here; it is input-side-dependent! } - block_rows := int (compptr^.height_in_blocks) mod compptr^.v_samp_factor; - if (block_rows = 0) then - block_rows := compptr^.v_samp_factor; - access_rows := block_rows; { this iMCU row only } - last_row := TRUE; - end; - { Align the virtual buffer for this component. } - if (cinfo^.output_iMCU_row > 0) then - begin - Inc(access_rows, compptr^.v_samp_factor); { prior iMCU row too } - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - (cinfo^.output_iMCU_row - 1) * compptr^.v_samp_factor, - JDIMENSION (access_rows), FALSE); - Inc(JBLOCKROW_PTR(buffer), compptr^.v_samp_factor); { point to current iMCU row } - first_row := FALSE; - end - else - begin - buffer := cinfo^.mem^.access_virt_barray - (j_common_ptr (cinfo), coef^.whole_image[ci], - JDIMENSION (0), JDIMENSION (access_rows), FALSE); - first_row := TRUE; - end; - { Fetch component-dependent info } - coef_bits := coef^.coef_bits_latch; - Inc(coef_bits, ci); { ci * SAVED_COEFS} - quanttbl := compptr^.quant_table; - Q00 := quanttbl^.quantval[0]; - Q01 := quanttbl^.quantval[Q01_POS]; - Q10 := quanttbl^.quantval[Q10_POS]; - Q20 := quanttbl^.quantval[Q20_POS]; - Q11 := quanttbl^.quantval[Q11_POS]; - Q02 := quanttbl^.quantval[Q02_POS]; - inverse_DCT := cinfo^.idct^.inverse_DCT[ci]; - output_ptr := output_buf^[ci]; - { Loop over all DCT blocks to be processed. } - for block_row := 0 to (block_rows-1) do - begin - buffer_ptr := buffer^[block_row]; - if (first_row) and (block_row = 0) then - prev_block_row := buffer_ptr - else - prev_block_row := buffer^[block_row-1]; - if (last_row) and (block_row = block_rows-1) then - next_block_row := buffer_ptr - else - next_block_row := buffer^[block_row+1]; - { We fetch the surrounding DC values using a sliding-register approach. - Initialize all nine here so as to do the right thing on narrow pics.} - - DC3 := int(prev_block_row^[0][0]); - DC2 := DC3; - DC1 := DC2; - DC6 := int(buffer_ptr^[0][0]); - DC5 := DC6; - DC4 := DC5; - DC9 := int(next_block_row^[0][0]); - DC8 := DC9; - DC7 := DC8 ; - output_col := 0; - last_block_column := compptr^.width_in_blocks - 1; - for block_num := 0 to last_block_column do - begin - { Fetch current DCT block into workspace so we can modify it. } - jcopy_block_row(buffer_ptr, JBLOCKROW (@workspace), JDIMENSION(1)); - { Update DC values } - if (block_num < last_block_column) then - begin - DC3 := int (prev_block_row^[1][0]); - DC6 := int (buffer_ptr^[1][0]); - DC9 := int (next_block_row^[1][0]); - end; - { Compute coefficient estimates per K.8. - An estimate is applied only if coefficient is still zero, - and is not known to be fully accurate. } - - { AC01 } - Al := coef_bits^[1]; - if (Al <> 0) and (workspace[1] = 0) then - begin - num := 36 * Q00 * (DC4 - DC6); - if (num >= 0) then - begin - pred := int (((Q01 shl 7) + num) div (Q01 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q01 shl 7) - num) div (Q01 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[1] := JCOEF (pred); - end; - { AC10 } - Al := coef_bits^[2]; - if (Al <> 0) and (workspace[8] = 0) then - begin - num := 36 * Q00 * (DC2 - DC8); - if (num >= 0) then - begin - pred := int (((Q10 shl 7) + num) div (Q10 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q10 shl 7) - num) div (Q10 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[8] := JCOEF (pred); - end; - { AC20 } - Al := coef_bits^[3]; - if (Al <> 0) and (workspace[16] = 0) then - begin - num := 9 * Q00 * (DC2 + DC8 - 2*DC5); - if (num >= 0) then - begin - pred := int (((Q20 shl 7) + num) div (Q20 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q20 shl 7) - num) div (Q20 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[16] := JCOEF (pred); - end; - { AC11 } - Al := coef_bits^[4]; - if (Al <> 0) and (workspace[9] = 0) then - begin - num := 5 * Q00 * (DC1 - DC3 - DC7 + DC9); - if (num >= 0) then - begin - pred := int (((Q11 shl 7) + num) div (Q11 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q11 shl 7) - num) div (Q11 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[9] := JCOEF (pred); - end; - { AC02 } - Al := coef_bits^[5]; - if (Al <> 0) and (workspace[2] = 0) then - begin - num := 9 * Q00 * (DC4 + DC6 - 2*DC5); - if (num >= 0) then - begin - pred := int (((Q02 shl 7) + num) div (Q02 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - end - else - begin - pred := int (((Q02 shl 7) - num) div (Q02 shl 8)); - if (Al > 0) and (pred >= (1 shl Al)) then - pred := (1 shl Al)-1; - pred := -pred; - end; - workspace[2] := JCOEF (pred); - end; - { OK, do the IDCT } - inverse_DCT (cinfo, compptr, JCOEFPTR (@workspace), - output_ptr, output_col); - { Advance for next column } - DC1 := DC2; DC2 := DC3; - DC4 := DC5; DC5 := DC6; - DC7 := DC8; DC8 := DC9; - Inc(JBLOCK_PTR(buffer_ptr)); - Inc(JBLOCK_PTR(prev_block_row)); - Inc(JBLOCK_PTR(next_block_row)); - Inc(output_col, compptr^.DCT_scaled_size); - end; - Inc(JSAMPROW_PTR(output_ptr), compptr^.DCT_scaled_size); - end; - Inc(compptr); - end; - - Inc(cinfo^.output_iMCU_row); - if (cinfo^.output_iMCU_row < LongInt(cinfo^.total_iMCU_rows)) then - begin - decompress_smooth_data := JPEG_ROW_COMPLETED; - exit; - end; - decompress_smooth_data := JPEG_SCAN_COMPLETED; -end; - -{$endif} { BLOCK_SMOOTHING_SUPPORTED } - - -{ Initialize coefficient buffer controller. } - -{GLOBAL} -procedure jinit_d_coef_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -var - coef : my_coef_ptr; -{$ifdef D_MULTISCAN_FILES_SUPPORTED} -var - ci, access_rows : int; - compptr : jpeg_component_info_ptr; -{$endif} -var - buffer : JBLOCK_PTR; - i : int; -begin - coef := my_coef_ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - SIZEOF(my_coef_controller)) ); - cinfo^.coef := jpeg_d_coef_controller_ptr(coef); - coef^.pub.start_input_pass := start_input_pass; - coef^.pub.start_output_pass := start_output_pass; -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - coef^.coef_bits_latch := NIL; -{$endif} - - { Create the coefficient buffer. } - if (need_full_buffer) then - begin -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - { Allocate a full-image virtual array for each component, } - { padded to a multiple of samp_factor DCT blocks in each direction. } - { Note we ask for a pre-zeroed array. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - access_rows := compptr^.v_samp_factor; -{$ifdef BLOCK_SMOOTHING_SUPPORTED} - { If block smoothing could be used, need a bigger window } - if (cinfo^.progressive_mode) then - access_rows := access_rows * 3; -{$endif} - coef^.whole_image[ci] := cinfo^.mem^.request_virt_barray - (j_common_ptr (cinfo), JPOOL_IMAGE, TRUE, - JDIMENSION (jround_up( long(compptr^.width_in_blocks), - long(compptr^.h_samp_factor) )), - JDIMENSION (jround_up( long(compptr^.height_in_blocks), - long(compptr^.v_samp_factor) )), - JDIMENSION (access_rows)); - Inc(compptr); - end; - coef^.pub.consume_data := consume_data; - coef^.pub.decompress_data := decompress_data; - coef^.pub.coef_arrays := @(coef^.whole_image); - { link to virtual arrays } -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - { We only need a single-MCU buffer. } - buffer := JBLOCK_PTR ( - cinfo^.mem^.alloc_large (j_common_ptr (cinfo), JPOOL_IMAGE, - D_MAX_BLOCKS_IN_MCU * SIZEOF(JBLOCK)) ); - for i := 0 to pred(D_MAX_BLOCKS_IN_MCU) do - begin - coef^.MCU_buffer[i] := JBLOCKROW(buffer); - Inc(buffer); - end; - coef^.pub.consume_data := dummy_consume_data; - coef^.pub.decompress_data := decompress_onepass; - coef^.pub.coef_arrays := NIL; { flag for no virtual arrays } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdcolor.pas b/3rd/Imaging/Source/JpegLib/imjdcolor.pas deleted file mode 100644 index 64c5f41df..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdcolor.pas +++ /dev/null @@ -1,501 +0,0 @@ -unit imjdcolor; - -{ This file contains output colorspace conversion routines. } - -{ Original: jdcolor.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjdeferr, - imjerror, - imjpeglib; - -{ Module initialization routine for output colorspace conversion. } - -{GLOBAL} -procedure jinit_color_deconverter (cinfo : j_decompress_ptr); - -implementation - -{ Private subobject } -type - int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; - int_table_ptr = ^int_Color_Table; - INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; - INT32_table_ptr = ^INT32_Color_Table; -type - my_cconvert_ptr = ^my_color_deconverter; - my_color_deconverter = record - pub : jpeg_color_deconverter; { public fields } - - { Private state for YCC^.RGB conversion } - Cr_r_tab : int_table_ptr; { => table for Cr to R conversion } - Cb_b_tab : int_table_ptr; { => table for Cb to B conversion } - Cr_g_tab : INT32_table_ptr; { => table for Cr to G conversion } - Cb_g_tab : INT32_table_ptr; { => table for Cb to G conversion } - end; - - - - -{*************** YCbCr ^. RGB conversion: most common case *************} - -{ YCbCr is defined per CCIR 601-1, except that Cb and Cr are - normalized to the range 0..MAXJSAMPLE rather than -0.5 .. 0.5. - The conversion equations to be implemented are therefore - R = Y + 1.40200 * Cr - G = Y - 0.34414 * Cb - 0.71414 * Cr - B = Y + 1.77200 * Cb - where Cb and Cr represent the incoming values less CENTERJSAMPLE. - (These numbers are derived from TIFF 6.0 section 21, dated 3-June-92.) - - To avoid floating-point arithmetic, we represent the fractional constants - as integers scaled up by 2^16 (about 4 digits precision); we have to divide - the products by 2^16, with appropriate rounding, to get the correct answer. - Notice that Y, being an integral input, does not contribute any fraction - so it need not participate in the rounding. - - For even more speed, we avoid doing any multiplications in the inner loop - by precalculating the constants times Cb and Cr for all possible values. - For 8-bit JSAMPLEs this is very reasonable (only 256 entries per table); - for 12-bit samples it is still acceptable. It's not very reasonable for - 16-bit samples, but if you want lossless storage you shouldn't be changing - colorspace anyway. - The Cr=>R and Cb=>B values can be rounded to integers in advance; the - values for the G calculation are left scaled up, since we must add them - together before rounding. } - -const - SCALEBITS = 16; { speediest right-shift on some machines } - ONE_HALF = (INT32(1) shl (SCALEBITS-1)); - - -{ Initialize tables for YCC->RGB colorspace conversion. } - -{LOCAL} -procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); -const - FIX_1_40200 = INT32(Round( 1.40200 * (1 shl SCALEBITS))); - FIX_1_77200 = INT32(Round( 1.77200 * (1 shl SCALEBITS))); - FIX_0_71414 = INT32(Round( 0.71414 * (1 shl SCALEBITS))); - FIX_0_34414 = INT32(Round( 0.34414 * (1 shl SCALEBITS))); - -var - cconvert : my_cconvert_ptr; - i : int; - x : INT32; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - - - cconvert^.Cr_r_tab := int_table_ptr( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - cconvert^.Cb_b_tab := int_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - cconvert^.Cr_g_tab := INT32_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - cconvert^.Cb_g_tab := INT32_table_ptr ( - cinfo^.mem^.alloc_small ( j_common_ptr(cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - - - x := -CENTERJSAMPLE; - for i := 0 to MAXJSAMPLE do - begin - { i is the actual input pixel value, in the range 0..MAXJSAMPLE } - { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } - { Cr=>R value is nearest int to 1.40200 * x } - - shift_temp := FIX_1_40200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cconvert^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cconvert^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cb=>B value is nearest int to 1.77200 * x } - shift_temp := FIX_1_77200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cconvert^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cconvert^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cr=>G value is scaled-up -0.71414 * x } - cconvert^.Cr_g_tab^[i] := (- FIX_0_71414 ) * x; - { Cb=>G value is scaled-up -0.34414 * x } - { We also add in ONE_HALF so that need not do it in inner loop } - cconvert^.Cb_g_tab^[i] := (- FIX_0_34414 ) * x + ONE_HALF; - Inc(x); - end; -end; - - -{ Convert some rows of samples to the output colorspace. - - Note that we change from noninterleaved, one-plane-per-component format - to interleaved-pixel format. The output buffer is therefore three times - as wide as the input buffer. - A starting row offset is provided only for the input buffer. The caller - can easily adjust the passed output_buf value to accommodate any row - offset required on that side. } - -{METHODDEF} -procedure ycc_rgb_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} y, cb, cr : int; - {register} outptr : JSAMPROW; - {register} inptr0, inptr1, inptr2 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - {register} Crrtab : int_table_ptr; - {register} Cbbtab : int_table_ptr; - {register} Crgtab : INT32_table_ptr; - {register} Cbgtab : INT32_table_ptr; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - num_cols := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - Crrtab := cconvert^.Cr_r_tab; - Cbbtab := cconvert^.Cb_b_tab; - Crgtab := cconvert^.Cr_g_tab; - Cbgtab := cconvert^.Cb_g_tab; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr0 := input_buf^[0]^[input_row]; - inptr1 := input_buf^[1]^[input_row]; - inptr2 := input_buf^[2]^[input_row]; - Inc(input_row); - outptr := output_buf^[0]; - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - y := GETJSAMPLE(inptr0^[col]); - cb := GETJSAMPLE(inptr1^[col]); - cr := GETJSAMPLE(inptr2^[col]); - { Range-limiting is essential due to noise introduced by DCT losses. } - outptr^[RGB_RED] := range_limit^[y + Crrtab^[cr]]; - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - outptr^[RGB_GREEN] := range_limit^[y + int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS)))] - else - outptr^[RGB_GREEN] := range_limit^[y + int(shift_temp shr SCALEBITS)]; - - outptr^[RGB_BLUE] := range_limit^[y + Cbbtab^[cb]]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - end; - end; -end; - - -{*************** Cases other than YCbCr -> RGB *************} - - -{ Color conversion for no colorspace change: just copy the data, - converting from separate-planes to interleaved representation. } - -{METHODDEF} -procedure null_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - {register} inptr, - outptr : JSAMPLE_PTR; - {register} count : JDIMENSION; - {register} num_components : int; - num_cols : JDIMENSION; - ci : int; -begin - num_components := cinfo^.num_components; - num_cols := cinfo^.output_width; - - while (num_rows > 0) do - begin - Dec(num_rows); - for ci := 0 to pred(num_components) do - begin - inptr := JSAMPLE_PTR(input_buf^[ci]^[input_row]); - outptr := JSAMPLE_PTR(@(output_buf^[0]^[ci])); - - for count := pred(num_cols) downto 0 do - begin - outptr^ := inptr^; { needn't bother with GETJSAMPLE() here } - Inc(inptr); - Inc(outptr, num_components); - end; - end; - Inc(input_row); - Inc(JSAMPROW_PTR(output_buf)); - end; -end; - - -{ Color conversion for grayscale: just copy the data. - This also works for YCbCr -> grayscale conversion, in which - we just copy the Y (luminance) component and ignore chrominance. } - -{METHODDEF} -procedure grayscale_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -begin - jcopy_sample_rows(input_buf^[0], int(input_row), output_buf, 0, - num_rows, cinfo^.output_width); -end; - -{ Convert grayscale to RGB: just duplicate the graylevel three times. - This is provided to support applications that don't want to cope - with grayscale as a separate case. } - -{METHODDEF} -procedure gray_rgb_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - {register} inptr, outptr : JSAMPLE_PTR; - {register} col : JDIMENSION; - num_cols : JDIMENSION; -begin - num_cols := cinfo^.output_width; - while (num_rows > 0) do - begin - inptr := JSAMPLE_PTR(input_buf^[0]^[input_row]); - Inc(input_row); - outptr := JSAMPLE_PTR(@output_buf^[0]); - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - { We can dispense with GETJSAMPLE() here } - JSAMPROW(outptr)^[RGB_RED] := inptr^; - JSAMPROW(outptr)^[RGB_GREEN] := inptr^; - JSAMPROW(outptr)^[RGB_BLUE] := inptr^; - Inc(inptr); - Inc(outptr, RGB_PIXELSIZE); - end; - Dec(num_rows); - end; -end; - - -{ Adobe-style YCCK -> CMYK conversion. - We convert YCbCr to R=1-C, G=1-M, and B=1-Y using the same - conversion as above, while passing K (black) unchanged. - We assume build_ycc_rgb_table has been called. } - -{METHODDEF} -procedure ycck_cmyk_convert (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); -var - cconvert : my_cconvert_ptr; - {register} y, cb, cr : int; - {register} outptr : JSAMPROW; - {register} inptr0, inptr1, inptr2, inptr3 : JSAMPROW; - {register} col : JDIMENSION; - num_cols : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - {register} Crrtab : int_table_ptr; - {register} Cbbtab : int_table_ptr; - {register} Crgtab : INT32_table_ptr; - {register} Cbgtab : INT32_table_ptr; -var - shift_temp : INT32; -begin - cconvert := my_cconvert_ptr (cinfo^.cconvert); - num_cols := cinfo^.output_width; - { copy these pointers into registers if possible } - range_limit := cinfo^.sample_range_limit; - Crrtab := cconvert^.Cr_r_tab; - Cbbtab := cconvert^.Cb_b_tab; - Crgtab := cconvert^.Cr_g_tab; - Cbgtab := cconvert^.Cb_g_tab; - - while (num_rows > 0) do - begin - Dec(num_rows); - inptr0 := input_buf^[0]^[input_row]; - inptr1 := input_buf^[1]^[input_row]; - inptr2 := input_buf^[2]^[input_row]; - inptr3 := input_buf^[3]^[input_row]; - Inc(input_row); - outptr := output_buf^[0]; - Inc(JSAMPROW_PTR(output_buf)); - for col := 0 to pred(num_cols) do - begin - y := GETJSAMPLE(inptr0^[col]); - cb := GETJSAMPLE(inptr1^[col]); - cr := GETJSAMPLE(inptr2^[col]); - { Range-limiting is essential due to noise introduced by DCT losses. } - outptr^[0] := range_limit^[MAXJSAMPLE - (y + Crrtab^[cr])]; { red } - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then - outptr^[1] := range_limit^[MAXJSAMPLE - (y + int( - (shift_temp shr SCALEBITS) or ((not INT32(0)) shl (32-SCALEBITS)) - ) )] - else - outptr^[1] := range_limit^[MAXJSAMPLE - { green } - (y + int(shift_temp shr SCALEBITS) )]; - outptr^[2] := range_limit^[MAXJSAMPLE - (y + Cbbtab^[cb])]; { blue } - { K passes through unchanged } - outptr^[3] := inptr3^[col]; { don't need GETJSAMPLE here } - Inc(JSAMPLE_PTR(outptr), 4); - end; - end; -end; - - -{ Empty method for start_pass. } - -{METHODDEF} -procedure start_pass_dcolor (cinfo : j_decompress_ptr); -begin - { no work needed } -end; - - -{ Module initialization routine for output colorspace conversion. } - -{GLOBAL} -procedure jinit_color_deconverter (cinfo : j_decompress_ptr); -var - cconvert : my_cconvert_ptr; - ci : int; -begin - cconvert := my_cconvert_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_color_deconverter)) ); - cinfo^.cconvert := jpeg_color_deconverter_ptr (cconvert); - cconvert^.pub.start_pass := start_pass_dcolor; - - { Make sure num_components agrees with jpeg_color_space } - case (cinfo^.jpeg_color_space) of - JCS_GRAYSCALE: - if (cinfo^.num_components <> 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - JCS_RGB, - JCS_YCbCr: - if (cinfo^.num_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - JCS_CMYK, - JCS_YCCK: - if (cinfo^.num_components <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - - else { JCS_UNKNOWN can be anything } - if (cinfo^.num_components < 1) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_J_COLORSPACE); - end; - - { Set out_color_components and conversion method based on requested space. - Also clear the component_needed flags for any unused components, - so that earlier pipeline stages can avoid useless computation. } - - case (cinfo^.out_color_space) of - JCS_GRAYSCALE: - begin - cinfo^.out_color_components := 1; - if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) - or (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - cconvert^.pub.color_convert := grayscale_convert; - { For color -> grayscale conversion, only the - Y (0) component is needed } - for ci := 1 to pred(cinfo^.num_components) do - cinfo^.comp_info^[ci].component_needed := FALSE; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_RGB: - begin - cinfo^.out_color_components := RGB_PIXELSIZE; - if (cinfo^.jpeg_color_space = JCS_YCbCr) then - begin - cconvert^.pub.color_convert := ycc_rgb_convert; - build_ycc_rgb_table(cinfo); - end - else - if (cinfo^.jpeg_color_space = JCS_GRAYSCALE) then - begin - cconvert^.pub.color_convert := gray_rgb_convert; - end - else - if (cinfo^.jpeg_color_space = JCS_RGB) and (RGB_PIXELSIZE = 3) then - begin - cconvert^.pub.color_convert := null_convert; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - JCS_CMYK: - begin - cinfo^.out_color_components := 4; - if (cinfo^.jpeg_color_space = JCS_YCCK) then - begin - cconvert^.pub.color_convert := ycck_cmyk_convert; - build_ycc_rgb_table(cinfo); - end - else - if (cinfo^.jpeg_color_space = JCS_CMYK) then - begin - cconvert^.pub.color_convert := null_convert; - end - else - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - - else - begin { Permit null conversion to same output space } - if (cinfo^.out_color_space = cinfo^.jpeg_color_space) then - begin - cinfo^.out_color_components := cinfo^.num_components; - cconvert^.pub.color_convert := null_convert; - end - else { unsupported non-null conversion } - ERREXIT(j_common_ptr(cinfo), JERR_CONVERSION_NOTIMPL); - end; - end; - - if (cinfo^.quantize_colors) then - cinfo^.output_components := 1 { single colormapped output component } - else - cinfo^.output_components := cinfo^.out_color_components; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdct.pas b/3rd/Imaging/Source/JpegLib/imjdct.pas deleted file mode 100644 index 30d335672..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdct.pas +++ /dev/null @@ -1,109 +0,0 @@ -unit imjdct; - -{ Orignal: jdct.h; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This include file contains common declarations for the forward and - inverse DCT modules. These declarations are private to the DCT managers - (jcdctmgr.c, jddctmgr.c) and the individual DCT algorithms. - The individual DCT algorithms are kept in separate files to ease - machine-dependent tuning (e.g., assembly coding). } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg; - - -{ A forward DCT routine is given a pointer to a work area of type DCTELEM[]; - the DCT is to be performed in-place in that buffer. Type DCTELEM is int - for 8-bit samples, INT32 for 12-bit samples. (NOTE: Floating-point DCT - implementations use an array of type FAST_FLOAT, instead.) - The DCT inputs are expected to be signed (range +-CENTERJSAMPLE). - The DCT outputs are returned scaled up by a factor of 8; they therefore - have a range of +-8K for 8-bit data, +-128K for 12-bit data. This - convention improves accuracy in integer implementations and saves some - work in floating-point ones. - Quantization of the output coefficients is done by jcdctmgr.c. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - DCTELEM = int; { 16 or 32 bits is fine } -{$else} -type { must have 32 bits } - DCTELEM = INT32; -{$endif} -type - jTDctElem = 0..(MaxInt div SizeOf(DCTELEM))-1; - DCTELEM_FIELD = array[jTDctElem] of DCTELEM; - DCTELEM_FIELD_PTR = ^DCTELEM_FIELD; - DCTELEMPTR = ^DCTELEM; - -type - forward_DCT_method_ptr = procedure(var data : array of DCTELEM); - float_DCT_method_ptr = procedure(var data : array of FAST_FLOAT); - - -{ An inverse DCT routine is given a pointer to the input JBLOCK and a pointer - to an output sample array. The routine must dequantize the input data as - well as perform the IDCT; for dequantization, it uses the multiplier table - pointed to by compptr->dct_table. The output data is to be placed into the - sample array starting at a specified column. (Any row offset needed will - be applied to the array pointer before it is passed to the IDCT code.) - Note that the number of samples emitted by the IDCT routine is - DCT_scaled_size * DCT_scaled_size. } - - -{ typedef inverse_DCT_method_ptr is declared in jpegint.h } - - -{ Each IDCT routine has its own ideas about the best dct_table element type. } - - -type - ISLOW_MULT_TYPE = MULTIPLIER; { short or int, whichever is faster } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - IFAST_MULT_TYPE = MULTIPLIER; { 16 bits is OK, use short if faster } -const - IFAST_SCALE_BITS = 2; { fractional bits in scale factors } -{$else} -type - IFAST_MULT_TYPE = INT32; { need 32 bits for scaled quantizers } -const - IFAST_SCALE_BITS = 13; { fractional bits in scale factors } -{$endif} -type - FLOAT_MULT_TYPE = FAST_FLOAT; { preferred floating type } - -const - RANGE_MASK = (MAXJSAMPLE * 4 + 3); { 2 bits wider than legal samples } - -type - jTMultType = 0..(MaxInt div SizeOf(ISLOW_MULT_TYPE))-1; - ISLOW_MULT_TYPE_FIELD = array[jTMultType] of ISLOW_MULT_TYPE; - ISLOW_MULT_TYPE_FIELD_PTR = ^ISLOW_MULT_TYPE_FIELD; - ISLOW_MULT_TYPE_PTR = ^ISLOW_MULT_TYPE; - - jTFloatType = 0..(MaxInt div SizeOf(FLOAT_MULT_TYPE))-1; - FLOAT_MULT_TYPE_FIELD = array[jTFloatType] of FLOAT_MULT_TYPE; - FLOAT_MULT_TYPE_FIELD_PTR = ^FLOAT_MULT_TYPE_FIELD; - FLOAT_MULT_TYPE_PTR = ^FLOAT_MULT_TYPE; - - jTFastType = 0..(MaxInt div SizeOf(IFAST_MULT_TYPE))-1; - IFAST_MULT_TYPE_FIELD = array[jTFastType] of IFAST_MULT_TYPE; - IFAST_MULT_TYPE_FIELD_PTR = ^IFAST_MULT_TYPE_FIELD; - IFAST_MULT_TYPE_PTR = ^IFAST_MULT_TYPE; - -type - jTFastFloat = 0..(MaxInt div SizeOf(FAST_FLOAT))-1; - FAST_FLOAT_FIELD = array[jTFastFloat] of FAST_FLOAT; - FAST_FLOAT_FIELD_PTR = ^FAST_FLOAT_FIELD; - FAST_FLOAT_PTR = ^FAST_FLOAT; - -implementation - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjddctmgr.pas b/3rd/Imaging/Source/JpegLib/imjddctmgr.pas deleted file mode 100644 index 5e62b3a3b..000000000 --- a/3rd/Imaging/Source/JpegLib/imjddctmgr.pas +++ /dev/null @@ -1,330 +0,0 @@ -unit imjddctmgr; - -{ Original : jddctmgr.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file contains the inverse-DCT management logic. - This code selects a particular IDCT implementation to be used, - and it performs related housekeeping chores. No code in this file - is executed per IDCT step, only during output pass setup. - - Note that the IDCT routines are responsible for performing coefficient - dequantization as well as the IDCT proper. This module sets up the - dequantization multiplier table needed by the IDCT routine. } - -interface - -{$I imjconfig.inc} - -{$N+} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjdct, { Private declarations for DCT subsystem } - imjidctfst, - {$IFDEF BASM} - imjidctasm, - {$ELSE} - imjidctint, - {$ENDIF} - imjidctflt, - imjidctred; - - - -{ Initialize IDCT manager. } - -{GLOBAL} -procedure jinit_inverse_dct (cinfo : j_decompress_ptr); - - -implementation - -{ The decompressor input side (jdinput.c) saves away the appropriate - quantization table for each component at the start of the first scan - involving that component. (This is necessary in order to correctly - decode files that reuse Q-table slots.) - When we are ready to make an output pass, the saved Q-table is converted - to a multiplier table that will actually be used by the IDCT routine. - The multiplier table contents are IDCT-method-dependent. To support - application changes in IDCT method between scans, we can remake the - multiplier tables if necessary. - In buffered-image mode, the first output pass may occur before any data - has been seen for some components, and thus before their Q-tables have - been saved away. To handle this case, multiplier tables are preset - to zeroes; the result of the IDCT will be a neutral gray level. } - - -{ Private subobject for this module } - -type - my_idct_ptr = ^my_idct_controller; - my_idct_controller = record - pub : jpeg_inverse_dct; { public fields } - - { This array contains the IDCT method code that each multiplier table - is currently set up for, or -1 if it's not yet set up. - The actual multiplier tables are pointed to by dct_table in the - per-component comp_info structures. } - - cur_method : array[0..MAX_COMPONENTS-1] of int; - end; {my_idct_controller;} - - -{ Allocated multiplier tables: big enough for any supported variant } - -type - multiplier_table = record - case byte of - 0:(islow_array : array[0..DCTSIZE2-1] of ISLOW_MULT_TYPE); - {$ifdef DCT_IFAST_SUPPORTED} - 1:(ifast_array : array[0..DCTSIZE2-1] of IFAST_MULT_TYPE); - {$endif} - {$ifdef DCT_FLOAT_SUPPORTED} - 2:(float_array : array[0..DCTSIZE2-1] of FLOAT_MULT_TYPE); - {$endif} - end; - - -{ The current scaled-IDCT routines require ISLOW-style multiplier tables, - so be sure to compile that code if either ISLOW or SCALING is requested. } - -{$ifdef DCT_ISLOW_SUPPORTED} - {$define PROVIDE_ISLOW_TABLES} -{$else} - {$ifdef IDCT_SCALING_SUPPORTED} - {$define PROVIDE_ISLOW_TABLES} - {$endif} -{$endif} - - -{ Prepare for an output pass. - Here we select the proper IDCT routine for each component and build - a matching multiplier table. } - -{METHODDEF} -procedure start_pass (cinfo : j_decompress_ptr); -var - idct : my_idct_ptr; - ci, i : int; - compptr : jpeg_component_info_ptr; - method : J_DCT_METHOD; - method_ptr : inverse_DCT_method_ptr; - qtbl : JQUANT_TBL_PTR; -{$ifdef PROVIDE_ISLOW_TABLES} -var - ismtbl : ISLOW_MULT_TYPE_FIELD_PTR; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} -const - CONST_BITS = 14; -const - aanscales : array[0..DCTSIZE2-1] of INT16 = - ({ precomputed values scaled up by 14 bits } - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 22725, 31521, 29692, 26722, 22725, 17855, 12299, 6270, - 21407, 29692, 27969, 25172, 21407, 16819, 11585, 5906, - 19266, 26722, 25172, 22654, 19266, 15137, 10426, 5315, - 16384, 22725, 21407, 19266, 16384, 12873, 8867, 4520, - 12873, 17855, 16819, 15137, 12873, 10114, 6967, 3552, - 8867, 12299, 11585, 10426, 8867, 6967, 4799, 2446, - 4520, 6270, 5906, 5315, 4520, 3552, 2446, 1247); -var - ifmtbl : IFAST_MULT_TYPE_FIELD_PTR; - {SHIFT_TEMPS} - - { Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - - function DESCALE(x : INT32; n : int) : INT32; - var - shift_temp : INT32; - begin - {$ifdef RIGHT_SHIFT_IS_UNSIGNED} - shift_temp := x + (INT32(1) shl (n-1)); - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - Descale := (shift_temp shr n); - {$else} - Descale := (x + (INT32(1) shl (n-1)) shr n; - {$endif} - end; - -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} -const - aanscalefactor : array[0..DCTSIZE-1] of double = - (1.0, 1.387039845, 1.306562965, 1.175875602, - 1.0, 0.785694958, 0.541196100, 0.275899379); -var - fmtbl : FLOAT_MULT_TYPE_FIELD_PTR; - row, col : int; -{$endif} -begin - idct := my_idct_ptr (cinfo^.idct); - method := J_DCT_METHOD(0); - method_ptr := NIL; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - - for ci := 0 to pred(cinfo^.num_components) do - begin - { Select the proper IDCT routine for this component's scaling } - case (compptr^.DCT_scaled_size) of -{$ifdef IDCT_SCALING_SUPPORTED} - 1:begin - method_ptr := jpeg_idct_1x1; - method := JDCT_ISLOW; { jidctred uses islow-style table } - end; - 2:begin - method_ptr := jpeg_idct_2x2; - method := JDCT_ISLOW; { jidctred uses islow-style table } - end; - 4:begin - method_ptr := jpeg_idct_4x4; - method := JDCT_ISLOW; { jidctred uses islow-style table } - end; -{$endif} - DCTSIZE: - case (cinfo^.dct_method) of -{$ifdef DCT_ISLOW_SUPPORTED} - JDCT_ISLOW: - begin - method_ptr := @jpeg_idct_islow; - method := JDCT_ISLOW; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - method_ptr := @jpeg_idct_ifast; - method := JDCT_IFAST; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - JDCT_FLOAT: - begin - method_ptr := @jpeg_idct_float; - method := JDCT_FLOAT; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; - else - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_DCTSIZE, compptr^.DCT_scaled_size); - end; - idct^.pub.inverse_DCT[ci] := method_ptr; - { Create multiplier table from quant table. - However, we can skip this if the component is uninteresting - or if we already built the table. Also, if no quant table - has yet been saved for the component, we leave the - multiplier table all-zero; we'll be reading zeroes from the - coefficient controller's buffer anyway. } - - if (not compptr^.component_needed) or (idct^.cur_method[ci] = int(method)) then - continue; - qtbl := compptr^.quant_table; - if (qtbl = NIL) then { happens if no data yet for component } - continue; - idct^.cur_method[ci] := int(method); - case (method) of -{$ifdef PROVIDE_ISLOW_TABLES} - JDCT_ISLOW: - begin - { For LL&M IDCT method, multipliers are equal to raw quantization - coefficients, but are stored as ints to ensure access efficiency. } - - ismtbl := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - for i := 0 to pred(DCTSIZE2) do - begin - ismtbl^[i] := ISLOW_MULT_TYPE (qtbl^.quantval[i]); - end; - end; -{$endif} -{$ifdef DCT_IFAST_SUPPORTED} - JDCT_IFAST: - begin - { For AA&N IDCT method, multipliers are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 - For integer operation, the multiplier table is to be scaled by - IFAST_SCALE_BITS. } - - ifmtbl := IFAST_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - - for i := 0 to pred(DCTSIZE2) do - begin - ifmtbl^[i] := IFAST_MULT_TYPE( - DESCALE( INT32 (qtbl^.quantval[i]) * INT32 (aanscales[i]), - CONST_BITS-IFAST_SCALE_BITS) ); - end; - end; -{$endif} -{$ifdef DCT_FLOAT_SUPPORTED} - JDCT_FLOAT: - begin - { For float AA&N IDCT method, multipliers are equal to quantization - coefficients scaled by scalefactor[row]*scalefactor[col], where - scalefactor[0] := 1 - scalefactor[k] := cos(k*PI/16) * sqrt(2) for k=1..7 } - - fmtbl := FLOAT_MULT_TYPE_FIELD_PTR(compptr^.dct_table); - - i := 0; - for row := 0 to pred(DCTSIZE) do - begin - for col := 0 to pred(DCTSIZE) do - begin - fmtbl^[i] := {FLOAT_MULT_TYPE} ( - {double} qtbl^.quantval[i] * - aanscalefactor[row] * aanscalefactor[col] ); - Inc(i); - end; - end; - end; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - break; - end; - Inc(compptr); - end; -end; - - -{ Initialize IDCT manager. } - -{GLOBAL} -procedure jinit_inverse_dct (cinfo : j_decompress_ptr); -var - idct : my_idct_ptr; - ci : int; - compptr : jpeg_component_info_ptr; -begin - idct := my_idct_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_idct_controller)) ); - cinfo^.idct := jpeg_inverse_dct_ptr (idct); - idct^.pub.start_pass := start_pass; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Allocate and pre-zero a multiplier table for each component } - compptr^.dct_table := - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(multiplier_table)); - MEMZERO(compptr^.dct_table, SIZEOF(multiplier_table)); - { Mark multiplier table not yet set up for any method } - idct^.cur_method[ci] := -1; - Inc(compptr); - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdeferr.pas b/3rd/Imaging/Source/JpegLib/imjdeferr.pas deleted file mode 100644 index eeaf6f619..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdeferr.pas +++ /dev/null @@ -1,497 +0,0 @@ -unit imjdeferr; - -{ This file defines the error and message codes for the cjpeg/djpeg - applications. These strings are not needed as part of the JPEG library - proper. - Edit this file to add new codes, or to translate the message strings to - some other language. } - -{ Original cderror.h ; Copyright (C) 1994, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -{ To define the enum list of message codes, include this file without - defining macro JMESSAGE. To create a message string table, include it - again with a suitable JMESSAGE definition (see jerror.c for an example). } - - -{ Original: jversion.h ; Copyright (C) 1991-1996, Thomas G. Lane. } -{ This file contains software version identification. } - -const - JVERSION = '6a 7-Feb-96'; - - JCOPYRIGHT = 'Copyright (C) 1996, Thomas G. Lane'; - - JNOTICE = 'Pascal Translation, Copyright (C) 1996, Jacques Nomssi Nzali'; - -{ Create the message string table. - We do this from the master message list in jerror.h by re-reading - jerror.h with a suitable definition for macro JMESSAGE. - The message table is made an external symbol just in case any applications - want to refer to it directly. } - -type - J_MESSAGE_CODE =( - JMSG_NOMESSAGE, - JERR_ARITH_NOTIMPL, - JERR_BAD_ALIGN_TYPE, - JERR_BAD_ALLOC_CHUNK, - JERR_BAD_BUFFER_MODE, - JERR_BAD_COMPONENT_ID, - JERR_BAD_DCT_COEF, - JERR_BAD_DCTSIZE, - JERR_BAD_HUFF_TABLE, - JERR_BAD_IN_COLORSPACE, - JERR_BAD_J_COLORSPACE, - JERR_BAD_LENGTH, - JERR_BAD_LIB_VERSION, - JERR_BAD_MCU_SIZE, - JERR_BAD_POOL_ID, - JERR_BAD_PRECISION, - JERR_BAD_PROGRESSION, - JERR_BAD_PROG_SCRIPT, - JERR_BAD_SAMPLING, - JERR_BAD_SCAN_SCRIPT, - JERR_BAD_STATE, - JERR_BAD_STRUCT_SIZE, - JERR_BAD_VIRTUAL_ACCESS, - JERR_BUFFER_SIZE, - JERR_CANT_SUSPEND, - JERR_CCIR601_NOTIMPL, - JERR_COMPONENT_COUNT, - JERR_CONVERSION_NOTIMPL, - JERR_DAC_INDEX, - JERR_DAC_VALUE, - JERR_DHT_COUNTS, - JERR_DHT_INDEX, - JERR_DQT_INDEX, - JERR_EMPTY_IMAGE, - JERR_EMS_READ, - JERR_EMS_WRITE, - JERR_EOI_EXPECTED, - JERR_FILE_READ, - JERR_FILE_WRITE, - JERR_FRACT_SAMPLE_NOTIMPL, - JERR_HUFF_CLEN_OVERFLOW, - JERR_HUFF_MISSING_CODE, - JERR_IMAGE_TOO_BIG, - JERR_INPUT_EMPTY, - JERR_INPUT_EOF, - JERR_MISMATCHED_QUANT_TABLE, - JERR_MISSING_DATA, - JERR_MODE_CHANGE, - JERR_NOTIMPL, - JERR_NOT_COMPILED, - JERR_NO_BACKING_STORE, - JERR_NO_HUFF_TABLE, - JERR_NO_IMAGE, - JERR_NO_QUANT_TABLE, - JERR_NO_SOI, - JERR_OUT_OF_MEMORY, - JERR_QUANT_COMPONENTS, - JERR_QUANT_FEW_COLORS, - JERR_QUANT_MANY_COLORS, - JERR_SOF_DUPLICATE, - JERR_SOF_NO_SOS, - JERR_SOF_UNSUPPORTED, - JERR_SOI_DUPLICATE, - JERR_SOS_NO_SOF, - JERR_TFILE_CREATE, - JERR_TFILE_READ, - JERR_TFILE_SEEK, - JERR_TFILE_WRITE, - JERR_TOO_LITTLE_DATA, - JERR_UNKNOWN_MARKER, - JERR_VIRTUAL_BUG, - JERR_WIDTH_OVERFLOW, - JERR_XMS_READ, - JERR_XMS_WRITE, - JMSG_COPYRIGHT, - JMSG_VERSION, - JTRC_16BIT_TABLES, - JTRC_ADOBE, - JTRC_APP0, - JTRC_APP14, - JTRC_DAC, - JTRC_DHT, - JTRC_DQT, - JTRC_DRI, - JTRC_EMS_CLOSE, - JTRC_EMS_OPEN, - JTRC_EOI, - JTRC_HUFFBITS, - JTRC_JFIF, - JTRC_JFIF_BADTHUMBNAILSIZE, - JTRC_JFIF_EXTENSION, - JTRC_JFIF_THUMBNAIL, - JTRC_MISC_MARKER, - JTRC_PARMLESS_MARKER, - JTRC_QUANTVALS, - JTRC_QUANT_3_NCOLORS, - JTRC_QUANT_NCOLORS, - JTRC_QUANT_SELECTED, - JTRC_RECOVERY_ACTION, - JTRC_RST, - JTRC_SMOOTH_NOTIMPL, - JTRC_SOF, - JTRC_SOF_COMPONENT, - JTRC_SOI, - JTRC_SOS, - JTRC_SOS_COMPONENT, - JTRC_SOS_PARAMS, - JTRC_TFILE_CLOSE, - JTRC_TFILE_OPEN, - JTRC_THUMB_JPEG, - JTRC_THUMB_PALETTE, - JTRC_THUMB_RGB, - JTRC_UNKNOWN_IDS, - JTRC_XMS_CLOSE, - JTRC_XMS_OPEN, - JWRN_ADOBE_XFORM, - JWRN_BOGUS_PROGRESSION, - JWRN_EXTRANEOUS_DATA, - JWRN_HIT_MARKER, - JWRN_HUFF_BAD_CODE, - JWRN_JFIF_MAJOR, - JWRN_JPEG_EOF, - JWRN_MUST_RESYNC, - JWRN_NOT_SEQUENTIAL, - JWRN_TOO_MUCH_DATA, - - - JMSG_FIRSTADDONCODE, { Must be first entry! } - - {$ifdef BMP_SUPPORTED} - JERR_BMP_BADCMAP, { Unsupported BMP colormap format } - JERR_BMP_BADDEPTH, { Only 8- and 24-bit BMP files are supported } - JERR_BMP_BADHEADER, { Invalid BMP file: bad header length } - JERR_BMP_BADPLANES, { Invalid BMP file: biPlanes not equal to 1 } - JERR_BMP_COLORSPACE, { BMP output must be grayscale or RGB } - JERR_BMP_COMPRESSED, { Sorry, compressed BMPs not yet supported } - JERR_BMP_NOT, { Not a BMP file - does not start with BM } - JTRC_BMP, { %dx%d 24-bit BMP image } - JTRC_BMP_MAPPED, { %dx%d 8-bit colormapped BMP image } - JTRC_BMP_OS2, { %dx%d 24-bit OS2 BMP image } - JTRC_BMP_OS2_MAPPED, { %dx%d 8-bit colormapped OS2 BMP image } - {$endif} { BMP_SUPPORTED } - - {$ifdef GIF_SUPPORTED} - JERR_GIF_BUG, { GIF output got confused } - JERR_GIF_CODESIZE, { Bogus GIF codesize %d } - JERR_GIF_COLORSPACE, { GIF output must be grayscale or RGB } - JERR_GIF_IMAGENOTFOUND, { Too few images in GIF file } - JERR_GIF_NOT, { Not a GIF file } - JTRC_GIF, { %dx%dx%d GIF image } - JTRC_GIF_BADVERSION, - { Warning: unexpected GIF version number '%c%c%c' } - JTRC_GIF_EXTENSION, { Ignoring GIF extension block of type 0x%02x } - JTRC_GIF_NONSQUARE, { Caution: nonsquare pixels in input } - JWRN_GIF_BADDATA, { Corrupt data in GIF file } - JWRN_GIF_CHAR, { Bogus char 0x%02x in GIF file, ignoring } - JWRN_GIF_ENDCODE, { Premature end of GIF image } - JWRN_GIF_NOMOREDATA, { Ran out of GIF bits } - {$endif} { GIF_SUPPORTED } - - {$ifdef PPM_SUPPORTED} - JERR_PPM_COLORSPACE, { PPM output must be grayscale or RGB } - JERR_PPM_NONNUMERIC, { Nonnumeric data in PPM file } - JERR_PPM_NOT, { Not a PPM file } - JTRC_PGM, { %dx%d PGM image } - JTRC_PGM_TEXT, { %dx%d text PGM image } - JTRC_PPM, { %dx%d PPM image } - JTRC_PPM_TEXT, { %dx%d text PPM image } - {$endif} { PPM_SUPPORTED } - - {$ifdef RLE_SUPPORTED} - JERR_RLE_BADERROR, { Bogus error code from RLE library } - JERR_RLE_COLORSPACE, { RLE output must be grayscale or RGB } - JERR_RLE_DIMENSIONS, { Image dimensions (%dx%d) too large for RLE } - JERR_RLE_EMPTY, { Empty RLE file } - JERR_RLE_EOF, { Premature EOF in RLE header } - JERR_RLE_MEM, { Insufficient memory for RLE header } - JERR_RLE_NOT, { Not an RLE file } - JERR_RLE_TOOMANYCHANNELS, { Cannot handle %d output channels for RLE } - JERR_RLE_UNSUPPORTED, { Cannot handle this RLE setup } - JTRC_RLE, { %dx%d full-color RLE file } - JTRC_RLE_FULLMAP, { %dx%d full-color RLE file with map of length %d } - JTRC_RLE_GRAY, { %dx%d grayscale RLE file } - JTRC_RLE_MAPGRAY, { %dx%d grayscale RLE file with map of length %d } - JTRC_RLE_MAPPED, { %dx%d colormapped RLE file with map of length %d } - {$endif} { RLE_SUPPORTED } - - {$ifdef TARGA_SUPPORTED} - JERR_TGA_BADCMAP, { Unsupported Targa colormap format } - JERR_TGA_BADPARMS, { Invalid or unsupported Targa file } - JERR_TGA_COLORSPACE, { Targa output must be grayscale or RGB } - JTRC_TGA, { %dx%d RGB Targa image } - JTRC_TGA_GRAY, { %dx%d grayscale Targa image } - JTRC_TGA_MAPPED, { %dx%d colormapped Targa image } - {$else} - JERR_TGA_NOTCOMP, { Targa support was not compiled } - {$endif} { TARGA_SUPPORTED } - - JERR_BAD_CMAP_FILE, - { Color map file is invalid or of unsupported format } - JERR_TOO_MANY_COLORS, - { Output file format cannot handle %d colormap entries } - JERR_UNGETC_FAILED, { ungetc failed } - {$ifdef TARGA_SUPPORTED} - JERR_UNKNOWN_FORMAT, - { Unrecognized input file format --- perhaps you need -targa } - {$else} - JERR_UNKNOWN_FORMAT, { Unrecognized input file format } - {$endif} - JERR_UNSUPPORTED_FORMAT, { Unsupported output file format } - - JMSG_LASTADDONCODE - ); - - -const - JMSG_LASTMSGCODE : J_MESSAGE_CODE = JMSG_LASTADDONCODE; - -type - msg_table = Array[J_MESSAGE_CODE] of string[80]; -const - jpeg_std_message_table : msg_table = ( - - { JMSG_NOMESSAGE } 'Bogus message code %d', { Must be first entry! } - -{ For maintenance convenience, list is alphabetical by message code name } - { JERR_ARITH_NOTIMPL } - 'Sorry, there are legal restrictions on arithmetic coding', - { JERR_BAD_ALIGN_TYPE } 'ALIGN_TYPE is wrong, please fix', - { JERR_BAD_ALLOC_CHUNK } 'MAX_ALLOC_CHUNK is wrong, please fix', - { JERR_BAD_BUFFER_MODE } 'Bogus buffer control mode', - { JERR_BAD_COMPONENT_ID } 'Invalid component ID %d in SOS', - { JERR_BAD_DCT_COEF } 'DCT coefficient out of range', - { JERR_BAD_DCTSIZE } 'IDCT output block size %d not supported', - { JERR_BAD_HUFF_TABLE } 'Bogus Huffman table definition', - { JERR_BAD_IN_COLORSPACE } 'Bogus input colorspace', - { JERR_BAD_J_COLORSPACE } 'Bogus JPEG colorspace', - { JERR_BAD_LENGTH } 'Bogus marker length', - { JERR_BAD_LIB_VERSION } - 'Wrong JPEG library version: library is %d, caller expects %d', - { JERR_BAD_MCU_SIZE } 'Sampling factors too large for interleaved scan', - { JERR_BAD_POOL_ID } 'Invalid memory pool code %d', - { JERR_BAD_PRECISION } 'Unsupported JPEG data precision %d', - { JERR_BAD_PROGRESSION } - 'Invalid progressive parameters Ss=%d Se=%d Ah=%d Al=%d', - { JERR_BAD_PROG_SCRIPT } - 'Invalid progressive parameters at scan script entry %d', - { JERR_BAD_SAMPLING } 'Bogus sampling factors', - { JERR_BAD_SCAN_SCRIPT } 'Invalid scan script at entry %d', - { JERR_BAD_STATE } 'Improper call to JPEG library in state %d', - { JERR_BAD_STRUCT_SIZE } - 'JPEG parameter struct mismatch: library thinks size is %d, caller expects %d', - { JERR_BAD_VIRTUAL_ACCESS } 'Bogus virtual array access', - { JERR_BUFFER_SIZE } 'Buffer passed to JPEG library is too small', - { JERR_CANT_SUSPEND } 'Suspension not allowed here', - { JERR_CCIR601_NOTIMPL } 'CCIR601 sampling not implemented yet', - { JERR_COMPONENT_COUNT } 'Too many color components: %d, max %d', - { JERR_CONVERSION_NOTIMPL } 'Unsupported color conversion request', - { JERR_DAC_INDEX } 'Bogus DAC index %d', - { JERR_DAC_VALUE } 'Bogus DAC value $%x', - { JERR_DHT_COUNTS } 'Bogus DHT counts', - { JERR_DHT_INDEX } 'Bogus DHT index %d', - { JERR_DQT_INDEX } 'Bogus DQT index %d', - { JERR_EMPTY_IMAGE } 'Empty JPEG image (DNL not supported)', - { JERR_EMS_READ } 'Read from EMS failed', - { JERR_EMS_WRITE } 'Write to EMS failed', - { JERR_EOI_EXPECTED } 'Didn''t expect more than one scan', - { JERR_FILE_READ } 'Input file read error', - { JERR_FILE_WRITE } 'Output file write error --- out of disk space?', - { JERR_FRACT_SAMPLE_NOTIMPL } 'Fractional sampling not implemented yet', - { JERR_HUFF_CLEN_OVERFLOW } 'Huffman code size table overflow', - { JERR_HUFF_MISSING_CODE } 'Missing Huffman code table entry', - { JERR_IMAGE_TOO_BIG } 'Maximum supported image dimension is %d pixels', - { JERR_INPUT_EMPTY } 'Empty input file', - { JERR_INPUT_EOF } 'Premature end of input file', - { JERR_MISMATCHED_QUANT_TABLE } - 'Cannot transcode due to multiple use of quantization table %d', - { JERR_MISSING_DATA } 'Scan script does not transmit all data', - { JERR_MODE_CHANGE } 'Invalid color quantization mode change', - { JERR_NOTIMPL } 'Not implemented yet', - { JERR_NOT_COMPILED } 'Requested feature was omitted at compile time', - { JERR_NO_BACKING_STORE } 'Backing store not supported', - { JERR_NO_HUFF_TABLE } 'Huffman table $%02x was not defined', - { JERR_NO_IMAGE } 'JPEG datastream contains no image', - { JERR_NO_QUANT_TABLE } 'Quantization table $%02x was not defined', - { JERR_NO_SOI } 'Not a JPEG file: starts with $%02x $%02x', - { JERR_OUT_OF_MEMORY } 'Insufficient memory (case %d)', - { JERR_QUANT_COMPONENTS } - 'Cannot quantize more than %d color components', - { JERR_QUANT_FEW_COLORS } 'Cannot quantize to fewer than %d colors', - { JERR_QUANT_MANY_COLORS } 'Cannot quantize to more than %d colors', - { JERR_SOF_DUPLICATE } 'Invalid JPEG file structure: two SOF markers', - { JERR_SOF_NO_SOS } 'Invalid JPEG file structure: missing SOS marker', - { JERR_SOF_UNSUPPORTED } 'Unsupported JPEG process: SOF type $%02x', - { JERR_SOI_DUPLICATE } 'Invalid JPEG file structure: two SOI markers', - { JERR_SOS_NO_SOF } 'Invalid JPEG file structure: SOS before SOF', - { JERR_TFILE_CREATE } 'Failed to create temporary file %s', - { JERR_TFILE_READ } 'Read failed on temporary file', - { JERR_TFILE_SEEK } 'Seek failed on temporary file', - { JERR_TFILE_WRITE } - 'Write failed on temporary file --- out of disk space?', - { JERR_TOO_LITTLE_DATA } 'Application transferred too few scanlines', - { JERR_UNKNOWN_MARKER } 'Unsupported marker type $%02x', - { JERR_VIRTUAL_BUG } 'Virtual array controller messed up', - { JERR_WIDTH_OVERFLOW } 'Image too wide for this implementation', - { JERR_XMS_READ } 'Read from XMS failed', - { JERR_XMS_WRITE } 'Write to XMS failed', - { JMSG_COPYRIGHT } JCOPYRIGHT, - { JMSG_VERSION } JVERSION, - { JTRC_16BIT_TABLES } - 'Caution: quantization tables are too coarse for baseline JPEG', - { JTRC_ADOBE } - 'Adobe APP14 marker: version %d, flags $%04x $%04x, transform %d', - { JTRC_APP0 } 'Unknown APP0 marker (not JFIF), length %d', - { JTRC_APP14 } 'Unknown APP14 marker (not Adobe), length %d', - { JTRC_DAC } 'Define Arithmetic Table $%02x: $%02x', - { JTRC_DHT } 'Define Huffman Table $%02x', - { JTRC_DQT } 'Define Quantization Table %d precision %d', - { JTRC_DRI } 'Define Restart Interval %d', - { JTRC_EMS_CLOSE } 'Freed EMS handle %d', - { JTRC_EMS_OPEN } 'Obtained EMS handle %d', - { JTRC_EOI } 'End Of Image', - { JTRC_HUFFBITS } ' %3d %3d %3d %3d %3d %3d %3d %3d', - { JTRC_JFIF } 'JFIF APP0 marker, density %dx%d %d', - { JTRC_JFIF_BADTHUMBNAILSIZE } - 'Warning: thumbnail image size does not match data length %d', - { JTRC_JFIF_EXTENSION } 'JFIF extension marker: type 0x%02x, length %u', - { JTRC_JFIF_THUMBNAIL } ' with %d x %d thumbnail image', - { JTRC_MISC_MARKER } 'Skipping marker $%02x, length %d', - { JTRC_PARMLESS_MARKER } 'Unexpected marker $%02x', - { JTRC_QUANTVALS } ' %4d %4d %4d %4d %4d %4d %4d %4d', - { JTRC_QUANT_3_NCOLORS } 'Quantizing to %d = %d*%d*%d colors', - { JTRC_QUANT_NCOLORS } 'Quantizing to %d colors', - { JTRC_QUANT_SELECTED } 'Selected %d colors for quantization', - { JTRC_RECOVERY_ACTION } 'At marker $%02x, recovery action %d', - { JTRC_RST } 'RST%d', - { JTRC_SMOOTH_NOTIMPL } - 'Smoothing not supported with nonstandard sampling ratios', - { JTRC_SOF } 'Start Of Frame $%02x: width=%d, height=%d, components=%d', - { JTRC_SOF_COMPONENT } ' Component %d: %dhx%dv q=%d', - { JTRC_SOI } 'Start of Image', - { JTRC_SOS } 'Start Of Scan: %d components', - { JTRC_SOS_COMPONENT } ' Component %d: dc=%d ac=%d', - { JTRC_SOS_PARAMS } ' Ss=%d, Se=%d, Ah=%d, Al=%d', - { JTRC_TFILE_CLOSE } 'Closed temporary file %s', - { JTRC_TFILE_OPEN } 'Opened temporary file %s', - { JTRC_THUMB_JPEG } - 'JFIF extension marker: JPEG-compressed thumbnail image, length %u', - { JMESSAGE(JTRC_THUMB_PALETTE } - 'JFIF extension marker: palette thumbnail image, length %u', - { JMESSAGE(JTRC_THUMB_RGB } - 'JFIF extension marker: RGB thumbnail image, length %u', - { JTRC_UNKNOWN_IDS } - 'Unrecognized component IDs %d %d %d, assuming YCbCr', - { JTRC_XMS_CLOSE } 'Freed XMS handle %d', - { JTRC_XMS_OPEN } 'Obtained XMS handle %d', - { JWRN_ADOBE_XFORM } 'Unknown Adobe color transform code %d', - { JWRN_BOGUS_PROGRESSION } - 'Inconsistent progression sequence for component %d coefficient %d', - { JWRN_EXTRANEOUS_DATA } - 'Corrupt JPEG data: %d extraneous bytes before marker $%02x', - { JWRN_HIT_MARKER } 'Corrupt JPEG data: premature end of data segment', - { JWRN_HUFF_BAD_CODE } 'Corrupt JPEG data: bad Huffman code', - { JWRN_JFIF_MAJOR } 'Warning: unknown JFIF revision number %d.%02d', - { JWRN_JPEG_EOF } 'Premature end of JPEG file', - { JWRN_MUST_RESYNC } - 'Corrupt JPEG data: found marker $%02x instead of RST%d', - { JWRN_NOT_SEQUENTIAL } 'Invalid SOS parameters for sequential JPEG', - { JWRN_TOO_MUCH_DATA } 'Application transferred too many scanlines', - - { JMSG_FIRSTADDONCODE } '', { Must be first entry! } - -{$ifdef BMP_SUPPORTED} - { JERR_BMP_BADCMAP } 'Unsupported BMP colormap format', - { JERR_BMP_BADDEPTH } 'Only 8- and 24-bit BMP files are supported', - { JERR_BMP_BADHEADER } 'Invalid BMP file: bad header length', - { JERR_BMP_BADPLANES } 'Invalid BMP file: biPlanes not equal to 1', - { JERR_BMP_COLORSPACE } 'BMP output must be grayscale or RGB', - { JERR_BMP_COMPRESSED } 'Sorry, compressed BMPs not yet supported', - { JERR_BMP_NOT } 'Not a BMP file - does not start with BM', - { JTRC_BMP } '%dx%d 24-bit BMP image', - { JTRC_BMP_MAPPED } '%dx%d 8-bit colormapped BMP image', - { JTRC_BMP_OS2 } '%dx%d 24-bit OS2 BMP image', - { JTRC_BMP_OS2_MAPPED } '%dx%d 8-bit colormapped OS2 BMP image', -{$endif} { BMP_SUPPORTED } - -{$ifdef GIF_SUPPORTED} - { JERR_GIF_BUG } 'GIF output got confused', - { JERR_GIF_CODESIZE } 'Bogus GIF codesize %d', - { JERR_GIF_COLORSPACE } 'GIF output must be grayscale or RGB', - { JERR_GIF_IMAGENOTFOUND } 'Too few images in GIF file', - { JERR_GIF_NOT } 'Not a GIF file', - { JTRC_GIF } '%dx%dx%d GIF image', - { JTRC_GIF_BADVERSION } - 'Warning: unexpected GIF version number "%c%c%c"', - { JTRC_GIF_EXTENSION } 'Ignoring GIF extension block of type 0x%02x', - { JTRC_GIF_NONSQUARE } 'Caution: nonsquare pixels in input', - { JWRN_GIF_BADDATA } 'Corrupt data in GIF file', - { JWRN_GIF_CHAR } 'Bogus char 0x%02x in GIF file, ignoring', - { JWRN_GIF_ENDCODE } 'Premature end of GIF image', - { JWRN_GIF_NOMOREDATA } 'Ran out of GIF bits', -{$endif} { GIF_SUPPORTED } - -{$ifdef PPM_SUPPORTED} - { JERR_PPM_COLORSPACE } 'PPM output must be grayscale or RGB', - { JERR_PPM_NONNUMERIC } 'Nonnumeric data in PPM file', - { JERR_PPM_NOT } 'Not a PPM file', - { JTRC_PGM } '%dx%d PGM image', - { JTRC_PGM_TEXT } '%dx%d text PGM image', - { JTRC_PPM } '%dx%d PPM image', - { JTRC_PPM_TEXT } '%dx%d text PPM image', -{$endif} { PPM_SUPPORTED } - -{$ifdef RLE_SUPPORTED} - { JERR_RLE_BADERROR } 'Bogus error code from RLE library', - { JERR_RLE_COLORSPACE } 'RLE output must be grayscale or RGB', - { JERR_RLE_DIMENSIONS } 'Image dimensions (%dx%d) too large for RLE', - { JERR_RLE_EMPTY } 'Empty RLE file', - { JERR_RLE_EOF } 'Premature EOF in RLE header', - { JERR_RLE_MEM } 'Insufficient memory for RLE header', - { JERR_RLE_NOT } 'Not an RLE file', - { JERR_RLE_TOOMANYCHANNELS } 'Cannot handle %d output channels for RLE', - { JERR_RLE_UNSUPPORTED } 'Cannot handle this RLE setup', - { JTRC_RLE } '%dx%d full-color RLE file', - { JTRC_RLE_FULLMAP } '%dx%d full-color RLE file with map of length %d', - { JTRC_RLE_GRAY } '%dx%d grayscale RLE file', - { JTRC_RLE_MAPGRAY } '%dx%d grayscale RLE file with map of length %d', - { JTRC_RLE_MAPPED } '%dx%d colormapped RLE file with map of length %d', -{$endif} { RLE_SUPPORTED } - -{$ifdef TARGA_SUPPORTED} - { JERR_TGA_BADCMAP } 'Unsupported Targa colormap format', - { JERR_TGA_BADPARMS } 'Invalid or unsupported Targa file', - { JERR_TGA_COLORSPACE } 'Targa output must be grayscale or RGB', - { JTRC_TGA } '%dx%d RGB Targa image', - { JTRC_TGA_GRAY } '%dx%d grayscale Targa image', - { JTRC_TGA_MAPPED } '%dx%d colormapped Targa image', -{$else} - { JERR_TGA_NOTCOMP } 'Targa support was not compiled', -{$endif} { TARGA_SUPPORTED } - - { JERR_BAD_CMAP_FILE } - 'Color map file is invalid or of unsupported format', - { JERR_TOO_MANY_COLORS } - 'Output file format cannot handle %d colormap entries', - { JERR_UNGETC_FAILED } 'ungetc failed', -{$ifdef TARGA_SUPPORTED} - { JERR_UNKNOWN_FORMAT } - 'Unrecognized input file format --- perhaps you need -targa', -{$else} - { JERR_UNKNOWN_FORMAT } 'Unrecognized input file format', -{$endif} - { JERR_UNSUPPORTED_FORMAT } 'Unsupported output file format', - - - { JMSG_LASTADDONCODE } ''); - -implementation - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdhuff.pas b/3rd/Imaging/Source/JpegLib/imjdhuff.pas deleted file mode 100644 index c653b717a..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdhuff.pas +++ /dev/null @@ -1,1205 +0,0 @@ -unit imjdhuff; - -{ This file contains declarations for Huffman entropy decoding routines - that are shared between the sequential decoder (jdhuff.c) and the - progressive decoder (jdphuff.c). No other modules need to see these. } - -{ This file contains Huffman entropy decoding routines. - - Much of the complexity here has to do with supporting input suspension. - If the data source module demands suspension, we want to be able to back - up to the start of the current MCU. To do this, we copy state variables - into local working storage, and update them back to the permanent - storage only upon successful completion of an MCU. } - -{ Original: jdhuff.h+jdhuff.c; Copyright (C) 1991-1997, Thomas G. Lane. } - - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - - -{ Declarations shared with jdphuff.c } - - - -{ Derived data constructed for each Huffman table } - -const - HUFF_LOOKAHEAD = 8; { # of bits of lookahead } - -type - d_derived_tbl_ptr = ^d_derived_tbl; - d_derived_tbl = record - { Basic tables: (element [0] of each array is unused) } - maxcode : array[0..18-1] of INT32; { largest code of length k (-1 if none) } - { (maxcode[17] is a sentinel to ensure jpeg_huff_decode terminates) } - valoffset : array[0..17-1] of INT32; { huffval[] offset for codes of length k } - { valoffset[k] = huffval[] index of 1st symbol of code length k, less - the smallest code of length k; so given a code of length k, the - corresponding symbol is huffval[code + valoffset[k]] } - - { Link to public Huffman table (needed only in jpeg_huff_decode) } - pub : JHUFF_TBL_PTR; - - { Lookahead tables: indexed by the next HUFF_LOOKAHEAD bits of - the input data stream. If the next Huffman code is no more - than HUFF_LOOKAHEAD bits long, we can obtain its length and - the corresponding symbol directly from these tables. } - - look_nbits : array[0..(1 shl HUFF_LOOKAHEAD)-1] of int; - { # bits, or 0 if too long } - look_sym : array[0..(1 shl HUFF_LOOKAHEAD)-1] of UINT8; - { symbol, or unused } - end; - -{ Fetching the next N bits from the input stream is a time-critical operation - for the Huffman decoders. We implement it with a combination of inline - macros and out-of-line subroutines. Note that N (the number of bits - demanded at one time) never exceeds 15 for JPEG use. - - We read source bytes into get_buffer and dole out bits as needed. - If get_buffer already contains enough bits, they are fetched in-line - by the macros CHECK_BIT_BUFFER and GET_BITS. When there aren't enough - bits, jpeg_fill_bit_buffer is called; it will attempt to fill get_buffer - as full as possible (not just to the number of bits needed; this - prefetching reduces the overhead cost of calling jpeg_fill_bit_buffer). - Note that jpeg_fill_bit_buffer may return FALSE to indicate suspension. - On TRUE return, jpeg_fill_bit_buffer guarantees that get_buffer contains - at least the requested number of bits --- dummy zeroes are inserted if - necessary. } - - -type - bit_buf_type = INT32 ; { type of bit-extraction buffer } -const - BIT_BUF_SIZE = 32; { size of buffer in bits } - -{ If long is > 32 bits on your machine, and shifting/masking longs is - reasonably fast, making bit_buf_type be long and setting BIT_BUF_SIZE - appropriately should be a win. Unfortunately we can't define the size - with something like #define BIT_BUF_SIZE (sizeof(bit_buf_type)*8) - because not all machines measure sizeof in 8-bit bytes. } - -type - bitread_perm_state = record { Bitreading state saved across MCUs } - get_buffer : bit_buf_type; { current bit-extraction buffer } - bits_left : int; { # of unused bits in it } - end; - -type - bitread_working_state = record - { Bitreading working state within an MCU } - { current data source location } - { We need a copy, rather than munging the original, in case of suspension } - next_input_byte : JOCTETptr; { => next byte to read from source } - bytes_in_buffer : size_t; { # of bytes remaining in source buffer } - { Bit input buffer --- note these values are kept in register variables, - not in this struct, inside the inner loops. } - - get_buffer : bit_buf_type; { current bit-extraction buffer } - bits_left : int; { # of unused bits in it } - { Pointer needed by jpeg_fill_bit_buffer } - cinfo : j_decompress_ptr; { back link to decompress master record } - end; - -{ Module initialization routine for Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_huff_decoder (cinfo : j_decompress_ptr); - -{GLOBAL} -function jpeg_huff_decode(var state : bitread_working_state; - get_buffer : bit_buf_type; {register} - bits_left : int; {register} - htbl : d_derived_tbl_ptr; - min_bits : int) : int; - -{ Compute the derived values for a Huffman table. - Note this is also used by jdphuff.c. } - -{GLOBAL} -procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : d_derived_tbl_ptr); - -{ Load up the bit buffer to a depth of at least nbits } - -function jpeg_fill_bit_buffer (var state : bitread_working_state; - get_buffer : bit_buf_type; {register} - bits_left : int; {register} - nbits : int) : boolean; - -implementation - -{$IFDEF MACRO} - -{ Macros to declare and load/save bitread local variables. } -{$define BITREAD_STATE_VARS} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - -{$define BITREAD_LOAD_STATE(cinfop,permstate)} - br_state.cinfo := cinfop; - br_state.next_input_byte := cinfop^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfop^.src^.bytes_in_buffer; - get_buffer := permstate.get_buffer; - bits_left := permstate.bits_left; - -{$define BITREAD_SAVE_STATE(cinfop,permstate) } - cinfop^.src^.next_input_byte := br_state.next_input_byte; - cinfop^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - permstate.get_buffer := get_buffer; - permstate.bits_left := bits_left; - - -{ These macros provide the in-line portion of bit fetching. - Use CHECK_BIT_BUFFER to ensure there are N bits in get_buffer - before using GET_BITS, PEEK_BITS, or DROP_BITS. - The variables get_buffer and bits_left are assumed to be locals, - but the state struct might not be (jpeg_huff_decode needs this). - CHECK_BIT_BUFFER(state,n,action); - Ensure there are N bits in get_buffer; if suspend, take action. - val = GET_BITS(n); - Fetch next N bits. - val = PEEK_BITS(n); - Fetch next N bits without removing them from the buffer. - DROP_BITS(n); - Discard next N bits. - The value N should be a simple variable, not an expression, because it - is evaluated multiple times. } - - -{$define CHECK_BIT_BUFFER(state,nbits,action)} - if (bits_left < (nbits)) then - begin - if (not jpeg_fill_bit_buffer(&(state),get_buffer,bits_left,nbits)) then - begin - action; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - -{$define GET_BITS(nbits)} - Dec(bits_left, (nbits)); - ( (int(get_buffer shr bits_left)) and ( pred(1 shl (nbits)) ) ) - -{$define PEEK_BITS(nbits)} - int(get_buffer shr (bits_left - (nbits))) and pred(1 shl (nbits)) - -{$define DROP_BITS(nbits)} - Dec(bits_left, nbits); - - - - -{ Code for extracting next Huffman-coded symbol from input bit stream. - Again, this is time-critical and we make the main paths be macros. - - We use a lookahead table to process codes of up to HUFF_LOOKAHEAD bits - without looping. Usually, more than 95% of the Huffman codes will be 8 - or fewer bits long. The few overlength codes are handled with a loop, - which need not be inline code. - - Notes about the HUFF_DECODE macro: - 1. Near the end of the data segment, we may fail to get enough bits - for a lookahead. In that case, we do it the hard way. - 2. If the lookahead table contains no entry, the next code must be - more than HUFF_LOOKAHEAD bits long. - 3. jpeg_huff_decode returns -1 if forced to suspend. } - - - - -macro HUFF_DECODE(s,br_state,htbl,return FALSE,slowlabel); -label showlabel; -var - nb, look : int; {register} -begin - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto slowlabel; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := htbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := htbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; -slowlabel: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,htbl,nb)); - if (s < 0) then - begin - result := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; -end; - - -{$ENDIF} {MACRO} - -{ Expanded entropy decoder object for Huffman decoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - last_dc_val : array[0..MAX_COMPS_IN_SCAN-1] of int; { last DC coef for each component } - end; - - -type - huff_entropy_ptr = ^huff_entropy_decoder; - huff_entropy_decoder = record - pub : jpeg_entropy_decoder; { public fields } - - { These fields are loaded into local variables at start of each MCU. - In case of suspension, we exit WITHOUT updating them. } - - bitstate : bitread_perm_state; { Bit buffer at start of MCU } - saved : savable_state; { Other state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - - { Pointers to derived tables (these workspaces have image lifespan) } - dc_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; - ac_derived_tbls : array[0..NUM_HUFF_TBLS] of d_derived_tbl_ptr; - - { Precalculated info set up by start_pass for use in decode_mcu: } - - { Pointers to derived tables to be used for each block within an MCU } - dc_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; - ac_cur_tbls : array[0..D_MAX_BLOCKS_IN_MCU-1] of d_derived_tbl_ptr; - { Whether we care about the DC and AC coefficient values for each block } - dc_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; - ac_needed : array[0..D_MAX_BLOCKS_IN_MCU-1] of boolean; - end; - - - -{ Initialize for a Huffman-compressed scan. } - -{METHODDEF} -procedure start_pass_huff_decoder (cinfo : j_decompress_ptr); -var - entropy : huff_entropy_ptr; - ci, blkn, dctbl, actbl : int; - compptr : jpeg_component_info_ptr; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Check that the scan parameters Ss, Se, Ah/Al are OK for sequential JPEG. - This ought to be an error condition, but we make it a warning because - there are some baseline files out there with all zeroes in these bytes. } - - if (cinfo^.Ss <> 0) or (cinfo^.Se <> DCTSIZE2-1) or - (cinfo^.Ah <> 0) or (cinfo^.Al <> 0) then - WARNMS(j_common_ptr(cinfo), JWRN_NOT_SEQUENTIAL); - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - dctbl := compptr^.dc_tbl_no; - actbl := compptr^.ac_tbl_no; - { Compute derived values for Huffman tables } - { We may do this more than once for a table, but it's not expensive } - jpeg_make_d_derived_tbl(cinfo, TRUE, dctbl, - entropy^.dc_derived_tbls[dctbl]); - jpeg_make_d_derived_tbl(cinfo, FALSE, actbl, - entropy^.ac_derived_tbls[actbl]); - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Precalculate decoding info for each block in an MCU of this scan } - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - { Precalculate which table to use for each block } - entropy^.dc_cur_tbls[blkn] := entropy^.dc_derived_tbls[compptr^.dc_tbl_no]; - entropy^.ac_cur_tbls[blkn] := entropy^.ac_derived_tbls[compptr^.ac_tbl_no]; - { Decide whether we really care about the coefficient values } - if (compptr^.component_needed) then - begin - entropy^.dc_needed[blkn] := TRUE; - { we don't need the ACs if producing a 1/8th-size image } - entropy^.ac_needed[blkn] := (compptr^.DCT_scaled_size > 1); - end - else - begin - entropy^.ac_needed[blkn] := FALSE; - entropy^.dc_needed[blkn] := FALSE; - end; - end; - - { Initialize bitread state variables } - entropy^.bitstate.bits_left := 0; - entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } - entropy^.pub.insufficient_data := FALSE; - - { Initialize restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; -end; - - -{ Compute the derived values for a Huffman table. - This routine also performs some validation checks on the table. - - Note this is also used by jdphuff.c. } - -{GLOBAL} -procedure jpeg_make_d_derived_tbl (cinfo : j_decompress_ptr; - isDC : boolean; - tblno : int; - var pdtbl : d_derived_tbl_ptr); -var - htbl : JHUFF_TBL_PTR; - dtbl : d_derived_tbl_ptr; - p, i, l, si, numsymbols : int; - lookbits, ctr : int; - huffsize : array[0..257-1] of byte; - huffcode : array[0..257-1] of uInt; - code : uInt; -var - sym : int; -begin - { Note that huffsize[] and huffcode[] are filled in code-length order, - paralleling the order of the symbols themselves in htbl^.huffval[]. } - - { Find the input Huffman table } - if (tblno < 0) or (tblno >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - if isDC then - htbl := cinfo^.dc_huff_tbl_ptrs[tblno] - else - htbl := cinfo^.ac_huff_tbl_ptrs[tblno]; - if (htbl = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_HUFF_TABLE, tblno); - - { Allocate a workspace if we haven't already done so. } - if (pdtbl = NIL) then - pdtbl := d_derived_tbl_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(d_derived_tbl)) ); - dtbl := pdtbl; - dtbl^.pub := htbl; { fill in back link } - - { Figure C.1: make table of Huffman code length for each symbol } - - p := 0; - for l := 1 to 16 do - begin - i := int(htbl^.bits[l]); - if (i < 0) or (p + i > 256) then { protect against table overrun } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - while (i > 0) do - begin - huffsize[p] := byte(l); - Inc(p); - Dec(i); - end; - end; - huffsize[p] := 0; - numsymbols := p; - - { Figure C.2: generate the codes themselves } - { We also validate that the counts represent a legal Huffman code tree. } - - code := 0; - si := huffsize[0]; - p := 0; - while (huffsize[p] <> 0) do - begin - while (( int (huffsize[p]) ) = si) do - begin - huffcode[p] := code; - Inc(p); - Inc(code); - end; - { code is now 1 more than the last code used for codelength si; but - it must still fit in si bits, since no code is allowed to be all ones. } - - if (INT32(code) >= (INT32(1) shl si)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - - code := code shl 1; - Inc(si); - end; - - { Figure F.15: generate decoding tables for bit-sequential decoding } - - p := 0; - for l := 1 to 16 do - begin - if (htbl^.bits[l] <> 0) then - begin - { valoffset[l] = huffval[] index of 1st symbol of code length l, - minus the minimum code of length l } - - dtbl^.valoffset[l] := INT32(p) - INT32(huffcode[p]); - Inc(p, htbl^.bits[l]); - dtbl^.maxcode[l] := huffcode[p-1]; { maximum code of length l } - end - else - begin - dtbl^.maxcode[l] := -1; { -1 if no codes of this length } - end; - end; - dtbl^.maxcode[17] := long($FFFFF); { ensures jpeg_huff_decode terminates } - - { Compute lookahead tables to speed up decoding. - First we set all the table entries to 0, indicating "too long"; - then we iterate through the Huffman codes that are short enough and - fill in all the entries that correspond to bit sequences starting - with that code. } - - MEMZERO(@dtbl^.look_nbits, SIZEOF(dtbl^.look_nbits)); - - p := 0; - for l := 1 to HUFF_LOOKAHEAD do - begin - for i := 1 to int (htbl^.bits[l]) do - begin - { l := current code's length, p := its index in huffcode[] & huffval[]. } - { Generate left-justified code followed by all possible bit sequences } - lookbits := huffcode[p] shl (HUFF_LOOKAHEAD-l); - for ctr := pred(1 shl (HUFF_LOOKAHEAD-l)) downto 0 do - begin - dtbl^.look_nbits[lookbits] := l; - dtbl^.look_sym[lookbits] := htbl^.huffval[p]; - Inc(lookbits); - end; - Inc(p); - end; - end; - - { Validate symbols as being reasonable. - For AC tables, we make no check, but accept all byte values 0..255. - For DC tables, we require the symbols to be in range 0..15. - (Tighter bounds could be applied depending on the data depth and mode, - but this is sufficient to ensure safe decoding.) } - - if (isDC) then - begin - for i := 0 to pred(numsymbols) do - begin - sym := htbl^.huffval[i]; - if (sym < 0) or (sym > 15) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - end; - end; -end; - - -{ Out-of-line code for bit fetching (shared with jdphuff.c). - See jdhuff.h for info about usage. - Note: current values of get_buffer and bits_left are passed as parameters, - but are returned in the corresponding fields of the state struct. - - On most machines MIN_GET_BITS should be 25 to allow the full 32-bit width - of get_buffer to be used. (On machines with wider words, an even larger - buffer could be used.) However, on some machines 32-bit shifts are - quite slow and take time proportional to the number of places shifted. - (This is true with most PC compilers, for instance.) In this case it may - be a win to set MIN_GET_BITS to the minimum value of 15. This reduces the - average shift distance at the cost of more calls to jpeg_fill_bit_buffer. } - -{$ifdef SLOW_SHIFT_32} -const - MIN_GET_BITS = 15; { minimum allowable value } -{$else} -const - MIN_GET_BITS = (BIT_BUF_SIZE-7); -{$endif} - - -{GLOBAL} -function jpeg_fill_bit_buffer (var state : bitread_working_state; - {register} get_buffer : bit_buf_type; - {register} bits_left : int; - nbits : int) : boolean; -label - no_more_bytes; -{ Load up the bit buffer to a depth of at least nbits } -var - { Copy heavily used state fields into locals (hopefully registers) } - {register} next_input_byte : {const} JOCTETptr; - {register} bytes_in_buffer : size_t; -var - {register} c : int; -var - cinfo : j_decompress_ptr; -begin - next_input_byte := state.next_input_byte; - bytes_in_buffer := state.bytes_in_buffer; - cinfo := state.cinfo; - - { Attempt to load at least MIN_GET_BITS bits into get_buffer. } - { (It is assumed that no request will be for more than that many bits.) } - { We fail to do so only if we hit a marker or are forced to suspend. } - - if (cinfo^.unread_marker = 0) then { cannot advance past a marker } - begin - while (bits_left < MIN_GET_BITS) do - begin - { Attempt to read a byte } - if (bytes_in_buffer = 0) then - begin - if not cinfo^.src^.fill_input_buffer(cinfo) then - begin - jpeg_fill_bit_buffer := FALSE; - exit; - end; - next_input_byte := cinfo^.src^.next_input_byte; - bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - end; - Dec(bytes_in_buffer); - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - - { If it's $FF, check and discard stuffed zero byte } - if (c = $FF) then - begin - { Loop here to discard any padding FF's on terminating marker, - so that we can save a valid unread_marker value. NOTE: we will - accept multiple FF's followed by a 0 as meaning a single FF data - byte. This data pattern is not valid according to the standard. } - - repeat - if (bytes_in_buffer = 0) then - begin - if (not state.cinfo^.src^.fill_input_buffer (state.cinfo)) then - begin - jpeg_fill_bit_buffer := FALSE; - exit; - end; - next_input_byte := state.cinfo^.src^.next_input_byte; - bytes_in_buffer := state.cinfo^.src^.bytes_in_buffer; - end; - Dec(bytes_in_buffer); - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - Until (c <> $FF); - - if (c = 0) then - begin - { Found FF/00, which represents an FF data byte } - c := $FF; - end - else - begin - { Oops, it's actually a marker indicating end of compressed data. - Save the marker code for later use. - Fine point: it might appear that we should save the marker into - bitread working state, not straight into permanent state. But - once we have hit a marker, we cannot need to suspend within the - current MCU, because we will read no more bytes from the data - source. So it is OK to update permanent state right away. } - - cinfo^.unread_marker := c; - { See if we need to insert some fake zero bits. } - goto no_more_bytes; - end; - end; - - { OK, load c into get_buffer } - get_buffer := (get_buffer shl 8) or c; - Inc(bits_left, 8); - end { end while } - end - else - begin - no_more_bytes: - { We get here if we've read the marker that terminates the compressed - data segment. There should be enough bits in the buffer register - to satisfy the request; if so, no problem. } - - if (nbits > bits_left) then - begin - { Uh-oh. Report corrupted data to user and stuff zeroes into - the data stream, so that we can produce some kind of image. - We use a nonvolatile flag to ensure that only one warning message - appears per data segment. } - - if not cinfo^.entropy^.insufficient_data then - begin - WARNMS(j_common_ptr(cinfo), JWRN_HIT_MARKER); - cinfo^.entropy^.insufficient_data := TRUE; - end; - { Fill the buffer with zero bits } - get_buffer := get_buffer shl (MIN_GET_BITS - bits_left); - bits_left := MIN_GET_BITS; - end; - end; - - { Unload the local registers } - state.next_input_byte := next_input_byte; - state.bytes_in_buffer := bytes_in_buffer; - state.get_buffer := get_buffer; - state.bits_left := bits_left; - - jpeg_fill_bit_buffer := TRUE; -end; - - -{ Out-of-line code for Huffman code decoding. - See jdhuff.h for info about usage. } - -{GLOBAL} -function jpeg_huff_decode (var state : bitread_working_state; - {register} get_buffer : bit_buf_type; - {register} bits_left : int; - htbl : d_derived_tbl_ptr; - min_bits : int) : int; -var - {register} l : int; - {register} code : INT32; -begin - l := min_bits; - - { HUFF_DECODE has determined that the code is at least min_bits } - { bits long, so fetch that many bits in one swoop. } - - {CHECK_BIT_BUFFER(state, l, return -1);} - if (bits_left < l) then - begin - if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, l)) then - begin - jpeg_huff_decode := -1; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - {code := GET_BITS(l);} - Dec(bits_left, l); - code := (int(get_buffer shr bits_left)) and ( pred(1 shl l) ); - - { Collect the rest of the Huffman code one bit at a time. } - { This is per Figure F.16 in the JPEG spec. } - - while (code > htbl^.maxcode[l]) do - begin - code := code shl 1; - {CHECK_BIT_BUFFER(state, 1, return -1);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(state, get_buffer, bits_left, 1)) then - begin - jpeg_huff_decode := -1; - exit; - end; - get_buffer := state.get_buffer; - bits_left := state.bits_left; - end; - - {code := code or GET_BITS(1);} - Dec(bits_left); - code := code or ( (int(get_buffer shr bits_left)) and pred(1 shl 1) ); - - Inc(l); - end; - - { Unload the local registers } - state.get_buffer := get_buffer; - state.bits_left := bits_left; - - { With garbage input we may reach the sentinel value l := 17. } - - if (l > 16) then - begin - WARNMS(j_common_ptr(state.cinfo), JWRN_HUFF_BAD_CODE); - jpeg_huff_decode := 0; { fake a zero as the safest result } - exit; - end; - - jpeg_huff_decode := htbl^.pub^.huffval[ int (code + htbl^.valoffset[l]) ]; -end; - - -{ Figure F.12: extend sign bit. - On some machines, a shift and add will be faster than a table lookup. } - -{$ifdef AVOID_TABLES} - -#define HUFF_EXTEND(x,s) ((x) < (1<<((s)-1)) ? (x) + (((-1)<<(s)) + 1) : (x)) - -{$else} - -{$define HUFF_EXTEND(x,s) - if (x < extend_test[s]) then - := x + extend_offset[s] - else - x;} - -const - extend_test : array[0..16-1] of int = { entry n is 2**(n-1) } - ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, - $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); - -const - extend_offset : array[0..16-1] of int = { entry n is (-1 << n) + 1 } -(0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, - ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, - ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1,((-1) shl 12) + 1, - ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1); - -{$endif} { AVOID_TABLES } - - -{ Check for a restart marker & resynchronize decoder. - Returns FALSE if must suspend. } - -{LOCAL} -function process_restart (cinfo : j_decompress_ptr) : boolean; -var - entropy : huff_entropy_ptr; - ci : int; -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Throw away any unused bits remaining in bit buffer; } - { include any full bytes in next_marker's count of discarded bytes } - Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); - entropy^.bitstate.bits_left := 0; - - { Advance past the RSTn marker } - if (not cinfo^.marker^.read_restart_marker (cinfo)) then - begin - process_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - - { Reset restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; - - { Reset out-of-data flag, unless read_restart_marker left us smack up - against a marker. In that case we will end up treating the next data - segment as empty, and we can avoid producing bogus output pixels by - leaving the flag set. } - - if (cinfo^.unread_marker = 0) then - entropy^.pub.insufficient_data := FALSE; - - process_restart := TRUE; -end; - - -{ Decode and return one MCU's worth of Huffman-compressed coefficients. - The coefficients are reordered from zigzag order into natural array order, - but are not dequantized. - - The i'th block of the MCU is stored into the block pointed to by - MCU_data[i]. WE ASSUME THIS AREA HAS BEEN ZEROED BY THE CALLER. - (Wholesale zeroing is usually a little faster than retail...) - - Returns FALSE if data source requested suspension. In that case no - changes have been made to permanent state. (Exception: some output - coefficients may already have been assigned. This is harmless for - this module, since we'll just re-assign them on the next call.) } - -{METHODDEF} -function decode_mcu (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label1, label2, label3; -var - entropy : huff_entropy_ptr; - {register} s, k, r : int; - blkn, ci : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - state : savable_state; - dctbl : d_derived_tbl_ptr; - actbl : d_derived_tbl_ptr; -var - nb, look : int; {register} -begin - entropy := huff_entropy_ptr (cinfo^.entropy); - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - {ASSIGN_STATE(state, entropy^.saved);} - state := entropy^.saved; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - dctbl := entropy^.dc_cur_tbls[blkn]; - actbl := entropy^.ac_cur_tbls[blkn]; - - { Decode a single block's worth of coefficients } - - { Section F.2.2.1: decode the DC coefficient difference } - {HUFF_DECODE(s, br_state, dctbl, return FALSE, label1);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label1; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := dctbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := dctbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label1: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,dctbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - if (s <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := ( int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - end; - - if (entropy^.dc_needed[blkn]) then - begin - { Convert DC difference to actual value, update last_dc_val } - ci := cinfo^.MCU_membership[blkn]; - Inc(s, state.last_dc_val[ci]); - state.last_dc_val[ci] := s; - { Output the DC coefficient (assumes jpeg_natural_order[0] := 0) } - block^[0] := JCOEF (s); - end; - - if (entropy^.ac_needed[blkn]) then - begin - - { Section F.2.2.2: decode the AC coefficients } - { Since zeroes are skipped, output area must be cleared beforehand } - k := 1; - while (k < DCTSIZE2) do { Nomssi: k is incr. in the loop } - begin - {HUFF_DECODE(s, br_state, actbl, return FALSE, label2);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label2; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := actbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := actbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label2: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - { Output coefficient in natural (dezigzagged) order. - Note: the extra entries in jpeg_natural_order[] will save us - if k >= DCTSIZE2, which could happen if the data is corrupted. } - - block^[jpeg_natural_order[k]] := JCOEF (s); - end - else - begin - if (r <> 15) then - break; - Inc(k, 15); - end; - Inc(k); - end; - end - else - begin - - { Section F.2.2.2: decode the AC coefficients } - { In this path we just discard the values } - k := 1; - while (k < DCTSIZE2) do - begin - {HUFF_DECODE(s, br_state, actbl, return FALSE, label3);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu := False; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label3; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := actbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := actbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label3: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,actbl,nb); - if (s < 0) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {DROP_BITS(s);} - Dec(bits_left, s); - end - else - begin - if (r <> 15) then - break; - Inc(k, 15); - end; - Inc(k); - end; - - end; - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - {ASSIGN_STATE(entropy^.saved, state);} - entropy^.saved := state; - - end; - - { Account for restart interval (no-op if not using restarts) } - if entropy^.restarts_to_go > 0 then - Dec(entropy^.restarts_to_go); - - decode_mcu := TRUE; -end; - - -{ Module initialization routine for Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_huff_decoder (cinfo : j_decompress_ptr); -var - entropy : huff_entropy_ptr; - i : int; -begin - entropy := huff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(huff_entropy_decoder)) ); - cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_huff_decoder; - entropy^.pub.decode_mcu := decode_mcu; - - { Mark tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.dc_derived_tbls[i] := NIL; - entropy^.ac_derived_tbls[i] := NIL; - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdinput.pas b/3rd/Imaging/Source/JpegLib/imjdinput.pas deleted file mode 100644 index 16a13e247..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdinput.pas +++ /dev/null @@ -1,416 +0,0 @@ -unit imjdinput; - -{ Original: jdinput.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains input control logic for the JPEG decompressor. - These routines are concerned with controlling the decompressor's input - processing (marker reading and coefficient decoding). The actual input - reading is done in jdmarker.c, jdhuff.c, and jdphuff.c. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjpeglib, - imjdeferr, - imjerror, - imjinclude, imjutils; - -{ Initialize the input controller module. - This is called only once, when the decompression object is created. } - -{GLOBAL} -procedure jinit_input_controller (cinfo : j_decompress_ptr); - -implementation - -{ Private state } - -type - my_inputctl_ptr = ^my_input_controller; - my_input_controller = record - pub : jpeg_input_controller; { public fields } - - inheaders : boolean; { TRUE until first SOS is reached } - end; {my_input_controller;} - - - -{ Forward declarations } -{METHODDEF} -function consume_markers (cinfo : j_decompress_ptr) : int; forward; - - -{ Routines to calculate various quantities related to the size of the image. } - -{LOCAL} -procedure initial_setup (cinfo : j_decompress_ptr); -{ Called once, when first SOS marker is reached } -var - ci : int; - compptr : jpeg_component_info_ptr; -begin - { Make sure image isn't bigger than I can handle } - if (long(cinfo^.image_height) > long (JPEG_MAX_DIMENSION)) or - (long(cinfo^.image_width) > long(JPEG_MAX_DIMENSION)) then - ERREXIT1(j_common_ptr(cinfo), JERR_IMAGE_TOO_BIG, uInt(JPEG_MAX_DIMENSION)); - - { For now, precision must match compiled-in value... } - if (cinfo^.data_precision <> BITS_IN_JSAMPLE) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_PRECISION, cinfo^.data_precision); - - { Check that number of components won't exceed internal array sizes } - if (cinfo^.num_components > MAX_COMPONENTS) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.num_components, - MAX_COMPONENTS); - - { Compute maximum sampling factors; check factor validity } - cinfo^.max_h_samp_factor := 1; - cinfo^.max_v_samp_factor := 1; - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - if (compptr^.h_samp_factor<=0) or (compptr^.h_samp_factor>MAX_SAMP_FACTOR) or - (compptr^.v_samp_factor<=0) or (compptr^.v_samp_factor>MAX_SAMP_FACTOR) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_SAMPLING); - {cinfo^.max_h_samp_factor := MAX(cinfo^.max_h_samp_factor, - compptr^.h_samp_factor); - cinfo^.max_v_samp_factor := MAX(cinfo^.max_v_samp_factor, - compptr^.v_samp_factor);} - if cinfo^.max_h_samp_factor < compptr^.h_samp_factor then - cinfo^.max_h_samp_factor := compptr^.h_samp_factor; - if cinfo^.max_v_samp_factor < compptr^.v_samp_factor then - cinfo^.max_v_samp_factor := compptr^.v_samp_factor; - Inc(compptr); - end; - - { We initialize DCT_scaled_size and min_DCT_scaled_size to DCTSIZE. - In the full decompressor, this will be overridden by jdmaster.c; - but in the transcoder, jdmaster.c is not used, so we must do it here. } - - cinfo^.min_DCT_scaled_size := DCTSIZE; - - { Compute dimensions of components } - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - compptr^.DCT_scaled_size := DCTSIZE; - { Size in DCT blocks } - compptr^.width_in_blocks := JDIMENSION( - jdiv_round_up( long(cinfo^.image_width) * long(compptr^.h_samp_factor), - long(cinfo^.max_h_samp_factor * DCTSIZE)) ); - compptr^.height_in_blocks := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor), - long (cinfo^.max_v_samp_factor * DCTSIZE)) ); - { downsampled_width and downsampled_height will also be overridden by - jdmaster.c if we are doing full decompression. The transcoder library - doesn't use these values, but the calling application might. } - - { Size in samples } - compptr^.downsampled_width := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_width) * long(compptr^.h_samp_factor), - long (cinfo^.max_h_samp_factor)) ); - compptr^.downsampled_height := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * long(compptr^.v_samp_factor), - long (cinfo^.max_v_samp_factor)) ); - { Mark component needed, until color conversion says otherwise } - compptr^.component_needed := TRUE; - { Mark no quantization table yet saved for component } - compptr^.quant_table := NIL; - Inc(compptr); - end; - - { Compute number of fully interleaved MCU rows. } - cinfo^.total_iMCU_rows := JDIMENSION( - jdiv_round_up(long(cinfo^.image_height), - long(cinfo^.max_v_samp_factor*DCTSIZE)) ); - - { Decide whether file contains multiple scans } - if (cinfo^.comps_in_scan < cinfo^.num_components) or - (cinfo^.progressive_mode) then - cinfo^.inputctl^.has_multiple_scans := TRUE - else - cinfo^.inputctl^.has_multiple_scans := FALSE; -end; - - -{LOCAL} -procedure per_scan_setup (cinfo : j_decompress_ptr); -{ Do computations that are needed before processing a JPEG scan } -{ cinfo^.comps_in_scan and cinfo^.cur_comp_info[] were set from SOS marker } -var - ci, mcublks, tmp : int; - compptr : jpeg_component_info_ptr; -begin - if (cinfo^.comps_in_scan = 1) then - begin - { Noninterleaved (single-component) scan } - compptr := cinfo^.cur_comp_info[0]; - - { Overall image size in MCUs } - cinfo^.MCUs_per_row := compptr^.width_in_blocks; - cinfo^.MCU_rows_in_scan := compptr^.height_in_blocks; - - { For noninterleaved scan, always one block per MCU } - compptr^.MCU_width := 1; - compptr^.MCU_height := 1; - compptr^.MCU_blocks := 1; - compptr^.MCU_sample_width := compptr^.DCT_scaled_size; - compptr^.last_col_width := 1; - { For noninterleaved scans, it is convenient to define last_row_height - as the number of block rows present in the last iMCU row. } - - tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.v_samp_factor); - if (tmp = 0) then - tmp := compptr^.v_samp_factor; - compptr^.last_row_height := tmp; - - { Prepare array describing MCU composition } - cinfo^.blocks_in_MCU := 1; - cinfo^.MCU_membership[0] := 0; - - end - else - begin - - { Interleaved (multi-component) scan } - if (cinfo^.comps_in_scan <= 0) or (cinfo^.comps_in_scan > MAX_COMPS_IN_SCAN) then - ERREXIT2(j_common_ptr(cinfo), JERR_COMPONENT_COUNT, cinfo^.comps_in_scan, - MAX_COMPS_IN_SCAN); - - { Overall image size in MCUs } - cinfo^.MCUs_per_row := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_width), - long (cinfo^.max_h_samp_factor*DCTSIZE)) ); - cinfo^.MCU_rows_in_scan := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height), - long (cinfo^.max_v_samp_factor*DCTSIZE)) ); - - cinfo^.blocks_in_MCU := 0; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Sampling factors give # of blocks of component in each MCU } - compptr^.MCU_width := compptr^.h_samp_factor; - compptr^.MCU_height := compptr^.v_samp_factor; - compptr^.MCU_blocks := compptr^.MCU_width * compptr^.MCU_height; - compptr^.MCU_sample_width := compptr^.MCU_width * compptr^.DCT_scaled_size; - { Figure number of non-dummy blocks in last MCU column & row } - tmp := int (LongInt(compptr^.width_in_blocks) mod compptr^.MCU_width); - if (tmp = 0) then - tmp := compptr^.MCU_width; - compptr^.last_col_width := tmp; - tmp := int (LongInt(compptr^.height_in_blocks) mod compptr^.MCU_height); - if (tmp = 0) then - tmp := compptr^.MCU_height; - compptr^.last_row_height := tmp; - { Prepare array describing MCU composition } - mcublks := compptr^.MCU_blocks; - if (LongInt(cinfo^.blocks_in_MCU) + mcublks > D_MAX_BLOCKS_IN_MCU) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_MCU_SIZE); - while (mcublks > 0) do - begin - Dec(mcublks); - cinfo^.MCU_membership[cinfo^.blocks_in_MCU] := ci; - Inc(cinfo^.blocks_in_MCU); - end; - end; - - end; -end; - - -{ Save away a copy of the Q-table referenced by each component present - in the current scan, unless already saved during a prior scan. - - In a multiple-scan JPEG file, the encoder could assign different components - the same Q-table slot number, but change table definitions between scans - so that each component uses a different Q-table. (The IJG encoder is not - currently capable of doing this, but other encoders might.) Since we want - to be able to dequantize all the components at the end of the file, this - means that we have to save away the table actually used for each component. - We do this by copying the table at the start of the first scan containing - the component. - The JPEG spec prohibits the encoder from changing the contents of a Q-table - slot between scans of a component using that slot. If the encoder does so - anyway, this decoder will simply use the Q-table values that were current - at the start of the first scan for the component. - - The decompressor output side looks only at the saved quant tables, - not at the current Q-table slots. } - -{LOCAL} -procedure latch_quant_tables (cinfo : j_decompress_ptr); -var - ci, qtblno : int; - compptr : jpeg_component_info_ptr; - qtbl : JQUANT_TBL_PTR; -begin - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { No work if we already saved Q-table for this component } - if (compptr^.quant_table <> NIL) then - continue; - { Make sure specified quantization table is present } - qtblno := compptr^.quant_tbl_no; - if (qtblno < 0) or (qtblno >= NUM_QUANT_TBLS) or - (cinfo^.quant_tbl_ptrs[qtblno] = NIL) then - ERREXIT1(j_common_ptr(cinfo), JERR_NO_QUANT_TABLE, qtblno); - { OK, save away the quantization table } - qtbl := JQUANT_TBL_PTR( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(JQUANT_TBL)) ); - MEMCOPY(qtbl, cinfo^.quant_tbl_ptrs[qtblno], SIZEOF(JQUANT_TBL)); - compptr^.quant_table := qtbl; - end; -end; - - -{ Initialize the input modules to read a scan of compressed data. - The first call to this is done by jdmaster.c after initializing - the entire decompressor (during jpeg_start_decompress). - Subsequent calls come from consume_markers, below. } - -{METHODDEF} -procedure start_input_pass (cinfo : j_decompress_ptr); -begin - per_scan_setup(cinfo); - latch_quant_tables(cinfo); - cinfo^.entropy^.start_pass (cinfo); - cinfo^.coef^.start_input_pass (cinfo); - cinfo^.inputctl^.consume_input := cinfo^.coef^.consume_data; -end; - - -{ Finish up after inputting a compressed-data scan. - This is called by the coefficient controller after it's read all - the expected data of the scan. } - -{METHODDEF} -procedure finish_input_pass (cinfo : j_decompress_ptr); -begin - cinfo^.inputctl^.consume_input := consume_markers; -end; - - -{ Read JPEG markers before, between, or after compressed-data scans. - Change state as necessary when a new scan is reached. - Return value is JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. - - The consume_input method pointer points either here or to the - coefficient controller's consume_data routine, depending on whether - we are reading a compressed data segment or inter-segment markers. } - -{METHODDEF} -function consume_markers (cinfo : j_decompress_ptr) : int; -var - val : int; - inputctl : my_inputctl_ptr; -begin - inputctl := my_inputctl_ptr (cinfo^.inputctl); - - if (inputctl^.pub.eoi_reached) then { After hitting EOI, read no further } - begin - consume_markers := JPEG_REACHED_EOI; - exit; - end; - - val := cinfo^.marker^.read_markers (cinfo); - - case (val) of - JPEG_REACHED_SOS: { Found SOS } - begin - if (inputctl^.inheaders) then - begin { 1st SOS } - initial_setup(cinfo); - inputctl^.inheaders := FALSE; - { Note: start_input_pass must be called by jdmaster.c - before any more input can be consumed. jdapimin.c is - responsible for enforcing this sequencing. } - end - else - begin { 2nd or later SOS marker } - if (not inputctl^.pub.has_multiple_scans) then - ERREXIT(j_common_ptr(cinfo), JERR_EOI_EXPECTED); { Oops, I wasn't expecting this! } - start_input_pass(cinfo); - end; - end; - JPEG_REACHED_EOI: { Found EOI } - begin - inputctl^.pub.eoi_reached := TRUE; - if (inputctl^.inheaders) then - begin { Tables-only datastream, apparently } - if (cinfo^.marker^.saw_SOF) then - ERREXIT(j_common_ptr(cinfo), JERR_SOF_NO_SOS); - end - else - begin - { Prevent infinite loop in coef ctlr's decompress_data routine - if user set output_scan_number larger than number of scans. } - - if (cinfo^.output_scan_number > cinfo^.input_scan_number) then - cinfo^.output_scan_number := cinfo^.input_scan_number; - end; - end; - JPEG_SUSPENDED:; - end; - - consume_markers := val; -end; - - -{ Reset state to begin a fresh datastream. } - -{METHODDEF} -procedure reset_input_controller (cinfo : j_decompress_ptr); -var - inputctl : my_inputctl_ptr; -begin - inputctl := my_inputctl_ptr (cinfo^.inputctl); - - inputctl^.pub.consume_input := consume_markers; - inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better } - inputctl^.pub.eoi_reached := FALSE; - inputctl^.inheaders := TRUE; - { Reset other modules } - cinfo^.err^.reset_error_mgr (j_common_ptr(cinfo)); - cinfo^.marker^.reset_marker_reader (cinfo); - { Reset progression state -- would be cleaner if entropy decoder did this } - cinfo^.coef_bits := NIL; -end; - - -{ Initialize the input controller module. - This is called only once, when the decompression object is created. } - -{GLOBAL} -procedure jinit_input_controller (cinfo : j_decompress_ptr); -var - inputctl : my_inputctl_ptr; -begin - { Create subobject in permanent pool } - inputctl := my_inputctl_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - SIZEOF(my_input_controller)) ); - cinfo^.inputctl := jpeg_input_controller_ptr(inputctl); - { Initialize method pointers } - inputctl^.pub.consume_input := consume_markers; - inputctl^.pub.reset_input_controller := reset_input_controller; - inputctl^.pub.start_input_pass := start_input_pass; - inputctl^.pub.finish_input_pass := finish_input_pass; - { Initialize state: can't use reset_input_controller since we don't - want to try to reset other modules yet. } - - inputctl^.pub.has_multiple_scans := FALSE; { "unknown" would be better } - inputctl^.pub.eoi_reached := FALSE; - inputctl^.inheaders := TRUE; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdmainct.pas b/3rd/Imaging/Source/JpegLib/imjdmainct.pas deleted file mode 100644 index 8c04d7efc..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdmainct.pas +++ /dev/null @@ -1,610 +0,0 @@ -unit imjdmainct; - - -{ This file is part of the Independent JPEG Group's software. - For conditions of distribution and use, see the accompanying README file. - - This file contains the main buffer controller for decompression. - The main buffer lies between the JPEG decompressor proper and the - post-processor; it holds downsampled data in the JPEG colorspace. - - Note that this code is bypassed in raw-data mode, since the application - supplies the equivalent of the main buffer in that case. } - -{ Original: jdmainct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - - -{ In the current system design, the main buffer need never be a full-image - buffer; any full-height buffers will be found inside the coefficient or - postprocessing controllers. Nonetheless, the main controller is not - trivial. Its responsibility is to provide context rows for upsampling/ - rescaling, and doing this in an efficient fashion is a bit tricky. - - Postprocessor input data is counted in "row groups". A row group - is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) - sample rows of each component. (We require DCT_scaled_size values to be - chosen such that these numbers are integers. In practice DCT_scaled_size - values will likely be powers of two, so we actually have the stronger - condition that DCT_scaled_size / min_DCT_scaled_size is an integer.) - Upsampling will typically produce max_v_samp_factor pixel rows from each - row group (times any additional scale factor that the upsampler is - applying). - - The coefficient controller will deliver data to us one iMCU row at a time; - each iMCU row contains v_samp_factor * DCT_scaled_size sample rows, or - exactly min_DCT_scaled_size row groups. (This amount of data corresponds - to one row of MCUs when the image is fully interleaved.) Note that the - number of sample rows varies across components, but the number of row - groups does not. Some garbage sample rows may be included in the last iMCU - row at the bottom of the image. - - Depending on the vertical scaling algorithm used, the upsampler may need - access to the sample row(s) above and below its current input row group. - The upsampler is required to set need_context_rows TRUE at global - selection - time if so. When need_context_rows is FALSE, this controller can simply - obtain one iMCU row at a time from the coefficient controller and dole it - out as row groups to the postprocessor. - - When need_context_rows is TRUE, this controller guarantees that the buffer - passed to postprocessing contains at least one row group's worth of samples - above and below the row group(s) being processed. Note that the context - rows "above" the first passed row group appear at negative row offsets in - the passed buffer. At the top and bottom of the image, the required - context rows are manufactured by duplicating the first or last real sample - row; this avoids having special cases in the upsampling inner loops. - - The amount of context is fixed at one row group just because that's a - convenient number for this controller to work with. The existing - upsamplers really only need one sample row of context. An upsampler - supporting arbitrary output rescaling might wish for more than one row - group of context when shrinking the image; tough, we don't handle that. - (This is justified by the assumption that downsizing will be handled mostly - by adjusting the DCT_scaled_size values, so that the actual scale factor at - the upsample step needn't be much less than one.) - - To provide the desired context, we have to retain the last two row groups - of one iMCU row while reading in the next iMCU row. (The last row group - can't be processed until we have another row group for its below-context, - and so we have to save the next-to-last group too for its above-context.) - We could do this most simply by copying data around in our buffer, but - that'd be very slow. We can avoid copying any data by creating a rather - strange pointer structure. Here's how it works. We allocate a workspace - consisting of M+2 row groups (where M = min_DCT_scaled_size is the number - of row groups per iMCU row). We create two sets of redundant pointers to - the workspace. Labeling the physical row groups 0 to M+1, the synthesized - pointer lists look like this: - M+1 M-1 - master pointer --> 0 master pointer --> 0 - 1 1 - ... ... - M-3 M-3 - M-2 M - M-1 M+1 - M M-2 - M+1 M-1 - 0 0 - We read alternate iMCU rows using each master pointer; thus the last two - row groups of the previous iMCU row remain un-overwritten in the workspace. - The pointer lists are set up so that the required context rows appear to - be adjacent to the proper places when we pass the pointer lists to the - upsampler. - - The above pictures describe the normal state of the pointer lists. - At top and bottom of the image, we diddle the pointer lists to duplicate - the first or last sample row as necessary (this is cheaper than copying - sample rows around). - - This scheme breaks down if M < 2, ie, min_DCT_scaled_size is 1. In that - situation each iMCU row provides only one row group so the buffering logic - must be different (eg, we must read two iMCU rows before we can emit the - first row group). For now, we simply do not support providing context - rows when min_DCT_scaled_size is 1. That combination seems unlikely to - be worth providing --- if someone wants a 1/8th-size preview, they probably - want it quick and dirty, so a context-free upsampler is sufficient. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, -{$ifdef QUANT_2PASS_SUPPORTED} - imjquant2, -{$endif} - imjdeferr, - imjerror, - imjpeglib; - - -{GLOBAL} -procedure jinit_d_main_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); - - -implementation - -{ Private buffer controller object } - -type - my_main_ptr = ^my_main_controller; - my_main_controller = record - pub : jpeg_d_main_controller; { public fields } - - { Pointer to allocated workspace (M or M+2 row groups). } - buffer : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - buffer_full : boolean; { Have we gotten an iMCU row from decoder? } - rowgroup_ctr : JDIMENSION ; { counts row groups output to postprocessor } - - { Remaining fields are only used in the context case. } - - { These are the master pointers to the funny-order pointer lists. } - xbuffer : array[0..2-1] of JSAMPIMAGE; { pointers to weird pointer lists } - - whichptr : int; { indicates which pointer set is now in use } - context_state : int; { process_data state machine status } - rowgroups_avail : JDIMENSION; { row groups available to postprocessor } - iMCU_row_ctr : JDIMENSION; { counts iMCU rows to detect image top/bot } - end; { my_main_controller; } - - -{ context_state values: } -const - CTX_PREPARE_FOR_IMCU = 0; { need to prepare for MCU row } - CTX_PROCESS_IMCU = 1; { feeding iMCU to postprocessor } - CTX_POSTPONED_ROW = 2; { feeding postponed row group } - - -{ Forward declarations } -{METHODDEF} -procedure process_data_simple_main(cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{METHODDEF} -procedure process_data_context_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; - -{$ifdef QUANT_2PASS_SUPPORTED} -{METHODDEF} -procedure process_data_crank_post (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{$endif} - - -{LOCAL} -procedure alloc_funny_pointers (cinfo : j_decompress_ptr); -{ Allocate space for the funny pointer lists. - This is done only once, not once per pass. } -var - main : my_main_ptr; - ci, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - xbuf : JSAMPARRAY; -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - { Get top-level space for component array pointers. - We alloc both arrays with one call to save a few cycles. } - - main^.xbuffer[0] := JSAMPIMAGE ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - cinfo^.num_components * 2 * SIZEOF(JSAMPARRAY)) ); - main^.xbuffer[1] := JSAMPIMAGE(@( main^.xbuffer[0]^[cinfo^.num_components] )); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - { Get space for pointer lists --- M+4 row groups in each list. - We alloc both pointer lists with one call to save a few cycles. } - - xbuf := JSAMPARRAY ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - 2 * (rgroup * (M + 4)) * SIZEOF(JSAMPROW)) ); - Inc(JSAMPROW_PTR(xbuf), rgroup); { want one row group at negative offsets } - main^.xbuffer[0]^[ci] := xbuf; - Inc(JSAMPROW_PTR(xbuf), rgroup * (M + 4)); - main^.xbuffer[1]^[ci] := xbuf; - Inc(compptr); - end; -end; - -{LOCAL} -procedure make_funny_pointers (cinfo : j_decompress_ptr); -{ Create the funny pointer lists discussed in the comments above. - The actual workspace is already allocated (in main^.buffer), - and the space for the pointer lists is allocated too. - This routine just fills in the curiously ordered lists. - This will be repeated at the beginning of each pass. } -var - main : my_main_ptr; - ci, i, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - buf, xbuf0, xbuf1 : JSAMPARRAY; -var - help_xbuf0 : JSAMPARRAY; { work around negative offsets } -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - xbuf0 := main^.xbuffer[0]^[ci]; - xbuf1 := main^.xbuffer[1]^[ci]; - { First copy the workspace pointers as-is } - buf := main^.buffer[ci]; - for i := 0 to pred(rgroup * (M + 2)) do - begin - xbuf0^[i] := buf^[i]; - xbuf1^[i] := buf^[i]; - end; - { In the second list, put the last four row groups in swapped order } - for i := 0 to pred(rgroup * 2) do - begin - xbuf1^[rgroup*(M-2) + i] := buf^[rgroup*M + i]; - xbuf1^[rgroup*M + i] := buf^[rgroup*(M-2) + i]; - end; - { The wraparound pointers at top and bottom will be filled later - (see set_wraparound_pointers, below). Initially we want the "above" - pointers to duplicate the first actual data line. This only needs - to happen in xbuffer[0]. } - - help_xbuf0 := xbuf0; - Dec(JSAMPROW_PTR(help_xbuf0), rgroup); - - for i := 0 to pred(rgroup) do - begin - {xbuf0^[i - rgroup] := xbuf0^[0];} - help_xbuf0^[i] := xbuf0^[0]; - end; - Inc(compptr); - end; -end; - - -{LOCAL} -procedure set_wraparound_pointers (cinfo : j_decompress_ptr); -{ Set up the "wraparound" pointers at top and bottom of the pointer lists. - This changes the pointer list state from top-of-image to the normal state. } -var - main : my_main_ptr; - ci, i, rgroup : int; - M : int; - compptr : jpeg_component_info_ptr; - xbuf0, xbuf1 : JSAMPARRAY; -var - help_xbuf0, - help_xbuf1 : JSAMPARRAY; { work around negative offsets } -begin - main := my_main_ptr (cinfo^.main); - M := cinfo^.min_DCT_scaled_size; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - xbuf0 := main^.xbuffer[0]^[ci]; - xbuf1 := main^.xbuffer[1]^[ci]; - - help_xbuf0 := xbuf0; - Dec(JSAMPROW_PTR(help_xbuf0), rgroup); - help_xbuf1 := xbuf1; - Dec(JSAMPROW_PTR(help_xbuf1), rgroup); - - for i := 0 to pred(rgroup) do - begin - {xbuf0^[i - rgroup] := xbuf0^[rgroup*(M+1) + i]; - xbuf1^[i - rgroup] := xbuf1^[rgroup*(M+1) + i];} - - help_xbuf0^[i] := xbuf0^[rgroup*(M+1) + i]; - help_xbuf1^[i] := xbuf1^[rgroup*(M+1) + i]; - - xbuf0^[rgroup*(M+2) + i] := xbuf0^[i]; - xbuf1^[rgroup*(M+2) + i] := xbuf1^[i]; - end; - Inc(compptr); - end; -end; - - -{LOCAL} -procedure set_bottom_pointers (cinfo : j_decompress_ptr); -{ Change the pointer lists to duplicate the last sample row at the bottom - of the image. whichptr indicates which xbuffer holds the final iMCU row. - Also sets rowgroups_avail to indicate number of nondummy row groups in row. } -var - main : my_main_ptr; - ci, i, rgroup, iMCUheight, rows_left : int; - compptr : jpeg_component_info_ptr; - xbuf : JSAMPARRAY; -begin - main := my_main_ptr (cinfo^.main); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Count sample rows in one iMCU row and in one row group } - iMCUheight := compptr^.v_samp_factor * compptr^.DCT_scaled_size; - rgroup := iMCUheight div cinfo^.min_DCT_scaled_size; - { Count nondummy sample rows remaining for this component } - rows_left := int (compptr^.downsampled_height mod JDIMENSION (iMCUheight)); - if (rows_left = 0) then - rows_left := iMCUheight; - { Count nondummy row groups. Should get same answer for each component, - so we need only do it once. } - if (ci = 0) then - begin - main^.rowgroups_avail := JDIMENSION ((rows_left-1) div rgroup + 1); - end; - { Duplicate the last real sample row rgroup*2 times; this pads out the - last partial rowgroup and ensures at least one full rowgroup of context. } - - xbuf := main^.xbuffer[main^.whichptr]^[ci]; - for i := 0 to pred(rgroup * 2) do - begin - xbuf^[rows_left + i] := xbuf^[rows_left-1]; - end; - Inc(compptr); - end; -end; - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_main (cinfo : j_decompress_ptr; - pass_mode : J_BUF_MODE); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - case (pass_mode) of - JBUF_PASS_THRU: - begin - if (cinfo^.upsample^.need_context_rows) then - begin - main^.pub.process_data := process_data_context_main; - make_funny_pointers(cinfo); { Create the xbuffer[] lists } - main^.whichptr := 0; { Read first iMCU row into xbuffer[0] } - main^.context_state := CTX_PREPARE_FOR_IMCU; - main^.iMCU_row_ctr := 0; - end - else - begin - { Simple case with no context needed } - main^.pub.process_data := process_data_simple_main; - end; - main^.buffer_full := FALSE; { Mark buffer empty } - main^.rowgroup_ctr := 0; - end; -{$ifdef QUANT_2PASS_SUPPORTED} - JBUF_CRANK_DEST: - { For last pass of 2-pass quantization, just crank the postprocessor } - main^.pub.process_data := process_data_crank_post; -{$endif} - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; -end; - - -{ Process some data. - This handles the simple case where no context is required. } - -{METHODDEF} -procedure process_data_simple_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - main : my_main_ptr; - rowgroups_avail : JDIMENSION; -var - main_buffer_ptr : JSAMPIMAGE; -begin - main := my_main_ptr (cinfo^.main); - main_buffer_ptr := JSAMPIMAGE(@(main^.buffer)); - - { Read input data if we haven't filled the main buffer yet } - if (not main^.buffer_full) then - begin - if (cinfo^.coef^.decompress_data (cinfo, main_buffer_ptr)=0) then - exit; { suspension forced, can do nothing more } - main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } - end; - - { There are always min_DCT_scaled_size row groups in an iMCU row. } - rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size); - { Note: at the bottom of the image, we may pass extra garbage row groups - to the postprocessor. The postprocessor has to check for bottom - of image anyway (at row resolution), so no point in us doing it too. } - - { Feed the postprocessor } - cinfo^.post^.post_process_data (cinfo, main_buffer_ptr, - main^.rowgroup_ctr, rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - - { Has postprocessor consumed all the data yet? If so, mark buffer empty } - if (main^.rowgroup_ctr >= rowgroups_avail) then - begin - main^.buffer_full := FALSE; - main^.rowgroup_ctr := 0; - end; -end; - - -{ Process some data. - This handles the case where context rows must be provided. } - -{METHODDEF} -procedure process_data_context_main (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - main : my_main_ptr; -begin - main := my_main_ptr (cinfo^.main); - - { Read input data if we haven't filled the main buffer yet } - if (not main^.buffer_full) then - begin - if (cinfo^.coef^.decompress_data (cinfo, - main^.xbuffer[main^.whichptr])=0) then - exit; { suspension forced, can do nothing more } - main^.buffer_full := TRUE; { OK, we have an iMCU row to work with } - Inc(main^.iMCU_row_ctr); { count rows received } - end; - - { Postprocessor typically will not swallow all the input data it is handed - in one call (due to filling the output buffer first). Must be prepared - to exit and restart. This switch lets us keep track of how far we got. - Note that each case falls through to the next on successful completion. } - - case (main^.context_state) of - CTX_POSTPONED_ROW: - begin - { Call postprocessor using previously set pointers for postponed row } - cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], - main^.rowgroup_ctr, main^.rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - if (main^.rowgroup_ctr < main^.rowgroups_avail) then - exit; { Need to suspend } - main^.context_state := CTX_PREPARE_FOR_IMCU; - if (out_row_ctr >= out_rows_avail) then - exit; { Postprocessor exactly filled output buf } - end; - end; - case (main^.context_state) of - CTX_POSTPONED_ROW, - CTX_PREPARE_FOR_IMCU: {FALLTHROUGH} - begin - { Prepare to process first M-1 row groups of this iMCU row } - main^.rowgroup_ctr := 0; - main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size - 1); - { Check for bottom of image: if so, tweak pointers to "duplicate" - the last sample row, and adjust rowgroups_avail to ignore padding rows. } - - if (main^.iMCU_row_ctr = cinfo^.total_iMCU_rows) then - set_bottom_pointers(cinfo); - main^.context_state := CTX_PROCESS_IMCU; - - end; - end; - case (main^.context_state) of - CTX_POSTPONED_ROW, - CTX_PREPARE_FOR_IMCU, {FALLTHROUGH} - CTX_PROCESS_IMCU: - begin - { Call postprocessor using previously set pointers } - cinfo^.post^.post_process_data (cinfo, main^.xbuffer[main^.whichptr], - main^.rowgroup_ctr, main^.rowgroups_avail, - output_buf, out_row_ctr, out_rows_avail); - if (main^.rowgroup_ctr < main^.rowgroups_avail) then - exit; { Need to suspend } - { After the first iMCU, change wraparound pointers to normal state } - if (main^.iMCU_row_ctr = 1) then - set_wraparound_pointers(cinfo); - { Prepare to load new iMCU row using other xbuffer list } - main^.whichptr := main^.whichptr xor 1; { 0=>1 or 1=>0 } - main^.buffer_full := FALSE; - { Still need to process last row group of this iMCU row, } - { which is saved at index M+1 of the other xbuffer } - main^.rowgroup_ctr := JDIMENSION (cinfo^.min_DCT_scaled_size + 1); - main^.rowgroups_avail := JDIMENSION (cinfo^.min_DCT_scaled_size + 2); - main^.context_state := CTX_POSTPONED_ROW; - end; - end; -end; - - -{ Process some data. - Final pass of two-pass quantization: just call the postprocessor. - Source data will be the postprocessor controller's internal buffer. } - -{$ifdef QUANT_2PASS_SUPPORTED} - -{METHODDEF} -procedure process_data_crank_post (cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - in_row_group_ctr : JDIMENSION; -begin - in_row_group_ctr := 0; - cinfo^.post^.post_process_data (cinfo, JSAMPIMAGE (NIL), - in_row_group_ctr, - JDIMENSION(0), - output_buf, - out_row_ctr, - out_rows_avail); -end; - -{$endif} { QUANT_2PASS_SUPPORTED } - - -{ Initialize main buffer controller. } - -{GLOBAL} -procedure jinit_d_main_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -var - main : my_main_ptr; - ci, rgroup, ngroups : int; - compptr : jpeg_component_info_ptr; -begin - main := my_main_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_main_controller)) ); - cinfo^.main := jpeg_d_main_controller_ptr(main); - main^.pub.start_pass := start_pass_main; - - if (need_full_buffer) then { shouldn't happen } - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - - { Allocate the workspace. - ngroups is the number of row groups we need.} - - if (cinfo^.upsample^.need_context_rows) then - begin - if (cinfo^.min_DCT_scaled_size < 2) then { unsupported, see comments above } - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - alloc_funny_pointers(cinfo); { Alloc space for xbuffer[] lists } - ngroups := cinfo^.min_DCT_scaled_size + 2; - end - else - begin - ngroups := cinfo^.min_DCT_scaled_size; - end; - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - rgroup := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; { height of a row group of component } - main^.buffer[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - compptr^.width_in_blocks * LongWord(compptr^.DCT_scaled_size), - JDIMENSION (rgroup * ngroups)); - Inc(compptr); - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdmarker.pas b/3rd/Imaging/Source/JpegLib/imjdmarker.pas deleted file mode 100644 index ad175b5dc..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdmarker.pas +++ /dev/null @@ -1,2648 +0,0 @@ -unit imjdmarker; - -{ This file contains routines to decode JPEG datastream markers. - Most of the complexity arises from our desire to support input - suspension: if not all of the data for a marker is available; - we must exit back to the application. On resumption; we reprocess - the marker. } - -{ Original: jdmarker.c; Copyright (C) 1991-1998; Thomas G. Lane. } -{ History - 9.7.96 Conversion to pascal started jnn - 22.3.98 updated to 6b jnn } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjcomapi, - imjpeglib; - -const { JPEG marker codes } - M_SOF0 = $c0; - M_SOF1 = $c1; - M_SOF2 = $c2; - M_SOF3 = $c3; - - M_SOF5 = $c5; - M_SOF6 = $c6; - M_SOF7 = $c7; - - M_JPG = $c8; - M_SOF9 = $c9; - M_SOF10 = $ca; - M_SOF11 = $cb; - - M_SOF13 = $cd; - M_SOF14 = $ce; - M_SOF15 = $cf; - - M_DHT = $c4; - - M_DAC = $cc; - - M_RST0 = $d0; - M_RST1 = $d1; - M_RST2 = $d2; - M_RST3 = $d3; - M_RST4 = $d4; - M_RST5 = $d5; - M_RST6 = $d6; - M_RST7 = $d7; - - M_SOI = $d8; - M_EOI = $d9; - M_SOS = $da; - M_DQT = $db; - M_DNL = $dc; - M_DRI = $dd; - M_DHP = $de; - M_EXP = $df; - - M_APP0 = $e0; - M_APP1 = $e1; - M_APP2 = $e2; - M_APP3 = $e3; - M_APP4 = $e4; - M_APP5 = $e5; - M_APP6 = $e6; - M_APP7 = $e7; - M_APP8 = $e8; - M_APP9 = $e9; - M_APP10 = $ea; - M_APP11 = $eb; - M_APP12 = $ec; - M_APP13 = $ed; - M_APP14 = $ee; - M_APP15 = $ef; - - M_JPG0 = $f0; - M_JPG13 = $fd; - M_COM = $fe; - - M_TEM = $01; - - M_ERROR = $100; - -type - JPEG_MARKER = uint; { JPEG marker codes } - -{ Private state } - -type - my_marker_ptr = ^my_marker_reader; - my_marker_reader = record - pub : jpeg_marker_reader; { public fields } - - { Application-overridable marker processing methods } - process_COM : jpeg_marker_parser_method; - process_APPn : array[0..16-1] of jpeg_marker_parser_method; - - { Limit on marker data length to save for each marker type } - length_limit_COM : uint; - length_limit_APPn : array[0..16-1] of uint; - - { Status of COM/APPn marker saving } - cur_marker : jpeg_saved_marker_ptr; { NIL if not processing a marker } - bytes_read : uint; { data bytes read so far in marker } - { Note: cur_marker is not linked into marker_list until it's all read. } - end; - -{GLOBAL} -function jpeg_resync_to_restart(cinfo : j_decompress_ptr; - desired : int) : boolean; -{GLOBAL} -procedure jinit_marker_reader (cinfo : j_decompress_ptr); - -{$ifdef SAVE_MARKERS_SUPPORTED} - -{GLOBAL} -procedure jpeg_save_markers (cinfo : j_decompress_ptr; - marker_code : int; - length_limit : uint); -{$ENDIF} - -{GLOBAL} -procedure jpeg_set_marker_processor (cinfo : j_decompress_ptr; - marker_code : int; - routine : jpeg_marker_parser_method); - -implementation - -uses - imjutils; - -{ At all times, cinfo1.src.next_input_byte and .bytes_in_buffer reflect - the current restart point; we update them only when we have reached a - suitable place to restart if a suspension occurs. } - - -{ Routines to process JPEG markers. - - Entry condition: JPEG marker itself has been read and its code saved - in cinfo^.unread_marker; input restart point is just after the marker. - - Exit: if return TRUE, have read and processed any parameters, and have - updated the restart point to point after the parameters. - If return FALSE, was forced to suspend before reaching end of - marker parameters; restart point has not been moved. Same routine - will be called again after application supplies more input data. - - This approach to suspension assumes that all of a marker's parameters - can fit into a single input bufferload. This should hold for "normal" - markers. Some COM/APPn markers might have large parameter segments - that might not fit. If we are simply dropping such a marker, we use - skip_input_data to get past it, and thereby put the problem on the - source manager's shoulders. If we are saving the marker's contents - into memory, we use a slightly different convention: when forced to - suspend, the marker processor updates the restart point to the end of - what it's consumed (ie, the end of the buffer) before returning FALSE. - On resumption, cinfo->unread_marker still contains the marker code, - but the data source will point to the next chunk of marker data. - The marker processor must retain internal state to deal with this. - - Note that we don't bother to avoid duplicate trace messages if a - suspension occurs within marker parameters. Other side effects - require more care. } - -{LOCAL} -function get_soi (cinfo : j_decompress_ptr) : boolean; -{ Process an SOI marker } -var - i : int; -begin - {$IFDEF DEBUG} - TRACEMS(j_common_ptr(cinfo), 1, JTRC_SOI); - {$ENDIF} - - if (cinfo^.marker^.saw_SOI) then - ERREXIT(j_common_ptr(cinfo), JERR_SOI_DUPLICATE); - - { Reset all parameters that are defined to be reset by SOI } - - for i := 0 to Pred(NUM_ARITH_TBLS) do - with cinfo^ do - begin - arith_dc_L[i] := 0; - arith_dc_U[i] := 1; - arith_ac_K[i] := 5; - end; - cinfo^.restart_interval := 0; - - { Set initial assumptions for colorspace etc } - - with cinfo^ do - begin - jpeg_color_space := JCS_UNKNOWN; - CCIR601_sampling := FALSE; { Assume non-CCIR sampling??? } - - saw_JFIF_marker := FALSE; - JFIF_major_version := 1; { set default JFIF APP0 values } - JFIF_minor_version := 1; - density_unit := 0; - X_density := 1; - Y_density := 1; - saw_Adobe_marker := FALSE; - Adobe_transform := 0; - - marker^.saw_SOI := TRUE; - end; - get_soi := TRUE; -end; { get_soi } - - -{LOCAL} -function get_sof(cinfo : j_decompress_ptr; - is_prog : boolean; - is_arith : boolean) : boolean; -{ Process a SOFn marker } -var - length : INT32; - c, ci : int; - compptr : jpeg_component_info_ptr; -{ Declare and initialize local copies of input pointer/count } -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; -{} - cinfo^.progressive_mode := is_prog; - cinfo^.arith_code := is_arith; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - - { Read a byte into variable cinfo^.data_precision. - If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - cinfo^.data_precision := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - -{ Read two bytes interpreted as an unsigned 16-bit integer. - cinfo^.image_height should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - cinfo^.image_height := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( cinfo^.image_height, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - -{ Read two bytes interpreted as an unsigned 16-bit integer. - cinfo^.image_width should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - cinfo^.image_width := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( cinfo^.image_width, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - { Read a byte into variable cinfo^.num_components. - If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - cinfo^.num_components := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - Dec(length, 8); - - {$IFDEF DEBUG} - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_SOF, cinfo^.unread_marker, - int(cinfo^.image_width), int(cinfo^.image_height), - cinfo^.num_components); - {$ENDIF} - - if (cinfo^.marker^.saw_SOF) then - ERREXIT(j_common_ptr(cinfo), JERR_SOF_DUPLICATE); - - { We don't support files in which the image height is initially specified } - { as 0 and is later redefined by DNL. As long as we have to check that, } - { might as well have a general sanity check. } - if (cinfo^.image_height <= 0) or (cinfo^.image_width <= 0) - or (cinfo^.num_components <= 0) then - ERREXIT(j_common_ptr(cinfo), JERR_EMPTY_IMAGE); - - if (length <> (cinfo^.num_components * 3)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - if (cinfo^.comp_info = NIL) then { do only once, even if suspend } - cinfo^.comp_info := jpeg_component_info_list_ptr( - cinfo^.mem^.alloc_small(j_common_ptr(cinfo), JPOOL_IMAGE, - cinfo^.num_components * SIZEOF(jpeg_component_info))); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - compptr^.component_index := ci; - - { Read a byte into variable compptr^.component_id. - If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - compptr^.component_id := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - compptr^.h_samp_factor := (c shr 4) and 15; - compptr^.v_samp_factor := (c ) and 15; - - { Read a byte into variable compptr^.quant_tbl_no. - If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sof := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - compptr^.quant_tbl_no := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - {$IFDEF DEBUG} - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_SOF_COMPONENT, - compptr^.component_id, compptr^.h_samp_factor, - compptr^.v_samp_factor, compptr^.quant_tbl_no); - {$ENDIF} - - Inc(compptr); - end; - - cinfo^.marker^.saw_SOF := TRUE; - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_sof := TRUE; -end; { get_sof } - - -{LOCAL} -function get_sos (cinfo : j_decompress_ptr) : boolean; -{ Process a SOS marker } -label - id_found; -var - length : INT32; - i, ci, n, c, cc : int; - compptr : jpeg_component_info_ptr; -{ Declare and initialize local copies of input pointer/count } -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; { Array[] of JOCTET; } - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{} - - if not cinfo^.marker^.saw_SOF then - ERREXIT(j_common_ptr(cinfo), JERR_SOS_NO_SOF); - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - - { Read a byte into variable n (Number of components). - If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - n := GETJOCTET(next_input_byte^); { Number of components } - Inc(next_input_byte); - - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_SOS, n); - {$ENDIF} - - if ((length <> (n * 2 + 6)) or (n < 1) or (n > MAX_COMPS_IN_SCAN)) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - cinfo^.comps_in_scan := n; - - { Collect the component-spec parameters } - - for i := 0 to Pred(n) do - begin - { Read a byte into variable cc. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - cc := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to Pred(cinfo^.num_components) do - begin - if (cc = compptr^.component_id) then - goto id_found; - Inc(compptr); - end; - - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_COMPONENT_ID, cc); - - id_found: - - cinfo^.cur_comp_info[i] := compptr; - compptr^.dc_tbl_no := (c shr 4) and 15; - compptr^.ac_tbl_no := (c ) and 15; - - {$IFDEF DEBUG} - TRACEMS3(j_common_ptr(cinfo), 1, JTRC_SOS_COMPONENT, cc, - compptr^.dc_tbl_no, compptr^.ac_tbl_no); - {$ENDIF} - end; - - { Collect the additional scan parameters Ss, Se, Ah/Al. } - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - cinfo^.Ss := c; - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - cinfo^.Se := c; - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_sos := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - cinfo^.Ah := (c shr 4) and 15; - cinfo^.Al := (c ) and 15; - - {$IFDEF DEBUG} - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_SOS_PARAMS, cinfo^.Ss, cinfo^.Se, - cinfo^.Ah, cinfo^.Al); - {$ENDIF} - - { Prepare to scan data & restart markers } - cinfo^.marker^.next_restart_num := 0; - - { Count another SOS marker } - Inc( cinfo^.input_scan_number ); - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_sos := TRUE; -end; { get_sos } - - -{METHODDEF} -function skip_variable (cinfo : j_decompress_ptr) : boolean; -{ Skip over an unknown or uninteresting variable-length marker } -var - length : INT32; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; { Array[] of JOCTET; } - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - skip_variable := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := uint(GETJOCTET(next_input_byte^)) shl 8; - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - skip_variable := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET(next_input_byte^)); - Inc( next_input_byte ); - - Dec(length, 2); - - {$IFDEF DEBUG} - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_MISC_MARKER, - cinfo^.unread_marker, int(length)); - {$ENDIF} - - { Unload the local copies --- do this only at a restart boundary } - { do before skip_input_data } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - if (length > 0) then - cinfo^.src^.skip_input_data(cinfo, long(length)); - - skip_variable := TRUE; -end; { skip_variable } - - -{$IFDEF D_ARITH_CODING_SUPPORTED} - -{LOCAL} -function get_dac (cinfo : j_decompress_ptr) : boolean; -{ Process a DAC marker } -var - length : INT32; - index, val : int; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dac := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dac := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - Dec(length, 2); - - while (length > 0) do - begin - { Read a byte into variable index. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dac := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - index := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - { Read a byte into variable val. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dac := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - val := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - Dec( length, 2); - - {$IFDEF DEBUG} - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_DAC, index, val); - {$ENDIF} - - if (index < 0) or (index >= (2*NUM_ARITH_TBLS)) then - ERREXIT1(j_common_ptr(cinfo) , JERR_DAC_INDEX, index); - - if (index >= NUM_ARITH_TBLS) then - begin { define AC table } - cinfo^.arith_ac_K[index-NUM_ARITH_TBLS] := UINT8(val); - end - else - begin { define DC table } - cinfo^.arith_dc_L[index] := UINT8(val and $0F); - cinfo^.arith_dc_U[index] := UINT8(val shr 4); - if (cinfo^.arith_dc_L[index] > cinfo^.arith_dc_U[index]) then - ERREXIT1(j_common_ptr(cinfo) , JERR_DAC_VALUE, val); - end; - end; - - if (length <> 0) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_dac := TRUE; -end; { get_dac } - -{$ELSE} - -{LOCAL} -function get_dac (cinfo : j_decompress_ptr) : boolean; -begin - get_dac := skip_variable(cinfo); -end; - -{$ENDIF} - -{LOCAL} -function get_dht (cinfo : j_decompress_ptr) : boolean; -{ Process a DHT marker } -var - length : INT32; - bits : Array[0..17-1] of UINT8; - huffval : Array[0..256-1] of UINT8; - i, index, count : int; - htblptr : ^JHUFF_TBL_PTR; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dht := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dht := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - Dec(length, 2); - - while (length > 16) do - begin - { Read a byte into variable index. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dht := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - index := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_DHT, index); - {$ENDIF} - - bits[0] := 0; - count := 0; - for i := 1 to 16 do - begin - { Read a byte into variable bits[i]. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dht := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - bits[i] := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - Inc( count, bits[i] ); - end; - - Dec( length, (1 + 16) ); - - {$IFDEF DEBUG} - TRACEMS8(j_common_ptr(cinfo), 2, JTRC_HUFFBITS, - bits[1], bits[2], bits[3], bits[4], - bits[5], bits[6], bits[7], bits[8]); - TRACEMS8(j_common_ptr(cinfo), 2, JTRC_HUFFBITS, - bits[9], bits[10], bits[11], bits[12], - bits[13], bits[14], bits[15], bits[16]); - {$ENDIF} - - { Here we just do minimal validation of the counts to avoid walking - off the end of our table space. jdhuff.c will check more carefully. } - - if (count > 256) or (INT32(count) > length) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_HUFF_TABLE); - - for i := 0 to Pred(count) do - begin - { Read a byte into variable huffval[i]. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dht := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - huffval[i] := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - end; - - Dec( length, count ); - - if (index and $10)<>0 then - begin { AC table definition } - Dec( index, $10 ); - htblptr := @cinfo^.ac_huff_tbl_ptrs[index]; - end - else - begin { DC table definition } - htblptr := @cinfo^.dc_huff_tbl_ptrs[index]; - end; - - if (index < 0) or (index >= NUM_HUFF_TBLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_DHT_INDEX, index); - - if (htblptr^ = NIL) then - htblptr^ := jpeg_alloc_huff_table(j_common_ptr(cinfo)); - - MEMCOPY(@(htblptr^)^.bits, @bits, SIZEOF((htblptr^)^.bits)); - MEMCOPY(@(htblptr^)^.huffval, @huffval, SIZEOF((htblptr^)^.huffval)); - end; - - if (length <> 0) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_dht := TRUE; -end; { get_dht } - - -{LOCAL} -function get_dqt (cinfo : j_decompress_ptr) : boolean; -{ Process a DQT marker } -var - length : INT32; - n, i, prec : int; - tmp : uint; - quant_ptr : JQUANT_TBL_PTR; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - Dec( length, 2 ); - - while (length > 0) do - begin - { Read a byte into variable n. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - n := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - prec := n shr 4; - n := n and $0F; - - {$IFDEF DEBUG} - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_DQT, n, prec); - {$ENDIF} - - if (n >= NUM_QUANT_TBLS) then - ERREXIT1(j_common_ptr(cinfo) , JERR_DQT_INDEX, n); - - if (cinfo^.quant_tbl_ptrs[n] = NIL) then - cinfo^.quant_tbl_ptrs[n] := jpeg_alloc_quant_table(j_common_ptr(cinfo)); - quant_ptr := cinfo^.quant_tbl_ptrs[n]; - - for i := 0 to Pred(DCTSIZE2) do - begin - if (prec <> 0) then - begin - { Read two bytes interpreted as an unsigned 16-bit integer. - tmp should be declared unsigned int or perhaps INT32. } - - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - tmp := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( tmp, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - end - else - begin - { Read a byte into variable tmp. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dqt := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - tmp := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - end; - - { We convert the zigzag-order table to natural array order. } - quant_ptr^.quantval[jpeg_natural_order[i]] := UINT16(tmp); - end; - - if (cinfo^.err^.trace_level >= 2) then - begin - i := 0; - while i < Pred(DCTSIZE2) do - begin - {$IFDEF DEBUG} - TRACEMS8(j_common_ptr(cinfo), 2, JTRC_QUANTVALS, - quant_ptr^.quantval[i], quant_ptr^.quantval[i+1], - quant_ptr^.quantval[i+2], quant_ptr^.quantval[i+3], - quant_ptr^.quantval[i+4], quant_ptr^.quantval[i+5], - quant_ptr^.quantval[i+6], quant_ptr^.quantval[i+7]); - {$ENDIF} - Inc(i, 8); - end; - end; - - Dec( length, DCTSIZE2+1 ); - if (prec <> 0) then - Dec( length, DCTSIZE2 ); - end; - - if (length <> 0) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_dqt := TRUE; -end; { get_dqt } - - -{LOCAL} -function get_dri (cinfo : j_decompress_ptr) : boolean; -{ Process a DRI marker } -var - length : INT32; - tmp : uint; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dri := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dri := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - if (length <> 4) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_LENGTH); - -{ Read two bytes interpreted as an unsigned 16-bit integer. - tmp should be declared unsigned int or perhaps INT32. } - -{ make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dri := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - tmp := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_dri := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( tmp, GETJOCTET( next_input_byte^)); - Inc( next_input_byte ); - - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_DRI, tmp); - {$ENDIF} - - cinfo^.restart_interval := tmp; - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - get_dri := TRUE; -end; { get_dri } - - -{ Routines for processing APPn and COM markers. - These are either saved in memory or discarded, per application request. - APP0 and APP14 are specially checked to see if they are - JFIF and Adobe markers, respectively. } - -const - APP0_DATA_LEN = 14; { Length of interesting data in APP0 } - APP14_DATA_LEN = 12; { Length of interesting data in APP14 } - APPN_DATA_LEN = 14; { Must be the largest of the above!! } - - -{LOCAL} -procedure examine_app0 (cinfo : j_decompress_ptr; - var data : array of JOCTET; - datalen : uint; - remaining : INT32); - -{ Examine first few bytes from an APP0. - Take appropriate action if it is a JFIF marker. - datalen is # of bytes at data[], remaining is length of rest of marker data. -} -{$IFDEF DEBUG} -var - totallen : INT32; -{$ENDIF} -begin - {$IFDEF DEBUG} - totallen := INT32(datalen) + remaining; - {$ENDIF} - if (datalen >= APP0_DATA_LEN) and - (GETJOCTET(data[0]) = $4A) and - (GETJOCTET(data[1]) = $46) and - (GETJOCTET(data[2]) = $49) and - (GETJOCTET(data[3]) = $46) and - (GETJOCTET(data[4]) = 0) then - begin - { Found JFIF APP0 marker: save info } - cinfo^.saw_JFIF_marker := TRUE; - cinfo^.JFIF_major_version := GETJOCTET(data[5]); - cinfo^.JFIF_minor_version := GETJOCTET(data[6]); - cinfo^.density_unit := GETJOCTET(data[7]); - cinfo^.X_density := (GETJOCTET(data[8]) shl 8) + GETJOCTET(data[9]); - cinfo^.Y_density := (GETJOCTET(data[10]) shl 8) + GETJOCTET(data[11]); - { Check version. - Major version must be 1, anything else signals an incompatible change. - (We used to treat this as an error, but now it's a nonfatal warning, - because some bozo at Hijaak couldn't read the spec.) - Minor version should be 0..2, but process anyway if newer. } - - if (cinfo^.JFIF_major_version <> 1) then - WARNMS2(j_common_ptr(cinfo), JWRN_JFIF_MAJOR, - cinfo^.JFIF_major_version, cinfo^.JFIF_minor_version); - { Generate trace messages } - {$IFDEF DEBUG} - TRACEMS5(j_common_ptr(cinfo), 1, JTRC_JFIF, - cinfo^.JFIF_major_version, cinfo^.JFIF_minor_version, - cinfo^.X_density, cinfo^.Y_density, cinfo^.density_unit); - { Validate thumbnail dimensions and issue appropriate messages } - if (GETJOCTET(data[12]) or GETJOCTET(data[13])) <> 0 then - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_JFIF_THUMBNAIL, - GETJOCTET(data[12]), GETJOCTET(data[13])); - Dec(totallen, APP0_DATA_LEN); - if (totallen <> - ( INT32(GETJOCTET(data[12])) * INT32(GETJOCTET(data[13])) * INT32(3) )) then - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_JFIF_BADTHUMBNAILSIZE, int(totallen)); - {$ENDIF} - end - else - if (datalen >= 6) and - (GETJOCTET(data[0]) = $4A) and - (GETJOCTET(data[1]) = $46) and - (GETJOCTET(data[2]) = $58) and - (GETJOCTET(data[3]) = $58) and - (GETJOCTET(data[4]) = 0) then - begin - { Found JFIF "JFXX" extension APP0 marker } - { The library doesn't actually do anything with these, - but we try to produce a helpful trace message. } - {$IFDEF DEBUG} - case (GETJOCTET(data[5])) of - $10: - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_THUMB_JPEG, int(totallen)); - $11: - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_THUMB_PALETTE, int(totallen)); - $13: - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_THUMB_RGB, int(totallen)); - else - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_JFIF_EXTENSION, - GETJOCTET(data[5]), int(totallen)); - end; - {$ENDIF} - end - else - begin - { Start of APP0 does not match "JFIF" or "JFXX", or too short } - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_APP0, int(totallen)); - {$ENDIF} - end; -end; - - -{LOCAL} -procedure examine_app14 (cinfo : j_decompress_ptr; - var data : array of JOCTET; - datalen : uint; - remaining : INT32); -{ Examine first few bytes from an APP14. - Take appropriate action if it is an Adobe marker. - datalen is # of bytes at data[], remaining is length of rest of marker data. - } -var - {$IFDEF DEBUG} - version, flags0, flags1, - {$ENDIF} - transform : uint; -begin - if (datalen >= APP14_DATA_LEN) and - (GETJOCTET(data[0]) = $41) and - (GETJOCTET(data[1]) = $64) and - (GETJOCTET(data[2]) = $6F) and - (GETJOCTET(data[3]) = $62) and - (GETJOCTET(data[4]) = $65) then - begin - { Found Adobe APP14 marker } - {$IFDEF DEBUG} - version := (GETJOCTET(data[5]) shl 8) + GETJOCTET(data[6]); - flags0 := (GETJOCTET(data[7]) shl 8) + GETJOCTET(data[8]); - flags1 := (GETJOCTET(data[9]) shl 8) + GETJOCTET(data[10]); - {$ENDIF} - transform := GETJOCTET(data[11]); - {$IFDEF DEBUG} - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_ADOBE, version, flags0, flags1, transform); - {$ENDIF} - cinfo^.saw_Adobe_marker := TRUE; - cinfo^.Adobe_transform := UINT8 (transform); - end - else - begin - { Start of APP14 does not match "Adobe", or too short } - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_APP14, int (datalen + remaining)); - {$ENDIF} - end; -end; - - -{METHODDEF} -function get_interesting_appn (cinfo : j_decompress_ptr) : boolean; -{ Process an APP0 or APP14 marker without saving it } -var - length : INT32; - b : array[0..APPN_DATA_LEN-1] of JOCTET; - i, numtoread: uint; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - -{ Read two bytes interpreted as an unsigned 16-bit integer. - length should be declared unsigned int or perhaps INT32. } - - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_interesting_appn := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_interesting_appn := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET(next_input_byte^)); - Inc( next_input_byte ); - - Dec(length, 2); - - { get the interesting part of the marker data } - if (length >= APPN_DATA_LEN) then - numtoread := APPN_DATA_LEN - else - if (length > 0) then - numtoread := uint(length) - else - numtoread := 0; - - if numtoread > 0 then - begin - for i := 0 to numtoread-1 do - begin - { Read a byte into b[i]. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - get_interesting_appn := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - b[i] := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - end; - end; - - Dec(length, numtoread); - - { process it } - case (cinfo^.unread_marker) of - M_APP0: - examine_app0(cinfo, b, numtoread, length); - M_APP14: - examine_app14(cinfo, b, numtoread, length); - else - { can't get here unless jpeg_save_markers chooses wrong processor } - ERREXIT1(j_common_ptr(cinfo), JERR_UNKNOWN_MARKER, cinfo^.unread_marker); - end; - - { skip any remaining data -- could be lots } - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - if (length > 0) then - cinfo^.src^.skip_input_data(cinfo, long(length)); - - get_interesting_appn := TRUE; -end; - -{$ifdef SAVE_MARKERS_SUPPORTED} - -{METHODDEF} -function save_marker (cinfo : j_decompress_ptr) : boolean; -{ Save an APPn or COM marker into the marker list } -var - marker : my_marker_ptr; - cur_marker : jpeg_saved_marker_ptr; - bytes_read, data_length : uint; - data : JOCTET_FIELD_PTR; - length : INT32; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -var - limit : uint; -var - prev : jpeg_saved_marker_ptr; -begin - { local copies of input pointer/count } - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - - marker := my_marker_ptr(cinfo^.marker); - cur_marker := marker^.cur_marker; - length := 0; - - if (cur_marker = NIL) then - begin - { begin reading a marker } - { Read two bytes interpreted as an unsigned 16-bit integer. } - - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - save_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - length := (uint( GETJOCTET(next_input_byte^)) shl 8); - Inc( next_input_byte ); - - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - save_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - Inc( length, GETJOCTET(next_input_byte^)); - Inc( next_input_byte ); - - Dec(length, 2); - if (length >= 0) then - begin { watch out for bogus length word } - { figure out how much we want to save } - - if (cinfo^.unread_marker = int(M_COM)) then - limit := marker^.length_limit_COM - else - limit := marker^.length_limit_APPn[cinfo^.unread_marker - int(M_APP0)]; - if (uint(length) < limit) then - limit := uint(length); - { allocate and initialize the marker item } - cur_marker := jpeg_saved_marker_ptr( - cinfo^.mem^.alloc_large (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(jpeg_marker_struct) + limit) ); - cur_marker^.next := NIL; - cur_marker^.marker := UINT8 (cinfo^.unread_marker); - cur_marker^.original_length := uint(length); - cur_marker^.data_length := limit; - { data area is just beyond the jpeg_marker_struct } - cur_marker^.data := JOCTET_FIELD_PTR(cur_marker); - Inc(jpeg_saved_marker_ptr(cur_marker^.data)); - data := cur_marker^.data; - - marker^.cur_marker := cur_marker; - marker^.bytes_read := 0; - bytes_read := 0; - data_length := limit; - end - else - begin - { deal with bogus length word } - data_length := 0; - bytes_read := 0; - data := NIL; - end - end - else - begin - { resume reading a marker } - bytes_read := marker^.bytes_read; - data_length := cur_marker^.data_length; - data := cur_marker^.data; - Inc(data, bytes_read); - end; - - while (bytes_read < data_length) do - begin - { move the restart point to here } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - marker^.bytes_read := bytes_read; - { If there's not at least one byte in buffer, suspend } - if (bytes_in_buffer = 0) then - begin - if not datasrc^.fill_input_buffer (cinfo) then - begin - save_marker := FALSE; - exit; - end; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - - { Copy bytes with reasonable rapidity } - while (bytes_read < data_length) and (bytes_in_buffer > 0) do - begin - JOCTETPTR(data)^ := next_input_byte^; - Inc(JOCTETPTR(data)); - Inc(next_input_byte); - Dec(bytes_in_buffer); - Inc(bytes_read); - end; - end; - - { Done reading what we want to read } - if (cur_marker <> NIL) then - begin { will be NIL if bogus length word } - { Add new marker to end of list } - if (cinfo^.marker_list = NIL) then - begin - cinfo^.marker_list := cur_marker - end - else - begin - prev := cinfo^.marker_list; - while (prev^.next <> NIL) do - prev := prev^.next; - prev^.next := cur_marker; - end; - { Reset pointer & calc remaining data length } - data := cur_marker^.data; - length := cur_marker^.original_length - data_length; - end; - { Reset to initial state for next marker } - marker^.cur_marker := NIL; - - { Process the marker if interesting; else just make a generic trace msg } - case (cinfo^.unread_marker) of - M_APP0: - examine_app0(cinfo, data^, data_length, length); - M_APP14: - examine_app14(cinfo, data^, data_length, length); - else - {$IFDEF DEBUG} - TRACEMS2(j_common_ptr(cinfo), 1, JTRC_MISC_MARKER, cinfo^.unread_marker, - int(data_length + length)); - {$ENDIF} - end; - - { skip any remaining data -- could be lots } - { do before skip_input_data } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - if (length > 0) then - cinfo^.src^.skip_input_data (cinfo, long(length) ); - - save_marker := TRUE; -end; - -{$endif} { SAVE_MARKERS_SUPPORTED } - - -{ Find the next JPEG marker, save it in cinfo^.unread_marker. - Returns FALSE if had to suspend before reaching a marker; - in that case cinfo^.unread_marker is unchanged. - - Note that the result might not be a valid marker code, - but it will never be 0 or FF. } - -{LOCAL} -function next_marker (cinfo : j_decompress_ptr) : boolean; -var - c : int; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - - {while TRUE do} - repeat - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - next_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - { Skip any non-FF bytes. - This may look a bit inefficient, but it will not occur in a valid file. - We sync after each discarded byte so that a suspending data source - can discard the byte from its buffer. } - - while (c <> $FF) do - begin - Inc(cinfo^.marker^.discarded_bytes); - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - next_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - end; - { This loop swallows any duplicate FF bytes. Extra FFs are legal as - pad bytes, so don't count them in discarded_bytes. We assume there - will not be so many consecutive FF bytes as to overflow a suspending - data source's input buffer. } - - repeat - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - next_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - Until (c <> $FF); - if (c <> 0) then - break; { found a valid marker, exit loop } - { Reach here if we found a stuffed-zero data sequence (FF/00). - Discard it and loop back to try again. } - - Inc(cinfo^.marker^.discarded_bytes, 2); - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - Until False; - - if (cinfo^.marker^.discarded_bytes <> 0) then - begin - WARNMS2(j_common_ptr(cinfo), JWRN_EXTRANEOUS_DATA, - cinfo^.marker^.discarded_bytes, c); - cinfo^.marker^.discarded_bytes := 0; - end; - - cinfo^.unread_marker := c; - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - next_marker := TRUE; -end; { next_marker } - - -{LOCAL} -function first_marker (cinfo : j_decompress_ptr) : boolean; -{ Like next_marker, but used to obtain the initial SOI marker. } -{ For this marker, we do not allow preceding garbage or fill; otherwise, - we might well scan an entire input file before realizing it ain't JPEG. - If an application wants to process non-JFIF files, it must seek to the - SOI before calling the JPEG library. } -var - c, c2 : int; -var - datasrc : jpeg_source_mgr_ptr; - next_input_byte : JOCTETptr; - bytes_in_buffer : size_t; -begin - datasrc := cinfo^.src; - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - - { Read a byte into variable c. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - first_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - { Read a byte into variable c2. If must suspend, return FALSE. } - { make a byte available. - Note we do *not* do INPUT_SYNC before calling fill_input_buffer, - but we must reload the local copies after a successful fill. } - if (bytes_in_buffer = 0) then - begin - if (not datasrc^.fill_input_buffer(cinfo)) then - begin - first_marker := FALSE; - exit; - end; - { Reload the local copies } - next_input_byte := datasrc^.next_input_byte; - bytes_in_buffer := datasrc^.bytes_in_buffer; - end; - Dec( bytes_in_buffer ); - - c2 := GETJOCTET(next_input_byte^); - Inc(next_input_byte); - - if (c <> $FF) or (c2 <> int(M_SOI)) then - ERREXIT2(j_common_ptr(cinfo), JERR_NO_SOI, c, c2); - - cinfo^.unread_marker := c2; - - { Unload the local copies --- do this only at a restart boundary } - datasrc^.next_input_byte := next_input_byte; - datasrc^.bytes_in_buffer := bytes_in_buffer; - - first_marker := TRUE; -end; { first_marker } - - -{ Read markers until SOS or EOI. - - Returns same codes as are defined for jpeg_consume_input: - JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. } - -{METHODDEF} -function read_markers (cinfo : j_decompress_ptr) : int; -begin - { Outer loop repeats once for each marker. } - repeat - { Collect the marker proper, unless we already did. } - { NB: first_marker() enforces the requirement that SOI appear first. } - if (cinfo^.unread_marker = 0) then - begin - if not cinfo^.marker^.saw_SOI then - begin - if not first_marker(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - end - else - begin - if not next_marker(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - end; - end; - { At this point cinfo^.unread_marker contains the marker code and the - input point is just past the marker proper, but before any parameters. - A suspension will cause us to return with this state still true. } - - case (cinfo^.unread_marker) of - M_SOI: - if not get_soi(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_SOF0, { Baseline } - M_SOF1: { Extended sequential, Huffman } - if not get_sof(cinfo, FALSE, FALSE) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - M_SOF2: { Progressive, Huffman } - if not get_sof(cinfo, TRUE, FALSE) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_SOF9: { Extended sequential, arithmetic } - if not get_sof(cinfo, FALSE, TRUE) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_SOF10: { Progressive, arithmetic } - if not get_sof(cinfo, TRUE, TRUE) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - { Currently unsupported SOFn types } - M_SOF3, { Lossless, Huffman } - M_SOF5, { Differential sequential, Huffman } - M_SOF6, { Differential progressive, Huffman } - M_SOF7, { Differential lossless, Huffman } - M_JPG, { Reserved for JPEG extensions } - M_SOF11, { Lossless, arithmetic } - M_SOF13, { Differential sequential, arithmetic } - M_SOF14, { Differential progressive, arithmetic } - M_SOF15: { Differential lossless, arithmetic } - ERREXIT1(j_common_ptr(cinfo), JERR_SOF_UNSUPPORTED, cinfo^.unread_marker); - - M_SOS: - begin - if not get_sos(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - cinfo^.unread_marker := 0; { processed the marker } - read_markers := JPEG_REACHED_SOS; - exit; - end; - - M_EOI: - begin - {$IFDEF DEBUG} - TRACEMS(j_common_ptr(cinfo), 1, JTRC_EOI); - {$ENDIF} - cinfo^.unread_marker := 0; { processed the marker } - read_markers := JPEG_REACHED_EOI; - exit; - end; - - M_DAC: - if not get_dac(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_DHT: - if not get_dht(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_DQT: - if not get_dqt(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_DRI: - if not get_dri(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_APP0, - M_APP1, - M_APP2, - M_APP3, - M_APP4, - M_APP5, - M_APP6, - M_APP7, - M_APP8, - M_APP9, - M_APP10, - M_APP11, - M_APP12, - M_APP13, - M_APP14, - M_APP15: - if not my_marker_ptr(cinfo^.marker)^. - process_APPn[cinfo^.unread_marker - int(M_APP0)](cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_COM: - if not my_marker_ptr(cinfo^.marker)^.process_COM (cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - M_RST0, { these are all parameterless } - M_RST1, - M_RST2, - M_RST3, - M_RST4, - M_RST5, - M_RST6, - M_RST7, - M_TEM: - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_PARMLESS_MARKER, - cinfo^.unread_marker) - {$ENDIF} - ; - - M_DNL: { Ignore DNL ... perhaps the wrong thing } - if not skip_variable(cinfo) then - begin - read_markers := JPEG_SUSPENDED; - exit; - end; - - else { must be DHP, EXP, JPGn, or RESn } - { For now, we treat the reserved markers as fatal errors since they are - likely to be used to signal incompatible JPEG Part 3 extensions. - Once the JPEG 3 version-number marker is well defined, this code - ought to change! } - ERREXIT1(j_common_ptr(cinfo) , JERR_UNKNOWN_MARKER, - cinfo^.unread_marker); - end; { end of case } - { Successfully processed marker, so reset state variable } - cinfo^.unread_marker := 0; - Until false; -end; { read_markers } - - -{ Read a restart marker, which is expected to appear next in the datastream; - if the marker is not there, take appropriate recovery action. - Returns FALSE if suspension is required. - - This is called by the entropy decoder after it has read an appropriate - number of MCUs. cinfo^.unread_marker may be nonzero if the entropy decoder - has already read a marker from the data source. Under normal conditions - cinfo^.unread_marker will be reset to 0 before returning; if not reset, - it holds a marker which the decoder will be unable to read past. } - -{METHODDEF} -function read_restart_marker (cinfo : j_decompress_ptr) :boolean; -begin - { Obtain a marker unless we already did. } - { Note that next_marker will complain if it skips any data. } - if (cinfo^.unread_marker = 0) then - begin - if not next_marker(cinfo) then - begin - read_restart_marker := FALSE; - exit; - end; - end; - - if (cinfo^.unread_marker = (int(M_RST0) + cinfo^.marker^.next_restart_num)) then - begin - { Normal case --- swallow the marker and let entropy decoder continue } - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 3, JTRC_RST, - cinfo^.marker^.next_restart_num); - {$ENDIF} - cinfo^.unread_marker := 0; - end - else - begin - { Uh-oh, the restart markers have been messed up. } - { Let the data source manager determine how to resync. } - if not cinfo^.src^.resync_to_restart(cinfo, - cinfo^.marker^.next_restart_num) then - begin - read_restart_marker := FALSE; - exit; - end; - end; - - { Update next-restart state } - with cinfo^.marker^ do - next_restart_num := (next_restart_num + 1) and 7; - - read_restart_marker := TRUE; -end; { read_restart_marker } - - -{ This is the default resync_to_restart method for data source managers - to use if they don't have any better approach. Some data source managers - may be able to back up, or may have additional knowledge about the data - which permits a more intelligent recovery strategy; such managers would - presumably supply their own resync method. - - read_restart_marker calls resync_to_restart if it finds a marker other than - the restart marker it was expecting. (This code is *not* used unless - a nonzero restart interval has been declared.) cinfo^.unread_marker is - the marker code actually found (might be anything, except 0 or FF). - The desired restart marker number (0..7) is passed as a parameter. - This routine is supposed to apply whatever error recovery strategy seems - appropriate in order to position the input stream to the next data segment. - Note that cinfo^.unread_marker is treated as a marker appearing before - the current data-source input point; usually it should be reset to zero - before returning. - Returns FALSE if suspension is required. - - This implementation is substantially constrained by wanting to treat the - input as a data stream; this means we can't back up. Therefore, we have - only the following actions to work with: - 1. Simply discard the marker and let the entropy decoder resume at next - byte of file. - 2. Read forward until we find another marker, discarding intervening - data. (In theory we could look ahead within the current bufferload, - without having to discard data if we don't find the desired marker. - This idea is not implemented here, in part because it makes behavior - dependent on buffer size and chance buffer-boundary positions.) - 3. Leave the marker unread (by failing to zero cinfo^.unread_marker). - This will cause the entropy decoder to process an empty data segment, - inserting dummy zeroes, and then we will reprocess the marker. - - #2 is appropriate if we think the desired marker lies ahead, while #3 is - appropriate if the found marker is a future restart marker (indicating - that we have missed the desired restart marker, probably because it got - corrupted). - We apply #2 or #3 if the found marker is a restart marker no more than - two counts behind or ahead of the expected one. We also apply #2 if the - found marker is not a legal JPEG marker code (it's certainly bogus data). - If the found marker is a restart marker more than 2 counts away, we do #1 - (too much risk that the marker is erroneous; with luck we will be able to - resync at some future point). - For any valid non-restart JPEG marker, we apply #3. This keeps us from - overrunning the end of a scan. An implementation limited to single-scan - files might find it better to apply #2 for markers other than EOI, since - any other marker would have to be bogus data in that case. } - - -{GLOBAL} -function jpeg_resync_to_restart(cinfo : j_decompress_ptr; - desired : int) : boolean; -var - marker : int; - action : int; -begin - marker := cinfo^.unread_marker; - //action := 1; { never used } - { Always put up a warning. } - WARNMS2(j_common_ptr(cinfo), JWRN_MUST_RESYNC, marker, desired); - - { Outer loop handles repeated decision after scanning forward. } - repeat - if (marker < int(M_SOF0)) then - action := 2 { invalid marker } - else - if (marker < int(M_RST0)) or (marker > int(M_RST7)) then - action := 3 { valid non-restart marker } - else - begin - if (marker = (int(M_RST0) + ((desired+1) and 7))) or - (marker = (int(M_RST0) + ((desired+2) and 7))) then - action := 3 { one of the next two expected restarts } - else - if (marker = (int(M_RST0) + ((desired-1) and 7))) or - (marker = (int(M_RST0) + ((desired-2) and 7))) then - action := 2 { a prior restart, so advance } - else - action := 1; { desired restart or too far away } - end; - - {$IFDEF DEBUG} - TRACEMS2(j_common_ptr(cinfo), 4, JTRC_RECOVERY_ACTION, marker, action); - {$ENDIF} - case action of - 1: - { Discard marker and let entropy decoder resume processing. } - begin - cinfo^.unread_marker := 0; - jpeg_resync_to_restart := TRUE; - exit; - end; - 2: - { Scan to the next marker, and repeat the decision loop. } - begin - if not next_marker(cinfo) then - begin - jpeg_resync_to_restart := FALSE; - exit; - end; - marker := cinfo^.unread_marker; - end; - 3: - { Return without advancing past this marker. } - { Entropy decoder will be forced to process an empty segment. } - begin - jpeg_resync_to_restart := TRUE; - exit; - end; - end; { case } - Until false; { end loop } -end; { jpeg_resync_to_restart } - - -{ Reset marker processing state to begin a fresh datastream. } - -{METHODDEF} -procedure reset_marker_reader (cinfo : j_decompress_ptr); -var - marker : my_marker_ptr; -begin - marker := my_marker_ptr (cinfo^.marker); - with cinfo^ do - begin - comp_info := NIL; { until allocated by get_sof } - input_scan_number := 0; { no SOS seen yet } - unread_marker := 0; { no pending marker } - end; - marker^.pub.saw_SOI := FALSE; { set internal state too } - marker^.pub.saw_SOF := FALSE; - marker^.pub.discarded_bytes := 0; - marker^.cur_marker := NIL; -end; { reset_marker_reader } - - -{ Initialize the marker reader module. - This is called only once, when the decompression object is created. } - -{GLOBAL} -procedure jinit_marker_reader (cinfo : j_decompress_ptr); -var - marker : my_marker_ptr; - i : int; -begin - { Create subobject in permanent pool } - marker := my_marker_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_PERMANENT, - SIZEOF(my_marker_reader)) - ); - cinfo^.marker := jpeg_marker_reader_ptr(marker); - { Initialize method pointers } - marker^.pub.reset_marker_reader := reset_marker_reader; - marker^.pub.read_markers := read_markers; - marker^.pub.read_restart_marker := read_restart_marker; - { Initialize COM/APPn processing. - By default, we examine and then discard APP0 and APP14, - but simply discard COM and all other APPn. } - - marker^.process_COM := skip_variable; - marker^.length_limit_COM := 0; - for i := 0 to 16-1 do - begin - marker^.process_APPn[i] := skip_variable; - marker^.length_limit_APPn[i] := 0; - end; - marker^.process_APPn[0] := get_interesting_appn; - marker^.process_APPn[14] := get_interesting_appn; - { Reset marker processing state } - reset_marker_reader(cinfo); -end; { jinit_marker_reader } - - -{ Control saving of COM and APPn markers into marker_list. } - - -{$ifdef SAVE_MARKERS_SUPPORTED} - -{GLOBAL} -procedure jpeg_save_markers (cinfo : j_decompress_ptr; - marker_code : int; - length_limit : uint); -var - marker : my_marker_ptr; - maxlength : long; - processor : jpeg_marker_parser_method; -begin - marker := my_marker_ptr (cinfo^.marker); - - { Length limit mustn't be larger than what we can allocate - (should only be a concern in a 16-bit environment). } - - maxlength := cinfo^.mem^.max_alloc_chunk - SIZEOF(jpeg_marker_struct); - if (long(length_limit) > maxlength) then - length_limit := uint(maxlength); - - { Choose processor routine to use. - APP0/APP14 have special requirements. } - - if (length_limit <> 0) then - begin - processor := save_marker; - { If saving APP0/APP14, save at least enough for our internal use. } - if (marker_code = int(M_APP0)) and (length_limit < APP0_DATA_LEN) then - length_limit := APP0_DATA_LEN - else - if (marker_code = int(M_APP14)) and (length_limit < APP14_DATA_LEN) then - length_limit := APP14_DATA_LEN; - end - else - begin - processor := skip_variable; - { If discarding APP0/APP14, use our regular on-the-fly processor. } - if (marker_code = int(M_APP0)) or (marker_code = int(M_APP14)) then - processor := get_interesting_appn; - end; - - if (marker_code = int(M_COM)) then - begin - marker^.process_COM := processor; - marker^.length_limit_COM := length_limit; - end - else - if (marker_code >= int(M_APP0)) and (marker_code <= int(M_APP15)) then - begin - marker^.process_APPn[marker_code - int(M_APP0)] := processor; - marker^.length_limit_APPn[marker_code - int(M_APP0)] := length_limit; - end - else - ERREXIT1(j_common_ptr(cinfo), JERR_UNKNOWN_MARKER, marker_code); -end; - -{$endif} { SAVE_MARKERS_SUPPORTED } - -{ Install a special processing method for COM or APPn markers. } - -{GLOBAL} - -procedure jpeg_set_marker_processor (cinfo : j_decompress_ptr; - marker_code : int; - routine : jpeg_marker_parser_method); -var - marker : my_marker_ptr; -begin - marker := my_marker_ptr (cinfo^.marker); - if (marker_code = int(M_COM)) then - marker^.process_COM := routine - else - if (marker_code >= int(M_APP0)) and (marker_code <= int(M_APP15)) then - marker^.process_APPn[marker_code - int(M_APP0)] := routine - else - ERREXIT1(j_common_ptr(cinfo), JERR_UNKNOWN_MARKER, marker_code); -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdmaster.pas b/3rd/Imaging/Source/JpegLib/imjdmaster.pas deleted file mode 100644 index 076eeec70..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdmaster.pas +++ /dev/null @@ -1,679 +0,0 @@ -unit imjdmaster; - -{ This file contains master control logic for the JPEG decompressor. - These routines are concerned with selecting the modules to be executed - and with determining the number of passes and the work to be done in each - pass. } - -{ Original: jdmaster.c ; Copyright (C) 1991-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjerror, - imjdeferr, - imjdcolor, imjdsample, imjdpostct, imjddctmgr, imjdphuff, - imjdhuff, imjdcoefct, imjdmainct, -{$ifdef QUANT_1PASS_SUPPORTED} - imjquant1, -{$endif} -{$ifdef QUANT_2PASS_SUPPORTED} - imjquant2, -{$endif} -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - imjdmerge, -{$endif} - imjpeglib; - - -{ Compute output image dimensions and related values. - NOTE: this is exported for possible use by application. - Hence it mustn't do anything that can't be done twice. - Also note that it may be called before the master module is initialized! } - -{GLOBAL} -procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); -{ Do computations that are needed before master selection phase } - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{GLOBAL} -procedure jpeg_new_colormap (cinfo : j_decompress_ptr); - -{$endif} - -{ Initialize master decompression control and select active modules. - This is performed at the start of jpeg_start_decompress. } - -{GLOBAL} -procedure jinit_master_decompress (cinfo : j_decompress_ptr); - -implementation - -{ Private state } - -type - my_master_ptr = ^my_decomp_master; - my_decomp_master = record - pub : jpeg_decomp_master; { public fields } - - pass_number : int; { # of passes completed } - - using_merged_upsample : boolean; { TRUE if using merged upsample/cconvert } - - { Saved references to initialized quantizer modules, - in case we need to switch modes. } - - quantizer_1pass : jpeg_color_quantizer_ptr; - quantizer_2pass : jpeg_color_quantizer_ptr; - end; - -{ Determine whether merged upsample/color conversion should be used. - CRUCIAL: this must match the actual capabilities of jdmerge.c! } - -{LOCAL} -function use_merged_upsample (cinfo : j_decompress_ptr) : boolean; -var - compptr : jpeg_component_info_list_ptr; -begin - compptr := cinfo^.comp_info; - -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - { Merging is the equivalent of plain box-filter upsampling } - if (cinfo^.do_fancy_upsampling) or (cinfo^.CCIR601_sampling) then - begin - use_merged_upsample := FALSE; - exit; - end; - { jdmerge.c only supports YCC=>RGB color conversion } - if (cinfo^.jpeg_color_space <> JCS_YCbCr) or (cinfo^.num_components <> 3) - or (cinfo^.out_color_space <> JCS_RGB) - or (cinfo^.out_color_components <> RGB_PIXELSIZE) then - begin - use_merged_upsample := FALSE; - exit; - end; - - { and it only handles 2h1v or 2h2v sampling ratios } - if (compptr^[0].h_samp_factor <> 2) or - (compptr^[1].h_samp_factor <> 1) or - (compptr^[2].h_samp_factor <> 1) or - (compptr^[0].v_samp_factor > 2) or - (compptr^[1].v_samp_factor <> 1) or - (compptr^[2].v_samp_factor <> 1) then - begin - use_merged_upsample := FALSE; - exit; - end; - { furthermore, it doesn't work if we've scaled the IDCTs differently } - if (compptr^[0].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or - (compptr^[1].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) or - (compptr^[2].DCT_scaled_size <> cinfo^.min_DCT_scaled_size) then - begin - use_merged_upsample := FALSE; - exit; - end; - { ??? also need to test for upsample-time rescaling, when & if supported } - use_merged_upsample := TRUE; { by golly, it'll work... } -{$else} - use_merged_upsample := FALSE; -{$endif} -end; - - -{ Compute output image dimensions and related values. - NOTE: this is exported for possible use by application. - Hence it mustn't do anything that can't be done twice. - Also note that it may be called before the master module is initialized! } - -{GLOBAL} -procedure jpeg_calc_output_dimensions (cinfo : j_decompress_ptr); -{ Do computations that are needed before master selection phase } -{$ifdef IDCT_SCALING_SUPPORTED} -var - ci : int; - compptr : jpeg_component_info_ptr; -{$endif} -var - ssize : int; -begin - { Prevent application from calling me at wrong times } - if (cinfo^.global_state <> DSTATE_READY) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - -{$ifdef IDCT_SCALING_SUPPORTED} - - { Compute actual output image dimensions and DCT scaling choices. } - if (cinfo^.scale_num * 8 <= cinfo^.scale_denom) then - begin - { Provide 1/8 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_width), long(8)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_height), long(8)) ); - cinfo^.min_DCT_scaled_size := 1; - end - else - if (cinfo^.scale_num * 4 <= cinfo^.scale_denom) then - begin - { Provide 1/4 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_width), long(4)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long (cinfo^.image_height), long(4)) ); - cinfo^.min_DCT_scaled_size := 2; - end - else - if (cinfo^.scale_num * 2 <= cinfo^.scale_denom) then - begin - { Provide 1/2 scaling } - cinfo^.output_width := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_width), long(2)) ); - cinfo^.output_height := JDIMENSION ( - jdiv_round_up( long(cinfo^.image_height), long(2)) ); - cinfo^.min_DCT_scaled_size := 4; - end - else - begin - { Provide 1/1 scaling } - cinfo^.output_width := cinfo^.image_width; - cinfo^.output_height := cinfo^.image_height; - cinfo^.min_DCT_scaled_size := DCTSIZE; - end; - { In selecting the actual DCT scaling for each component, we try to - scale up the chroma components via IDCT scaling rather than upsampling. - This saves time if the upsampler gets to use 1:1 scaling. - Note this code assumes that the supported DCT scalings are powers of 2. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - ssize := cinfo^.min_DCT_scaled_size; - while (ssize < DCTSIZE) and - ((compptr^.h_samp_factor * ssize * 2 <= - cinfo^.max_h_samp_factor * cinfo^.min_DCT_scaled_size) and - (compptr^.v_samp_factor * ssize * 2 <= - cinfo^.max_v_samp_factor * cinfo^.min_DCT_scaled_size)) do - begin - ssize := ssize * 2; - end; - compptr^.DCT_scaled_size := ssize; - Inc(compptr); - end; - - { Recompute downsampled dimensions of components; - application needs to know these if using raw downsampled data. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Size in samples, after IDCT scaling } - compptr^.downsampled_width := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_width) * - long (compptr^.h_samp_factor * compptr^.DCT_scaled_size), - long (cinfo^.max_h_samp_factor * DCTSIZE)) ); - compptr^.downsampled_height := JDIMENSION ( - jdiv_round_up(long (cinfo^.image_height) * - long (compptr^.v_samp_factor * compptr^.DCT_scaled_size), - long (cinfo^.max_v_samp_factor * DCTSIZE)) ); - Inc(compptr); - end; - -{$else} { !IDCT_SCALING_SUPPORTED } - - { Hardwire it to "no scaling" } - cinfo^.output_width := cinfo^.image_width; - cinfo^.output_height := cinfo^.image_height; - { jdinput.c has already initialized DCT_scaled_size to DCTSIZE, - and has computed unscaled downsampled_width and downsampled_height. } - -{$endif} { IDCT_SCALING_SUPPORTED } - - { Report number of components in selected colorspace. } - { Probably this should be in the color conversion module... } - case (cinfo^.out_color_space) of - JCS_GRAYSCALE: - cinfo^.out_color_components := 1; -{$ifndef RGB_PIXELSIZE_IS_3} - JCS_RGB: - cinfo^.out_color_components := RGB_PIXELSIZE; -{$else} - JCS_RGB, -{$endif} { else share code with YCbCr } - JCS_YCbCr: - cinfo^.out_color_components := 3; - JCS_CMYK, - JCS_YCCK: - cinfo^.out_color_components := 4; - else { else must be same colorspace as in file } - cinfo^.out_color_components := cinfo^.num_components; - end; - if (cinfo^.quantize_colors) then - cinfo^.output_components := 1 - else - cinfo^.output_components := cinfo^.out_color_components; - - { See if upsampler will want to emit more than one row at a time } - if (use_merged_upsample(cinfo)) then - cinfo^.rec_outbuf_height := cinfo^.max_v_samp_factor - else - cinfo^.rec_outbuf_height := 1; -end; - - -{ Several decompression processes need to range-limit values to the range - 0..MAXJSAMPLE; the input value may fall somewhat outside this range - due to noise introduced by quantization, roundoff error, etc. These - processes are inner loops and need to be as fast as possible. On most - machines, particularly CPUs with pipelines or instruction prefetch, - a (subscript-check-less) C table lookup - x := sample_range_limit[x]; - is faster than explicit tests - if (x < 0) x := 0; - else if (x > MAXJSAMPLE) x := MAXJSAMPLE; - These processes all use a common table prepared by the routine below. - - For most steps we can mathematically guarantee that the initial value - of x is within MAXJSAMPLE+1 of the legal range, so a table running from - -(MAXJSAMPLE+1) to 2*MAXJSAMPLE+1 is sufficient. But for the initial - limiting step (just after the IDCT), a wildly out-of-range value is - possible if the input data is corrupt. To avoid any chance of indexing - off the end of memory and getting a bad-pointer trap, we perform the - post-IDCT limiting thus: - x := range_limit[x & MASK]; - where MASK is 2 bits wider than legal sample data, ie 10 bits for 8-bit - samples. Under normal circumstances this is more than enough range and - a correct output will be generated; with bogus input data the mask will - cause wraparound, and we will safely generate a bogus-but-in-range output. - For the post-IDCT step, we want to convert the data from signed to unsigned - representation by adding CENTERJSAMPLE at the same time that we limit it. - So the post-IDCT limiting table ends up looking like this: - CENTERJSAMPLE,CENTERJSAMPLE+1,...,MAXJSAMPLE, - MAXJSAMPLE (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), - 0 (repeat 2*(MAXJSAMPLE+1)-CENTERJSAMPLE times), - 0,1,...,CENTERJSAMPLE-1 - Negative inputs select values from the upper half of the table after - masking. - - We can save some space by overlapping the start of the post-IDCT table - with the simpler range limiting table. The post-IDCT table begins at - sample_range_limit + CENTERJSAMPLE. - - Note that the table is allocated in near data space on PCs; it's small - enough and used often enough to justify this. } - -{LOCAL} -procedure prepare_range_limit_table (cinfo : j_decompress_ptr); -{ Allocate and fill in the sample_range_limit table } -var - table : range_limit_table_ptr; - idct_table : JSAMPROW; - i : int; -begin - table := range_limit_table_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - (5 * (MAXJSAMPLE+1) + CENTERJSAMPLE) * SIZEOF(JSAMPLE)) ); - - { First segment of "simple" table: limit[x] := 0 for x < 0 } - MEMZERO(table, (MAXJSAMPLE+1) * SIZEOF(JSAMPLE)); - - cinfo^.sample_range_limit := (table); - { allow negative subscripts of simple table } - { is noop, handled via type definition (Nomssi) } - { Main part of "simple" table: limit[x] := x } - for i := 0 to MAXJSAMPLE do - table^[i] := JSAMPLE (i); - idct_table := JSAMPROW(@ table^[CENTERJSAMPLE]); - { Point to where post-IDCT table starts } - { End of simple table, rest of first half of post-IDCT table } - for i := CENTERJSAMPLE to pred(2*(MAXJSAMPLE+1)) do - idct_table^[i] := MAXJSAMPLE; - { Second half of post-IDCT table } - MEMZERO(@(idct_table^[2 * (MAXJSAMPLE+1)]), - (2 * (MAXJSAMPLE+1) - CENTERJSAMPLE) * SIZEOF(JSAMPLE)); - MEMCOPY(@(idct_table^[(4 * (MAXJSAMPLE+1) - CENTERJSAMPLE)]), - @cinfo^.sample_range_limit^[0], CENTERJSAMPLE * SIZEOF(JSAMPLE)); - -end; - - -{ Master selection of decompression modules. - This is done once at jpeg_start_decompress time. We determine - which modules will be used and give them appropriate initialization calls. - We also initialize the decompressor input side to begin consuming data. - - Since jpeg_read_header has finished, we know what is in the SOF - and (first) SOS markers. We also have all the application parameter - settings. } - -{LOCAL} -procedure master_selection (cinfo : j_decompress_ptr); -var - master : my_master_ptr; - use_c_buffer : boolean; - samplesperrow : long; - jd_samplesperrow : JDIMENSION; -var - nscans : int; -begin - master := my_master_ptr (cinfo^.master); - - { Initialize dimensions and other stuff } - jpeg_calc_output_dimensions(cinfo); - prepare_range_limit_table(cinfo); - - { Width of an output scanline must be representable as JDIMENSION. } - samplesperrow := long(cinfo^.output_width) * long (cinfo^.out_color_components); - jd_samplesperrow := JDIMENSION (samplesperrow); - if (long(jd_samplesperrow) <> samplesperrow) then - ERREXIT(j_common_ptr(cinfo), JERR_WIDTH_OVERFLOW); - - { Initialize my private state } - master^.pass_number := 0; - master^.using_merged_upsample := use_merged_upsample(cinfo); - - { Color quantizer selection } - master^.quantizer_1pass := NIL; - master^.quantizer_2pass := NIL; - { No mode changes if not using buffered-image mode. } - if (not cinfo^.quantize_colors) or (not cinfo^.buffered_image) then - begin - cinfo^.enable_1pass_quant := FALSE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; - end; - if (cinfo^.quantize_colors) then - begin - if (cinfo^.raw_data_out) then - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - { 2-pass quantizer only works in 3-component color space. } - if (cinfo^.out_color_components <> 3) then - begin - cinfo^.enable_1pass_quant := TRUE; - cinfo^.enable_external_quant := FALSE; - cinfo^.enable_2pass_quant := FALSE; - cinfo^.colormap := NIL; - end - else - if (cinfo^.colormap <> NIL) then - begin - cinfo^.enable_external_quant := TRUE; - end - else - if (cinfo^.two_pass_quantize) then - begin - cinfo^.enable_2pass_quant := TRUE; - end - else - begin - cinfo^.enable_1pass_quant := TRUE; - end; - - if (cinfo^.enable_1pass_quant) then - begin -{$ifdef QUANT_1PASS_SUPPORTED} - jinit_1pass_quantizer(cinfo); - master^.quantizer_1pass := cinfo^.cquantize; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end; - - { We use the 2-pass code to map to external colormaps. } - if (cinfo^.enable_2pass_quant) or (cinfo^.enable_external_quant) then - begin -{$ifdef QUANT_2PASS_SUPPORTED} - jinit_2pass_quantizer(cinfo); - master^.quantizer_2pass := cinfo^.cquantize; -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end; - { If both quantizers are initialized, the 2-pass one is left active; - this is necessary for starting with quantization to an external map. } - end; - - { Post-processing: in particular, color conversion first } - if (not cinfo^.raw_data_out) then - begin - if (master^.using_merged_upsample) then - begin -{$ifdef UPSAMPLE_MERGING_SUPPORTED} - jinit_merged_upsampler(cinfo); { does color conversion too } -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - begin - jinit_color_deconverter(cinfo); - jinit_upsampler(cinfo); - end; - jinit_d_post_controller(cinfo, cinfo^.enable_2pass_quant); - end; - { Inverse DCT } - jinit_inverse_dct(cinfo); - { Entropy decoding: either Huffman or arithmetic coding. } - if (cinfo^.arith_code) then - begin - ERREXIT(j_common_ptr(cinfo), JERR_ARITH_NOTIMPL); - end - else - begin - if (cinfo^.progressive_mode) then - begin -{$ifdef D_PROGRESSIVE_SUPPORTED} - jinit_phuff_decoder(cinfo); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} - end - else - jinit_huff_decoder(cinfo); - end; - - { Initialize principal buffer controllers. } - use_c_buffer := cinfo^.inputctl^.has_multiple_scans or cinfo^.buffered_image; - jinit_d_coef_controller(cinfo, use_c_buffer); - - if (not cinfo^.raw_data_out) then - jinit_d_main_controller(cinfo, FALSE { never need full buffer here }); - - { We can now tell the memory manager to allocate virtual arrays. } - cinfo^.mem^.realize_virt_arrays (j_common_ptr(cinfo)); - - { Initialize input side of decompressor to consume first scan. } - cinfo^.inputctl^.start_input_pass (cinfo); - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - { If jpeg_start_decompress will read the whole file, initialize - progress monitoring appropriately. The input step is counted - as one pass. } - - if (cinfo^.progress <> NIL) and (not cinfo^.buffered_image) and - (cinfo^.inputctl^.has_multiple_scans) then - begin - - { Estimate number of scans to set pass_limit. } - if (cinfo^.progressive_mode) then - begin - { Arbitrarily estimate 2 interleaved DC scans + 3 AC scans/component. } - nscans := 2 + 3 * cinfo^.num_components; - end - else - begin - { For a nonprogressive multiscan file, estimate 1 scan per component. } - nscans := cinfo^.num_components; - end; - cinfo^.progress^.pass_counter := Long(0); - cinfo^.progress^.pass_limit := long (cinfo^.total_iMCU_rows) * nscans; - cinfo^.progress^.completed_passes := 0; - if cinfo^.enable_2pass_quant then - cinfo^.progress^.total_passes := 3 - else - cinfo^.progress^.total_passes := 2; - { Count the input pass as done } - Inc(master^.pass_number); - end; -{$endif} { D_MULTISCAN_FILES_SUPPORTED } -end; - - -{ Per-pass setup. - This is called at the beginning of each output pass. We determine which - modules will be active during this pass and give them appropriate - start_pass calls. We also set is_dummy_pass to indicate whether this - is a "real" output pass or a dummy pass for color quantization. - (In the latter case, jdapistd.c will crank the pass to completion.) } - -{METHODDEF} -procedure prepare_for_output_pass (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - if (master^.pub.is_dummy_pass) then - begin -{$ifdef QUANT_2PASS_SUPPORTED} - { Final pass of 2-pass quantization } - master^.pub.is_dummy_pass := FALSE; - cinfo^.cquantize^.start_pass (cinfo, FALSE); - cinfo^.post^.start_pass (cinfo, JBUF_CRANK_DEST); - cinfo^.main^.start_pass (cinfo, JBUF_CRANK_DEST); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); -{$endif} { QUANT_2PASS_SUPPORTED } - end - else - begin - if (cinfo^.quantize_colors) and (cinfo^.colormap = NIL) then - begin - { Select new quantization method } - if (cinfo^.two_pass_quantize) and (cinfo^.enable_2pass_quant) then - begin - cinfo^.cquantize := master^.quantizer_2pass; - master^.pub.is_dummy_pass := TRUE; - end - else - if (cinfo^.enable_1pass_quant) then - begin - cinfo^.cquantize := master^.quantizer_1pass; - end - else - begin - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); - end; - end; - cinfo^.idct^.start_pass (cinfo); - cinfo^.coef^.start_output_pass (cinfo); - if (not cinfo^.raw_data_out) then - begin - if (not master^.using_merged_upsample) then - cinfo^.cconvert^.start_pass (cinfo); - cinfo^.upsample^.start_pass (cinfo); - if (cinfo^.quantize_colors) then - cinfo^.cquantize^.start_pass (cinfo, master^.pub.is_dummy_pass); - if master^.pub.is_dummy_pass then - cinfo^.post^.start_pass (cinfo, JBUF_SAVE_AND_PASS) - else - cinfo^.post^.start_pass (cinfo, JBUF_PASS_THRU); - cinfo^.main^.start_pass (cinfo, JBUF_PASS_THRU); - end; - end; - - { Set up progress monitor's pass info if present } - if (cinfo^.progress <> NIL) then - begin - cinfo^.progress^.completed_passes := master^.pass_number; - if master^.pub.is_dummy_pass then - cinfo^.progress^.total_passes := master^.pass_number + 2 - else - cinfo^.progress^.total_passes := master^.pass_number + 1; - { In buffered-image mode, we assume one more output pass if EOI not - yet reached, but no more passes if EOI has been reached. } - - if (cinfo^.buffered_image) and (not cinfo^.inputctl^.eoi_reached) then - begin - if cinfo^.enable_2pass_quant then - Inc(cinfo^.progress^.total_passes, 2) - else - Inc(cinfo^.progress^.total_passes, 1); - end; - end; -end; - - -{ Finish up at end of an output pass. } - -{METHODDEF} -procedure finish_output_pass (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - if (cinfo^.quantize_colors) then - cinfo^.cquantize^.finish_pass (cinfo); - Inc(master^.pass_number); -end; - - -{$ifdef D_MULTISCAN_FILES_SUPPORTED} - -{ Switch to a new external colormap between output passes. } - -{GLOBAL} -procedure jpeg_new_colormap (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr (cinfo^.master); - - { Prevent application from calling me at wrong times } - if (cinfo^.global_state <> DSTATE_BUFIMAGE) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_STATE, cinfo^.global_state); - - if (cinfo^.quantize_colors) and (cinfo^.enable_external_quant) and - (cinfo^.colormap <> NIL) then - begin - { Select 2-pass quantizer for external colormap use } - cinfo^.cquantize := master^.quantizer_2pass; - { Notify quantizer of colormap change } - cinfo^.cquantize^.new_color_map (cinfo); - master^.pub.is_dummy_pass := FALSE; { just in case } - end - else - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); -end; - -{$endif} { D_MULTISCAN_FILES_SUPPORTED } - - -{ Initialize master decompression control and select active modules. - This is performed at the start of jpeg_start_decompress. } - -{GLOBAL} -procedure jinit_master_decompress (cinfo : j_decompress_ptr); -var - master : my_master_ptr; -begin - master := my_master_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_decomp_master)) ); - cinfo^.master := jpeg_decomp_master_ptr(master); - master^.pub.prepare_for_output_pass := prepare_for_output_pass; - master^.pub.finish_output_pass := finish_output_pass; - - master^.pub.is_dummy_pass := FALSE; - - master_selection(cinfo); -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdmerge.pas b/3rd/Imaging/Source/JpegLib/imjdmerge.pas deleted file mode 100644 index 3e9c7fbeb..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdmerge.pas +++ /dev/null @@ -1,514 +0,0 @@ -unit imjdmerge; - -{ This file contains code for merged upsampling/color conversion. - - This file combines functions from jdsample.c and jdcolor.c; - read those files first to understand what's going on. - - When the chroma components are to be upsampled by simple replication - (ie, box filtering), we can save some work in color conversion by - calculating all the output pixels corresponding to a pair of chroma - samples at one time. In the conversion equations - R := Y + K1 * Cr - G := Y + K2 * Cb + K3 * Cr - B := Y + K4 * Cb - only the Y term varies among the group of pixels corresponding to a pair - of chroma samples, so the rest of the terms can be calculated just once. - At typical sampling ratios, this eliminates half or three-quarters of the - multiplications needed for color conversion. - - This file currently provides implementations for the following cases: - YCbCr => RGB color conversion only. - Sampling ratios of 2h1v or 2h2v. - No scaling needed at upsample time. - Corner-aligned (non-CCIR601) sampling alignment. - Other special cases could be added, but in most applications these are - the only common cases. (For uncommon cases we fall back on the more - general code in jdsample.c and jdcolor.c.) } - -{ Original: jdmerge.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjutils; - -{ Module initialization routine for merged upsampling/color conversion. - - NB: this is called under the conditions determined by use_merged_upsample() - in jdmaster.c. That routine MUST correspond to the actual capabilities - of this module; no safety checks are made here. } - -{GLOBAL} -procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); - -implementation - - -{ Private subobject } - -type { the same definition as in JdColor } - int_Color_Table = array[0..MAXJSAMPLE+1-1] of int; - int_CConvertPtr = ^int_Color_Table; - INT32_Color_Table = array[0..MAXJSAMPLE+1-1] of INT32; - INT32_CConvertPtr = ^INT32_Color_Table; - -type - my_upsample_ptr = ^my_upsampler; - my_upsampler = record - pub : jpeg_upsampler; { public fields } - - { Pointer to routine to do actual upsampling/conversion of one row group } - upmethod : procedure (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); - - { Private state for YCC->RGB conversion } - Cr_r_tab : int_CConvertPtr; { => table for Cr to R conversion } - Cb_b_tab : int_CConvertPtr; { => table for Cb to B conversion } - Cr_g_tab : INT32_CConvertPtr; { => table for Cr to G conversion } - Cb_g_tab : INT32_CConvertPtr; { => table for Cb to G conversion } - - { For 2:1 vertical sampling, we produce two output rows at a time. - We need a "spare" row buffer to hold the second output row if the - application provides just a one-row buffer; we also use the spare - to discard the dummy last row if the image height is odd. } - - spare_row : JSAMPROW; - spare_full : boolean; { TRUE if spare buffer is occupied } - - out_row_width : JDIMENSION; { samples per output row } - rows_to_go : JDIMENSION; { counts rows remaining in image } - end; {my_upsampler;} - - -const - SCALEBITS = 16; { speediest right-shift on some machines } - ONE_HALF = (INT32(1) shl (SCALEBITS-1)); - - -{ Initialize tables for YCC->RGB colorspace conversion. - This is taken directly from jdcolor.c; see that file for more info. } - -{LOCAL} -procedure build_ycc_rgb_table (cinfo : j_decompress_ptr); -const - FIX_1_40200 = INT32( Round(1.40200 * (INT32(1) shl SCALEBITS)) ); - FIX_1_77200 = INT32( Round(1.77200 * (INT32(1) shl SCALEBITS)) ); - FIX_0_71414 = INT32( Round(0.71414 * (INT32(1) shl SCALEBITS)) ); - FIX_0_34414 = INT32( Round(0.34414 * (INT32(1) shl SCALEBITS)) ); -var - upsample : my_upsample_ptr; - i : int; - x : INT32; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - upsample^.Cr_r_tab := int_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - upsample^.Cb_b_tab := int_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(int)) ); - upsample^.Cr_g_tab := INT32_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - upsample^.Cb_g_tab := INT32_CConvertPtr ( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - (MAXJSAMPLE+1) * SIZEOF(INT32)) ); - - x := -CENTERJSAMPLE; - for i := 0 to pred(MAXJSAMPLE) do - begin - { i is the actual input pixel value, in the range 0..MAXJSAMPLE } - { The Cb or Cr value we are thinking of is x := i - CENTERJSAMPLE } - { Cr=>R value is nearest int to 1.40200 * x } - {upsample^.Cr_r_tab^[i] := int( - RIGHT_SHIFT(FIX_1_40200 * x + ONE_HALF, SCALEBITS) );} - shift_temp := FIX_1_40200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - upsample^.Cr_r_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - upsample^.Cr_r_tab^[i] := int(shift_temp shr SCALEBITS); - - - { Cb=>B value is nearest int to 1.77200 * x } - {upsample^.Cb_b_tab^[i] := int( - RIGHT_SHIFT(FIX_1_77200 * x + ONE_HALF, SCALEBITS) );} - shift_temp := FIX_1_77200 * x + ONE_HALF; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - upsample^.Cb_b_tab^[i] := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - upsample^.Cb_b_tab^[i] := int(shift_temp shr SCALEBITS); - - { Cr=>G value is scaled-up -0.71414 * x } - upsample^.Cr_g_tab^[i] := (- FIX_0_71414) * x; - { Cb=>G value is scaled-up -0.34414 * x } - { We also add in ONE_HALF so that need not do it in inner loop } - upsample^.Cb_g_tab^[i] := (- FIX_0_34414) * x + ONE_HALF; - Inc(x); - end; -end; - - -{ Initialize for an upsampling pass. } - -{METHODDEF} -procedure start_pass_merged_upsample (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Mark the spare buffer empty } - upsample^.spare_full := FALSE; - { Initialize total-height counter for detecting bottom of image } - upsample^.rows_to_go := cinfo^.output_height; -end; - - -{ Control routine to do upsampling (and color conversion). - - The control routine just handles the row buffering considerations. } - -{METHODDEF} -procedure merged_2v_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -{ 2:1 vertical sampling case: may need a spare row. } -var - upsample : my_upsample_ptr; - work_ptrs : array[0..2-1] of JSAMPROW; - num_rows : JDIMENSION; { number of rows returned to caller } -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - if (upsample^.spare_full) then - begin - { If we have a spare row saved from a previous cycle, just return it. } - jcopy_sample_rows(JSAMPARRAY(@upsample^.spare_row), - 0, - JSAMPARRAY(@ output_buf^[out_row_ctr]), - 0, 1, upsample^.out_row_width); - num_rows := 1; - upsample^.spare_full := FALSE; - end - else - begin - { Figure number of rows to return to caller. } - num_rows := 2; - { Not more than the distance to the end of the image. } - if (num_rows > upsample^.rows_to_go) then - num_rows := upsample^.rows_to_go; - { And not more than what the client can accept: } - Dec(out_rows_avail, {var} out_row_ctr); - if (num_rows > out_rows_avail) then - num_rows := out_rows_avail; - { Create output pointer array for upsampler. } - work_ptrs[0] := output_buf^[out_row_ctr]; - if (num_rows > 1) then - begin - work_ptrs[1] := output_buf^[out_row_ctr + 1]; - end - else - begin - work_ptrs[1] := upsample^.spare_row; - upsample^.spare_full := TRUE; - end; - { Now do the upsampling. } - upsample^.upmethod (cinfo, input_buf, {var}in_row_group_ctr, - JSAMPARRAY(@work_ptrs)); - end; - - { Adjust counts } - Inc(out_row_ctr, num_rows); - Dec(upsample^.rows_to_go, num_rows); - { When the buffer is emptied, declare this input row group consumed } - if (not upsample^.spare_full) then - Inc(in_row_group_ctr); -end; - - -{METHODDEF} -procedure merged_1v_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -{ 1:1 vertical sampling case: much easier, never need a spare row. } -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Just do the upsampling. } - upsample^.upmethod (cinfo, input_buf, in_row_group_ctr, - JSAMPARRAY(@ output_buf^[out_row_ctr])); - { Adjust counts } - Inc(out_row_ctr); - Inc(in_row_group_ctr); -end; - - -{ These are the routines invoked by the control routines to do - the actual upsampling/conversion. One row group is processed per call. - - Note: since we may be writing directly into application-supplied buffers, - we have to be honest about the output width; we can't assume the buffer - has been rounded up to an even width. } - - -{ Upsample and color convert for the case of 2:1 horizontal and 1:1 vertical. } - -{METHODDEF} -procedure h2v1_merged_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); -var - upsample : my_upsample_ptr; - {register} y, cred, cgreen, cblue : int; - cb, cr : int; - {register} outptr : JSAMPROW; - inptr0, inptr1, inptr2 : JSAMPLE_PTR; - col : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - Crrtab : int_CConvertPtr; - Cbbtab : int_CConvertPtr; - Crgtab : INT32_CConvertPtr; - Cbgtab : INT32_CConvertPtr; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - range_limit := cinfo^.sample_range_limit; - Crrtab := upsample^.Cr_r_tab; - Cbbtab := upsample^.Cb_b_tab; - Crgtab := upsample^.Cr_g_tab; - Cbgtab := upsample^.Cb_g_tab; - - inptr0 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr]); - inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); - inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); - outptr := output_buf^[0]; - { Loop for each pair of output pixels } - for col := pred(cinfo^.output_width shr 1) downto 0 do - begin - { Do the chroma part of the calculation } - cb := GETJSAMPLE(inptr1^); - Inc(inptr1); - cr := GETJSAMPLE(inptr2^); - Inc(inptr2); - cred := Crrtab^[cr]; - {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - { Fetch 2 Y values and emit 2 pixels } - y := GETJSAMPLE(inptr0^); - Inc(inptr0); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr0^); - Inc(inptr0); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr), RGB_PIXELSIZE); - end; - { If image width is odd, do the last output column separately } - if Odd(cinfo^.output_width) then - begin - cb := GETJSAMPLE(inptr1^); - cr := GETJSAMPLE(inptr2^); - cred := Crrtab^[cr]; - {cgreen := int ( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - y := GETJSAMPLE(inptr0^); - outptr^[RGB_RED] := range_limit^[y + cred]; - outptr^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr^[RGB_BLUE] := range_limit^[y + cblue]; - end; -end; - - -{ Upsample and color convert for the case of 2:1 horizontal and 2:1 vertical. } - -{METHODDEF} -procedure h2v2_merged_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - in_row_group_ctr : JDIMENSION; - output_buf : JSAMPARRAY); -var - upsample : my_upsample_ptr; - {register} y, cred, cgreen, cblue : int; - cb, cr : int; - {register} outptr0, outptr1 : JSAMPROW; - inptr00, inptr01, inptr1, inptr2 : JSAMPLE_PTR; - col : JDIMENSION; - { copy these pointers into registers if possible } - {register} range_limit : range_limit_table_ptr; - Crrtab : int_CConvertPtr; - Cbbtab : int_CConvertPtr; - Crgtab : INT32_CConvertPtr; - Cbgtab : INT32_CConvertPtr; -var - shift_temp : INT32; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - range_limit := cinfo^.sample_range_limit; - Crrtab := upsample^.Cr_r_tab; - Cbbtab := upsample^.Cb_b_tab; - Crgtab := upsample^.Cr_g_tab; - Cbgtab := upsample^.Cb_g_tab; - - inptr00 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2]); - inptr01 := JSAMPLE_PTR(input_buf^[0]^[in_row_group_ctr*2 + 1]); - inptr1 := JSAMPLE_PTR(input_buf^[1]^[in_row_group_ctr]); - inptr2 := JSAMPLE_PTR(input_buf^[2]^[in_row_group_ctr]); - outptr0 := output_buf^[0]; - outptr1 := output_buf^[1]; - { Loop for each group of output pixels } - for col := pred(cinfo^.output_width shr 1) downto 0 do - begin - { Do the chroma part of the calculation } - cb := GETJSAMPLE(inptr1^); - Inc(inptr1); - cr := GETJSAMPLE(inptr2^); - Inc(inptr2); - cred := Crrtab^[cr]; - {cgreen := int( RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS) );} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - { Fetch 4 Y values and emit 4 pixels } - y := GETJSAMPLE(inptr00^); - Inc(inptr00); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr00^); - Inc(inptr00); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr0), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr01^); - Inc(inptr01); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); - y := GETJSAMPLE(inptr01^); - Inc(inptr01); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - Inc(JSAMPLE_PTR(outptr1), RGB_PIXELSIZE); - end; - { If image width is odd, do the last output column separately } - if Odd(cinfo^.output_width) then - begin - cb := GETJSAMPLE(inptr1^); - cr := GETJSAMPLE(inptr2^); - cred := Crrtab^[cr]; - {cgreen := int (RIGHT_SHIFT(Cbgtab[cb] + Crgtab[cr], SCALEBITS));} - shift_temp := Cbgtab^[cb] + Crgtab^[cr]; - if shift_temp < 0 then { SHIFT arithmetic RIGHT } - cgreen := int((shift_temp shr SCALEBITS) - or ( (not INT32(0)) shl (32-SCALEBITS))) - else - cgreen := int(shift_temp shr SCALEBITS); - - cblue := Cbbtab^[cb]; - y := GETJSAMPLE(inptr00^); - outptr0^[RGB_RED] := range_limit^[y + cred]; - outptr0^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr0^[RGB_BLUE] := range_limit^[y + cblue]; - y := GETJSAMPLE(inptr01^); - outptr1^[RGB_RED] := range_limit^[y + cred]; - outptr1^[RGB_GREEN] := range_limit^[y + cgreen]; - outptr1^[RGB_BLUE] := range_limit^[y + cblue]; - end; -end; - - -{ Module initialization routine for merged upsampling/color conversion. - - NB: this is called under the conditions determined by use_merged_upsample() - in jdmaster.c. That routine MUST correspond to the actual capabilities - of this module; no safety checks are made here. } - - -{GLOBAL} -procedure jinit_merged_upsampler (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_upsampler)) ); - cinfo^.upsample := jpeg_upsampler_ptr (upsample); - upsample^.pub.start_pass := start_pass_merged_upsample; - upsample^.pub.need_context_rows := FALSE; - - upsample^.out_row_width := cinfo^.output_width * JDIMENSION(cinfo^.out_color_components); - - if (cinfo^.max_v_samp_factor = 2) then - begin - upsample^.pub.upsample := merged_2v_upsample; - upsample^.upmethod := h2v2_merged_upsample; - { Allocate a spare row buffer } - upsample^.spare_row := JSAMPROW( - cinfo^.mem^.alloc_large ( j_common_ptr(cinfo), JPOOL_IMAGE, - size_t (upsample^.out_row_width * SIZEOF(JSAMPLE))) ); - end - else - begin - upsample^.pub.upsample := merged_1v_upsample; - upsample^.upmethod := h2v1_merged_upsample; - { No spare row needed } - upsample^.spare_row := NIL; - end; - - build_ycc_rgb_table(cinfo); -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdphuff.pas b/3rd/Imaging/Source/JpegLib/imjdphuff.pas deleted file mode 100644 index 4fa4d76ac..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdphuff.pas +++ /dev/null @@ -1,1065 +0,0 @@ -unit imjdphuff; - -{ This file contains Huffman entropy decoding routines for progressive JPEG. - - Much of the complexity here has to do with supporting input suspension. - If the data source module demands suspension, we want to be able to back - up to the start of the current MCU. To do this, we copy state variables - into local working storage, and update them back to the permanent - storage only upon successful completion of an MCU. } - -{ Original: jdphuff.c ; Copyright (C) 1995-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdeferr, - imjerror, - imjutils, - imjdhuff; { Declarations shared with jdhuff.c } - - -{GLOBAL} -procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); - -implementation - -{ Expanded entropy decoder object for progressive Huffman decoding. - - The savable_state subrecord contains fields that change within an MCU, - but must not be updated permanently until we complete the MCU. } - -type - savable_state = record - EOBRUN : uInt; { remaining EOBs in EOBRUN } - last_dc_val : array[00..MAX_COMPS_IN_SCAN-1] of int; - { last DC coef for each component } - end; - - -type - phuff_entropy_ptr = ^phuff_entropy_decoder; - phuff_entropy_decoder = record - pub : jpeg_entropy_decoder; { public fields } - - { These fields are loaded into local variables at start of each MCU. - In case of suspension, we exit WITHOUT updating them. } - - bitstate : bitread_perm_state; { Bit buffer at start of MCU } - saved : savable_state; { Other state at start of MCU } - - { These fields are NOT loaded into local working state. } - restarts_to_go : uInt; { MCUs left in this restart interval } - - { Pointers to derived tables (these workspaces have image lifespan) } - derived_tbls : array[0..NUM_HUFF_TBLS-1] of d_derived_tbl_ptr; - - ac_derived_tbl : d_derived_tbl_ptr; { active table during an AC scan } - end; - - - -{ Forward declarations } -{METHODDEF} -function decode_mcu_DC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_AC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_DC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; -{METHODDEF} -function decode_mcu_AC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - forward; - -{ Initialize for a Huffman-compressed scan. } - -{METHODDEF} -procedure start_pass_phuff_decoder (cinfo : j_decompress_ptr); -var - entropy : phuff_entropy_ptr; - is_DC_band, bad : boolean; - ci, coefi, tbl : int; - coef_bit_ptr : coef_bits_ptr; - compptr : jpeg_component_info_ptr; -var - cindex : int; - expected : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - is_DC_band := (cinfo^.Ss = 0); - - { Validate scan parameters } - bad := FALSE; - if (is_DC_band) then - begin - if (cinfo^.Se <> 0) then - bad := TRUE; - end - else - begin - { need not check Ss/Se < 0 since they came from unsigned bytes } - if (cinfo^.Ss > cinfo^.Se) or (cinfo^.Se >= DCTSIZE2) then - bad := TRUE; - { AC scans may have only one component } - if (cinfo^.comps_in_scan <> 1) then - bad := TRUE; - end; - if (cinfo^.Ah <> 0) then - begin - { Successive approximation refinement scan: must have Al = Ah-1. } - if (cinfo^.Al <> cinfo^.Ah-1) then - bad := TRUE; - end; - if (cinfo^.Al > 13) then { need not check for < 0 } - bad := TRUE; - { Arguably the maximum Al value should be less than 13 for 8-bit precision, - but the spec doesn't say so, and we try to be liberal about what we - accept. Note: large Al values could result in out-of-range DC - coefficients during early scans, leading to bizarre displays due to - overflows in the IDCT math. But we won't crash. } - - if (bad) then - ERREXIT4(j_common_ptr(cinfo), JERR_BAD_PROGRESSION, - cinfo^.Ss, cinfo^.Se, cinfo^.Ah, cinfo^.Al); - { Update progression status, and verify that scan order is legal. - Note that inter-scan inconsistencies are treated as warnings - not fatal errors ... not clear if this is right way to behave. } - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - cindex := cinfo^.cur_comp_info[ci]^.component_index; - coef_bit_ptr := coef_bits_ptr(@(cinfo^.coef_bits^[cindex])); {^[0] ??? - Nomssi } - if (not is_DC_band) and (coef_bit_ptr^[0] < 0) then - { AC without prior DC scan } - WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, 0); - for coefi := cinfo^.Ss to cinfo^.Se do - begin - if (coef_bit_ptr^[coefi] < 0) then - expected := 0 - else - expected := coef_bit_ptr^[coefi]; - if (cinfo^.Ah <> expected) then - WARNMS2(j_common_ptr(cinfo), JWRN_BOGUS_PROGRESSION, cindex, coefi); - coef_bit_ptr^[coefi] := cinfo^.Al; - end; - end; - - { Select MCU decoding routine } - if (cinfo^.Ah = 0) then - begin - if (is_DC_band) then - entropy^.pub.decode_mcu := decode_mcu_DC_first - else - entropy^.pub.decode_mcu := decode_mcu_AC_first; - end - else - begin - if (is_DC_band) then - entropy^.pub.decode_mcu := decode_mcu_DC_refine - else - entropy^.pub.decode_mcu := decode_mcu_AC_refine; - end; - - for ci := 0 to pred(cinfo^.comps_in_scan) do - begin - compptr := cinfo^.cur_comp_info[ci]; - { Make sure requested tables are present, and compute derived tables. - We may build same derived table more than once, but it's not expensive. } - - if (is_DC_band) then - begin - if (cinfo^.Ah = 0) then - begin { DC refinement needs no table } - tbl := compptr^.dc_tbl_no; - jpeg_make_d_derived_tbl(cinfo, TRUE, tbl, - entropy^.derived_tbls[tbl]); - end; - end - else - begin - tbl := compptr^.ac_tbl_no; - jpeg_make_d_derived_tbl(cinfo, FALSE, tbl, - entropy^.derived_tbls[tbl]); - { remember the single active table } - entropy^.ac_derived_tbl := entropy^.derived_tbls[tbl]; - end; - { Initialize DC predictions to 0 } - entropy^.saved.last_dc_val[ci] := 0; - end; - - { Initialize bitread state variables } - entropy^.bitstate.bits_left := 0; - entropy^.bitstate.get_buffer := 0; { unnecessary, but keeps Purify quiet } - entropy^.pub.insufficient_data := FALSE; - - { Initialize private state variables } - entropy^.saved.EOBRUN := 0; - - { Initialize restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; -end; - - -{ Figure F.12: extend sign bit. - On some machines, a shift and add will be faster than a table lookup. } - -{$ifdef AVOID_TABLES} - -#define HUFF_EXTEND(x,s) - ((x) < (1shl((s)-1)) ? (x) + (((-1)shl(s)) + 1) : (x)) - -{$else} - -{ #define HUFF_EXTEND(x,s) - if (x) < extend_test[s] then - (x) + extend_offset[s] - else - (x)} - -const - extend_test : Array[0..16-1] of int = { entry n is 2**(n-1) } - ($0000, $0001, $0002, $0004, $0008, $0010, $0020, $0040, - $0080, $0100, $0200, $0400, $0800, $1000, $2000, $4000); - -const - extend_offset : array[0..16-1] of int = { entry n is (-1 shl n) + 1 } - ( 0, ((-1) shl 1) + 1, ((-1) shl 2) + 1, ((-1) shl 3) + 1, ((-1) shl 4) + 1, - ((-1) shl 5) + 1, ((-1) shl 6) + 1, ((-1) shl 7) + 1, ((-1) shl 8) + 1, - ((-1) shl 9) + 1, ((-1) shl 10) + 1, ((-1) shl 11) + 1, ((-1) shl 12) + 1, - ((-1) shl 13) + 1, ((-1) shl 14) + 1, ((-1) shl 15) + 1 ); - -{$endif} { AVOID_TABLES } - - -{ Check for a restart marker & resynchronize decoder. - return:=s FALSE if must suspend. } - -{LOCAL} -function process_restart (cinfo : j_decompress_ptr) : boolean; -var - entropy : phuff_entropy_ptr; - ci : int; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - - { Throw away any unused bits remaining in bit buffer; } - { include any full bytes in next_marker's count of discarded bytes } - Inc(cinfo^.marker^.discarded_bytes, entropy^.bitstate.bits_left div 8); - entropy^.bitstate.bits_left := 0; - - { Advance past the RSTn marker } - if (not cinfo^.marker^.read_restart_marker (cinfo)) then - begin - process_restart := FALSE; - exit; - end; - - { Re-initialize DC predictions to 0 } - for ci := 0 to pred(cinfo^.comps_in_scan) do - entropy^.saved.last_dc_val[ci] := 0; - { Re-init EOB run count, too } - entropy^.saved.EOBRUN := 0; - - { Reset restart counter } - entropy^.restarts_to_go := cinfo^.restart_interval; - - { Reset out-of-data flag, unless read_restart_marker left us smack up - against a marker. In that case we will end up treating the next data - segment as empty, and we can avoid producing bogus output pixels by - leaving the flag set. } - if (cinfo^.unread_marker = 0) then - entropy^.pub.insufficient_data := FALSE; - - process_restart := TRUE; -end; - - -{ Huffman MCU decoding. - Each of these routines decodes and returns one MCU's worth of - Huffman-compressed coefficients. - The coefficients are reordered from zigzag order into natural array order, - but are not dequantized. - - The i'th block of the MCU is stored into the block pointed to by - MCU_data[i]. WE ASSUME THIS AREA IS INITIALLY ZEROED BY THE CALLER. - - We return FALSE if data source requested suspension. In that case no - changes have been made to permanent state. (Exception: some output - coefficients may already have been assigned. This is harmless for - spectral selection, since we'll just re-assign them on the next call. - Successive approximation AC refinement has to be more careful, however.) } - - -{ MCU decoding for DC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function decode_mcu_DC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label1; -var - entropy : phuff_entropy_ptr; - Al : int; - {register} s, r : int; - blkn, ci : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - state : savable_state; - tbl : d_derived_tbl_ptr; - compptr : jpeg_component_info_ptr; -var - nb, look : int; {register} -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Al := cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - {ASSIGN_STATE(state, entropy^.saved);} - state := entropy^.saved; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - ci := cinfo^.MCU_membership[blkn]; - compptr := cinfo^.cur_comp_info[ci]; - tbl := entropy^.derived_tbls[compptr^.dc_tbl_no]; - - { Decode a single block's worth of coefficients } - - { Section F.2.2.1: decode the DC coefficient difference } - {HUFF_DECODE(s, br_state, tbl, return FALSE, label1);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label1; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label1: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - if (s <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu_DC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - end; - - { Convert DC difference to actual value, update last_dc_val } - Inc(s, state.last_dc_val[ci]); - state.last_dc_val[ci] := s; - { Scale and output the DC coefficient (assumes jpeg_natural_order[0]=0) } - block^[0] := JCOEF (s shl Al); - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - {ASSIGN_STATE(entropy^.saved, state);} - entropy^.saved := state; - end; - - { Account for restart interval (no-op if not using restarts) } - if entropy^.restarts_to_go > 0 then - Dec(entropy^.restarts_to_go); - - decode_mcu_DC_first := TRUE; -end; - - -{ MCU decoding for AC initial scan (either spectral selection, - or first pass of successive approximation). } - -{METHODDEF} -function decode_mcu_AC_first (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - label2; -var - entropy : phuff_entropy_ptr; - Se : int; - Al : int; - {register} s, k, r : int; - EOBRUN : uInt; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - tbl : d_derived_tbl_ptr; -var - nb, look : int; {register} -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - Al := cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - end; - - { If we've run out of data, just leave the MCU set to zeroes. - This way, we return uniform gray for the remainder of the segment. } - if not entropy^.pub.insufficient_data then - begin - - { Load up working state. - We can avoid loading/saving bitread state if in an EOB run. } - - EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } - - { There is always only one block per MCU } - - if (EOBRUN > 0) then { if it's a band of zeroes... } - Dec(EOBRUN) { ...process it now (we do nothing) } - else - begin - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - block := JBLOCK_PTR(MCU_data[0]); - tbl := entropy^.ac_derived_tbl; - - k := cinfo^.Ss; - while (k <= Se) do - begin - {HUFF_DECODE(s, br_state, tbl, return FALSE, label2);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label2; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label2: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - if (s <> 0) then - begin - Inc(k, r); - {CHECK_BIT_BUFFER(br_state, s, return FALSE);} - if (bits_left < s) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,s)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(s);} - Dec(bits_left, s); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl s) ); - - {s := HUFF_EXTEND(r, s);} - if (r < extend_test[s]) then - s := r + extend_offset[s] - else - s := r; - - { Scale and output coefficient in natural (dezigzagged) order } - block^[jpeg_natural_order[k]] := JCOEF (s shl Al); - end - else - begin - if (r = 15) then - begin { ZRL } - Inc(k, 15); { skip 15 zeroes in band } - end - else - begin { EOBr, run length is 2^r + appended bits } - EOBRUN := 1 shl r; - if (r <> 0) then - begin { EOBr, r > 0 } - {CHECK_BIT_BUFFER(br_state, r, return FALSE);} - if (bits_left < r) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then - begin - decode_mcu_AC_first := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(r);} - Dec(bits_left, r); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); - - Inc(EOBRUN, r); - end; - Dec(EOBRUN); { this band is processed at this moment } - break; { force end-of-band } - end; - end; - Inc(k); - end; - - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - end; - - { Completed MCU, so update state } - entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } - end; - - { Account for restart interval (no-op if not using restarts) } - if entropy^.restarts_to_go > 0 then - Dec(entropy^.restarts_to_go); - - decode_mcu_AC_first := TRUE; -end; - - -{ MCU decoding for DC successive approximation refinement scan. - Note: we assume such scans can be multi-component, although the spec - is not very clear on the point. } - -{METHODDEF} -function decode_mcu_DC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - -var - entropy : phuff_entropy_ptr; - p1 : int; { 1 in the bit position being coded } - blkn : int; - block : JBLOCK_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; -begin - entropy := phuff_entropy_ptr (cinfo^.entropy); - p1 := 1 shl cinfo^.Al; - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_DC_refine := FALSE; - exit; - end; - end; - - { Not worth the cycles to check insufficient_data here, - since we will not change the data anyway if we read zeroes. } - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - { Outer loop handles each block in the MCU } - - for blkn := 0 to pred(cinfo^.blocks_in_MCU) do - begin - block := JBLOCK_PTR(MCU_data[blkn]); - - { Encoded data is simply the next bit of the two's-complement DC value } - {CHECK_BIT_BUFFER(br_state, 1, return FALSE);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - begin - decode_mcu_DC_refine := FALSE; - exit; - end; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) ) <> 0 then - block^[0] := block^[0] or p1; - { Note: since we use OR, repeating the assignment later is safe } - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - { Account for restart interval (no-op if not using restarts) } - if entropy^.restarts_to_go > 0 then - Dec(entropy^.restarts_to_go); - - decode_mcu_DC_refine := TRUE; -end; - - -{ MCU decoding for AC successive approximation refinement scan. } - -{METHODDEF} -function decode_mcu_AC_refine (cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; -label - undoit, label3; -var - entropy : phuff_entropy_ptr; - Se : int; - p1 : int; { 1 in the bit position being coded } - m1 : int; { -1 in the bit position being coded } - {register} s, k, r : int; - EOBRUN : uInt; - block : JBLOCK_PTR; - thiscoef : JCOEF_PTR; - {BITREAD_STATE_VARS;} - get_buffer : bit_buf_type ; {register} - bits_left : int; {register} - br_state : bitread_working_state; - - tbl : d_derived_tbl_ptr; - num_newnz : int; - newnz_pos : array[0..DCTSIZE2-1] of int; -var - pos : int; -var - nb, look : int; {register} -begin - num_newnz := 0; - block := nil; - - entropy := phuff_entropy_ptr (cinfo^.entropy); - Se := cinfo^.Se; - p1 := 1 shl cinfo^.Al; { 1 in the bit position being coded } - m1 := (-1) shl cinfo^.Al; { -1 in the bit position being coded } - - { Process restart marker if needed; may have to suspend } - if (cinfo^.restart_interval <> 0) then - begin - if (entropy^.restarts_to_go = 0) then - if (not process_restart(cinfo)) then - begin - decode_mcu_AC_refine := FALSE; - exit; - end; - end; - - { If we've run out of data, don't modify the MCU. } - if not entropy^.pub.insufficient_data then - begin - - { Load up working state } - {BITREAD_LOAD_STATE(cinfo,entropy^.bitstate);} - br_state.cinfo := cinfo; - br_state.next_input_byte := cinfo^.src^.next_input_byte; - br_state.bytes_in_buffer := cinfo^.src^.bytes_in_buffer; - get_buffer := entropy^.bitstate.get_buffer; - bits_left := entropy^.bitstate.bits_left; - - EOBRUN := entropy^.saved.EOBRUN; { only part of saved state we care about } - - { There is always only one block per MCU } - block := JBLOCK_PTR(MCU_data[0]); - tbl := entropy^.ac_derived_tbl; - - { If we are forced to suspend, we must undo the assignments to any newly - nonzero coefficients in the block, because otherwise we'd get confused - next time about which coefficients were already nonzero. - But we need not undo addition of bits to already-nonzero coefficients; - instead, we can test the current bit position to see if we already did it.} - - num_newnz := 0; - - { initialize coefficient loop counter to start of band } - k := cinfo^.Ss; - - if (EOBRUN = 0) then - begin - while (k <= Se) do - begin - {HUFF_DECODE(s, br_state, tbl, goto undoit, label3);} - if (bits_left < HUFF_LOOKAHEAD) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left, 0)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - if (bits_left < HUFF_LOOKAHEAD) then - begin - nb := 1; - goto label3; - end; - end; - {look := PEEK_BITS(HUFF_LOOKAHEAD);} - look := int(get_buffer shr (bits_left - HUFF_LOOKAHEAD)) and - pred(1 shl HUFF_LOOKAHEAD); - - nb := tbl^.look_nbits[look]; - if (nb <> 0) then - begin - {DROP_BITS(nb);} - Dec(bits_left, nb); - - s := tbl^.look_sym[look]; - end - else - begin - nb := HUFF_LOOKAHEAD+1; - label3: - s := jpeg_huff_decode(br_state,get_buffer,bits_left,tbl,nb); - if (s < 0) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - r := s shr 4; - s := s and 15; - if (s <> 0) then - begin - if (s <> 1) then { size of new coef should always be 1 } - WARNMS(j_common_ptr(cinfo), JWRN_HUFF_BAD_CODE); - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - s := p1 { newly nonzero coef is positive } - else - s := m1; { newly nonzero coef is negative } - end - else - begin - if (r <> 15) then - begin - EOBRUN := 1 shl r; { EOBr, run length is 2^r + appended bits } - if (r <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, r, goto undoit);} - if (bits_left < r) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,r)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {r := GET_BITS(r);} - Dec(bits_left, r); - r := (int(get_buffer shr bits_left)) and ( pred(1 shl r) ); - - Inc(EOBRUN, r); - end; - break; { rest of block is handled by EOB logic } - end; - { note s := 0 for processing ZRL } - end; - { Advance over already-nonzero coefs and r still-zero coefs, - appending correction bits to the nonzeroes. A correction bit is 1 - if the absolute value of the coefficient must be increased. } - - repeat - thiscoef :=@(block^[jpeg_natural_order[k]]); - if (thiscoef^ <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - begin - if ((thiscoef^ and p1) = 0) then - begin { do nothing if already set it } - if (thiscoef^ >= 0) then - Inc(thiscoef^, p1) - else - Inc(thiscoef^, m1); - end; - end; - end - else - begin - Dec(r); - if (r < 0) then - break; { reached target zero coefficient } - end; - Inc(k); - until (k > Se); - if (s <> 0) then - begin - pos := jpeg_natural_order[k]; - { Output newly nonzero coefficient } - block^[pos] := JCOEF (s); - { Remember its position in case we have to suspend } - newnz_pos[num_newnz] := pos; - Inc(num_newnz); - end; - Inc(k); - end; - end; - - if (EOBRUN > 0) then - begin - { Scan any remaining coefficient positions after the end-of-band - (the last newly nonzero coefficient, if any). Append a correction - bit to each already-nonzero coefficient. A correction bit is 1 - if the absolute value of the coefficient must be increased. } - - while (k <= Se) do - begin - thiscoef := @(block^[jpeg_natural_order[k]]); - if (thiscoef^ <> 0) then - begin - {CHECK_BIT_BUFFER(br_state, 1, goto undoit);} - if (bits_left < 1) then - begin - if (not jpeg_fill_bit_buffer(br_state,get_buffer,bits_left,1)) then - goto undoit; - get_buffer := br_state.get_buffer; - bits_left := br_state.bits_left; - end; - - {if (GET_BITS(1)) then} - Dec(bits_left); - if (int(get_buffer shr bits_left)) and ( pred(1 shl 1) )<>0 then - begin - if ((thiscoef^ and p1) = 0) then - begin { do nothing if already changed it } - if (thiscoef^ >= 0) then - Inc(thiscoef^, p1) - else - Inc(thiscoef^, m1); - end; - end; - end; - Inc(k); - end; - { Count one block completed in EOB run } - Dec(EOBRUN); - end; - - { Completed MCU, so update state } - {BITREAD_SAVE_STATE(cinfo,entropy^.bitstate);} - cinfo^.src^.next_input_byte := br_state.next_input_byte; - cinfo^.src^.bytes_in_buffer := br_state.bytes_in_buffer; - entropy^.bitstate.get_buffer := get_buffer; - entropy^.bitstate.bits_left := bits_left; - - entropy^.saved.EOBRUN := EOBRUN; { only part of saved state we care about } - end; - - { Account for restart interval (no-op if not using restarts) } - if entropy^.restarts_to_go > 0 then - Dec(entropy^.restarts_to_go); - - decode_mcu_AC_refine := TRUE; - exit; - -undoit: - { Re-zero any output coefficients that we made newly nonzero } - while (num_newnz > 0) do - begin - Dec(num_newnz); - block^[newnz_pos[num_newnz]] := 0; - end; - - decode_mcu_AC_refine := FALSE; -end; - - -{ Module initialization routine for progressive Huffman entropy decoding. } - -{GLOBAL} -procedure jinit_phuff_decoder (cinfo : j_decompress_ptr); -var - entropy : phuff_entropy_ptr; - coef_bit_ptr : int_ptr; - ci, i : int; -begin - entropy := phuff_entropy_ptr( - cinfo^.mem^.alloc_small (j_common_ptr (cinfo), JPOOL_IMAGE, - SIZEOF(phuff_entropy_decoder)) ); - cinfo^.entropy := jpeg_entropy_decoder_ptr (entropy); - entropy^.pub.start_pass := start_pass_phuff_decoder; - - { Mark derived tables unallocated } - for i := 0 to pred(NUM_HUFF_TBLS) do - begin - entropy^.derived_tbls[i] := NIL; - end; - - { Create progression status table } - cinfo^.coef_bits := coef_bits_ptrrow ( - cinfo^.mem^.alloc_small ( j_common_ptr (cinfo), JPOOL_IMAGE, - cinfo^.num_components*DCTSIZE2*SIZEOF(int)) ); - coef_bit_ptr := @cinfo^.coef_bits^[0][0]; - for ci := 0 to pred(cinfo^.num_components) do - for i := 0 to pred(DCTSIZE2) do - begin - coef_bit_ptr^ := -1; - Inc(coef_bit_ptr); - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdpostct.pas b/3rd/Imaging/Source/JpegLib/imjdpostct.pas deleted file mode 100644 index f3078c356..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdpostct.pas +++ /dev/null @@ -1,341 +0,0 @@ -unit imjdpostct; - -{ Original: jdpostct.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -{ This file contains the decompression postprocessing controller. - This controller manages the upsampling, color conversion, and color - quantization/reduction steps; specifically, it controls the buffering - between upsample/color conversion and color quantization/reduction. - - If no color quantization/reduction is required, then this module has no - work to do, and it just hands off to the upsample/color conversion code. - An integrated upsample/convert/quantize process would replace this module - entirely. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{ Initialize postprocessing controller. } - -{GLOBAL} -procedure jinit_d_post_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -implementation - - -{ Private buffer controller object } - -type - my_post_ptr = ^my_post_controller; - my_post_controller = record - pub : jpeg_d_post_controller; { public fields } - - { Color quantization source buffer: this holds output data from - the upsample/color conversion step to be passed to the quantizer. - For two-pass color quantization, we need a full-image buffer; - for one-pass operation, a strip buffer is sufficient. } - - whole_image : jvirt_sarray_ptr; { virtual array, or NIL if one-pass } - buffer : JSAMPARRAY; { strip buffer, or current strip of virtual } - strip_height : JDIMENSION; { buffer size in rows } - { for two-pass mode only: } - starting_row : JDIMENSION; { row # of first row in current strip } - next_row : JDIMENSION; { index of next row to fill/empty in strip } - end; - -{ Forward declarations } -{METHODDEF} -procedure post_process_1pass(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{$ifdef QUANT_2PASS_SUPPORTED} -{METHODDEF} -procedure post_process_prepass(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{METHODDEF} -procedure post_process_2pass(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); forward; -{$endif} - - -{ Initialize for a processing pass. } - -{METHODDEF} -procedure start_pass_dpost (cinfo : j_decompress_ptr; - pass_mode : J_BUF_MODE); -var - post : my_post_ptr; -begin - post := my_post_ptr(cinfo^.post); - - case (pass_mode) of - JBUF_PASS_THRU: - if (cinfo^.quantize_colors) then - begin - { Single-pass processing with color quantization. } - post^.pub.post_process_data := post_process_1pass; - { We could be doing buffered-image output before starting a 2-pass - color quantization; in that case, jinit_d_post_controller did not - allocate a strip buffer. Use the virtual-array buffer as workspace. } - if (post^.buffer = NIL) then - begin - post^.buffer := cinfo^.mem^.access_virt_sarray - (j_common_ptr(cinfo), post^.whole_image, - JDIMENSION(0), post^.strip_height, TRUE); - end; - end - else - begin - { For single-pass processing without color quantization, - I have no work to do; just call the upsampler directly. } - - post^.pub.post_process_data := cinfo^.upsample^.upsample; - end; - -{$ifdef QUANT_2PASS_SUPPORTED} - JBUF_SAVE_AND_PASS: - begin - { First pass of 2-pass quantization } - if (post^.whole_image = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - post^.pub.post_process_data := post_process_prepass; - end; - JBUF_CRANK_DEST: - begin - { Second pass of 2-pass quantization } - if (post^.whole_image = NIL) then - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - post^.pub.post_process_data := post_process_2pass; - end; -{$endif} { QUANT_2PASS_SUPPORTED } - else - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); - end; - post^.next_row := 0; - post^.starting_row := 0; -end; - - -{ Process some data in the one-pass (strip buffer) case. - This is used for color precision reduction as well as one-pass quantization. } - -{METHODDEF} -procedure post_process_1pass (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - post : my_post_ptr; - num_rows, max_rows : JDIMENSION; -begin - post := my_post_ptr (cinfo^.post); - - { Fill the buffer, but not more than what we can dump out in one go. } - { Note we rely on the upsampler to detect bottom of image. } - max_rows := out_rows_avail - out_row_ctr; - if (max_rows > post^.strip_height) then - max_rows := post^.strip_height; - num_rows := 0; - cinfo^.upsample^.upsample (cinfo, - input_buf, - in_row_group_ctr, - in_row_groups_avail, - post^.buffer, - num_rows, { var } - max_rows); - { Quantize and emit data. } - - cinfo^.cquantize^.color_quantize (cinfo, - post^.buffer, - JSAMPARRAY(@ output_buf^[out_row_ctr]), - int(num_rows)); - - Inc(out_row_ctr, num_rows); -end; - - -{$ifdef QUANT_2PASS_SUPPORTED} - -{ Process some data in the first pass of 2-pass quantization. } - -{METHODDEF} -procedure post_process_prepass (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail:JDIMENSION); -var - post : my_post_ptr; - old_next_row, num_rows : JDIMENSION; -begin - post := my_post_ptr(cinfo^.post); - - { Reposition virtual buffer if at start of strip. } - if (post^.next_row = 0) then - begin - post^.buffer := cinfo^.mem^.access_virt_sarray - (j_common_ptr(cinfo), post^.whole_image, - post^.starting_row, post^.strip_height, TRUE); - end; - - { Upsample some data (up to a strip height's worth). } - old_next_row := post^.next_row; - cinfo^.upsample^.upsample (cinfo, - input_buf, in_row_group_ctr, in_row_groups_avail, - post^.buffer, post^.next_row, post^.strip_height); - - { Allow quantizer to scan new data. No data is emitted, } - { but we advance out_row_ctr so outer loop can tell when we're done. } - if (post^.next_row > old_next_row) then - begin - num_rows := post^.next_row - old_next_row; - - - cinfo^.cquantize^.color_quantize (cinfo, - JSAMPARRAY(@ post^.buffer^[old_next_row]), - JSAMPARRAY(NIL), - int(num_rows)); - Inc(out_row_ctr, num_rows); - end; - - { Advance if we filled the strip. } - if (post^.next_row >= post^.strip_height) then - begin - Inc(post^.starting_row, post^.strip_height); - post^.next_row := 0; - end; -end; - - -{ Process some data in the second pass of 2-pass quantization. } - -{METHODDEF} -procedure post_process_2pass (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - post : my_post_ptr; - num_rows, max_rows : JDIMENSION; -begin - post := my_post_ptr(cinfo^.post); - - { Reposition virtual buffer if at start of strip. } - if (post^.next_row = 0) then - begin - post^.buffer := cinfo^.mem^.access_virt_sarray - (j_common_ptr(cinfo), post^.whole_image, - post^.starting_row, post^.strip_height, FALSE); - end; - - { Determine number of rows to emit. } - num_rows := post^.strip_height - post^.next_row; { available in strip } - max_rows := out_rows_avail - out_row_ctr; { available in output area } - if (num_rows > max_rows) then - num_rows := max_rows; - { We have to check bottom of image here, can't depend on upsampler. } - max_rows := cinfo^.output_height - post^.starting_row; - if (num_rows > max_rows) then - num_rows := max_rows; - - { Quantize and emit data. } - cinfo^.cquantize^.color_quantize (cinfo, - JSAMPARRAY(@ post^.buffer^[post^.next_row]), - JSAMPARRAY(@ output_buf^[out_row_ctr]), - int(num_rows)); - Inc(out_row_ctr, num_rows); - - { Advance if we filled the strip. } - Inc(post^.next_row, num_rows); - if (post^.next_row >= post^.strip_height) then - begin - Inc(post^.starting_row, post^.strip_height); - post^.next_row := 0; - end; -end; - -{$endif} { QUANT_2PASS_SUPPORTED } - - -{ Initialize postprocessing controller. } - -{GLOBAL} -procedure jinit_d_post_controller (cinfo : j_decompress_ptr; - need_full_buffer : boolean); -var - post : my_post_ptr; -begin - post := my_post_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_post_controller)) ); - cinfo^.post := jpeg_d_post_controller_ptr (post); - post^.pub.start_pass := start_pass_dpost; - post^.whole_image := NIL; { flag for no virtual arrays } - post^.buffer := NIL; { flag for no strip buffer } - - { Create the quantization buffer, if needed } - if (cinfo^.quantize_colors) then - begin - { The buffer strip height is max_v_samp_factor, which is typically - an efficient number of rows for upsampling to return. - (In the presence of output rescaling, we might want to be smarter?) } - - post^.strip_height := JDIMENSION (cinfo^.max_v_samp_factor); - if (need_full_buffer) then - begin - { Two-pass color quantization: need full-image storage. } - { We round up the number of rows to a multiple of the strip height. } -{$ifdef QUANT_2PASS_SUPPORTED} - post^.whole_image := cinfo^.mem^.request_virt_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, FALSE, - LongInt(cinfo^.output_width) * cinfo^.out_color_components, - JDIMENSION (jround_up( long(cinfo^.output_height), - long(post^.strip_height)) ), - post^.strip_height); -{$else} - ERREXIT(j_common_ptr(cinfo), JERR_BAD_BUFFER_MODE); -{$endif} { QUANT_2PASS_SUPPORTED } - end - else - begin - { One-pass color quantization: just make a strip buffer. } - post^.buffer := cinfo^.mem^.alloc_sarray - (j_common_ptr (cinfo), JPOOL_IMAGE, - LongInt(cinfo^.output_width) * cinfo^.out_color_components, - post^.strip_height); - end; - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjdsample.pas b/3rd/Imaging/Source/JpegLib/imjdsample.pas deleted file mode 100644 index ed2488c95..000000000 --- a/3rd/Imaging/Source/JpegLib/imjdsample.pas +++ /dev/null @@ -1,592 +0,0 @@ -unit imjdsample; - -{ Original: jdsample.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -{ This file contains upsampling routines. - - Upsampling input data is counted in "row groups". A row group - is defined to be (v_samp_factor * DCT_scaled_size / min_DCT_scaled_size) - sample rows of each component. Upsampling will normally produce - max_v_samp_factor pixel rows from each row group (but this could vary - if the upsampler is applying a scale factor of its own). - - An excellent reference for image resampling is - Digital Image Warping, George Wolberg, 1990. - Pub. by IEEE Computer Society Press, Los Alamitos, CA. ISBN 0-8186-8944-7.} - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjpeglib, - imjdeferr, - imjerror; - - -{ Pointer to routine to upsample a single component } -type - upsample1_ptr = procedure (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); - -{ Module initialization routine for upsampling. } - -{GLOBAL} -procedure jinit_upsampler (cinfo : j_decompress_ptr); - -implementation - -{ Private subobject } - -type - my_upsample_ptr = ^my_upsampler; - my_upsampler = record - pub : jpeg_upsampler; { public fields } - - { Color conversion buffer. When using separate upsampling and color - conversion steps, this buffer holds one upsampled row group until it - has been color converted and output. - Note: we do not allocate any storage for component(s) which are full-size, - ie do not need rescaling. The corresponding entry of color_buf[] is - simply set to point to the input data array, thereby avoiding copying.} - - color_buf : array[0..MAX_COMPONENTS-1] of JSAMPARRAY; - - { Per-component upsampling method pointers } - methods : array[0..MAX_COMPONENTS-1] of upsample1_ptr; - - next_row_out : int; { counts rows emitted from color_buf } - rows_to_go : JDIMENSION; { counts rows remaining in image } - - { Height of an input row group for each component. } - rowgroup_height : array[0..MAX_COMPONENTS-1] of int; - - { These arrays save pixel expansion factors so that int_expand need not - recompute them each time. They are unused for other upsampling methods.} - h_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; - v_expand : array[0..MAX_COMPONENTS-1] of UINT8 ; - end; - - -{ Initialize for an upsampling pass. } - -{METHODDEF} -procedure start_pass_upsample (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Mark the conversion buffer empty } - upsample^.next_row_out := cinfo^.max_v_samp_factor; - { Initialize total-height counter for detecting bottom of image } - upsample^.rows_to_go := cinfo^.output_height; -end; - - -{ Control routine to do upsampling (and color conversion). - - In this version we upsample each component independently. - We upsample one row group into the conversion buffer, then apply - color conversion a row at a time. } - -{METHODDEF} -procedure sep_upsample (cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); -var - upsample : my_upsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - num_rows : JDIMENSION; -begin - upsample := my_upsample_ptr (cinfo^.upsample); - - { Fill the conversion buffer, if it's empty } - if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then - begin - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Invoke per-component upsample method. Notice we pass a POINTER - to color_buf[ci], so that fullsize_upsample can change it. } - - upsample^.methods[ci] (cinfo, compptr, - JSAMPARRAY(@ input_buf^[ci]^ - [LongInt(in_row_group_ctr) * upsample^.rowgroup_height[ci]]), - upsample^.color_buf[ci]); - - Inc(compptr); - end; - upsample^.next_row_out := 0; - end; - - { Color-convert and emit rows } - - { How many we have in the buffer: } - num_rows := JDIMENSION (cinfo^.max_v_samp_factor - upsample^.next_row_out); - { Not more than the distance to the end of the image. Need this test - in case the image height is not a multiple of max_v_samp_factor: } - - if (num_rows > upsample^.rows_to_go) then - num_rows := upsample^.rows_to_go; - { And not more than what the client can accept: } - Dec(out_rows_avail, out_row_ctr); - if (num_rows > out_rows_avail) then - num_rows := out_rows_avail; - - cinfo^.cconvert^.color_convert (cinfo, - JSAMPIMAGE(@(upsample^.color_buf)), - JDIMENSION (upsample^.next_row_out), - JSAMPARRAY(@(output_buf^[out_row_ctr])), - int (num_rows)); - - { Adjust counts } - Inc(out_row_ctr, num_rows); - Dec(upsample^.rows_to_go, num_rows); - Inc(upsample^.next_row_out, num_rows); - { When the buffer is emptied, declare this input row group consumed } - if (upsample^.next_row_out >= cinfo^.max_v_samp_factor) then - Inc(in_row_group_ctr); -end; - - -{ These are the routines invoked by sep_upsample to upsample pixel values - of a single component. One row group is processed per call. } - - -{ For full-size components, we just make color_buf[ci] point at the - input buffer, and thus avoid copying any data. Note that this is - safe only because sep_upsample doesn't declare the input row group - "consumed" until we are done color converting and emitting it. } - -{METHODDEF} -procedure fullsize_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -begin - output_data_ptr := input_data; -end; - - -{ This is a no-op version used for "uninteresting" components. - These components will not be referenced by color conversion. } - -{METHODDEF} -procedure noop_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -begin - output_data_ptr := NIL; { safety check } -end; - - -{ This version handles any integral sampling ratios. - This is not used for typical JPEG files, so it need not be fast. - Nor, for that matter, is it particularly accurate: the algorithm is - simple replication of the input pixel onto the corresponding output - pixels. The hi-falutin sampling literature refers to this as a - "box filter". A box filter tends to introduce visible artifacts, - so if you are actually going to use 3:1 or 4:1 sampling ratios - you would be well advised to improve this code. } - -{METHODDEF} -procedure int_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - upsample : my_upsample_ptr; - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {register} h : int; - {outend} - h_expand, v_expand : int; - inrow, outrow : int; -var - outcount : int; { Nomssi: avoid pointer arithmetic } -begin - upsample := my_upsample_ptr (cinfo^.upsample); - output_data := output_data_ptr; - - h_expand := upsample^.h_expand[compptr^.component_index]; - v_expand := upsample^.v_expand[compptr^.component_index]; - - inrow := 0; - outrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - { Generate one output row with proper horizontal expansion } - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - outcount := cinfo^.output_width; - while (outcount > 0) do { Nomssi } - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - for h := pred(h_expand) downto 0 do - begin - outptr^ := invalue; - inc(outptr); { <-- fix: this was left out in PasJpeg 1.0 } - Dec(outcount); { thanks to Jannie Gerber for the report } - end; - end; - - { Generate any additional output rows by duplicating the first one } - if (v_expand > 1) then - begin - jcopy_sample_rows(output_data, outrow, output_data, outrow+1, - v_expand-1, cinfo^.output_width); - end; - Inc(inrow); - Inc(outrow, v_expand); - end; -end; - - -{ Fast processing for the common case of 2:1 horizontal and 1:1 vertical. - It's still a box filter. } - -{METHODDEF} -procedure h2v1_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {outend : JSAMPROW;} - outcount : int; - inrow : int; -begin - output_data := output_data_ptr; - - for inrow := 0 to pred(cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[inrow]); - {outend := outptr + cinfo^.output_width;} - outcount := cinfo^.output_width; - while (outcount > 0) do - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - outptr^ := invalue; - Inc(outptr); - outptr^ := invalue; - Inc(outptr); - Dec(outcount, 2); { Nomssi: to avoid pointer arithmetic } - end; - end; -end; - - -{ Fast processing for the common case of 2:1 horizontal and 2:1 vertical. - It's still a box filter. } - -{METHODDEF} -procedure h2v2_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr, outptr : JSAMPLE_PTR; - {register} invalue : JSAMPLE; - {outend : JSAMPROW;} - outcount : int; - inrow, outrow : int; -begin - output_data := output_data_ptr; - - inrow := 0; - outrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - {outend := outptr + cinfo^.output_width;} - outcount := cinfo^.output_width; - while (outcount > 0) do - begin - invalue := inptr^; { don't need GETJSAMPLE() here } - Inc(inptr); - outptr^ := invalue; - Inc(outptr); - outptr^ := invalue; - Inc(outptr); - Dec(outcount, 2); - end; - jcopy_sample_rows(output_data, outrow, output_data, outrow+1, - 1, cinfo^.output_width); - Inc(inrow); - Inc(outrow, 2); - end; -end; - - -{ Fancy processing for the common case of 2:1 horizontal and 1:1 vertical. - - The upsampling algorithm is linear interpolation between pixel centers, - also known as a "triangle filter". This is a good compromise between - speed and visual quality. The centers of the output pixels are 1/4 and 3/4 - of the way between input pixel centers. - - A note about the "bias" calculations: when rounding fractional values to - integer, we do not want to always round 0.5 up to the next integer. - If we did that, we'd introduce a noticeable bias towards larger values. - Instead, this code is arranged so that 0.5 will be rounded up or down at - alternate pixel locations (a simple ordered dither pattern). } - -{METHODDEF} -procedure h2v1_fancy_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} pre_inptr, inptr, outptr : JSAMPLE_PTR; - {register} invalue : int; - {register} colctr : JDIMENSION; - inrow : int; -begin - output_data := output_data_ptr; - - for inrow := 0 to pred(cinfo^.max_v_samp_factor) do - begin - inptr := JSAMPLE_PTR(input_data^[inrow]); - outptr := JSAMPLE_PTR(output_data^[inrow]); - { Special case for first column } - pre_inptr := inptr; - invalue := GETJSAMPLE(inptr^); - Inc(inptr); - outptr^ := JSAMPLE (invalue); - Inc(outptr); - outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(inptr^) + 2) shr 2); - Inc(outptr); - - for colctr := pred(compptr^.downsampled_width - 2) downto 0 do - begin - { General case: 3/4 * nearer pixel + 1/4 * further pixel } - invalue := GETJSAMPLE(inptr^) * 3; - Inc(inptr); - outptr^ := JSAMPLE ((invalue + GETJSAMPLE(pre_inptr^) + 1) shr 2); - Inc(pre_inptr); - Inc(outptr); - outptr^ := JSAMPLE ((invalue + GETJSAMPLE(inptr^) + 2) shr 2); - Inc(outptr); - end; - - { Special case for last column } - invalue := GETJSAMPLE(inptr^); - outptr^ := JSAMPLE ((invalue * 3 + GETJSAMPLE(pre_inptr^) + 1) shr 2); - Inc(outptr); - outptr^ := JSAMPLE (invalue); - {Inc(outptr); - value never used } - end; -end; - - -{ Fancy processing for the common case of 2:1 horizontal and 2:1 vertical. - Again a triangle filter; see comments for h2v1 case, above. - - It is OK for us to reference the adjacent input rows because we demanded - context from the main buffer controller (see initialization code). } - -{METHODDEF} -procedure h2v2_fancy_upsample (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - input_data : JSAMPARRAY; - var output_data_ptr : JSAMPARRAY); -var - output_data : JSAMPARRAY; - {register} inptr0, inptr1, outptr : JSAMPLE_PTR; -{$ifdef BITS_IN_JSAMPLE_IS_8} - {register} thiscolsum, lastcolsum, nextcolsum : int; -{$else} - {register} thiscolsum, lastcolsum, nextcolsum : INT32; -{$endif} - {register} colctr : JDIMENSION; - inrow, outrow, v : int; -var - prev_input_data : JSAMPARRAY; { Nomssi work around } -begin - output_data := output_data_ptr; - - outrow := 0; - inrow := 0; - while (outrow < cinfo^.max_v_samp_factor) do - begin - for v := 0 to pred(2) do - begin - { inptr0 points to nearest input row, inptr1 points to next nearest } - inptr0 := JSAMPLE_PTR(input_data^[inrow]); - if (v = 0) then { next nearest is row above } - begin - {inptr1 := JSAMPLE_PTR(input_data^[inrow-1]);} - prev_input_data := input_data; { work around } - Dec(JSAMPROW_PTR(prev_input_data)); { negative offsets } - inptr1 := JSAMPLE_PTR(prev_input_data^[inrow]); - end - else { next nearest is row below } - inptr1 := JSAMPLE_PTR(input_data^[inrow+1]); - outptr := JSAMPLE_PTR(output_data^[outrow]); - Inc(outrow); - - { Special case for first column } - thiscolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - - outptr^ := JSAMPLE ((thiscolsum * 4 + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); - Inc(outptr); - lastcolsum := thiscolsum; thiscolsum := nextcolsum; - - for colctr := pred(compptr^.downsampled_width - 2) downto 0 do - begin - { General case: 3/4 * nearer pixel + 1/4 * further pixel in each } - { dimension, thus 9/16, 3/16, 3/16, 1/16 overall } - nextcolsum := GETJSAMPLE(inptr0^) * 3 + GETJSAMPLE(inptr1^); - Inc(inptr0); - Inc(inptr1); - outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 3 + nextcolsum + 7) shr 4); - Inc(outptr); - lastcolsum := thiscolsum; - thiscolsum := nextcolsum; - end; - - { Special case for last column } - outptr^ := JSAMPLE ((thiscolsum * 3 + lastcolsum + 8) shr 4); - Inc(outptr); - outptr^ := JSAMPLE ((thiscolsum * 4 + 7) shr 4); - {Inc(outptr); - value never used } - end; - Inc(inrow); - end; -end; - - -{ Module initialization routine for upsampling. } - -{GLOBAL} -procedure jinit_upsampler (cinfo : j_decompress_ptr); -var - upsample : my_upsample_ptr; - ci : int; - compptr : jpeg_component_info_ptr; - need_buffer, do_fancy : boolean; - h_in_group, v_in_group, h_out_group, v_out_group : int; -begin - upsample := my_upsample_ptr ( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_upsampler)) ); - cinfo^.upsample := jpeg_upsampler_ptr (upsample); - upsample^.pub.start_pass := start_pass_upsample; - upsample^.pub.upsample := sep_upsample; - upsample^.pub.need_context_rows := FALSE; { until we find out differently } - - if (cinfo^.CCIR601_sampling) then { this isn't supported } - ERREXIT(j_common_ptr(cinfo), JERR_CCIR601_NOTIMPL); - - { jdmainct.c doesn't support context rows when min_DCT_scaled_size := 1, - so don't ask for it. } - - do_fancy := cinfo^.do_fancy_upsampling and (cinfo^.min_DCT_scaled_size > 1); - - { Verify we can handle the sampling factors, select per-component methods, - and create storage as needed. } - - compptr := jpeg_component_info_ptr(cinfo^.comp_info); - for ci := 0 to pred(cinfo^.num_components) do - begin - { Compute size of an "input group" after IDCT scaling. This many samples - are to be converted to max_h_samp_factor * max_v_samp_factor pixels. } - - h_in_group := (compptr^.h_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; - v_in_group := (compptr^.v_samp_factor * compptr^.DCT_scaled_size) div - cinfo^.min_DCT_scaled_size; - h_out_group := cinfo^.max_h_samp_factor; - v_out_group := cinfo^.max_v_samp_factor; - upsample^.rowgroup_height[ci] := v_in_group; { save for use later } - need_buffer := TRUE; - if (not compptr^.component_needed) then - begin - { Don't bother to upsample an uninteresting component. } - upsample^.methods[ci] := noop_upsample; - need_buffer := FALSE; - end - else - if (h_in_group = h_out_group) and (v_in_group = v_out_group) then - begin - { Fullsize components can be processed without any work. } - upsample^.methods[ci] := fullsize_upsample; - need_buffer := FALSE; - end - else - if (h_in_group * 2 = h_out_group) and - (v_in_group = v_out_group) then - begin - { Special cases for 2h1v upsampling } - if (do_fancy) and (compptr^.downsampled_width > 2) then - upsample^.methods[ci] := h2v1_fancy_upsample - else - upsample^.methods[ci] := h2v1_upsample; - end - else - if (h_in_group * 2 = h_out_group) and - (v_in_group * 2 = v_out_group) then - begin - { Special cases for 2h2v upsampling } - if (do_fancy) and (compptr^.downsampled_width > 2) then - begin - upsample^.methods[ci] := h2v2_fancy_upsample; - upsample^.pub.need_context_rows := TRUE; - end - else - upsample^.methods[ci] := h2v2_upsample; - end - else - if ((h_out_group mod h_in_group) = 0) and - ((v_out_group mod v_in_group) = 0) then - begin - { Generic integral-factors upsampling method } - upsample^.methods[ci] := int_upsample; - upsample^.h_expand[ci] := UINT8 (h_out_group div h_in_group); - upsample^.v_expand[ci] := UINT8 (v_out_group div v_in_group); - end - else - ERREXIT(j_common_ptr(cinfo), JERR_FRACT_SAMPLE_NOTIMPL); - if (need_buffer) then - begin - upsample^.color_buf[ci] := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION (jround_up( long (cinfo^.output_width), - long (cinfo^.max_h_samp_factor))), - JDIMENSION (cinfo^.max_v_samp_factor)); - end; - Inc(compptr); - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjerror.pas b/3rd/Imaging/Source/JpegLib/imjerror.pas deleted file mode 100644 index d1e4ebcbc..000000000 --- a/3rd/Imaging/Source/JpegLib/imjerror.pas +++ /dev/null @@ -1,462 +0,0 @@ -unit imjerror; - -{ This file contains simple error-reporting and trace-message routines. - These are suitable for Unix-like systems and others where writing to - stderr is the right thing to do. Many applications will want to replace - some or all of these routines. - - These routines are used by both the compression and decompression code. } - -{ Source: jerror.c; Copyright (C) 1991-1996, Thomas G. Lane. } -{ note: format_message still contains a hack } -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjdeferr, - imjpeglib; -{ - jversion; -} - -const - EXIT_FAILURE = 1; { define halt() codes if not provided } - -{GLOBAL} -function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr; - - - -procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE); - -procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt); - -procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : int; p2 : int); - -procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int); - -procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int); - -procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE; - str : AnsiString); -{ Nonfatal errors (we can keep going, but the data is probably corrupt) } - -procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE); - -procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int); - -procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int); - -{ Informational/debugging messages } -procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE); - -procedure TRACEMS1(cinfo : j_common_ptr; lvl : int; - code : J_MESSAGE_CODE; p1 : long); - -procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; - p2 : int); - -procedure TRACEMS3(cinfo : j_common_ptr; - lvl : int; - code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int); - -procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int); - -procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int; p5 : int); - -procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int; - p5 : int; p6 : int; p7 : int; p8 : int); - -procedure TRACEMSS(cinfo : j_common_ptr; lvl : int; - code : J_MESSAGE_CODE; str : AnsiString); - -implementation - - -{ How to format a message string, in format_message() ? } - -{$IFDEF OS2} - {$DEFINE NO_FORMAT} -{$ENDIF} -{$IFDEF FPC} - {$DEFINE NO_FORMAT} -{$ENDIF} - -uses -{$IFNDEF NO_FORMAT} - {$IFDEF VER70} - drivers, { Turbo Vision unit with FormatStr } - {$ELSE} - sysutils, { Delphi Unit with Format() } - {$ENDIF} -{$ENDIF} - imjcomapi; - -{ Error exit handler: must not return to caller. - - Applications may override this if they want to get control back after - an error. Typically one would longjmp somewhere instead of exiting. - The setjmp buffer can be made a private field within an expanded error - handler object. Note that the info needed to generate an error message - is stored in the error object, so you can generate the message now or - later, at your convenience. - You should make sure that the JPEG object is cleaned up (with jpeg_abort - or jpeg_destroy) at some point. } - - -{METHODDEF} -procedure error_exit (cinfo : j_common_ptr); -begin - { Always display the message } - cinfo^.err^.output_message(cinfo); - - { Let the memory manager delete any temp files before we die } - jpeg_destroy(cinfo); - - halt(EXIT_FAILURE); -end; - - -{ Actual output of an error or trace message. - Applications may override this method to send JPEG messages somewhere - other than stderr. } - -{ Macros to simplify using the error and trace message stuff } -{ The first parameter is either type of cinfo pointer } - -{ Fatal errors (print message and exit) } -procedure ERREXIT(cinfo : j_common_ptr; code : J_MESSAGE_CODE); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.error_exit(cinfo); -end; - -procedure ERREXIT1(cinfo : j_common_ptr; code : J_MESSAGE_CODE; p1 : uInt); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.error_exit (cinfo); -end; - -procedure ERREXIT2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.msg_parm.i[1] := p2; - cinfo^.err^.error_exit (cinfo); -end; - -procedure ERREXIT3(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.msg_parm.i[1] := p2; - cinfo^.err^.msg_parm.i[2] := p3; - cinfo^.err^.error_exit (cinfo); -end; - -procedure ERREXIT4(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.msg_parm.i[1] := p2; - cinfo^.err^.msg_parm.i[2] := p3; - cinfo^.err^.msg_parm.i[3] := p4; - cinfo^.err^.error_exit (cinfo); -end; - -procedure ERREXITS(cinfo : j_common_ptr;code : J_MESSAGE_CODE; - str : AnsiString); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.s := str; { string[JMSG_STR_PARM_MAX] } - cinfo^.err^.error_exit (cinfo); -end; - -{ Nonfatal errors (we can keep going, but the data is probably corrupt) } - -procedure WARNMS(cinfo : j_common_ptr; code : J_MESSAGE_CODE); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message(cinfo, -1); -end; - -procedure WARNMS1(cinfo : j_common_ptr;code : J_MESSAGE_CODE; p1 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.emit_message (cinfo, -1); -end; - -procedure WARNMS2(cinfo : j_common_ptr; code : J_MESSAGE_CODE; - p1 : int; p2 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.msg_parm.i[1] := p2; - cinfo^.err^.emit_message (cinfo, -1); -end; - -{ Informational/debugging messages } -procedure TRACEMS(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message(cinfo, lvl); -end; - -procedure TRACEMS1(cinfo : j_common_ptr; lvl : int; - code : J_MESSAGE_CODE; p1 : long); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.emit_message (cinfo, lvl); -end; - -procedure TRACEMS2(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; - p2 : int); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.i[0] := p1; - cinfo^.err^.msg_parm.i[1] := p2; - cinfo^.err^.emit_message (cinfo, lvl); -end; - -procedure TRACEMS3(cinfo : j_common_ptr; - lvl : int; - code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int); -var - _mp : int8array; -begin - _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; - cinfo^.err^.msg_parm.i := _mp; - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message (cinfo, lvl); -end; - - -procedure TRACEMS4(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int); -var - _mp : int8array; -begin - _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4; - cinfo^.err^.msg_parm.i := _mp; - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message (cinfo, lvl); -end; - -procedure TRACEMS5(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int; p5 : int); -var - _mp : ^int8array; -begin - _mp := @cinfo^.err^.msg_parm.i; - _mp^[0] := p1; _mp^[1] := p2; _mp^[2] := p3; - _mp^[3] := p4; _mp^[5] := p5; - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message (cinfo, lvl); -end; - -procedure TRACEMS8(cinfo : j_common_ptr; lvl : int; code : J_MESSAGE_CODE; - p1 : int; p2 : int; p3 : int; p4 : int; - p5 : int; p6 : int; p7 : int; p8 : int); -var - _mp : int8array; -begin - _mp[0] := p1; _mp[1] := p2; _mp[2] := p3; _mp[3] := p4; - _mp[4] := p5; _mp[5] := p6; _mp[6] := p7; _mp[7] := p8; - cinfo^.err^.msg_parm.i := _mp; - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.emit_message (cinfo, lvl); -end; - -procedure TRACEMSS(cinfo : j_common_ptr; lvl : int; - code : J_MESSAGE_CODE; str : AnsiString); -begin - cinfo^.err^.msg_code := ord(code); - cinfo^.err^.msg_parm.s := str; { string JMSG_STR_PARM_MAX } - cinfo^.err^.emit_message (cinfo, lvl); -end; - -{METHODDEF} -procedure output_message (cinfo : j_common_ptr); -var - buffer : AnsiString; {[JMSG_LENGTH_MAX];} -begin - { Create the message } - cinfo^.err^.format_message (cinfo, buffer); - - { Send it to stderr, adding a newline } - WriteLn(output, buffer); -end; - - - -{ Decide whether to emit a trace or warning message. - msg_level is one of: - -1: recoverable corrupt-data warning, may want to abort. - 0: important advisory messages (always display to user). - 1: first level of tracing detail. - 2,3,...: successively more detailed tracing messages. - An application might override this method if it wanted to abort on warnings - or change the policy about which messages to display. } - - -{METHODDEF} -procedure emit_message (cinfo : j_common_ptr; msg_level : int); -var - err : jpeg_error_mgr_ptr; -begin - err := cinfo^.err; - if (msg_level < 0) then - begin - { It's a warning message. Since corrupt files may generate many warnings, - the policy implemented here is to show only the first warning, - unless trace_level >= 3. } - - if (err^.num_warnings = 0) or (err^.trace_level >= 3) then - err^.output_message(cinfo); - { Always count warnings in num_warnings. } - Inc( err^.num_warnings ); - end - else - begin - { It's a trace message. Show it if trace_level >= msg_level. } - if (err^.trace_level >= msg_level) then - err^.output_message (cinfo); - end; -end; - - -{ Format a message string for the most recent JPEG error or message. - The message is stored into buffer, which should be at least JMSG_LENGTH_MAX - characters. Note that no '\n' character is added to the string. - Few applications should need to override this method. } - - -{METHODDEF} -procedure format_message (cinfo : j_common_ptr; var buffer : AnsiString); -var - err : jpeg_error_mgr_ptr; - msg_code : J_MESSAGE_CODE; - msgtext : AnsiString; - isstring : boolean; -begin - err := cinfo^.err; - msg_code := J_MESSAGE_CODE(err^.msg_code); - msgtext := ''; - - { Look up message string in proper table } - if (msg_code > JMSG_NOMESSAGE) - and (msg_code <= J_MESSAGE_CODE(err^.last_jpeg_message)) then - begin - msgtext := err^.jpeg_message_table^[msg_code]; - end - else - if (err^.addon_message_table <> NIL) and - (msg_code >= err^.first_addon_message) and - (msg_code <= err^.last_addon_message) then - begin - msgtext := err^.addon_message_table^[J_MESSAGE_CODE - (ord(msg_code) - ord(err^.first_addon_message))]; - end; - - { Defend against bogus message number } - if (msgtext = '') then - begin - err^.msg_parm.i[0] := int(msg_code); - msgtext := err^.jpeg_message_table^[JMSG_NOMESSAGE]; - end; - - { Check for string parameter, as indicated by %s in the message text } - isstring := Pos('%s', msgtext) > 0; - - { Format the message into the passed buffer } - if (isstring) then - buffer := Concat(msgtext, err^.msg_parm.s) - else - begin - {$IFDEF VER70} - FormatStr(buffer, msgtext, err^.msg_parm.i); - {$ELSE} - {$IFDEF NO_FORMAT} - buffer := msgtext; - {$ELSE} - buffer := Format(msgtext, [ - err^.msg_parm.i[0], err^.msg_parm.i[1], - err^.msg_parm.i[2], err^.msg_parm.i[3], - err^.msg_parm.i[4], err^.msg_parm.i[5], - err^.msg_parm.i[6], err^.msg_parm.i[7] ]); - {$ENDIF} - {$ENDIF} - end; -end; - - - -{ Reset error state variables at start of a new image. - This is called during compression startup to reset trace/error - processing to default state, without losing any application-specific - method pointers. An application might possibly want to override - this method if it has additional error processing state. } - - -{METHODDEF} -procedure reset_error_mgr (cinfo : j_common_ptr); -begin - cinfo^.err^.num_warnings := 0; - { trace_level is not reset since it is an application-supplied parameter } - cinfo^.err^.msg_code := 0; { may be useful as a flag for "no error" } -end; - - -{ Fill in the standard error-handling methods in a jpeg_error_mgr object. - Typical call is: - cinfo : jpeg_compress_struct; - err : jpeg_error_mgr; - - cinfo.err := jpeg_std_error(@err); - after which the application may override some of the methods. } - - -{GLOBAL} -function jpeg_std_error (var err : jpeg_error_mgr) : jpeg_error_mgr_ptr; -begin - err.error_exit := error_exit; - err.emit_message := emit_message; - err.output_message := output_message; - err.format_message := format_message; - err.reset_error_mgr := reset_error_mgr; - - err.trace_level := 0; { default := no tracing } - err.num_warnings := 0; { no warnings emitted yet } - err.msg_code := 0; { may be useful as a flag for "no error" } - - { Initialize message table pointers } - err.jpeg_message_table := @jpeg_std_message_table; - err.last_jpeg_message := pred(JMSG_LASTMSGCODE); - - err.addon_message_table := NIL; - err.first_addon_message := JMSG_NOMESSAGE; { for safety } - err.last_addon_message := JMSG_NOMESSAGE; - - jpeg_std_error := @err; -end; - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjfdctflt.pas b/3rd/Imaging/Source/JpegLib/imjfdctflt.pas deleted file mode 100644 index 28f881b15..000000000 --- a/3rd/Imaging/Source/JpegLib/imjfdctflt.pas +++ /dev/null @@ -1,176 +0,0 @@ -unit imjfdctflt; - -{$N+} -{ This file contains a floating-point implementation of the - forward DCT (Discrete Cosine Transform). - - This implementation should be more accurate than either of the integer - DCT implementations. However, it may not give the same results on all - machines because of differences in roundoff behavior. Speed will depend - on the hardware's floating point capacity. - - A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT - on each column. Direct algorithms are also available, but they are - much more complex and seem not to be any faster when reduced to code. - - This implementation is based on Arai, Agui, and Nakajima's algorithm for - scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in - Japanese, but the algorithm is described in the Pennebaker & Mitchell - JPEG textbook (see REFERENCES section in file README). The following code - is based directly on figure 4-8 in P&M. - While an 8-point DCT cannot be done in less than 11 multiplies, it is - possible to arrange the computation so that many of the multiplies are - simple scalings of the final outputs. These multiplies can then be - folded into the multiplications or divisions by the JPEG quantization - table entries. The AA&N method leaves only 5 multiplies and 29 adds - to be done in the DCT itself. - The primary disadvantage of this method is that with a fixed-point - implementation, accuracy is lost due to imprecise representation of the - scaled quantization values. However, that problem does not arise if - we use floating point arithmetic. } - -{ Original : jfdctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - - -{ Perform the forward DCT on one block of samples.} - -{GLOBAL} -procedure jpeg_fdct_float (var data : array of FAST_FLOAT); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - - -{ Perform the forward DCT on one block of samples.} - -{GLOBAL} -procedure jpeg_fdct_float (var data : array of FAST_FLOAT); -type - PWorkspace = ^TWorkspace; - TWorkspace = array [0..DCTSIZE2-1] of FAST_FLOAT; -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT; - tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT; - z1, z2, z3, z4, z5, z11, z13 : FAST_FLOAT; - dataptr : PWorkspace; - ctr : int; -begin - { Pass 1: process rows. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[0] + dataptr^[7]; - tmp7 := dataptr^[0] - dataptr^[7]; - tmp1 := dataptr^[1] + dataptr^[6]; - tmp6 := dataptr^[1] - dataptr^[6]; - tmp2 := dataptr^[2] + dataptr^[5]; - tmp5 := dataptr^[2] - dataptr^[5]; - tmp3 := dataptr^[3] + dataptr^[4]; - tmp4 := dataptr^[3] - dataptr^[4]; - - { Even part } - - tmp10 := tmp0 + tmp3; { phase 2 } - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[0] := tmp10 + tmp11; { phase 3 } - dataptr^[4] := tmp10 - tmp11; - - z1 := (tmp12 + tmp13) * ({FAST_FLOAT}(0.707106781)); { c4 } - dataptr^[2] := tmp13 + z1; { phase 5 } - dataptr^[6] := tmp13 - z1; - - { Odd part } - - tmp10 := tmp4 + tmp5; { phase 2 } - tmp11 := tmp5 + tmp6; - tmp12 := tmp6 + tmp7; - - { The rotator is modified from fig 4-8 to avoid extra negations. } - z5 := (tmp10 - tmp12) * ( {FAST_FLOAT}(0.382683433)); { c6 } - z2 := {FAST_FLOAT}(0.541196100) * tmp10 + z5; { c2-c6 } - z4 := {FAST_FLOAT}(1.306562965) * tmp12 + z5; { c2+c6 } - z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 } - - z11 := tmp7 + z3; { phase 5 } - z13 := tmp7 - z3; - - dataptr^[5] := z13 + z2; { phase 6 } - dataptr^[3] := z13 - z2; - dataptr^[1] := z11 + z4; - dataptr^[7] := z11 - z4; - - Inc(FAST_FLOAT_PTR(dataptr), DCTSIZE); { advance pointer to next row } - end; - - { Pass 2: process columns. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; - tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; - tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; - tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; - tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; - tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; - tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; - tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4]; - - { Even part } - - tmp10 := tmp0 + tmp3; { phase 2 } - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 } - dataptr^[DCTSIZE*4] := tmp10 - tmp11; - - z1 := (tmp12 + tmp13) * {FAST_FLOAT} (0.707106781); { c4 } - dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 } - dataptr^[DCTSIZE*6] := tmp13 - z1; - - { Odd part } - - tmp10 := tmp4 + tmp5; { phase 2 } - tmp11 := tmp5 + tmp6; - tmp12 := tmp6 + tmp7; - - { The rotator is modified from fig 4-8 to avoid extra negations. } - z5 := (tmp10 - tmp12) * {FAST_FLOAT} (0.382683433); { c6 } - z2 := {FAST_FLOAT} (0.541196100) * tmp10 + z5; { c2-c6 } - z4 := {FAST_FLOAT} (1.306562965) * tmp12 + z5; { c2+c6 } - z3 := tmp11 * {FAST_FLOAT} (0.707106781); { c4 } - - z11 := tmp7 + z3; { phase 5 } - z13 := tmp7 - z3; - - dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 } - dataptr^[DCTSIZE*3] := z13 - z2; - dataptr^[DCTSIZE*1] := z11 + z4; - dataptr^[DCTSIZE*7] := z11 - z4; - - Inc(FAST_FLOAT_PTR(dataptr)); { advance pointer to next column } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjfdctfst.pas b/3rd/Imaging/Source/JpegLib/imjfdctfst.pas deleted file mode 100644 index 51e4bc61b..000000000 --- a/3rd/Imaging/Source/JpegLib/imjfdctfst.pas +++ /dev/null @@ -1,237 +0,0 @@ -unit imjfdctfst; - -{ This file contains a fast, not so accurate integer implementation of the - forward DCT (Discrete Cosine Transform). - - A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT - on each column. Direct algorithms are also available, but they are - much more complex and seem not to be any faster when reduced to code. - - This implementation is based on Arai, Agui, and Nakajima's algorithm for - scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in - Japanese, but the algorithm is described in the Pennebaker & Mitchell - JPEG textbook (see REFERENCES section in file README). The following code - is based directly on figure 4-8 in P&M. - While an 8-point DCT cannot be done in less than 11 multiplies, it is - possible to arrange the computation so that many of the multiplies are - simple scalings of the final outputs. These multiplies can then be - folded into the multiplications or divisions by the JPEG quantization - table entries. The AA&N method leaves only 5 multiplies and 29 adds - to be done in the DCT itself. - The primary disadvantage of this method is that with fixed-point math, - accuracy is lost due to imprecise representation of the scaled - quantization values. The smaller the quantization table entry, the less - precise the scaled value, so this implementation does worse with high- - quality-setting files than with low-quality ones. } - -{ Original: jfdctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - - -{ Perform the forward DCT on one block of samples. } - -{GLOBAL} -procedure jpeg_fdct_ifast (var data : array of DCTELEM); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - - -{ Scaling decisions are generally the same as in the LL&M algorithm; - see jfdctint.c for more details. However, we choose to descale - (right shift) multiplication products as soon as they are formed, - rather than carrying additional fractional bits into subsequent additions. - This compromises accuracy slightly, but it lets us save a few shifts. - More importantly, 16-bit arithmetic is then adequate (for 8-bit samples) - everywhere except in the multiplications proper; this saves a good deal - of work on 16-bit-int machines. - - Again to save a few shifts, the intermediate results between pass 1 and - pass 2 are not upscaled, but are represented only to integral precision. - - A final compromise is to represent the multiplicative constants to only - 8 fractional bits, rather than 13. This saves some shifting work on some - machines, and may also reduce the cost of multiplication (since there - are fewer one-bits in the constants). } - -const - CONST_BITS = 8; -const - CONST_SCALE = (INT32(1) shl CONST_BITS); - - -const - FIX_0_382683433 = INT32(Round(CONST_SCALE * 0.382683433)); {98} - FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {139} - FIX_0_707106781 = INT32(Round(CONST_SCALE * 0.707106781)); {181} - FIX_1_306562965 = INT32(Round(CONST_SCALE * 1.306562965)); {334} - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{ We can gain a little more speed, with a further compromise in accuracy, - by omitting the addition in a descaling shift. This yields an incorrectly - rounded result half the time... } -{$ifndef USE_ACCURATE_ROUNDING} - shift_temp := x; -{$else} - shift_temp := x + (INT32(1) shl (n-1)); -{$endif} - -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else -{$endif} - Descale := (shift_temp shr n); -end; - -{ Multiply a DCTELEM variable by an INT32 constant, and immediately - descale to yield a DCTELEM result. } - - - function MULTIPLY(X : DCTELEM; Y: INT32): DCTELEM; - begin - Multiply := DeScale((X) * (Y), CONST_BITS); - end; - - -{ Perform the forward DCT on one block of samples. } - -{GLOBAL} -procedure jpeg_fdct_ifast (var data : array of DCTELEM); -type - PWorkspace = ^TWorkspace; - TWorkspace = array [0..DCTSIZE2-1] of DCTELEM; -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM; - tmp10, tmp11, tmp12, tmp13 : DCTELEM; - z1, z2, z3, z4, z5, z11, z13 : DCTELEM; - dataptr : PWorkspace; - ctr : int; - {SHIFT_TEMPS} -begin - { Pass 1: process rows. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[0] + dataptr^[7]; - tmp7 := dataptr^[0] - dataptr^[7]; - tmp1 := dataptr^[1] + dataptr^[6]; - tmp6 := dataptr^[1] - dataptr^[6]; - tmp2 := dataptr^[2] + dataptr^[5]; - tmp5 := dataptr^[2] - dataptr^[5]; - tmp3 := dataptr^[3] + dataptr^[4]; - tmp4 := dataptr^[3] - dataptr^[4]; - - { Even part } - - tmp10 := tmp0 + tmp3; { phase 2 } - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[0] := tmp10 + tmp11; { phase 3 } - dataptr^[4] := tmp10 - tmp11; - - z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 } - dataptr^[2] := tmp13 + z1; { phase 5 } - dataptr^[6] := tmp13 - z1; - - { Odd part } - - tmp10 := tmp4 + tmp5; { phase 2 } - tmp11 := tmp5 + tmp6; - tmp12 := tmp6 + tmp7; - - { The rotator is modified from fig 4-8 to avoid extra negations. } - z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 } - z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 } - z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 } - z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 } - - z11 := tmp7 + z3; { phase 5 } - z13 := tmp7 - z3; - - dataptr^[5] := z13 + z2; { phase 6 } - dataptr^[3] := z13 - z2; - dataptr^[1] := z11 + z4; - dataptr^[7] := z11 - z4; - - Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row } - end; - - { Pass 2: process columns. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; - tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; - tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; - tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; - tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; - tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; - tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; - tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4]; - - { Even part } - - tmp10 := tmp0 + tmp3; { phase 2 } - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[DCTSIZE*0] := tmp10 + tmp11; { phase 3 } - dataptr^[DCTSIZE*4] := tmp10 - tmp11; - - z1 := MULTIPLY(tmp12 + tmp13, FIX_0_707106781); { c4 } - dataptr^[DCTSIZE*2] := tmp13 + z1; { phase 5 } - dataptr^[DCTSIZE*6] := tmp13 - z1; - - { Odd part } - - tmp10 := tmp4 + tmp5; { phase 2 } - tmp11 := tmp5 + tmp6; - tmp12 := tmp6 + tmp7; - - { The rotator is modified from fig 4-8 to avoid extra negations. } - z5 := MULTIPLY(tmp10 - tmp12, FIX_0_382683433); { c6 } - z2 := MULTIPLY(tmp10, FIX_0_541196100) + z5; { c2-c6 } - z4 := MULTIPLY(tmp12, FIX_1_306562965) + z5; { c2+c6 } - z3 := MULTIPLY(tmp11, FIX_0_707106781); { c4 } - - z11 := tmp7 + z3; { phase 5 } - z13 := tmp7 - z3; - - dataptr^[DCTSIZE*5] := z13 + z2; { phase 6 } - dataptr^[DCTSIZE*3] := z13 - z2; - dataptr^[DCTSIZE*1] := z11 + z4; - dataptr^[DCTSIZE*7] := z11 - z4; - - Inc(DCTELEMPTR(dataptr)); { advance pointer to next column } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjfdctint.pas b/3rd/Imaging/Source/JpegLib/imjfdctint.pas deleted file mode 100644 index bc946383b..000000000 --- a/3rd/Imaging/Source/JpegLib/imjfdctint.pas +++ /dev/null @@ -1,297 +0,0 @@ -unit imjfdctint; - - -{ This file contains a slow-but-accurate integer implementation of the - forward DCT (Discrete Cosine Transform). - - A 2-D DCT can be done by 1-D DCT on each row followed by 1-D DCT - on each column. Direct algorithms are also available, but they are - much more complex and seem not to be any faster when reduced to code. - - This implementation is based on an algorithm described in - C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT - Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics, - Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991. - The primary algorithm described there uses 11 multiplies and 29 adds. - We use their alternate method with 12 multiplies and 32 adds. - The advantage of this method is that no data path contains more than one - multiplication; this allows a very simple and accurate implementation in - scaled fixed-point arithmetic, with a minimal number of shifts. } - -{ Original : jfdctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjutils, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - - -{ Perform the forward DCT on one block of samples. } - -{GLOBAL} -procedure jpeg_fdct_islow (var data : array of DCTELEM); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - - -{ The poop on this scaling stuff is as follows: - - Each 1-D DCT step produces outputs which are a factor of sqrt(N) - larger than the true DCT outputs. The final outputs are therefore - a factor of N larger than desired; since N=8 this can be cured by - a simple right shift at the end of the algorithm. The advantage of - this arrangement is that we save two multiplications per 1-D DCT, - because the y0 and y4 outputs need not be divided by sqrt(N). - In the IJG code, this factor of 8 is removed by the quantization step - (in jcdctmgr.c), NOT in this module. - - We have to do addition and subtraction of the integer inputs, which - is no problem, and multiplication by fractional constants, which is - a problem to do in integer arithmetic. We multiply all the constants - by CONST_SCALE and convert them to integer constants (thus retaining - CONST_BITS bits of precision in the constants). After doing a - multiplication we have to divide the product by CONST_SCALE, with proper - rounding, to produce the correct output. This division can be done - cheaply as a right shift of CONST_BITS bits. We postpone shifting - as long as possible so that partial sums can be added together with - full fractional precision. - - The outputs of the first pass are scaled up by PASS1_BITS bits so that - they are represented to better-than-integral precision. These outputs - require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word - with the recommended scaling. (For 12-bit sample data, the intermediate - array is INT32 anyway.) - - To avoid overflow of the 32-bit intermediate results in pass 2, we must - have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis - shows that the values given below are the most effective. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - CONST_BITS = 13; - PASS1_BITS = 2; -{$else} -const - CONST_BITS = 13; - PASS1_BITS = 1; { lose a little precision to avoid overflow } -{$endif} - -const - CONST_SCALE = (INT32(1) shl CONST_BITS); - -const - FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446} - FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196} - FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433} - FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270} - FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373} - FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633} - FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299} - FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137} - FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069} - FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819} - FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995} - FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172} - - -{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result. - For 8-bit samples with the recommended scaling, all the variable - and constant values involved are no more than 16 bits wide, so a - 16x16->32 bit multiply can be used instead of a full 32x32 multiply. - For 12-bit samples, a full 32-bit multiplication will be needed. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} - - {MULTIPLY16C16(var,const)} - function Multiply(X, Y: int): INT32; - begin - Multiply := int(X) * INT32(Y); - end; - -{$else} - function Multiply(X, Y: INT32): INT32; - begin - Multiply := X * Y; - end; -{$endif} - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - shift_temp := x + (INT32(1) shl (n-1)); - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - Descale := (shift_temp shr n); -{$else} - Descale := (x + (INT32(1) shl (n-1)) shr n; -{$endif} -end; - - -{ Perform the forward DCT on one block of samples. } - -{GLOBAL} -procedure jpeg_fdct_islow (var data : array of DCTELEM); -type - PWorkspace = ^TWorkspace; - TWorkspace = array [0..DCTSIZE2-1] of DCTELEM; -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : INT32; - tmp10, tmp11, tmp12, tmp13 : INT32; - z1, z2, z3, z4, z5 : INT32; - dataptr : PWorkspace; - ctr : int; - {SHIFT_TEMPS} -begin - - { Pass 1: process rows. } - { Note results are scaled up by sqrt(8) compared to a true DCT; } - { furthermore, we scale the results by 2**PASS1_BITS. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[0] + dataptr^[7]; - tmp7 := dataptr^[0] - dataptr^[7]; - tmp1 := dataptr^[1] + dataptr^[6]; - tmp6 := dataptr^[1] - dataptr^[6]; - tmp2 := dataptr^[2] + dataptr^[5]; - tmp5 := dataptr^[2] - dataptr^[5]; - tmp3 := dataptr^[3] + dataptr^[4]; - tmp4 := dataptr^[3] - dataptr^[4]; - - { Even part per LL&M figure 1 --- note that published figure is faulty; - rotator "sqrt(2)*c1" should be "sqrt(2)*c6". } - - tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[0] := DCTELEM ((tmp10 + tmp11) shl PASS1_BITS); - dataptr^[4] := DCTELEM ((tmp10 - tmp11) shl PASS1_BITS); - - z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100); - dataptr^[2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865), - CONST_BITS-PASS1_BITS)); - dataptr^[6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065), - CONST_BITS-PASS1_BITS)); - - { Odd part per figure 8 --- note paper omits factor of sqrt(2). - cK represents cos(K*pi/16). - i0..i3 in the paper are tmp4..tmp7 here. } - - z1 := tmp4 + tmp7; - z2 := tmp5 + tmp6; - z3 := tmp4 + tmp6; - z4 := tmp5 + tmp7; - z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } - - tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } - z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } - z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } - z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } - - Inc(z3, z5); - Inc(z4, z5); - - dataptr^[7] := DCTELEM(DESCALE(tmp4 + z1 + z3, CONST_BITS-PASS1_BITS)); - dataptr^[5] := DCTELEM(DESCALE(tmp5 + z2 + z4, CONST_BITS-PASS1_BITS)); - dataptr^[3] := DCTELEM(DESCALE(tmp6 + z2 + z3, CONST_BITS-PASS1_BITS)); - dataptr^[1] := DCTELEM(DESCALE(tmp7 + z1 + z4, CONST_BITS-PASS1_BITS)); - - Inc(DCTELEMPTR(dataptr), DCTSIZE); { advance pointer to next row } - end; - - { Pass 2: process columns. - We remove the PASS1_BITS scaling, but leave the results scaled up - by an overall factor of 8. } - - dataptr := PWorkspace(@data); - for ctr := DCTSIZE-1 downto 0 do - begin - tmp0 := dataptr^[DCTSIZE*0] + dataptr^[DCTSIZE*7]; - tmp7 := dataptr^[DCTSIZE*0] - dataptr^[DCTSIZE*7]; - tmp1 := dataptr^[DCTSIZE*1] + dataptr^[DCTSIZE*6]; - tmp6 := dataptr^[DCTSIZE*1] - dataptr^[DCTSIZE*6]; - tmp2 := dataptr^[DCTSIZE*2] + dataptr^[DCTSIZE*5]; - tmp5 := dataptr^[DCTSIZE*2] - dataptr^[DCTSIZE*5]; - tmp3 := dataptr^[DCTSIZE*3] + dataptr^[DCTSIZE*4]; - tmp4 := dataptr^[DCTSIZE*3] - dataptr^[DCTSIZE*4]; - - { Even part per LL&M figure 1 --- note that published figure is faulty; - rotator "sqrt(2)*c1" should be "sqrt(2)*c6". } - - tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - dataptr^[DCTSIZE*0] := DCTELEM (DESCALE(tmp10 + tmp11, PASS1_BITS)); - dataptr^[DCTSIZE*4] := DCTELEM (DESCALE(tmp10 - tmp11, PASS1_BITS)); - - z1 := MULTIPLY(tmp12 + tmp13, FIX_0_541196100); - dataptr^[DCTSIZE*2] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp13, FIX_0_765366865), - CONST_BITS+PASS1_BITS)); - dataptr^[DCTSIZE*6] := DCTELEM (DESCALE(z1 + MULTIPLY(tmp12, - FIX_1_847759065), - CONST_BITS+PASS1_BITS)); - - { Odd part per figure 8 --- note paper omits factor of sqrt(2). - cK represents cos(K*pi/16). - i0..i3 in the paper are tmp4..tmp7 here. } - - z1 := tmp4 + tmp7; - z2 := tmp5 + tmp6; - z3 := tmp4 + tmp6; - z4 := tmp5 + tmp7; - z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } - - tmp4 := MULTIPLY(tmp4, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - tmp5 := MULTIPLY(tmp5, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - tmp6 := MULTIPLY(tmp6, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - tmp7 := MULTIPLY(tmp7, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } - z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } - z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } - z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } - - Inc(z3, z5); - Inc(z4, z5); - - dataptr^[DCTSIZE*7] := DCTELEM (DESCALE(tmp4 + z1 + z3, - CONST_BITS+PASS1_BITS)); - dataptr^[DCTSIZE*5] := DCTELEM (DESCALE(tmp5 + z2 + z4, - CONST_BITS+PASS1_BITS)); - dataptr^[DCTSIZE*3] := DCTELEM (DESCALE(tmp6 + z2 + z3, - CONST_BITS+PASS1_BITS)); - dataptr^[DCTSIZE*1] := DCTELEM (DESCALE(tmp7 + z1 + z4, - CONST_BITS+PASS1_BITS)); - - Inc(DCTELEMPTR(dataptr)); { advance pointer to next column } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjidctasm.pas b/3rd/Imaging/Source/JpegLib/imjidctasm.pas deleted file mode 100644 index 3cf4e703f..000000000 --- a/3rd/Imaging/Source/JpegLib/imjidctasm.pas +++ /dev/null @@ -1,793 +0,0 @@ -unit imjidctasm; - -{ This file contains a slow-but-accurate integer implementation of the - inverse DCT (Discrete Cosine Transform). In the IJG code, this routine - must also perform dequantization of the input coefficients. - - A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT - on each row (or vice versa, but it's more convenient to emit a row at - a time). Direct algorithms are also available, but they are much more - complex and seem not to be any faster when reduced to code. - - This implementation is based on an algorithm described in - C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT - Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics, - Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991. - The primary algorithm described there uses 11 multiplies and 29 adds. - We use their alternate method with 12 multiplies and 32 adds. - The advantage of this method is that no data path contains more than one - multiplication; this allows a very simple and accurate implementation in - scaled fixed-point arithmetic, with a minimal number of shifts. } - -{ Original : jidctint.c ; Copyright (C) 1991-1996, Thomas G. Lane. } -{ ;------------------------------------------------------------------------- - ; JIDCTINT.ASM - ; 80386 protected mode assembly translation of JIDCTINT.C - ; **** Optimized to all hell by Jason M. Felice (jasonf@apk.net) **** - ; **** E-mail welcome **** - ; - ; ** This code does not make O/S calls -- use it for OS/2, Win95, WinNT, - ; ** DOS prot. mode., Linux, whatever... have fun. - ; - ; ** Note, this code is dependant on the structure member order in the .h - ; ** files for the following structures: - ; -- amazingly NOT j_decompress_struct... cool. - ; -- jpeg_component_info (dependant on position of dct_table element) - ; - ; Originally created with the /Fa option of MSVC 4.0 (why work when you - ; don't have to?) - ; - ; (this code, when compiled is 1K bytes smaller than the optimized MSVC - ; release build, not to mention 120-130 ms faster in my profile test with 1 - ; small color and and 1 medium black-and-white jpeg: stats using TASM 4.0 - ; and MSVC 4.0 to create a non-console app; jpeg_idct_islow accumulated - ; 5,760 hits on all trials) - ; - ; TASM -t -ml -os jidctint.asm, jidctint.obj - ;------------------------------------------------------------------------- - Converted to Delphi 2.0 BASM for PasJPEG - by Jacques NOMSSI NZALI - October 13th 1996 - * assumes Delphi "register" calling convention - first 3 parameter are in EAX,EDX,ECX - * register allocation revised -} - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_islow (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - -{ The poop on this scaling stuff is as follows: - - Each 1-D IDCT step produces outputs which are a factor of sqrt(N) - larger than the true IDCT outputs. The final outputs are therefore - a factor of N larger than desired; since N=8 this can be cured by - a simple right shift at the end of the algorithm. The advantage of - this arrangement is that we save two multiplications per 1-D IDCT, - because the y0 and y4 inputs need not be divided by sqrt(N). - - We have to do addition and subtraction of the integer inputs, which - is no problem, and multiplication by fractional constants, which is - a problem to do in integer arithmetic. We multiply all the constants - by CONST_SCALE and convert them to integer constants (thus retaining - CONST_BITS bits of precision in the constants). After doing a - multiplication we have to divide the product by CONST_SCALE, with proper - rounding, to produce the correct output. This division can be done - cheaply as a right shift of CONST_BITS bits. We postpone shifting - as long as possible so that partial sums can be added together with - full fractional precision. - - The outputs of the first pass are scaled up by PASS1_BITS bits so that - they are represented to better-than-integral precision. These outputs - require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word - with the recommended scaling. (To scale up 12-bit sample data further, an - intermediate INT32 array would be needed.) - - To avoid overflow of the 32-bit intermediate results in pass 2, we must - have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis - shows that the values given below are the most effective. } - -const - CONST_BITS = 13; - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - PASS1_BITS = 2; -{$else} -const - PASS1_BITS = 1; { lose a little precision to avoid overflow } -{$endif} - -const - CONST_SCALE = (INT32(1) shl CONST_BITS); - -const - FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446} - FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196} - FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433} - FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270} - FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373} - FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633} - FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299} - FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137} - FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069} - FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819} - FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995} - FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172} - - -{ for DESCALE } -const - ROUND_CONST = (INT32(1) shl (CONST_BITS-PASS1_BITS-1)); -const - ROUND_CONST_2 = (INT32(1) shl (CONST_BITS+PASS1_BITS+3-1)); - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_islow (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = coef_bits_field; { buffers data between passes } -const - coefDCTSIZE = DCTSIZE*SizeOf(JCOEF); - wrkDCTSIZE = DCTSIZE*SizeOf(int); -var - tmp0, tmp1, tmp2, tmp3 : INT32; - tmp10, tmp11, tmp12, tmp13 : INT32; - z1, z2, z3, z4, z5 : INT32; -var - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; -var - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; -var - dcval : int; -var - dcval_ : JSAMPLE; -asm - push edi - push esi - push ebx - - cld { The only direction we use, might as well set it now, as opposed } - { to inside 2 loops. } - -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - {range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE]));} - mov eax, [eax].jpeg_decompress_struct.sample_range_limit {eax=cinfo} - add eax, (MAXJSAMPLE+1 + CENTERJSAMPLE)*(Type JSAMPLE) - mov range_limit, eax - - { Pass 1: process columns from input, store into work array. } - { Note results are scaled up by sqrt(8) compared to a true IDCT; } - { furthermore, we scale the results by 2**PASS1_BITS. } - - {inptr := coef_block;} - mov esi, ecx { ecx=coef_block } - {quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table);} - mov edi, [edx].jpeg_component_info.dct_table { edx=compptr } - - {wsptr := PWorkspace(@workspace);} - lea ecx, workspace - - {for ctr := pred(DCTSIZE) downto 0 do - begin} - mov ctr, DCTSIZE -@loop518: - { Due to quantization, we will usually find that many of the input - coefficients are zero, especially the AC terms. We can exploit this - by short-circuiting the IDCT calculation for any column in which all - the AC terms are zero. In that case each output is equal to the - DC coefficient (with scale factor as needed). - With typical images and quantization tables, half or more of the - column DCT calculations can be simplified this way. } - - {if ((inptr^[DCTSIZE*1]) or (inptr^[DCTSIZE*2]) or (inptr^[DCTSIZE*3]) or - (inptr^[DCTSIZE*4]) or (inptr^[DCTSIZE*5]) or (inptr^[DCTSIZE*6]) or - (inptr^[DCTSIZE*7]) = 0) then - begin} - mov eax, DWORD PTR [esi+coefDCTSIZE*1] - or eax, DWORD PTR [esi+coefDCTSIZE*2] - or eax, DWORD PTR [esi+coefDCTSIZE*3] - mov edx, DWORD PTR [esi+coefDCTSIZE*4] - or eax, edx - or eax, DWORD PTR [esi+coefDCTSIZE*5] - or eax, DWORD PTR [esi+coefDCTSIZE*6] - or eax, DWORD PTR [esi+coefDCTSIZE*7] - jne @loop520 - - { AC terms all zero } - {dcval := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * - (quantptr^[DCTSIZE*0]) shl PASS1_BITS;} - mov eax, DWORD PTR [esi+coefDCTSIZE*0] - imul eax, DWORD PTR [edi+wrkDCTSIZE*0] - shl eax, PASS1_BITS - - {wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - wsptr^[DCTSIZE*2] := dcval; - wsptr^[DCTSIZE*3] := dcval; - wsptr^[DCTSIZE*4] := dcval; - wsptr^[DCTSIZE*5] := dcval; - wsptr^[DCTSIZE*6] := dcval; - wsptr^[DCTSIZE*7] := dcval;} - - mov DWORD PTR [ecx+ wrkDCTSIZE*0], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*1], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*2], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*3], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*4], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*5], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*6], eax - mov DWORD PTR [ecx+ wrkDCTSIZE*7], eax - - {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - continue;} - dec ctr - je @loop519 - - add esi, Type JCOEF - add edi, Type ISLOW_MULT_TYPE - add ecx, Type int { int_ptr } - jmp @loop518 - -@loop520: - - {end;} - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]; - - z1 := (z2 + z3) * INT32(FIX_0_541196100); - tmp2 := z1 + INT32(z3) * INT32(- FIX_1_847759065); - tmp3 := z1 + INT32(z2) * INT32(FIX_0_765366865);} - - mov edx, DWORD PTR [esi+coefDCTSIZE*2] - imul edx, DWORD PTR [edi+wrkDCTSIZE*2] {z2} - - mov eax, DWORD PTR [esi+coefDCTSIZE*6] - imul eax, DWORD PTR [edi+wrkDCTSIZE*6] {z3} - - lea ebx, [eax+edx] - imul ebx, FIX_0_541196100 {z1} - - imul eax, (-FIX_1_847759065) - add eax, ebx - mov tmp2, eax - - imul edx, FIX_0_765366865 - add edx, ebx - mov tmp3, edx - - {z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*4]) * quantptr^[DCTSIZE*4];} - - mov edx, DWORD PTR [esi+coefDCTSIZE*4] - imul edx, DWORD PTR [edi+wrkDCTSIZE*4] { z3 = edx } - - mov eax, DWORD PTR [esi+coefDCTSIZE*0] - imul eax, DWORD PTR [edi+wrkDCTSIZE*0] { z2 = eax } - - {tmp0 := (z2 + z3) shl CONST_BITS; - tmp1 := (z2 - z3) shl CONST_BITS;} - lea ebx,[eax+edx] - sub eax, edx - shl ebx, CONST_BITS { tmp0 = ebx } - shl eax, CONST_BITS { tmp1 = eax } - - {tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3;} - mov edx, tmp3 - sub ebx, edx - mov tmp13, ebx - add edx, edx - add ebx, edx - mov tmp10, ebx - - {tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2;} - mov ebx, tmp2 - sub eax, ebx - mov tmp12, eax - add ebx, ebx - add eax, ebx - mov tmp11, eax - - { Odd part per figure 8; the matrix is unitary and hence its - transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } - - {tmp0 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7];} - mov eax, DWORD PTR [esi+coefDCTSIZE*7] - imul eax, DWORD PTR [edi+wrkDCTSIZE*7] - mov edx, eax { edx = tmp0 } - {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - imul eax, FIX_0_298631336 - mov tmp0, eax - - {tmp3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1];} - mov eax, DWORD PTR [esi+coefDCTSIZE*1] - imul eax, DWORD PTR [edi+wrkDCTSIZE*1] - mov tmp3, eax - - {z1 := tmp0 + tmp3;} - {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } - add eax, edx - imul eax, (-FIX_0_899976223) - mov z1, eax - - {tmp1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5];} - mov eax, DWORD PTR [esi+coefDCTSIZE*5] - imul eax, DWORD PTR [edi+wrkDCTSIZE*5] - mov ebx, eax { ebx = tmp1 } - {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - imul eax, FIX_2_053119869 - mov tmp1, eax - - {tmp2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3];} - mov eax, DWORD PTR [esi+coefDCTSIZE*3] - imul eax, DWORD PTR [edi+wrkDCTSIZE*3] - mov tmp2, eax - - {z3 := tmp0 + tmp2;} - add edx, eax { edx = z3 } - - {z2 := tmp1 + tmp2;} - {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } - add eax, ebx - imul eax, (-FIX_2_562915447) - mov z2, eax - - {z4 := tmp1 + tmp3;} - add ebx, tmp3 { ebx = z4 } - - {z5 := INT32(z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } - lea eax, [edx+ebx] - imul eax, FIX_1_175875602 { eax = z5 } - - {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } - {Inc(z4, z5);} - imul ebx, (-FIX_0_390180644) - add ebx, eax - mov z4, ebx - - {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } - {Inc(z3, z5);} - imul edx, (-FIX_1_961570560) - add eax, edx { z3 = eax } - - {Inc(tmp0, z1 + z3);} - mov ebx, z1 - add ebx, eax - add tmp0, ebx - - {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - {Inc(tmp2, z2 + z3);} - mov ebx, tmp2 - imul ebx, FIX_3_072711026 - mov edx, z2 { z2 = edx } - add ebx, edx - add eax, ebx - mov tmp2, eax - - {Inc(tmp1, z2 + z4);} - mov eax, z4 { z4 = eax } - add edx, eax - add tmp1, edx - - {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - {Inc(tmp3, z1 + z4);} - mov edx, tmp3 - imul edx, FIX_1_501321110 - - add edx, eax - add edx, z1 { tmp3 = edx } - - { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } - - {wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp3, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*7] := int (DESCALE(tmp10 - tmp3, CONST_BITS-PASS1_BITS));} - mov eax, tmp10 - add eax, ROUND_CONST - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*0], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*7], eax - - {wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS));} - mov eax, tmp11 - add eax, ROUND_CONST - mov edx, tmp2 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*1], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*6], eax - - {wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS));} - mov eax, tmp12 - add eax, ROUND_CONST - mov edx, tmp1 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*2], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*5], eax - - {wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS));} - {wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS));} - mov eax, tmp13 - add eax, ROUND_CONST - mov edx, tmp0 - lea ebx, [eax+edx] - sar ebx, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*3], ebx - - sub eax, edx - sar eax, CONST_BITS-PASS1_BITS - mov DWORD PTR [ecx+wrkDCTSIZE*4], eax - - {Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - {Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr));} - dec ctr - je @loop519 - - add esi, Type JCOEF - add edi, Type ISLOW_MULT_TYPE - add ecx, Type int { int_ptr } - {end;} - jmp @loop518 -@loop519: - { Save to memory what we've registerized for the preceding loop. } - - { Pass 2: process rows from work array, store into output array. } - { Note that we must descale the results by a factor of 8 == 2**3, } - { and also undo the PASS1_BITS scaling. } - - {wsptr := @workspace;} - lea esi, workspace - - {for ctr := 0 to pred(DCTSIZE) do - begin} - mov ctr, 0 -@loop523: - - {outptr := output_buf^[ctr];} - mov eax, ctr - mov ebx, output_buf - mov edi, DWORD PTR [ebx+eax*4] { 4 = SizeOf(pointer) } - - {Inc(JSAMPLE_PTR(outptr), output_col);} - add edi, LongWord(output_col) - - { Rows of zeroes can be exploited in the same way as we did with columns. - However, the column calculation has created many nonzero AC terms, so - the simplification applies less often (typically 5% to 10% of the time). - On machines with very fast multiplication, it's possible that the - test takes more time than it's worth. In that case this section - may be commented out. } - -{$ifndef NO_ZERO_ROW_TEST} - {if ((wsptr^[1]) or (wsptr^[2]) or (wsptr^[3]) or (wsptr^[4]) or - (wsptr^[5]) or (wsptr^[6]) or (wsptr^[7]) = 0) then - begin} - mov eax, DWORD PTR [esi+4*1] - or eax, DWORD PTR [esi+4*2] - or eax, DWORD PTR [esi+4*3] - jne @loop525 { Nomssi: early exit path may help } - or eax, DWORD PTR [esi+4*4] - or eax, DWORD PTR [esi+4*5] - or eax, DWORD PTR [esi+4*6] - or eax, DWORD PTR [esi+4*7] - jne @loop525 - - { AC terms all zero } - {JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]), - PASS1_BITS+3)) and RANGE_MASK];} - mov eax, DWORD PTR [esi+4*0] - add eax, (INT32(1) shl (PASS1_BITS+3-1)) - sar eax, PASS1_BITS+3 - and eax, RANGE_MASK - mov ebx, range_limit - mov al, BYTE PTR [ebx+eax] - mov ah, al - - {outptr^[0] := dcval_; - outptr^[1] := dcval_; - outptr^[2] := dcval_; - outptr^[3] := dcval_; - outptr^[4] := dcval_; - outptr^[5] := dcval_; - outptr^[6] := dcval_; - outptr^[7] := dcval_;} - - stosw - stosw - stosw - stosw - - {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - {continue;} - add esi, wrkDCTSIZE - inc ctr - cmp ctr, DCTSIZE - jl @loop523 - jmp @loop524 - {end;} -@loop525: -{$endif} - - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - {z2 := INT32 (wsptr^[2]);} - mov edx, DWORD PTR [esi+4*2] { z2 = edx } - - {z3 := INT32 (wsptr^[6]);} - mov ecx, DWORD PTR [esi+4*6] { z3 = ecx } - - {z1 := (z2 + z3) * INT32(FIX_0_541196100);} - lea eax, [edx+ecx] - imul eax, FIX_0_541196100 - mov ebx, eax { z1 = ebx } - - {tmp2 := z1 + (z3) * INT32(- FIX_1_847759065);} - imul ecx, (-FIX_1_847759065) - add ecx, ebx { tmp2 = ecx } - - {tmp3 := z1 + (z2) * INT32(FIX_0_765366865);} - imul edx, FIX_0_765366865 - add ebx, edx { tmp3 = ebx } - - {tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS;} - {tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS;} - mov edx, DWORD PTR [esi+4*4] - mov eax, DWORD PTR [esi+4*0] - sub eax, edx - add edx, edx - add edx, eax - shl edx, CONST_BITS { tmp0 = edx } - shl eax, CONST_BITS { tmp1 = eax } - - {tmp10 := tmp0 + tmp3;} - {tmp13 := tmp0 - tmp3;} - sub edx, ebx - mov tmp13, edx - add ebx, ebx - add edx, ebx - mov tmp10, edx - - {tmp11 := tmp1 + tmp2;} - {tmp12 := tmp1 - tmp2;} - lea ebx, [ecx+eax] - mov tmp11, ebx - sub eax, ecx - mov tmp12, eax - - { Odd part per figure 8; the matrix is unitary and hence its - transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } - -{ The following lines no longer produce code, since wsptr has been - optimized to esi, it is more efficient to access these values - directly. - tmp0 := INT32(wsptr^[7]); - tmp1 := INT32(wsptr^[5]); - tmp2 := INT32(wsptr^[3]); - tmp3 := INT32(wsptr^[1]); } - - {z2 := tmp1 + tmp2;} - {z2 := (z2) * INT32(- FIX_2_562915447); { sqrt(2) * (-c1-c3) } - mov ebx, DWORD PTR [esi+4*3] { tmp2 } - mov ecx, DWORD PTR [esi+4*5] { tmp1 } - lea eax, [ebx+ecx] - imul eax, (-FIX_2_562915447) - mov z2, eax - - {z3 := tmp0 + tmp2;} - mov edx, DWORD PTR [esi+4*7] { tmp0 } - add ebx, edx { old z3 = ebx } - mov eax, ebx - {z3 := (z3) * INT32(- FIX_1_961570560); { sqrt(2) * (-c3-c5) } - imul eax, (-FIX_1_961570560) - mov z3, eax - - {z1 := tmp0 + tmp3;} - {z1 := (z1) * INT32(- FIX_0_899976223); { sqrt(2) * (c7-c3) } - mov eax, DWORD PTR [esi+4*1] { tmp3 } - add edx, eax - imul edx, (-FIX_0_899976223) { z1 = edx } - - {z4 := tmp1 + tmp3;} - add eax, ecx { +tmp1 } - add ebx, eax { z3 + z4 = ebx } - {z4 := (z4) * INT32(- FIX_0_390180644); { sqrt(2) * (c5-c3) } - imul eax, (-FIX_0_390180644) { z4 = eax } - - {z5 := (z3 + z4) * INT32(FIX_1_175875602); { sqrt(2) * c3 } - {Inc(z3, z5);} - imul ebx, FIX_1_175875602 - mov ecx, z3 - add ecx, ebx { ecx = z3 } - - {Inc(z4, z5);} - add ebx, eax { z4 = ebx } - - {tmp0 := (tmp0) * INT32(FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - {Inc(tmp0, z1 + z3);} - mov eax, DWORD PTR [esi+4*7] - imul eax, FIX_0_298631336 - add eax, edx - add eax, ecx - mov tmp0, eax - - {tmp1 := (tmp1) * INT32(FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - {Inc(tmp1, z2 + z4);} - mov eax, DWORD PTR [esi+4*5] - imul eax, FIX_2_053119869 - add eax, z2 - add eax, ebx - mov tmp1, eax - - {tmp2 := (tmp2) * INT32(FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - {Inc(tmp2, z2 + z3);} - mov eax, DWORD PTR [esi+4*3] - imul eax, FIX_3_072711026 - add eax, z2 - add ecx, eax { ecx = tmp2 } - - {tmp3 := (tmp3) * INT32(FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - {Inc(tmp3, z1 + z4);} - mov eax, DWORD PTR [esi+4*1] - imul eax, FIX_1_501321110 - add eax, edx - add ebx, eax { ebx = tmp3 } - - { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } - - {outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK]; } - {outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - - mov edx, tmp10 - add edx, ROUND_CONST_2 - lea eax, [ebx+edx] - sub edx, ebx - - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov ebx, range_limit { once for all } - mov al, BYTE PTR [ebx+eax] - mov [edi+0], al - - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov al, BYTE PTR [ebx+edx] - mov [edi+7], al - - {outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp11 - add eax, ROUND_CONST_2 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+1], dl - - {outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+6], al - - {outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp12 - add eax, ROUND_CONST_2 - mov ecx, tmp1 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+2], dl - - {outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+5], al - - {outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - mov eax, tmp13 - add eax, ROUND_CONST_2 - mov ecx, tmp0 - lea edx, [eax+ecx] - shr edx, CONST_BITS+PASS1_BITS+3 - and edx, RANGE_MASK - mov dl, BYTE PTR [ebx+edx] - mov [edi+3], dl - - {outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0, - CONST_BITS+PASS1_BITS+3)) and RANGE_MASK];} - sub eax, ecx - shr eax, CONST_BITS+PASS1_BITS+3 - and eax, RANGE_MASK - mov al, BYTE PTR [ebx+eax] - mov [edi+4], al - - {Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - add esi, wrkDCTSIZE - add edi, DCTSIZE - - {end;} - inc ctr - cmp ctr, DCTSIZE - jl @loop523 - -@loop524: -@loop496: - pop ebx - pop esi - pop edi -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjidctflt.pas b/3rd/Imaging/Source/JpegLib/imjidctflt.pas deleted file mode 100644 index 68e158849..000000000 --- a/3rd/Imaging/Source/JpegLib/imjidctflt.pas +++ /dev/null @@ -1,286 +0,0 @@ -unit imjidctflt; - -{$N+} -{ This file contains a floating-point implementation of the - inverse DCT (Discrete Cosine Transform). In the IJG code, this routine - must also perform dequantization of the input coefficients. - - This implementation should be more accurate than either of the integer - IDCT implementations. However, it may not give the same results on all - machines because of differences in roundoff behavior. Speed will depend - on the hardware's floating point capacity. - - A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT - on each row (or vice versa, but it's more convenient to emit a row at - a time). Direct algorithms are also available, but they are much more - complex and seem not to be any faster when reduced to code. - - This implementation is based on Arai, Agui, and Nakajima's algorithm for - scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in - Japanese, but the algorithm is described in the Pennebaker & Mitchell - JPEG textbook (see REFERENCES section in file README). The following code - is based directly on figure 4-8 in P&M. - While an 8-point DCT cannot be done in less than 11 multiplies, it is - possible to arrange the computation so that many of the multiplies are - simple scalings of the final outputs. These multiplies can then be - folded into the multiplications or divisions by the JPEG quantization - table entries. The AA&N method leaves only 5 multiplies and 29 adds - to be done in the DCT itself. - The primary disadvantage of this method is that with a fixed-point - implementation, accuracy is lost due to imprecise representation of the - scaled quantization values. However, that problem does not arise if - we use floating point arithmetic. } - -{ Original: jidctflt.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_float (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - - -{ Dequantize a coefficient by multiplying it by the multiplier-table - entry; produce a float result. } - -function DEQUANTIZE(coef : int; quantval : FAST_FLOAT) : FAST_FLOAT; -begin - Dequantize := ( (coef) * quantval); -end; - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - shift_temp := x + (INT32(1) shl (n-1)); - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - Descale := (shift_temp shr n); -{$else} - Descale := (x + (INT32(1) shl (n-1)) shr n; -{$endif} -end; - - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_float (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = array[0..DCTSIZE2-1] of FAST_FLOAT; -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : FAST_FLOAT; - tmp10, tmp11, tmp12, tmp13 : FAST_FLOAT; - z5, z10, z11, z12, z13 : FAST_FLOAT; - inptr : JCOEFPTR; - quantptr : FLOAT_MULT_TYPE_FIELD_PTR; - wsptr : PWorkSpace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {SHIFT_TEMPS} -var - dcval : FAST_FLOAT; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - - { Pass 1: process columns from input, store into work array. } - - inptr := coef_block; - quantptr := FLOAT_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := @workspace; - for ctr := pred(DCTSIZE) downto 0 do - begin - { Due to quantization, we will usually find that many of the input - coefficients are zero, especially the AC terms. We can exploit this - by short-circuiting the IDCT calculation for any column in which all - the AC terms are zero. In that case each output is equal to the - DC coefficient (with scale factor as needed). - With typical images and quantization tables, half or more of the - column DCT calculations can be simplified this way. } - - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and - (inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and - (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero } - FAST_FLOAT(dcval) := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - wsptr^[DCTSIZE*2] := dcval; - wsptr^[DCTSIZE*3] := dcval; - wsptr^[DCTSIZE*4] := dcval; - wsptr^[DCTSIZE*5] := dcval; - wsptr^[DCTSIZE*6] := dcval; - wsptr^[DCTSIZE*7] := dcval; - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(FLOAT_MULT_TYPE_PTR(quantptr)); - Inc(FAST_FLOAT_PTR(wsptr)); - continue; - end; - - { Even part } - - tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); - tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); - tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); - tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); - - tmp10 := tmp0 + tmp2; { phase 3 } - tmp11 := tmp0 - tmp2; - - tmp13 := tmp1 + tmp3; { phases 5-3 } - tmp12 := (tmp1 - tmp3) * ({FAST_FLOAT}(1.414213562)) - tmp13; { 2*c4 } - - tmp0 := tmp10 + tmp13; { phase 2 } - tmp3 := tmp10 - tmp13; - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - - tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); - tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); - tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); - tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); - - z13 := tmp6 + tmp5; { phase 6 } - z10 := tmp6 - tmp5; - z11 := tmp4 + tmp7; - z12 := tmp4 - tmp7; - - tmp7 := z11 + z13; { phase 5 } - tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); { 2*c4 } - - z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 } - tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) } - tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) } - - tmp6 := tmp12 - tmp7; { phase 2 } - tmp5 := tmp11 - tmp6; - tmp4 := tmp10 + tmp5; - - wsptr^[DCTSIZE*0] := tmp0 + tmp7; - wsptr^[DCTSIZE*7] := tmp0 - tmp7; - wsptr^[DCTSIZE*1] := tmp1 + tmp6; - wsptr^[DCTSIZE*6] := tmp1 - tmp6; - wsptr^[DCTSIZE*2] := tmp2 + tmp5; - wsptr^[DCTSIZE*5] := tmp2 - tmp5; - wsptr^[DCTSIZE*4] := tmp3 + tmp4; - wsptr^[DCTSIZE*3] := tmp3 - tmp4; - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(FLOAT_MULT_TYPE_PTR(quantptr)); - Inc(FAST_FLOAT_PTR(wsptr)); - end; - - { Pass 2: process rows from work array, store into output array. } - { Note that we must descale the results by a factor of 8 = 2**3. } - - wsptr := @workspace; - for ctr := 0 to pred(DCTSIZE) do - begin - outptr := JSAMPROW(@(output_buf^[ctr]^[output_col])); - { Rows of zeroes can be exploited in the same way as we did with columns. - However, the column calculation has created many nonzero AC terms, so - the simplification applies less often (typically 5% to 10% of the time). - And testing floats for zero is relatively expensive, so we don't bother. } - - { Even part } - - tmp10 := wsptr^[0] + wsptr^[4]; - tmp11 := wsptr^[0] - wsptr^[4]; - - tmp13 := wsptr^[2] + wsptr^[6]; - tmp12 := (wsptr^[2] - wsptr^[6]) * ({FAST_FLOAT}(1.414213562)) - tmp13; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - - z13 := wsptr^[5] + wsptr^[3]; - z10 := wsptr^[5] - wsptr^[3]; - z11 := wsptr^[1] + wsptr^[7]; - z12 := wsptr^[1] - wsptr^[7]; - - tmp7 := z11 + z13; - tmp11 := (z11 - z13) * ({FAST_FLOAT}(1.414213562)); - - z5 := (z10 + z12) * ({FAST_FLOAT}(1.847759065)); { 2*c2 } - tmp10 := ({FAST_FLOAT}(1.082392200)) * z12 - z5; { 2*(c2-c6) } - tmp12 := ({FAST_FLOAT}(-2.613125930)) * z10 + z5; { -2*(c2+c6) } - - tmp6 := tmp12 - tmp7; - tmp5 := tmp11 - tmp6; - tmp4 := tmp10 + tmp5; - - { Final output stage: scale down by a factor of 8 and range-limit } - - outptr^[0] := range_limit^[ int(DESCALE( INT32(Round((tmp0 + tmp7))), 3)) - and RANGE_MASK]; - outptr^[7] := range_limit^[ int(DESCALE( INT32(Round((tmp0 - tmp7))), 3)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE( INT32(Round((tmp1 + tmp6))), 3)) - and RANGE_MASK]; - outptr^[6] := range_limit^[ int(DESCALE( INT32(Round((tmp1 - tmp6))), 3)) - and RANGE_MASK]; - outptr^[2] := range_limit^[ int(DESCALE( INT32(Round((tmp2 + tmp5))), 3)) - and RANGE_MASK]; - outptr^[5] := range_limit^[ int(DESCALE( INT32(Round((tmp2 - tmp5))), 3)) - and RANGE_MASK]; - outptr^[4] := range_limit^[ int(DESCALE( INT32(Round((tmp3 + tmp4))), 3)) - and RANGE_MASK]; - outptr^[3] := range_limit^[ int(DESCALE( INT32(Round((tmp3 - tmp4))), 3)) - and RANGE_MASK]; - - Inc(FAST_FLOAT_PTR(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjidctfst.pas b/3rd/Imaging/Source/JpegLib/imjidctfst.pas deleted file mode 100644 index 6b1dd9b97..000000000 --- a/3rd/Imaging/Source/JpegLib/imjidctfst.pas +++ /dev/null @@ -1,410 +0,0 @@ -unit imjidctfst; - -{ This file contains a fast, not so accurate integer implementation of the - inverse DCT (Discrete Cosine Transform). In the IJG code, this routine - must also perform dequantization of the input coefficients. - - A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT - on each row (or vice versa, but it's more convenient to emit a row at - a time). Direct algorithms are also available, but they are much more - complex and seem not to be any faster when reduced to code. - - This implementation is based on Arai, Agui, and Nakajima's algorithm for - scaled DCT. Their original paper (Trans. IEICE E-71(11):1095) is in - Japanese, but the algorithm is described in the Pennebaker & Mitchell - JPEG textbook (see REFERENCES section in file README). The following code - is based directly on figure 4-8 in P&M. - While an 8-point DCT cannot be done in less than 11 multiplies, it is - possible to arrange the computation so that many of the multiplies are - simple scalings of the final outputs. These multiplies can then be - folded into the multiplications or divisions by the JPEG quantization - table entries. The AA&N method leaves only 5 multiplies and 29 adds - to be done in the DCT itself. - The primary disadvantage of this method is that with fixed-point math, - accuracy is lost due to imprecise representation of the scaled - quantization values. The smaller the quantization table entry, the less - precise the scaled value, so this implementation does worse with high- - quality-setting files than with low-quality ones. } - -{ Original : jidctfst.c ; Copyright (C) 1994-1996, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_ifast (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - -{ Scaling decisions are generally the same as in the LL&M algorithm; - see jidctint.c for more details. However, we choose to descale - (right shift) multiplication products as soon as they are formed, - rather than carrying additional fractional bits into subsequent additions. - This compromises accuracy slightly, but it lets us save a few shifts. - More importantly, 16-bit arithmetic is then adequate (for 8-bit samples) - everywhere except in the multiplications proper; this saves a good deal - of work on 16-bit-int machines. - - The dequantized coefficients are not integers because the AA&N scaling - factors have been incorporated. We represent them scaled up by PASS1_BITS, - so that the first and second IDCT rounds have the same input scaling. - For 8-bit JSAMPLEs, we choose IFAST_SCALE_BITS = PASS1_BITS so as to - avoid a descaling shift; this compromises accuracy rather drastically - for small quantization table entries, but it saves a lot of shifts. - For 12-bit JSAMPLEs, there's no hope of using 16x16 multiplies anyway, - so we use a much larger scaling factor to preserve accuracy. - - A final compromise is to represent the multiplicative constants to only - 8 fractional bits, rather than 13. This saves some shifting work on some - machines, and may also reduce the cost of multiplication (since there - are fewer one-bits in the constants). } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - CONST_BITS = 8; - PASS1_BITS = 2; -{$else} -const - CONST_BITS = 8; - PASS1_BITS = 1; { lose a little precision to avoid overflow } -{$endif} - - -const - FIX_1_082392200 = INT32(Round((INT32(1) shl CONST_BITS)*1.082392200)); {277} - FIX_1_414213562 = INT32(Round((INT32(1) shl CONST_BITS)*1.414213562)); {362} - FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS)*1.847759065)); {473} - FIX_2_613125930 = INT32(Round((INT32(1) shl CONST_BITS)*2.613125930)); {669} - - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{$ifdef USE_ACCURATE_ROUNDING} - shift_temp := x + (INT32(1) shl (n-1)); -{$else} -{ We can gain a little more speed, with a further compromise in accuracy, - by omitting the addition in a descaling shift. This yields an incorrectly - rounded result half the time... } - shift_temp := x; -{$endif} - -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else -{$endif} - Descale := (shift_temp shr n); -end; - - -{ Multiply a DCTELEM variable by an INT32 constant, and immediately - descale to yield a DCTELEM result. } - - {(DCTELEM( DESCALE((var) * (const), CONST_BITS))} - function Multiply(Avar, Aconst: Integer): DCTELEM; - begin - Multiply := DCTELEM( Avar*INT32(Aconst) div (INT32(1) shl CONST_BITS)); - end; - - -{ Dequantize a coefficient by multiplying it by the multiplier-table - entry; produce a DCTELEM result. For 8-bit data a 16x16->16 - multiplication will do. For 12-bit data, the multiplier table is - declared INT32, so a 32-bit multiply will be used. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} - function DEQUANTIZE(coef,quantval : int) : int; - begin - Dequantize := ( IFAST_MULT_TYPE(coef) * quantval); - end; -{$else} - function DEQUANTIZE(coef,quantval : INT32) : int; - begin - Dequantize := DESCALE((coef)*(quantval), IFAST_SCALE_BITS-PASS1_BITS); - end; -{$endif} - - -{ Like DESCALE, but applies to a DCTELEM and produces an int. - We assume that int right shift is unsigned if INT32 right shift is. } - -function IDESCALE(x : DCTELEM; n : int) : int; -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - DCTELEMBITS = 16; { DCTELEM may be 16 or 32 bits } -{$else} -const - DCTELEMBITS = 32; { DCTELEM must be 32 bits } -{$endif} -var - ishift_temp : DCTELEM; -begin -{$ifndef USE_ACCURATE_ROUNDING} - ishift_temp := x + (INT32(1) shl (n-1)); -{$else} -{ We can gain a little more speed, with a further compromise in accuracy, - by omitting the addition in a descaling shift. This yields an incorrectly - rounded result half the time... } - ishift_temp := x; -{$endif} - -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - if ishift_temp < 0 then - IDescale := (ishift_temp shr n) - or ((not DCTELEM(0)) shl (DCTELEMBITS-n)) - else -{$endif} - IDescale := (ishift_temp shr n); -end; - - - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_ifast (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = coef_bits_field; { buffers data between passes } -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM; - tmp10, tmp11, tmp12, tmp13 : DCTELEM; - z5, z10, z11, z12, z13 : DCTELEM; - inptr : JCOEFPTR; - quantptr : IFAST_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {SHIFT_TEMPS} { for DESCALE } - {ISHIFT_TEMPS} { for IDESCALE } -var - dcval : int; -var - dcval_ : JSAMPLE; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - { Pass 1: process columns from input, store into work array. } - - inptr := coef_block; - quantptr := IFAST_MULT_TYPE_FIELD_PTR(compptr^.dct_table); - wsptr := @workspace; - for ctr := pred(DCTSIZE) downto 0 do - begin - { Due to quantization, we will usually find that many of the input - coefficients are zero, especially the AC terms. We can exploit this - by short-circuiting the IDCT calculation for any column in which all - the AC terms are zero. In that case each output is equal to the - DC coefficient (with scale factor as needed). - With typical images and quantization tables, half or more of the - column DCT calculations can be simplified this way. } - - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and - (inptr^[DCTSIZE*4]=0) and (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and - (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero } - dcval := int(DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0])); - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - wsptr^[DCTSIZE*2] := dcval; - wsptr^[DCTSIZE*3] := dcval; - wsptr^[DCTSIZE*4] := dcval; - wsptr^[DCTSIZE*5] := dcval; - wsptr^[DCTSIZE*6] := dcval; - wsptr^[DCTSIZE*7] := dcval; - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(IFAST_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - continue; - end; - - { Even part } - - tmp0 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); - tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); - tmp2 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); - tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); - - tmp10 := tmp0 + tmp2; { phase 3 } - tmp11 := tmp0 - tmp2; - - tmp13 := tmp1 + tmp3; { phases 5-3 } - tmp12 := MULTIPLY(tmp1 - tmp3, FIX_1_414213562) - tmp13; { 2*c4 } - - tmp0 := tmp10 + tmp13; { phase 2 } - tmp3 := tmp10 - tmp13; - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - - tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); - tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); - tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); - tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); - - z13 := tmp6 + tmp5; { phase 6 } - z10 := tmp6 - tmp5; - z11 := tmp4 + tmp7; - z12 := tmp4 - tmp7; - - tmp7 := z11 + z13; { phase 5 } - tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 } - - z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 } - tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) } - tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) } - - tmp6 := tmp12 - tmp7; { phase 2 } - tmp5 := tmp11 - tmp6; - tmp4 := tmp10 + tmp5; - - wsptr^[DCTSIZE*0] := int (tmp0 + tmp7); - wsptr^[DCTSIZE*7] := int (tmp0 - tmp7); - wsptr^[DCTSIZE*1] := int (tmp1 + tmp6); - wsptr^[DCTSIZE*6] := int (tmp1 - tmp6); - wsptr^[DCTSIZE*2] := int (tmp2 + tmp5); - wsptr^[DCTSIZE*5] := int (tmp2 - tmp5); - wsptr^[DCTSIZE*4] := int (tmp3 + tmp4); - wsptr^[DCTSIZE*3] := int (tmp3 - tmp4); - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(IFAST_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process rows from work array, store into output array. } - { Note that we must descale the results by a factor of 8 == 2**3, } - { and also undo the PASS1_BITS scaling. } - - wsptr := @workspace; - for ctr := 0 to pred(DCTSIZE) do - begin - outptr := JSAMPROW(@output_buf^[ctr]^[output_col]); - { Rows of zeroes can be exploited in the same way as we did with columns. - However, the column calculation has created many nonzero AC terms, so - the simplification applies less often (typically 5% to 10% of the time). - On machines with very fast multiplication, it's possible that the - test takes more time than it's worth. In that case this section - may be commented out. } - -{$ifndef NO_ZERO_ROW_TEST} - if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0) and - (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then - begin - { AC terms all zero } - dcval_ := range_limit^[IDESCALE(wsptr^[0], PASS1_BITS+3) - and RANGE_MASK]; - - outptr^[0] := dcval_; - outptr^[1] := dcval_; - outptr^[2] := dcval_; - outptr^[3] := dcval_; - outptr^[4] := dcval_; - outptr^[5] := dcval_; - outptr^[6] := dcval_; - outptr^[7] := dcval_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part } - - tmp10 := (DCTELEM(wsptr^[0]) + DCTELEM(wsptr^[4])); - tmp11 := (DCTELEM(wsptr^[0]) - DCTELEM(wsptr^[4])); - - tmp13 := (DCTELEM(wsptr^[2]) + DCTELEM(wsptr^[6])); - tmp12 := MULTIPLY(DCTELEM(wsptr^[2]) - DCTELEM(wsptr^[6]), FIX_1_414213562) - - tmp13; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - - z13 := DCTELEM(wsptr^[5]) + DCTELEM(wsptr^[3]); - z10 := DCTELEM(wsptr^[5]) - DCTELEM(wsptr^[3]); - z11 := DCTELEM(wsptr^[1]) + DCTELEM(wsptr^[7]); - z12 := DCTELEM(wsptr^[1]) - DCTELEM(wsptr^[7]); - - tmp7 := z11 + z13; { phase 5 } - tmp11 := MULTIPLY(z11 - z13, FIX_1_414213562); { 2*c4 } - - z5 := MULTIPLY(z10 + z12, FIX_1_847759065); { 2*c2 } - tmp10 := MULTIPLY(z12, FIX_1_082392200) - z5; { 2*(c2-c6) } - tmp12 := MULTIPLY(z10, - FIX_2_613125930) + z5; { -2*(c2+c6) } - - tmp6 := tmp12 - tmp7; { phase 2 } - tmp5 := tmp11 - tmp6; - tmp4 := tmp10 + tmp5; - - { Final output stage: scale down by a factor of 8 and range-limit } - - outptr^[0] := range_limit^[IDESCALE(tmp0 + tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[7] := range_limit^[IDESCALE(tmp0 - tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[1] := range_limit^[IDESCALE(tmp1 + tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[6] := range_limit^[IDESCALE(tmp1 - tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[2] := range_limit^[IDESCALE(tmp2 + tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[5] := range_limit^[IDESCALE(tmp2 - tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[4] := range_limit^[IDESCALE(tmp3 + tmp4, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[3] := range_limit^[IDESCALE(tmp3 - tmp4, PASS1_BITS+3) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjidctint.pas b/3rd/Imaging/Source/JpegLib/imjidctint.pas deleted file mode 100644 index f46cc8f9c..000000000 --- a/3rd/Imaging/Source/JpegLib/imjidctint.pas +++ /dev/null @@ -1,440 +0,0 @@ -unit imjidctint; -{$Q+} - -{ This file contains a slow-but-accurate integer implementation of the - inverse DCT (Discrete Cosine Transform). In the IJG code, this routine - must also perform dequantization of the input coefficients. - - A 2-D IDCT can be done by 1-D IDCT on each column followed by 1-D IDCT - on each row (or vice versa, but it's more convenient to emit a row at - a time). Direct algorithms are also available, but they are much more - complex and seem not to be any faster when reduced to code. - - This implementation is based on an algorithm described in - C. Loeffler, A. Ligtenberg and G. Moschytz, "Practical Fast 1-D DCT - Algorithms with 11 Multiplications", Proc. Int'l. Conf. on Acoustics, - Speech, and Signal Processing 1989 (ICASSP '89), pp. 988-991. - The primary algorithm described there uses 11 multiplies and 29 adds. - We use their alternate method with 12 multiplies and 32 adds. - The advantage of this method is that no data path contains more than one - multiplication; this allows a very simple and accurate implementation in - scaled fixed-point arithmetic, with a minimal number of shifts. } - -{ Original : jidctint.c ; Copyright (C) 1991-1998, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_islow (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - -{ The poop on this scaling stuff is as follows: - - Each 1-D IDCT step produces outputs which are a factor of sqrt(N) - larger than the true IDCT outputs. The final outputs are therefore - a factor of N larger than desired; since N=8 this can be cured by - a simple right shift at the end of the algorithm. The advantage of - this arrangement is that we save two multiplications per 1-D IDCT, - because the y0 and y4 inputs need not be divided by sqrt(N). - - We have to do addition and subtraction of the integer inputs, which - is no problem, and multiplication by fractional constants, which is - a problem to do in integer arithmetic. We multiply all the constants - by CONST_SCALE and convert them to integer constants (thus retaining - CONST_BITS bits of precision in the constants). After doing a - multiplication we have to divide the product by CONST_SCALE, with proper - rounding, to produce the correct output. This division can be done - cheaply as a right shift of CONST_BITS bits. We postpone shifting - as long as possible so that partial sums can be added together with - full fractional precision. - - The outputs of the first pass are scaled up by PASS1_BITS bits so that - they are represented to better-than-integral precision. These outputs - require BITS_IN_JSAMPLE + PASS1_BITS + 3 bits; this fits in a 16-bit word - with the recommended scaling. (To scale up 12-bit sample data further, an - intermediate INT32 array would be needed.) - - To avoid overflow of the 32-bit intermediate results in pass 2, we must - have BITS_IN_JSAMPLE + CONST_BITS + PASS1_BITS <= 26. Error analysis - shows that the values given below are the most effective. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - CONST_BITS = 13; - PASS1_BITS = 2; -{$else} -const - CONST_BITS = 13; - PASS1_BITS = 1; { lose a little precision to avoid overflow } -{$endif} - -const - CONST_SCALE = (INT32(1) shl CONST_BITS); - -const - FIX_0_298631336 = INT32(Round(CONST_SCALE * 0.298631336)); {2446} - FIX_0_390180644 = INT32(Round(CONST_SCALE * 0.390180644)); {3196} - FIX_0_541196100 = INT32(Round(CONST_SCALE * 0.541196100)); {4433} - FIX_0_765366865 = INT32(Round(CONST_SCALE * 0.765366865)); {6270} - FIX_0_899976223 = INT32(Round(CONST_SCALE * 0.899976223)); {7373} - FIX_1_175875602 = INT32(Round(CONST_SCALE * 1.175875602)); {9633} - FIX_1_501321110 = INT32(Round(CONST_SCALE * 1.501321110)); {12299} - FIX_1_847759065 = INT32(Round(CONST_SCALE * 1.847759065)); {15137} - FIX_1_961570560 = INT32(Round(CONST_SCALE * 1.961570560)); {16069} - FIX_2_053119869 = INT32(Round(CONST_SCALE * 2.053119869)); {16819} - FIX_2_562915447 = INT32(Round(CONST_SCALE * 2.562915447)); {20995} - FIX_3_072711026 = INT32(Round(CONST_SCALE * 3.072711026)); {25172} - - - -{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result. - For 8-bit samples with the recommended scaling, all the variable - and constant values involved are no more than 16 bits wide, so a - 16x16->32 bit multiply can be used instead of a full 32x32 multiply. - For 12-bit samples, a full 32-bit multiplication will be needed. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} - - {$IFDEF BASM16} - {$IFNDEF WIN32} - {MULTIPLY16C16(var,const)} - function Multiply(X, Y: Integer): integer; assembler; - asm - mov ax, X - imul Y - mov al, ah - mov ah, dl - end; - {$ENDIF} - {$ENDIF} - - function Multiply(X, Y: INT32): INT32; - begin - Multiply := INT32(X) * INT32(Y); - end; - - -{$else} - {#define MULTIPLY(var,const) ((var) * (const))} - function Multiply(X, Y: INT32): INT32; - begin - Multiply := INT32(X) * INT32(Y); - end; -{$endif} - - -{ Dequantize a coefficient by multiplying it by the multiplier-table - entry; produce an int result. In this module, both inputs and result - are 16 bits or less, so either int or short multiply will work. } - -function DEQUANTIZE(coef,quantval : int) : int; -begin - Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval); -end; - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - shift_temp := x + (INT32(1) shl (n-1)); - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - Descale := (shift_temp shr n); -{$else} - Descale := (x + (INT32(1) shl (n-1)) shr n; -{$endif} -end; - -{ Perform dequantization and inverse DCT on one block of coefficients. } - -{GLOBAL} -procedure jpeg_idct_islow (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = coef_bits_field; { buffers data between passes } -var - tmp0, tmp1, tmp2, tmp3 : INT32; - tmp10, tmp11, tmp12, tmp13 : INT32; - z1, z2, z3, z4, z5 : INT32; - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; - {SHIFT_TEMPS} -var - dcval : int; -var - dcval_ : JSAMPLE; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - - - { Pass 1: process columns from input, store into work array. } - { Note results are scaled up by sqrt(8) compared to a true IDCT; } - { furthermore, we scale the results by 2**PASS1_BITS. } - - inptr := coef_block; - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := PWorkspace(@workspace); - for ctr := pred(DCTSIZE) downto 0 do - begin - { Due to quantization, we will usually find that many of the input - coefficients are zero, especially the AC terms. We can exploit this - by short-circuiting the IDCT calculation for any column in which all - the AC terms are zero. In that case each output is equal to the - DC coefficient (with scale factor as needed). - With typical images and quantization tables, half or more of the - column DCT calculations can be simplified this way. } - - if ((inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and - (inptr^[DCTSIZE*3]=0) and (inptr^[DCTSIZE*4]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and - (inptr^[DCTSIZE*7]=0)) then - begin - { AC terms all zero } - dcval := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]) shl PASS1_BITS; - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - wsptr^[DCTSIZE*2] := dcval; - wsptr^[DCTSIZE*3] := dcval; - wsptr^[DCTSIZE*4] := dcval; - wsptr^[DCTSIZE*5] := dcval; - wsptr^[DCTSIZE*6] := dcval; - wsptr^[DCTSIZE*7] := dcval; - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - continue; - end; - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - z2 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); - z3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); - - z1 := MULTIPLY(z2 + z3, FIX_0_541196100); - tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065); - tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865); - - z2 := DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0]); - z3 := DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); - - tmp0 := (z2 + z3) shl CONST_BITS; - tmp1 := (z2 - z3) shl CONST_BITS; - - tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - { Odd part per figure 8; the matrix is unitary and hence its - transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } - - tmp0 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); - tmp1 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); - tmp2 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); - tmp3 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); - - z1 := tmp0 + tmp3; - z2 := tmp1 + tmp2; - z3 := tmp0 + tmp2; - z4 := tmp1 + tmp3; - z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } - - tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } - z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } - z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } - z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } - - Inc(z3, z5); - Inc(z4, z5); - - Inc(tmp0, z1 + z3); - Inc(tmp1, z2 + z4); - Inc(tmp2, z2 + z3); - Inc(tmp3, z1 + z4); - - { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } - - wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp3, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*7] := int (DESCALE(tmp10 - tmp3, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*1] := int (DESCALE(tmp11 + tmp2, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*6] := int (DESCALE(tmp11 - tmp2, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*2] := int (DESCALE(tmp12 + tmp1, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*5] := int (DESCALE(tmp12 - tmp1, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*3] := int (DESCALE(tmp13 + tmp0, CONST_BITS-PASS1_BITS)); - wsptr^[DCTSIZE*4] := int (DESCALE(tmp13 - tmp0, CONST_BITS-PASS1_BITS)); - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process rows from work array, store into output array. } - { Note that we must descale the results by a factor of 8 == 2**3, } - { and also undo the PASS1_BITS scaling. } - - wsptr := @workspace; - for ctr := 0 to pred(DCTSIZE) do - begin - outptr := output_buf^[ctr]; - Inc(JSAMPLE_PTR(outptr), output_col); - { Rows of zeroes can be exploited in the same way as we did with columns. - However, the column calculation has created many nonzero AC terms, so - the simplification applies less often (typically 5% to 10% of the time). - On machines with very fast multiplication, it's possible that the - test takes more time than it's worth. In that case this section - may be commented out. } - -{$ifndef NO_ZERO_ROW_TEST} - if ((wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and (wsptr^[4]=0) - and (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0)) then - begin - { AC terms all zero } - JSAMPLE(dcval_) := range_limit^[int(DESCALE(INT32(wsptr^[0]), - PASS1_BITS+3)) and RANGE_MASK]; - - outptr^[0] := dcval_; - outptr^[1] := dcval_; - outptr^[2] := dcval_; - outptr^[3] := dcval_; - outptr^[4] := dcval_; - outptr^[5] := dcval_; - outptr^[6] := dcval_; - outptr^[7] := dcval_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part: reverse the even part of the forward DCT. } - { The rotator is sqrt(2)*c(-6). } - - z2 := INT32 (wsptr^[2]); - z3 := INT32 (wsptr^[6]); - - z1 := MULTIPLY(z2 + z3, FIX_0_541196100); - tmp2 := z1 + MULTIPLY(z3, - FIX_1_847759065); - tmp3 := z1 + MULTIPLY(z2, FIX_0_765366865); - - tmp0 := (INT32(wsptr^[0]) + INT32(wsptr^[4])) shl CONST_BITS; - tmp1 := (INT32(wsptr^[0]) - INT32(wsptr^[4])) shl CONST_BITS; - - tmp10 := tmp0 + tmp3; - tmp13 := tmp0 - tmp3; - tmp11 := tmp1 + tmp2; - tmp12 := tmp1 - tmp2; - - { Odd part per figure 8; the matrix is unitary and hence its - transpose is its inverse. i0..i3 are y7,y5,y3,y1 respectively. } - - tmp0 := INT32(wsptr^[7]); - tmp1 := INT32(wsptr^[5]); - tmp2 := INT32(wsptr^[3]); - tmp3 := INT32(wsptr^[1]); - - z1 := tmp0 + tmp3; - z2 := tmp1 + tmp2; - z3 := tmp0 + tmp2; - z4 := tmp1 + tmp3; - z5 := MULTIPLY(z3 + z4, FIX_1_175875602); { sqrt(2) * c3 } - - tmp0 := MULTIPLY(tmp0, FIX_0_298631336); { sqrt(2) * (-c1+c3+c5-c7) } - tmp1 := MULTIPLY(tmp1, FIX_2_053119869); { sqrt(2) * ( c1+c3-c5+c7) } - tmp2 := MULTIPLY(tmp2, FIX_3_072711026); { sqrt(2) * ( c1+c3+c5-c7) } - tmp3 := MULTIPLY(tmp3, FIX_1_501321110); { sqrt(2) * ( c1+c3-c5-c7) } - z1 := MULTIPLY(z1, - FIX_0_899976223); { sqrt(2) * (c7-c3) } - z2 := MULTIPLY(z2, - FIX_2_562915447); { sqrt(2) * (-c1-c3) } - z3 := MULTIPLY(z3, - FIX_1_961570560); { sqrt(2) * (-c3-c5) } - z4 := MULTIPLY(z4, - FIX_0_390180644); { sqrt(2) * (c5-c3) } - - Inc(z3, z5); - Inc(z4, z5); - - Inc(tmp0, z1 + z3); - Inc(tmp1, z2 + z4); - Inc(tmp2, z2 + z3); - Inc(tmp3, z1 + z4); - - { Final output stage: inputs are tmp10..tmp13, tmp0..tmp3 } - - outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp3, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[7] := range_limit^[ int(DESCALE(tmp10 - tmp3, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE(tmp11 + tmp2, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[6] := range_limit^[ int(DESCALE(tmp11 - tmp2, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[2] := range_limit^[ int(DESCALE(tmp12 + tmp1, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[5] := range_limit^[ int(DESCALE(tmp12 - tmp1, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[3] := range_limit^[ int(DESCALE(tmp13 + tmp0, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - outptr^[4] := range_limit^[ int(DESCALE(tmp13 - tmp0, - CONST_BITS+PASS1_BITS+3)) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjidctred.pas b/3rd/Imaging/Source/JpegLib/imjidctred.pas deleted file mode 100644 index dae7bfcbb..000000000 --- a/3rd/Imaging/Source/JpegLib/imjidctred.pas +++ /dev/null @@ -1,525 +0,0 @@ -unit imjidctred; - - -{ This file contains inverse-DCT routines that produce reduced-size output: - either 4x4, 2x2, or 1x1 pixels from an 8x8 DCT block. - - The implementation is based on the Loeffler, Ligtenberg and Moschytz (LL&M) - algorithm used in jidctint.c. We simply replace each 8-to-8 1-D IDCT step - with an 8-to-4 step that produces the four averages of two adjacent outputs - (or an 8-to-2 step producing two averages of four outputs, for 2x2 output). - These steps were derived by computing the corresponding values at the end - of the normal LL&M code, then simplifying as much as possible. - - 1x1 is trivial: just take the DC coefficient divided by 8. - - See jidctint.c for additional comments. } - - -{ Original : jidctred.c ; Copyright (C) 1994-1998, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib, - imjdct; { Private declarations for DCT subsystem } - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 1x1 output block. } - -{GLOBAL} -procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 2x2 output block. } - -{GLOBAL} -procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 4x4 output block. } - -{GLOBAL} -procedure jpeg_idct_4x4 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -implementation - -{ This module is specialized to the case DCTSIZE = 8. } - -{$ifndef DCTSIZE_IS_8} - Sorry, this code only copes with 8x8 DCTs. { deliberate syntax err } -{$endif} - - -{ Scaling is the same as in jidctint.c. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -const - CONST_BITS = 13; - PASS1_BITS = 2; -{$else} -const - CONST_BITS = 13; - PASS1_BITS = 1; { lose a little precision to avoid overflow } -{$endif} - -const - FIX_0_211164243 = INT32(Round((INT32(1) shl CONST_BITS) * 0.211164243)); {1730} - FIX_0_509795579 = INT32(Round((INT32(1) shl CONST_BITS) * 0.509795579)); {4176} - FIX_0_601344887 = INT32(Round((INT32(1) shl CONST_BITS) * 0.601344887)); {4926} - FIX_0_720959822 = INT32(Round((INT32(1) shl CONST_BITS) * 0.720959822)); {5906} - FIX_0_765366865 = INT32(Round((INT32(1) shl CONST_BITS) * 0.765366865)); {6270} - FIX_0_850430095 = INT32(Round((INT32(1) shl CONST_BITS) * 0.850430095)); {6967} - FIX_0_899976223 = INT32(Round((INT32(1) shl CONST_BITS) * 0.899976223)); {7373} - FIX_1_061594337 = INT32(Round((INT32(1) shl CONST_BITS) * 1.061594337)); {8697} - FIX_1_272758580 = INT32(Round((INT32(1) shl CONST_BITS) * 1.272758580)); {10426} - FIX_1_451774981 = INT32(Round((INT32(1) shl CONST_BITS) * 1.451774981)); {11893} - FIX_1_847759065 = INT32(Round((INT32(1) shl CONST_BITS) * 1.847759065)); {15137} - FIX_2_172734803 = INT32(Round((INT32(1) shl CONST_BITS) * 2.172734803)); {17799} - FIX_2_562915447 = INT32(Round((INT32(1) shl CONST_BITS) * 2.562915447)); {20995} - FIX_3_624509785 = INT32(Round((INT32(1) shl CONST_BITS) * 3.624509785)); {29692} - - -{ Multiply an INT32 variable by an INT32 constant to yield an INT32 result. - For 8-bit samples with the recommended scaling, all the variable - and constant values involved are no more than 16 bits wide, so a - 16x16->32 bit multiply can be used instead of a full 32x32 multiply. - For 12-bit samples, a full 32-bit multiplication will be needed. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} - - {function Multiply(X, Y: Integer): integer; assembler; - asm - mov ax, X - imul Y - mov al, ah - mov ah, dl - end;} - - {MULTIPLY16C16(var,const)} - function Multiply(X, Y: Integer): INT32; - begin - Multiply := X*INT32(Y); - end; - - -{$else} - function Multiply(X, Y: INT32): INT32; - begin - Multiply := X*Y; - end; -{$endif} - - -{ Dequantize a coefficient by multiplying it by the multiplier-table - entry; produce an int result. In this module, both inputs and result - are 16 bits or less, so either int or short multiply will work. } - -function DEQUANTIZE(coef,quantval : int) : int; -begin - Dequantize := ( ISLOW_MULT_TYPE(coef) * quantval); -end; - - -{ Descale and correctly round an INT32 value that's scaled by N bits. - We assume RIGHT_SHIFT rounds towards minus infinity, so adding - the fudge factor is correct for either sign of X. } - -function DESCALE(x : INT32; n : int) : INT32; -var - shift_temp : INT32; -begin -{$ifdef RIGHT_SHIFT_IS_UNSIGNED} - shift_temp := x + (INT32(1) shl (n-1)); - if shift_temp < 0 then - Descale := (shift_temp shr n) or ((not INT32(0)) shl (32-n)) - else - Descale := (shift_temp shr n); -{$else} - Descale := (x + (INT32(1) shl (n-1)) shr n; -{$endif} -end; - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 4x4 output block. } - -{GLOBAL} -procedure jpeg_idct_4x4 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = array[0..(DCTSIZE*4)-1] of int; { buffers data between passes } -var - tmp0, tmp2, tmp10, tmp12 : INT32; - z1, z2, z3, z4 : INT32; - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {SHIFT_TEMPS} -var - dcval : int; -var - dcval_ : JSAMPLE; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - - { Pass 1: process columns from input, store into work array. } - - inptr := coef_block; - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := @workspace; - for ctr := DCTSIZE downto 1 do - begin - { Don't bother to process column 4, because second pass won't use it } - if (ctr = DCTSIZE-4) then - begin - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*2]=0) and (inptr^[DCTSIZE*3]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*6]=0) and (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero; we need not examine term 4 for 4x4 output } - dcval := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * - quantptr^[DCTSIZE*0]) shl PASS1_BITS; - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - wsptr^[DCTSIZE*2] := dcval; - wsptr^[DCTSIZE*3] := dcval; - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - - { Even part } - - tmp0 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); - - tmp0 := tmp0 shl (CONST_BITS+1); - - z2 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*2]) * quantptr^[DCTSIZE*2]); - z3 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*6]) * quantptr^[DCTSIZE*6]); - - tmp2 := MULTIPLY(z2, FIX_1_847759065) + MULTIPLY(z3, - FIX_0_765366865); - - tmp10 := tmp0 + tmp2; - tmp12 := tmp0 - tmp2; - - { Odd part } - - z1 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]; - z2 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]; - z3 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]; - z4 := ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]; - - tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } - + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } - + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } - + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } - - tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } - + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } - + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } - + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } - - { Final output stage } - - wsptr^[DCTSIZE*0] := int(DESCALE(tmp10 + tmp2, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*3] := int(DESCALE(tmp10 - tmp2, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*1] := int(DESCALE(tmp12 + tmp0, CONST_BITS-PASS1_BITS+1)); - wsptr^[DCTSIZE*2] := int(DESCALE(tmp12 - tmp0, CONST_BITS-PASS1_BITS+1)); - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process 4 rows from work array, store into output array. } - - wsptr := @workspace; - for ctr := 0 to pred(4) do - begin - outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); - { It's not clear whether a zero row test is worthwhile here ... } - -{$ifndef NO_ZERO_ROW_TEST} - if (wsptr^[1]=0) and (wsptr^[2]=0) and (wsptr^[3]=0) and - (wsptr^[5]=0) and (wsptr^[6]=0) and (wsptr^[7]=0) then - begin - { AC terms all zero } - dcval_ := range_limit^[int(DESCALE(INT32(wsptr^[0]), PASS1_BITS+3)) - and RANGE_MASK]; - - outptr^[0] := dcval_; - outptr^[1] := dcval_; - outptr^[2] := dcval_; - outptr^[3] := dcval_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part } - - tmp0 := (INT32(wsptr^[0])) shl (CONST_BITS+1); - - tmp2 := MULTIPLY(INT32(wsptr^[2]), FIX_1_847759065) - + MULTIPLY(INT32(wsptr^[6]), - FIX_0_765366865); - - tmp10 := tmp0 + tmp2; - tmp12 := tmp0 - tmp2; - - { Odd part } - - z1 := INT32(wsptr^[7]); - z2 := INT32(wsptr^[5]); - z3 := INT32(wsptr^[3]); - z4 := INT32(wsptr^[1]); - - tmp0 := MULTIPLY(z1, - FIX_0_211164243) { sqrt(2) * (c3-c1) } - + MULTIPLY(z2, FIX_1_451774981) { sqrt(2) * (c3+c7) } - + MULTIPLY(z3, - FIX_2_172734803) { sqrt(2) * (-c1-c5) } - + MULTIPLY(z4, FIX_1_061594337); { sqrt(2) * (c5+c7) } - - tmp2 := MULTIPLY(z1, - FIX_0_509795579) { sqrt(2) * (c7-c5) } - + MULTIPLY(z2, - FIX_0_601344887) { sqrt(2) * (c5-c1) } - + MULTIPLY(z3, FIX_0_899976223) { sqrt(2) * (c3-c7) } - + MULTIPLY(z4, FIX_2_562915447); { sqrt(2) * (c1+c3) } - - { Final output stage } - - outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp2, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[3] := range_limit^[ int(DESCALE(tmp10 - tmp2, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE(tmp12 + tmp0, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - outptr^[2] := range_limit^[ int(DESCALE(tmp12 - tmp0, - CONST_BITS+PASS1_BITS+3+1)) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 2x2 output block. } - -{GLOBAL} -procedure jpeg_idct_2x2 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -type - PWorkspace = ^TWorkspace; - TWorkspace = array[0..(DCTSIZE*2)-1] of int; { buffers data between passes } -var - tmp0, tmp10, z1 : INT32; - inptr : JCOEFPTR; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {SHIFT_TEMPS} -var - dcval : int; -var - dcval_ : JSAMPLE; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - { Pass 1: process columns from input, store into work array. } - - inptr := coef_block; - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - wsptr := @workspace; - for ctr := DCTSIZE downto 1 do - begin - { Don't bother to process columns 2,4,6 } - if (ctr = DCTSIZE-2) or (ctr = DCTSIZE-4) or (ctr = DCTSIZE-6) then - begin - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - if (inptr^[DCTSIZE*1]=0) and (inptr^[DCTSIZE*3]=0) and - (inptr^[DCTSIZE*5]=0) and (inptr^[DCTSIZE*7]=0) then - begin - { AC terms all zero; we need not examine terms 2,4,6 for 2x2 output } - dcval := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * - quantptr^[DCTSIZE*0]) shl PASS1_BITS; - - wsptr^[DCTSIZE*0] := dcval; - wsptr^[DCTSIZE*1] := dcval; - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - - continue; - end; - - { Even part } - - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*0]) * quantptr^[DCTSIZE*0]); - - tmp10 := z1 shl (CONST_BITS+2); - - { Odd part } - - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*7]) * quantptr^[DCTSIZE*7]); - tmp0 := MULTIPLY(z1, - FIX_0_720959822); { sqrt(2) * (c7-c5+c3-c1) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*5]) * quantptr^[DCTSIZE*5]); - Inc(tmp0, MULTIPLY(z1, FIX_0_850430095)); { sqrt(2) * (-c1+c3+c5+c7) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*3]) * quantptr^[DCTSIZE*3]); - Inc(tmp0, MULTIPLY(z1, - FIX_1_272758580)); { sqrt(2) * (-c1+c3-c5-c7) } - z1 := (ISLOW_MULT_TYPE(inptr^[DCTSIZE*1]) * quantptr^[DCTSIZE*1]); - Inc(tmp0, MULTIPLY(z1, FIX_3_624509785)); { sqrt(2) * (c1+c3+c5+c7) } - - { Final output stage } - - wsptr^[DCTSIZE*0] := int (DESCALE(tmp10 + tmp0, CONST_BITS-PASS1_BITS+2)); - wsptr^[DCTSIZE*1] := int (DESCALE(tmp10 - tmp0, CONST_BITS-PASS1_BITS+2)); - - Inc(JCOEF_PTR(inptr)); - Inc(ISLOW_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - end; - - { Pass 2: process 2 rows from work array, store into output array. } - - wsptr := @workspace; - for ctr := 0 to pred(2) do - begin - outptr := JSAMPROW(@ output_buf^[ctr]^[output_col]); - { It's not clear whether a zero row test is worthwhile here ... } - -{$ifndef NO_ZERO_ROW_TEST} - if (wsptr^[1]=0) and (wsptr^[3]=0) and (wsptr^[5]=0) and (wsptr^[7]= 0) then - begin - { AC terms all zero } - dcval_ := range_limit^[ int(DESCALE(INT32(wsptr^[0]), PASS1_BITS+3)) - and RANGE_MASK]; - - outptr^[0] := dcval_; - outptr^[1] := dcval_; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - continue; - end; -{$endif} - - { Even part } - - tmp10 := (INT32 (wsptr^[0])) shl (CONST_BITS+2); - - { Odd part } - - tmp0 := MULTIPLY( INT32(wsptr^[7]), - FIX_0_720959822) { sqrt(2) * (c7-c5+c3-c1) } - + MULTIPLY( INT32(wsptr^[5]), FIX_0_850430095) { sqrt(2) * (-c1+c3+c5+c7) } - + MULTIPLY( INT32(wsptr^[3]), - FIX_1_272758580) { sqrt(2) * (-c1+c3-c5-c7) } - + MULTIPLY( INT32(wsptr^[1]), FIX_3_624509785); { sqrt(2) * (c1+c3+c5+c7) } - - { Final output stage } - - outptr^[0] := range_limit^[ int(DESCALE(tmp10 + tmp0, - CONST_BITS+PASS1_BITS+3+2)) - and RANGE_MASK]; - outptr^[1] := range_limit^[ int(DESCALE(tmp10 - tmp0, - CONST_BITS+PASS1_BITS+3+2)) - and RANGE_MASK]; - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; -end; - - -{ Perform dequantization and inverse DCT on one block of coefficients, - producing a reduced-size 1x1 output block. } - -{GLOBAL} -procedure jpeg_idct_1x1 (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); -var - dcval : int; - quantptr : ISLOW_MULT_TYPE_FIELD_PTR; - range_limit : JSAMPROW; - {SHIFT_TEMPS} -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - { Pass 1: process columns from input, store into work array. } - - { We hardly need an inverse DCT routine for this: just take the - average pixel value, which is one-eighth of the DC coefficient. } - - quantptr := ISLOW_MULT_TYPE_FIELD_PTR (compptr^.dct_table); - dcval := (ISLOW_MULT_TYPE(coef_block^[0]) * quantptr^[0]); - dcval := int (DESCALE( INT32(dcval), 3)); - - output_buf^[0]^[output_col] := range_limit^[dcval and RANGE_MASK]; -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjinclude.pas b/3rd/Imaging/Source/JpegLib/imjinclude.pas deleted file mode 100644 index dcaa684ba..000000000 --- a/3rd/Imaging/Source/JpegLib/imjinclude.pas +++ /dev/null @@ -1,126 +0,0 @@ -unit imjinclude; - -{ This file exists to provide a single place to fix any problems with - including the wrong system include files. (Common problems are taken - care of by the standard jconfig symbols, but on really weird systems - you may have to edit this file.) - - NOTE: this file is NOT intended to be included by applications using the - JPEG library. Most applications need only include jpeglib.h. } - -{ Original: jinclude.h Copyright (C) 1991-1994, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -{ Include auto-config file to find out which system include files we need. } - -uses -{$ifdef Delphi_Stream} - classes, -{$endif} - imjmorecfg; - -{ Nomssi: - To write a dest/source manager that handle streams rather than files, - you can edit the FILEptr definition and the JFREAD() and JFWRITE() - functions in this unit, you don't need to change the default managers - JDATASRC and JDATADST. } - -{$ifdef Delphi_Stream} -type - FILEptr = ^TStream; -{$else} - {$ifdef Delphi_Jpeg} - type - FILEptr = TCustomMemoryStream; - {$else} - type - FILEptr = ^File; - {$endif} -{$endif} - -{ We need the NULL macro and size_t typedef. - On an ANSI-conforming system it is sufficient to include . - Otherwise, we get them from or ; we may have to - pull in as well. - Note that the core JPEG library does not require ; - only the default error handler and data source/destination modules do. - But we must pull it in because of the references to FILE in jpeglib.h. - You can remove those references if you want to compile without .} - - - -{ We need memory copying and zeroing functions, plus strncpy(). - ANSI and System V implementations declare these in . - BSD doesn't have the mem() functions, but it does have bcopy()/bzero(). - Some systems may declare memset and memcpy in . - - NOTE: we assume the size parameters to these functions are of type size_t. - Change the casts in these macros if not! } - -procedure MEMZERO(target : pointer; size : size_t); - -procedure MEMCOPY(dest, src : pointer; size : size_t); - -{function SIZEOF(object) : size_t;} - -function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; - -function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; - -implementation - -procedure MEMZERO(target : pointer; size : size_t); -begin - FillChar(target^, size, 0); -end; - -procedure MEMCOPY(dest, src : pointer; size : size_t); -begin - Move(src^, dest^, size); -end; - -{ In ANSI C, and indeed any rational implementation, size_t is also the - type returned by sizeof(). However, it seems there are some irrational - implementations out there, in which sizeof() returns an int even though - size_t is defined as long or unsigned long. To ensure consistent results - we always use this SIZEOF() macro in place of using sizeof() directly. } - - -{#define - SIZEOF(object) (size_t(sizeof(object))} - - -{ The modules that use fread() and fwrite() always invoke them through - these macros. On some systems you may need to twiddle the argument casts. - CAUTION: argument order is different from underlying functions! } - - -function JFREAD(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; -var - count : uint; -begin - {$ifdef Delphi_Stream} - count := fp^.Read(buf^, sizeofbuf); - {$else} - blockread(fp^, buf^, sizeofbuf, count); - {$endif} - JFREAD := size_t(count); -end; - -function JFWRITE(fp : FILEptr; buf : pointer; sizeofbuf : size_t) : size_t; -var - count : uint; -begin - {$ifdef Delphi_Stream} - count := fp^.Write(buf^, sizeofbuf); - {$else} - blockwrite(fp^, buf^, sizeofbuf, count); - {$endif} - JFWRITE := size_t(count); -end; - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjmemmgr.pas b/3rd/Imaging/Source/JpegLib/imjmemmgr.pas deleted file mode 100644 index b3122f67a..000000000 --- a/3rd/Imaging/Source/JpegLib/imjmemmgr.pas +++ /dev/null @@ -1,1283 +0,0 @@ -unit imjmemmgr; - -{ This file contains the JPEG system-independent memory management - routines. This code is usable across a wide variety of machines; most - of the system dependencies have been isolated in a separate file. - The major functions provided here are: - * pool-based allocation and freeing of memory; - * policy decisions about how to divide available memory among the - virtual arrays; - * control logic for swapping virtual arrays between main memory and - backing storage. - The separate system-dependent file provides the actual backing-storage - access code, and it contains the policy decision about how much total - main memory to use. - This file is system-dependent in the sense that some of its functions - are unnecessary in some systems. For example, if there is enough virtual - memory so that backing storage will never be used, much of the virtual - array control logic could be removed. (Of course, if you have that much - memory then you shouldn't care about a little bit of unused code...) } - -{ Original : jmemmgr.c ; Copyright (C) 1991-1997, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjdeferr, - imjerror, - imjpeglib, - imjutils, -{$IFDEF VER70} -{$ifndef NO_GETENV} - Dos, { DOS unit should declare getenv() } - { function GetEnv(name : string) : string; } -{$endif} - imjmemdos; { import the system-dependent declarations } -{$ELSE} - imjmemnobs; - {$DEFINE NO_GETENV} -{$ENDIF} - -{ Memory manager initialization. - When this is called, only the error manager pointer is valid in cinfo! } - -{GLOBAL} -procedure jinit_memory_mgr (cinfo : j_common_ptr); - -implementation - - -{ Some important notes: - The allocation routines provided here must never return NIL. - They should exit to error_exit if unsuccessful. - - It's not a good idea to try to merge the sarray and barray routines, - even though they are textually almost the same, because samples are - usually stored as bytes while coefficients are shorts or ints. Thus, - in machines where byte pointers have a different representation from - word pointers, the resulting machine code could not be the same. } - - -{ Many machines require storage alignment: longs must start on 4-byte - boundaries, doubles on 8-byte boundaries, etc. On such machines, malloc() - always returns pointers that are multiples of the worst-case alignment - requirement, and we had better do so too. - There isn't any really portable way to determine the worst-case alignment - requirement. This module assumes that the alignment requirement is - multiples of sizeof(ALIGN_TYPE). - By default, we define ALIGN_TYPE as double. This is necessary on some - workstations (where doubles really do need 8-byte alignment) and will work - fine on nearly everything. If your machine has lesser alignment needs, - you can save a few bytes by making ALIGN_TYPE smaller. - The only place I know of where this will NOT work is certain Macintosh - 680x0 compilers that define double as a 10-byte IEEE extended float. - Doing 10-byte alignment is counterproductive because longwords won't be - aligned well. Put "#define ALIGN_TYPE long" in jconfig.h if you have - such a compiler. } - -{$ifndef ALIGN_TYPE} { so can override from jconfig.h } -type - ALIGN_TYPE = double; -{$endif} - - -{ We allocate objects from "pools", where each pool is gotten with a single - request to jpeg_get_small() or jpeg_get_large(). There is no per-object - overhead within a pool, except for alignment padding. Each pool has a - header with a link to the next pool of the same class. - Small and large pool headers are identical except that the latter's - link pointer must be FAR on 80x86 machines. - Notice that the "real" header fields are union'ed with a dummy ALIGN_TYPE - field. This forces the compiler to make SIZEOF(small_pool_hdr) a multiple - of the alignment requirement of ALIGN_TYPE. } - -type - small_pool_ptr = ^small_pool_hdr; - small_pool_hdr = record - case byte of - 0:(hdr : record - next : small_pool_ptr; { next in list of pools } - bytes_used : size_t; { how many bytes already used within pool } - bytes_left : size_t; { bytes still available in this pool } - end); - 1:(dummy : ALIGN_TYPE); { included in union to ensure alignment } - end; {small_pool_hdr;} - -type - large_pool_ptr = ^large_pool_hdr; {FAR} - large_pool_hdr = record - case byte of - 0:(hdr : record - next : large_pool_ptr; { next in list of pools } - bytes_used : size_t; { how many bytes already used within pool } - bytes_left : size_t; { bytes still available in this pool } - end); - 1:(dummy : ALIGN_TYPE); { included in union to ensure alignment } - end; {large_pool_hdr;} - - -{ Here is the full definition of a memory manager object. } - -type - my_mem_ptr = ^my_memory_mgr; - my_memory_mgr = record - pub : jpeg_memory_mgr; { public fields } - - { Each pool identifier (lifetime class) names a linked list of pools. } - small_list : array[0..JPOOL_NUMPOOLS-1] of small_pool_ptr ; - large_list : array[0..JPOOL_NUMPOOLS-1] of large_pool_ptr ; - - { Since we only have one lifetime class of virtual arrays, only one - linked list is necessary (for each datatype). Note that the virtual - array control blocks being linked together are actually stored somewhere - in the small-pool list. } - - virt_sarray_list : jvirt_sarray_ptr; - virt_barray_list : jvirt_barray_ptr; - - { This counts total space obtained from jpeg_get_small/large } - total_space_allocated : long; - - { alloc_sarray and alloc_barray set this value for use by virtual - array routines. } - - last_rowsperchunk : JDIMENSION; { from most recent alloc_sarray/barray } - end; {my_memory_mgr;} - - {$ifndef AM_MEMORY_MANAGER} { only jmemmgr.c defines these } - -{ The control blocks for virtual arrays. - Note that these blocks are allocated in the "small" pool area. - System-dependent info for the associated backing store (if any) is hidden - inside the backing_store_info struct. } -type - jvirt_sarray_control = record - mem_buffer : JSAMPARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - samplesperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_sarray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_sarray_ptr; { link to next virtual sarray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - - jvirt_barray_control = record - mem_buffer : JBLOCKARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - blocksperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_barray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_barray_ptr; { link to next virtual barray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - {$endif} { AM_MEMORY_MANAGER} - -{$ifdef MEM_STATS} { optional extra stuff for statistics } - -{LOCAL} -procedure print_mem_stats (cinfo : j_common_ptr; pool_id : int); -var - mem : my_mem_ptr; - shdr_ptr : small_pool_ptr; - lhdr_ptr : large_pool_ptr; -begin - mem := my_mem_ptr (cinfo^.mem); - - { Since this is only a debugging stub, we can cheat a little by using - fprintf directly rather than going through the trace message code. - This is helpful because message parm array can't handle longs. } - - WriteLn(output, 'Freeing pool ', pool_id,', total space := ', - mem^.total_space_allocated); - - lhdr_ptr := mem^.large_list[pool_id]; - while (lhdr_ptr <> NIL) do - begin - WriteLn(output, ' Large chunk used ', - long (lhdr_ptr^.hdr.bytes_used)); - lhdr_ptr := lhdr_ptr^.hdr.next; - end; - - shdr_ptr := mem^.small_list[pool_id]; - - while (shdr_ptr <> NIL) do - begin - WriteLn(output, ' Small chunk used ', - long (shdr_ptr^.hdr.bytes_used), ' free ', - long (shdr_ptr^.hdr.bytes_left) ); - shdr_ptr := shdr_ptr^.hdr.next; - end; -end; - -{$endif} { MEM_STATS } - - -{LOCAL} -procedure out_of_memory (cinfo : j_common_ptr; which : int); -{ Report an out-of-memory error and stop execution } -{ If we compiled MEM_STATS support, report alloc requests before dying } -begin -{$ifdef MEM_STATS} - cinfo^.err^.trace_level := 2; { force self_destruct to report stats } -{$endif} - ERREXIT1(cinfo, JERR_OUT_OF_MEMORY, which); -end; - - -{ Allocation of "small" objects. - - For these, we use pooled storage. When a new pool must be created, - we try to get enough space for the current request plus a "slop" factor, - where the slop will be the amount of leftover space in the new pool. - The speed vs. space tradeoff is largely determined by the slop values. - A different slop value is provided for each pool class (lifetime), - and we also distinguish the first pool of a class from later ones. - NOTE: the values given work fairly well on both 16- and 32-bit-int - machines, but may be too small if longs are 64 bits or more. } - -const - first_pool_slop : array[0..JPOOL_NUMPOOLS-1] of size_t = - (1600, { first PERMANENT pool } - 16000); { first IMAGE pool } - -const - extra_pool_slop : array[0..JPOOL_NUMPOOLS-1] of size_t = - (0, { additional PERMANENT pools } - 5000); { additional IMAGE pools } - -const - MIN_SLOP = 50; { greater than 0 to avoid futile looping } - - -{METHODDEF} -function alloc_small (cinfo : j_common_ptr; - pool_id : int; - sizeofobject : size_t) : pointer; -type - byteptr = ^byte; -{ Allocate a "small" object } -var - mem : my_mem_ptr; - hdr_ptr, prev_hdr_ptr : small_pool_ptr; - data_ptr : byteptr; - odd_bytes, min_request, slop : size_t; -begin - mem := my_mem_ptr (cinfo^.mem); - - { Check for unsatisfiable request (do now to ensure no overflow below) } - if (sizeofobject > size_t(MAX_ALLOC_CHUNK-SIZEOF(small_pool_hdr))) then - out_of_memory(cinfo, 1); { request exceeds malloc's ability } - - { Round up the requested size to a multiple of SIZEOF(ALIGN_TYPE) } - odd_bytes := sizeofobject mod SIZEOF(ALIGN_TYPE); - if (odd_bytes > 0) then - Inc(sizeofobject, SIZEOF(ALIGN_TYPE) - odd_bytes); - - { See if space is available in any existing pool } - if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then - ERREXIT1(j_common_ptr(cinfo), JERR_BAD_POOL_ID, pool_id); { safety check } - prev_hdr_ptr := NIL; - hdr_ptr := mem^.small_list[pool_id]; - while (hdr_ptr <> NIL) do - begin - if (hdr_ptr^.hdr.bytes_left >= sizeofobject) then - break; { found pool with enough space } - prev_hdr_ptr := hdr_ptr; - hdr_ptr := hdr_ptr^.hdr.next; - end; - - { Time to make a new pool? } - if (hdr_ptr = NIL) then - begin - { min_request is what we need now, slop is what will be leftover } - min_request := sizeofobject + SIZEOF(small_pool_hdr); - if (prev_hdr_ptr = NIL) then { first pool in class? } - slop := first_pool_slop[pool_id] - else - slop := extra_pool_slop[pool_id]; - { Don't ask for more than MAX_ALLOC_CHUNK } - if (slop > size_t (MAX_ALLOC_CHUNK-min_request)) then - slop := size_t (MAX_ALLOC_CHUNK-min_request); - { Try to get space, if fail reduce slop and try again } - while TRUE do - begin - hdr_ptr := small_pool_ptr(jpeg_get_small(cinfo, min_request + slop)); - if (hdr_ptr <> NIL) then - break; - slop := slop div 2; - if (slop < MIN_SLOP) then { give up when it gets real small } - out_of_memory(cinfo, 2); { jpeg_get_small failed } - end; - Inc(mem^.total_space_allocated, min_request + slop); - { Success, initialize the new pool header and add to end of list } - hdr_ptr^.hdr.next := NIL; - hdr_ptr^.hdr.bytes_used := 0; - hdr_ptr^.hdr.bytes_left := sizeofobject + slop; - if (prev_hdr_ptr = NIL) then { first pool in class? } - mem^.small_list[pool_id] := hdr_ptr - else - prev_hdr_ptr^.hdr.next := hdr_ptr; - end; - - { OK, allocate the object from the current pool } - data_ptr := byteptr (hdr_ptr); - Inc(small_pool_ptr(data_ptr)); { point to first data byte in pool } - Inc(data_ptr, hdr_ptr^.hdr.bytes_used); { point to place for object } - Inc(hdr_ptr^.hdr.bytes_used, sizeofobject); - Dec(hdr_ptr^.hdr.bytes_left, sizeofobject); - - alloc_small := pointer(data_ptr); -end; - - -{ Allocation of "large" objects. - - The external semantics of these are the same as "small" objects, - except that FAR pointers are used on 80x86. However the pool - management heuristics are quite different. We assume that each - request is large enough that it may as well be passed directly to - jpeg_get_large; the pool management just links everything together - so that we can free it all on demand. - Note: the major use of "large" objects is in JSAMPARRAY and JBLOCKARRAY - structures. The routines that create these structures (see below) - deliberately bunch rows together to ensure a large request size. } - -{METHODDEF} -function alloc_large (cinfo : j_common_ptr; - pool_id : int; - sizeofobject : size_t) : pointer; -{ Allocate a "large" object } -var - mem : my_mem_ptr; - hdr_ptr : large_pool_ptr; - odd_bytes : size_t; -var - dest_ptr : large_pool_ptr; -begin - mem := my_mem_ptr (cinfo^.mem); - - { Check for unsatisfiable request (do now to ensure no overflow below) } - if (sizeofobject > size_t (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr))) then - out_of_memory(cinfo, 3); { request exceeds malloc's ability } - - { Round up the requested size to a multiple of SIZEOF(ALIGN_TYPE) } - odd_bytes := sizeofobject mod SIZEOF(ALIGN_TYPE); - if (odd_bytes > 0) then - Inc(sizeofobject, SIZEOF(ALIGN_TYPE) - odd_bytes); - - { Always make a new pool } - if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then - ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check } - - hdr_ptr := large_pool_ptr (jpeg_get_large(cinfo, sizeofobject + - SIZEOF(large_pool_hdr))); - if (hdr_ptr = NIL) then - out_of_memory(cinfo, 4); { jpeg_get_large failed } - Inc(mem^.total_space_allocated, sizeofobject + SIZEOF(large_pool_hdr)); - - { Success, initialize the new pool header and add to list } - hdr_ptr^.hdr.next := mem^.large_list[pool_id]; - { We maintain space counts in each pool header for statistical purposes, - even though they are not needed for allocation. } - - hdr_ptr^.hdr.bytes_used := sizeofobject; - hdr_ptr^.hdr.bytes_left := 0; - mem^.large_list[pool_id] := hdr_ptr; - - {alloc_large := pointerFAR (hdr_ptr + 1); - point to first data byte in pool } - dest_ptr := hdr_ptr; - Inc(large_pool_ptr(dest_ptr)); - alloc_large := dest_ptr; -end; - - -{ Creation of 2-D sample arrays. - The pointers are in near heap, the samples themselves in FAR heap. - - To minimize allocation overhead and to allow I/O of large contiguous - blocks, we allocate the sample rows in groups of as many rows as possible - without exceeding MAX_ALLOC_CHUNK total bytes per allocation request. - NB: the virtual array control routines, later in this file, know about - this chunking of rows. The rowsperchunk value is left in the mem manager - object so that it can be saved away if this sarray is the workspace for - a virtual array. } - -{METHODDEF} -function alloc_sarray (cinfo : j_common_ptr; - pool_id : int; - samplesperrow : JDIMENSION; - numrows : JDIMENSION) : JSAMPARRAY; -{ Allocate a 2-D sample array } -var - mem : my_mem_ptr; - the_result : JSAMPARRAY; - workspace : JSAMPROW; - rowsperchunk, currow, i : JDIMENSION; - ltemp : long; -begin - mem := my_mem_ptr(cinfo^.mem); - - { Calculate max # of rows allowed in one allocation chunk } - ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div - (long(samplesperrow) * SIZEOF(JSAMPLE)); - if (ltemp <= 0) then - ERREXIT(cinfo, JERR_WIDTH_OVERFLOW); - if (ltemp < long(numrows)) then - rowsperchunk := JDIMENSION (ltemp) - else - rowsperchunk := numrows; - mem^.last_rowsperchunk := rowsperchunk; - - { Get space for row pointers (small object) } - the_result := JSAMPARRAY (alloc_small(cinfo, pool_id, - size_t (numrows * SIZEOF(JSAMPROW)))); - - { Get the rows themselves (large objects) } - currow := 0; - while (currow < numrows) do - begin - {rowsperchunk := MIN(rowsperchunk, numrows - currow);} - if rowsperchunk > numrows - currow then - rowsperchunk := numrows - currow; - - workspace := JSAMPROW (alloc_large(cinfo, pool_id, - size_t (size_t(rowsperchunk) * size_t(samplesperrow) - * SIZEOF(JSAMPLE))) ); - for i := pred(rowsperchunk) downto 0 do - begin - the_result^[currow] := workspace; - Inc(currow); - Inc(JSAMPLE_PTR(workspace), samplesperrow); - end; - end; - - alloc_sarray := the_result; -end; - - -{ Creation of 2-D coefficient-block arrays. - This is essentially the same as the code for sample arrays, above. } - -{METHODDEF} -function alloc_barray (cinfo : j_common_ptr; - pool_id : int; - blocksperrow : JDIMENSION; - numrows : JDIMENSION) : JBLOCKARRAY; -{ Allocate a 2-D coefficient-block array } -var - mem : my_mem_ptr; - the_result : JBLOCKARRAY; - workspace : JBLOCKROW; - rowsperchunk, currow, i : JDIMENSION; - ltemp : long; -begin - mem := my_mem_ptr(cinfo^.mem); - - { Calculate max # of rows allowed in one allocation chunk } - ltemp := (MAX_ALLOC_CHUNK-SIZEOF(large_pool_hdr)) div - (long(blocksperrow) * SIZEOF(JBLOCK)); - - if (ltemp <= 0) then - ERREXIT(cinfo, JERR_WIDTH_OVERFLOW); - if (ltemp < long(numrows)) then - rowsperchunk := JDIMENSION (ltemp) - else - rowsperchunk := numrows; - mem^.last_rowsperchunk := rowsperchunk; - - { Get space for row pointers (small object) } - the_result := JBLOCKARRAY (alloc_small(cinfo, pool_id, - size_t (numrows * SIZEOF(JBLOCKROW))) ); - - { Get the rows themselves (large objects) } - currow := 0; - while (currow < numrows) do - begin - {rowsperchunk := MIN(rowsperchunk, numrows - currow);} - if rowsperchunk > numrows - currow then - rowsperchunk := numrows - currow; - - workspace := JBLOCKROW (alloc_large(cinfo, pool_id, - size_t (size_t(rowsperchunk) * size_t(blocksperrow) - * SIZEOF(JBLOCK))) ); - for i := rowsperchunk downto 1 do - begin - the_result^[currow] := workspace; - Inc(currow); - Inc(JBLOCK_PTR(workspace), blocksperrow); - end; - end; - - alloc_barray := the_result; -end; - - -{ About virtual array management: - - The above "normal" array routines are only used to allocate strip buffers - (as wide as the image, but just a few rows high). Full-image-sized buffers - are handled as "virtual" arrays. The array is still accessed a strip at a - time, but the memory manager must save the whole array for repeated - accesses. The intended implementation is that there is a strip buffer in - memory (as high as is possible given the desired memory limit), plus a - backing file that holds the rest of the array. - - The request_virt_array routines are told the total size of the image and - the maximum number of rows that will be accessed at once. The in-memory - buffer must be at least as large as the maxaccess value. - - The request routines create control blocks but not the in-memory buffers. - That is postponed until realize_virt_arrays is called. At that time the - total amount of space needed is known (approximately, anyway), so free - memory can be divided up fairly. - - The access_virt_array routines are responsible for making a specific strip - area accessible (after reading or writing the backing file, if necessary). - Note that the access routines are told whether the caller intends to modify - the accessed strip; during a read-only pass this saves having to rewrite - data to disk. The access routines are also responsible for pre-zeroing - any newly accessed rows, if pre-zeroing was requested. - - In current usage, the access requests are usually for nonoverlapping - strips; that is, successive access start_row numbers differ by exactly - num_rows := maxaccess. This means we can get good performance with simple - buffer dump/reload logic, by making the in-memory buffer be a multiple - of the access height; then there will never be accesses across bufferload - boundaries. The code will still work with overlapping access requests, - but it doesn't handle bufferload overlaps very efficiently. } - - -{METHODDEF} -function request_virt_sarray (cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - samplesperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_sarray_ptr; -{ Request a virtual 2-D sample array } -var - mem : my_mem_ptr; - the_result : jvirt_sarray_ptr; -begin - mem := my_mem_ptr (cinfo^.mem); - - { Only IMAGE-lifetime virtual arrays are currently supported } - if (pool_id <> JPOOL_IMAGE) then - ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check } - - { get control block } - the_result := jvirt_sarray_ptr (alloc_small(cinfo, pool_id, - SIZEOF(jvirt_sarray_control)) ); - - the_result^.mem_buffer := NIL; { marks array not yet realized } - the_result^.rows_in_array := numrows; - the_result^.samplesperrow := samplesperrow; - the_result^.maxaccess := maxaccess; - the_result^.pre_zero := pre_zero; - the_result^.b_s_open := FALSE; { no associated backing-store object } - the_result^.next := mem^.virt_sarray_list; { add to list of virtual arrays } - mem^.virt_sarray_list := the_result; - - request_virt_sarray := the_result; -end; - - -{METHODDEF} -function request_virt_barray (cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - blocksperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_barray_ptr; -{ Request a virtual 2-D coefficient-block array } -var - mem : my_mem_ptr; - the_result : jvirt_barray_ptr; -begin - mem := my_mem_ptr(cinfo^.mem); - - { Only IMAGE-lifetime virtual arrays are currently supported } - if (pool_id <> JPOOL_IMAGE) then - ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check } - - { get control block } - the_result := jvirt_barray_ptr(alloc_small(cinfo, pool_id, - SIZEOF(jvirt_barray_control)) ); - - the_result^.mem_buffer := NIL; { marks array not yet realized } - the_result^.rows_in_array := numrows; - the_result^.blocksperrow := blocksperrow; - the_result^.maxaccess := maxaccess; - the_result^.pre_zero := pre_zero; - the_result^.b_s_open := FALSE; { no associated backing-store object } - the_result^.next := mem^.virt_barray_list; { add to list of virtual arrays } - mem^.virt_barray_list := the_result; - - request_virt_barray := the_result; -end; - - -{METHODDEF} -procedure realize_virt_arrays (cinfo : j_common_ptr); -{ Allocate the in-memory buffers for any unrealized virtual arrays } -var - mem : my_mem_ptr; - space_per_minheight, maximum_space, avail_mem : long; - minheights, max_minheights : long; - sptr : jvirt_sarray_ptr; - bptr : jvirt_barray_ptr; -begin - mem := my_mem_ptr (cinfo^.mem); - { Compute the minimum space needed (maxaccess rows in each buffer) - and the maximum space needed (full image height in each buffer). - These may be of use to the system-dependent jpeg_mem_available routine. } - - space_per_minheight := 0; - maximum_space := 0; - sptr := mem^.virt_sarray_list; - while (sptr <> NIL) do - begin - if (sptr^.mem_buffer = NIL) then - begin { if not realized yet } - Inc(space_per_minheight, long(sptr^.maxaccess) * - long(sptr^.samplesperrow) * SIZEOF(JSAMPLE)); - Inc(maximum_space, long(sptr^.rows_in_array) * - long(sptr^.samplesperrow) * SIZEOF(JSAMPLE)); - end; - sptr := sptr^.next; - end; - bptr := mem^.virt_barray_list; - while (bptr <> NIL) do - begin - if (bptr^.mem_buffer = NIL) then - begin { if not realized yet } - Inc(space_per_minheight, long(bptr^.maxaccess) * - long(bptr^.blocksperrow) * SIZEOF(JBLOCK)); - Inc(maximum_space, long(bptr^.rows_in_array) * - long(bptr^.blocksperrow) * SIZEOF(JBLOCK)); - end; - bptr := bptr^.next; - end; - - if (space_per_minheight <= 0) then - exit; { no unrealized arrays, no work } - - { Determine amount of memory to actually use; this is system-dependent. } - avail_mem := jpeg_mem_available(cinfo, space_per_minheight, maximum_space, - mem^.total_space_allocated); - - { If the maximum space needed is available, make all the buffers full - height; otherwise parcel it out with the same number of minheights - in each buffer. } - - if (avail_mem >= maximum_space) then - max_minheights := long(1000000000) - else - begin - max_minheights := avail_mem div space_per_minheight; - { If there doesn't seem to be enough space, try to get the minimum - anyway. This allows a "stub" implementation of jpeg_mem_available(). } - if (max_minheights <= 0) then - max_minheights := 1; - end; - - { Allocate the in-memory buffers and initialize backing store as needed. } - - sptr := mem^.virt_sarray_list; - while (sptr <> NIL) do - begin - if (sptr^.mem_buffer = NIL) then - begin { if not realized yet } - minheights := (long(sptr^.rows_in_array) - long(1)) div LongInt(sptr^.maxaccess) + long(1); - if (minheights <= max_minheights) then - begin - { This buffer fits in memory } - sptr^.rows_in_mem := sptr^.rows_in_array; - end - else - begin - { It doesn't fit in memory, create backing store. } - sptr^.rows_in_mem := JDIMENSION(max_minheights) * sptr^.maxaccess; - jpeg_open_backing_store(cinfo, - @sptr^.b_s_info, - long(sptr^.rows_in_array) * - long(sptr^.samplesperrow) * - long(SIZEOF(JSAMPLE))); - sptr^.b_s_open := TRUE; - end; - sptr^.mem_buffer := alloc_sarray(cinfo, JPOOL_IMAGE, - sptr^.samplesperrow, sptr^.rows_in_mem); - sptr^.rowsperchunk := mem^.last_rowsperchunk; - sptr^.cur_start_row := 0; - sptr^.first_undef_row := 0; - sptr^.dirty := FALSE; - end; - sptr := sptr^.next; - end; - - bptr := mem^.virt_barray_list; - while (bptr <> NIL) do - begin - if (bptr^.mem_buffer = NIL) then - begin { if not realized yet } - minheights := (long(bptr^.rows_in_array) - long(1)) div LongInt(bptr^.maxaccess) + long(1); - if (minheights <= max_minheights) then - begin - { This buffer fits in memory } - bptr^.rows_in_mem := bptr^.rows_in_array; - end - else - begin - { It doesn't fit in memory, create backing store. } - bptr^.rows_in_mem := JDIMENSION (max_minheights) * bptr^.maxaccess; - jpeg_open_backing_store(cinfo, - @bptr^.b_s_info, - long(bptr^.rows_in_array) * - long(bptr^.blocksperrow) * - long(SIZEOF(JBLOCK))); - bptr^.b_s_open := TRUE; - end; - bptr^.mem_buffer := alloc_barray(cinfo, JPOOL_IMAGE, - bptr^.blocksperrow, bptr^.rows_in_mem); - bptr^.rowsperchunk := mem^.last_rowsperchunk; - bptr^.cur_start_row := 0; - bptr^.first_undef_row := 0; - bptr^.dirty := FALSE; - end; - bptr := bptr^.next; - end; -end; - - -{LOCAL} -procedure do_sarray_io (cinfo : j_common_ptr; - ptr : jvirt_sarray_ptr; - writing : boolean); -{ Do backing store read or write of a virtual sample array } -var - bytesperrow, file_offset, byte_count, rows, thisrow, i : long; -begin - - bytesperrow := long(ptr^.samplesperrow * SIZEOF(JSAMPLE)); - file_offset := LongInt(ptr^.cur_start_row) * bytesperrow; - { Loop to read or write each allocation chunk in mem_buffer } - i := 0; - while i < long(ptr^.rows_in_mem) do - begin - - { One chunk, but check for short chunk at end of buffer } - {rows := MIN(long(ptr^.rowsperchunk), long(ptr^.rows_in_mem - i));} - rows := long(ptr^.rowsperchunk); - if rows > long(ptr^.rows_in_mem) - i then - rows := long(ptr^.rows_in_mem) - i; - { Transfer no more than is currently defined } - thisrow := long (ptr^.cur_start_row) + i; - {rows := MIN(rows, long(ptr^.first_undef_row) - thisrow);} - if (rows > long(ptr^.first_undef_row) - thisrow) then - rows := long(ptr^.first_undef_row) - thisrow; - { Transfer no more than fits in file } - {rows := MIN(rows, long(ptr^.rows_in_array) - thisrow);} - if (rows > long(ptr^.rows_in_array) - thisrow) then - rows := long(ptr^.rows_in_array) - thisrow; - - if (rows <= 0) then { this chunk might be past end of file! } - break; - byte_count := rows * bytesperrow; - if (writing) then - ptr^.b_s_info.write_backing_store (cinfo, - @ptr^.b_s_info, - pointer {FAR} (ptr^.mem_buffer^[i]), - file_offset, byte_count) - else - ptr^.b_s_info.read_backing_store (cinfo, - @ptr^.b_s_info, - pointer {FAR} (ptr^.mem_buffer^[i]), - file_offset, byte_count); - Inc(file_offset, byte_count); - Inc(i, ptr^.rowsperchunk); - end; -end; - - -{LOCAL} -procedure do_barray_io (cinfo : j_common_ptr; - ptr : jvirt_barray_ptr; - writing : boolean); -{ Do backing store read or write of a virtual coefficient-block array } -var - bytesperrow, file_offset, byte_count, rows, thisrow, i : long; -begin - bytesperrow := long (ptr^.blocksperrow) * SIZEOF(JBLOCK); - file_offset := LongInt(ptr^.cur_start_row) * bytesperrow; - { Loop to read or write each allocation chunk in mem_buffer } - i := 0; - while (i < long(ptr^.rows_in_mem)) do - begin - { One chunk, but check for short chunk at end of buffer } - {rows := MIN(long(ptr^.rowsperchunk), long(ptr^.rows_in_mem - i));} - rows := long(ptr^.rowsperchunk); - if rows > long(ptr^.rows_in_mem) - i then - rows := long(ptr^.rows_in_mem) - i; - { Transfer no more than is currently defined } - thisrow := long (ptr^.cur_start_row) + i; - {rows := MIN(rows, long(ptr^.first_undef_row - thisrow));} - if rows > long(ptr^.first_undef_row) - thisrow then - rows := long(ptr^.first_undef_row) - thisrow; - { Transfer no more than fits in file } - {rows := MIN(rows, long (ptr^.rows_in_array - thisrow));} - if (rows > long (ptr^.rows_in_array) - thisrow) then - rows := long (ptr^.rows_in_array) - thisrow; - - if (rows <= 0) then { this chunk might be past end of file! } - break; - byte_count := rows * bytesperrow; - if (writing) then - ptr^.b_s_info.write_backing_store (cinfo, - @ptr^.b_s_info, - {FAR} pointer(ptr^.mem_buffer^[i]), - file_offset, byte_count) - else - ptr^.b_s_info.read_backing_store (cinfo, - @ptr^.b_s_info, - {FAR} pointer(ptr^.mem_buffer^[i]), - file_offset, byte_count); - Inc(file_offset, byte_count); - Inc(i, ptr^.rowsperchunk); - end; -end; - - -{METHODDEF} -function access_virt_sarray (cinfo : j_common_ptr; - ptr : jvirt_sarray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean ) : JSAMPARRAY; -{ Access the part of a virtual sample array starting at start_row } -{ and extending for num_rows rows. writable is true if } -{ caller intends to modify the accessed area. } -var - end_row : JDIMENSION; - undef_row : JDIMENSION; -var - bytesperrow : size_t; -var - ltemp : long; -begin - end_row := start_row + num_rows; - { debugging check } - if (end_row > ptr^.rows_in_array) or (num_rows > ptr^.maxaccess) or - (ptr^.mem_buffer = NIL) then - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - - { Make the desired part of the virtual array accessible } - if (start_row < ptr^.cur_start_row) or - (end_row > ptr^.cur_start_row+ptr^.rows_in_mem) then - begin - if (not ptr^.b_s_open) then - ERREXIT(cinfo, JERR_VIRTUAL_BUG); - { Flush old buffer contents if necessary } - if (ptr^.dirty) then - begin - do_sarray_io(cinfo, ptr, TRUE); - ptr^.dirty := FALSE; - end; - { Decide what part of virtual array to access. - Algorithm: if target address > current window, assume forward scan, - load starting at target address. If target address < current window, - assume backward scan, load so that target area is top of window. - Note that when switching from forward write to forward read, will have - start_row := 0, so the limiting case applies and we load from 0 anyway. } - if (start_row > ptr^.cur_start_row) then - begin - ptr^.cur_start_row := start_row; - end - else - begin - { use long arithmetic here to avoid overflow & unsigned problems } - - - ltemp := long(end_row) - long(ptr^.rows_in_mem); - if (ltemp < 0) then - ltemp := 0; { don't fall off front end of file } - ptr^.cur_start_row := JDIMENSION(ltemp); - end; - { Read in the selected part of the array. - During the initial write pass, we will do no actual read - because the selected part is all undefined. } - - do_sarray_io(cinfo, ptr, FALSE); - end; - { Ensure the accessed part of the array is defined; prezero if needed. - To improve locality of access, we only prezero the part of the array - that the caller is about to access, not the entire in-memory array. } - if (ptr^.first_undef_row < end_row) then - begin - if (ptr^.first_undef_row < start_row) then - begin - if (writable) then { writer skipped over a section of array } - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - undef_row := start_row; { but reader is allowed to read ahead } - end - else - begin - undef_row := ptr^.first_undef_row; - end; - if (writable) then - ptr^.first_undef_row := end_row; - if (ptr^.pre_zero) then - begin - bytesperrow := size_t(ptr^.samplesperrow) * SIZEOF(JSAMPLE); - Dec(undef_row, ptr^.cur_start_row); { make indexes relative to buffer } - Dec(end_row, ptr^.cur_start_row); - while (undef_row < end_row) do - begin - jzero_far({FAR} pointer(ptr^.mem_buffer^[undef_row]), bytesperrow); - Inc(undef_row); - end; - end - else - begin - if (not writable) then { reader looking at undefined data } - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - end; - end; - { Flag the buffer dirty if caller will write in it } - if (writable) then - ptr^.dirty := TRUE; - { Return address of proper part of the buffer } - access_virt_sarray := JSAMPARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]); -end; - - -{METHODDEF} -function access_virt_barray (cinfo : j_common_ptr; - ptr : jvirt_barray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean) : JBLOCKARRAY; -{ Access the part of a virtual block array starting at start_row } -{ and extending for num_rows rows. writable is true if } -{ caller intends to modify the accessed area. } -var - end_row : JDIMENSION; - undef_row : JDIMENSION; - ltemp : long; -var - bytesperrow : size_t; -begin - end_row := start_row + num_rows; - - { debugging check } - if (end_row > ptr^.rows_in_array) or (num_rows > ptr^.maxaccess) or - (ptr^.mem_buffer = NIL) then - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - - { Make the desired part of the virtual array accessible } - if (start_row < ptr^.cur_start_row) or - (end_row > ptr^.cur_start_row+ptr^.rows_in_mem) then - begin - if (not ptr^.b_s_open) then - ERREXIT(cinfo, JERR_VIRTUAL_BUG); - { Flush old buffer contents if necessary } - if (ptr^.dirty) then - begin - do_barray_io(cinfo, ptr, TRUE); - ptr^.dirty := FALSE; - end; - { Decide what part of virtual array to access. - Algorithm: if target address > current window, assume forward scan, - load starting at target address. If target address < current window, - assume backward scan, load so that target area is top of window. - Note that when switching from forward write to forward read, will have - start_row := 0, so the limiting case applies and we load from 0 anyway. } - - if (start_row > ptr^.cur_start_row) then - begin - ptr^.cur_start_row := start_row; - end - else - begin - { use long arithmetic here to avoid overflow & unsigned problems } - - ltemp := long(end_row) - long(ptr^.rows_in_mem); - if (ltemp < 0) then - ltemp := 0; { don't fall off front end of file } - ptr^.cur_start_row := JDIMENSION (ltemp); - end; - { Read in the selected part of the array. - During the initial write pass, we will do no actual read - because the selected part is all undefined. } - - do_barray_io(cinfo, ptr, FALSE); - end; - { Ensure the accessed part of the array is defined; prezero if needed. - To improve locality of access, we only prezero the part of the array - that the caller is about to access, not the entire in-memory array. } - - if (ptr^.first_undef_row < end_row) then - begin - if (ptr^.first_undef_row < start_row) then - begin - if (writable) then { writer skipped over a section of array } - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - undef_row := start_row; { but reader is allowed to read ahead } - end - else - begin - undef_row := ptr^.first_undef_row; - end; - if (writable) then - ptr^.first_undef_row := end_row; - if (ptr^.pre_zero) then - begin - bytesperrow := size_t (ptr^.blocksperrow) * SIZEOF(JBLOCK); - Dec(undef_row, ptr^.cur_start_row); { make indexes relative to buffer } - Dec(end_row, ptr^.cur_start_row); - while (undef_row < end_row) do - begin - jzero_far({FAR}pointer(ptr^.mem_buffer^[undef_row]), bytesperrow); - Inc(undef_row); - end; - end - else - begin - if (not writable) then { reader looking at undefined data } - ERREXIT(cinfo, JERR_BAD_VIRTUAL_ACCESS); - end; - end; - { Flag the buffer dirty if caller will write in it } - if (writable) then - ptr^.dirty := TRUE; - { Return address of proper part of the buffer } - access_virt_barray := JBLOCKARRAY(@ ptr^.mem_buffer^[start_row - ptr^.cur_start_row]); -end; - - -{ Release all objects belonging to a specified pool. } - -{METHODDEF} -procedure free_pool (cinfo : j_common_ptr; pool_id : int); -var - mem : my_mem_ptr; - shdr_ptr : small_pool_ptr; - lhdr_ptr : large_pool_ptr; - space_freed : size_t; -var - sptr : jvirt_sarray_ptr; - bptr : jvirt_barray_ptr; -var - next_lhdr_ptr : large_pool_ptr; - next_shdr_ptr : small_pool_ptr; -begin - mem := my_mem_ptr(cinfo^.mem); - - if (pool_id < 0) or (pool_id >= JPOOL_NUMPOOLS) then - ERREXIT1(cinfo, JERR_BAD_POOL_ID, pool_id); { safety check } - -{$ifdef MEM_STATS} - if (cinfo^.err^.trace_level > 1) then - print_mem_stats(cinfo, pool_id); { print pool's memory usage statistics } -{$endif} - - { If freeing IMAGE pool, close any virtual arrays first } - if (pool_id = JPOOL_IMAGE) then - begin - sptr := mem^.virt_sarray_list; - while (sptr <> NIL) do - begin - if (sptr^.b_s_open) then - begin { there may be no backing store } - sptr^.b_s_open := FALSE; { prevent recursive close if error } - sptr^.b_s_info.close_backing_store (cinfo, @sptr^.b_s_info); - end; - sptr := sptr^.next; - end; - mem^.virt_sarray_list := NIL; - bptr := mem^.virt_barray_list; - while (bptr <> NIL) do - begin - if (bptr^.b_s_open) then - begin { there may be no backing store } - bptr^.b_s_open := FALSE; { prevent recursive close if error } - bptr^.b_s_info.close_backing_store (cinfo, @bptr^.b_s_info); - end; - bptr := bptr^.next; - end; - mem^.virt_barray_list := NIL; - end; - - { Release large objects } - lhdr_ptr := mem^.large_list[pool_id]; - mem^.large_list[pool_id] := NIL; - - while (lhdr_ptr <> NIL) do - begin - next_lhdr_ptr := lhdr_ptr^.hdr.next; - space_freed := lhdr_ptr^.hdr.bytes_used + - lhdr_ptr^.hdr.bytes_left + - SIZEOF(large_pool_hdr); - jpeg_free_large(cinfo, {FAR} pointer(lhdr_ptr), space_freed); - Dec(mem^.total_space_allocated, space_freed); - lhdr_ptr := next_lhdr_ptr; - end; - - { Release small objects } - shdr_ptr := mem^.small_list[pool_id]; - mem^.small_list[pool_id] := NIL; - - while (shdr_ptr <> NIL) do - begin - next_shdr_ptr := shdr_ptr^.hdr.next; - space_freed := shdr_ptr^.hdr.bytes_used + - shdr_ptr^.hdr.bytes_left + - SIZEOF(small_pool_hdr); - jpeg_free_small(cinfo, pointer(shdr_ptr), space_freed); - Dec(mem^.total_space_allocated, space_freed); - shdr_ptr := next_shdr_ptr; - end; -end; - - -{ Close up shop entirely. - Note that this cannot be called unless cinfo^.mem is non-NIL. } - -{METHODDEF} -procedure self_destruct (cinfo : j_common_ptr); -var - pool : int; -begin - { Close all backing store, release all memory. - Releasing pools in reverse order might help avoid fragmentation - with some (brain-damaged) malloc libraries. } - - for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do - begin - free_pool(cinfo, pool); - end; - - { Release the memory manager control block too. } - jpeg_free_small(cinfo, pointer(cinfo^.mem), SIZEOF(my_memory_mgr)); - cinfo^.mem := NIL; { ensures I will be called only once } - - jpeg_mem_term(cinfo); { system-dependent cleanup } -end; - - -{ Memory manager initialization. - When this is called, only the error manager pointer is valid in cinfo! } - -{GLOBAL} -procedure jinit_memory_mgr (cinfo : j_common_ptr); -var - mem : my_mem_ptr; - max_to_use : long; - pool : int; - test_mac : size_t; -{$ifndef NO_GETENV} -var - memenv : string; - code : integer; -{$endif} -begin - cinfo^.mem := NIL; { for safety if init fails } - - { Check for configuration errors. - SIZEOF(ALIGN_TYPE) should be a power of 2; otherwise, it probably - doesn't reflect any real hardware alignment requirement. - The test is a little tricky: for X>0, X and X-1 have no one-bits - in common if and only if X is a power of 2, ie has only one one-bit. - Some compilers may give an "unreachable code" warning here; ignore it. } - if ((SIZEOF(ALIGN_TYPE) and (SIZEOF(ALIGN_TYPE)-1)) <> 0) then - ERREXIT(cinfo, JERR_BAD_ALIGN_TYPE); - { MAX_ALLOC_CHUNK must be representable as type size_t, and must be - a multiple of SIZEOF(ALIGN_TYPE). - Again, an "unreachable code" warning may be ignored here. - But a "constant too large" warning means you need to fix MAX_ALLOC_CHUNK. } - - test_mac := size_t (MAX_ALLOC_CHUNK); - if (long (test_mac) <> MAX_ALLOC_CHUNK) or - ((MAX_ALLOC_CHUNK mod SIZEOF(ALIGN_TYPE)) <> 0) then - ERREXIT(cinfo, JERR_BAD_ALLOC_CHUNK); - - max_to_use := jpeg_mem_init(cinfo); { system-dependent initialization } - - { Attempt to allocate memory manager's control block } - mem := my_mem_ptr (jpeg_get_small(cinfo, SIZEOF(my_memory_mgr))); - - if (mem = NIL) then - begin - jpeg_mem_term(cinfo); { system-dependent cleanup } - ERREXIT1(cinfo, JERR_OUT_OF_MEMORY, 0); - end; - - { OK, fill in the method pointers } - mem^.pub.alloc_small := alloc_small; - mem^.pub.alloc_large := alloc_large; - mem^.pub.alloc_sarray := alloc_sarray; - mem^.pub.alloc_barray := alloc_barray; - mem^.pub.request_virt_sarray := request_virt_sarray; - mem^.pub.request_virt_barray := request_virt_barray; - mem^.pub.realize_virt_arrays := realize_virt_arrays; - mem^.pub.access_virt_sarray := access_virt_sarray; - mem^.pub.access_virt_barray := access_virt_barray; - mem^.pub.free_pool := free_pool; - mem^.pub.self_destruct := self_destruct; - - { Make MAX_ALLOC_CHUNK accessible to other modules } - mem^.pub.max_alloc_chunk := MAX_ALLOC_CHUNK; - - { Initialize working state } - mem^.pub.max_memory_to_use := max_to_use; - - for pool := JPOOL_NUMPOOLS-1 downto JPOOL_PERMANENT do - begin - mem^.small_list[pool] := NIL; - mem^.large_list[pool] := NIL; - end; - mem^.virt_sarray_list := NIL; - mem^.virt_barray_list := NIL; - - mem^.total_space_allocated := SIZEOF(my_memory_mgr); - - { Declare ourselves open for business } - cinfo^.mem := @mem^.pub; - - { Check for an environment variable JPEGMEM; if found, override the - default max_memory setting from jpeg_mem_init. Note that the - surrounding application may again override this value. - If your system doesn't support getenv(), define NO_GETENV to disable - this feature. } - -{$ifndef NO_GETENV} - memenv := getenv('JPEGMEM'); - if (memenv <> '') then - begin - Val(memenv, max_to_use, code); - if (Code = 0) then - begin - max_to_use := max_to_use * long(1000); - mem^.pub.max_memory_to_use := max_to_use * long(1000); - end; - end; -{$endif} - -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjmemnobs.pas b/3rd/Imaging/Source/JpegLib/imjmemnobs.pas deleted file mode 100644 index 750fd807e..000000000 --- a/3rd/Imaging/Source/JpegLib/imjmemnobs.pas +++ /dev/null @@ -1,259 +0,0 @@ -unit imjmemnobs; -{ Delphi3 -- > jmemnobs from jmemwin } -{ This file provides an Win32-compatible implementation of the system- - dependent portion of the JPEG memory manager. } - -{ Check jmemnobs.c } -{ Copyright (C) 1996, Jacques Nomssi Nzali } - - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjdeferr, - imjerror, - imjpeglib; - -{ The macro MAX_ALLOC_CHUNK designates the maximum number of bytes that may - be requested in a single call to jpeg_get_large (and jpeg_get_small for that - matter, but that case should never come into play). This macro is needed - to model the 64Kb-segment-size limit of far addressing on 80x86 machines. - On those machines, we expect that jconfig.h will provide a proper value. - On machines with 32-bit flat address spaces, any large constant may be used. - - NB: jmemmgr.c expects that MAX_ALLOC_CHUNK will be representable as type - size_t and will be a multiple of sizeof(align_type). } - -const - MAX_ALLOC_CHUNK = long(1000000000); - -{GLOBAL} -procedure jpeg_open_backing_store (cinfo : j_common_ptr; - info : backing_store_ptr; - total_bytes_needed : long); - -{ These routines take care of any system-dependent initialization and - cleanup required. } - -{GLOBAL} -function jpeg_mem_init (cinfo : j_common_ptr) : long; - -{GLOBAL} -procedure jpeg_mem_term (cinfo : j_common_ptr); - -{ These two functions are used to allocate and release small chunks of - memory. (Typically the total amount requested through jpeg_get_small is - no more than 20K or so; this will be requested in chunks of a few K each.) - Behavior should be the same as for the standard library functions malloc - and free; in particular, jpeg_get_small must return NIL on failure. - On most systems, these ARE malloc and free. jpeg_free_small is passed the - size of the object being freed, just in case it's needed. - On an 80x86 machine using small-data memory model, these manage near heap. } - - -{ Near-memory allocation and freeing are controlled by the regular library - routines malloc() and free(). } - -{GLOBAL} -function jpeg_get_small (cinfo : j_common_ptr; - sizeofobject : size_t) : pointer; - -{GLOBAL} -{object is a reserved word in Borland Pascal } -procedure jpeg_free_small (cinfo : j_common_ptr; - an_object : pointer; - sizeofobject : size_t); - -{ These two functions are used to allocate and release large chunks of - memory (up to the total free space designated by jpeg_mem_available). - The interface is the same as above, except that on an 80x86 machine, - far pointers are used. On most other machines these are identical to - the jpeg_get/free_small routines; but we keep them separate anyway, - in case a different allocation strategy is desirable for large chunks. } - - -{ "Large" objects are allocated in far memory, if possible } - - -{GLOBAL} -function jpeg_get_large (cinfo : j_common_ptr; - sizeofobject : size_t) : voidp; {far} - -{GLOBAL} -procedure jpeg_free_large (cinfo : j_common_ptr; - {var?} an_object : voidp; {FAR} - sizeofobject : size_t); - -{ This routine computes the total memory space available for allocation. - It's impossible to do this in a portable way; our current solution is - to make the user tell us (with a default value set at compile time). - If you can actually get the available space, it's a good idea to subtract - a slop factor of 5% or so. } - -{GLOBAL} -function jpeg_mem_available (cinfo : j_common_ptr; - min_bytes_needed : long; - max_bytes_needed : long; - already_allocated : long) : long; - - -implementation - -{ This structure holds whatever state is needed to access a single - backing-store object. The read/write/close method pointers are called - by jmemmgr.c to manipulate the backing-store object; all other fields - are private to the system-dependent backing store routines. } - - - -{ These two functions are used to allocate and release small chunks of - memory. (Typically the total amount requested through jpeg_get_small is - no more than 20K or so; this will be requested in chunks of a few K each.) - Behavior should be the same as for the standard library functions malloc - and free; in particular, jpeg_get_small must return NIL on failure. - On most systems, these ARE malloc and free. jpeg_free_small is passed the - size of the object being freed, just in case it's needed. - On an 80x86 machine using small-data memory model, these manage near heap. } - - -{ Near-memory allocation and freeing are controlled by the regular library - routines malloc() and free(). } - -{GLOBAL} -function jpeg_get_small (cinfo : j_common_ptr; - sizeofobject : size_t) : pointer; -var - p : pointer; -begin - GetMem(p, sizeofobject); - jpeg_get_small := p; -end; - -{GLOBAL} -{object is a reserved word in Object Pascal } -procedure jpeg_free_small (cinfo : j_common_ptr; - an_object : pointer; - sizeofobject : size_t); -begin - FreeMem(an_object, sizeofobject); -end; - -{ These two functions are used to allocate and release large chunks of - memory (up to the total free space designated by jpeg_mem_available). - The interface is the same as above, except that on an 80x86 machine, - far pointers are used. On most other machines these are identical to - the jpeg_get/free_small routines; but we keep them separate anyway, - in case a different allocation strategy is desirable for large chunks. } - - - -{GLOBAL} -function jpeg_get_large (cinfo : j_common_ptr; - sizeofobject : size_t) : voidp; {far} -var - p : pointer; -begin - GetMem(p, sizeofobject); - jpeg_get_large := p; -end; - -{GLOBAL} -procedure jpeg_free_large (cinfo : j_common_ptr; - {var?} an_object : voidp; {FAR} - sizeofobject : size_t); -begin - Freemem(an_object, sizeofobject); -end; - -{ This routine computes the total space still available for allocation by - jpeg_get_large. If more space than this is needed, backing store will be - used. NOTE: any memory already allocated must not be counted. - - There is a minimum space requirement, corresponding to the minimum - feasible buffer sizes; jmemmgr.c will request that much space even if - jpeg_mem_available returns zero. The maximum space needed, enough to hold - all working storage in memory, is also passed in case it is useful. - Finally, the total space already allocated is passed. If no better - method is available, cinfo^.mem^.max_memory_to_use - already_allocated - is often a suitable calculation. - - It is OK for jpeg_mem_available to underestimate the space available - (that'll just lead to more backing-store access than is really necessary). - However, an overestimate will lead to failure. Hence it's wise to subtract - a slop factor from the true available space. 5% should be enough. - - On machines with lots of virtual memory, any large constant may be returned. - Conversely, zero may be returned to always use the minimum amount of memory.} - - - -{ This routine computes the total memory space available for allocation. - It's impossible to do this in a portable way; our current solution is - to make the user tell us (with a default value set at compile time). - If you can actually get the available space, it's a good idea to subtract - a slop factor of 5% or so. } - -const - DEFAULT_MAX_MEM = long(300000); { for total usage about 450K } - -{GLOBAL} -function jpeg_mem_available (cinfo : j_common_ptr; - min_bytes_needed : long; - max_bytes_needed : long; - already_allocated : long) : long; -begin - {jpeg_mem_available := cinfo^.mem^.max_memory_to_use - already_allocated;} - jpeg_mem_available := max_bytes_needed; -end; - - -{ Initial opening of a backing-store object. This must fill in the - read/write/close pointers in the object. The read/write routines - may take an error exit if the specified maximum file size is exceeded. - (If jpeg_mem_available always returns a large value, this routine can - just take an error exit.) } - - - -{ Initial opening of a backing-store object. } - -{GLOBAL} -procedure jpeg_open_backing_store (cinfo : j_common_ptr; - info : backing_store_ptr; - total_bytes_needed : long); -begin - ERREXIT(cinfo, JERR_NO_BACKING_STORE); -end; - -{ These routines take care of any system-dependent initialization and - cleanup required. jpeg_mem_init will be called before anything is - allocated (and, therefore, nothing in cinfo is of use except the error - manager pointer). It should return a suitable default value for - max_memory_to_use; this may subsequently be overridden by the surrounding - application. (Note that max_memory_to_use is only important if - jpeg_mem_available chooses to consult it ... no one else will.) - jpeg_mem_term may assume that all requested memory has been freed and that - all opened backing-store objects have been closed. } - - -{ These routines take care of any system-dependent initialization and - cleanup required. } - - -{GLOBAL} -function jpeg_mem_init (cinfo : j_common_ptr) : long; -begin - jpeg_mem_init := DEFAULT_MAX_MEM; { default for max_memory_to_use } -end; - -{GLOBAL} -procedure jpeg_mem_term (cinfo : j_common_ptr); -begin - -end; - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjmorecfg.pas b/3rd/Imaging/Source/JpegLib/imjmorecfg.pas deleted file mode 100644 index fddf3f5b8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjmorecfg.pas +++ /dev/null @@ -1,219 +0,0 @@ -unit imjmorecfg; - -{ This file contains additional configuration options that customize the - JPEG software for special applications or support machine-dependent - optimizations. Most users will not need to touch this file. } - -{ Source: jmorecfg.h; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -type - int = Integer; - uInt = Cardinal; - short = SmallInt; - ushort = Word; - long = LongInt; - -type - voidp = pointer; - -type - int_ptr = ^int; - size_t = int; - -{ Define BITS_IN_JSAMPLE as either - 8 for 8-bit sample values (the usual setting) - 12 for 12-bit sample values - Only 8 and 12 are legal data precisions for lossy JPEG according to the - JPEG standard, and the IJG code does not support anything else! - We do not support run-time selection of data precision, sorry. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} { use 8 or 12 } -const - BITS_IN_JSAMPLE = 8; -{$else} -const - BITS_IN_JSAMPLE = 12; -{$endif} - - -{ Maximum number of components (color channels) allowed in JPEG image. - To meet the letter of the JPEG spec, set this to 255. However, darn - few applications need more than 4 channels (maybe 5 for CMYK + alpha - mask). We recommend 10 as a reasonable compromise; use 4 if you are - really short on memory. (Each allowed component costs a hundred or so - bytes of storage, whether actually used in an image or not.) } - - -const - MAX_COMPONENTS = 10; { maximum number of image components } - - -{ Basic data types. - You may need to change these if you have a machine with unusual data - type sizes; for example, "char" not 8 bits, "short" not 16 bits, - or "long" not 32 bits. We don't care whether "int" is 16 or 32 bits, - but it had better be at least 16. } - - -{ Representation of a single sample (pixel element value). - We frequently allocate large arrays of these, so it's important to keep - them small. But if you have memory to burn and access to char or short - arrays is very slow on your hardware, you might want to change these. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -{ JSAMPLE should be the smallest type that will hold the values 0..255. - You can use a signed char by having GETJSAMPLE mask it with $FF. } - -{ CHAR_IS_UNSIGNED } -type - JSAMPLE = byte; { Pascal unsigned char } - GETJSAMPLE = int; - -const - MAXJSAMPLE = 255; - CENTERJSAMPLE = 128; - -{$endif} - -{$ifndef BITS_IN_JSAMPLE_IS_8} -{ JSAMPLE should be the smallest type that will hold the values 0..4095. - On nearly all machines "short" will do nicely. } - -type - JSAMPLE = short; - GETJSAMPLE = int; - -const - MAXJSAMPLE = 4095; - CENTERJSAMPLE = 2048; - -{$endif} { BITS_IN_JSAMPLE = 12 } - - -{ Representation of a DCT frequency coefficient. - This should be a signed value of at least 16 bits; "short" is usually OK. - Again, we allocate large arrays of these, but you can change to int - if you have memory to burn and "short" is really slow. } -type - JCOEF = int; - JCOEF_PTR = ^JCOEF; - - -{ Compressed datastreams are represented as arrays of JOCTET. - These must be EXACTLY 8 bits wide, at least once they are written to - external storage. Note that when using the stdio data source/destination - managers, this is also the data type passed to fread/fwrite. } - - -type - JOCTET = Byte; - jTOctet = 0..(MaxInt div SizeOf(JOCTET))-1; - JOCTET_FIELD = array[jTOctet] of JOCTET; - JOCTET_FIELD_PTR = ^JOCTET_FIELD; - JOCTETPTR = ^JOCTET; - - GETJOCTET = JOCTET; { A work around } - - -{ These typedefs are used for various table entries and so forth. - They must be at least as wide as specified; but making them too big - won't cost a huge amount of memory, so we don't provide special - extraction code like we did for JSAMPLE. (In other words, these - typedefs live at a different point on the speed/space tradeoff curve.) } - - -{ UINT8 must hold at least the values 0..255. } - -type - UINT8 = Byte; - -{ UINT16 must hold at least the values 0..65535. } - - UINT16 = Word; - -{ INT16 must hold at least the values -32768..32767. } - - INT16 = SmallInt; - -{ INT32 must hold at least signed 32-bit values. } - - INT32 = LongInt; -type - INT32PTR = ^INT32; - -{ Datatype used for image dimensions. The JPEG standard only supports - images up to 64K*64K due to 16-bit fields in SOF markers. Therefore - "unsigned int" is sufficient on all machines. However, if you need to - handle larger images and you don't mind deviating from the spec, you - can change this datatype. } - -type - JDIMENSION = uInt; - -const - JPEG_MAX_DIMENSION = 65500; { a tad under 64K to prevent overflows } - - -{ Ordering of RGB data in scanlines passed to or from the application. - If your application wants to deal with data in the order B,G,R, just - change these macros. You can also deal with formats such as R,G,B,X - (one extra byte per pixel) by changing RGB_PIXELSIZE. Note that changing - the offsets will also change the order in which colormap data is organized. - RESTRICTIONS: - 1. The sample applications cjpeg,djpeg do NOT support modified RGB formats. - 2. These macros only affect RGB<=>YCbCr color conversion, so they are not - useful if you are using JPEG color spaces other than YCbCr or grayscale. - 3. The color quantizer modules will not behave desirably if RGB_PIXELSIZE - is not 3 (they don't understand about dummy color components!). So you - can't use color quantization if you change that value. } - -{$ifdef RGB_RED_IS_0} -const - RGB_RED = 0; { Offset of Red in an RGB scanline element } - RGB_GREEN = 1; { Offset of Green } - RGB_BLUE = 2; { Offset of Blue } -{$else} -const - RGB_RED = 2; { Offset of Red in an RGB scanline element } - RGB_GREEN = 1; { Offset of Green } - RGB_BLUE = 0; { Offset of Blue } -{$endif} - -{$ifdef RGB_PIXELSIZE_IS_3} -const - RGB_PIXELSIZE = 3; { JSAMPLEs per RGB scanline element } -{$else} -const - RGB_PIXELSIZE = ??; { Nomssi: deliberate syntax error. Set this value } -{$endif} - -{ Definitions for speed-related optimizations. } - -{ On some machines (notably 68000 series) "int" is 32 bits, but multiplying - two 16-bit shorts is faster than multiplying two ints. Define MULTIPLIER - as short on such a machine. MULTIPLIER must be at least 16 bits wide. } -type - MULTIPLIER = int; { type for fastest integer multiply } - - -{ FAST_FLOAT should be either float or double, whichever is done faster - by your compiler. (Note that this type is only used in the floating point - DCT routines, so it only matters if you've defined DCT_FLOAT_SUPPORTED.) - Typically, float is faster in ANSI C compilers, while double is faster in - pre-ANSI compilers (because they insist on converting to double anyway). - The code below therefore chooses float if we have ANSI-style prototypes. } - -type - FAST_FLOAT = double; {float} - - -implementation - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjpeglib.pas b/3rd/Imaging/Source/JpegLib/imjpeglib.pas deleted file mode 100644 index f30ece662..000000000 --- a/3rd/Imaging/Source/JpegLib/imjpeglib.pas +++ /dev/null @@ -1,1300 +0,0 @@ -unit imjpeglib; - -{ This file defines the application interface for the JPEG library. - Most applications using the library need only include this file, - and perhaps jerror.h if they want to know the exact error codes. } - -{ Source:jpeglib.h+jpegint.h; Copyright (C) 1991-1998, Thomas G. Lane. } - - -interface - -{$I imjconfig.inc} - -{ First we include the configuration files that record how this - installation of the JPEG library is set up. jconfig.h can be - generated automatically for many systems. jmorecfg.h contains - manual configuration options that most people need not worry about. } - -uses - imjdeferr, - imjmorecfg; { seldom changed options } - -{ Version ID for the JPEG library. - Might be useful for tests like "#if JPEG_LIB_VERSION >= 60". } - - -Const - JPEG_LIB_VERSION = 62; { Version 6b } - - -{ These marker codes are exported since applications and data source modules - are likely to want to use them. } - -const - JPEG_RST0 = $D0; { RST0 marker code } - JPEG_EOI = $D9; { EOI marker code } - JPEG_APP0 = $E0; { APP0 marker code } - JPEG_COM = $FE; { COM marker code } - - -{ Various constants determining the sizes of things. - All of these are specified by the JPEG standard, so don't change them - if you want to be compatible. } - -const - DCTSIZE = 8; { The basic DCT block is 8x8 samples } - DCTSIZE2 = 64; { DCTSIZE squared; # of elements in a block } - NUM_QUANT_TBLS = 4; { Quantization tables are numbered 0..3 } - NUM_HUFF_TBLS = 4; { Huffman tables are numbered 0..3 } - NUM_ARITH_TBLS = 16; { Arith-coding tables are numbered 0..15 } - MAX_COMPS_IN_SCAN = 4; { JPEG limit on # of components in one scan } - MAX_SAMP_FACTOR = 4; { JPEG limit on sampling factors } -{ Unfortunately, some bozo at Adobe saw no reason to be bound by the standard; - the PostScript DCT filter can emit files with many more than 10 blocks/MCU. - If you happen to run across such a file, you can up D_MAX_BLOCKS_IN_MCU - to handle it. We even let you do this from the jconfig.h file. However, - we strongly discourage changing C_MAX_BLOCKS_IN_MCU; just because Adobe - sometimes emits noncompliant files doesn't mean you should too. } - C_MAX_BLOCKS_IN_MCU = 10; { compressor's limit on blocks per MCU } - D_MAX_BLOCKS_IN_MCU = 10; { decompressor's limit on blocks per MCU } - - -{ Data structures for images (arrays of samples and of DCT coefficients). - On 80x86 machines, the image arrays are too big for near pointers, - but the pointer arrays can fit in near memory. } - -type -{ for typecasting } - JSAMPLE_PTR = ^JSAMPLE; - JSAMPROW_PTR = ^JSAMPROW; - JBLOCKROW_PTR = ^JBLOCKROW; - - jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1; - JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far} - JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. } - - jTRow = 0..(MaxInt div SIZEOF(JSAMPROW))-1; - JSAMPROW_ARRAY = Array[jTRow] of JSAMPROW; - JSAMPARRAY = ^JSAMPROW_ARRAY; { ptr to some rows (a 2-D sample array) } - - jTArray = 0..(MaxInt div SIZEOF(JSAMPARRAY))-1; - JSAMP_ARRAY = Array[jTArray] of JSAMPARRAY; - JSAMPIMAGE = ^JSAMP_ARRAY; { a 3-D sample array: top index is color } - - JBLOCK = Array[0..DCTSIZE2-1] of JCOEF; { one block of coefficients } - JBLOCK_PTR = ^JBLOCK; - - jTBlockRow = 0..(MaxInt div SIZEOF(JBLOCK))-1; - JBLOCK_ROWS = Array[jTBlockRow] of JBLOCK; - JBLOCKROW = ^JBLOCK_ROWS; {far} { pointer to one row of coefficient blocks } - - - jTBlockArray = 0..(MaxInt div SIZEOF(JBLOCKROW))-1; - JBLOCK_ARRAY = Array[jTBlockArray] of JBLOCKROW; - JBLOCKARRAY = ^JBLOCK_ARRAY; { a 2-D array of coefficient blocks } - - jTBlockImage = 0..(MaxInt div SIZEOF(JBLOCKARRAY))-1; - JBLOCK_IMAGE = Array[jTBlockImage] of JBLOCKARRAY; - JBLOCKIMAGE = ^JBLOCK_IMAGE; { a 3-D array of coefficient blocks } - - jTCoef = 0..(MaxInt div SIZEOF(JCOEF))-1; - JCOEF_ROW = Array[jTCoef] of JCOEF; - JCOEFPTR = ^JCOEF_ROW; {far} { useful in a couple of places } - - -type - jTByte = 0..(MaxInt div SIZEOF(byte))-1; - JByteArray = Array[jTByte] of byte; - JBytePtr = ^JByteArray; -type - byteptr = ^byte; - -{ Types for JPEG compression parameters and working tables. } - - -{ DCT coefficient quantization tables. } - -type - JQUANT_TBL_PTR = ^JQUANT_TBL; - JQUANT_TBL = record - { This array gives the coefficient quantizers in natural array order - (not the zigzag order in which they are stored in a JPEG DQT marker). - CAUTION: IJG versions prior to v6a kept this array in zigzag order. } - quantval : Array[0..DCTSIZE2-1] of UINT16; - { quantization step for each coefficient } - { This field is used only during compression. It's initialized FALSE when - the table is created, and set TRUE when it's been output to the file. - You could suppress output of a table by setting this to TRUE. - (See jpeg_suppress_tables for an example.) } - sent_table : boolean; { TRUE when table has been output } - end; - JQUANT_TBL_FIELD = Array[0..(MaxInt div SizeOf(JQUANT_TBL))-1] of JQUANT_TBL; - -{ Huffman coding tables. } - -type - JHUFF_TBL_PTR = ^JHUFF_TBL; - JHUFF_TBL = record - { These two fields directly represent the contents of a JPEG DHT marker } - bits : Array[0..17-1] of UINT8; { bits[k] = # of symbols with codes of } - { length k bits; bits[0] is unused } - huffval : Array[0..256-1] of UINT8; - { The symbols, in order of incr code length } - { This field is used only during compression. It's initialized FALSE when - the table is created, and set TRUE when it's been output to the file. - You could suppress output of a table by setting this to TRUE. - (See jpeg_suppress_tables for an example.) } - sent_table : boolean; { TRUE when table has been output } - end; - JHUFF_TBL_FIELD = Array[0..(MaxInt div SizeOf(JHUFF_TBL))-1] of JHUFF_TBL; - -{ Declarations for both compression & decompression } - -type - J_BUF_MODE = ( { Operating modes for buffer controllers } - JBUF_PASS_THRU, { Plain stripwise operation } - { Remaining modes require a full-image buffer to have been created } - JBUF_SAVE_SOURCE, { Run source subobject only, save output } - JBUF_CRANK_DEST, { Run dest subobject only, using saved data } - JBUF_SAVE_AND_PASS { Run both subobjects, save output } - ); - -{ Values of global_state field (jdapi.c has some dependencies on ordering!) } -const - CSTATE_START = 100; { after create_compress } - CSTATE_SCANNING = 101; { start_compress done, write_scanlines OK } - CSTATE_RAW_OK = 102; { start_compress done, write_raw_data OK } - CSTATE_WRCOEFS = 103; { jpeg_write_coefficients done } - DSTATE_START = 200; { after create_decompress } - DSTATE_INHEADER = 201; { reading header markers, no SOS yet } - DSTATE_READY = 202; { found SOS, ready for start_decompress } - DSTATE_PRELOAD = 203; { reading multiscan file in start_decompress} - DSTATE_PRESCAN = 204; { performing dummy pass for 2-pass quant } - DSTATE_SCANNING = 205; { start_decompress done, read_scanlines OK } - DSTATE_RAW_OK = 206; { start_decompress done, read_raw_data OK } - DSTATE_BUFIMAGE = 207; { expecting jpeg_start_output } - DSTATE_BUFPOST = 208; { looking for SOS/EOI in jpeg_finish_output } - DSTATE_RDCOEFS = 209; { reading file in jpeg_read_coefficients } - DSTATE_STOPPING = 210; { looking for EOI in jpeg_finish_decompress } - - - -{ Basic info about one component (color channel). } - -type - jpeg_component_info_ptr = ^jpeg_component_info; - jpeg_component_info = record - { These values are fixed over the whole image. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOF marker. } - component_id : int; { identifier for this component (0..255) } - component_index : int; { its index in SOF or cinfo^.comp_info[] } - h_samp_factor : int; { horizontal sampling factor (1..4) } - v_samp_factor : int; { vertical sampling factor (1..4) } - quant_tbl_no : int; { quantization table selector (0..3) } - { These values may vary between scans. } - { For compression, they must be supplied by parameter setup; } - { for decompression, they are read from the SOS marker. } - { The decompressor output side may not use these variables. } - dc_tbl_no : int; { DC entropy table selector (0..3) } - ac_tbl_no : int; { AC entropy table selector (0..3) } - - { Remaining fields should be treated as private by applications. } - - { These values are computed during compression or decompression startup: } - { Component's size in DCT blocks. - Any dummy blocks added to complete an MCU are not counted; therefore - these values do not depend on whether a scan is interleaved or not. } - width_in_blocks : JDIMENSION; - height_in_blocks : JDIMENSION; - { Size of a DCT block in samples. Always DCTSIZE for compression. - For decompression this is the size of the output from one DCT block, - reflecting any scaling we choose to apply during the IDCT step. - Values of 1,2,4,8 are likely to be supported. Note that different - components may receive different IDCT scalings. } - - DCT_scaled_size : int; - { The downsampled dimensions are the component's actual, unpadded number - of samples at the main buffer (preprocessing/compression interface), thus - downsampled_width = ceil(image_width * Hi/Hmax) - and similarly for height. For decompression, IDCT scaling is included, so - downsampled_width = ceil(image_width * Hi/Hmax * DCT_scaled_size/DCTSIZE)} - - downsampled_width : JDIMENSION; { actual width in samples } - downsampled_height : JDIMENSION; { actual height in samples } - { This flag is used only for decompression. In cases where some of the - components will be ignored (eg grayscale output from YCbCr image), - we can skip most computations for the unused components. } - - component_needed : boolean; { do we need the value of this component? } - - { These values are computed before starting a scan of the component. } - { The decompressor output side may not use these variables. } - MCU_width : int; { number of blocks per MCU, horizontally } - MCU_height : int; { number of blocks per MCU, vertically } - MCU_blocks : int; { MCU_width * MCU_height } - MCU_sample_width : int; { MCU width in samples, MCU_width*DCT_scaled_size } - last_col_width : int; { # of non-dummy blocks across in last MCU } - last_row_height : int; { # of non-dummy blocks down in last MCU } - - { Saved quantization table for component; NIL if none yet saved. - See jdinput.c comments about the need for this information. - This field is currently used only for decompression. } - - quant_table : JQUANT_TBL_PTR; - - { Private per-component storage for DCT or IDCT subsystem. } - dct_table : pointer; - end; { record jpeg_component_info } - - jTCinfo = 0..(MaxInt div SizeOf(jpeg_component_info))-1; - jpeg_component_info_array = array[jTCinfo] of jpeg_component_info; - jpeg_component_info_list_ptr = ^jpeg_component_info_array; - - -{ The script for encoding a multiple-scan file is an array of these: } - -type - jpeg_scan_info_ptr = ^jpeg_scan_info; - jpeg_scan_info = record - comps_in_scan : int; { number of components encoded in this scan } - component_index : Array[0..MAX_COMPS_IN_SCAN-1] of int; - { their SOF/comp_info[] indexes } - Ss, Se : int; { progressive JPEG spectral selection parms } - Ah, Al : int; { progressive JPEG successive approx. parms } - end; - -{ The decompressor can save APPn and COM markers in a list of these: } - -type - jpeg_saved_marker_ptr = ^jpeg_marker_struct; - jpeg_marker_struct = record - next : jpeg_saved_marker_ptr; { next in list, or NULL } - marker : UINT8; { marker code: JPEG_COM, or JPEG_APP0+n } - original_length : uint; { # bytes of data in the file } - data_length : uint; { # bytes of data saved at data[] } - data : JOCTET_FIELD_PTR; { the data contained in the marker } - { the marker length word is not counted in data_length or original_length } - end; - -{ Known color spaces. } - -type - J_COLOR_SPACE = ( - JCS_UNKNOWN, { error/unspecified } - JCS_GRAYSCALE, { monochrome } - JCS_RGB, { red/green/blue } - JCS_YCbCr, { Y/Cb/Cr (also known as YUV) } - JCS_CMYK, { C/M/Y/K } - JCS_YCCK { Y/Cb/Cr/K } - ); - -{ DCT/IDCT algorithm options. } - -type - J_DCT_METHOD = ( - JDCT_ISLOW, { slow but accurate integer algorithm } - JDCT_IFAST, { faster, less accurate integer method } - JDCT_FLOAT { floating-point: accurate, fast on fast HW } - ); - -const - JDCT_DEFAULT = JDCT_ISLOW; - JDCT_FASTEST = JDCT_IFAST; - -{ Dithering options for decompression. } - -type - J_DITHER_MODE = ( - JDITHER_NONE, { no dithering } - JDITHER_ORDERED, { simple ordered dither } - JDITHER_FS { Floyd-Steinberg error diffusion dither } - ); - - -const - JPOOL_PERMANENT = 0; { lasts until master record is destroyed } - JPOOL_IMAGE = 1; { lasts until done with image/datastream } - JPOOL_NUMPOOLS = 2; - - -{ "Object" declarations for JPEG modules that may be supplied or called - directly by the surrounding application. - As with all objects in the JPEG library, these structs only define the - publicly visible methods and state variables of a module. Additional - private fields may exist after the public ones. } - - -{ Error handler object } - -const - JMSG_LENGTH_MAX = 200; { recommended size of format_message buffer } - JMSG_STR_PARM_MAX = 80; - -const - TEMP_NAME_LENGTH = 64; { max length of a temporary file's name } -type - TEMP_STRING = string[TEMP_NAME_LENGTH]; - -{$ifdef USE_MSDOS_MEMMGR} { DOS-specific junk } -type - XMSH = ushort; { type of extended-memory handles } - EMSH = ushort; { type of expanded-memory handles } - - handle_union = record - case byte of - 0:(file_handle : short); { DOS file handle if it's a temp file } - 1:(xms_handle : XMSH); { handle if it's a chunk of XMS } - 2:(ems_handle : EMSH); { handle if it's a chunk of EMS } - end; -{$endif} { USE_MSDOS_MEMMGR } - -type - jpeg_error_mgr_ptr = ^jpeg_error_mgr; - jpeg_memory_mgr_ptr = ^jpeg_memory_mgr; - jpeg_progress_mgr_ptr = ^jpeg_progress_mgr; - - -{$ifdef common} -{ Common fields between JPEG compression and decompression master structs. } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } -{$endif} - - j_common_ptr = ^jpeg_common_struct; - j_compress_ptr = ^jpeg_compress_struct; - j_decompress_ptr = ^jpeg_decompress_struct; - - {$ifdef AM_MEMORY_MANAGER} { only jmemmgr.c defines these } - -{ This structure holds whatever state is needed to access a single - backing-store object. The read/write/close method pointers are called - by jmemmgr.c to manipulate the backing-store object; all other fields - are private to the system-dependent backing store routines. } - - - backing_store_ptr = ^backing_store_info; - backing_store_info = record - { Methods for reading/writing/closing this backing-store object } - read_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr; - buffer_address : pointer; {far} - file_offset : long; - byte_count : long); - write_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr; - buffer_address : pointer; {far} - file_offset : long; - byte_count : long); - - close_backing_store : procedure (cinfo : j_common_ptr; - info : backing_store_ptr); - - { Private fields for system-dependent backing-store management } - {$ifdef USE_MSDOS_MEMMGR} - { For the MS-DOS manager (jmemdos.c), we need: } - handle : handle_union; { reference to backing-store storage object } - temp_name : TEMP_STRING; { name if it's a file } - {$else} - { For a typical implementation with temp files, we need: } - temp_file : file; { stdio reference to temp file } - temp_name : TEMP_STRING; { name of temp file } - {$endif} - end; - - -{ The control blocks for virtual arrays. - Note that these blocks are allocated in the "small" pool area. - System-dependent info for the associated backing store (if any) is hidden - inside the backing_store_info struct. } - - jvirt_sarray_ptr = ^jvirt_sarray_control; - jvirt_sarray_control = record - mem_buffer : JSAMPARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - samplesperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_sarray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_sarray_ptr; { link to next virtual sarray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - - jvirt_barray_ptr = ^jvirt_barray_control; - jvirt_barray_control = record - mem_buffer : JBLOCKARRAY; { => the in-memory buffer } - rows_in_array : JDIMENSION; { total virtual array height } - blocksperrow : JDIMENSION; { width of array (and of memory buffer) } - maxaccess : JDIMENSION; { max rows accessed by access_virt_barray } - rows_in_mem : JDIMENSION; { height of memory buffer } - rowsperchunk : JDIMENSION; { allocation chunk size in mem_buffer } - cur_start_row : JDIMENSION; { first logical row # in the buffer } - first_undef_row : JDIMENSION; { row # of first uninitialized row } - pre_zero : boolean; { pre-zero mode requested? } - dirty : boolean; { do current buffer contents need written? } - b_s_open : boolean; { is backing-store data valid? } - next : jvirt_barray_ptr; { link to next virtual barray control block } - b_s_info : backing_store_info; { System-dependent control info } - end; - - {$endif} { AM_MEMORY_MANAGER } - -{ Declarations for compression modules } - -{ Master control module } - jpeg_comp_master_ptr = ^jpeg_comp_master; - jpeg_comp_master = record - prepare_for_pass : procedure(cinfo : j_compress_ptr); - pass_startup : procedure(cinfo : j_compress_ptr); - finish_pass : procedure(cinfo : j_compress_ptr); - - { State variables made visible to other modules } - call_pass_startup : Boolean; { True if pass_startup must be called } - is_last_pass : Boolean; { True during last pass } - end; - -{ Main buffer control (downsampled-data buffer) } - jpeg_c_main_controller_ptr = ^jpeg_c_main_controller; - jpeg_c_main_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - process_data : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION); - end; - -{ Compression preprocessing (downsampling input buffer control) } - jpeg_c_prep_controller_ptr = ^jpeg_c_prep_controller; - jpeg_c_prep_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - pre_process_data : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - var in_row_ctr : JDIMENSION; - in_rows_avail : JDIMENSION; - output_buf : JSAMPIMAGE; - var out_row_group_ctr : JDIMENSION; - out_row_groups_avail : JDIMENSION); - end; - -{ Coefficient buffer control } - jpeg_c_coef_controller_ptr = ^jpeg_c_coef_controller; - jpeg_c_coef_controller = record - start_pass : procedure(cinfo : j_compress_ptr; pass_mode : J_BUF_MODE); - compress_data : function(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE) : boolean; - end; - -{ Colorspace conversion } - jpeg_color_converter_ptr = ^jpeg_color_converter; - jpeg_color_converter = record - start_pass : procedure(cinfo : j_compress_ptr); - color_convert : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPIMAGE; - output_row : JDIMENSION; - num_rows : int); - end; - -{ Downsampling } - jpeg_downsampler_ptr = ^jpeg_downsampler; - jpeg_downsampler = record - start_pass : procedure(cinfo : j_compress_ptr); - downsample : procedure(cinfo : j_compress_ptr; - input_buf : JSAMPIMAGE; - in_row_index : JDIMENSION; - output_buf : JSAMPIMAGE; - out_row_group_index: JDIMENSION); - need_context_rows : Boolean; { TRUE if need rows above & below } - end; - -{ Forward DCT (also controls coefficient quantization) } - jpeg_forward_dct_ptr = ^jpeg_forward_dct; - jpeg_forward_dct = record - start_pass : procedure(cinfo : j_compress_ptr); - { perhaps this should be an array??? } - forward_DCT : procedure(cinfo : j_compress_ptr; - compptr : jpeg_component_info_ptr; - sample_data : JSAMPARRAY; - coef_blocks : JBLOCKROW; - start_row : JDIMENSION; - start_col : JDIMENSION; - num_blocks : JDIMENSION); - end; - -{ Entropy encoding } - - jpeg_entropy_encoder_ptr = ^jpeg_entropy_encoder; - jpeg_entropy_encoder = record - start_pass : procedure(cinfo : j_compress_ptr; gather_statistics : boolean); - encode_mcu : function(cinfo : j_compress_ptr; - const MCU_data: array of JBLOCKROW) : boolean; - finish_pass : procedure(cinfo : j_compress_ptr); - end; - -{ Marker writing } - jpeg_marker_writer_ptr = ^jpeg_marker_writer; - jpeg_marker_writer = record - write_file_header : procedure(cinfo : j_compress_ptr); - write_frame_header : procedure(cinfo : j_compress_ptr); - write_scan_header : procedure(cinfo : j_compress_ptr); - write_file_trailer : procedure(cinfo : j_compress_ptr); - write_tables_only : procedure(cinfo : j_compress_ptr); - { These routines are exported to allow insertion of extra markers } - { Probably only COM and APPn markers should be written this way } - write_marker_header : procedure (cinfo : j_compress_ptr; - marker : int; - datalen : uint); - write_marker_byte : procedure (cinfo : j_compress_ptr; val : int); - end; - -{ Declarations for decompression modules } - -{ Master control module } - jpeg_decomp_master_ptr = ^jpeg_decomp_master; - jpeg_decomp_master = record - prepare_for_output_pass : procedure( cinfo : j_decompress_ptr); - finish_output_pass : procedure(cinfo : j_decompress_ptr); - - { State variables made visible to other modules } - is_dummy_pass : Boolean; { True during 1st pass for 2-pass quant } - end; - -{ Input control module } - jpeg_input_controller_ptr = ^jpeg_input_controller; - jpeg_input_controller = record - consume_input : function (cinfo : j_decompress_ptr) : int; - reset_input_controller : procedure(cinfo : j_decompress_ptr); - start_input_pass : procedure(cinfo : j_decompress_ptr); - finish_input_pass : procedure(cinfo : j_decompress_ptr); - - { State variables made visible to other modules } - has_multiple_scans : Boolean; { True if file has multiple scans } - eoi_reached : Boolean; { True when EOI has been consumed } - end; - -{ Main buffer control (downsampled-data buffer) } - - jpeg_d_main_controller_ptr = ^jpeg_d_main_controller; - jpeg_d_main_controller = record - start_pass : procedure(cinfo : j_decompress_ptr; pass_mode : J_BUF_MODE); - process_data : procedure(cinfo : j_decompress_ptr; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); - end; - -{ Coefficient buffer control } - jvirt_barray_tbl = array[0..MAX_COMPONENTS-1] of jvirt_barray_ptr; - jvirt_barray_tbl_ptr = ^jvirt_barray_tbl; - jpeg_d_coef_controller_ptr = ^jpeg_d_coef_controller; - jpeg_d_coef_controller = record - start_input_pass : procedure(cinfo : j_decompress_ptr); - consume_data : function (cinfo : j_decompress_ptr) : int; - start_output_pass : procedure(cinfo : j_decompress_ptr); - decompress_data : function (cinfo : j_decompress_ptr; - output_buf : JSAMPIMAGE) : int; - { Pointer to array of coefficient virtual arrays, or NIL if none } - coef_arrays : jvirt_barray_tbl_ptr; - end; - -{ Decompression postprocessing (color quantization buffer control) } - jpeg_d_post_controller_ptr = ^jpeg_d_post_controller; - jpeg_d_post_controller = record - start_pass : procedure(cinfo : j_decompress_ptr; - pass_mode : J_BUF_MODE); - post_process_data : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); - end; - - -{ Routine signature for application-supplied marker processing methods. - Need not pass marker code since it is stored in cinfo^.unread_marker. } - - jpeg_marker_parser_method = function(cinfo : j_decompress_ptr) : boolean; - -{ Marker reading & parsing } - jpeg_marker_reader_ptr = ^jpeg_marker_reader; - jpeg_marker_reader = record - reset_marker_reader : procedure(cinfo : j_decompress_ptr); - { Read markers until SOS or EOI. - Returns same codes as are defined for jpeg_consume_input: - JPEG_SUSPENDED, JPEG_REACHED_SOS, or JPEG_REACHED_EOI. } - - read_markers : function (cinfo : j_decompress_ptr) : int; - { Read a restart marker --- exported for use by entropy decoder only } - read_restart_marker : jpeg_marker_parser_method; - - { State of marker reader --- nominally internal, but applications - supplying COM or APPn handlers might like to know the state. } - - saw_SOI : boolean; { found SOI? } - saw_SOF : boolean; { found SOF? } - next_restart_num : int; { next restart number expected (0-7) } - discarded_bytes : uint; { # of bytes skipped looking for a marker } - end; - -{ Entropy decoding } - jpeg_entropy_decoder_ptr = ^jpeg_entropy_decoder; - jpeg_entropy_decoder = record - start_pass : procedure(cinfo : j_decompress_ptr); - decode_mcu : function(cinfo : j_decompress_ptr; - var MCU_data : array of JBLOCKROW) : boolean; - { This is here to share code between baseline and progressive decoders; } - { other modules probably should not use it } - insufficient_data : BOOLEAN; { set TRUE after emitting warning } - end; - -{ Inverse DCT (also performs dequantization) } - inverse_DCT_method_ptr = procedure(cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; output_col : JDIMENSION); - - jpeg_inverse_dct_ptr = ^jpeg_inverse_dct; - jpeg_inverse_dct = record - start_pass : procedure(cinfo : j_decompress_ptr); - { It is useful to allow each component to have a separate IDCT method. } - inverse_DCT : Array[0..MAX_COMPONENTS-1] of inverse_DCT_method_ptr; - end; - -{ Upsampling (note that upsampler must also call color converter) } - jpeg_upsampler_ptr = ^jpeg_upsampler; - jpeg_upsampler = record - start_pass : procedure(cinfo : j_decompress_ptr); - upsample : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - var in_row_group_ctr : JDIMENSION; { array of } - in_row_groups_avail : JDIMENSION; - output_buf : JSAMPARRAY; - var out_row_ctr : JDIMENSION; - out_rows_avail : JDIMENSION); - - need_context_rows : boolean; { TRUE if need rows above & below } - end; - -{ Colorspace conversion } - jpeg_color_deconverter_ptr = ^jpeg_color_deconverter; - jpeg_color_deconverter = record - start_pass : procedure(cinfo: j_decompress_ptr); - color_convert : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPIMAGE; - input_row : JDIMENSION; - output_buf : JSAMPARRAY; - num_rows : int); - end; - -{ Color quantization or color precision reduction } - jpeg_color_quantizer_ptr = ^jpeg_color_quantizer; - jpeg_color_quantizer = record - start_pass : procedure(cinfo : j_decompress_ptr; is_pre_scan : boolean); - color_quantize : procedure(cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); - - finish_pass : procedure(cinfo : j_decompress_ptr); - new_color_map : procedure(cinfo : j_decompress_ptr); - end; - - {int8array = Array[0..8-1] of int;} - int8array = Array[0..8-1] of longint; { for TP FormatStr } - - jpeg_error_mgr = record - { Error exit handler: does not return to caller } - error_exit : procedure (cinfo : j_common_ptr); - { Conditionally emit a trace or warning message } - emit_message : procedure (cinfo : j_common_ptr; msg_level : int); - { Routine that actually outputs a trace or error message } - output_message : procedure (cinfo : j_common_ptr); - { Format a message string for the most recent JPEG error or message } - format_message : procedure (cinfo : j_common_ptr; var buffer : AnsiString); - - { Reset error state variables at start of a new image } - reset_error_mgr : procedure (cinfo : j_common_ptr); - - { The message ID code and any parameters are saved here. - A message can have one string parameter or up to 8 int parameters. } - - msg_code : int; - - msg_parm : record - case byte of - 0:(i : int8array); - 1:(s : string[JMSG_STR_PARM_MAX]); - end; - - { Standard state variables for error facility } - - trace_level : int; { max msg_level that will be displayed } - - { For recoverable corrupt-data errors, we emit a warning message, - but keep going unless emit_message chooses to abort. emit_message - should count warnings in num_warnings. The surrounding application - can check for bad data by seeing if num_warnings is nonzero at the - end of processing. } - - num_warnings : long; { number of corrupt-data warnings } - - { These fields point to the table(s) of error message strings. - An application can change the table pointer to switch to a different - message list (typically, to change the language in which errors are - reported). Some applications may wish to add additional error codes - that will be handled by the JPEG library error mechanism; the second - table pointer is used for this purpose. - - First table includes all errors generated by JPEG library itself. - Error code 0 is reserved for a "no such error string" message. } - - {const char * const * jpeg_message_table; } - jpeg_message_table : ^msg_table; { Library errors } - - last_jpeg_message : J_MESSAGE_CODE; - { Table contains strings 0..last_jpeg_message } - { Second table can be added by application (see cjpeg/djpeg for example). - It contains strings numbered first_addon_message..last_addon_message. } - - {const char * const * addon_message_table; } - addon_message_table : ^msg_table; { Non-library errors } - - first_addon_message : J_MESSAGE_CODE; { code for first string in addon table } - last_addon_message : J_MESSAGE_CODE; { code for last string in addon table } - end; - - -{ Progress monitor object } - - jpeg_progress_mgr = record - progress_monitor : procedure(cinfo : j_common_ptr); - - pass_counter : long; { work units completed in this pass } - pass_limit : long; { total number of work units in this pass } - completed_passes : int; { passes completed so far } - total_passes : int; { total number of passes expected } - end; - - -{ Data destination object for compression } - jpeg_destination_mgr_ptr = ^jpeg_destination_mgr; - jpeg_destination_mgr = record - next_output_byte : JOCTETptr; { => next byte to write in buffer } - free_in_buffer : size_t; { # of byte spaces remaining in buffer } - - init_destination : procedure (cinfo : j_compress_ptr); - empty_output_buffer : function (cinfo : j_compress_ptr) : boolean; - term_destination : procedure (cinfo : j_compress_ptr); - end; - - -{ Data source object for decompression } - - jpeg_source_mgr_ptr = ^jpeg_source_mgr; - jpeg_source_mgr = record - {const JOCTET * next_input_byte;} - next_input_byte : JOCTETptr; { => next byte to read from buffer } - bytes_in_buffer : size_t; { # of bytes remaining in buffer } - - init_source : procedure (cinfo : j_decompress_ptr); - fill_input_buffer : function (cinfo : j_decompress_ptr) : boolean; - skip_input_data : procedure (cinfo : j_decompress_ptr; num_bytes : long); - resync_to_restart : function (cinfo : j_decompress_ptr; - desired : int) : boolean; - term_source : procedure (cinfo : j_decompress_ptr); - end; - - -{ Memory manager object. - Allocates "small" objects (a few K total), "large" objects (tens of K), - and "really big" objects (virtual arrays with backing store if needed). - The memory manager does not allow individual objects to be freed; rather, - each created object is assigned to a pool, and whole pools can be freed - at once. This is faster and more convenient than remembering exactly what - to free, especially where malloc()/free() are not too speedy. - NB: alloc routines never return NIL. They exit to error_exit if not - successful. } - - - jpeg_memory_mgr = record - { Method pointers } - alloc_small : function (cinfo : j_common_ptr; pool_id : int; - sizeofobject : size_t) : pointer; - alloc_large : function (cinfo : j_common_ptr; pool_id : int; - sizeofobject : size_t) : pointer; {far} - alloc_sarray : function (cinfo : j_common_ptr; pool_id : int; - samplesperrow : JDIMENSION; - numrows : JDIMENSION) : JSAMPARRAY; - - alloc_barray : function (cinfo : j_common_ptr; pool_id : int; - blocksperrow : JDIMENSION; - numrows : JDIMENSION) : JBLOCKARRAY; - - request_virt_sarray : function(cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - samplesperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_sarray_ptr; - - request_virt_barray : function(cinfo : j_common_ptr; - pool_id : int; - pre_zero : boolean; - blocksperrow : JDIMENSION; - numrows : JDIMENSION; - maxaccess : JDIMENSION) : jvirt_barray_ptr; - - realize_virt_arrays : procedure (cinfo : j_common_ptr); - - access_virt_sarray : function (cinfo : j_common_ptr; - ptr : jvirt_sarray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean) : JSAMPARRAY; - - access_virt_barray : function (cinfo : j_common_ptr; - ptr : jvirt_barray_ptr; - start_row : JDIMENSION; - num_rows : JDIMENSION; - writable : boolean) : JBLOCKARRAY; - - free_pool : procedure (cinfo : j_common_ptr; pool_id : int); - self_destruct : procedure (cinfo : j_common_ptr); - - { Limit on memory allocation for this JPEG object. (Note that this is - merely advisory, not a guaranteed maximum; it only affects the space - used for virtual-array buffers.) May be changed by outer application - after creating the JPEG object. } - max_memory_to_use : long; - - { Maximum allocation request accepted by alloc_large. } - max_alloc_chunk : long; - end; - -{ Routines that are to be used by both halves of the library are declared - to receive a pointer to this structure. There are no actual instances of - jpeg_common_struct, only of jpeg_compress_struct and jpeg_decompress_struct.} - jpeg_common_struct = record - { Fields common to both master struct types } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Additional fields follow in an actual jpeg_compress_struct or - jpeg_decompress_struct. All three structs must agree on these - initial fields! (This would be a lot cleaner in C++.) } - end; - - -{ Master record for a compression instance } - - jpeg_compress_struct = record - { Fields shared with jpeg_decompress_struct } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Destination for compressed data } - dest : jpeg_destination_mgr_ptr; - - { Description of source image --- these fields must be filled in by - outer application before starting compression. in_color_space must - be correct before you can even call jpeg_set_defaults(). } - - - image_width : JDIMENSION; { input image width } - image_height : JDIMENSION; { input image height } - input_components : int; { # of color components in input image } - in_color_space : J_COLOR_SPACE; { colorspace of input image } - - input_gamma : double; { image gamma of input image } - - { Compression parameters --- these fields must be set before calling - jpeg_start_compress(). We recommend calling jpeg_set_defaults() to - initialize everything to reasonable defaults, then changing anything - the application specifically wants to change. That way you won't get - burnt when new parameters are added. Also note that there are several - helper routines to simplify changing parameters. } - - data_precision : int; { bits of precision in image data } - - num_components : int; { # of color components in JPEG image } - jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } - - comp_info : jpeg_component_info_list_ptr; - { comp_info^[i] describes component that appears i'th in SOF } - - quant_tbl_ptrs: Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; - { ptrs to coefficient quantization tables, or NIL if not defined } - - dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - { ptrs to Huffman coding tables, or NIL if not defined } - - arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } - arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } - arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } - - num_scans : int; { # of entries in scan_info array } - scan_info : jpeg_scan_info_ptr; { script for multi-scan file, or NIL } - { The default value of scan_info is NIL, which causes a single-scan - sequential JPEG file to be emitted. To create a multi-scan file, - set num_scans and scan_info to point to an array of scan definitions. } - - raw_data_in : boolean; { TRUE=caller supplies downsampled data } - arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } - optimize_coding : boolean; { TRUE=optimize entropy encoding parms } - CCIR601_sampling : boolean; { TRUE=first samples are cosited } - smoothing_factor : int; { 1..100, or 0 for no input smoothing } - dct_method : J_DCT_METHOD; { DCT algorithm selector } - - { The restart interval can be specified in absolute MCUs by setting - restart_interval, or in MCU rows by setting restart_in_rows - (in which case the correct restart_interval will be figured - for each scan). } - - restart_interval : uint; { MCUs per restart, or 0 for no restart } - restart_in_rows : int; { if > 0, MCU rows per restart interval } - - { Parameters controlling emission of special markers. } - - write_JFIF_header : boolean; { should a JFIF marker be written? } - JFIF_major_version : UINT8; { What to write for the JFIF version number } - JFIF_minor_version : UINT8; - { These three values are not used by the JPEG code, merely copied } - { into the JFIF APP0 marker. density_unit can be 0 for unknown, } - { 1 for dots/inch, or 2 for dots/cm. Note that the pixel aspect } - { ratio is defined by X_density/Y_density even when density_unit=0. } - density_unit : UINT8; { JFIF code for pixel size units } - X_density : UINT16; { Horizontal pixel density } - Y_density : UINT16; { Vertical pixel density } - write_Adobe_marker : boolean; { should an Adobe marker be written? } - - { State variable: index of next scanline to be written to - jpeg_write_scanlines(). Application may use this to control its - processing loop, e.g., "while (next_scanline < image_height)". } - - next_scanline : JDIMENSION; { 0 .. image_height-1 } - - { Remaining fields are known throughout compressor, but generally - should not be touched by a surrounding application. } - - { These fields are computed during compression startup } - progressive_mode : boolean; { TRUE if scan script uses progressive mode } - max_h_samp_factor : int; { largest h_samp_factor } - max_v_samp_factor : int; { largest v_samp_factor } - - total_iMCU_rows : JDIMENSION; { # of iMCU rows to be input to coef ctlr } - { The coefficient controller receives data in units of MCU rows as defined - for fully interleaved scans (whether the JPEG file is interleaved or not). - There are v_samp_factor * DCTSIZE sample rows of each component in an - "iMCU" (interleaved MCU) row. } - - { These fields are valid during any one scan. - They describe the components and MCUs actually appearing in the scan. } - - comps_in_scan : int; { # of JPEG components in this scan } - cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; - { cur_comp_info[i]^ describes component that appears i'th in SOS } - - MCUs_per_row : JDIMENSION; { # of MCUs across the image } - MCU_rows_in_scan : JDIMENSION;{ # of MCU rows in the image } - - blocks_in_MCU : int; { # of DCT blocks per MCU } - MCU_membership : Array[0..C_MAX_BLOCKS_IN_MCU-1] of int; - { MCU_membership[i] is index in cur_comp_info of component owning } - { i'th block in an MCU } - - Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } - - { Links to compression subobjects (methods and private variables of modules) } - master : jpeg_comp_master_ptr; - main : jpeg_c_main_controller_ptr; - prep : jpeg_c_prep_controller_ptr; - coef : jpeg_c_coef_controller_ptr; - marker : jpeg_marker_writer_ptr; - cconvert : jpeg_color_converter_ptr; - downsample : jpeg_downsampler_ptr; - fdct : jpeg_forward_dct_ptr; - entropy : jpeg_entropy_encoder_ptr; - script_space : jpeg_scan_info_ptr; { workspace for jpeg_simple_progression } - script_space_size : int; - end; - - -{ Master record for a decompression instance } - - coef_bits_field = Array[0..DCTSIZE2-1] of int; - coef_bits_ptr = ^coef_bits_field; - coef_bits_ptrfield = Array[0..MAX_COMPS_IN_SCAN-1] of coef_bits_field; - coef_bits_ptrrow = ^coef_bits_ptrfield; - - range_limit_table = array[-(MAXJSAMPLE+1)..4*(MAXJSAMPLE+1) - + CENTERJSAMPLE -1] of JSAMPLE; - range_limit_table_ptr = ^range_limit_table; - - jpeg_decompress_struct = record - { Fields shared with jpeg_compress_struct } - err : jpeg_error_mgr_ptr; { Error handler module } - mem : jpeg_memory_mgr_ptr; { Memory manager module } - progress : jpeg_progress_mgr_ptr; { Progress monitor, or NIL if none } - client_data : voidp; { Available for use by application } - is_decompressor : boolean; { so common code can tell which is which } - global_state : int; { for checking call sequence validity } - - { Source of compressed data } - src : jpeg_source_mgr_ptr; - - { Basic description of image --- filled in by jpeg_read_header(). } - { Application may inspect these values to decide how to process image. } - - image_width : JDIMENSION; { nominal image width (from SOF marker) } - image_height : JDIMENSION; { nominal image height } - num_components : int; { # of color components in JPEG image } - jpeg_color_space : J_COLOR_SPACE; { colorspace of JPEG image } - - { Decompression processing parameters --- these fields must be set before - calling jpeg_start_decompress(). Note that jpeg_read_header() - initializes them to default values. } - - out_color_space : J_COLOR_SPACE; { colorspace for output } - - scale_num, scale_denom : uint ; { fraction by which to scale image } - - output_gamma : double; { image gamma wanted in output } - - buffered_image : boolean; { TRUE=multiple output passes } - raw_data_out : boolean; { TRUE=downsampled data wanted } - - dct_method : J_DCT_METHOD; { IDCT algorithm selector } - do_fancy_upsampling : boolean; { TRUE=apply fancy upsampling } - do_block_smoothing : boolean; { TRUE=apply interblock smoothing } - - quantize_colors : boolean; { TRUE=colormapped output wanted } - { the following are ignored if not quantize_colors: } - dither_mode : J_DITHER_MODE; { type of color dithering to use } - two_pass_quantize : boolean; { TRUE=use two-pass color quantization } - desired_number_of_colors : int; { max # colors to use in created colormap } - { these are significant only in buffered-image mode: } - enable_1pass_quant : boolean; { enable future use of 1-pass quantizer } - enable_external_quant : boolean; { enable future use of external colormap } - enable_2pass_quant : boolean; { enable future use of 2-pass quantizer } - - { Description of actual output image that will be returned to application. - These fields are computed by jpeg_start_decompress(). - You can also use jpeg_calc_output_dimensions() to determine these values - in advance of calling jpeg_start_decompress(). } - - output_width : JDIMENSION; { scaled image width } - output_height: JDIMENSION; { scaled image height } - out_color_components : int; { # of color components in out_color_space } - output_components : int; { # of color components returned } - { output_components is 1 (a colormap index) when quantizing colors; - otherwise it equals out_color_components. } - - rec_outbuf_height : int; { min recommended height of scanline buffer } - { If the buffer passed to jpeg_read_scanlines() is less than this many - rows high, space and time will be wasted due to unnecessary data - copying. Usually rec_outbuf_height will be 1 or 2, at most 4. } - - { When quantizing colors, the output colormap is described by these - fields. The application can supply a colormap by setting colormap - non-NIL before calling jpeg_start_decompress; otherwise a colormap - is created during jpeg_start_decompress or jpeg_start_output. The map - has out_color_components rows and actual_number_of_colors columns. } - - actual_number_of_colors : int; { number of entries in use } - colormap : JSAMPARRAY; { The color map as a 2-D pixel array } - - { State variables: these variables indicate the progress of decompression. - The application may examine these but must not modify them. } - - { Row index of next scanline to be read from jpeg_read_scanlines(). - Application may use this to control its processing loop, e.g., - "while (output_scanline < output_height)". } - - output_scanline : JDIMENSION; { 0 .. output_height-1 } - - { Current input scan number and number of iMCU rows completed in scan. - These indicate the progress of the decompressor input side. } - - input_scan_number : int; { Number of SOS markers seen so far } - input_iMCU_row : JDIMENSION; { Number of iMCU rows completed } - - { The "output scan number" is the notional scan being displayed by the - output side. The decompressor will not allow output scan/row number - to get ahead of input scan/row, but it can fall arbitrarily far behind.} - - output_scan_number : int; { Nominal scan number being displayed } - output_iMCU_row : int; { Number of iMCU rows read } - - { Current progression status. coef_bits[c][i] indicates the precision - with which component c's DCT coefficient i (in zigzag order) is known. - It is -1 when no data has yet been received, otherwise it is the point - transform (shift) value for the most recent scan of the coefficient - (thus, 0 at completion of the progression). - This pointer is NIL when reading a non-progressive file. } - - coef_bits : coef_bits_ptrrow; - { -1 or current Al value for each coef } - - { Internal JPEG parameters --- the application usually need not look at - these fields. Note that the decompressor output side may not use - any parameters that can change between scans. } - - { Quantization and Huffman tables are carried forward across input - datastreams when processing abbreviated JPEG datastreams. } - - quant_tbl_ptrs : Array[0..NUM_QUANT_TBLS-1] of JQUANT_TBL_PTR; - { ptrs to coefficient quantization tables, or NIL if not defined } - - dc_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - ac_huff_tbl_ptrs : Array[0..NUM_HUFF_TBLS-1] of JHUFF_TBL_PTR; - { ptrs to Huffman coding tables, or NIL if not defined } - - { These parameters are never carried across datastreams, since they - are given in SOF/SOS markers or defined to be reset by SOI. } - - data_precision : int; { bits of precision in image data } - - comp_info : jpeg_component_info_list_ptr; - { comp_info^[i] describes component that appears i'th in SOF } - - progressive_mode : boolean; { TRUE if SOFn specifies progressive mode } - arith_code : boolean; { TRUE=arithmetic coding, FALSE=Huffman } - - arith_dc_L : Array[0..NUM_ARITH_TBLS-1] of UINT8; { L values for DC arith-coding tables } - arith_dc_U : Array[0..NUM_ARITH_TBLS-1] of UINT8; { U values for DC arith-coding tables } - arith_ac_K : Array[0..NUM_ARITH_TBLS-1] of UINT8; { Kx values for AC arith-coding tables } - - restart_interval : uint; { MCUs per restart interval, or 0 for no restart } - - { These fields record data obtained from optional markers recognized by - the JPEG library. } - - saw_JFIF_marker : boolean; { TRUE iff a JFIF APP0 marker was found } - { Data copied from JFIF marker; only valid if saw_JFIF_marker is TRUE: } - JFIF_major_version : UINT8; { JFIF version number } - JFIF_minor_version : UINT8; - density_unit : UINT8; { JFIF code for pixel size units } - X_density : UINT16; { Horizontal pixel density } - Y_density : UINT16; { Vertical pixel density } - saw_Adobe_marker : boolean; { TRUE iff an Adobe APP14 marker was found } - Adobe_transform : UINT8; { Color transform code from Adobe marker } - - CCIR601_sampling : boolean; { TRUE=first samples are cosited } - - { Aside from the specific data retained from APPn markers known to the - library, the uninterpreted contents of any or all APPn and COM markers - can be saved in a list for examination by the application. } - - marker_list : jpeg_saved_marker_ptr; { Head of list of saved markers } - - { Remaining fields are known throughout decompressor, but generally - should not be touched by a surrounding application. } - - - { These fields are computed during decompression startup } - - max_h_samp_factor : int; { largest h_samp_factor } - max_v_samp_factor : int; { largest v_samp_factor } - - min_DCT_scaled_size : int; { smallest DCT_scaled_size of any component } - - total_iMCU_rows : JDIMENSION; { # of iMCU rows in image } - { The coefficient controller's input and output progress is measured in - units of "iMCU" (interleaved MCU) rows. These are the same as MCU rows - in fully interleaved JPEG scans, but are used whether the scan is - interleaved or not. We define an iMCU row as v_samp_factor DCT block - rows of each component. Therefore, the IDCT output contains - v_samp_factor*DCT_scaled_size sample rows of a component per iMCU row.} - - sample_range_limit : range_limit_table_ptr; { table for fast range-limiting } - - - { These fields are valid during any one scan. - They describe the components and MCUs actually appearing in the scan. - Note that the decompressor output side must not use these fields. } - - comps_in_scan : int; { # of JPEG components in this scan } - cur_comp_info : Array[0..MAX_COMPS_IN_SCAN-1] of jpeg_component_info_ptr; - { cur_comp_info[i]^ describes component that appears i'th in SOS } - - MCUs_per_row : JDIMENSION; { # of MCUs across the image } - MCU_rows_in_scan : JDIMENSION; { # of MCU rows in the image } - - blocks_in_MCU : JDIMENSION; { # of DCT blocks per MCU } - MCU_membership : Array[0..D_MAX_BLOCKS_IN_MCU-1] of int; - { MCU_membership[i] is index in cur_comp_info of component owning } - { i'th block in an MCU } - - Ss, Se, Ah, Al : int; { progressive JPEG parameters for scan } - - { This field is shared between entropy decoder and marker parser. - It is either zero or the code of a JPEG marker that has been - read from the data source, but has not yet been processed. } - - unread_marker : int; - - { Links to decompression subobjects - (methods, private variables of modules) } - - master : jpeg_decomp_master_ptr; - main : jpeg_d_main_controller_ptr; - coef : jpeg_d_coef_controller_ptr; - post : jpeg_d_post_controller_ptr; - inputctl : jpeg_input_controller_ptr; - marker : jpeg_marker_reader_ptr; - entropy : jpeg_entropy_decoder_ptr; - idct : jpeg_inverse_dct_ptr; - upsample : jpeg_upsampler_ptr; - cconvert : jpeg_color_deconverter_ptr; - cquantize : jpeg_color_quantizer_ptr; - end; - -{ Decompression startup: read start of JPEG datastream to see what's there - function jpeg_read_header (cinfo : j_decompress_ptr; - require_image : boolean) : int; - Return value is one of: } -const - JPEG_SUSPENDED = 0; { Suspended due to lack of input data } - JPEG_HEADER_OK = 1; { Found valid image datastream } - JPEG_HEADER_TABLES_ONLY = 2; { Found valid table-specs-only datastream } -{ If you pass require_image = TRUE (normal case), you need not check for - a TABLES_ONLY return code; an abbreviated file will cause an error exit. - JPEG_SUSPENDED is only possible if you use a data source module that can - give a suspension return (the stdio source module doesn't). } - - -{ function jpeg_consume_input (cinfo : j_decompress_ptr) : int; - Return value is one of: } - - JPEG_REACHED_SOS = 1; { Reached start of new scan } - JPEG_REACHED_EOI = 2; { Reached end of image } - JPEG_ROW_COMPLETED = 3; { Completed one iMCU row } - JPEG_SCAN_COMPLETED = 4; { Completed last iMCU row of a scan } - - - - -implementation - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjquant1.pas b/3rd/Imaging/Source/JpegLib/imjquant1.pas deleted file mode 100644 index f15afa049..000000000 --- a/3rd/Imaging/Source/JpegLib/imjquant1.pas +++ /dev/null @@ -1,1009 +0,0 @@ -unit imjquant1; - -{ This file contains 1-pass color quantization (color mapping) routines. - These routines provide mapping to a fixed color map using equally spaced - color values. Optional Floyd-Steinberg or ordered dithering is available. } - -{ Original: jquant1.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjpeglib; - -{GLOBAL} -procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); - -implementation - -uses - imjmorecfg, - imjdeferr, - imjerror, - imjutils; - -{ The main purpose of 1-pass quantization is to provide a fast, if not very - high quality, colormapped output capability. A 2-pass quantizer usually - gives better visual quality; however, for quantized grayscale output this - quantizer is perfectly adequate. Dithering is highly recommended with this - quantizer, though you can turn it off if you really want to. - - In 1-pass quantization the colormap must be chosen in advance of seeing the - image. We use a map consisting of all combinations of Ncolors[i] color - values for the i'th component. The Ncolors[] values are chosen so that - their product, the total number of colors, is no more than that requested. - (In most cases, the product will be somewhat less.) - - Since the colormap is orthogonal, the representative value for each color - component can be determined without considering the other components; - then these indexes can be combined into a colormap index by a standard - N-dimensional-array-subscript calculation. Most of the arithmetic involved - can be precalculated and stored in the lookup table colorindex[]. - colorindex[i][j] maps pixel value j in component i to the nearest - representative value (grid plane) for that component; this index is - multiplied by the array stride for component i, so that the - index of the colormap entry closest to a given pixel value is just - sum( colorindex[component-number][pixel-component-value] ) - Aside from being fast, this scheme allows for variable spacing between - representative values with no additional lookup cost. - - If gamma correction has been applied in color conversion, it might be wise - to adjust the color grid spacing so that the representative colors are - equidistant in linear space. At this writing, gamma correction is not - implemented by jdcolor, so nothing is done here. } - - -{ Declarations for ordered dithering. - - We use a standard 16x16 ordered dither array. The basic concept of ordered - dithering is described in many references, for instance Dale Schumacher's - chapter II.2 of Graphics Gems II (James Arvo, ed. Academic Press, 1991). - In place of Schumacher's comparisons against a "threshold" value, we add a - "dither" value to the input pixel and then round the result to the nearest - output value. The dither value is equivalent to (0.5 - threshold) times - the distance between output values. For ordered dithering, we assume that - the output colors are equally spaced; if not, results will probably be - worse, since the dither may be too much or too little at a given point. - - The normal calculation would be to form pixel value + dither, range-limit - this to 0..MAXJSAMPLE, and then index into the colorindex table as usual. - We can skip the separate range-limiting step by extending the colorindex - table in both directions. } - - -const - ODITHER_SIZE = 16; { dimension of dither matrix } -{ NB: if ODITHER_SIZE is not a power of 2, ODITHER_MASK uses will break } - ODITHER_CELLS = (ODITHER_SIZE*ODITHER_SIZE); { # cells in matrix } - ODITHER_MASK = (ODITHER_SIZE-1); { mask for wrapping around counters } - -type - ODITHER_vector = Array[0..ODITHER_SIZE-1] of int; - ODITHER_MATRIX = Array[0..ODITHER_SIZE-1] of ODITHER_vector; - {ODITHER_MATRIX_PTR = ^array[0..ODITHER_SIZE-1] of int;} - ODITHER_MATRIX_PTR = ^ODITHER_MATRIX; - -const - base_dither_matrix : Array[0..ODITHER_SIZE-1,0..ODITHER_SIZE-1] of UINT8 - = ( - { Bayer's order-4 dither array. Generated by the code given in - Stephen Hawley's article "Ordered Dithering" in Graphics Gems I. - The values in this array must range from 0 to ODITHER_CELLS-1. } - - ( 0,192, 48,240, 12,204, 60,252, 3,195, 51,243, 15,207, 63,255 ), - ( 128, 64,176,112,140, 76,188,124,131, 67,179,115,143, 79,191,127 ), - ( 32,224, 16,208, 44,236, 28,220, 35,227, 19,211, 47,239, 31,223 ), - ( 160, 96,144, 80,172,108,156, 92,163, 99,147, 83,175,111,159, 95 ), - ( 8,200, 56,248, 4,196, 52,244, 11,203, 59,251, 7,199, 55,247 ), - ( 136, 72,184,120,132, 68,180,116,139, 75,187,123,135, 71,183,119 ), - ( 40,232, 24,216, 36,228, 20,212, 43,235, 27,219, 39,231, 23,215 ), - ( 168,104,152, 88,164,100,148, 84,171,107,155, 91,167,103,151, 87 ), - ( 2,194, 50,242, 14,206, 62,254, 1,193, 49,241, 13,205, 61,253 ), - ( 130, 66,178,114,142, 78,190,126,129, 65,177,113,141, 77,189,125 ), - ( 34,226, 18,210, 46,238, 30,222, 33,225, 17,209, 45,237, 29,221 ), - ( 162, 98,146, 82,174,110,158, 94,161, 97,145, 81,173,109,157, 93 ), - ( 10,202, 58,250, 6,198, 54,246, 9,201, 57,249, 5,197, 53,245 ), - ( 138, 74,186,122,134, 70,182,118,137, 73,185,121,133, 69,181,117 ), - ( 42,234, 26,218, 38,230, 22,214, 41,233, 25,217, 37,229, 21,213 ), - ( 170,106,154, 90,166,102,150, 86,169,105,153, 89,165,101,149, 85 ) - ); - - -{ Declarations for Floyd-Steinberg dithering. - - Errors are accumulated into the array fserrors[], at a resolution of - 1/16th of a pixel count. The error at a given pixel is propagated - to its not-yet-processed neighbors using the standard F-S fractions, - ... (here) 7/16 - 3/16 5/16 1/16 - We work left-to-right on even rows, right-to-left on odd rows. - - We can get away with a single array (holding one row's worth of errors) - by using it to store the current row's errors at pixel columns not yet - processed, but the next row's errors at columns already processed. We - need only a few extra variables to hold the errors immediately around the - current column. (If we are lucky, those variables are in registers, but - even if not, they're probably cheaper to access than array elements are.) - - The fserrors[] array is indexed [component#][position]. - We provide (#columns + 2) entries per component; the extra entry at each - end saves us from special-casing the first and last pixels. - - Note: on a wide image, we might not have enough room in a PC's near data - segment to hold the error array; so it is allocated with alloc_large. } - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - FSERROR = INT16; { 16 bits should be enough } - LOCFSERROR = int; { use 'int' for calculation temps } -{$else} -type - FSERROR = INT32; { may need more than 16 bits } - LOCFSERROR = INT32; { be sure calculation temps are big enough } -{$endif} - -type - jFSError = 0..(MaxInt div SIZEOF(FSERROR))-1; - FS_ERROR_FIELD = array[jFSError] of FSERROR; - FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} - { pointer to error array (in FAR storage!) } - FSERRORPTR = ^FSERROR; - - -{ Private subobject } - -const - MAX_Q_COMPS = 4; { max components I can handle } - -type - my_cquantize_ptr = ^my_cquantizer; - my_cquantizer = record - pub : jpeg_color_quantizer; { public fields } - - { Initially allocated colormap is saved here } - sv_colormap : JSAMPARRAY; { The color map as a 2-D pixel array } - sv_actual : int; { number of entries in use } - - colorindex : JSAMPARRAY; { Precomputed mapping for speed } - { colorindex[i][j] = index of color closest to pixel value j in component i, - premultiplied as described above. Since colormap indexes must fit into - JSAMPLEs, the entries of this array will too. } - - is_padded : boolean; { is the colorindex padded for odither? } - - Ncolors : array[0..MAX_Q_COMPS-1] of int; - { # of values alloced to each component } - - { Variables for ordered dithering } - row_index : int; { cur row's vertical index in dither matrix } - odither : array[0..MAX_Q_COMPS-1] of ODITHER_MATRIX_PTR; - { one dither array per component } - { Variables for Floyd-Steinberg dithering } - fserrors : array[0..MAX_Q_COMPS-1] of FS_ERROR_FIELD_PTR; - { accumulated errors } - on_odd_row : boolean; { flag to remember which row we are on } - end; - - -{ Policy-making subroutines for create_colormap and create_colorindex. - These routines determine the colormap to be used. The rest of the module - only assumes that the colormap is orthogonal. - - * select_ncolors decides how to divvy up the available colors - among the components. - * output_value defines the set of representative values for a component. - * largest_input_value defines the mapping from input values to - representative values for a component. - Note that the latter two routines may impose different policies for - different components, though this is not currently done. } - - - -{LOCAL} -function select_ncolors (cinfo : j_decompress_ptr; - var Ncolors : array of int) : int; -{ Determine allocation of desired colors to components, } -{ and fill in Ncolors[] array to indicate choice. } -{ Return value is total number of colors (product of Ncolors[] values). } -var - nc : int; - max_colors : int; - total_colors, iroot, i, j : int; - changed : boolean; - temp : long; -const - RGB_order:array[0..2] of int = (RGB_GREEN, RGB_RED, RGB_BLUE); -begin - nc := cinfo^.out_color_components; { number of color components } - max_colors := cinfo^.desired_number_of_colors; - - { We can allocate at least the nc'th root of max_colors per component. } - { Compute floor(nc'th root of max_colors). } - iroot := 1; - repeat - Inc(iroot); - temp := iroot; { set temp = iroot ** nc } - for i := 1 to pred(nc) do - temp := temp * iroot; - until (temp > long(max_colors)); { repeat till iroot exceeds root } - Dec(iroot); { now iroot = floor(root) } - - { Must have at least 2 color values per component } - if (iroot < 2) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, int(temp)); - - { Initialize to iroot color values for each component } - total_colors := 1; - for i := 0 to pred(nc) do - begin - Ncolors[i] := iroot; - total_colors := total_colors * iroot; - end; - - { We may be able to increment the count for one or more components without - exceeding max_colors, though we know not all can be incremented. - Sometimes, the first component can be incremented more than once! - (Example: for 16 colors, we start at 2*2*2, go to 3*2*2, then 4*2*2.) - In RGB colorspace, try to increment G first, then R, then B. } - - repeat - changed := FALSE; - for i := 0 to pred(nc) do - begin - if cinfo^.out_color_space = JCS_RGB then - j := RGB_order[i] - else - j := i; - { calculate new total_colors if Ncolors[j] is incremented } - temp := total_colors div Ncolors[j]; - temp := temp * (Ncolors[j]+1); { done in long arith to avoid oflo } - if (temp > long(max_colors)) then - break; { won't fit, done with this pass } - Inc(Ncolors[j]); { OK, apply the increment } - total_colors := int(temp); - changed := TRUE; - end; - until not changed; - - select_ncolors := total_colors; -end; - - -{LOCAL} -function output_value (cinfo : j_decompress_ptr; - ci : int; j : int; maxj : int) : int; -{ Return j'th output value, where j will range from 0 to maxj } -{ The output values must fall in 0..MAXJSAMPLE in increasing order } -begin - { We always provide values 0 and MAXJSAMPLE for each component; - any additional values are equally spaced between these limits. - (Forcing the upper and lower values to the limits ensures that - dithering can't produce a color outside the selected gamut.) } - - output_value := int (( INT32(j) * MAXJSAMPLE + maxj div 2) div maxj); -end; - - -{LOCAL} -function largest_input_value (cinfo : j_decompress_ptr; - ci : int; j : int; maxj : int) : int; -{ Return largest input value that should map to j'th output value } -{ Must have largest(j=0) >= 0, and largest(j=maxj) >= MAXJSAMPLE } -begin - { Breakpoints are halfway between values returned by output_value } - largest_input_value := int (( INT32(2*j + 1) * MAXJSAMPLE + - maxj) div (2*maxj)); -end; - - -{ Create the colormap. } - -{LOCAL} -procedure create_colormap (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - colormap : JSAMPARRAY; { Created colormap } - - total_colors : int; { Number of distinct output colors } - i,j,k, nci, blksize, blkdist, ptr, val : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Select number of colors for each component } - total_colors := select_ncolors(cinfo, cquantize^.Ncolors); - - { Report selected color counts } - {$IFDEF DEBUG} - if (cinfo^.out_color_components = 3) then - TRACEMS4(j_common_ptr(cinfo), 1, JTRC_QUANT_3_NCOLORS, - total_colors, cquantize^.Ncolors[0], - cquantize^.Ncolors[1], cquantize^.Ncolors[2]) - else - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_NCOLORS, total_colors); - {$ENDIF} - - { Allocate and fill in the colormap. } - { The colors are ordered in the map in standard row-major order, } - { i.e. rightmost (highest-indexed) color changes most rapidly. } - - colormap := cinfo^.mem^.alloc_sarray( - j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION(total_colors), JDIMENSION(cinfo^.out_color_components)); - - { blksize is number of adjacent repeated entries for a component } - { blkdist is distance between groups of identical entries for a component } - blkdist := total_colors; - - for i := 0 to pred(cinfo^.out_color_components) do - begin - { fill in colormap entries for i'th color component } - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - blksize := blkdist div nci; - for j := 0 to pred(nci) do - begin - { Compute j'th output value (out of nci) for component } - val := output_value(cinfo, i, j, nci-1); - { Fill in all colormap entries that have this value of this component } - ptr := j * blksize; - while (ptr < total_colors) do - begin - { fill in blksize entries beginning at ptr } - for k := 0 to pred(blksize) do - colormap^[i]^[ptr+k] := JSAMPLE(val); - - Inc(ptr, blkdist); - end; - end; - blkdist := blksize; { blksize of this color is blkdist of next } - end; - - { Save the colormap in private storage, - where it will survive color quantization mode changes. } - - cquantize^.sv_colormap := colormap; - cquantize^.sv_actual := total_colors; -end; - -{ Create the color index table. } - -{LOCAL} -procedure create_colorindex (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - indexptr, - help_indexptr : JSAMPROW; { for negative offsets } - i,j,k, nci, blksize, val, pad : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - { For ordered dither, we pad the color index tables by MAXJSAMPLE in - each direction (input index values can be -MAXJSAMPLE .. 2*MAXJSAMPLE). - This is not necessary in the other dithering modes. However, we - flag whether it was done in case user changes dithering mode. } - - if (cinfo^.dither_mode = JDITHER_ORDERED) then - begin - pad := MAXJSAMPLE*2; - cquantize^.is_padded := TRUE; - end - else - begin - pad := 0; - cquantize^.is_padded := FALSE; - end; - - cquantize^.colorindex := cinfo^.mem^.alloc_sarray - (j_common_ptr(cinfo), JPOOL_IMAGE, - JDIMENSION(MAXJSAMPLE+1 + pad), - JDIMENSION(cinfo^.out_color_components)); - - { blksize is number of adjacent repeated entries for a component } - blksize := cquantize^.sv_actual; - - for i := 0 to pred(cinfo^.out_color_components) do - begin - { fill in colorindex entries for i'th color component } - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - blksize := blksize div nci; - - { adjust colorindex pointers to provide padding at negative indexes. } - if (pad <> 0) then - Inc(JSAMPLE_PTR(cquantize^.colorindex^[i]), MAXJSAMPLE); - - { in loop, val = index of current output value, } - { and k = largest j that maps to current val } - indexptr := cquantize^.colorindex^[i]; - val := 0; - k := largest_input_value(cinfo, i, 0, nci-1); - for j := 0 to MAXJSAMPLE do - begin - while (j > k) do { advance val if past boundary } - begin - Inc(val); - k := largest_input_value(cinfo, i, val, nci-1); - end; - { premultiply so that no multiplication needed in main processing } - indexptr^[j] := JSAMPLE (val * blksize); - end; - { Pad at both ends if necessary } - if (pad <> 0) then - begin - help_indexptr := indexptr; - { adjust the help pointer to avoid negative offsets } - Dec(JSAMPLE_PTR(help_indexptr), MAXJSAMPLE); - - for j := 1 to MAXJSAMPLE do - begin - {indexptr^[-j] := indexptr^[0];} - help_indexptr^[MAXJSAMPLE-j] := indexptr^[0]; - indexptr^[MAXJSAMPLE+j] := indexptr^[MAXJSAMPLE]; - end; - end; - end; -end; - - -{ Create an ordered-dither array for a component having ncolors - distinct output values. } - -{LOCAL} -function make_odither_array (cinfo : j_decompress_ptr; - ncolors : int) : ODITHER_MATRIX_PTR; -var - odither : ODITHER_MATRIX_PTR; - j, k : int; - num, den : INT32; -begin - odither := ODITHER_MATRIX_PTR ( - cinfo^.mem^.alloc_small(j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(ODITHER_MATRIX))); - { The inter-value distance for this color is MAXJSAMPLE/(ncolors-1). - Hence the dither value for the matrix cell with fill order f - (f=0..N-1) should be (N-1-2*f)/(2*N) * MAXJSAMPLE/(ncolors-1). - On 16-bit-int machine, be careful to avoid overflow. } - - den := 2 * ODITHER_CELLS * ( INT32(ncolors - 1)); - for j := 0 to pred(ODITHER_SIZE) do - begin - for k := 0 to pred(ODITHER_SIZE) do - begin - num := ( INT32(ODITHER_CELLS-1 - 2*( int(base_dither_matrix[j][k])))) - * MAXJSAMPLE; - { Ensure round towards zero despite C's lack of consistency - about rounding negative values in integer division... } - - if num<0 then - odither^[j][k] := int (-((-num) div den)) - else - odither^[j][k] := int (num div den); - end; - end; - make_odither_array := odither; -end; - - -{ Create the ordered-dither tables. - Components having the same number of representative colors may - share a dither table. } - -{LOCAL} -procedure create_odither_tables (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - odither : ODITHER_MATRIX_PTR; - i, j, nci : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - for i := 0 to pred(cinfo^.out_color_components) do - begin - nci := cquantize^.Ncolors[i]; { # of distinct values for this color } - odither := NIL; { search for matching prior component } - for j := 0 to pred(i) do - begin - if (nci = cquantize^.Ncolors[j]) then - begin - odither := cquantize^.odither[j]; - break; - end; - end; - if (odither = NIL) then { need a new table? } - odither := make_odither_array(cinfo, nci); - cquantize^.odither[i] := odither; - end; -end; - - -{ Map some rows of pixels to the output colormapped representation. } - -{METHODDEF} -procedure color_quantize (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, no dithering } -var - cquantize : my_cquantize_ptr; - colorindex : JSAMPARRAY; - pixcode, ci : int; {register} - ptrin, ptrout : JSAMPLE_PTR; {register} - row : int; - col : JDIMENSION; - width : JDIMENSION; - nc : int; {register} -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex := cquantize^.colorindex; - width := cinfo^.output_width; - nc := cinfo^.out_color_components; - - for row := 0 to pred(num_rows) do - begin - ptrin := JSAMPLE_PTR(input_buf^[row]); - ptrout := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - pixcode := 0; - for ci := 0 to pred(nc) do - begin - Inc(pixcode, GETJSAMPLE(colorindex^[ci]^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - end; - ptrout^ := JSAMPLE (pixcode); - Inc(ptrout); - end; - end; -end; - - -{METHODDEF} -procedure color_quantize3 (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ Fast path for out_color_components=3, no dithering } -var - cquantize : my_cquantize_ptr; - pixcode : int; {register} - ptrin, ptrout : JSAMPLE_PTR; {register} - colorindex0 : JSAMPROW; - colorindex1 : JSAMPROW; - colorindex2 : JSAMPROW; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex0 := (cquantize^.colorindex)^[0]; - colorindex1 := (cquantize^.colorindex)^[1]; - colorindex2 := (cquantize^.colorindex)^[2]; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - ptrin := JSAMPLE_PTR(input_buf^[row]); - ptrout := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - pixcode := GETJSAMPLE((colorindex0)^[GETJSAMPLE(ptrin^)]); - Inc(ptrin); - Inc( pixcode, GETJSAMPLE((colorindex1)^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - Inc( pixcode, GETJSAMPLE((colorindex2)^[GETJSAMPLE(ptrin^)]) ); - Inc(ptrin); - ptrout^ := JSAMPLE (pixcode); - Inc(ptrout); - end; - end; -end; - - -{METHODDEF} -procedure quantize_ord_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, with ordered dithering } -var - cquantize : my_cquantize_ptr; - input_ptr, {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex_ci : JSAMPROW; - dither : ^ODITHER_vector; { points to active row of dither matrix } - row_index, col_index : int; { current indexes into dither matrix } - nc : int; - ci : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; -var - pad_offset : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - nc := cinfo^.out_color_components; - width := cinfo^.output_width; - - { Nomssi: work around negative offset } - if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then - pad_offset := MAXJSAMPLE - else - pad_offset := 0; - - for row := 0 to pred(num_rows) do - begin - { Initialize output values to 0 so can process components separately } - jzero_far( {far} pointer(output_buf^[row]), - size_t(width * SIZEOF(JSAMPLE))); - row_index := cquantize^.row_index; - for ci := 0 to pred(nc) do - begin - input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - colorindex_ci := cquantize^.colorindex^[ci]; - { Nomssi } - Dec(JSAMPLE_PTR(colorindex_ci), pad_offset); - - dither := @(cquantize^.odither[ci]^[row_index]); - col_index := 0; - - for col := pred(width) downto 0 do - begin - { Form pixel value + dither, range-limit to 0..MAXJSAMPLE, - select output value, accumulate into output code for this pixel. - Range-limiting need not be done explicitly, as we have extended - the colorindex table to produce the right answers for out-of-range - inputs. The maximum dither is +- MAXJSAMPLE; this sets the - required amount of padding. } - - Inc(output_ptr^, - colorindex_ci^[GETJSAMPLE(input_ptr^)+ pad_offset + - dither^[col_index]]); - Inc(output_ptr); - Inc(input_ptr, nc); - col_index := (col_index + 1) and ODITHER_MASK; - end; - end; - { Advance row index for next row } - row_index := (row_index + 1) and ODITHER_MASK; - cquantize^.row_index := row_index; - end; -end; - -{METHODDEF} -procedure quantize3_ord_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ Fast path for out_color_components=3, with ordered dithering } -var - cquantize : my_cquantize_ptr; - pixcode : int; {register} - input_ptr : JSAMPLE_PTR; {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex0 : JSAMPROW; - colorindex1 : JSAMPROW; - colorindex2 : JSAMPROW; - dither0 : ^ODITHER_vector; { points to active row of dither matrix } - dither1 : ^ODITHER_vector; - dither2 : ^ODITHER_vector; - row_index, col_index : int; { current indexes into dither matrix } - row : int; - col : JDIMENSION; - width : JDIMENSION; -var - pad_offset : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - colorindex0 := (cquantize^.colorindex)^[0]; - colorindex1 := (cquantize^.colorindex)^[1]; - colorindex2 := (cquantize^.colorindex)^[2]; - width := cinfo^.output_width; - - { Nomssi: work around negative offset } - if my_cquantize_ptr (cinfo^.cquantize)^.is_padded then - pad_offset := MAXJSAMPLE - else - pad_offset := 0; - - Dec(JSAMPLE_PTR(colorindex0), pad_offset); - Dec(JSAMPLE_PTR(colorindex1), pad_offset); - Dec(JSAMPLE_PTR(colorindex2), pad_offset); - - for row := 0 to pred(num_rows) do - begin - row_index := cquantize^.row_index; - input_ptr := JSAMPLE_PTR(input_buf^[row]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - dither0 := @(cquantize^.odither[0]^[row_index]); - dither1 := @(cquantize^.odither[1]^[row_index]); - dither2 := @(cquantize^.odither[2]^[row_index]); - col_index := 0; - - - for col := pred(width) downto 0 do - begin - pixcode := GETJSAMPLE(colorindex0^[GETJSAMPLE(input_ptr^) + pad_offset - + dither0^[col_index]]); - Inc(input_ptr); - Inc(pixcode, GETJSAMPLE(colorindex1^[GETJSAMPLE(input_ptr^) + pad_offset - + dither1^[col_index]])); - Inc(input_ptr); - Inc(pixcode, GETJSAMPLE(colorindex2^[GETJSAMPLE(input_ptr^) + pad_offset - + dither2^[col_index]])); - Inc(input_ptr); - output_ptr^ := JSAMPLE (pixcode); - Inc(output_ptr); - col_index := (col_index + 1) and ODITHER_MASK; - end; - row_index := (row_index + 1) and ODITHER_MASK; - cquantize^.row_index := row_index; - end; -end; - - -{METHODDEF} -procedure quantize_fs_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ General case, with Floyd-Steinberg dithering } -var - cquantize : my_cquantize_ptr; - cur : LOCFSERROR; {register} { current error or pixel value } - belowerr : LOCFSERROR; { error for pixel below cur } - bpreverr : LOCFSERROR; { error for below/prev col } - bnexterr : LOCFSERROR; { error for below/next col } - delta : LOCFSERROR; - prev_errorptr, - errorptr : FSERRORPTR; {register} { => fserrors[] at column before current } - input_ptr, {register} - output_ptr : JSAMPLE_PTR; {register} - colorindex_ci : JSAMPROW; - colormap_ci : JSAMPROW; - pixcode : int; - nc : int; - dir : int; { 1 for left-to-right, -1 for right-to-left } - dirnc : int; { dir * nc } - ci : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; - range_limit : range_limit_table_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - nc := cinfo^.out_color_components; - width := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - - for row := 0 to pred(num_rows) do - begin - { Initialize output values to 0 so can process components separately } - jzero_far( (output_buf)^[row], - size_t(width * SIZEOF(JSAMPLE))); - for ci := 0 to pred(nc) do - begin - input_ptr := JSAMPLE_PTR(@ input_buf^[row]^[ci]); - output_ptr := JSAMPLE_PTR(output_buf^[row]); - errorptr := FSERRORPTR(cquantize^.fserrors[ci]); { => entry before first column } - if (cquantize^.on_odd_row) then - begin - { work right to left in this row } - Inc(input_ptr, (width-1) * JDIMENSION(nc)); { so point to rightmost pixel } - Inc(output_ptr, width-1); - dir := -1; - dirnc := -nc; - Inc(errorptr, (width+1)); { => entry after last column } - end - else - begin - { work left to right in this row } - dir := 1; - dirnc := nc; - {errorptr := cquantize^.fserrors[ci];} - end; - - colorindex_ci := cquantize^.colorindex^[ci]; - - colormap_ci := (cquantize^.sv_colormap)^[ci]; - { Preset error values: no error propagated to first pixel from left } - cur := 0; - { and no error propagated to row below yet } - belowerr := 0; - bpreverr := 0; - - for col := pred(width) downto 0 do - begin - prev_errorptr := errorptr; - Inc(errorptr, dir); { advance errorptr to current column } - - { cur holds the error propagated from the previous pixel on the - current line. Add the error propagated from the previous line - to form the complete error correction term for this pixel, and - round the error term (which is expressed * 16) to an integer. - RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct - for either sign of the error value. - Note: errorptr points to *previous* column's array entry. } - - cur := (cur + errorptr^ + 8) div 16; - - { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. - The maximum error is +- MAXJSAMPLE; this sets the required size - of the range_limit array. } - - Inc( cur, GETJSAMPLE(input_ptr^)); - cur := GETJSAMPLE(range_limit^[cur]); - { Select output value, accumulate into output code for this pixel } - pixcode := GETJSAMPLE(colorindex_ci^[cur]); - Inc(output_ptr^, JSAMPLE (pixcode)); - { Compute actual representation error at this pixel } - { Note: we can do this even though we don't have the final } - { pixel code, because the colormap is orthogonal. } - Dec(cur, GETJSAMPLE(colormap_ci^[pixcode])); - { Compute error fractions to be propagated to adjacent pixels. - Add these into the running sums, and simultaneously shift the - next-line error sums left by 1 column. } - - bnexterr := cur; - delta := cur * 2; - Inc(cur, delta); { form error * 3 } - prev_errorptr^ := FSERROR (bpreverr + cur); - Inc(cur, delta); { form error * 5 } - bpreverr := belowerr + cur; - belowerr := bnexterr; - Inc(cur, delta); { form error * 7 } - { At this point cur contains the 7/16 error value to be propagated - to the next pixel on the current line, and all the errors for the - next line have been shifted over. We are therefore ready to move on. } - - Inc(input_ptr, dirnc); { advance input ptr to next column } - Inc(output_ptr, dir); { advance output ptr to next column } - - end; - { Post-loop cleanup: we must unload the final error value into the - final fserrors[] entry. Note we need not unload belowerr because - it is for the dummy column before or after the actual array. } - - errorptr^ := FSERROR (bpreverr); { unload prev err into array } - { Nomssi : ?? } - end; - cquantize^.on_odd_row := not cquantize^.on_odd_row; - end; -end; - - -{ Allocate workspace for Floyd-Steinberg errors. } - -{LOCAL} -procedure alloc_fs_workspace (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - arraysize : size_t; - i : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); - for i := 0 to pred(cinfo^.out_color_components) do - begin - cquantize^.fserrors[i] := FS_ERROR_FIELD_PTR( - cinfo^.mem^.alloc_large(j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); - end; -end; - - -{ Initialize for one-pass color quantization. } - -{METHODDEF} -procedure start_pass_1_quant (cinfo : j_decompress_ptr; - is_pre_scan : boolean); -var - cquantize : my_cquantize_ptr; - arraysize : size_t; - i : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - { Install my colormap. } - cinfo^.colormap := cquantize^.sv_colormap; - cinfo^.actual_number_of_colors := cquantize^.sv_actual; - - { Initialize for desired dithering mode. } - case (cinfo^.dither_mode) of - JDITHER_NONE: - if (cinfo^.out_color_components = 3) then - cquantize^.pub.color_quantize := color_quantize3 - else - cquantize^.pub.color_quantize := color_quantize; - JDITHER_ORDERED: - begin - if (cinfo^.out_color_components = 3) then - cquantize^.pub.color_quantize := quantize3_ord_dither - else - cquantize^.pub.color_quantize := quantize_ord_dither; - cquantize^.row_index := 0; { initialize state for ordered dither } - { If user changed to ordered dither from another mode, - we must recreate the color index table with padding. - This will cost extra space, but probably isn't very likely. } - - if (not cquantize^.is_padded) then - create_colorindex(cinfo); - { Create ordered-dither tables if we didn't already. } - if (cquantize^.odither[0] = NIL) then - create_odither_tables(cinfo); - end; - JDITHER_FS: - begin - cquantize^.pub.color_quantize := quantize_fs_dither; - cquantize^.on_odd_row := FALSE; { initialize state for F-S dither } - { Allocate Floyd-Steinberg workspace if didn't already. } - if (cquantize^.fserrors[0] = NIL) then - alloc_fs_workspace(cinfo); - { Initialize the propagated errors to zero. } - arraysize := size_t ((cinfo^.output_width + 2) * SIZEOF(FSERROR)); - for i := 0 to pred(cinfo^.out_color_components) do - jzero_far({far} pointer( cquantize^.fserrors[i] ), arraysize); - end; - else - ERREXIT(j_common_ptr(cinfo), JERR_NOT_COMPILED); - end; -end; - - -{ Finish up at the end of the pass. } - -{METHODDEF} -procedure finish_pass_1_quant (cinfo : j_decompress_ptr); -begin - { no work in 1-pass case } -end; - - -{ Switch to a new external colormap between output passes. - Shouldn't get to this module! } - -{METHODDEF} -procedure new_color_map_1_quant (cinfo : j_decompress_ptr); -begin - ERREXIT(j_common_ptr(cinfo), JERR_MODE_CHANGE); -end; - - -{ Module initialization routine for 1-pass color quantization. } - -{GLOBAL} -procedure jinit_1pass_quantizer (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_cquantizer))); - cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); - cquantize^.pub.start_pass := start_pass_1_quant; - cquantize^.pub.finish_pass := finish_pass_1_quant; - cquantize^.pub.new_color_map := new_color_map_1_quant; - cquantize^.fserrors[0] := NIL; { Flag FS workspace not allocated } - cquantize^.odither[0] := NIL; { Also flag odither arrays not allocated } - - { Make sure my internal arrays won't overflow } - if (cinfo^.out_color_components > MAX_Q_COMPS) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_COMPONENTS, MAX_Q_COMPS); - { Make sure colormap indexes can be represented by JSAMPLEs } - if (cinfo^.desired_number_of_colors > (MAXJSAMPLE+1)) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXJSAMPLE+1); - - { Create the colormap and color index table. } - create_colormap(cinfo); - create_colorindex(cinfo); - - { Allocate Floyd-Steinberg workspace now if requested. - We do this now since it is FAR storage and may affect the memory - manager's space calculations. If the user changes to FS dither - mode in a later pass, we will allocate the space then, and will - possibly overrun the max_memory_to_use setting. } - - if (cinfo^.dither_mode = JDITHER_FS) then - alloc_fs_workspace(cinfo); -end; - - -end. diff --git a/3rd/Imaging/Source/JpegLib/imjquant2.pas b/3rd/Imaging/Source/JpegLib/imjquant2.pas deleted file mode 100644 index a1e7a4402..000000000 --- a/3rd/Imaging/Source/JpegLib/imjquant2.pas +++ /dev/null @@ -1,1551 +0,0 @@ -unit imjquant2; - - -{ This file contains 2-pass color quantization (color mapping) routines. - These routines provide selection of a custom color map for an image, - followed by mapping of the image to that color map, with optional - Floyd-Steinberg dithering. - It is also possible to use just the second pass to map to an arbitrary - externally-given color map. - - Note: ordered dithering is not supported, since there isn't any fast - way to compute intercolor distances; it's unclear that ordered dither's - fundamental assumptions even hold with an irregularly spaced color map. } - -{ Original: jquant2.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjdeferr, - imjerror, - imjutils, - imjpeglib; - -{ Module initialization routine for 2-pass color quantization. } - - -{GLOBAL} -procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); - -implementation - -{ This module implements the well-known Heckbert paradigm for color - quantization. Most of the ideas used here can be traced back to - Heckbert's seminal paper - Heckbert, Paul. "Color Image Quantization for Frame Buffer Display", - Proc. SIGGRAPH '82, Computer Graphics v.16 #3 (July 1982), pp 297-304. - - In the first pass over the image, we accumulate a histogram showing the - usage count of each possible color. To keep the histogram to a reasonable - size, we reduce the precision of the input; typical practice is to retain - 5 or 6 bits per color, so that 8 or 4 different input values are counted - in the same histogram cell. - - Next, the color-selection step begins with a box representing the whole - color space, and repeatedly splits the "largest" remaining box until we - have as many boxes as desired colors. Then the mean color in each - remaining box becomes one of the possible output colors. - - The second pass over the image maps each input pixel to the closest output - color (optionally after applying a Floyd-Steinberg dithering correction). - This mapping is logically trivial, but making it go fast enough requires - considerable care. - - Heckbert-style quantizers vary a good deal in their policies for choosing - the "largest" box and deciding where to cut it. The particular policies - used here have proved out well in experimental comparisons, but better ones - may yet be found. - - In earlier versions of the IJG code, this module quantized in YCbCr color - space, processing the raw upsampled data without a color conversion step. - This allowed the color conversion math to be done only once per colormap - entry, not once per pixel. However, that optimization precluded other - useful optimizations (such as merging color conversion with upsampling) - and it also interfered with desired capabilities such as quantizing to an - externally-supplied colormap. We have therefore abandoned that approach. - The present code works in the post-conversion color space, typically RGB. - - To improve the visual quality of the results, we actually work in scaled - RGB space, giving G distances more weight than R, and R in turn more than - B. To do everything in integer math, we must use integer scale factors. - The 2/3/1 scale factors used here correspond loosely to the relative - weights of the colors in the NTSC grayscale equation. - If you want to use this code to quantize a non-RGB color space, you'll - probably need to change these scale factors. } - -const - R_SCALE = 2; { scale R distances by this much } - G_SCALE = 3; { scale G distances by this much } - B_SCALE = 1; { and B by this much } - -{ Relabel R/G/B as components 0/1/2, respecting the RGB ordering defined - in jmorecfg.h. As the code stands, it will do the right thing for R,G,B - and B,G,R orders. If you define some other weird order in jmorecfg.h, - you'll get compile errors until you extend this logic. In that case - you'll probably want to tweak the histogram sizes too. } - -{$ifdef RGB_RED_IS_0} -const - C0_SCALE = R_SCALE; - C1_SCALE = G_SCALE; - C2_SCALE = B_SCALE; -{$else} -const - C0_SCALE = B_SCALE; - C1_SCALE = G_SCALE; - C2_SCALE = R_SCALE; -{$endif} - - -{ First we have the histogram data structure and routines for creating it. - - The number of bits of precision can be adjusted by changing these symbols. - We recommend keeping 6 bits for G and 5 each for R and B. - If you have plenty of memory and cycles, 6 bits all around gives marginally - better results; if you are short of memory, 5 bits all around will save - some space but degrade the results. - To maintain a fully accurate histogram, we'd need to allocate a "long" - (preferably unsigned long) for each cell. In practice this is overkill; - we can get by with 16 bits per cell. Few of the cell counts will overflow, - and clamping those that do overflow to the maximum value will give close- - enough results. This reduces the recommended histogram size from 256Kb - to 128Kb, which is a useful savings on PC-class machines. - (In the second pass the histogram space is re-used for pixel mapping data; - in that capacity, each cell must be able to store zero to the number of - desired colors. 16 bits/cell is plenty for that too.) - Since the JPEG code is intended to run in small memory model on 80x86 - machines, we can't just allocate the histogram in one chunk. Instead - of a true 3-D array, we use a row of pointers to 2-D arrays. Each - pointer corresponds to a C0 value (typically 2^5 = 32 pointers) and - each 2-D array has 2^6*2^5 = 2048 or 2^6*2^6 = 4096 entries. Note that - on 80x86 machines, the pointer row is in near memory but the actual - arrays are in far memory (same arrangement as we use for image arrays). } - - -const - MAXNUMCOLORS = (MAXJSAMPLE+1); { maximum size of colormap } - -{ These will do the right thing for either R,G,B or B,G,R color order, - but you may not like the results for other color orders. } - -const - HIST_C0_BITS = 5; { bits of precision in R/B histogram } - HIST_C1_BITS = 6; { bits of precision in G histogram } - HIST_C2_BITS = 5; { bits of precision in B/R histogram } - -{ Number of elements along histogram axes. } -const - HIST_C0_ELEMS = (1 shl HIST_C0_BITS); - HIST_C1_ELEMS = (1 shl HIST_C1_BITS); - HIST_C2_ELEMS = (1 shl HIST_C2_BITS); - -{ These are the amounts to shift an input value to get a histogram index. } -const - C0_SHIFT = (BITS_IN_JSAMPLE-HIST_C0_BITS); - C1_SHIFT = (BITS_IN_JSAMPLE-HIST_C1_BITS); - C2_SHIFT = (BITS_IN_JSAMPLE-HIST_C2_BITS); - - -type { Nomssi } - RGBptr = ^RGBtype; - RGBtype = packed record - r,g,b : JSAMPLE; - end; -type - histcell = UINT16; { histogram cell; prefer an unsigned type } - -type - histptr = ^histcell {FAR}; { for pointers to histogram cells } - -type - hist1d = array[0..HIST_C2_ELEMS-1] of histcell; { typedefs for the array } - {hist1d_ptr = ^hist1d;} - hist1d_field = array[0..HIST_C1_ELEMS-1] of hist1d; - { type for the 2nd-level pointers } - hist2d = ^hist1d_field; - hist2d_field = array[0..HIST_C0_ELEMS-1] of hist2d; - hist3d = ^hist2d_field; { type for top-level pointer } - - -{ Declarations for Floyd-Steinberg dithering. - - Errors are accumulated into the array fserrors[], at a resolution of - 1/16th of a pixel count. The error at a given pixel is propagated - to its not-yet-processed neighbors using the standard F-S fractions, - ... (here) 7/16 - 3/16 5/16 1/16 - We work left-to-right on even rows, right-to-left on odd rows. - - We can get away with a single array (holding one row's worth of errors) - by using it to store the current row's errors at pixel columns not yet - processed, but the next row's errors at columns already processed. We - need only a few extra variables to hold the errors immediately around the - current column. (If we are lucky, those variables are in registers, but - even if not, they're probably cheaper to access than array elements are.) - - The fserrors[] array has (#columns + 2) entries; the extra entry at - each end saves us from special-casing the first and last pixels. - Each entry is three values long, one value for each color component. - - Note: on a wide image, we might not have enough room in a PC's near data - segment to hold the error array; so it is allocated with alloc_large. } - - -{$ifdef BITS_IN_JSAMPLE_IS_8} -type - FSERROR = INT16; { 16 bits should be enough } - LOCFSERROR = int; { use 'int' for calculation temps } -{$else} -type - FSERROR = INT32; { may need more than 16 bits } - LOCFSERROR = INT32; { be sure calculation temps are big enough } -{$endif} -type { Nomssi } - RGB_FSERROR_PTR = ^RGB_FSERROR; - RGB_FSERROR = packed record - r,g,b : FSERROR; - end; - LOCRGB_FSERROR = packed record - r,g,b : LOCFSERROR; - end; - -type - FSERROR_PTR = ^FSERROR; - jFSError = 0..(MaxInt div SIZEOF(RGB_FSERROR))-1; - FS_ERROR_FIELD = array[jFSError] of RGB_FSERROR; - FS_ERROR_FIELD_PTR = ^FS_ERROR_FIELD;{far} - { pointer to error array (in FAR storage!) } - -type - error_limit_array = array[-MAXJSAMPLE..MAXJSAMPLE] of int; - { table for clamping the applied error } - error_limit_ptr = ^error_limit_array; - -{ Private subobject } -type - my_cquantize_ptr = ^my_cquantizer; - my_cquantizer = record - pub : jpeg_color_quantizer; { public fields } - - { Space for the eventually created colormap is stashed here } - sv_colormap : JSAMPARRAY; { colormap allocated at init time } - desired : int; { desired # of colors = size of colormap } - - { Variables for accumulating image statistics } - histogram : hist3d; { pointer to the histogram } - - needs_zeroed : boolean; { TRUE if next pass must zero histogram } - - { Variables for Floyd-Steinberg dithering } - fserrors : FS_ERROR_FIELD_PTR; { accumulated errors } - on_odd_row : boolean; { flag to remember which row we are on } - error_limiter : error_limit_ptr; { table for clamping the applied error } - end; - - - -{ Prescan some rows of pixels. - In this module the prescan simply updates the histogram, which has been - initialized to zeroes by start_pass. - An output_buf parameter is required by the method signature, but no data - is actually output (in fact the buffer controller is probably passing a - NIL pointer). } - -{METHODDEF} -procedure prescan_quantize (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -var - cquantize : my_cquantize_ptr; - {register} ptr : RGBptr; - {register} histp : histptr; - {register} histogram : hist3d; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - ptr := RGBptr(input_buf^[row]); - for col := pred(width) downto 0 do - begin - { get pixel value and index into the histogram } - histp := @(histogram^[GETJSAMPLE(ptr^.r) shr C0_SHIFT]^ - [GETJSAMPLE(ptr^.g) shr C1_SHIFT] - [GETJSAMPLE(ptr^.b) shr C2_SHIFT]); - { increment, check for overflow and undo increment if so. } - Inc(histp^); - if (histp^ <= 0) then - Dec(histp^); - Inc(ptr); - end; - end; -end; - -{ Next we have the really interesting routines: selection of a colormap - given the completed histogram. - These routines work with a list of "boxes", each representing a rectangular - subset of the input color space (to histogram precision). } - -type - box = record - { The bounds of the box (inclusive); expressed as histogram indexes } - c0min, c0max : int; - c1min, c1max : int; - c2min, c2max : int; - { The volume (actually 2-norm) of the box } - volume : INT32; - { The number of nonzero histogram cells within this box } - colorcount : long; - end; - -type - jBoxList = 0..(MaxInt div SizeOf(box))-1; - box_field = array[jBoxlist] of box; - boxlistptr = ^box_field; - boxptr = ^box; - -{LOCAL} -function find_biggest_color_pop (boxlist : boxlistptr; numboxes : int) : boxptr; -{ Find the splittable box with the largest color population } -{ Returns NIL if no splittable boxes remain } -var - boxp : boxptr ; {register} - i : int; {register} - maxc : long; {register} - which : boxptr; -begin - which := NIL; - boxp := @(boxlist^[0]); - maxc := 0; - for i := 0 to pred(numboxes) do - begin - if (boxp^.colorcount > maxc) and (boxp^.volume > 0) then - begin - which := boxp; - maxc := boxp^.colorcount; - end; - Inc(boxp); - end; - find_biggest_color_pop := which; -end; - - -{LOCAL} -function find_biggest_volume (boxlist : boxlistptr; numboxes : int) : boxptr; -{ Find the splittable box with the largest (scaled) volume } -{ Returns NULL if no splittable boxes remain } -var - {register} boxp : boxptr; - {register} i : int; - {register} maxv : INT32; - which : boxptr; -begin - maxv := 0; - which := NIL; - boxp := @(boxlist^[0]); - for i := 0 to pred(numboxes) do - begin - if (boxp^.volume > maxv) then - begin - which := boxp; - maxv := boxp^.volume; - end; - Inc(boxp); - end; - find_biggest_volume := which; -end; - - -{LOCAL} -procedure update_box (cinfo : j_decompress_ptr; var boxp : box); -label - have_c0min, have_c0max, - have_c1min, have_c1max, - have_c2min, have_c2max; -{ Shrink the min/max bounds of a box to enclose only nonzero elements, } -{ and recompute its volume and population } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - histp : histptr; - c0,c1,c2 : int; - c0min,c0max,c1min,c1max,c2min,c2max : int; - dist0,dist1,dist2 : INT32; - ccount : long; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - - c0min := boxp.c0min; c0max := boxp.c0max; - c1min := boxp.c1min; c1max := boxp.c1max; - c2min := boxp.c2min; c2max := boxp.c2max; - - if (c0max > c0min) then - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c0min := c0; - boxp.c0min := c0min; - goto have_c0min; - end; - Inc(histp); - end; - end; - have_c0min: - if (c0max > c0min) then - for c0 := c0max downto c0min do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if ( histp^ <> 0) then - begin - c0max := c0; - boxp.c0max := c0; - goto have_c0max; - end; - Inc(histp); - end; - end; - have_c0max: - if (c1max > c1min) then - for c1 := c1min to c1max do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c1min := c1; - boxp.c1min := c1; - goto have_c1min; - end; - Inc(histp); - end; - end; - have_c1min: - if (c1max > c1min) then - for c1 := c1max downto c1min do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - begin - c1max := c1; - boxp.c1max := c1; - goto have_c1max; - end; - Inc(histp); - end; - end; - have_c1max: - if (c2max > c2min) then - for c2 := c2min to c2max do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1min][c2]); - for c1 := c1min to c1max do - begin - if (histp^ <> 0) then - begin - c2min := c2; - boxp.c2min := c2min; - goto have_c2min; - end; - Inc(histp, HIST_C2_ELEMS); - end; - end; - have_c2min: - if (c2max > c2min) then - for c2 := c2max downto c2min do - for c0 := c0min to c0max do - begin - histp := @(histogram^[c0]^[c1min][c2]); - for c1 := c1min to c1max do - begin - if (histp^ <> 0) then - begin - c2max := c2; - boxp.c2max := c2max; - goto have_c2max; - end; - Inc(histp, HIST_C2_ELEMS); - end; - end; - have_c2max: - - { Update box volume. - We use 2-norm rather than real volume here; this biases the method - against making long narrow boxes, and it has the side benefit that - a box is splittable iff norm > 0. - Since the differences are expressed in histogram-cell units, - we have to shift back to JSAMPLE units to get consistent distances; - after which, we scale according to the selected distance scale factors.} - - dist0 := ((c0max - c0min) shl C0_SHIFT) * C0_SCALE; - dist1 := ((c1max - c1min) shl C1_SHIFT) * C1_SCALE; - dist2 := ((c2max - c2min) shl C2_SHIFT) * C2_SCALE; - boxp.volume := dist0*dist0 + dist1*dist1 + dist2*dist2; - - { Now scan remaining volume of box and compute population } - ccount := 0; - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - if (histp^ <> 0) then - Inc(ccount); - Inc(histp); - end; - end; - boxp.colorcount := ccount; -end; - - -{LOCAL} -function median_cut (cinfo : j_decompress_ptr; boxlist : boxlistptr; - numboxes : int; desired_colors : int) : int; -{ Repeatedly select and split the largest box until we have enough boxes } -var - n,lb : int; - c0,c1,c2,cmax : int; - {register} b1,b2 : boxptr; -begin - while (numboxes < desired_colors) do - begin - { Select box to split. - Current algorithm: by population for first half, then by volume. } - - if (numboxes*2 <= desired_colors) then - b1 := find_biggest_color_pop(boxlist, numboxes) - else - b1 := find_biggest_volume(boxlist, numboxes); - - if (b1 = NIL) then { no splittable boxes left! } - break; - b2 := @(boxlist^[numboxes]); { where new box will go } - { Copy the color bounds to the new box. } - b2^.c0max := b1^.c0max; b2^.c1max := b1^.c1max; b2^.c2max := b1^.c2max; - b2^.c0min := b1^.c0min; b2^.c1min := b1^.c1min; b2^.c2min := b1^.c2min; - { Choose which axis to split the box on. - Current algorithm: longest scaled axis. - See notes in update_box about scaling distances. } - - c0 := ((b1^.c0max - b1^.c0min) shl C0_SHIFT) * C0_SCALE; - c1 := ((b1^.c1max - b1^.c1min) shl C1_SHIFT) * C1_SCALE; - c2 := ((b1^.c2max - b1^.c2min) shl C2_SHIFT) * C2_SCALE; - { We want to break any ties in favor of green, then red, blue last. - This code does the right thing for R,G,B or B,G,R color orders only. } - -{$ifdef RGB_RED_IS_0} - cmax := c1; n := 1; - if (c0 > cmax) then - begin - cmax := c0; - n := 0; - end; - if (c2 > cmax) then - n := 2; -{$else} - cmax := c1; - n := 1; - if (c2 > cmax) then - begin - cmax := c2; - n := 2; - end; - if (c0 > cmax) then - n := 0; -{$endif} - { Choose split point along selected axis, and update box bounds. - Current algorithm: split at halfway point. - (Since the box has been shrunk to minimum volume, - any split will produce two nonempty subboxes.) - Note that lb value is max for lower box, so must be < old max. } - - case n of - 0:begin - lb := (b1^.c0max + b1^.c0min) div 2; - b1^.c0max := lb; - b2^.c0min := lb+1; - end; - 1:begin - lb := (b1^.c1max + b1^.c1min) div 2; - b1^.c1max := lb; - b2^.c1min := lb+1; - end; - 2:begin - lb := (b1^.c2max + b1^.c2min) div 2; - b1^.c2max := lb; - b2^.c2min := lb+1; - end; - end; - { Update stats for boxes } - update_box(cinfo, b1^); - update_box(cinfo, b2^); - Inc(numboxes); - end; - median_cut := numboxes; -end; - - -{LOCAL} -procedure compute_color (cinfo : j_decompress_ptr; - const boxp : box; icolor : int); -{ Compute representative color for a box, put it in colormap[icolor] } -var - { Current algorithm: mean weighted by pixels (not colors) } - { Note it is important to get the rounding correct! } - cquantize : my_cquantize_ptr; - histogram : hist3d; - histp : histptr; - c0,c1,c2 : int; - c0min,c0max,c1min,c1max,c2min,c2max : int; - count : long; - total : long; - c0total : long; - c1total : long; - c2total : long; -begin - cquantize := my_cquantize_ptr(cinfo^.cquantize); - histogram := cquantize^.histogram; - total := 0; - c0total := 0; - c1total := 0; - c2total := 0; - - c0min := boxp.c0min; c0max := boxp.c0max; - c1min := boxp.c1min; c1max := boxp.c1max; - c2min := boxp.c2min; c2max := boxp.c2max; - - for c0 := c0min to c0max do - for c1 := c1min to c1max do - begin - histp := @(histogram^[c0]^[c1][c2min]); - for c2 := c2min to c2max do - begin - count := histp^; - Inc(histp); - if (count <> 0) then - begin - Inc(total, count); - Inc(c0total, ((c0 shl C0_SHIFT) + ((1 shl C0_SHIFT) shr 1)) * count); - Inc(c1total, ((c1 shl C1_SHIFT) + ((1 shl C1_SHIFT) shr 1)) * count); - Inc(c2total, ((c2 shl C2_SHIFT) + ((1 shl C2_SHIFT) shr 1)) * count); - end; - end; - end; - - cinfo^.colormap^[0]^[icolor] := JSAMPLE ((c0total + (total shr 1)) div total); - cinfo^.colormap^[1]^[icolor] := JSAMPLE ((c1total + (total shr 1)) div total); - cinfo^.colormap^[2]^[icolor] := JSAMPLE ((c2total + (total shr 1)) div total); -end; - - -{LOCAL} -procedure select_colors (cinfo : j_decompress_ptr; desired_colors : int); -{ Master routine for color selection } -var - boxlist : boxlistptr; - numboxes : int; - i : int; -begin - { Allocate workspace for box list } - boxlist := boxlistptr(cinfo^.mem^.alloc_small( - j_common_ptr(cinfo), JPOOL_IMAGE, desired_colors * SIZEOF(box))); - { Initialize one box containing whole space } - numboxes := 1; - boxlist^[0].c0min := 0; - boxlist^[0].c0max := MAXJSAMPLE shr C0_SHIFT; - boxlist^[0].c1min := 0; - boxlist^[0].c1max := MAXJSAMPLE shr C1_SHIFT; - boxlist^[0].c2min := 0; - boxlist^[0].c2max := MAXJSAMPLE shr C2_SHIFT; - { Shrink it to actually-used volume and set its statistics } - update_box(cinfo, boxlist^[0]); - { Perform median-cut to produce final box list } - numboxes := median_cut(cinfo, boxlist, numboxes, desired_colors); - { Compute the representative color for each box, fill colormap } - for i := 0 to pred(numboxes) do - compute_color(cinfo, boxlist^[i], i); - cinfo^.actual_number_of_colors := numboxes; - {$IFDEF DEBUG} - TRACEMS1(j_common_ptr(cinfo), 1, JTRC_QUANT_SELECTED, numboxes); - {$ENDIF} -end; - - -{ These routines are concerned with the time-critical task of mapping input - colors to the nearest color in the selected colormap. - - We re-use the histogram space as an "inverse color map", essentially a - cache for the results of nearest-color searches. All colors within a - histogram cell will be mapped to the same colormap entry, namely the one - closest to the cell's center. This may not be quite the closest entry to - the actual input color, but it's almost as good. A zero in the cache - indicates we haven't found the nearest color for that cell yet; the array - is cleared to zeroes before starting the mapping pass. When we find the - nearest color for a cell, its colormap index plus one is recorded in the - cache for future use. The pass2 scanning routines call fill_inverse_cmap - when they need to use an unfilled entry in the cache. - - Our method of efficiently finding nearest colors is based on the "locally - sorted search" idea described by Heckbert and on the incremental distance - calculation described by Spencer W. Thomas in chapter III.1 of Graphics - Gems II (James Arvo, ed. Academic Press, 1991). Thomas points out that - the distances from a given colormap entry to each cell of the histogram can - be computed quickly using an incremental method: the differences between - distances to adjacent cells themselves differ by a constant. This allows a - fairly fast implementation of the "brute force" approach of computing the - distance from every colormap entry to every histogram cell. Unfortunately, - it needs a work array to hold the best-distance-so-far for each histogram - cell (because the inner loop has to be over cells, not colormap entries). - The work array elements have to be INT32s, so the work array would need - 256Kb at our recommended precision. This is not feasible in DOS machines. - - To get around these problems, we apply Thomas' method to compute the - nearest colors for only the cells within a small subbox of the histogram. - The work array need be only as big as the subbox, so the memory usage - problem is solved. Furthermore, we need not fill subboxes that are never - referenced in pass2; many images use only part of the color gamut, so a - fair amount of work is saved. An additional advantage of this - approach is that we can apply Heckbert's locality criterion to quickly - eliminate colormap entries that are far away from the subbox; typically - three-fourths of the colormap entries are rejected by Heckbert's criterion, - and we need not compute their distances to individual cells in the subbox. - The speed of this approach is heavily influenced by the subbox size: too - small means too much overhead, too big loses because Heckbert's criterion - can't eliminate as many colormap entries. Empirically the best subbox - size seems to be about 1/512th of the histogram (1/8th in each direction). - - Thomas' article also describes a refined method which is asymptotically - faster than the brute-force method, but it is also far more complex and - cannot efficiently be applied to small subboxes. It is therefore not - useful for programs intended to be portable to DOS machines. On machines - with plenty of memory, filling the whole histogram in one shot with Thomas' - refined method might be faster than the present code --- but then again, - it might not be any faster, and it's certainly more complicated. } - - - -{ log2(histogram cells in update box) for each axis; this can be adjusted } -const - BOX_C0_LOG = (HIST_C0_BITS-3); - BOX_C1_LOG = (HIST_C1_BITS-3); - BOX_C2_LOG = (HIST_C2_BITS-3); - - BOX_C0_ELEMS = (1 shl BOX_C0_LOG); { # of hist cells in update box } - BOX_C1_ELEMS = (1 shl BOX_C1_LOG); - BOX_C2_ELEMS = (1 shl BOX_C2_LOG); - - BOX_C0_SHIFT = (C0_SHIFT + BOX_C0_LOG); - BOX_C1_SHIFT = (C1_SHIFT + BOX_C1_LOG); - BOX_C2_SHIFT = (C2_SHIFT + BOX_C2_LOG); - - -{ The next three routines implement inverse colormap filling. They could - all be folded into one big routine, but splitting them up this way saves - some stack space (the mindist[] and bestdist[] arrays need not coexist) - and may allow some compilers to produce better code by registerizing more - inner-loop variables. } - -{LOCAL} -function find_nearby_colors (cinfo : j_decompress_ptr; - minc0 : int; minc1 : int; minc2 : int; - var colorlist : array of JSAMPLE) : int; -{ Locate the colormap entries close enough to an update box to be candidates - for the nearest entry to some cell(s) in the update box. The update box - is specified by the center coordinates of its first cell. The number of - candidate colormap entries is returned, and their colormap indexes are - placed in colorlist[]. - This routine uses Heckbert's "locally sorted search" criterion to select - the colors that need further consideration. } - -var - numcolors : int; - maxc0, maxc1, maxc2 : int; - centerc0, centerc1, centerc2 : int; - i, x, ncolors : int; - minmaxdist, min_dist, max_dist, tdist : INT32; - mindist : array[0..MAXNUMCOLORS-1] of INT32; - { min distance to colormap entry i } -begin - numcolors := cinfo^.actual_number_of_colors; - - { Compute true coordinates of update box's upper corner and center. - Actually we compute the coordinates of the center of the upper-corner - histogram cell, which are the upper bounds of the volume we care about. - Note that since ">>" rounds down, the "center" values may be closer to - min than to max; hence comparisons to them must be "<=", not "<". } - - maxc0 := minc0 + ((1 shl BOX_C0_SHIFT) - (1 shl C0_SHIFT)); - centerc0 := (minc0 + maxc0) shr 1; - maxc1 := minc1 + ((1 shl BOX_C1_SHIFT) - (1 shl C1_SHIFT)); - centerc1 := (minc1 + maxc1) shr 1; - maxc2 := minc2 + ((1 shl BOX_C2_SHIFT) - (1 shl C2_SHIFT)); - centerc2 := (minc2 + maxc2) shr 1; - - { For each color in colormap, find: - 1. its minimum squared-distance to any point in the update box - (zero if color is within update box); - 2. its maximum squared-distance to any point in the update box. - Both of these can be found by considering only the corners of the box. - We save the minimum distance for each color in mindist[]; - only the smallest maximum distance is of interest. } - - minmaxdist := long($7FFFFFFF); - - for i := 0 to pred(numcolors) do - begin - { We compute the squared-c0-distance term, then add in the other two. } - x := GETJSAMPLE(cinfo^.colormap^[0]^[i]); - if (x < minc0) then - begin - tdist := (x - minc0) * C0_SCALE; - min_dist := tdist*tdist; - tdist := (x - maxc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - if (x > maxc0) then - begin - tdist := (x - maxc0) * C0_SCALE; - min_dist := tdist*tdist; - tdist := (x - minc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - begin - { within cell range so no contribution to min_dist } - min_dist := 0; - if (x <= centerc0) then - begin - tdist := (x - maxc0) * C0_SCALE; - max_dist := tdist*tdist; - end - else - begin - tdist := (x - minc0) * C0_SCALE; - max_dist := tdist*tdist; - end; - end; - - x := GETJSAMPLE(cinfo^.colormap^[1]^[i]); - if (x < minc1) then - begin - tdist := (x - minc1) * C1_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - maxc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - if (x > maxc1) then - begin - tdist := (x - maxc1) * C1_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - minc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - { within cell range so no contribution to min_dist } - if (x <= centerc1) then - begin - tdist := (x - maxc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - tdist := (x - minc1) * C1_SCALE; - Inc(max_dist, tdist*tdist); - end - end; - - x := GETJSAMPLE(cinfo^.colormap^[2]^[i]); - if (x < minc2) then - begin - tdist := (x - minc2) * C2_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - maxc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - if (x > maxc2) then - begin - tdist := (x - maxc2) * C2_SCALE; - Inc(min_dist, tdist*tdist); - tdist := (x - minc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - { within cell range so no contribution to min_dist } - if (x <= centerc2) then - begin - tdist := (x - maxc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end - else - begin - tdist := (x - minc2) * C2_SCALE; - Inc(max_dist, tdist*tdist); - end; - end; - - mindist[i] := min_dist; { save away the results } - if (max_dist < minmaxdist) then - minmaxdist := max_dist; - end; - - { Now we know that no cell in the update box is more than minmaxdist - away from some colormap entry. Therefore, only colors that are - within minmaxdist of some part of the box need be considered. } - - ncolors := 0; - for i := 0 to pred(numcolors) do - begin - if (mindist[i] <= minmaxdist) then - begin - colorlist[ncolors] := JSAMPLE(i); - Inc(ncolors); - end; - end; - find_nearby_colors := ncolors; -end; - - -{LOCAL} -procedure find_best_colors (cinfo : j_decompress_ptr; - minc0 : int; minc1 : int; minc2 : int; - numcolors : int; - var colorlist : array of JSAMPLE; - var bestcolor : array of JSAMPLE); -{ Find the closest colormap entry for each cell in the update box, - given the list of candidate colors prepared by find_nearby_colors. - Return the indexes of the closest entries in the bestcolor[] array. - This routine uses Thomas' incremental distance calculation method to - find the distance from a colormap entry to successive cells in the box. } -const - { Nominal steps between cell centers ("x" in Thomas article) } - STEP_C0 = ((1 shl C0_SHIFT) * C0_SCALE); - STEP_C1 = ((1 shl C1_SHIFT) * C1_SCALE); - STEP_C2 = ((1 shl C2_SHIFT) * C2_SCALE); -var - ic0, ic1, ic2 : int; - i, icolor : int; - {register} bptr : INT32PTR; { pointer into bestdist[] array } - cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } - dist0, dist1 : INT32; { initial distance values } - {register} dist2 : INT32; { current distance in inner loop } - xx0, xx1 : INT32; { distance increments } - {register} xx2 : INT32; - inc0, inc1, inc2 : INT32; { initial values for increments } - { This array holds the distance to the nearest-so-far color for each cell } - bestdist : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of INT32; -begin - { Initialize best-distance for each cell of the update box } - for i := BOX_C0_ELEMS*BOX_C1_ELEMS*BOX_C2_ELEMS-1 downto 0 do - bestdist[i] := $7FFFFFFF; - - { For each color selected by find_nearby_colors, - compute its distance to the center of each cell in the box. - If that's less than best-so-far, update best distance and color number. } - - - - for i := 0 to pred(numcolors) do - begin - icolor := GETJSAMPLE(colorlist[i]); - { Compute (square of) distance from minc0/c1/c2 to this color } - inc0 := (minc0 - GETJSAMPLE(cinfo^.colormap^[0]^[icolor])) * C0_SCALE; - dist0 := inc0*inc0; - inc1 := (minc1 - GETJSAMPLE(cinfo^.colormap^[1]^[icolor])) * C1_SCALE; - Inc(dist0, inc1*inc1); - inc2 := (minc2 - GETJSAMPLE(cinfo^.colormap^[2]^[icolor])) * C2_SCALE; - Inc(dist0, inc2*inc2); - { Form the initial difference increments } - inc0 := inc0 * (2 * STEP_C0) + STEP_C0 * STEP_C0; - inc1 := inc1 * (2 * STEP_C1) + STEP_C1 * STEP_C1; - inc2 := inc2 * (2 * STEP_C2) + STEP_C2 * STEP_C2; - { Now loop over all cells in box, updating distance per Thomas method } - bptr := @bestdist[0]; - cptr := @bestcolor[0]; - xx0 := inc0; - for ic0 := BOX_C0_ELEMS-1 downto 0 do - begin - dist1 := dist0; - xx1 := inc1; - for ic1 := BOX_C1_ELEMS-1 downto 0 do - begin - dist2 := dist1; - xx2 := inc2; - for ic2 := BOX_C2_ELEMS-1 downto 0 do - begin - if (dist2 < bptr^) then - begin - bptr^ := dist2; - cptr^ := JSAMPLE (icolor); - end; - Inc(dist2, xx2); - Inc(xx2, 2 * STEP_C2 * STEP_C2); - Inc(bptr); - Inc(cptr); - end; - Inc(dist1, xx1); - Inc(xx1, 2 * STEP_C1 * STEP_C1); - end; - Inc(dist0, xx0); - Inc(xx0, 2 * STEP_C0 * STEP_C0); - end; - end; -end; - - -{LOCAL} -procedure fill_inverse_cmap (cinfo : j_decompress_ptr; - c0 : int; c1 : int; c2 : int); -{ Fill the inverse-colormap entries in the update box that contains } -{ histogram cell c0/c1/c2. (Only that one cell MUST be filled, but } -{ we can fill as many others as we wish.) } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - minc0, minc1, minc2 : int; { lower left corner of update box } - ic0, ic1, ic2 : int; - {register} cptr : JSAMPLE_PTR; { pointer into bestcolor[] array } - {register} cachep : histptr; { pointer into main cache array } - { This array lists the candidate colormap indexes. } - colorlist : array[0..MAXNUMCOLORS-1] of JSAMPLE; - numcolors : int; { number of candidate colors } - { This array holds the actually closest colormap index for each cell. } - bestcolor : array[0..BOX_C0_ELEMS * BOX_C1_ELEMS * BOX_C2_ELEMS-1] of JSAMPLE; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - - { Convert cell coordinates to update box ID } - c0 := c0 shr BOX_C0_LOG; - c1 := c1 shr BOX_C1_LOG; - c2 := c2 shr BOX_C2_LOG; - - { Compute true coordinates of update box's origin corner. - Actually we compute the coordinates of the center of the corner - histogram cell, which are the lower bounds of the volume we care about.} - - minc0 := (c0 shl BOX_C0_SHIFT) + ((1 shl C0_SHIFT) shr 1); - minc1 := (c1 shl BOX_C1_SHIFT) + ((1 shl C1_SHIFT) shr 1); - minc2 := (c2 shl BOX_C2_SHIFT) + ((1 shl C2_SHIFT) shr 1); - - { Determine which colormap entries are close enough to be candidates - for the nearest entry to some cell in the update box. } - - numcolors := find_nearby_colors(cinfo, minc0, minc1, minc2, colorlist); - - { Determine the actually nearest colors. } - find_best_colors(cinfo, minc0, minc1, minc2, numcolors, colorlist, - bestcolor); - - { Save the best color numbers (plus 1) in the main cache array } - c0 := c0 shl BOX_C0_LOG; { convert ID back to base cell indexes } - c1 := c1 shl BOX_C1_LOG; - c2 := c2 shl BOX_C2_LOG; - cptr := @(bestcolor[0]); - for ic0 := 0 to pred(BOX_C0_ELEMS) do - for ic1 := 0 to pred(BOX_C1_ELEMS) do - begin - cachep := @(histogram^[c0+ic0]^[c1+ic1][c2]); - for ic2 := 0 to pred(BOX_C2_ELEMS) do - begin - cachep^ := histcell (GETJSAMPLE(cptr^) + 1); - Inc(cachep); - Inc(cptr); - end; - end; -end; - - -{ Map some rows of pixels to the output colormapped representation. } - -{METHODDEF} -procedure pass2_no_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ This version performs no dithering } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - {register} inptr : RGBptr; - outptr : JSAMPLE_PTR; - {register} cachep : histptr; - {register} c0, c1, c2 : int; - row : int; - col : JDIMENSION; - width : JDIMENSION; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - - for row := 0 to pred(num_rows) do - begin - inptr := RGBptr(input_buf^[row]); - outptr := JSAMPLE_PTR(output_buf^[row]); - for col := pred(width) downto 0 do - begin - { get pixel value and index into the cache } - c0 := GETJSAMPLE(inptr^.r) shr C0_SHIFT; - c1 := GETJSAMPLE(inptr^.g) shr C1_SHIFT; - c2 := GETJSAMPLE(inptr^.b) shr C2_SHIFT; - Inc(inptr); - cachep := @(histogram^[c0]^[c1][c2]); - { If we have not seen this color before, find nearest colormap entry } - { and update the cache } - if (cachep^ = 0) then - fill_inverse_cmap(cinfo, c0,c1,c2); - { Now emit the colormap index for this cell } - outptr^ := JSAMPLE (cachep^ - 1); - Inc(outptr); - end; - end; -end; - - -{METHODDEF} -procedure pass2_fs_dither (cinfo : j_decompress_ptr; - input_buf : JSAMPARRAY; - output_buf : JSAMPARRAY; - num_rows : int); -{ This version performs Floyd-Steinberg dithering } -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - {register} cur : LOCRGB_FSERROR; { current error or pixel value } - belowerr : LOCRGB_FSERROR; { error for pixel below cur } - bpreverr : LOCRGB_FSERROR; { error for below/prev col } - prev_errorptr, - {register} errorptr : RGB_FSERROR_PTR; { => fserrors[] at column before current } - inptr : RGBptr; { => current input pixel } - outptr : JSAMPLE_PTR; { => current output pixel } - cachep : histptr; - dir : int; { +1 or -1 depending on direction } - row : int; - col : JDIMENSION; - width : JDIMENSION; - range_limit : range_limit_table_ptr; - error_limit : error_limit_ptr; - colormap0 : JSAMPROW; - colormap1 : JSAMPROW; - colormap2 : JSAMPROW; - {register} pixcode : int; - {register} bnexterr, delta : LOCFSERROR; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - width := cinfo^.output_width; - range_limit := cinfo^.sample_range_limit; - error_limit := cquantize^.error_limiter; - colormap0 := cinfo^.colormap^[0]; - colormap1 := cinfo^.colormap^[1]; - colormap2 := cinfo^.colormap^[2]; - - for row := 0 to pred(num_rows) do - begin - inptr := RGBptr(input_buf^[row]); - outptr := JSAMPLE_PTR(output_buf^[row]); - errorptr := RGB_FSERROR_PTR(cquantize^.fserrors); { => entry before first real column } - if (cquantize^.on_odd_row) then - begin - { work right to left in this row } - Inc(inptr, (width-1)); { so point to rightmost pixel } - Inc(outptr, width-1); - dir := -1; - Inc(errorptr, (width+1)); { => entry after last column } - cquantize^.on_odd_row := FALSE; { flip for next time } - end - else - begin - { work left to right in this row } - dir := 1; - cquantize^.on_odd_row := TRUE; { flip for next time } - end; - - { Preset error values: no error propagated to first pixel from left } - cur.r := 0; - cur.g := 0; - cur.b := 0; - { and no error propagated to row below yet } - belowerr.r := 0; - belowerr.g := 0; - belowerr.b := 0; - bpreverr.r := 0; - bpreverr.g := 0; - bpreverr.b := 0; - - for col := pred(width) downto 0 do - begin - prev_errorptr := errorptr; - Inc(errorptr, dir); { advance errorptr to current column } - - { curN holds the error propagated from the previous pixel on the - current line. Add the error propagated from the previous line - to form the complete error correction term for this pixel, and - round the error term (which is expressed * 16) to an integer. - RIGHT_SHIFT rounds towards minus infinity, so adding 8 is correct - for either sign of the error value. - Note: prev_errorptr points to *previous* column's array entry. } - - { Nomssi Note: Borland Pascal SHR is unsigned } - cur.r := (cur.r + errorptr^.r + 8) div 16; - cur.g := (cur.g + errorptr^.g + 8) div 16; - cur.b := (cur.b + errorptr^.b + 8) div 16; - { Limit the error using transfer function set by init_error_limit. - See comments with init_error_limit for rationale. } - - cur.r := error_limit^[cur.r]; - cur.g := error_limit^[cur.g]; - cur.b := error_limit^[cur.b]; - { Form pixel value + error, and range-limit to 0..MAXJSAMPLE. - The maximum error is +- MAXJSAMPLE (or less with error limiting); - this sets the required size of the range_limit array. } - - Inc(cur.r, GETJSAMPLE(inptr^.r)); - Inc(cur.g, GETJSAMPLE(inptr^.g)); - Inc(cur.b, GETJSAMPLE(inptr^.b)); - - cur.r := GETJSAMPLE(range_limit^[cur.r]); - cur.g := GETJSAMPLE(range_limit^[cur.g]); - cur.b := GETJSAMPLE(range_limit^[cur.b]); - { Index into the cache with adjusted pixel value } - cachep := @(histogram^[cur.r shr C0_SHIFT]^ - [cur.g shr C1_SHIFT][cur.b shr C2_SHIFT]); - { If we have not seen this color before, find nearest colormap } - { entry and update the cache } - if (cachep^ = 0) then - fill_inverse_cmap(cinfo, cur.r shr C0_SHIFT, - cur.g shr C1_SHIFT, - cur.b shr C2_SHIFT); - { Now emit the colormap index for this cell } - - pixcode := cachep^ - 1; - outptr^ := JSAMPLE (pixcode); - - { Compute representation error for this pixel } - Dec(cur.r, GETJSAMPLE(colormap0^[pixcode])); - Dec(cur.g, GETJSAMPLE(colormap1^[pixcode])); - Dec(cur.b, GETJSAMPLE(colormap2^[pixcode])); - - { Compute error fractions to be propagated to adjacent pixels. - Add these into the running sums, and simultaneously shift the - next-line error sums left by 1 column. } - - bnexterr := cur.r; { Process component 0 } - delta := cur.r * 2; - Inc(cur.r, delta); { form error * 3 } - prev_errorptr^.r := FSERROR (bpreverr.r + cur.r); - Inc(cur.r, delta); { form error * 5 } - bpreverr.r := belowerr.r + cur.r; - belowerr.r := bnexterr; - Inc(cur.r, delta); { form error * 7 } - bnexterr := cur.g; { Process component 1 } - delta := cur.g * 2; - Inc(cur.g, delta); { form error * 3 } - prev_errorptr^.g := FSERROR (bpreverr.g + cur.g); - Inc(cur.g, delta); { form error * 5 } - bpreverr.g := belowerr.g + cur.g; - belowerr.g := bnexterr; - Inc(cur.g, delta); { form error * 7 } - bnexterr := cur.b; { Process component 2 } - delta := cur.b * 2; - Inc(cur.b, delta); { form error * 3 } - prev_errorptr^.b := FSERROR (bpreverr.b + cur.b); - Inc(cur.b, delta); { form error * 5 } - bpreverr.b := belowerr.b + cur.b; - belowerr.b := bnexterr; - Inc(cur.b, delta); { form error * 7 } - - { At this point curN contains the 7/16 error value to be propagated - to the next pixel on the current line, and all the errors for the - next line have been shifted over. We are therefore ready to move on.} - - Inc(inptr, dir); { Advance pixel pointers to next column } - Inc(outptr, dir); - end; - { Post-loop cleanup: we must unload the final error values into the - final fserrors[] entry. Note we need not unload belowerrN because - it is for the dummy column before or after the actual array. } - - errorptr^.r := FSERROR (bpreverr.r); { unload prev errs into array } - errorptr^.g := FSERROR (bpreverr.g); - errorptr^.b := FSERROR (bpreverr.b); - end; -end; - - -{ Initialize the error-limiting transfer function (lookup table). - The raw F-S error computation can potentially compute error values of up to - +- MAXJSAMPLE. But we want the maximum correction applied to a pixel to be - much less, otherwise obviously wrong pixels will be created. (Typical - effects include weird fringes at color-area boundaries, isolated bright - pixels in a dark area, etc.) The standard advice for avoiding this problem - is to ensure that the "corners" of the color cube are allocated as output - colors; then repeated errors in the same direction cannot cause cascading - error buildup. However, that only prevents the error from getting - completely out of hand; Aaron Giles reports that error limiting improves - the results even with corner colors allocated. - A simple clamping of the error values to about +- MAXJSAMPLE/8 works pretty - well, but the smoother transfer function used below is even better. Thanks - to Aaron Giles for this idea. } - -{LOCAL} -procedure init_error_limit (cinfo : j_decompress_ptr); -const - STEPSIZE = ((MAXJSAMPLE+1) div 16); -{ Allocate and fill in the error_limiter table } -var - cquantize : my_cquantize_ptr; - table : error_limit_ptr; - inp, out : int; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - table := error_limit_ptr (cinfo^.mem^.alloc_small - (j_common_ptr (cinfo), JPOOL_IMAGE, (MAXJSAMPLE*2+1) * SIZEOF(int))); - { not needed: Inc(table, MAXJSAMPLE); - so can index -MAXJSAMPLE .. +MAXJSAMPLE } - cquantize^.error_limiter := table; - { Map errors 1:1 up to +- MAXJSAMPLE/16 } - out := 0; - for inp := 0 to pred(STEPSIZE) do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(out); - end; - { Map errors 1:2 up to +- 3*MAXJSAMPLE/16 } - inp := STEPSIZE; { Nomssi: avoid problems with Delphi2 optimizer } - while (inp < STEPSIZE*3) do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(inp); - if Odd(inp) then - Inc(out); - end; - { Clamp the rest to final out value (which is (MAXJSAMPLE+1)/8) } - inp := STEPSIZE*3; { Nomssi: avoid problems with Delphi 2 optimizer } - while inp <= MAXJSAMPLE do - begin - table^[inp] := out; - table^[-inp] := -out; - Inc(inp); - end; -end; - -{ Finish up at the end of each pass. } - -{METHODDEF} -procedure finish_pass1 (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Select the representative colors and fill in cinfo^.colormap } - cinfo^.colormap := cquantize^.sv_colormap; - select_colors(cinfo, cquantize^.desired); - { Force next pass to zero the color index table } - cquantize^.needs_zeroed := TRUE; -end; - - -{METHODDEF} -procedure finish_pass2 (cinfo : j_decompress_ptr); -begin - { no work } -end; - - -{ Initialize for each processing pass. } - -{METHODDEF} -procedure start_pass_2_quant (cinfo : j_decompress_ptr; - is_pre_scan : boolean); -var - cquantize : my_cquantize_ptr; - histogram : hist3d; - i : int; -var - arraysize : size_t; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - histogram := cquantize^.histogram; - { Only F-S dithering or no dithering is supported. } - { If user asks for ordered dither, give him F-S. } - if (cinfo^.dither_mode <> JDITHER_NONE) then - cinfo^.dither_mode := JDITHER_FS; - - if (is_pre_scan) then - begin - { Set up method pointers } - cquantize^.pub.color_quantize := prescan_quantize; - cquantize^.pub.finish_pass := finish_pass1; - cquantize^.needs_zeroed := TRUE; { Always zero histogram } - end - else - begin - { Set up method pointers } - if (cinfo^.dither_mode = JDITHER_FS) then - cquantize^.pub.color_quantize := pass2_fs_dither - else - cquantize^.pub.color_quantize := pass2_no_dither; - cquantize^.pub.finish_pass := finish_pass2; - - { Make sure color count is acceptable } - i := cinfo^.actual_number_of_colors; - if (i < 1) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_FEW_COLORS, 1); - if (i > MAXNUMCOLORS) then - ERREXIT1(j_common_ptr(cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); - - if (cinfo^.dither_mode = JDITHER_FS) then - begin - arraysize := size_t ((cinfo^.output_width + 2) * - (3 * SIZEOF(FSERROR))); - { Allocate Floyd-Steinberg workspace if we didn't already. } - if (cquantize^.fserrors = NIL) then - cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large - (j_common_ptr(cinfo), JPOOL_IMAGE, arraysize)); - { Initialize the propagated errors to zero. } - jzero_far(cquantize^.fserrors, arraysize); - { Make the error-limit table if we didn't already. } - if (cquantize^.error_limiter = NIL) then - init_error_limit(cinfo); - cquantize^.on_odd_row := FALSE; - end; - - end; - { Zero the histogram or inverse color map, if necessary } - if (cquantize^.needs_zeroed) then - begin - for i := 0 to pred(HIST_C0_ELEMS) do - begin - jzero_far( histogram^[i], - HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell)); - end; - cquantize^.needs_zeroed := FALSE; - end; -end; - - -{ Switch to a new external colormap between output passes. } - -{METHODDEF} -procedure new_color_map_2_quant (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; -begin - cquantize := my_cquantize_ptr (cinfo^.cquantize); - - { Reset the inverse color map } - cquantize^.needs_zeroed := TRUE; -end; - - -{ Module initialization routine for 2-pass color quantization. } - - -{GLOBAL} -procedure jinit_2pass_quantizer (cinfo : j_decompress_ptr); -var - cquantize : my_cquantize_ptr; - i : int; -var - desired : int; -begin - cquantize := my_cquantize_ptr( - cinfo^.mem^.alloc_small (j_common_ptr(cinfo), JPOOL_IMAGE, - SIZEOF(my_cquantizer))); - cinfo^.cquantize := jpeg_color_quantizer_ptr(cquantize); - cquantize^.pub.start_pass := start_pass_2_quant; - cquantize^.pub.new_color_map := new_color_map_2_quant; - cquantize^.fserrors := NIL; { flag optional arrays not allocated } - cquantize^.error_limiter := NIL; - - { Make sure jdmaster didn't give me a case I can't handle } - if (cinfo^.out_color_components <> 3) then - ERREXIT(j_common_ptr(cinfo), JERR_NOTIMPL); - - { Allocate the histogram/inverse colormap storage } - cquantize^.histogram := hist3d (cinfo^.mem^.alloc_small - (j_common_ptr (cinfo), JPOOL_IMAGE, HIST_C0_ELEMS * SIZEOF(hist2d))); - for i := 0 to pred(HIST_C0_ELEMS) do - begin - cquantize^.histogram^[i] := hist2d (cinfo^.mem^.alloc_large - (j_common_ptr (cinfo), JPOOL_IMAGE, - HIST_C1_ELEMS*HIST_C2_ELEMS * SIZEOF(histcell))); - end; - cquantize^.needs_zeroed := TRUE; { histogram is garbage now } - - { Allocate storage for the completed colormap, if required. - We do this now since it is FAR storage and may affect - the memory manager's space calculations. } - - if (cinfo^.enable_2pass_quant) then - begin - { Make sure color count is acceptable } - desired := cinfo^.desired_number_of_colors; - { Lower bound on # of colors ... somewhat arbitrary as long as > 0 } - if (desired < 8) then - ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_FEW_COLORS, 8); - { Make sure colormap indexes can be represented by JSAMPLEs } - if (desired > MAXNUMCOLORS) then - ERREXIT1(j_common_ptr (cinfo), JERR_QUANT_MANY_COLORS, MAXNUMCOLORS); - cquantize^.sv_colormap := cinfo^.mem^.alloc_sarray - (j_common_ptr (cinfo),JPOOL_IMAGE, JDIMENSION(desired), JDIMENSION(3)); - cquantize^.desired := desired; - end - else - cquantize^.sv_colormap := NIL; - - { Only F-S dithering or no dithering is supported. } - { If user asks for ordered dither, give him F-S. } - if (cinfo^.dither_mode <> JDITHER_NONE) then - cinfo^.dither_mode := JDITHER_FS; - - { Allocate Floyd-Steinberg workspace if necessary. - This isn't really needed until pass 2, but again it is FAR storage. - Although we will cope with a later change in dither_mode, - we do not promise to honor max_memory_to_use if dither_mode changes. } - - if (cinfo^.dither_mode = JDITHER_FS) then - begin - cquantize^.fserrors := FS_ERROR_FIELD_PTR (cinfo^.mem^.alloc_large - (j_common_ptr(cinfo), JPOOL_IMAGE, - size_t ((cinfo^.output_width + 2) * (3 * SIZEOF(FSERROR))) ) ); - { Might as well create the error-limiting table too. } - init_error_limit(cinfo); - end; -end; -{ QUANT_2PASS_SUPPORTED } -end. diff --git a/3rd/Imaging/Source/JpegLib/imjutils.pas b/3rd/Imaging/Source/JpegLib/imjutils.pas deleted file mode 100644 index eb147b9c8..000000000 --- a/3rd/Imaging/Source/JpegLib/imjutils.pas +++ /dev/null @@ -1,232 +0,0 @@ -unit imjutils; - -{ This file contains tables and miscellaneous utility routines needed - for both compression and decompression. - Note we prefix all global names with "j" to minimize conflicts with - a surrounding application. } - -{ Source: jutils.c; Copyright (C) 1991-1996, Thomas G. Lane. } - -interface - -{$I imjconfig.inc} - -uses - imjmorecfg, - imjinclude, - imjpeglib; - - -{ jpeg_zigzag_order[i] is the zigzag-order position of the i'th element - of a DCT block read in natural order (left to right, top to bottom). } - - -{$ifdef FALSE} { This table is not actually needed in v6a } - -const - jpeg_zigzag_order : array[0..DCTSIZE2] of int = - (0, 1, 5, 6, 14, 15, 27, 28, - 2, 4, 7, 13, 16, 26, 29, 42, - 3, 8, 12, 17, 25, 30, 41, 43, - 9, 11, 18, 24, 31, 40, 44, 53, - 10, 19, 23, 32, 39, 45, 52, 54, - 20, 22, 33, 38, 46, 51, 55, 60, - 21, 34, 37, 47, 50, 56, 59, 61, - 35, 36, 48, 49, 57, 58, 62, 63); - -{$endif} - - -{ jpeg_natural_order[i] is the natural-order position of the i'th element - of zigzag order. - - When reading corrupted data, the Huffman decoders could attempt - to reference an entry beyond the end of this array (if the decoded - zero run length reaches past the end of the block). To prevent - wild stores without adding an inner-loop test, we put some extra - "63"s after the real entries. This will cause the extra coefficient - to be stored in location 63 of the block, not somewhere random. - The worst case would be a run-length of 15, which means we need 16 - fake entries. } - - -const - jpeg_natural_order : array[0..DCTSIZE2+16-1] of int = - (0, 1, 8, 16, 9, 2, 3, 10, - 17, 24, 32, 25, 18, 11, 4, 5, - 12, 19, 26, 33, 40, 48, 41, 34, - 27, 20, 13, 6, 7, 14, 21, 28, - 35, 42, 49, 56, 57, 50, 43, 36, - 29, 22, 15, 23, 30, 37, 44, 51, - 58, 59, 52, 45, 38, 31, 39, 46, - 53, 60, 61, 54, 47, 55, 62, 63, - 63, 63, 63, 63, 63, 63, 63, 63, { extra entries for safety in decoder } - 63, 63, 63, 63, 63, 63, 63, 63); - - - -{ Arithmetic utilities } - -{GLOBAL} -function jdiv_round_up (a : long; b : long) : long; - -{GLOBAL} -function jround_up (a : long; b : long) : long; - -{GLOBAL} -procedure jcopy_sample_rows (input_array : JSAMPARRAY; - source_row : int; - output_array : JSAMPARRAY; dest_row : int; - num_rows : int; num_cols : JDIMENSION); - -{GLOBAL} -procedure jcopy_block_row (input_row : JBLOCKROW; - output_row : JBLOCKROW; - num_blocks : JDIMENSION); - -{GLOBAL} -procedure jzero_far (target : pointer;{far} bytestozero : size_t); - -procedure FMEMZERO(target : pointer; size : size_t); - -procedure FMEMCOPY(dest,src : pointer; size : size_t); - -implementation - -{GLOBAL} -function jdiv_round_up (a : long; b : long) : long; -{ Compute a/b rounded up to next integer, ie, ceil(a/b) } -{ Assumes a >= 0, b > 0 } -begin - jdiv_round_up := (a + b - long(1)) div b; -end; - - -{GLOBAL} -function jround_up (a : long; b : long) : long; -{ Compute a rounded up to next multiple of b, ie, ceil(a/b)*b } -{ Assumes a >= 0, b > 0 } -begin - Inc(a, b - long(1)); - jround_up := a - (a mod b); -end; - -{ On normal machines we can apply MEMCOPY() and MEMZERO() to sample arrays - and coefficient-block arrays. This won't work on 80x86 because the arrays - are FAR and we're assuming a small-pointer memory model. However, some - DOS compilers provide far-pointer versions of memcpy() and memset() even - in the small-model libraries. These will be used if USE_FMEM is defined. - Otherwise, the routines below do it the hard way. (The performance cost - is not all that great, because these routines aren't very heavily used.) } - - -{$ifndef NEED_FAR_POINTERS} { normal case, same as regular macros } -procedure FMEMZERO(target : pointer; size : size_t); -begin - FillChar(target^, size, 0); -end; - -procedure FMEMCOPY(dest,src : pointer; size : size_t); -begin - Move(src^, dest^, size); -end; - - -{$else} { 80x86 case, define if we can } - {$ifdef USE_FMEM} - FMEMCOPY(dest,src,size) _fmemcpy((void FAR *)(dest), (const void FAR *)(src), (size_t)(size)) - FMEMZERO(target,size) _fmemset((void FAR *)(target), 0, (size_t)(size)) - {$endif} -{$endif} - - -{GLOBAL} -procedure jcopy_sample_rows (input_array : JSAMPARRAY; source_row : int; - output_array : JSAMPARRAY; dest_row : int; - num_rows : int; num_cols : JDIMENSION); -{ Copy some rows of samples from one place to another. - num_rows rows are copied from input_array[source_row++] - to output_array[dest_row++]; these areas may overlap for duplication. - The source and destination arrays must be at least as wide as num_cols. } -var - inptr, outptr : JSAMPLE_PTR; {register} -{$ifdef FMEMCOPY} - count : size_t; {register} -{$else} - count : JDIMENSION; {register} -{$endif} - row : int; {register} -begin -{$ifdef FMEMCOPY} - count := size_t(num_cols * SIZEOF(JSAMPLE)); -{$endif} - Inc(JSAMPROW_PTR(input_array), source_row); - Inc(JSAMPROW_PTR(output_array), dest_row); - - for row := pred(num_rows) downto 0 do - begin - inptr := JSAMPLE_PTR(input_array^[0]); - Inc(JSAMPROW_PTR(input_array)); - outptr := JSAMPLE_PTR(output_array^[0]); - Inc(JSAMPROW_PTR(output_array)); -{$ifdef FMEMCOPY} - FMEMCOPY(outptr, inptr, count); -{$else} - for count := pred(num_cols) downto 0 do - begin - outptr^ := inptr^; { needn't bother with GETJSAMPLE() here } - Inc(inptr); - Inc(outptr); - end; -{$endif} - end; -end; - - -{GLOBAL} -procedure jcopy_block_row (input_row : JBLOCKROW; - output_row : JBLOCKROW; - num_blocks : JDIMENSION); -{ Copy a row of coefficient blocks from one place to another. } -{$ifdef FMEMCOPY} -begin - FMEMCOPY(output_row, input_row, num_blocks * (DCTSIZE2 * SIZEOF(JCOEF))); -{$else} -var - inptr, outptr : JCOEFPTR; {register} - count : long; {register} -begin - inptr := JCOEFPTR (input_row); - outptr := JCOEFPTR (output_row); - for count := long(num_blocks) * DCTSIZE2 -1 downto 0 do - begin - outptr^ := inptr^; - Inc(outptr); - Inc(inptr); - end; -{$endif} -end; - - -{GLOBAL} -procedure jzero_far (target : pointer;{far} bytestozero : size_t); -{ Zero out a chunk of FAR memory. } -{ This might be sample-array data, block-array data, or alloc_large data. } -{$ifdef FMEMZERO} -begin - FMEMZERO(target, bytestozero); -{$else} -var - ptr : byteptr; - count : size_t; {register} -begin - ptr := target; - for count := bytestozero-1 downto 0 do - begin - ptr^ := 0; - Inc(ptr); - end; -{$endif} -end; - -end. diff --git a/3rd/Imaging/Source/JpegLib/readme.txt b/3rd/Imaging/Source/JpegLib/readme.txt deleted file mode 100644 index 3cbe89077..000000000 --- a/3rd/Imaging/Source/JpegLib/readme.txt +++ /dev/null @@ -1,381 +0,0 @@ -_____________________________________________________________________________ - -PASJPEG 1.1 May 29th, 1999 - -Based on the Independent JPEG Group's JPEG software release 6b - -Copyright (C) 1996,1998,1999 by NOMSSI NZALI Jacques H. C. -[kn&n DES] See "Legal issues" for conditions of distribution and use. -_____________________________________________________________________________ - - -Information in this file -======================== - - o Introduction - o Notes - o File list - o Translation - o Legal issues - o Archive Locations - -Introduction -============ - -PASJPEG is a port of the sixth public release of the IJG C source (release -6b of 27-Mar-98) [3], that implements JPEG baseline, extended-sequential, and -progressive compression processes to Turbo Pascal 7.0 for DOS (TP). The code -has been tested under Delphi 3.0, it can be ported to other Pascal -environments, since many compilers try to be compatible to TP. - -JPEG (pronounced "jay-peg") is a standardized familly of algorithms for -compression of continous tone still images. Most JPEG processes are lossy, -the output image is not exactly identical to the input image. However, on -typical photographic images, very good compression levels can be obtained -with no visible change, and remarkably high compression levels are possible -if you can tolerate a low-quality image [1],[2]. The Independent JPEG Group -(IJG) has created a free, portable C library for JPEG compression and -decompression of JPEG images. - -The IJG documentation (system architecture, using the IJG JPEG library, -usage and file list) is a must read. The files DEMO.PAS, TEST.PAS, CJPEG.PAS, -DJPEG.PAS and EXAMPLE.PAS demonstrate the usage of the JPEG decompression -and compression library. The RDJPGCOM application shows how to parse a JFIF -file. - -Notes: -====== - -* Please report any errors/problems you may find in code and in the - documentation (e.g. this README.TXT file). - -* The sample applications (CJPEG, DJPEG) doesn't support all the options - of the original C code. WRJPGCOM is not ported. - -* Environment variable JPEGMEM syntax changed; - -* You can modify the jpeg.pas unit from the Delphi 3 distribution to - use PasJPEG. - -Change log -========== - -1. bugs fixed: - * in procedure read_gif_map(), unit RDCOLMAP.PAS (used by DJPEG sample - application). Davie Lee Reed - * -dct int and -dct fast now bytewise equal to the IJG output. - * -dct float produced large files - -2. Support for scripts - -3. BASM version of JIDCTINT.PAS for Delphi 2 and 3. - -4. images with integral sampling ratios were not decoded correctly. - Create a jpeg file with cjpeg and the option "-sample 4x1" and try to decode - it with any software that uses PasJpeg. Thanks to Jannie Gerber for reporting - this with a fix: In JDSAMPLE.PAS, procedure int_upsample(), - - for h := pred(h_expand) downto 0 do - begin - outptr^ := invalue; - +=> inc(outptr); { this is the culprit that was left out!!! } - Dec(outcount); - end; - -File list -========= - -Here is a road map to the files in the PasJPEG distribution. The -distribution includes the JPEG library proper, plus two application -programs ("cjpeg" and "djpeg") which use the library to convert JPEG -files to and from some other popular image formats. A third application -"jpegtran" uses the library to do lossless conversion between different -variants of JPEG. There is also the stand-alone applications "rdjpgcom". - -Documentation(see README for a guide to the documentation files): - -readme.txt Introduction, Documentation - -Additional files - -demo.pas Demo program, uses example.pas -example.pas Sample code for calling JPEG library. -test.pas Sample application code for demo.pas - -Configuration/installation files and programs (see install.doc for more info): - -jconfig.inc Configuration declarations. - -*.ijg script files - -Pascal source code files: - -jinclude.pas Central include file used by all IJG .c files to reference - system include files. -jpeglib.pas JPEG library's internal data structures, exported data - and function declarations. -jmorecfg.pas Additional configuration declarations; need not be changed - for a standard installation. -jdeferr.pas defines the error and message text. -jerror.pas Declares JPEG library's error and trace message codes. -jinclude.pas the place to specify system depedent input/output code. -jdct.pas Private declarations for forward & reverse DCT subsystems. - -These files contain most of the functions intended to be called directly by -an application program: - -jcapimin.pas Application program interface: core routines for compression. -jcapistd.pas Application program interface: standard compression. -jdapimin.pas Application program interface: core routines for decompression. -jdapistd.pas Application program interface: standard decompression. -jcomapi.pas Application program interface routines common to compression - and decompression. -jcparam.pas Compression parameter setting helper routines. -jctrans.pas API and library routines for transcoding compression. -jdtrans.pas API and library routines for transcoding decompression. - -Compression side of the library: - -jcinit.pas Initialization: determines which other modules to use. -jcmaster.pas Master control: setup and inter-pass sequencing logic. -jcmainct.pas Main buffer controller (preprocessor => JPEG compressor). -jcprepct.pas Preprocessor buffer controller. -jccoefct.pas Buffer controller for DCT coefficient buffer. -jccolor.pas Color space conversion. -jcsample.pas Downsampling. -jcdctmgr.pas DCT manager (DCT implementation selection & control). -jfdctint.pas Forward DCT using slow-but-accurate integer method. -jfdctfst.pas Forward DCT using faster, less accurate integer method. -jfdctflt.pas Forward DCT using floating-point arithmetic. -jchuff.pas Huffman entropy coding for sequential JPEG. -jcphuff.pas Huffman entropy coding for progressive JPEG. -jcmarker.pas JPEG marker writing. -jdatadst.pas Data destination manager for stdio output. - -Decompression side of the library: - -jdmaster.pas Master control: determines which other modules to use. -jdinput.pas Input controller: controls input processing modules. -jdmainct.pas Main buffer controller (JPEG decompressor => postprocessor). -jdcoefct.pas Buffer controller for DCT coefficient buffer. -jdpostct.pas Postprocessor buffer controller. -jdmarker.pas JPEG marker reading. -jdhuff.pas Huffman entropy decoding for sequential JPEG. -jdphuff.pas Huffman entropy decoding for progressive JPEG. -jddctmgr.pas IDCT manager (IDCT implementation selection & control). -jidctint.pas Inverse DCT using slow-but-accurate integer method. -jidctasm.pas BASM specific version of jidctint.pas for 32bit Delphi. -jidctfst.pas Inverse DCT using faster, less accurate integer method. -jidctflt.pas Inverse DCT using floating-point arithmetic. -jidctred.pas Inverse DCTs with reduced-size outputs. -jidct2d.pas How to for a direct 2D Inverse DCT - not used -jdsample.pas Upsampling. -jdcolor.pas Color space conversion. -jdmerge.pas Merged upsampling/color conversion (faster, lower quality). -jquant1.pas One-pass color quantization using a fixed-spacing colormap. -jquant2.pas Two-pass color quantization using a custom-generated colormap. - Also handles one-pass quantization to an externally given map. -jdatasrc.pas Data source manager for stdio input. - -Support files for both compression and decompression: - -jerror.pas Standard error handling routines (application replaceable). -jmemmgr.pas System-independent (more or less) memory management code. -jutils.pas Miscellaneous utility routines. - -jmemmgr.pas relies on a system-dependent memory management module. The -PASJPEG distribution includes the following implementations of the system- -dependent module: - -jmemnobs.pas "No backing store": assumes adequate virtual memory exists. -jmemdos.pas Custom implementation for MS-DOS (16-bit environment only): - can use extended and expanded memory as well as temporary - files. -jmemsys.pas A skeleton with all the declaration you need to create a - working system-dependent JPEG memory manager on unusual - systems. - -Exactly one of the system-dependent units should be used in jmemmgr.pas. - -jmemdosa.pas BASM 80x86 assembly code support for jmemdos.pas; used only - in MS-DOS-specific configurations of the JPEG library. - - -Applications using the library should use jmorecfg, jerror, jpeglib, and -include jconfig.inc. - -CJPEG/DJPEG/JPEGTRAN - -Pascal source code files: - -cderror.pas Additional error and trace message codes for cjpeg/djpeg. - Not used, Those errors have been added to jdeferr. -cjpeg.pas Main program for cjpeg. -djpeg.pas Main program for djpeg. -jpegtran.pas Main program for jpegtran. -cdjpeg.pas Utility routines used by all three programs. -rdcolmap.pas Code to read a colormap file for djpeg's "-map" switch. -rdswitch.pas Code to process some of cjpeg's more complex switches. - Also used by jpegtran. -transupp.pas Support code for jpegtran: lossless image manipulations. - -fcache.pas -rdswitch.pas Code to process some of cjpeg's more complex switches. - Also used by jpegtran. - -Image file writer modules for djpeg: - -wrbmp.pas BMP file output. -wrppm.pas PPM/PGM file output. -wrtarga.pas Targa file output. - -Image file reader modules for cjpeg: - -rdbmp.pas BMP file input. -rdppm.pas PPM/PGM file input. -rdtarga.pas Targa file input. - NOT READY YET - -This program does not depend on the JPEG library - -rdjpgcom.pas Stand-alone rdjpgcom application. - - -Translation -=========== - -TP is unit-centric, exported type definitions and routines are declared -in the "interface" part of the unit, "make" files are not needed. -Macros are not supported, they were either copied as needed or translated -to Pascal routines (procedure). The procedures will be replaced by code in -later releases. -Conditional defines that indicate whether to include various optional -functions are defined in the file JCONFIG.INC. This file is included first -in all source files. - -The base type definitions are in the unit JMORECFG.PAS. The error handling -macros have been converted to procedures in JERROR.PAS. The error codes are -in JDEFERR.PAS. jpegint.h and jpeglib.h were merged into one large unit -JPEGLIB.PAS containing type definitions with global scope. - -The translation of the header file is the most sophisticated work, a good -understanding of the syntax is required. Once the header files are done, -the translation turns into a lot of editing work. Each C source file was -converted to a unit by editing the syntax (separate variable definition -and usage, define labels, group variable definitions, expanding macros, etc). - -The IJG source labels routines GLOBAL, METHODDEF and LOCAL. All globals -routines are in the interface section of the units. The "far" directive is -used for methods (METHODDEF). - -Some C -> Pascal examples. - -* "{" -> "begin" "->" -> "^." " = " -> " := " "<<" -> " shl " - "}" -> "end;" "!=" -> "<>" " == " -> " = " ">>" -> " shr " - "/*" -> "{" routine -> function "0x" -> "$" - "*/" -> "}" (void) procedure "NULL" -> "NIL" - -* structs are records, Unions are variable records, pointers are always far, - the operators && and || (and/or) have not the same priority in both - languages, so parenthesis are important. The Pascal "case" doesn't have the - falltrough option of the C "switch" statement, my work around is to split - one "switch" statement into many case statements. -* The pointer type in C is not readily interchangeable. It is used to address - an array (Pascal pointer to an array) or in pointer arithmetic a pointer to - a single element. I've used the Inc() statement with type casting to - translate pointer arithmetic most of the time. - - C example: - typedef JSAMPLE* JSAMPROW; /* ptr to one image row of pixel samples. */ - - Pascal - type - JSAMPLE_PTR = ^JSAMPLE; { ptr to a single pixel sample. } - jTSample = 0..(MaxInt div SIZEOF(JSAMPLE))-1; - JSAMPLE_ARRAY = Array[jTSample] of JSAMPLE; {far} - JSAMPROW = ^JSAMPLE_ARRAY; { ptr to one image row of pixel samples. } - - The following code - - JSAMPROW buffer0, buffer1; /* ptr to a JSAMPLE buffer. */ - - ... - - buffer1 = buffer0 + i; - - can be translated to - - var - buffer0, buffer1 : JSAMPROW; - - ... - - buffer1 := buffer0; - Inc(JSAMPLE_PTR(buffer1), i); - - or - - buffer1 := JSAMPROW(@ buffer0^[i]); - - Declaring the variables as JSAMPLE_PTR may reduce type casting in some - places. I use help pointers to handle negative array offsets. - -While translating the type of function parameter from C to Pascal, one can -often use "var", "const", or "array of" parameters instead of pointers. - -While translating for(;;)-loops with more than one induction variable to -Pascal "for to/downto do"-loops, the extra induction variables have to be -manually updated at the end of the loop and before "continue"-statements. - - -Legal issues -============ - -Copyright (C) 1996,1998 by Jacques Nomssi Nzali - - This software is provided 'as-is', without any express or implied - warranty. In no event will the author be held liable for any damages - arising from the use of this software. - - Permission is granted to anyone to use this software for any purpose, - including commercial applications, and to alter it and redistribute it - freely, subject to the following restrictions: - - 1. The origin of this software must not be misrepresented; you must not - claim that you wrote the original software. If you use this software - in a product, an acknowledgment in the product documentation would be - appreciated but is not required. - 2. Altered source versions must be plainly marked as such, and must not be - misrepresented as being the original software. - 3. This notice may not be removed or altered from any source distribution. - - -Archive Locations: -================== - -[1] Thomas G. Lane, JPEG FAQ - - in comp.graphics.misc and related newsgroups - -[2] Wallace, Gregory K.: The JPEG Still Picture Compression Standard - - ftp.uu.net, graphics/jpeg/wallace.ps.Z - -[3] The Independent JPEG Group C library for JPEG encoding and decoding, - rev 6b. - - ftp://ftp.uu.net/graphics/jpeg/ - - or SimTel in msdos/graphics/ - -[4] JPEG implementation, written by the PVRG group at Stanford, - ftp havefun.stanford.edu:/pub/jpeg/JPEGv1.2.tar.Z. - -[5] PASJPEG.ZIP at NView ftp site - - ftp://druckfix.physik.tu-chemnitz.de/pub/nv/ - http://www.tu-chemnitz.de/~nomssi/pub/pasjpeg.zip - -[6] The PasJPEG home page with links - - http://www.tu-chemnitz.de/~nomssi/pasjpeg.html -_____________________________________________________________________________ \ No newline at end of file diff --git a/3rd/Imaging/Source/ZLib/dzlib.pas b/3rd/Imaging/Source/ZLib/dzlib.pas deleted file mode 100644 index 37a0da0af..000000000 --- a/3rd/Imaging/Source/ZLib/dzlib.pas +++ /dev/null @@ -1,523 +0,0 @@ -{*******************************************************} -{ } -{ Delphi Supplemental Components } -{ ZLIB Data Compression Interface Unit } -{ } -{ Copyright (c) 1997 Borland International } -{ Copyright (c) 1998 Jacques Nomssi Nzali } -{ } -{*******************************************************} - -{ - Modified for - Vampyre Imaging Library - by Marek Mauder - http://imaginglib.sourceforge.net - - You can choose which pascal zlib implementation will be - used. IMPASZLIB and FPCPASZLIB are translations of zlib - to pascal so they don't need any *.obj files. - The others are interfaces to *.obj files (Windows) or - *.so libraries (Linux). - Default implementation is IMPASZLIB because it can be compiled - by all supported compilers and works on all supported platforms. - I usually use implementation with the fastest decompression - when building release Win32 binaries. - FPCPASZLIB is useful for Lazarus applications. FPC's zlib is linked - to exe by default so there is no need to link additional (and almost identical) - IMPASZLIB. - - There is a small speed comparison table of some of the - supported implementations (TGA image 28�311�570 bytes, compression level = 6, - Delphi 9, Win32, Athlon XP 1900). - - ZLib version Decompression Compression Comp. Size - IMPASZLIB | 1.1.2 | 824 ms | 4 280 ms | 18 760 133 B - ZLIBEX | 1.2.2 | 710 ms | 1 590 ms* | 19 056 621 B - DELPHIZLIB | 1.0.4 | 976 ms | 9 190 ms | 18 365 562 B - ZLIBPAS | 1.2.3 | 680 ms | 3 790 ms | 18 365 387 B - * obj files are compiled with compression level hardcoded to 1 (fastest) -} - -unit dzlib; - -{$I ImagingOptions.inc} - -interface - -{$DEFINE IMPASZLIB} -{ $DEFINE ZLIBPAS} -{ $DEFINE FPCPASZLIB} -{ $DEFINE ZLIBEX} -{ $DEFINE DELPHIZLIB} - -{ Automatically use FPC's PasZLib when compiling with FPC.} - -{$IFDEF FPC} - {$UNDEF IMPASZLIB} - {$DEFINE FPCPASZLIB} -{$ENDIF} - -uses -{$IF Defined(IMPASZLIB)} - { Use paszlib modified by me for Delphi and FPC } - imzdeflate, imzinflate, impaszlib, -{$ELSEIF Defined(FPCPASZLIB)} - { Use FPC's paszlib } - zbase, paszlib, -{$ELSEIF Defined(ZLIBPAS)} - { Pascal interface to ZLib shipped with ZLib C source } - zlibpas, -{$ELSEIF Defined(ZLIBEX)} - { Use ZlibEx unit } - ZLibEx, -{$ELSEIF Defined(DELPHIZLIB)} - { Use ZLib unit shipped with Delphi } - ZLib, -{$IFEND} - ImagingTypes, SysUtils, Classes; - -{$IF Defined(IMPASZLIB) or Defined(FPCPASZLIB) or Defined(ZLIBPAS)} -type - TZStreamRec = z_stream; -{$IFEND} - -const - Z_NO_FLUSH = 0; - Z_PARTIAL_FLUSH = 1; - Z_SYNC_FLUSH = 2; - Z_FULL_FLUSH = 3; - Z_FINISH = 4; - - Z_OK = 0; - Z_STREAM_END = 1; - Z_NEED_DICT = 2; - Z_ERRNO = -1; - Z_STREAM_ERROR = -2; - Z_DATA_ERROR = -3; - Z_MEM_ERROR = -4; - Z_BUF_ERROR = -5; - Z_VERSION_ERROR = -6; - - Z_NO_COMPRESSION = 0; - Z_BEST_SPEED = 1; - Z_BEST_COMPRESSION = 9; - Z_DEFAULT_COMPRESSION = -1; - - Z_FILTERED = 1; - Z_HUFFMAN_ONLY = 2; - Z_RLE = 3; - Z_DEFAULT_STRATEGY = 0; - - Z_BINARY = 0; - Z_ASCII = 1; - Z_UNKNOWN = 2; - - Z_DEFLATED = 8; - -type - { Abstract ancestor class } - TCustomZlibStream = class(TStream) - private - FStrm: TStream; - FStrmPos: Integer; - FOnProgress: TNotifyEvent; - FZRec: TZStreamRec; - FBuffer: array [Word] of Byte; - protected - procedure Progress(Sender: TObject); dynamic; - property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; - constructor Create(Strm: TStream); - end; - -{ TCompressionStream compresses data on the fly as data is written to it, and - stores the compressed data to another stream. - - TCompressionStream is write-only and strictly sequential. Reading from the - stream will raise an exception. Using Seek to move the stream pointer - will raise an exception. - - Output data is cached internally, written to the output stream only when - the internal output buffer is full. All pending output data is flushed - when the stream is destroyed. - - The Position property returns the number of uncompressed bytes of - data that have been written to the stream so far. - - CompressionRate returns the on-the-fly percentage by which the original - data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100 - If raw data size = 100 and compressed data size = 25, the CompressionRate - is 75% - - The OnProgress event is called each time the output buffer is filled and - written to the output stream. This is useful for updating a progress - indicator when you are writing a large chunk of data to the compression - stream in a single call.} - - - TCompressionLevel = (clNone, clFastest, clDefault, clMax); - - TCompressionStream = class(TCustomZlibStream) - private - function GetCompressionRate: Single; - public - constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; - property CompressionRate: Single read GetCompressionRate; - property OnProgress; - end; - -{ TDecompressionStream decompresses data on the fly as data is read from it. - - Compressed data comes from a separate source stream. TDecompressionStream - is read-only and unidirectional; you can seek forward in the stream, but not - backwards. The special case of setting the stream position to zero is - allowed. Seeking forward decompresses data until the requested position in - the uncompressed data has been reached. Seeking backwards, seeking relative - to the end of the stream, requesting the size of the stream, and writing to - the stream will raise an exception. - - The Position property returns the number of bytes of uncompressed data that - have been read from the stream so far. - - The OnProgress event is called each time the internal input buffer of - compressed data is exhausted and the next block is read from the input stream. - This is useful for updating a progress indicator when you are reading a - large chunk of data from the decompression stream in a single call.} - - TDecompressionStream = class(TCustomZlibStream) - public - constructor Create(Source: TStream); - destructor Destroy; override; - function Read(var Buffer; Count: Longint): Longint; override; - function Write(const Buffer; Count: Longint): Longint; override; - function Seek(Offset: Longint; Origin: Word): Longint; override; - property OnProgress; - end; - - - -{ CompressBuf compresses data, buffer to buffer, in one call. - In: InBuf = ptr to compressed data - InBytes = number of bytes in InBuf - Out: OutBuf = ptr to newly allocated buffer containing decompressed data - OutBytes = number of bytes in OutBuf } -procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; - var OutBuf: Pointer; var OutBytes: Integer; - CompressLevel: Integer = Z_DEFAULT_COMPRESSION; - CompressStrategy: Integer = Z_DEFAULT_STRATEGY); - -{ DecompressBuf decompresses data, buffer to buffer, in one call. - In: InBuf = ptr to compressed data - InBytes = number of bytes in InBuf - OutEstimate = zero, or est. size of the decompressed data - Out: OutBuf = ptr to newly allocated buffer containing decompressed data - OutBytes = number of bytes in OutBuf } -procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; - OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer); - - -type - EZlibError = class(Exception); - ECompressionError = class(EZlibError); - EDecompressionError = class(EZlibError); - -implementation - -const - ZErrorMessages: array[0..9] of PAnsiChar = ( - 'need dictionary', // Z_NEED_DICT (2) - 'stream end', // Z_STREAM_END (1) - '', // Z_OK (0) - 'file error', // Z_ERRNO (-1) - 'stream error', // Z_STREAM_ERROR (-2) - 'data error', // Z_DATA_ERROR (-3) - 'insufficient memory', // Z_MEM_ERROR (-4) - 'buffer error', // Z_BUF_ERROR (-5) - 'incompatible version', // Z_VERSION_ERROR (-6) - ''); - -function zlibAllocMem(AppData: Pointer; Items, Size: Cardinal): Pointer; -begin - GetMem(Result, Items*Size); -end; - -procedure zlibFreeMem(AppData, Block: Pointer); -begin - FreeMem(Block); -end; - -function CCheck(code: Integer): Integer; -begin - Result := code; - if code < 0 then - raise ECompressionError.Create('zlib: ' + ZErrorMessages[2 - code]); -end; - -function DCheck(code: Integer): Integer; -begin - Result := code; - if code < 0 then - raise EDecompressionError.Create('zlib: ' + ZErrorMessages[2 - code]); -end; - -procedure CompressBuf(const InBuf: Pointer; InBytes: Integer; - var OutBuf: Pointer; var OutBytes: Integer; - CompressLevel, CompressStrategy: Integer); -var - strm: TZStreamRec; - P: Pointer; -begin - FillChar(strm, sizeof(strm), 0); -{$IFNDEF FPCPASZLIB} - strm.zalloc := @zlibAllocMem; - strm.zfree := @zlibFreeMem; -{$ENDIF} - OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - - CCheck(deflateInit2(strm, CompressLevel, Z_DEFLATED, MAX_WBITS, - DEF_MEM_LEVEL, CompressStrategy)); - - try - while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, 256); - ReallocMem(OutBuf, OutBytes); - strm.next_out := Pointer(PtrUInt(OutBuf) + (PtrUInt(strm.next_out) - PtrUInt(P))); - strm.avail_out := 256; - end; - finally - CCheck(deflateEnd(strm)); - end; - ReallocMem(OutBuf, strm.total_out); - OutBytes := strm.total_out; - except - zlibFreeMem(nil, OutBuf); - raise - end; -end; - -procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer; - OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer); -var - strm: TZStreamRec; - P: Pointer; - BufInc: Integer; -begin - FillChar(strm, sizeof(strm), 0); -{$IFNDEF FPCPASZLIB} - strm.zalloc := @zlibAllocMem; - strm.zfree := @zlibFreeMem; -{$ENDIF} - BufInc := (InBytes + 255) and not 255; - if OutEstimate = 0 then - OutBytes := BufInc - else - OutBytes := OutEstimate; - GetMem(OutBuf, OutBytes); - try - strm.next_in := InBuf; - strm.avail_in := InBytes; - strm.next_out := OutBuf; - strm.avail_out := OutBytes; - DCheck(inflateInit_(strm, zlib_version, sizeof(strm))); - try - while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do - begin - P := OutBuf; - Inc(OutBytes, BufInc); - ReallocMem(OutBuf, OutBytes); - strm.next_out := Pointer(PtrUInt(OutBuf) + (PtrUInt(strm.next_out) - PtrUInt(P))); - strm.avail_out := BufInc; - end; - finally - DCheck(inflateEnd(strm)); - end; - ReallocMem(OutBuf, strm.total_out); - OutBytes := strm.total_out; - except - zlibFreeMem(nil, OutBuf); - raise - end; -end; - - -{ TCustomZlibStream } - -constructor TCustomZLibStream.Create(Strm: TStream); -begin - inherited Create; - FStrm := Strm; - FStrmPos := Strm.Position; -{$IFNDEF FPCPASZLIB} - FZRec.zalloc := @zlibAllocMem; - FZRec.zfree := @zlibFreeMem; -{$ENDIF} -end; - -procedure TCustomZLibStream.Progress(Sender: TObject); -begin - if Assigned(FOnProgress) then FOnProgress(Sender); -end; - -{ TCompressionStream } - -constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel; - Dest: TStream); -const - Levels: array [TCompressionLevel] of ShortInt = - (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION); -begin - inherited Create(Dest); - FZRec.next_out := @FBuffer; - FZRec.avail_out := sizeof(FBuffer); - CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec))); -end; - -destructor TCompressionStream.Destroy; -begin - FZRec.next_in := nil; - FZRec.avail_in := 0; - try - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END) - and (FZRec.avail_out = 0) do - begin - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); - FZRec.next_out := @FBuffer; - FZRec.avail_out := sizeof(FBuffer); - end; - if FZRec.avail_out < sizeof(FBuffer) then - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out); - finally - deflateEnd(FZRec); - end; - inherited Destroy; -end; - -function TCompressionStream.Read(var Buffer; Count: Longint): Longint; -begin - raise ECompressionError.Create('Invalid stream operation'); -end; - -function TCompressionStream.Write(const Buffer; Count: Longint): Longint; -begin - FZRec.next_in := @Buffer; - FZRec.avail_in := Count; - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (FZRec.avail_in > 0) do - begin - CCheck(deflate(FZRec, 0)); - if FZRec.avail_out = 0 then - begin - FStrm.WriteBuffer(FBuffer, sizeof(FBuffer)); - FZRec.next_out := @FBuffer; - FZRec.avail_out := sizeof(FBuffer); - FStrmPos := FStrm.Position; - Progress(Self); - end; - end; - Result := Count; -end; - -function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint; -begin - if (Offset = 0) and (Origin = soFromCurrent) then - Result := FZRec.total_in - else - raise ECompressionError.Create('Invalid stream operation'); -end; - -function TCompressionStream.GetCompressionRate: Single; -begin - if FZRec.total_in = 0 then - Result := 0 - else - Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0; -end; - -{ TDecompressionStream } - -constructor TDecompressionStream.Create(Source: TStream); -begin - inherited Create(Source); - FZRec.next_in := @FBuffer; - FZRec.avail_in := 0; - DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec))); -end; - -destructor TDecompressionStream.Destroy; -begin - inflateEnd(FZRec); - inherited Destroy; -end; - -function TDecompressionStream.Read(var Buffer; Count: Longint): Longint; -begin - FZRec.next_out := @Buffer; - FZRec.avail_out := Count; - if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos; - while (FZRec.avail_out > 0) do - begin - if FZRec.avail_in = 0 then - begin - FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer)); - if FZRec.avail_in = 0 then - begin - Result := Count - Integer(FZRec.avail_out); - Exit; - end; - FZRec.next_in := @FBuffer; - FStrmPos := FStrm.Position; - Progress(Self); - end; - CCheck(inflate(FZRec, 0)); - end; - Result := Count; -end; - -function TDecompressionStream.Write(const Buffer; Count: Longint): Longint; -begin - raise EDecompressionError.Create('Invalid stream operation'); -end; - -function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint; -var - I: Integer; - Buf: array [0..4095] of Byte; -begin - if (Offset = 0) and (Origin = soFromBeginning) then - begin - DCheck(inflateReset(FZRec)); - FZRec.next_in := @FBuffer; - FZRec.avail_in := 0; - FStrm.Position := 0; - FStrmPos := 0; - end - else if ( (Offset >= 0) and (Origin = soFromCurrent)) or - ( ((Offset - Integer(FZRec.total_out)) > 0) and (Origin = soFromBeginning)) then - begin - if Origin = soFromBeginning then Dec(Offset, FZRec.total_out); - if Offset > 0 then - begin - for I := 1 to Offset div sizeof(Buf) do - ReadBuffer(Buf, sizeof(Buf)); - ReadBuffer(Buf, Offset mod sizeof(Buf)); - end; - end - else - raise EDecompressionError.Create('Invalid stream operation'); - Result := FZRec.total_out; -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/imadler.pas b/3rd/Imaging/Source/ZLib/imadler.pas deleted file mode 100644 index 4438056cc..000000000 --- a/3rd/Imaging/Source/ZLib/imadler.pas +++ /dev/null @@ -1,114 +0,0 @@ -Unit imadler; - -{ - adler32.c -- compute the Adler-32 checksum of a data stream - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - imzutil; - -function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong; - -{ Update a running Adler-32 checksum with the bytes buf[0..len-1] and - return the updated checksum. If buf is NIL, this function returns - the required initial value for the checksum. - An Adler-32 checksum is almost as reliable as a CRC32 but can be computed - much faster. Usage example: - - var - adler : uLong; - begin - adler := adler32(0, Z_NULL, 0); - - while (read_buffer(buffer, length) <> EOF) do - adler := adler32(adler, buffer, length); - - if (adler <> original_adler) then - error(); - end; -} - -implementation - -const - BASE = uLong(65521); { largest prime smaller than 65536 } - {NMAX = 5552; original code with unsigned 32 bit integer } - { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 } - NMAX = 3854; { code with signed 32 bit integer } - { NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^31-1 } - { The penalty is the time loss in the extra MOD-calls. } - - -{ ========================================================================= } - -function adler32(adler : uLong; buf : pBytef; len : uInt) : uLong; -var - s1, s2 : uLong; - k : int; -begin - s1 := adler and $ffff; - s2 := (adler shr 16) and $ffff; - - if not Assigned(buf) then - begin - adler32 := uLong(1); - exit; - end; - - while (len > 0) do - begin - if len < NMAX then - k := len - else - k := NMAX; - Dec(len, k); - { - while (k >= 16) do - begin - DO16(buf); - Inc(buf, 16); - Dec(k, 16); - end; - if (k <> 0) then - repeat - Inc(s1, buf^); - Inc(puf); - Inc(s2, s1); - Dec(k); - until (k = 0); - } - while (k > 0) do - begin - Inc(s1, buf^); - Inc(s2, s1); - Inc(buf); - Dec(k); - end; - s1 := s1 mod BASE; - s2 := s2 mod BASE; - end; - adler32 := (s2 shl 16) or s1; -end; - -{ -#define DO1(buf,i) - begin - Inc(s1, buf[i]); - Inc(s2, s1); - end; -#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); -#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); -#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); -#define DO16(buf) DO8(buf,0); DO8(buf,8); -} -end. - diff --git a/3rd/Imaging/Source/ZLib/iminfblock.pas b/3rd/Imaging/Source/ZLib/iminfblock.pas deleted file mode 100644 index 7ab003ff0..000000000 --- a/3rd/Imaging/Source/ZLib/iminfblock.pas +++ /dev/null @@ -1,951 +0,0 @@ -Unit iminfblock; - -{ infblock.h and - infblock.c -- interpret and process block types to last block - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - {$IFDEF DEBUG} - SysUtils, strutils, - {$ENDIF} - imzutil, impaszlib; - -function inflate_blocks_new(var z : z_stream; - c : check_func; { check function } - w : uInt { window size } - ) : pInflate_blocks_state; - -function inflate_blocks (var s : inflate_blocks_state; - var z : z_stream; - r : int { initial return code } - ) : int; - -procedure inflate_blocks_reset (var s : inflate_blocks_state; - var z : z_stream; - c : puLong); { check value on output } - - -function inflate_blocks_free(s : pInflate_blocks_state; - var z : z_stream) : int; - -procedure inflate_set_dictionary(var s : inflate_blocks_state; - const d : array of byte; { dictionary } - n : uInt); { dictionary length } - -function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; - -implementation - -uses - iminfcodes, iminftrees, iminfutil; - -{ Tables for deflate from PKZIP's appnote.txt. } -Const - border : Array [0..18] Of Word { Order of the bit length code lengths } - = (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15); - -{ Notes beyond the 1.93a appnote.txt: - - 1. Distance pointers never point before the beginning of the output - stream. - 2. Distance pointers can point back across blocks, up to 32k away. - 3. There is an implied maximum of 7 bits for the bit length table and - 15 bits for the actual data. - 4. If only one code exists, then it is encoded using one bit. (Zero - would be more efficient, but perhaps a little confusing.) If two - codes exist, they are coded using one bit each (0 and 1). - 5. There is no way of sending zero distance codes--a dummy must be - sent if there are none. (History: a pre 2.0 version of PKZIP would - store blocks with no distance codes, but this was discovered to be - too harsh a criterion.) Valid only for 1.93a. 2.04c does allow - zero distance codes, which is sent as one code of zero bits in - length. - 6. There are up to 286 literal/length codes. Code 256 represents the - end-of-block. Note however that the static length tree defines - 288 codes just to fill out the Huffman codes. Codes 286 and 287 - cannot be used though, since there is no length base or extra bits - defined for them. Similarily, there are up to 30 distance codes. - However, static trees define 32 codes (all 5 bits) to fill out the - Huffman codes, but the last two had better not show up in the data. - 7. Unzip can check dynamic Huffman blocks for complete code sets. - The exception is that a single code would not be complete (see #4). - 8. The five bits following the block type is really the number of - literal codes sent minus 257. - 9. Length codes 8,16,16 are interpreted as 13 length codes of 8 bits - (1+6+6). Therefore, to output three times the length, you output - three codes (1+1+1), whereas to output four times the same length, - you only need two codes (1+3). Hmm. - 10. In the tree reconstruction algorithm, Code = Code + Increment - only if BitLength(i) is not zero. (Pretty obvious.) - 11. Correction: 4 Bits: # of Bit Length codes - 4 (4 - 19) - 12. Note: length code 284 can represent 227-258, but length code 285 - really is 258. The last length deserves its own, short code - since it gets used a lot in very redundant files. The length - 258 is special since 258 - 3 (the min match length) is 255. - 13. The literal/length and distance code bit lengths are read as a - single stream of lengths. It is possible (and advantageous) for - a repeat code (16, 17, or 18) to go across the boundary between - the two sets of lengths. } - - -procedure inflate_blocks_reset (var s : inflate_blocks_state; - var z : z_stream; - c : puLong); { check value on output } -begin - if (c <> Z_NULL) then - c^ := s.check; - if (s.mode = BTREE) or (s.mode = DTREE) then - ZFREE(z, s.sub.trees.blens); - if (s.mode = CODES) then - inflate_codes_free(s.sub.decode.codes, z); - - s.mode := ZTYPE; - s.bitk := 0; - s.bitb := 0; - - s.write := s.window; - s.read := s.window; - if Assigned(s.checkfn) then - begin - s.check := s.checkfn(uLong(0), pBytef(NIL), 0); - z.adler := s.check; - end; - {$IFDEF DEBUG} - Tracev('inflate: blocks reset'); - {$ENDIF} -end; - - -function inflate_blocks_new(var z : z_stream; - c : check_func; { check function } - w : uInt { window size } - ) : pInflate_blocks_state; -var - s : pInflate_blocks_state; -begin - s := pInflate_blocks_state( ZALLOC(z,1, sizeof(inflate_blocks_state)) ); - if (s = Z_NULL) then - begin - inflate_blocks_new := s; - exit; - end; - s^.hufts := huft_ptr( ZALLOC(z, sizeof(inflate_huft), MANY) ); - - if (s^.hufts = Z_NULL) then - begin - ZFREE(z, s); - inflate_blocks_new := Z_NULL; - exit; - end; - - s^.window := pBytef( ZALLOC(z, 1, w) ); - if (s^.window = Z_NULL) then - begin - ZFREE(z, s^.hufts); - ZFREE(z, s); - inflate_blocks_new := Z_NULL; - exit; - end; - s^.zend := s^.window; - Inc(s^.zend, w); - s^.checkfn := c; - s^.mode := ZTYPE; - {$IFDEF DEBUG} - Tracev('inflate: blocks allocated'); - {$ENDIF} - inflate_blocks_reset(s^, z, Z_NULL); - inflate_blocks_new := s; -end; - - -function inflate_blocks (var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; { initial return code } -label - start_btree, start_dtree, - start_blkdone, start_dry, - start_codes; - -var - t : uInt; { temporary storage } - b : uLong; { bit buffer } - k : uInt; { bits in bit buffer } - p : pBytef; { input data pointer } - n : uInt; { bytes available there } - q : pBytef; { output window write pointer } - m : uInt; { bytes to end of window or read pointer } -{ fixed code blocks } -var - bl, bd : uInt; - tl, td : pInflate_huft; -var - h : pInflate_huft; - i, j, c : uInt; -var - cs : pInflate_codes_state; -begin - { copy input/output information to locals } - p := z.next_in; - n := z.avail_in; - b := s.bitb; - k := s.bitk; - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - -{ decompress an inflated block } - - - { process input based on current state } - while True do - Case s.mode of - ZTYPE: - begin - {NEEDBITS(3);} - while (k < 3) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := uInt(b) and 7; - s.last := boolean(t and 1); - case (t shr 1) of - 0: { stored } - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: stored block (last)') - else - Tracev('inflate: stored block'); - {$ENDIF} - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - t := k and 7; { go to byte boundary } - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - s.mode := LENS; { get length of stored block } - end; - 1: { fixed } - begin - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: fixed codes blocks (last)') - else - Tracev('inflate: fixed codes blocks'); - {$ENDIF} - inflate_trees_fixed(bl, bd, tl, td, z); - s.sub.decode.codes := inflate_codes_new(bl, bd, tl, td, z); - if (s.sub.decode.codes = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - end; - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := CODES; - end; - 2: { dynamic } - begin - {$IFDEF DEBUG} - if s.last then - Tracev('inflate: dynamic codes block (last)') - else - Tracev('inflate: dynamic codes block'); - {$ENDIF} - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := TABLE; - end; - 3: - begin { illegal } - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - - s.mode := BLKBAD; - z.msg := 'invalid block type'; - r := Z_DATA_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - end; - end; - LENS: - begin - {NEEDBITS(32);} - while (k < 32) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - if (((not b) shr 16) and $ffff) <> (b and $ffff) then - begin - s.mode := BLKBAD; - z.msg := 'invalid stored block lengths'; - r := Z_DATA_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.left := uInt(b) and $ffff; - k := 0; - b := 0; { dump bits } - {$IFDEF DEBUG} - Tracev('inflate: stored length '+IntToStr(s.sub.left)); - {$ENDIF} - if s.sub.left <> 0 then - s.mode := STORED - else - if s.last then - s.mode := DRY - else - s.mode := ZTYPE; - end; - STORED: - begin - if (n = 0) then - begin - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - {NEEDOUT} - if (m = 0) then - begin - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - end; - end; - r := Z_OK; - - t := s.sub.left; - if (t > n) then - t := n; - if (t > m) then - t := m; - zmemcpy(q, p, t); - Inc(p, t); Dec(n, t); - Inc(q, t); Dec(m, t); - Dec(s.sub.left, t); - if (s.sub.left = 0) then - begin - {$IFDEF DEBUG} - if (ptr2int(q) >= ptr2int(s.read)) then - Tracev('inflate: stored end '+ - IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') - else - Tracev('inflate: stored end '+ - IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + - ptr2int(q) - ptr2int(s.window)) + ' total out'); - {$ENDIF} - if s.last then - s.mode := DRY - else - s.mode := ZTYPE; - end; - end; - TABLE: - begin - {NEEDBITS(14);} - while (k < 14) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := uInt(b) and $3fff; - s.sub.trees.table := t; - {$ifndef PKZIP_BUG_WORKAROUND} - if ((t and $1f) > 29) or (((t shr 5) and $1f) > 29) then - begin - s.mode := BLKBAD; - z.msg := 'too many length or distance symbols'; - r := Z_DATA_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - {$endif} - t := 258 + (t and $1f) + ((t shr 5) and $1f); - s.sub.trees.blens := puIntArray( ZALLOC(z, t, sizeof(uInt)) ); - if (s.sub.trees.blens = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - {DUMPBITS(14);} - b := b shr 14; - Dec(k, 14); - - s.sub.trees.index := 0; - {$IFDEF DEBUG} - Tracev('inflate: table sizes ok'); - {$ENDIF} - s.mode := BTREE; - { fall trough case is handled by the while } - { try GOTO for speed - Nomssi } - goto start_btree; - end; - BTREE: - begin - start_btree: - while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do - begin - {NEEDBITS(3);} - while (k < 3) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - s.sub.trees.blens^[border[s.sub.trees.index]] := uInt(b) and 7; - Inc(s.sub.trees.index); - {DUMPBITS(3);} - b := b shr 3; - Dec(k, 3); - end; - while (s.sub.trees.index < 19) do - begin - s.sub.trees.blens^[border[s.sub.trees.index]] := 0; - Inc(s.sub.trees.index); - end; - s.sub.trees.bb := 7; - t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb, - s.sub.trees.tb, s.hufts^, z); - if (t <> Z_OK) then - begin - ZFREE(z, s.sub.trees.blens); - r := t; - if (r = Z_DATA_ERROR) then - s.mode := BLKBAD; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.trees.index := 0; - {$IFDEF DEBUG} - Tracev('inflate: bits tree ok'); - {$ENDIF} - s.mode := DTREE; - { fall through again } - goto start_dtree; - end; - DTREE: - begin - start_dtree: - while TRUE do - begin - t := s.sub.trees.table; - if not (s.sub.trees.index < 258 + - (t and $1f) + ((t shr 5) and $1f)) then - break; - t := s.sub.trees.bb; - {NEEDBITS(t);} - while (k < t) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - h := s.sub.trees.tb; - Inc(h, uInt(b) and inflate_mask[t]); - t := h^.Bits; - c := h^.Base; - - if (c < 16) then - begin - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - s.sub.trees.blens^[s.sub.trees.index] := c; - Inc(s.sub.trees.index); - end - else { c = 16..18 } - begin - if c = 18 then - begin - i := 7; - j := 11; - end - else - begin - i := c - 14; - j := 3; - end; - {NEEDBITS(t + i);} - while (k < t + i) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - {DUMPBITS(t);} - b := b shr t; - Dec(k, t); - - Inc(j, uInt(b) and inflate_mask[i]); - {DUMPBITS(i);} - b := b shr i; - Dec(k, i); - - i := s.sub.trees.index; - t := s.sub.trees.table; - if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or - ((c = 16) and (i < 1)) then - begin - ZFREE(z, s.sub.trees.blens); - s.mode := BLKBAD; - z.msg := 'invalid bit length repeat'; - r := Z_DATA_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - if c = 16 then - c := s.sub.trees.blens^[i - 1] - else - c := 0; - repeat - s.sub.trees.blens^[i] := c; - Inc(i); - Dec(j); - until (j=0); - s.sub.trees.index := i; - end; - end; { while } - s.sub.trees.tb := Z_NULL; - begin - bl := 9; { must be <= 9 for lookahead assumptions } - bd := 6; { must be <= 9 for lookahead assumptions } - t := s.sub.trees.table; - t := inflate_trees_dynamic(257 + (t and $1f), - 1 + ((t shr 5) and $1f), - s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z); - ZFREE(z, s.sub.trees.blens); - if (t <> Z_OK) then - begin - if (t = uInt(Z_DATA_ERROR)) then - s.mode := BLKBAD; - r := t; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - {$IFDEF DEBUG} - Tracev('inflate: trees ok'); - {$ENDIF} - { c renamed to cs } - cs := inflate_codes_new(bl, bd, tl, td, z); - if (cs = Z_NULL) then - begin - r := Z_MEM_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - s.sub.decode.codes := cs; - end; - s.mode := CODES; - { yet another falltrough } - goto start_codes; - end; - CODES: - begin - start_codes: - { update pointers } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - - r := inflate_codes(s, z, r); - if (r <> Z_STREAM_END) then - begin - inflate_blocks := inflate_flush(s, z, r); - exit; - end; - r := Z_OK; - inflate_codes_free(s.sub.decode.codes, z); - { load local pointers } - p := z.next_in; - n := z.avail_in; - b := s.bitb; - k := s.bitk; - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - {$IFDEF DEBUG} - if (ptr2int(q) >= ptr2int(s.read)) then - Tracev('inflate: codes end '+ - IntToStr(z.total_out + ptr2int(q) - ptr2int(s.read)) + ' total out') - else - Tracev('inflate: codes end '+ - IntToStr(z.total_out + ptr2int(s.zend) - ptr2int(s.read) + - ptr2int(q) - ptr2int(s.window)) + ' total out'); - {$ENDIF} - if (not s.last) then - begin - s.mode := ZTYPE; - continue; { break for switch statement in C-code } - end; - {$ifndef patch112} - if (k > 7) then { return unused byte, if any } - begin - {$IFDEF DEBUG} - Assert(k < 16, 'inflate_codes grabbed too many bytes'); - {$ENDIF} - Dec(k, 8); - Inc(n); - Dec(p); { can always return one } - end; - {$endif} - s.mode := DRY; - { another falltrough } - goto start_dry; - end; - DRY: - begin - start_dry: - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - - { not needed anymore, we are done: - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - } - - if (s.read <> s.write) then - begin - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - s.mode := BLKDONE; - goto start_blkdone; - end; - BLKDONE: - begin - start_blkdone: - r := Z_STREAM_END; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - BLKBAD: - begin - r := Z_DATA_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - else - begin - r := Z_STREAM_ERROR; - { update pointers and return } - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_blocks := inflate_flush(s,z,r); - exit; - end; - end; { Case s.mode of } - -end; - - -function inflate_blocks_free(s : pInflate_blocks_state; - var z : z_stream) : int; -begin - inflate_blocks_reset(s^, z, Z_NULL); - ZFREE(z, s^.window); - ZFREE(z, s^.hufts); - ZFREE(z, s); - {$IFDEF DEBUG} - Trace('inflate: blocks freed'); - {$ENDIF} - inflate_blocks_free := Z_OK; -end; - - -procedure inflate_set_dictionary(var s : inflate_blocks_state; - const d : array of byte; { dictionary } - n : uInt); { dictionary length } -begin - zmemcpy(s.window, pBytef(@d), n); - s.write := s.window; - Inc(s.write, n); - s.read := s.write; -end; - - -{ Returns true if inflate is currently at the end of a block generated - by Z_SYNC_FLUSH or Z_FULL_FLUSH. - IN assertion: s <> Z_NULL } - -function inflate_blocks_sync_point(var s : inflate_blocks_state) : int; -begin - inflate_blocks_sync_point := int(s.mode = LENS); -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/iminfcodes.pas b/3rd/Imaging/Source/ZLib/iminfcodes.pas deleted file mode 100644 index 5a1a78183..000000000 --- a/3rd/Imaging/Source/ZLib/iminfcodes.pas +++ /dev/null @@ -1,576 +0,0 @@ -Unit iminfcodes; - -{ infcodes.c -- process literals and length/distance pairs - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - {$IFDEF DEBUG} - SysUtils, strutils, - {$ENDIF} - imzutil, impaszlib; - -function inflate_codes_new (bl : uInt; - bd : uInt; - tl : pInflate_huft; - td : pInflate_huft; - var z : z_stream): pInflate_codes_state; - -function inflate_codes(var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; - -procedure inflate_codes_free(c : pInflate_codes_state; - var z : z_stream); - -implementation - -uses - iminfutil, iminffast; - - -function inflate_codes_new (bl : uInt; - bd : uInt; - tl : pInflate_huft; - td : pInflate_huft; - var z : z_stream): pInflate_codes_state; -var - c : pInflate_codes_state; -begin - c := pInflate_codes_state( ZALLOC(z,1,sizeof(inflate_codes_state)) ); - if (c <> Z_NULL) then - begin - c^.mode := START; - c^.lbits := Byte(bl); - c^.dbits := Byte(bd); - c^.ltree := tl; - c^.dtree := td; - {$IFDEF DEBUG} - Tracev('inflate: codes new'); - {$ENDIF} - end; - inflate_codes_new := c; -end; - - -function inflate_codes(var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; -var - j : uInt; { temporary storage } - t : pInflate_huft; { temporary pointer } - e : uInt; { extra bits or operation } - b : uLong; { bit buffer } - k : uInt; { bits in bit buffer } - p : pBytef; { input data pointer } - n : uInt; { bytes available there } - q : pBytef; { output window write pointer } - m : uInt; { bytes to end of window or read pointer } - f : pBytef; { pointer to copy strings from } -var - c : pInflate_codes_state; -begin - c := s.sub.decode.codes; { codes state } - - { copy input/output information to locals } - p := z.next_in; - n := z.avail_in; - b := s.bitb; - k := s.bitk; - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - { process input and output based on current state } - while True do - case (c^.mode) of - { waiting for "i:"=input, "o:"=output, "x:"=nothing } - START: { x: set up for LEN } - begin -{$ifndef SLOW} - if (m >= 258) and (n >= 10) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - - r := inflate_fast(c^.lbits, c^.dbits, c^.ltree, c^.dtree, s, z); - {LOAD} - p := z.next_in; - n := z.avail_in; - b := s.bitb; - k := s.bitk; - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - if (r <> Z_OK) then - begin - if (r = Z_STREAM_END) then - c^.mode := WASH - else - c^.mode := BADCODE; - continue; { break for switch-statement in C } - end; - end; -{$endif} { not SLOW } - c^.sub.code.need := c^.lbits; - c^.sub.code.tree := c^.ltree; - c^.mode := LEN; { falltrough } - end; - LEN: { i: get length/literal/eob next } - begin - j := c^.sub.code.need; - {NEEDBITS(j);} - while (k < j) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - t := c^.sub.code.tree; - Inc(t, uInt(b) and inflate_mask[j]); - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - - e := uInt(t^.exop); - if (e = 0) then { literal } - begin - c^.sub.lit := t^.base; - {$IFDEF DEBUG} - if (t^.base >= $20) and (t^.base < $7f) then - Tracevv('inflate: literal '+AnsiChar(t^.base)) - else - Tracevv('inflate: literal '+IntToStr(t^.base)); - {$ENDIF} - c^.mode := LIT; - continue; { break switch statement } - end; - if (e and 16 <> 0) then { length } - begin - c^.sub.copy.get := e and 15; - c^.len := t^.base; - c^.mode := LENEXT; - continue; { break C-switch statement } - end; - if (e and 64 = 0) then { next table } - begin - c^.sub.code.need := e; - c^.sub.code.tree := @huft_ptr(t)^[t^.base]; - continue; { break C-switch statement } - end; - if (e and 32 <> 0) then { end of block } - begin - {$IFDEF DEBUG} - Tracevv('inflate: end of block'); - {$ENDIF} - c^.mode := WASH; - continue; { break C-switch statement } - end; - c^.mode := BADCODE; { invalid code } - z.msg := 'invalid literal/length code'; - r := Z_DATA_ERROR; - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - LENEXT: { i: getting length extra (have base) } - begin - j := c^.sub.copy.get; - {NEEDBITS(j);} - while (k < j) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - Inc(c^.len, uInt(b and inflate_mask[j])); - {DUMPBITS(j);} - b := b shr j; - Dec(k, j); - - c^.sub.code.need := c^.dbits; - c^.sub.code.tree := c^.dtree; - {$IFDEF DEBUG} - Tracevv('inflate: length '+IntToStr(c^.len)); - {$ENDIF} - c^.mode := DIST; - { falltrough } - end; - DIST: { i: get distance next } - begin - j := c^.sub.code.need; - {NEEDBITS(j);} - while (k < j) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - t := @huft_ptr(c^.sub.code.tree)^[uInt(b) and inflate_mask[j]]; - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - - e := uInt(t^.exop); - if (e and 16 <> 0) then { distance } - begin - c^.sub.copy.get := e and 15; - c^.sub.copy.dist := t^.base; - c^.mode := DISTEXT; - continue; { break C-switch statement } - end; - if (e and 64 = 0) then { next table } - begin - c^.sub.code.need := e; - c^.sub.code.tree := @huft_ptr(t)^[t^.base]; - continue; { break C-switch statement } - end; - c^.mode := BADCODE; { invalid code } - z.msg := 'invalid distance code'; - r := Z_DATA_ERROR; - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - DISTEXT: { i: getting distance extra } - begin - j := c^.sub.copy.get; - {NEEDBITS(j);} - while (k < j) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - Inc(c^.sub.copy.dist, uInt(b) and inflate_mask[j]); - {DUMPBITS(j);} - b := b shr j; - Dec(k, j); - {$IFDEF DEBUG} - Tracevv('inflate: distance '+ IntToStr(c^.sub.copy.dist)); - {$ENDIF} - c^.mode := COPY; - { falltrough } - end; - COPY: { o: copying bytes in window, waiting for space } - begin - f := q; - Dec(f, c^.sub.copy.dist); - if (uInt(ptr2int(q) - ptr2int(s.window)) < c^.sub.copy.dist) then - begin - f := s.zend; - Dec(f, c^.sub.copy.dist - uInt(ptr2int(q) - ptr2int(s.window))); - end; - - while (c^.len <> 0) do - begin - {NEEDOUT} - if (m = 0) then - begin - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - end; - end; - r := Z_OK; - - {OUTBYTE( *f++)} - q^ := f^; - Inc(q); - Inc(f); - Dec(m); - - if (f = s.zend) then - f := s.window; - Dec(c^.len); - end; - c^.mode := START; - { C-switch break; not needed } - end; - LIT: { o: got literal, waiting for output space } - begin - {NEEDOUT} - if (m = 0) then - begin - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - end; - - if (m = 0) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - end; - end; - r := Z_OK; - - {OUTBYTE(c^.sub.lit);} - q^ := c^.sub.lit; - Inc(q); - Dec(m); - - c^.mode := START; - {break;} - end; - WASH: { o: got eob, possibly more output } - begin - {$ifdef patch112} - if (k > 7) then { return unused byte, if any } - begin - {$IFDEF DEBUG} - Assert(k < 16, 'inflate_codes grabbed too many bytes'); - {$ENDIF} - Dec(k, 8); - Inc(n); - Dec(p); { can always return one } - end; - {$endif} - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - if (s.read <> s.write) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - c^.mode := ZEND; - { falltrough } - end; - - ZEND: - begin - r := Z_STREAM_END; - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - BADCODE: { x: got error } - begin - r := Z_DATA_ERROR; - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - else - begin - r := Z_STREAM_ERROR; - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_codes := inflate_flush(s,z,r); - exit; - end; - end; -{NEED_DUMMY_RETURN - Delphi2+ dumb compilers complain without this } - inflate_codes := Z_STREAM_ERROR; -end; - - -procedure inflate_codes_free(c : pInflate_codes_state; - var z : z_stream); -begin - ZFREE(z, c); - {$IFDEF DEBUG} - Tracev('inflate: codes free'); - {$ENDIF} -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/iminffast.pas b/3rd/Imaging/Source/ZLib/iminffast.pas deleted file mode 100644 index 400b0fcff..000000000 --- a/3rd/Imaging/Source/ZLib/iminffast.pas +++ /dev/null @@ -1,318 +0,0 @@ -Unit iminffast; - -{ - inffast.h and - inffast.c -- process literals and length/distance pairs fast - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - - -interface - -{$I imzconf.inc} - -uses - {$ifdef DEBUG} - SysUtils, strutils, - {$ENDIF} - imzutil, impaszlib; - -function inflate_fast( bl : uInt; - bd : uInt; - tl : pInflate_huft; - td : pInflate_huft; - var s : inflate_blocks_state; - var z : z_stream) : int; - - -implementation - -uses - iminfutil; - - -{ Called with number of bytes left to write in window at least 258 - (the maximum string length) and number of input bytes available - at least ten. The ten bytes are six bytes for the longest length/ - distance pair plus four bytes for overloading the bit buffer. } - -function inflate_fast( bl : uInt; - bd : uInt; - tl : pInflate_huft; - td : pInflate_huft; - var s : inflate_blocks_state; - var z : z_stream) : int; - -var - t : pInflate_huft; { temporary pointer } - e : uInt; { extra bits or operation } - b : uLong; { bit buffer } - k : uInt; { bits in bit buffer } - p : pBytef; { input data pointer } - n : uInt; { bytes available there } - q : pBytef; { output window write pointer } - m : uInt; { bytes to end of window or read pointer } - ml : uInt; { mask for literal/length tree } - md : uInt; { mask for distance tree } - c : uInt; { bytes to copy } - d : uInt; { distance back to copy from } - r : pBytef; { copy source pointer } -begin - { load input, output, bit values (macro LOAD) } - p := z.next_in; - n := z.avail_in; - b := s.bitb; - k := s.bitk; - q := s.write; - if ptr2int(q) < ptr2int(s.read) then - m := uInt(ptr2int(s.read)-ptr2int(q)-1) - else - m := uInt(ptr2int(s.zend)-ptr2int(q)); - - { initialize masks } - ml := inflate_mask[bl]; - md := inflate_mask[bd]; - - { do until not enough input or output space for fast loop } - repeat { assume called with (m >= 258) and (n >= 10) } - { get literal/length code } - {GRABBITS(20);} { max bits for literal/length code } - while (k < 20) do - begin - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := @(huft_ptr(tl)^[uInt(b) and ml]); - - e := t^.exop; - if (e = 0) then - begin - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - {$IFDEF DEBUG} - if (t^.base >= $20) and (t^.base < $7f) then - Tracevv('inflate: * literal '+AnsiChar(t^.base)) - else - Tracevv('inflate: * literal '+ IntToStr(t^.base)); - {$ENDIF} - q^ := Byte(t^.base); - Inc(q); - Dec(m); - continue; - end; - repeat - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - - if (e and 16 <> 0) then - begin - { get extra bits for length } - e := e and 15; - c := t^.base + (uInt(b) and inflate_mask[e]); - {DUMPBITS(e);} - b := b shr e; - Dec(k, e); - {$IFDEF DEBUG} - Tracevv('inflate: * length ' + IntToStr(c)); - {$ENDIF} - { decode distance base of block to copy } - {GRABBITS(15);} { max bits for distance code } - while (k < 15) do - begin - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - t := @huft_ptr(td)^[uInt(b) and md]; - e := t^.exop; - repeat - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - - if (e and 16 <> 0) then - begin - { get extra bits to add to distance base } - e := e and 15; - {GRABBITS(e);} { get extra bits (up to 13) } - while (k < e) do - begin - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - - d := t^.base + (uInt(b) and inflate_mask[e]); - {DUMPBITS(e);} - b := b shr e; - Dec(k, e); - - {$IFDEF DEBUG} - Tracevv('inflate: * distance '+IntToStr(d)); - {$ENDIF} - { do the copy } - Dec(m, c); - if (uInt(ptr2int(q) - ptr2int(s.window)) >= d) then { offset before dest } - begin { just copy } - r := q; - Dec(r, d); - q^ := r^; Inc(q); Inc(r); Dec(c); { minimum count is three, } - q^ := r^; Inc(q); Inc(r); Dec(c); { so unroll loop a little } - end - else { else offset after destination } - begin - e := d - uInt(ptr2int(q) - ptr2int(s.window)); { bytes from offset to end } - r := s.zend; - Dec(r, e); { pointer to offset } - if (c > e) then { if source crosses, } - begin - Dec(c, e); { copy to end of window } - repeat - q^ := r^; - Inc(q); - Inc(r); - Dec(e); - until (e=0); - r := s.window; { copy rest from start of window } - end; - end; - repeat { copy all or what's left } - q^ := r^; - Inc(q); - Inc(r); - Dec(c); - until (c = 0); - break; - end - else - if (e and 64 = 0) then - begin - Inc(t, t^.base + (uInt(b) and inflate_mask[e])); - e := t^.exop; - end - else - begin - z.msg := 'invalid distance code'; - {UNGRAB} - c := z.avail_in-n; - if (k shr 3) < c then - c := k shr 3; - Inc(n, c); - Dec(p, c); - Dec(k, c shl 3); - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - - inflate_fast := Z_DATA_ERROR; - exit; - end; - until FALSE; - break; - end; - if (e and 64 = 0) then - begin - {t += t->base; - e = (t += ((uInt)b & inflate_mask[e]))->exop;} - - Inc(t, t^.base + (uInt(b) and inflate_mask[e])); - e := t^.exop; - if (e = 0) then - begin - {DUMPBITS(t^.bits);} - b := b shr t^.bits; - Dec(k, t^.bits); - - {$IFDEF DEBUG} - if (t^.base >= $20) and (t^.base < $7f) then - Tracevv('inflate: * literal '+AnsiChar(t^.base)) - else - Tracevv('inflate: * literal '+IntToStr(t^.base)); - {$ENDIF} - q^ := Byte(t^.base); - Inc(q); - Dec(m); - break; - end; - end - else - if (e and 32 <> 0) then - begin - {$IFDEF DEBUG} - Tracevv('inflate: * end of block'); - {$ENDIF} - {UNGRAB} - c := z.avail_in-n; - if (k shr 3) < c then - c := k shr 3; - Inc(n, c); - Dec(p, c); - Dec(k, c shl 3); - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_fast := Z_STREAM_END; - exit; - end - else - begin - z.msg := 'invalid literal/length code'; - {UNGRAB} - c := z.avail_in-n; - if (k shr 3) < c then - c := k shr 3; - Inc(n, c); - Dec(p, c); - Dec(k, c shl 3); - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_fast := Z_DATA_ERROR; - exit; - end; - until FALSE; - until (m < 258) or (n < 10); - - { not enough input or output--restore pointers and return } - {UNGRAB} - c := z.avail_in-n; - if (k shr 3) < c then - c := k shr 3; - Inc(n, c); - Dec(p, c); - Dec(k, c shl 3); - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, ptr2int(p)-ptr2int(z.next_in)); - z.next_in := p; - s.write := q; - inflate_fast := Z_OK; -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/iminftrees.pas b/3rd/Imaging/Source/ZLib/iminftrees.pas deleted file mode 100644 index 6949a63fd..000000000 --- a/3rd/Imaging/Source/ZLib/iminftrees.pas +++ /dev/null @@ -1,781 +0,0 @@ -Unit iminftrees; - -{ inftrees.h -- header to use inftrees.c - inftrees.c -- generate Huffman trees for efficient decoding - Copyright (C) 1995-1998 Mark Adler - - WARNING: this file should *not* be used by applications. It is - part of the implementation of the compression library and is - subject to change. - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -Interface - -{$I imzconf.inc} - -uses - imzutil, impaszlib; - - -{ Maximum size of dynamic tree. The maximum found in a long but non- - exhaustive search was 1004 huft structures (850 for length/literals - and 154 for distances, the latter actually the result of an - exhaustive search). The actual maximum is not known, but the - value below is more than safe. } -const - MANY = 1440; - - -{$ifdef DEBUG} -var - inflate_hufts : uInt; -{$endif} - -function inflate_trees_bits( - var c : array of uIntf; { 19 code lengths } - var bb : uIntf; { bits tree desired/actual depth } - var tb : pinflate_huft; { bits tree result } - var hp : array of Inflate_huft; { space for trees } - var z : z_stream { for messages } - ) : int; - -function inflate_trees_dynamic( - nl : uInt; { number of literal/length codes } - nd : uInt; { number of distance codes } - var c : Array of uIntf; { that many (total) code lengths } - var bl : uIntf; { literal desired/actual bit depth } - var bd : uIntf; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var hp : array of Inflate_huft; { space for trees } -var z : z_stream { for messages } - ) : int; - -function inflate_trees_fixed ( - var bl : uInt; { literal desired/actual bit depth } - var bd : uInt; { distance desired/actual bit depth } - var tl : pInflate_huft; { literal/length tree result } - var td : pInflate_huft; { distance tree result } - var z : z_stream { for memory allocation } - ) : int; - - -implementation - -const - inflate_copyright = 'inflate 1.1.2 Copyright 1995-1998 Mark Adler'; - -{ - If you use the zlib library in a product, an acknowledgment is welcome - in the documentation of your product. If for some reason you cannot - include such an acknowledgment, I would appreciate that you keep this - copyright string in the executable of your product. -} - - -const -{ Tables for deflate from PKZIP's appnote.txt. } - cplens : Array [0..30] Of uInt { Copy lengths for literal codes 257..285 } - = (3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, - 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0); - { actually lengths - 2; also see note #13 above about 258 } - - invalid_code = 112; - - cplext : Array [0..30] Of uInt { Extra bits for literal codes 257..285 } - = (0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, - 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0, invalid_code, invalid_code); - - cpdist : Array [0..29] Of uInt { Copy offsets for distance codes 0..29 } - = (1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, - 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, - 8193, 12289, 16385, 24577); - - cpdext : Array [0..29] Of uInt { Extra bits for distance codes } - = (0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, - 7, 7, 8, 8, 9, 9, 10, 10, 11, 11, - 12, 12, 13, 13); - -{ Huffman code decoding is performed using a multi-level table lookup. - The fastest way to decode is to simply build a lookup table whose - size is determined by the longest code. However, the time it takes - to build this table can also be a factor if the data being decoded - is not very long. The most common codes are necessarily the - shortest codes, so those codes dominate the decoding time, and hence - the speed. The idea is you can have a shorter table that decodes the - shorter, more probable codes, and then point to subsidiary tables for - the longer codes. The time it costs to decode the longer codes is - then traded against the time it takes to make longer tables. - - This results of this trade are in the variables lbits and dbits - below. lbits is the number of bits the first level table for literal/ - length codes can decode in one step, and dbits is the same thing for - the distance codes. Subsequent tables are also less than or equal to - those sizes. These values may be adjusted either when all of the - codes are shorter than that, in which case the longest code length in - bits is used, or when the shortest code is *longer* than the requested - table size, in which case the length of the shortest code in bits is - used. - - There are two different values for the two tables, since they code a - different number of possibilities each. The literal/length table - codes 286 possible values, or in a flat code, a little over eight - bits. The distance table codes 30 possible values, or a little less - than five bits, flat. The optimum values for speed end up being - about one bit more than those, so lbits is 8+1 and dbits is 5+1. - The optimum values may differ though from machine to machine, and - possibly even between compilers. Your mileage may vary. } - - -{ If BMAX needs to be larger than 16, then h and x[] should be uLong. } -const - BMAX = 15; { maximum bit length of any code } - -{$DEFINE USE_PTR} - -function huft_build( -var b : array of uIntf; { code lengths in bits (all assumed <= BMAX) } - n : uInt; { number of codes (assumed <= N_MAX) } - s : uInt; { number of simple-valued codes (0..s-1) } -const d : array of uIntf; { list of base values for non-simple codes } -{ array of word } -const e : array of uIntf; { list of extra bits for non-simple codes } -{ array of byte } - t : ppInflate_huft; { result: starting table } -var m : uIntf; { maximum lookup bits, returns actual } -var hp : array of inflate_huft; { space for trees } -var hn : uInt; { hufts used in space } -var v : array of uIntf { working area: values in order of bit length } - ) : int; -{ Given a list of code lengths and a maximum table size, make a set of - tables to decode that set of codes. Return Z_OK on success, Z_BUF_ERROR - if the given code set is incomplete (the tables are still built in this - case), Z_DATA_ERROR if the input is invalid (an over-subscribed set of - lengths), or Z_MEM_ERROR if not enough memory. } -Var - a : uInt; { counter for codes of length k } - c : Array [0..BMAX] Of uInt; { bit length count table } - f : uInt; { i repeats in table every f entries } - g : int; { maximum code length } - h : int; { table level } - i : uInt; {register} { counter, current code } - j : uInt; {register} { counter } - k : Int; {register} { number of bits in current code } - l : int; { bits per table (returned in m) } - mask : uInt; { (1 shl w) - 1, to avoid cc -O bug on HP } - p : ^uIntf; {register} { pointer into c[], b[], or v[] } - q : pInflate_huft; { points to current table } - r : inflate_huft; { table entry for structure assignment } - u : Array [0..BMAX-1] Of pInflate_huft; { table stack } - w : int; {register} { bits before this table = (l*h) } - x : Array [0..BMAX] Of uInt; { bit offsets, then code stack } - {$IFDEF USE_PTR} - xp : puIntf; { pointer into x } - {$ELSE} - xp : uInt; - {$ENDIF} - y : int; { number of dummy codes added } - z : uInt; { number of entries in current table } -Begin - { Generate counts for each bit length } - FillChar(c,SizeOf(c),0) ; { clear c[] } - - for i := 0 to n-1 do - Inc (c[b[i]]); { assume all entries <= BMAX } - - If (c[0] = n) Then { null input--all zero length codes } - Begin - t^ := pInflate_huft(NIL); - m := 0 ; - huft_build := Z_OK ; - Exit; - End ; - - { Find minimum and maximum length, bound [m] by those } - l := m; - for j:=1 To BMAX do - if (c[j] <> 0) then - break; - k := j ; { minimum code length } - if (uInt(l) < j) then - l := j; - for i := BMAX downto 1 do - if (c[i] <> 0) then - break ; - g := i ; { maximum code length } - if (uInt(l) > i) then - l := i; - m := l; - - { Adjust last length count to fill out codes, if needed } - y := 1 shl j ; - while (j < i) do - begin - Dec(y, c[j]) ; - if (y < 0) then - begin - huft_build := Z_DATA_ERROR; { bad input: more codes than bits } - exit; - end ; - Inc(j) ; - y := y shl 1 - end; - Dec (y, c[i]) ; - if (y < 0) then - begin - huft_build := Z_DATA_ERROR; { bad input: more codes than bits } - exit; - end; - Inc(c[i], y); - - { Generate starting offsets into the value table FOR each length } - {$IFDEF USE_PTR} - x[1] := 0; - j := 0; - - p := @c[1]; - xp := @x[2]; - - dec(i); { note that i = g from above } - WHILE (i > 0) DO - BEGIN - inc(j, p^); - xp^ := j; - inc(p); - inc(xp); - dec(i); - END; - {$ELSE} - x[1] := 0; - j := 0 ; - for i := 1 to g do - begin - x[i] := j; - Inc(j, c[i]); - end; - {$ENDIF} - - { Make a table of values in order of bit lengths } - for i := 0 to n-1 do - begin - j := b[i]; - if (j <> 0) then - begin - v[ x[j] ] := i; - Inc(x[j]); - end; - end; - n := x[g]; { set n to length of v } - - { Generate the Huffman codes and for each, make the table entries } - i := 0 ; - x[0] := 0 ; { first Huffman code is zero } - p := Addr(v) ; { grab values in bit order } - h := -1 ; { no tables yet--level -1 } - w := -l ; { bits decoded = (l*h) } - - u[0] := pInflate_huft(NIL); { just to keep compilers happy } - q := pInflate_huft(NIL); { ditto } - z := 0 ; { ditto } - - { go through the bit lengths (k already is bits in shortest code) } - while (k <= g) Do - begin - a := c[k] ; - while (a<>0) Do - begin - Dec (a) ; - { here i is the Huffman code of length k bits for value p^ } - { make tables up to required level } - while (k > w + l) do - begin - - Inc (h) ; - Inc (w, l); { add bits already decoded } - { previous table always l bits } - { compute minimum size table less than or equal to l bits } - - { table size upper limit } - z := g - w; - If (z > uInt(l)) Then - z := l; - - { try a k-w bit table } - j := k - w; - f := 1 shl j; - if (f > a+1) Then { too few codes for k-w bit table } - begin - Dec(f, a+1); { deduct codes from patterns left } - {$IFDEF USE_PTR} - xp := Addr(c[k]); - - if (j < z) then - begin - Inc(j); - while (j < z) do - begin { try smaller tables up to z bits } - f := f shl 1; - Inc (xp) ; - If (f <= xp^) Then - break; { enough codes to use up j bits } - Dec(f, xp^); { else deduct codes from patterns } - Inc(j); - end; - end; - {$ELSE} - xp := k; - - if (j < z) then - begin - Inc (j) ; - While (j < z) Do - begin { try smaller tables up to z bits } - f := f * 2; - Inc (xp) ; - if (f <= c[xp]) then - Break ; { enough codes to use up j bits } - Dec (f, c[xp]) ; { else deduct codes from patterns } - Inc (j); - end; - end; - {$ENDIF} - end; - - z := 1 shl j; { table entries for j-bit table } - - { allocate new table } - if (hn + z > MANY) then { (note: doesn't matter for fixed) } - begin - huft_build := Z_MEM_ERROR; { not enough memory } - exit; - end; - - q := @hp[hn]; - u[h] := q; - Inc(hn, z); - - { connect to last table, if there is one } - if (h <> 0) then - begin - x[h] := i; { save pattern for backing up } - r.bits := Byte(l); { bits to dump before this table } - r.exop := Byte(j); { bits in this table } - j := i shr (w - l); - {r.base := uInt( q - u[h-1] -j);} { offset to this table } - r.base := (ptr2int(q) - ptr2int(u[h-1]) ) div sizeof(q^) - j; - huft_Ptr(u[h-1])^[j] := r; { connect to last table } - end - else - t^ := q; { first table is returned result } - end; - - { set up table entry in r } - r.bits := Byte(k - w); - - { C-code: if (p >= v + n) - see ZUTIL.PAS for comments } - - if ptr2int(p)>=ptr2int(@(v[n])) then { also works under DPMI ?? } - r.exop := 128 + 64 { out of values--invalid code } - else - if (p^ < s) then - begin - if (p^ < 256) then { 256 is end-of-block code } - r.exop := 0 - Else - r.exop := 32 + 64; { EOB_code; } - r.base := p^; { simple code is just the value } - Inc(p); - end - Else - begin - r.exop := Byte(e[p^-s] + 16 + 64); { non-simple--look up in lists } - r.base := d[p^-s]; - Inc (p); - end ; - - { fill code-like entries with r } - f := 1 shl (k - w); - j := i shr w; - while (j < z) do - begin - huft_Ptr(q)^[j] := r; - Inc(j, f); - end; - - { backwards increment the k-bit code i } - j := 1 shl (k-1) ; - while (i and j) <> 0 do - begin - i := i xor j; { bitwise exclusive or } - j := j shr 1 - end ; - i := i xor j; - - { backup over finished tables } - mask := (1 shl w) - 1; { needed on HP, cc -O bug } - while ((i and mask) <> x[h]) do - begin - Dec(h); { don't need to update q } - Dec(w, l); - mask := (1 shl w) - 1; - end; - - end; - - Inc(k); - end; - - { Return Z_BUF_ERROR if we were given an incomplete table } - if (y <> 0) And (g <> 1) then - huft_build := Z_BUF_ERROR - else - huft_build := Z_OK; -end; { huft_build} - - -function inflate_trees_bits( - var c : array of uIntf; { 19 code lengths } - var bb : uIntf; { bits tree desired/actual depth } - var tb : pinflate_huft; { bits tree result } - var hp : array of Inflate_huft; { space for trees } - var z : z_stream { for messages } - ) : int; -var - r : int; - hn : uInt; { hufts used in space } - v : PuIntArray; { work area for huft_build } -begin - hn := 0; - v := PuIntArray( ZALLOC(z, 19, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - inflate_trees_bits := Z_MEM_ERROR; - exit; - end; - - r := huft_build(c, 19, 19, cplens, cplext, - {puIntf(Z_NULL), puIntf(Z_NULL),} - @tb, bb, hp, hn, v^); - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed dynamic bit lengths tree' - else - if (r = Z_BUF_ERROR) or (bb = 0) then - begin - z.msg := 'incomplete dynamic bit lengths tree'; - r := Z_DATA_ERROR; - end; - ZFREE(z, v); - inflate_trees_bits := r; -end; - - -function inflate_trees_dynamic( - nl : uInt; { number of literal/length codes } - nd : uInt; { number of distance codes } - var c : Array of uIntf; { that many (total) code lengths } - var bl : uIntf; { literal desired/actual bit depth } - var bd : uIntf; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var hp : array of Inflate_huft; { space for trees } -var z : z_stream { for messages } - ) : int; -var - r : int; - hn : uInt; { hufts used in space } - v : PuIntArray; { work area for huft_build } -begin - hn := 0; - { allocate work area } - v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - inflate_trees_dynamic := Z_MEM_ERROR; - exit; - end; - - { build literal/length tree } - r := huft_build(c, nl, 257, cplens, cplext, @tl, bl, hp, hn, v^); - if (r <> Z_OK) or (bl = 0) then - begin - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed literal/length tree' - else - if (r <> Z_MEM_ERROR) then - begin - z.msg := 'incomplete literal/length tree'; - r := Z_DATA_ERROR; - end; - - ZFREE(z, v); - inflate_trees_dynamic := r; - exit; - end; - - { build distance tree } - r := huft_build(puIntArray(@c[nl])^, nd, 0, - cpdist, cpdext, @td, bd, hp, hn, v^); - if (r <> Z_OK) or ((bd = 0) and (nl > 257)) then - begin - if (r = Z_DATA_ERROR) then - z.msg := 'oversubscribed literal/length tree' - else - if (r = Z_BUF_ERROR) then - begin -{$ifdef PKZIP_BUG_WORKAROUND} - r := Z_OK; - end; -{$else} - z.msg := 'incomplete literal/length tree'; - r := Z_DATA_ERROR; - end - else - if (r <> Z_MEM_ERROR) then - begin - z.msg := 'empty distance tree with lengths'; - r := Z_DATA_ERROR; - end; - ZFREE(z, v); - inflate_trees_dynamic := r; - exit; -{$endif} - end; - - { done } - ZFREE(z, v); - inflate_trees_dynamic := Z_OK; -end; - -{$UNDEF BUILDFIXED} - -{ build fixed tables only once--keep them here } -{$IFNDEF BUILDFIXED} -{ locals } -var - fixed_built : Boolean = false; -const - FIXEDH = 544; { number of hufts used by fixed tables } -var - fixed_mem : array[0..FIXEDH-1] of inflate_huft; - fixed_bl : uInt; - fixed_bd : uInt; - fixed_tl : pInflate_huft; - fixed_td : pInflate_huft; - -{$ELSE} - -{ inffixed.h -- table for decoding fixed codes } - -{local} -const - fixed_bl = uInt(9); -{local} -const - fixed_bd = uInt(5); -{local} -const - fixed_tl : array [0..288-1] of inflate_huft = ( - Exop, { number of extra bits or operation } - bits : Byte; { number of bits in this code or subcode } - {pad : uInt;} { pad structure to a power of 2 (4 bytes for } - { 16-bit, 8 bytes for 32-bit int's) } - base : uInt; { literal, length base, or distance base } - { or table offset } - - ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), ((82,7),31), - ((0,8),112), ((0,8),48), ((0,9),192), ((80,7),10), ((0,8),96), - ((0,8),32), ((0,9),160), ((0,8),0), ((0,8),128), ((0,8),64), - ((0,9),224), ((80,7),6), ((0,8),88), ((0,8),24), ((0,9),144), - ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),208), ((81,7),17), - ((0,8),104), ((0,8),40), ((0,9),176), ((0,8),8), ((0,8),136), - ((0,8),72), ((0,9),240), ((80,7),4), ((0,8),84), ((0,8),20), - ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), ((0,9),200), - ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),168), ((0,8),4), - ((0,8),132), ((0,8),68), ((0,9),232), ((80,7),8), ((0,8),92), - ((0,8),28), ((0,9),152), ((84,7),83), ((0,8),124), ((0,8),60), - ((0,9),216), ((82,7),23), ((0,8),108), ((0,8),44), ((0,9),184), - ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),248), ((80,7),3), - ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), ((0,8),114), - ((0,8),50), ((0,9),196), ((81,7),11), ((0,8),98), ((0,8),34), - ((0,9),164), ((0,8),2), ((0,8),130), ((0,8),66), ((0,9),228), - ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),148), ((84,7),67), - ((0,8),122), ((0,8),58), ((0,9),212), ((82,7),19), ((0,8),106), - ((0,8),42), ((0,9),180), ((0,8),10), ((0,8),138), ((0,8),74), - ((0,9),244), ((80,7),5), ((0,8),86), ((0,8),22), ((192,8),0), - ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),204), ((81,7),15), - ((0,8),102), ((0,8),38), ((0,9),172), ((0,8),6), ((0,8),134), - ((0,8),70), ((0,9),236), ((80,7),9), ((0,8),94), ((0,8),30), - ((0,9),156), ((84,7),99), ((0,8),126), ((0,8),62), ((0,9),220), - ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),188), ((0,8),14), - ((0,8),142), ((0,8),78), ((0,9),252), ((96,7),256), ((0,8),81), - ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), ((0,8),49), - ((0,9),194), ((80,7),10), ((0,8),97), ((0,8),33), ((0,9),162), - ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),226), ((80,7),6), - ((0,8),89), ((0,8),25), ((0,9),146), ((83,7),59), ((0,8),121), - ((0,8),57), ((0,9),210), ((81,7),17), ((0,8),105), ((0,8),41), - ((0,9),178), ((0,8),9), ((0,8),137), ((0,8),73), ((0,9),242), - ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), ((83,7),43), - ((0,8),117), ((0,8),53), ((0,9),202), ((81,7),13), ((0,8),101), - ((0,8),37), ((0,9),170), ((0,8),5), ((0,8),133), ((0,8),69), - ((0,9),234), ((80,7),8), ((0,8),93), ((0,8),29), ((0,9),154), - ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),218), ((82,7),23), - ((0,8),109), ((0,8),45), ((0,9),186), ((0,8),13), ((0,8),141), - ((0,8),77), ((0,9),250), ((80,7),3), ((0,8),83), ((0,8),19), - ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), ((0,9),198), - ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),166), ((0,8),3), - ((0,8),131), ((0,8),67), ((0,9),230), ((80,7),7), ((0,8),91), - ((0,8),27), ((0,9),150), ((84,7),67), ((0,8),123), ((0,8),59), - ((0,9),214), ((82,7),19), ((0,8),107), ((0,8),43), ((0,9),182), - ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),246), ((80,7),5), - ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), ((0,8),119), - ((0,8),55), ((0,9),206), ((81,7),15), ((0,8),103), ((0,8),39), - ((0,9),174), ((0,8),7), ((0,8),135), ((0,8),71), ((0,9),238), - ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),158), ((84,7),99), - ((0,8),127), ((0,8),63), ((0,9),222), ((82,7),27), ((0,8),111), - ((0,8),47), ((0,9),190), ((0,8),15), ((0,8),143), ((0,8),79), - ((0,9),254), ((96,7),256), ((0,8),80), ((0,8),16), ((84,8),115), - ((82,7),31), ((0,8),112), ((0,8),48), ((0,9),193), ((80,7),10), - ((0,8),96), ((0,8),32), ((0,9),161), ((0,8),0), ((0,8),128), - ((0,8),64), ((0,9),225), ((80,7),6), ((0,8),88), ((0,8),24), - ((0,9),145), ((83,7),59), ((0,8),120), ((0,8),56), ((0,9),209), - ((81,7),17), ((0,8),104), ((0,8),40), ((0,9),177), ((0,8),8), - ((0,8),136), ((0,8),72), ((0,9),241), ((80,7),4), ((0,8),84), - ((0,8),20), ((85,8),227), ((83,7),43), ((0,8),116), ((0,8),52), - ((0,9),201), ((81,7),13), ((0,8),100), ((0,8),36), ((0,9),169), - ((0,8),4), ((0,8),132), ((0,8),68), ((0,9),233), ((80,7),8), - ((0,8),92), ((0,8),28), ((0,9),153), ((84,7),83), ((0,8),124), - ((0,8),60), ((0,9),217), ((82,7),23), ((0,8),108), ((0,8),44), - ((0,9),185), ((0,8),12), ((0,8),140), ((0,8),76), ((0,9),249), - ((80,7),3), ((0,8),82), ((0,8),18), ((85,8),163), ((83,7),35), - ((0,8),114), ((0,8),50), ((0,9),197), ((81,7),11), ((0,8),98), - ((0,8),34), ((0,9),165), ((0,8),2), ((0,8),130), ((0,8),66), - ((0,9),229), ((80,7),7), ((0,8),90), ((0,8),26), ((0,9),149), - ((84,7),67), ((0,8),122), ((0,8),58), ((0,9),213), ((82,7),19), - ((0,8),106), ((0,8),42), ((0,9),181), ((0,8),10), ((0,8),138), - ((0,8),74), ((0,9),245), ((80,7),5), ((0,8),86), ((0,8),22), - ((192,8),0), ((83,7),51), ((0,8),118), ((0,8),54), ((0,9),205), - ((81,7),15), ((0,8),102), ((0,8),38), ((0,9),173), ((0,8),6), - ((0,8),134), ((0,8),70), ((0,9),237), ((80,7),9), ((0,8),94), - ((0,8),30), ((0,9),157), ((84,7),99), ((0,8),126), ((0,8),62), - ((0,9),221), ((82,7),27), ((0,8),110), ((0,8),46), ((0,9),189), - ((0,8),14), ((0,8),142), ((0,8),78), ((0,9),253), ((96,7),256), - ((0,8),81), ((0,8),17), ((85,8),131), ((82,7),31), ((0,8),113), - ((0,8),49), ((0,9),195), ((80,7),10), ((0,8),97), ((0,8),33), - ((0,9),163), ((0,8),1), ((0,8),129), ((0,8),65), ((0,9),227), - ((80,7),6), ((0,8),89), ((0,8),25), ((0,9),147), ((83,7),59), - ((0,8),121), ((0,8),57), ((0,9),211), ((81,7),17), ((0,8),105), - ((0,8),41), ((0,9),179), ((0,8),9), ((0,8),137), ((0,8),73), - ((0,9),243), ((80,7),4), ((0,8),85), ((0,8),21), ((80,8),258), - ((83,7),43), ((0,8),117), ((0,8),53), ((0,9),203), ((81,7),13), - ((0,8),101), ((0,8),37), ((0,9),171), ((0,8),5), ((0,8),133), - ((0,8),69), ((0,9),235), ((80,7),8), ((0,8),93), ((0,8),29), - ((0,9),155), ((84,7),83), ((0,8),125), ((0,8),61), ((0,9),219), - ((82,7),23), ((0,8),109), ((0,8),45), ((0,9),187), ((0,8),13), - ((0,8),141), ((0,8),77), ((0,9),251), ((80,7),3), ((0,8),83), - ((0,8),19), ((85,8),195), ((83,7),35), ((0,8),115), ((0,8),51), - ((0,9),199), ((81,7),11), ((0,8),99), ((0,8),35), ((0,9),167), - ((0,8),3), ((0,8),131), ((0,8),67), ((0,9),231), ((80,7),7), - ((0,8),91), ((0,8),27), ((0,9),151), ((84,7),67), ((0,8),123), - ((0,8),59), ((0,9),215), ((82,7),19), ((0,8),107), ((0,8),43), - ((0,9),183), ((0,8),11), ((0,8),139), ((0,8),75), ((0,9),247), - ((80,7),5), ((0,8),87), ((0,8),23), ((192,8),0), ((83,7),51), - ((0,8),119), ((0,8),55), ((0,9),207), ((81,7),15), ((0,8),103), - ((0,8),39), ((0,9),175), ((0,8),7), ((0,8),135), ((0,8),71), - ((0,9),239), ((80,7),9), ((0,8),95), ((0,8),31), ((0,9),159), - ((84,7),99), ((0,8),127), ((0,8),63), ((0,9),223), ((82,7),27), - ((0,8),111), ((0,8),47), ((0,9),191), ((0,8),15), ((0,8),143), - ((0,8),79), ((0,9),255) - ); - -{local} -const - fixed_td : array[0..32-1] of inflate_huft = ( -(Exop:80;bits:5;base:1), (Exop:87;bits:5;base:257), (Exop:83;bits:5;base:17), -(Exop:91;bits:5;base:4097), (Exop:81;bits:5;base), (Exop:89;bits:5;base:1025), -(Exop:85;bits:5;base:65), (Exop:93;bits:5;base:16385), (Exop:80;bits:5;base:3), -(Exop:88;bits:5;base:513), (Exop:84;bits:5;base:33), (Exop:92;bits:5;base:8193), -(Exop:82;bits:5;base:9), (Exop:90;bits:5;base:2049), (Exop:86;bits:5;base:129), -(Exop:192;bits:5;base:24577), (Exop:80;bits:5;base:2), (Exop:87;bits:5;base:385), -(Exop:83;bits:5;base:25), (Exop:91;bits:5;base:6145), (Exop:81;bits:5;base:7), -(Exop:89;bits:5;base:1537), (Exop:85;bits:5;base:97), (Exop:93;bits:5;base:24577), -(Exop:80;bits:5;base:4), (Exop:88;bits:5;base:769), (Exop:84;bits:5;base:49), -(Exop:92;bits:5;base:12289), (Exop:82;bits:5;base:13), (Exop:90;bits:5;base:3073), -(Exop:86;bits:5;base:193), (Exop:192;bits:5;base:24577) - ); -{$ENDIF} - -function inflate_trees_fixed( -var bl : uInt; { literal desired/actual bit depth } -var bd : uInt; { distance desired/actual bit depth } -var tl : pInflate_huft; { literal/length tree result } -var td : pInflate_huft; { distance tree result } -var z : z_stream { for memory allocation } - ) : int; -type - pFixed_table = ^fixed_table; - fixed_table = array[0..288-1] of uIntf; -var - k : int; { temporary variable } - c : pFixed_table; { length list for huft_build } - v : PuIntArray; { work area for huft_build } -var - f : uInt; { number of hufts used in fixed_mem } -begin - { build fixed tables if not already (multiple overlapped executions ok) } - if not fixed_built then - begin - f := 0; - - { allocate memory } - c := pFixed_table( ZALLOC(z, 288, sizeof(uInt)) ); - if (c = Z_NULL) then - begin - inflate_trees_fixed := Z_MEM_ERROR; - exit; - end; - v := PuIntArray( ZALLOC(z, 288, sizeof(uInt)) ); - if (v = Z_NULL) then - begin - ZFREE(z, c); - inflate_trees_fixed := Z_MEM_ERROR; - exit; - end; - - { literal table } - for k := 0 to Pred(144) do - c^[k] := 8; - for k := 144 to Pred(256) do - c^[k] := 9; - for k := 256 to Pred(280) do - c^[k] := 7; - for k := 280 to Pred(288) do - c^[k] := 8; - fixed_bl := 9; - huft_build(c^, 288, 257, cplens, cplext, @fixed_tl, fixed_bl, - fixed_mem, f, v^); - - { distance table } - for k := 0 to Pred(30) do - c^[k] := 5; - fixed_bd := 5; - huft_build(c^, 30, 0, cpdist, cpdext, @fixed_td, fixed_bd, - fixed_mem, f, v^); - - { done } - ZFREE(z, v); - ZFREE(z, c); - fixed_built := True; - end; - bl := fixed_bl; - bd := fixed_bd; - tl := fixed_tl; - td := fixed_td; - inflate_trees_fixed := Z_OK; -end; { inflate_trees_fixed } - - -end. \ No newline at end of file diff --git a/3rd/Imaging/Source/ZLib/iminfutil.pas b/3rd/Imaging/Source/ZLib/iminfutil.pas deleted file mode 100644 index 384f0d3ca..000000000 --- a/3rd/Imaging/Source/ZLib/iminfutil.pas +++ /dev/null @@ -1,222 +0,0 @@ -Unit iminfutil; - -{ types and macros common to blocks and codes - Copyright (C) 1995-1998 Mark Adler - - WARNING: this file should *not* be used by applications. It is - part of the implementation of the compression library and is - subject to change. - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - imzutil, impaszlib; - -{ copy as much as possible from the sliding window to the output area } -function inflate_flush(var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; - -{ And'ing with mask[n] masks the lower n bits } -const - inflate_mask : array[0..17-1] of uInt = ( - $0000, - $0001, $0003, $0007, $000f, $001f, $003f, $007f, $00ff, - $01ff, $03ff, $07ff, $0fff, $1fff, $3fff, $7fff, $ffff); - -{procedure GRABBITS(j : int);} -{procedure DUMPBITS(j : int);} -{procedure NEEDBITS(j : int);} - -implementation - -{ macros for bit input with no checking and for returning unused bytes } -procedure GRABBITS(j : int); -begin - {while (k < j) do - begin - Dec(z^.avail_in); - Inc(z^.total_in); - b := b or (uLong(z^.next_in^) shl k); - Inc(z^.next_in); - Inc(k, 8); - end;} -end; - -procedure DUMPBITS(j : int); -begin - {b := b shr j; - Dec(k, j);} -end; - -procedure NEEDBITS(j : int); -begin - (* - while (k < j) do - begin - {NEEDBYTE;} - if (n <> 0) then - r :=Z_OK - else - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, LongInt(p)-LongInt(z.next_in)); - z.next_in := p; - s.write := q; - result := inflate_flush(s,z,r); - exit; - end; - Dec(n); - b := b or (uLong(p^) shl k); - Inc(p); - Inc(k, 8); - end; - *) -end; - -procedure NEEDOUT; -begin - (* - if (m = 0) then - begin - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if LongInt(q) < LongInt(s.read) then - m := uInt(LongInt(s.read)-LongInt(q)-1) - else - m := uInt(LongInt(s.zend)-LongInt(q)); - end; - - if (m = 0) then - begin - {FLUSH} - s.write := q; - r := inflate_flush(s,z,r); - q := s.write; - if LongInt(q) < LongInt(s.read) then - m := uInt(LongInt(s.read)-LongInt(q)-1) - else - m := uInt(LongInt(s.zend)-LongInt(q)); - - {WRAP} - if (q = s.zend) and (s.read <> s.window) then - begin - q := s.window; - if LongInt(q) < LongInt(s.read) then - m := uInt(LongInt(s.read)-LongInt(q)-1) - else - m := uInt(LongInt(s.zend)-LongInt(q)); - end; - - if (m = 0) then - begin - {UPDATE} - s.bitb := b; - s.bitk := k; - z.avail_in := n; - Inc(z.total_in, LongInt(p)-LongInt(z.next_in)); - z.next_in := p; - s.write := q; - result := inflate_flush(s,z,r); - exit; - end; - end; - end; - r := Z_OK; - *) -end; - -{ copy as much as possible from the sliding window to the output area } -function inflate_flush(var s : inflate_blocks_state; - var z : z_stream; - r : int) : int; -var - n : uInt; - p : pBytef; - q : pBytef; -begin - { local copies of source and destination pointers } - p := z.next_out; - q := s.read; - - { compute number of bytes to copy as far as end of window } - if ptr2int(q) <= ptr2int(s.write) then - n := uInt(ptr2int(s.write) - ptr2int(q)) - else - n := uInt(ptr2int(s.zend) - ptr2int(q)); - if (n > z.avail_out) then - n := z.avail_out; - if (n <> 0) and (r = Z_BUF_ERROR) then - r := Z_OK; - - { update counters } - Dec(z.avail_out, n); - Inc(z.total_out, n); - - - { update check information } - if Assigned(s.checkfn) then - begin - s.check := s.checkfn(s.check, q, n); - z.adler := s.check; - end; - - { copy as far as end of window } - zmemcpy(p, q, n); - Inc(p, n); - Inc(q, n); - - { see if more to copy at beginning of window } - if (q = s.zend) then - begin - { wrap pointers } - q := s.window; - if (s.write = s.zend) then - s.write := s.window; - - { compute bytes to copy } - n := uInt(ptr2int(s.write) - ptr2int(q)); - if (n > z.avail_out) then - n := z.avail_out; - if (n <> 0) and (r = Z_BUF_ERROR) then - r := Z_OK; - - { update counters } - Dec( z.avail_out, n); - Inc( z.total_out, n); - - { update check information } - if Assigned(s.checkfn) then - begin - s.check := s.checkfn(s.check, q, n); - z.adler := s.check; - end; - - { copy } - zmemcpy(p, q, n); - Inc(p, n); - Inc(q, n); - end; - - - { update pointers } - z.next_out := p; - s.read := q; - - { done } - inflate_flush := r; -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/impaszlib.pas b/3rd/Imaging/Source/ZLib/impaszlib.pas deleted file mode 100644 index 555634c57..000000000 --- a/3rd/Imaging/Source/ZLib/impaszlib.pas +++ /dev/null @@ -1,520 +0,0 @@ -Unit impaszlib; - - -{ Original: - zlib.h -- interface of the 'zlib' general purpose compression library - version 1.1.0, Feb 24th, 1998 - - Copyright (C) 1995-1998 Jean-loup Gailly and Mark Adler - - This software is provided 'as-is', without any express or implied - warranty. In no event will the authors be held liable for any damages - arising from the use of this software. - - Permission is granted to anyone to use this software for any purpose, - including commercial applications, and to alter it and redistribute it - freely, subject to the following restrictions: - - 1. The origin of this software must not be misrepresented; you must not - claim that you wrote the original software. If you use this software - in a product, an acknowledgment in the product documentation would be - appreciated but is not required. - 2. Altered source versions must be plainly marked as such, and must not be - misrepresented as being the original software. - 3. This notice may not be removed or altered from any source distribution. - - Jean-loup Gailly Mark Adler - jloup@gzip.org madler@alumni.caltech.edu - - - The data format used by the zlib library is described by RFCs (Request for - Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt - (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). - - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - imzutil; - -{ zconf.h -- configuration of the zlib compression library } -{ zutil.c -- target dependent utility functions for the compression library } - -{ The 'zlib' compression library provides in-memory compression and - decompression functions, including integrity checks of the uncompressed - data. This version of the library supports only one compression method - (deflation) but other algorithms will be added later and will have the same - stream interface. - - Compression can be done in a single step if the buffers are large - enough (for example if an input file is mmap'ed), or can be done by - repeated calls of the compression function. In the latter case, the - application must provide more input and/or consume the output - (providing more output space) before each call. - - The library also supports reading and writing files in gzip (.gz) format - with an interface similar to that of stdio. - - The library does not install any signal handler. The decoder checks - the consistency of the compressed data, so the library should never - crash even in case of corrupted input. } - - - -{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more - than 64k bytes at a time (needed on systems with 16-bit int). } - -{ Maximum value for memLevel in deflateInit2 } -const - MAX_MEM_LEVEL = 9; - DEF_MEM_LEVEL = 8; { if MAX_MEM_LEVEL > 8 } - -{ Maximum value for windowBits in deflateInit2 and inflateInit2 } -const - MAX_WBITS = 15; { 32K LZ77 window } - -{ default windowBits for decompression. MAX_WBITS is for compression only } -const - DEF_WBITS = MAX_WBITS; - -{ The memory requirements for deflate are (in bytes): - 1 shl (windowBits+2) + 1 shl (memLevel+9) - that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) - plus a few kilobytes for small objects. For example, if you want to reduce - the default memory requirements from 256K to 128K, compile with - DMAX_WBITS=14 DMAX_MEM_LEVEL=7 - Of course this will generally degrade compression (there's no free lunch). - - The memory requirements for inflate are (in bytes) 1 shl windowBits - that is, 32K for windowBits=15 (default value) plus a few kilobytes - for small objects. } - - -{ Huffman code lookup table entry--this entry is four bytes for machines - that have 16-bit pointers (e.g. PC's in the small or medium model). } - -type - pInflate_huft = ^inflate_huft; - inflate_huft = Record - Exop, { number of extra bits or operation } - bits : Byte; { number of bits in this code or subcode } - {pad : uInt;} { pad structure to a power of 2 (4 bytes for } - { 16-bit, 8 bytes for 32-bit int's) } - base : uInt; { literal, length base, or distance base } - { or table offset } - End; - -type - huft_field = Array[0..(MaxInt div SizeOf(inflate_huft))-1] of inflate_huft; - huft_ptr = ^huft_field; -type - ppInflate_huft = ^pInflate_huft; - -type - inflate_codes_mode = ( { waiting for "i:"=input, "o:"=output, "x:"=nothing } - START, { x: set up for LEN } - LEN, { i: get length/literal/eob next } - LENEXT, { i: getting length extra (have base) } - DIST, { i: get distance next } - DISTEXT, { i: getting distance extra } - COPY, { o: copying bytes in window, waiting for space } - LIT, { o: got literal, waiting for output space } - WASH, { o: got eob, possibly still output waiting } - ZEND, { x: got eob and all data flushed } - BADCODE); { x: got error } - -{ inflate codes private state } -type - pInflate_codes_state = ^inflate_codes_state; - inflate_codes_state = record - - mode : inflate_codes_mode; { current inflate_codes mode } - - { mode dependent information } - len : uInt; - sub : record { submode } - Case Byte of - 0:(code : record { if LEN or DIST, where in tree } - tree : pInflate_huft; { pointer into tree } - need : uInt; { bits needed } - end); - 1:(lit : uInt); { if LIT, literal } - 2:(copy: record { if EXT or COPY, where and how much } - get : uInt; { bits to get for extra } - dist : uInt; { distance back to copy from } - end); - end; - - { mode independent information } - lbits : Byte; { ltree bits decoded per branch } - dbits : Byte; { dtree bits decoder per branch } - ltree : pInflate_huft; { literal/length/eob tree } - dtree : pInflate_huft; { distance tree } - end; - -type - check_func = function(check : uLong; - buf : pBytef; - {const buf : array of byte;} - len : uInt) : uLong; -type - inflate_block_mode = - (ZTYPE, { get type bits (3, including end bit) } - LENS, { get lengths for stored } - STORED, { processing stored block } - TABLE, { get table lengths } - BTREE, { get bit lengths tree for a dynamic block } - DTREE, { get length, distance trees for a dynamic block } - CODES, { processing fixed or dynamic block } - DRY, { output remaining window bytes } - BLKDONE, { finished last block, done } - BLKBAD); { got a data error--stuck here } - -type - pInflate_blocks_state = ^inflate_blocks_state; - -{ inflate blocks semi-private state } - inflate_blocks_state = record - - mode : inflate_block_mode; { current inflate_block mode } - - { mode dependent information } - sub : record { submode } - case Byte of - 0:(left : uInt); { if STORED, bytes left to copy } - 1:(trees : record { if DTREE, decoding info for trees } - table : uInt; { table lengths (14 bits) } - index : uInt; { index into blens (or border) } - blens : PuIntArray; { bit lengths of codes } - bb : uInt; { bit length tree depth } - tb : pInflate_huft; { bit length decoding tree } - end); - 2:(decode : record { if CODES, current state } - tl : pInflate_huft; - td : pInflate_huft; { trees to free } - codes : pInflate_codes_state; - end); - end; - last : boolean; { true if this block is the last block } - - { mode independent information } - bitk : uInt; { bits in bit buffer } - bitb : uLong; { bit buffer } - hufts : huft_ptr; {pInflate_huft;} { single malloc for tree space } - window : pBytef; { sliding window } - zend : pBytef; { one byte after sliding window } - read : pBytef; { window read pointer } - write : pBytef; { window write pointer } - checkfn : check_func; { check function } - check : uLong; { check on output } - end; - -type - inflate_mode = ( - METHOD, { waiting for method byte } - FLAG, { waiting for flag byte } - DICT4, { four dictionary check bytes to go } - DICT3, { three dictionary check bytes to go } - DICT2, { two dictionary check bytes to go } - DICT1, { one dictionary check byte to go } - DICT0, { waiting for inflateSetDictionary } - BLOCKS, { decompressing blocks } - CHECK4, { four check bytes to go } - CHECK3, { three check bytes to go } - CHECK2, { two check bytes to go } - CHECK1, { one check byte to go } - DONE, { finished check, done } - BAD); { got an error--stay here } - -{ inflate private state } -type - pInternal_state = ^internal_state; { or point to a deflate_state record } - internal_state = record - - mode : inflate_mode; { current inflate mode } - - { mode dependent information } - sub : record { submode } - case byte of - 0:(method : uInt); { if FLAGS, method byte } - 1:(check : record { if CHECK, check values to compare } - was : uLong; { computed check value } - need : uLong; { stream check value } - end); - 2:(marker : uInt); { if BAD, inflateSync's marker bytes count } - end; - - { mode independent information } - nowrap : boolean; { flag for no wrapper } - wbits : uInt; { log2(window size) (8..15, defaults to 15) } - blocks : pInflate_blocks_state; { current inflate_blocks state } - end; - -type - alloc_func = function(opaque : voidpf; items : uInt; size : uInt) : voidpf; - free_func = procedure(opaque : voidpf; address : voidpf); - -type - z_streamp = ^z_stream; - z_stream = record - next_in : pBytef; { next input byte } - avail_in : uInt; { number of bytes available at next_in } - total_in : uLong; { total nb of input bytes read so far } - - next_out : pBytef; { next output byte should be put there } - avail_out : uInt; { remaining free space at next_out } - total_out : uLong; { total nb of bytes output so far } - - msg : string[255]; { last error message, '' if no error } - state : pInternal_state; { not visible by applications } - - zalloc : alloc_func; { used to allocate the internal state } - zfree : free_func; { used to free the internal state } - opaque : voidpf; { private data object passed to zalloc and zfree } - - data_type : int; { best guess about the data type: ascii or binary } - adler : uLong; { adler32 value of the uncompressed data } - reserved : uLong; { reserved for future use } - end; - - -{ The application must update next_in and avail_in when avail_in has - dropped to zero. It must update next_out and avail_out when avail_out - has dropped to zero. The application must initialize zalloc, zfree and - opaque before calling the init function. All other fields are set by the - compression library and must not be updated by the application. - - The opaque value provided by the application will be passed as the first - parameter for calls of zalloc and zfree. This can be useful for custom - memory management. The compression library attaches no meaning to the - opaque value. - - zalloc must return Z_NULL if there is not enough memory for the object. - On 16-bit systems, the functions zalloc and zfree must be able to allocate - exactly 65536 bytes, but will not be required to allocate more than this - if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, - pointers returned by zalloc for objects of exactly 65536 bytes *must* - have their offset normalized to zero. The default allocation function - provided by this library ensures this (see zutil.c). To reduce memory - requirements and avoid any allocation of 64K objects, at the expense of - compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). - - The fields total_in and total_out can be used for statistics or - progress reports. After compression, total_in holds the total size of - the uncompressed data and may be saved for use in the decompressor - (particularly if the decompressor wants to decompress everything in - a single step). } - -const { constants } - Z_NO_FLUSH = 0; - Z_PARTIAL_FLUSH = 1; - Z_SYNC_FLUSH = 2; - Z_FULL_FLUSH = 3; - Z_FINISH = 4; -{ Allowed flush values; see deflate() below for details } - - Z_OK = 0; - Z_STREAM_END = 1; - Z_NEED_DICT = 2; - Z_ERRNO = (-1); - Z_STREAM_ERROR = (-2); - Z_DATA_ERROR = (-3); - Z_MEM_ERROR = (-4); - Z_BUF_ERROR = (-5); - Z_VERSION_ERROR = (-6); -{ Return codes for the compression/decompression functions. Negative - values are errors, positive values are used for special but normal events.} - - Z_NO_COMPRESSION = 0; - Z_BEST_SPEED = 1; - Z_BEST_COMPRESSION = 9; - Z_DEFAULT_COMPRESSION = (-1); -{ compression levels } - - Z_FILTERED = 1; - Z_HUFFMAN_ONLY = 2; - Z_DEFAULT_STRATEGY = 0; -{ compression strategy; see deflateInit2() below for details } - - Z_BINARY = 0; - Z_ASCII = 1; - Z_UNKNOWN = 2; -{ Possible values of the data_type field } - - Z_DEFLATED = 8; -{ The deflate compression method (the only one supported in this version) } - - Z_NULL = NIL; { for initializing zalloc, zfree, opaque } - - {$IFDEF GZIO} -var - errno : int; - {$ENDIF} - - { common constants } - - -{ The three kinds of block type } -const - STORED_BLOCK = 0; - STATIC_TREES = 1; - DYN_TREES = 2; -{ The minimum and maximum match lengths } -const - MIN_MATCH = 3; - MAX_MATCH = 258; - -const - PRESET_DICT = $20; { preset dictionary flag in zlib header } - - - {$IFDEF DEBUG} - procedure Assert(cond : boolean; msg : AnsiString); - {$ENDIF} - - procedure Trace(x : AnsiString); - procedure Tracev(x : AnsiString); - procedure Tracevv(x : AnsiString); - procedure Tracevvv(x : AnsiString); - procedure Tracec(c : boolean; x : AnsiString); - procedure Tracecv(c : boolean; x : AnsiString); - -function zlibVersion : AnsiString; -{ The application can compare zlibVersion and ZLIB_VERSION for consistency. - If the first character differs, the library code actually used is - not compatible with the zlib.h header file used by the application. - This check is automatically made by deflateInit and inflateInit. } - -function zError(err : int) : AnsiString; -function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf; -procedure ZFREE (var strm : z_stream; ptr : voidpf); -procedure TRY_FREE (var strm : z_stream; ptr : voidpf); - -const - ZLIB_VERSION : string[10] = '1.1.2'; - -const - z_errbase = Z_NEED_DICT; - z_errmsg : Array[0..9] of string[21] = { indexed by 2-zlib_error } - ('need dictionary', { Z_NEED_DICT 2 } - 'stream end', { Z_STREAM_END 1 } - '', { Z_OK 0 } - 'file error', { Z_ERRNO (-1) } - 'stream error', { Z_STREAM_ERROR (-2) } - 'data error', { Z_DATA_ERROR (-3) } - 'insufficient memory', { Z_MEM_ERROR (-4) } - 'buffer error', { Z_BUF_ERROR (-5) } - 'incompatible version',{ Z_VERSION_ERROR (-6) } - ''); -const - z_verbose : int = 1; - -function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString; - Stream_size: LongInt): LongInt; -function inflateInit_(var Stream: z_stream; const Version: AnsiString; - Stream_size: Longint): LongInt; - -{$IFDEF DEBUG} -procedure z_error (m : string); -{$ENDIF} - -implementation - -uses - imzdeflate, imzinflate; - -function deflateInit_(var Stream: z_stream; Level: LongInt; const Version: AnsiString; - Stream_size: LongInt): LongInt; -begin - Result := imzdeflate.deflateInit_(@Stream, Level, Version, Stream_size); -end; - -function inflateInit_(var Stream: z_stream; const Version: AnsiString; - Stream_size: Longint): LongInt; -begin - Result := imzinflate.inflateInit_(@Stream, Version, Stream_size); -end; - -function zError(err : int) : AnsiString; -begin - zError := z_errmsg[Z_NEED_DICT-err]; -end; - -function zlibVersion : AnsiString; -begin - zlibVersion := ZLIB_VERSION; -end; - -procedure z_error (m : AnsiString); -begin - WriteLn(output, m); - Write('Zlib - Halt...'); - ReadLn; - Halt(1); -end; - -procedure Assert(cond : boolean; msg : AnsiString); -begin - if not cond then - z_error(msg); -end; - -procedure Trace(x : AnsiString); -begin - WriteLn(x); -end; - -procedure Tracev(x : AnsiString); -begin - if (z_verbose>0) then - WriteLn(x); -end; - -procedure Tracevv(x : AnsiString); -begin - if (z_verbose>1) then - WriteLn(x); -end; - -procedure Tracevvv(x : AnsiString); -begin - if (z_verbose>2) then - WriteLn(x); -end; - -procedure Tracec(c : boolean; x : AnsiString); -begin - if (z_verbose>0) and (c) then - WriteLn(x); -end; - -procedure Tracecv(c : boolean; x : AnsiString); -begin - if (z_verbose>1) and c then - WriteLn(x); -end; - -function ZALLOC (var strm : z_stream; items : uInt; size : uInt) : voidpf; -begin - ZALLOC := strm.zalloc(strm.opaque, items, size); -end; - -procedure ZFREE (var strm : z_stream; ptr : voidpf); -begin - strm.zfree(strm.opaque, ptr); -end; - -procedure TRY_FREE (var strm : z_stream; ptr : voidpf); -begin - {if @strm <> Z_NULL then} - strm.zfree(strm.opaque, ptr); -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/imtrees.pas b/3rd/Imaging/Source/ZLib/imtrees.pas deleted file mode 100644 index 04c0ebf3d..000000000 --- a/3rd/Imaging/Source/ZLib/imtrees.pas +++ /dev/null @@ -1,2249 +0,0 @@ -Unit imtrees; - -{$T-} -{$define ORG_DEBUG} -{ - trees.c -- output deflated data using Huffman coding - Copyright (C) 1995-1998 Jean-loup Gailly - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -{ - * ALGORITHM - * - * The "deflation" process uses several Huffman trees. The more - * common source values are represented by shorter bit sequences. - * - * Each code tree is stored in a compressed form which is itself - * a Huffman encoding of the lengths of all the code strings (in - * ascending order by source values). The actual code strings are - * reconstructed from the lengths in the inflate process, as described - * in the deflate specification. - * - * REFERENCES - * - * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". - * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc - * - * Storer, James A. - * Data Compression: Methods and Theory, pp. 49-50. - * Computer Science Press, 1988. ISBN 0-7167-8156-5. - * - * Sedgewick, R. - * Algorithms, p290. - * Addison-Wesley, 1983. ISBN 0-201-06672-6. - } - -interface - -{$I imzconf.inc} - -uses - {$ifdef DEBUG} - SysUtils, strutils, - {$ENDIF} - imzutil, impaszlib; - -{ =========================================================================== - Internal compression state. } - -const - LENGTH_CODES = 29; -{ number of length codes, not counting the special END_BLOCK code } - - LITERALS = 256; -{ number of literal bytes 0..255 } - - L_CODES = (LITERALS+1+LENGTH_CODES); -{ number of Literal or Length codes, including the END_BLOCK code } - - D_CODES = 30; -{ number of distance codes } - - BL_CODES = 19; -{ number of codes used to transfer the bit lengths } - - HEAP_SIZE = (2*L_CODES+1); -{ maximum heap size } - - MAX_BITS = 15; -{ All codes must not exceed MAX_BITS bits } - -const - INIT_STATE = 42; - BUSY_STATE = 113; - FINISH_STATE = 666; -{ Stream status } - - -{ Data structure describing a single value and its code string. } -type - ct_data_ptr = ^ct_data; - ct_data = record - fc : record - case byte of - 0:(freq : ush); { frequency count } - 1:(code : ush); { bit string } - end; - dl : record - case byte of - 0:(dad : ush); { father node in Huffman tree } - 1:(len : ush); { length of bit string } - end; - end; - -{ Freq = fc.freq - Code = fc.code - Dad = dl.dad - Len = dl.len } - -type - ltree_type = array[0..HEAP_SIZE-1] of ct_data; { literal and length tree } - dtree_type = array[0..2*D_CODES+1-1] of ct_data; { distance tree } - htree_type = array[0..2*BL_CODES+1-1] of ct_data; { Huffman tree for bit lengths } - { generic tree type } - tree_type = array[0..(MaxInt div SizeOf(ct_data))-1] of ct_data; - - tree_ptr = ^tree_type; - ltree_ptr = ^ltree_type; - dtree_ptr = ^dtree_type; - htree_ptr = ^htree_type; - - -type - static_tree_desc_ptr = ^static_tree_desc; - static_tree_desc = - record - {const} static_tree : tree_ptr; { static tree or NIL } - {const} extra_bits : pzIntfArray; { extra bits for each code or NIL } - extra_base : int; { base index for extra_bits } - elems : int; { max number of elements in the tree } - max_length : int; { max bit length for the codes } - end; - - tree_desc_ptr = ^tree_desc; - tree_desc = record - dyn_tree : tree_ptr; { the dynamic tree } - max_code : int; { largest code with non zero frequency } - stat_desc : static_tree_desc_ptr; { the corresponding static tree } - end; - -type - Pos = ush; - Posf = Pos; {FAR} - IPos = uInt; - - pPosf = ^Posf; - - zPosfArray = array[0..(MaxInt div SizeOf(Posf))-1] of Posf; - pzPosfArray = ^zPosfArray; - -{ A Pos is an index in the character window. We use short instead of int to - save space in the various tables. IPos is used only for parameter passing.} - -type - deflate_state_ptr = ^deflate_state; - deflate_state = record - strm : z_streamp; { pointer back to this zlib stream } - status : int; { as the name implies } - pending_buf : pzByteArray; { output still pending } - pending_buf_size : ulg; { size of pending_buf } - pending_out : pBytef; { next pending byte to output to the stream } - pending : int; { nb of bytes in the pending buffer } - noheader : int; { suppress zlib header and adler32 } - data_type : Byte; { UNKNOWN, BINARY or ASCII } - method : Byte; { STORED (for zip only) or DEFLATED } - last_flush : int; { value of flush param for previous deflate call } - - { used by deflate.pas: } - - w_size : uInt; { LZ77 window size (32K by default) } - w_bits : uInt; { log2(w_size) (8..16) } - w_mask : uInt; { w_size - 1 } - - window : pzByteArray; - { Sliding window. Input bytes are read into the second half of the window, - and move to the first half later to keep a dictionary of at least wSize - bytes. With this organization, matches are limited to a distance of - wSize-MAX_MATCH bytes, but this ensures that IO is always - performed with a length multiple of the block size. Also, it limits - the window size to 64K, which is quite useful on MSDOS. - To do: use the user input buffer as sliding window. } - - window_size : ulg; - { Actual size of window: 2*wSize, except when the user input buffer - is directly used as sliding window. } - - prev : pzPosfArray; - { Link to older string with same hash index. To limit the size of this - array to 64K, this link is maintained only for the last 32K strings. - An index in this array is thus a window index modulo 32K. } - - head : pzPosfArray; { Heads of the hash chains or NIL. } - - ins_h : uInt; { hash index of string to be inserted } - hash_size : uInt; { number of elements in hash table } - hash_bits : uInt; { log2(hash_size) } - hash_mask : uInt; { hash_size-1 } - - hash_shift : uInt; - { Number of bits by which ins_h must be shifted at each input - step. It must be such that after MIN_MATCH steps, the oldest - byte no longer takes part in the hash key, that is: - hash_shift * MIN_MATCH >= hash_bits } - - block_start : long; - { Window position at the beginning of the current output block. Gets - negative when the window is moved backwards. } - - match_length : uInt; { length of best match } - prev_match : IPos; { previous match } - match_available : boolean; { set if previous match exists } - strstart : uInt; { start of string to insert } - match_start : uInt; { start of matching string } - lookahead : uInt; { number of valid bytes ahead in window } - - prev_length : uInt; - { Length of the best match at previous step. Matches not greater than this - are discarded. This is used in the lazy match evaluation. } - - max_chain_length : uInt; - { To speed up deflation, hash chains are never searched beyond this - length. A higher limit improves compression ratio but degrades the - speed. } - - { moved to the end because Borland Pascal won't accept the following: - max_lazy_match : uInt; - max_insert_length : uInt absolute max_lazy_match; - } - - level : int; { compression level (1..9) } - strategy : int; { favor or force Huffman coding} - - good_match : uInt; - { Use a faster search when the previous match is longer than this } - - nice_match : int; { Stop searching when current match exceeds this } - - { used by trees.pas: } - { Didn't use ct_data typedef below to supress compiler warning } - dyn_ltree : ltree_type; { literal and length tree } - dyn_dtree : dtree_type; { distance tree } - bl_tree : htree_type; { Huffman tree for bit lengths } - - l_desc : tree_desc; { desc. for literal tree } - d_desc : tree_desc; { desc. for distance tree } - bl_desc : tree_desc; { desc. for bit length tree } - - bl_count : array[0..MAX_BITS+1-1] of ush; - { number of codes at each bit length for an optimal tree } - - heap : array[0..2*L_CODES+1-1] of int; { heap used to build the Huffman trees } - heap_len : int; { number of elements in the heap } - heap_max : int; { element of largest frequency } - { The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. - The same heap array is used to build all trees. } - - depth : array[0..2*L_CODES+1-1] of uch; - { Depth of each subtree used as tie breaker for trees of equal frequency } - - - l_buf : puchfArray; { buffer for literals or lengths } - - lit_bufsize : uInt; - { Size of match buffer for literals/lengths. There are 4 reasons for - limiting lit_bufsize to 64K: - - frequencies can be kept in 16 bit counters - - if compression is not successful for the first block, all input - data is still in the window so we can still emit a stored block even - when input comes from standard input. (This can also be done for - all blocks if lit_bufsize is not greater than 32K.) - - if compression is not successful for a file smaller than 64K, we can - even emit a stored file instead of a stored block (saving 5 bytes). - This is applicable only for zip (not gzip or zlib). - - creating new Huffman trees less frequently may not provide fast - adaptation to changes in the input data statistics. (Take for - example a binary file with poorly compressible code followed by - a highly compressible string table.) Smaller buffer sizes give - fast adaptation but have of course the overhead of transmitting - trees more frequently. - - I can't count above 4 } - - - last_lit : uInt; { running index in l_buf } - - d_buf : pushfArray; - { Buffer for distances. To simplify the code, d_buf and l_buf have - the same number of elements. To use different lengths, an extra flag - array would be necessary. } - - opt_len : ulg; { bit length of current block with optimal trees } - static_len : ulg; { bit length of current block with static trees } - compressed_len : ulg; { total bit length of compressed file } - matches : uInt; { number of string matches in current block } - last_eob_len : int; { bit length of EOB code for last block } - -{$ifdef DEBUG} - bits_sent : ulg; { bit length of the compressed data } -{$endif} - - bi_buf : ush; - { Output buffer. bits are inserted starting at the bottom (least - significant bits). } - - bi_valid : int; - { Number of valid bits in bi_buf. All bits above the last valid bit - are always zero. } - - case byte of - 0:(max_lazy_match : uInt); - { Attempt to find a better match only when the current match is strictly - smaller than this value. This mechanism is used only for compression - levels >= 4. } - - 1:(max_insert_length : uInt); - { Insert new strings in the hash table only if the match length is not - greater than this length. This saves time but degrades compression. - max_insert_length is used only for compression levels <= 3. } - end; - -procedure _tr_init (var s : deflate_state); - -function _tr_tally (var s : deflate_state; - dist : unsigned; - lc : unsigned) : boolean; - -function _tr_flush_block (var s : deflate_state; - buf : pcharf; - stored_len : ulg; - eof : boolean) : ulg; - -procedure _tr_align(var s : deflate_state); - -procedure _tr_stored_block(var s : deflate_state; - buf : pcharf; - stored_len : ulg; - eof : boolean); - -implementation - -{ #define GEN_TREES_H } - -{$ifndef GEN_TREES_H} -{ header created automatically with -DGEN_TREES_H } - -const - DIST_CODE_LEN = 512; { see definition of array dist_code below } - -{ The static literal tree. Since the bit lengths are imposed, there is no - need for the L_CODES extra codes used during heap construction. However - The codes 286 and 287 are needed to build a canonical tree (see _tr_init - below). } -var - static_ltree : array[0..L_CODES+2-1] of ct_data = ( -{ fc:(freq, code) dl:(dad,len) } -(fc:(freq: 12);dl:(len: 8)), (fc:(freq:140);dl:(len: 8)), (fc:(freq: 76);dl:(len: 8)), -(fc:(freq:204);dl:(len: 8)), (fc:(freq: 44);dl:(len: 8)), (fc:(freq:172);dl:(len: 8)), -(fc:(freq:108);dl:(len: 8)), (fc:(freq:236);dl:(len: 8)), (fc:(freq: 28);dl:(len: 8)), -(fc:(freq:156);dl:(len: 8)), (fc:(freq: 92);dl:(len: 8)), (fc:(freq:220);dl:(len: 8)), -(fc:(freq: 60);dl:(len: 8)), (fc:(freq:188);dl:(len: 8)), (fc:(freq:124);dl:(len: 8)), -(fc:(freq:252);dl:(len: 8)), (fc:(freq: 2);dl:(len: 8)), (fc:(freq:130);dl:(len: 8)), -(fc:(freq: 66);dl:(len: 8)), (fc:(freq:194);dl:(len: 8)), (fc:(freq: 34);dl:(len: 8)), -(fc:(freq:162);dl:(len: 8)), (fc:(freq: 98);dl:(len: 8)), (fc:(freq:226);dl:(len: 8)), -(fc:(freq: 18);dl:(len: 8)), (fc:(freq:146);dl:(len: 8)), (fc:(freq: 82);dl:(len: 8)), -(fc:(freq:210);dl:(len: 8)), (fc:(freq: 50);dl:(len: 8)), (fc:(freq:178);dl:(len: 8)), -(fc:(freq:114);dl:(len: 8)), (fc:(freq:242);dl:(len: 8)), (fc:(freq: 10);dl:(len: 8)), -(fc:(freq:138);dl:(len: 8)), (fc:(freq: 74);dl:(len: 8)), (fc:(freq:202);dl:(len: 8)), -(fc:(freq: 42);dl:(len: 8)), (fc:(freq:170);dl:(len: 8)), (fc:(freq:106);dl:(len: 8)), -(fc:(freq:234);dl:(len: 8)), (fc:(freq: 26);dl:(len: 8)), (fc:(freq:154);dl:(len: 8)), -(fc:(freq: 90);dl:(len: 8)), (fc:(freq:218);dl:(len: 8)), (fc:(freq: 58);dl:(len: 8)), -(fc:(freq:186);dl:(len: 8)), (fc:(freq:122);dl:(len: 8)), (fc:(freq:250);dl:(len: 8)), -(fc:(freq: 6);dl:(len: 8)), (fc:(freq:134);dl:(len: 8)), (fc:(freq: 70);dl:(len: 8)), -(fc:(freq:198);dl:(len: 8)), (fc:(freq: 38);dl:(len: 8)), (fc:(freq:166);dl:(len: 8)), -(fc:(freq:102);dl:(len: 8)), (fc:(freq:230);dl:(len: 8)), (fc:(freq: 22);dl:(len: 8)), -(fc:(freq:150);dl:(len: 8)), (fc:(freq: 86);dl:(len: 8)), (fc:(freq:214);dl:(len: 8)), -(fc:(freq: 54);dl:(len: 8)), (fc:(freq:182);dl:(len: 8)), (fc:(freq:118);dl:(len: 8)), -(fc:(freq:246);dl:(len: 8)), (fc:(freq: 14);dl:(len: 8)), (fc:(freq:142);dl:(len: 8)), -(fc:(freq: 78);dl:(len: 8)), (fc:(freq:206);dl:(len: 8)), (fc:(freq: 46);dl:(len: 8)), -(fc:(freq:174);dl:(len: 8)), (fc:(freq:110);dl:(len: 8)), (fc:(freq:238);dl:(len: 8)), -(fc:(freq: 30);dl:(len: 8)), (fc:(freq:158);dl:(len: 8)), (fc:(freq: 94);dl:(len: 8)), -(fc:(freq:222);dl:(len: 8)), (fc:(freq: 62);dl:(len: 8)), (fc:(freq:190);dl:(len: 8)), -(fc:(freq:126);dl:(len: 8)), (fc:(freq:254);dl:(len: 8)), (fc:(freq: 1);dl:(len: 8)), -(fc:(freq:129);dl:(len: 8)), (fc:(freq: 65);dl:(len: 8)), (fc:(freq:193);dl:(len: 8)), -(fc:(freq: 33);dl:(len: 8)), (fc:(freq:161);dl:(len: 8)), (fc:(freq: 97);dl:(len: 8)), -(fc:(freq:225);dl:(len: 8)), (fc:(freq: 17);dl:(len: 8)), (fc:(freq:145);dl:(len: 8)), -(fc:(freq: 81);dl:(len: 8)), (fc:(freq:209);dl:(len: 8)), (fc:(freq: 49);dl:(len: 8)), -(fc:(freq:177);dl:(len: 8)), (fc:(freq:113);dl:(len: 8)), (fc:(freq:241);dl:(len: 8)), -(fc:(freq: 9);dl:(len: 8)), (fc:(freq:137);dl:(len: 8)), (fc:(freq: 73);dl:(len: 8)), -(fc:(freq:201);dl:(len: 8)), (fc:(freq: 41);dl:(len: 8)), (fc:(freq:169);dl:(len: 8)), -(fc:(freq:105);dl:(len: 8)), (fc:(freq:233);dl:(len: 8)), (fc:(freq: 25);dl:(len: 8)), -(fc:(freq:153);dl:(len: 8)), (fc:(freq: 89);dl:(len: 8)), (fc:(freq:217);dl:(len: 8)), -(fc:(freq: 57);dl:(len: 8)), (fc:(freq:185);dl:(len: 8)), (fc:(freq:121);dl:(len: 8)), -(fc:(freq:249);dl:(len: 8)), (fc:(freq: 5);dl:(len: 8)), (fc:(freq:133);dl:(len: 8)), -(fc:(freq: 69);dl:(len: 8)), (fc:(freq:197);dl:(len: 8)), (fc:(freq: 37);dl:(len: 8)), -(fc:(freq:165);dl:(len: 8)), (fc:(freq:101);dl:(len: 8)), (fc:(freq:229);dl:(len: 8)), -(fc:(freq: 21);dl:(len: 8)), (fc:(freq:149);dl:(len: 8)), (fc:(freq: 85);dl:(len: 8)), -(fc:(freq:213);dl:(len: 8)), (fc:(freq: 53);dl:(len: 8)), (fc:(freq:181);dl:(len: 8)), -(fc:(freq:117);dl:(len: 8)), (fc:(freq:245);dl:(len: 8)), (fc:(freq: 13);dl:(len: 8)), -(fc:(freq:141);dl:(len: 8)), (fc:(freq: 77);dl:(len: 8)), (fc:(freq:205);dl:(len: 8)), -(fc:(freq: 45);dl:(len: 8)), (fc:(freq:173);dl:(len: 8)), (fc:(freq:109);dl:(len: 8)), -(fc:(freq:237);dl:(len: 8)), (fc:(freq: 29);dl:(len: 8)), (fc:(freq:157);dl:(len: 8)), -(fc:(freq: 93);dl:(len: 8)), (fc:(freq:221);dl:(len: 8)), (fc:(freq: 61);dl:(len: 8)), -(fc:(freq:189);dl:(len: 8)), (fc:(freq:125);dl:(len: 8)), (fc:(freq:253);dl:(len: 8)), -(fc:(freq: 19);dl:(len: 9)), (fc:(freq:275);dl:(len: 9)), (fc:(freq:147);dl:(len: 9)), -(fc:(freq:403);dl:(len: 9)), (fc:(freq: 83);dl:(len: 9)), (fc:(freq:339);dl:(len: 9)), -(fc:(freq:211);dl:(len: 9)), (fc:(freq:467);dl:(len: 9)), (fc:(freq: 51);dl:(len: 9)), -(fc:(freq:307);dl:(len: 9)), (fc:(freq:179);dl:(len: 9)), (fc:(freq:435);dl:(len: 9)), -(fc:(freq:115);dl:(len: 9)), (fc:(freq:371);dl:(len: 9)), (fc:(freq:243);dl:(len: 9)), -(fc:(freq:499);dl:(len: 9)), (fc:(freq: 11);dl:(len: 9)), (fc:(freq:267);dl:(len: 9)), -(fc:(freq:139);dl:(len: 9)), (fc:(freq:395);dl:(len: 9)), (fc:(freq: 75);dl:(len: 9)), -(fc:(freq:331);dl:(len: 9)), (fc:(freq:203);dl:(len: 9)), (fc:(freq:459);dl:(len: 9)), -(fc:(freq: 43);dl:(len: 9)), (fc:(freq:299);dl:(len: 9)), (fc:(freq:171);dl:(len: 9)), -(fc:(freq:427);dl:(len: 9)), (fc:(freq:107);dl:(len: 9)), (fc:(freq:363);dl:(len: 9)), -(fc:(freq:235);dl:(len: 9)), (fc:(freq:491);dl:(len: 9)), (fc:(freq: 27);dl:(len: 9)), -(fc:(freq:283);dl:(len: 9)), (fc:(freq:155);dl:(len: 9)), (fc:(freq:411);dl:(len: 9)), -(fc:(freq: 91);dl:(len: 9)), (fc:(freq:347);dl:(len: 9)), (fc:(freq:219);dl:(len: 9)), -(fc:(freq:475);dl:(len: 9)), (fc:(freq: 59);dl:(len: 9)), (fc:(freq:315);dl:(len: 9)), -(fc:(freq:187);dl:(len: 9)), (fc:(freq:443);dl:(len: 9)), (fc:(freq:123);dl:(len: 9)), -(fc:(freq:379);dl:(len: 9)), (fc:(freq:251);dl:(len: 9)), (fc:(freq:507);dl:(len: 9)), -(fc:(freq: 7);dl:(len: 9)), (fc:(freq:263);dl:(len: 9)), (fc:(freq:135);dl:(len: 9)), -(fc:(freq:391);dl:(len: 9)), (fc:(freq: 71);dl:(len: 9)), (fc:(freq:327);dl:(len: 9)), -(fc:(freq:199);dl:(len: 9)), (fc:(freq:455);dl:(len: 9)), (fc:(freq: 39);dl:(len: 9)), -(fc:(freq:295);dl:(len: 9)), (fc:(freq:167);dl:(len: 9)), (fc:(freq:423);dl:(len: 9)), -(fc:(freq:103);dl:(len: 9)), (fc:(freq:359);dl:(len: 9)), (fc:(freq:231);dl:(len: 9)), -(fc:(freq:487);dl:(len: 9)), (fc:(freq: 23);dl:(len: 9)), (fc:(freq:279);dl:(len: 9)), -(fc:(freq:151);dl:(len: 9)), (fc:(freq:407);dl:(len: 9)), (fc:(freq: 87);dl:(len: 9)), -(fc:(freq:343);dl:(len: 9)), (fc:(freq:215);dl:(len: 9)), (fc:(freq:471);dl:(len: 9)), -(fc:(freq: 55);dl:(len: 9)), (fc:(freq:311);dl:(len: 9)), (fc:(freq:183);dl:(len: 9)), -(fc:(freq:439);dl:(len: 9)), (fc:(freq:119);dl:(len: 9)), (fc:(freq:375);dl:(len: 9)), -(fc:(freq:247);dl:(len: 9)), (fc:(freq:503);dl:(len: 9)), (fc:(freq: 15);dl:(len: 9)), -(fc:(freq:271);dl:(len: 9)), (fc:(freq:143);dl:(len: 9)), (fc:(freq:399);dl:(len: 9)), -(fc:(freq: 79);dl:(len: 9)), (fc:(freq:335);dl:(len: 9)), (fc:(freq:207);dl:(len: 9)), -(fc:(freq:463);dl:(len: 9)), (fc:(freq: 47);dl:(len: 9)), (fc:(freq:303);dl:(len: 9)), -(fc:(freq:175);dl:(len: 9)), (fc:(freq:431);dl:(len: 9)), (fc:(freq:111);dl:(len: 9)), -(fc:(freq:367);dl:(len: 9)), (fc:(freq:239);dl:(len: 9)), (fc:(freq:495);dl:(len: 9)), -(fc:(freq: 31);dl:(len: 9)), (fc:(freq:287);dl:(len: 9)), (fc:(freq:159);dl:(len: 9)), -(fc:(freq:415);dl:(len: 9)), (fc:(freq: 95);dl:(len: 9)), (fc:(freq:351);dl:(len: 9)), -(fc:(freq:223);dl:(len: 9)), (fc:(freq:479);dl:(len: 9)), (fc:(freq: 63);dl:(len: 9)), -(fc:(freq:319);dl:(len: 9)), (fc:(freq:191);dl:(len: 9)), (fc:(freq:447);dl:(len: 9)), -(fc:(freq:127);dl:(len: 9)), (fc:(freq:383);dl:(len: 9)), (fc:(freq:255);dl:(len: 9)), -(fc:(freq:511);dl:(len: 9)), (fc:(freq: 0);dl:(len: 7)), (fc:(freq: 64);dl:(len: 7)), -(fc:(freq: 32);dl:(len: 7)), (fc:(freq: 96);dl:(len: 7)), (fc:(freq: 16);dl:(len: 7)), -(fc:(freq: 80);dl:(len: 7)), (fc:(freq: 48);dl:(len: 7)), (fc:(freq:112);dl:(len: 7)), -(fc:(freq: 8);dl:(len: 7)), (fc:(freq: 72);dl:(len: 7)), (fc:(freq: 40);dl:(len: 7)), -(fc:(freq:104);dl:(len: 7)), (fc:(freq: 24);dl:(len: 7)), (fc:(freq: 88);dl:(len: 7)), -(fc:(freq: 56);dl:(len: 7)), (fc:(freq:120);dl:(len: 7)), (fc:(freq: 4);dl:(len: 7)), -(fc:(freq: 68);dl:(len: 7)), (fc:(freq: 36);dl:(len: 7)), (fc:(freq:100);dl:(len: 7)), -(fc:(freq: 20);dl:(len: 7)), (fc:(freq: 84);dl:(len: 7)), (fc:(freq: 52);dl:(len: 7)), -(fc:(freq:116);dl:(len: 7)), (fc:(freq: 3);dl:(len: 8)), (fc:(freq:131);dl:(len: 8)), -(fc:(freq: 67);dl:(len: 8)), (fc:(freq:195);dl:(len: 8)), (fc:(freq: 35);dl:(len: 8)), -(fc:(freq:163);dl:(len: 8)), (fc:(freq: 99);dl:(len: 8)), (fc:(freq:227);dl:(len: 8)) -); - - -{ The static distance tree. (Actually a trivial tree since all lens use - 5 bits.) } - static_dtree : array[0..D_CODES-1] of ct_data = ( -(fc:(freq: 0); dl:(len:5)), (fc:(freq:16); dl:(len:5)), (fc:(freq: 8); dl:(len:5)), -(fc:(freq:24); dl:(len:5)), (fc:(freq: 4); dl:(len:5)), (fc:(freq:20); dl:(len:5)), -(fc:(freq:12); dl:(len:5)), (fc:(freq:28); dl:(len:5)), (fc:(freq: 2); dl:(len:5)), -(fc:(freq:18); dl:(len:5)), (fc:(freq:10); dl:(len:5)), (fc:(freq:26); dl:(len:5)), -(fc:(freq: 6); dl:(len:5)), (fc:(freq:22); dl:(len:5)), (fc:(freq:14); dl:(len:5)), -(fc:(freq:30); dl:(len:5)), (fc:(freq: 1); dl:(len:5)), (fc:(freq:17); dl:(len:5)), -(fc:(freq: 9); dl:(len:5)), (fc:(freq:25); dl:(len:5)), (fc:(freq: 5); dl:(len:5)), -(fc:(freq:21); dl:(len:5)), (fc:(freq:13); dl:(len:5)), (fc:(freq:29); dl:(len:5)), -(fc:(freq: 3); dl:(len:5)), (fc:(freq:19); dl:(len:5)), (fc:(freq:11); dl:(len:5)), -(fc:(freq:27); dl:(len:5)), (fc:(freq: 7); dl:(len:5)), (fc:(freq:23); dl:(len:5)) -); - -{ Distance codes. The first 256 values correspond to the distances - 3 .. 258, the last 256 values correspond to the top 8 bits of - the 15 bit distances. } - _dist_code : array[0..DIST_CODE_LEN-1] of uch = ( - 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, - 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, -10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, -11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, -12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, -13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, -13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, -14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, -14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, -14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, -15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, -15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, -15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, -18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, -23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, -24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, -26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, -26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, -27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, -27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, -28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, -28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, -28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, -29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, -29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, -29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 -); - -{ length code for each normalized match length (0 == MIN_MATCH) } - _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch = ( - 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, -13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, -17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, -19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, -21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, -22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, -23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, -24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, -25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, -25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, -26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, -26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, -27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 -); - - -{ First normalized length for each code (0 = MIN_MATCH) } - base_length : array[0..LENGTH_CODES-1] of int = ( -0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, -64, 80, 96, 112, 128, 160, 192, 224, 0 -); - - -{ First normalized distance for each code (0 = distance of 1) } - base_dist : array[0..D_CODES-1] of int = ( - 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, - 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, - 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 -); -{$endif} - -{ Output a byte on the stream. - IN assertion: there is enough room in pending_buf. -macro put_byte(s, c) -begin - s^.pending_buf^[s^.pending] := (c); - Inc(s^.pending); -end -} - -const - MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1); -{ Minimum amount of lookahead, except at the end of the input file. - See deflate.c for comments about the MIN_MATCH+1. } - -{macro d_code(dist) - if (dist) < 256 then - := _dist_code[dist] - else - := _dist_code[256+((dist) shr 7)]); - Mapping from a distance to a distance code. dist is the distance - 1 and - must not have side effects. _dist_code[256] and _dist_code[257] are never - used. } - -{$ifndef ORG_DEBUG} -{ Inline versions of _tr_tally for speed: } - -#if defined(GEN_TREES_H) || !defined(STDC) - extern uch _length_code[]; - extern uch _dist_code[]; -#else - extern const uch _length_code[]; - extern const uch _dist_code[]; -#endif - -macro _tr_tally_lit(s, c, flush) -var - cc : uch; -begin - cc := (c); - s^.d_buf[s^.last_lit] := 0; - s^.l_buf[s^.last_lit] := cc; - Inc(s^.last_lit); - Inc(s^.dyn_ltree[cc].fc.Freq); - flush := (s^.last_lit = s^.lit_bufsize-1); -end; - -macro _tr_tally_dist(s, distance, length, flush) \ -var - len : uch; - dist : ush; -begin - len := (length); - dist := (distance); - s^.d_buf[s^.last_lit] := dist; - s^.l_buf[s^.last_lit] = len; - Inc(s^.last_lit); - Dec(dist); - Inc(s^.dyn_ltree[_length_code[len]+LITERALS+1].fc.Freq); - Inc(s^.dyn_dtree[d_code(dist)].Freq); - flush := (s^.last_lit = s^.lit_bufsize-1); -end; - -{$endif} - -{ =========================================================================== - Constants } - -const - MAX_BL_BITS = 7; -{ Bit length codes must not exceed MAX_BL_BITS bits } - -const - END_BLOCK = 256; -{ end of block literal code } - -const - REP_3_6 = 16; -{ repeat previous bit length 3-6 times (2 bits of repeat count) } - -const - REPZ_3_10 = 17; -{ repeat a zero length 3-10 times (3 bits of repeat count) } - -const - REPZ_11_138 = 18; -{ repeat a zero length 11-138 times (7 bits of repeat count) } - -{local} -const - extra_lbits : array[0..LENGTH_CODES-1] of int - { extra bits for each length code } - = (0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0); - -{local} -const - extra_dbits : array[0..D_CODES-1] of int - { extra bits for each distance code } - = (0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13); - -{local} -const - extra_blbits : array[0..BL_CODES-1] of int { extra bits for each bit length code } - = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7); - -{local} -const - bl_order : array[0..BL_CODES-1] of uch - = (16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15); -{ The lengths of the bit length codes are sent in order of decreasing - probability, to avoid transmitting the lengths for unused bit length codes. - } - -const - Buf_size = (8 * 2*sizeof(uch)); -{ Number of bits used within bi_buf. (bi_buf might be implemented on - more than 16 bits on some systems.) } - -{ =========================================================================== - Local data. These are initialized only once. } - - -{$ifdef GEN_TREES_H)} -{ non ANSI compilers may not accept trees.h } - -const - DIST_CODE_LEN = 512; { see definition of array dist_code below } - -{local} -var - static_ltree : array[0..L_CODES+2-1] of ct_data; -{ The static literal tree. Since the bit lengths are imposed, there is no - need for the L_CODES extra codes used during heap construction. However - The codes 286 and 287 are needed to build a canonical tree (see _tr_init - below). } - -{local} - static_dtree : array[0..D_CODES-1] of ct_data; -{ The static distance tree. (Actually a trivial tree since all codes use - 5 bits.) } - - _dist_code : array[0..DIST_CODE_LEN-1] of uch; -{ Distance codes. The first 256 values correspond to the distances - 3 .. 258, the last 256 values correspond to the top 8 bits of - the 15 bit distances. } - - _length_code : array[0..MAX_MATCH-MIN_MATCH+1-1] of uch; -{ length code for each normalized match length (0 == MIN_MATCH) } - -{local} - base_length : array[0..LENGTH_CODES-1] of int; -{ First normalized length for each code (0 = MIN_MATCH) } - -{local} - base_dist : array[0..D_CODES-1] of int; -{ First normalized distance for each code (0 = distance of 1) } - -{$endif} { GEN_TREES_H } - -{local} -const - static_l_desc : static_tree_desc = - (static_tree: {tree_ptr}(@(static_ltree)); { pointer to array of ct_data } - extra_bits: {pzIntfArray}(@(extra_lbits)); { pointer to array of int } - extra_base: LITERALS+1; - elems: L_CODES; - max_length: MAX_BITS); - -{local} -const - static_d_desc : static_tree_desc = - (static_tree: {tree_ptr}(@(static_dtree)); - extra_bits: {pzIntfArray}(@(extra_dbits)); - extra_base : 0; - elems: D_CODES; - max_length: MAX_BITS); - -{local} -const - static_bl_desc : static_tree_desc = - (static_tree: {tree_ptr}(NIL); - extra_bits: {pzIntfArray}@(extra_blbits); - extra_base : 0; - elems: BL_CODES; - max_length: MAX_BL_BITS); - -(* =========================================================================== - Local (static) routines in this file. } - -procedure tr_static_init; -procedure init_block(var deflate_state); -procedure pqdownheap(var s : deflate_state; - var tree : ct_data; - k : int); -procedure gen_bitlen(var s : deflate_state; - var desc : tree_desc); -procedure gen_codes(var tree : ct_data; - max_code : int; - bl_count : pushf); -procedure build_tree(var s : deflate_state; - var desc : tree_desc); -procedure scan_tree(var s : deflate_state; - var tree : ct_data; - max_code : int); -procedure send_tree(var s : deflate_state; - var tree : ct_data; - max_code : int); -function build_bl_tree(var deflate_state) : int; -procedure send_all_trees(var deflate_state; - lcodes : int; - dcodes : int; - blcodes : int); -procedure compress_block(var s : deflate_state; - var ltree : ct_data; - var dtree : ct_data); -procedure set_data_type(var s : deflate_state); -function bi_reverse(value : unsigned; - length : int) : unsigned; -procedure bi_windup(var deflate_state); -procedure bi_flush(var deflate_state); -procedure copy_block(var deflate_state; - buf : pcharf; - len : unsigned; - header : int); -*) - -{$ifdef GEN_TREES_H} -{local} -procedure gen_trees_header; -{$endif} - -(* -{ =========================================================================== - Output a short LSB first on the stream. - IN assertion: there is enough room in pendingBuf. } - -macro put_short(s, w) -begin - {put_byte(s, (uch)((w) & 0xff));} - s.pending_buf^[s.pending] := uch((w) and $ff); - Inc(s.pending); - - {put_byte(s, (uch)((ush)(w) >> 8));} - s.pending_buf^[s.pending] := uch(ush(w) shr 8);; - Inc(s.pending); -end -*) - -{ =========================================================================== - Send a value on a given number of bits. - IN assertion: length <= 16 and value fits in length bits. } - -{$ifdef ORG_DEBUG} - -{local} -procedure send_bits(var s : deflate_state; - value : int; { value to send } - length : int); { number of bits } -begin - {$ifdef DEBUG} - Tracevv(' l '+IntToStr(length)+ ' v '+IntToStr(value)); - Assert((length > 0) and (length <= 15), 'invalid length'); - Inc(s.bits_sent, ulg(length)); - {$ENDIF} - - { If not enough room in bi_buf, use (valid) bits from bi_buf and - (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) - unused bits in value. } - {$IFOPT Q+} {$Q-} {$DEFINE NoOverflowCheck} {$ENDIF} - {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF} - if (s.bi_valid > int(Buf_size) - length) then - begin - s.bi_buf := s.bi_buf or int(value shl s.bi_valid); - {put_short(s, s.bi_buf);} - s.pending_buf^[s.pending] := uch(s.bi_buf and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);; - Inc(s.pending); - - s.bi_buf := ush(value) shr (Buf_size - s.bi_valid); - Inc(s.bi_valid, length - Buf_size); - end - else - begin - s.bi_buf := s.bi_buf or int(value shl s.bi_valid); - Inc(s.bi_valid, length); - end; - {$IFDEF NoOverflowCheck} {$Q+} {$UNDEF NoOverflowCheck} {$ENDIF} - {$IFDEF NoRangeCheck} {$Q+} {$UNDEF NoRangeCheck} {$ENDIF} -end; - -{$else} { !DEBUG } - - -macro send_code(s, c, tree) -begin - send_bits(s, tree[c].Code, tree[c].Len); - { Send a code of the given tree. c and tree must not have side effects } -end - -macro send_bits(s, value, length) \ -begin int len := length;\ - if (s^.bi_valid > (int)Buf_size - len) begin\ - int val := value;\ - s^.bi_buf |= (val << s^.bi_valid);\ - {put_short(s, s.bi_buf);} - s.pending_buf^[s.pending] := uch(s.bi_buf and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);; - Inc(s.pending); - - s^.bi_buf := (ush)val >> (Buf_size - s^.bi_valid);\ - s^.bi_valid += len - Buf_size;\ - end else begin\ - s^.bi_buf |= (value) << s^.bi_valid;\ - s^.bi_valid += len;\ - end\ -end; -{$endif} { DEBUG } - -{ =========================================================================== - Reverse the first len bits of a code, using straightforward code (a faster - method would use a table) - IN assertion: 1 <= len <= 15 } - -{local} -function bi_reverse(code : unsigned; { the value to invert } - len : int) : unsigned; { its bit length } - -var - res : unsigned; {register} -begin - res := 0; - repeat - res := res or (code and 1); - code := code shr 1; - res := res shl 1; - Dec(len); - until (len <= 0); - bi_reverse := res shr 1; -end; - -{ =========================================================================== - Generate the codes for a given tree and bit counts (which need not be - optimal). - IN assertion: the array bl_count contains the bit length statistics for - the given tree and the field len is set for all tree elements. - OUT assertion: the field code is set for all tree elements of non - zero code length. } - -{local} -procedure gen_codes(tree : tree_ptr; { the tree to decorate } - max_code : int; { largest code with non zero frequency } - var bl_count : array of ushf); { number of codes at each bit length } - -var - next_code : array[0..MAX_BITS+1-1] of ush; { next code value for each bit length } - code : ush; { running code value } - bits : int; { bit index } - n : int; { code index } -var - len : int; -begin - code := 0; - - { The distribution counts are first used to generate the code values - without bit reversal. } - - for bits := 1 to MAX_BITS do - begin - code := ((code + bl_count[bits-1]) shl 1); - next_code[bits] := code; - end; - { Check that the bit counts in bl_count are consistent. The last code - must be all ones. } - - {$IFDEF DEBUG} - Assert (code + bl_count[MAX_BITS]-1 = (1 shl MAX_BITS)-1, - 'inconsistent bit counts'); - Tracev(#13'gen_codes: max_code '+IntToStr(max_code)); - {$ENDIF} - - for n := 0 to max_code do - begin - len := tree^[n].dl.Len; - if (len = 0) then - continue; - { Now reverse the bits } - tree^[n].fc.Code := bi_reverse(next_code[len], len); - Inc(next_code[len]); - {$ifdef DEBUG} - if (n>31) and (n<128) then - Tracecv(tree <> tree_ptr(@static_ltree), - (^M'n #'+IntToStr(n)+' '+AnsiChar(n)+' l '+IntToStr(len)+' c '+ - IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')')) - else - Tracecv(tree <> tree_ptr(@static_ltree), - (^M'n #'+IntToStr(n)+' l '+IntToStr(len)+' c '+ - IntToStr(tree^[n].fc.Code)+' ('+IntToStr(next_code[len]-1)+')')); - {$ENDIF} - end; -end; - -{ =========================================================================== - Genererate the file trees.h describing the static trees. } -{$ifdef GEN_TREES_H} - -macro SEPARATOR(i, last, width) - if (i) = (last) then - ( ^M');'^M^M - else \ - if (i) mod (width) = (width)-1 then - ','^M - else - ', ' - -procedure gen_trees_header; -var - header : system.text; - i : int; -begin - system.assign(header, 'trees.inc'); - {$I-} - ReWrite(header); - {$I+} - Assert (IOresult <> 0, 'Can''t open trees.h'); - WriteLn(header, - '{ header created automatically with -DGEN_TREES_H }'^M); - - WriteLn(header, 'local const ct_data static_ltree[L_CODES+2] := ('); - for i := 0 to L_CODES+2-1 do - begin - WriteLn(header, '((%3u),(%3u))%s', static_ltree[i].Code, - static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); - end; - - WriteLn(header, 'local const ct_data static_dtree[D_CODES] := ('); - for i := 0 to D_CODES-1 do - begin - WriteLn(header, '((%2u),(%2u))%s', static_dtree[i].Code, - static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); - end; - - WriteLn(header, 'const uch _dist_code[DIST_CODE_LEN] := ('); - for i := 0 to DIST_CODE_LEN-1 do - begin - WriteLn(header, '%2u%s', _dist_code[i], - SEPARATOR(i, DIST_CODE_LEN-1, 20)); - end; - - WriteLn(header, 'const uch _length_code[MAX_MATCH-MIN_MATCH+1]= ('); - for i := 0 to MAX_MATCH-MIN_MATCH+1-1 do - begin - WriteLn(header, '%2u%s', _length_code[i], - SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); - end; - - WriteLn(header, 'local const int base_length[LENGTH_CODES] := ('); - for i := 0 to LENGTH_CODES-1 do - begin - WriteLn(header, '%1u%s', base_length[i], - SEPARATOR(i, LENGTH_CODES-1, 20)); - end; - - WriteLn(header, 'local const int base_dist[D_CODES] := ('); - for i := 0 to D_CODES-1 do - begin - WriteLn(header, '%5u%s', base_dist[i], - SEPARATOR(i, D_CODES-1, 10)); - end; - - close(header); -end; -{$endif} { GEN_TREES_H } - - -{ =========================================================================== - Initialize the various 'constant' tables. } - -{local} -procedure tr_static_init; - -{$ifdef GEN_TREES_H} -const - static_init_done : boolean = FALSE; -var - n : int; { iterates over tree elements } - bits : int; { bit counter } - length : int; { length value } - code : int; { code value } - dist : int; { distance index } - bl_count : array[0..MAX_BITS+1-1] of ush; - { number of codes at each bit length for an optimal tree } -begin - if (static_init_done) then - exit; - - { Initialize the mapping length (0..255) -> length code (0..28) } - length := 0; - for code := 0 to LENGTH_CODES-1-1 do - begin - base_length[code] := length; - for n := 0 to (1 shl extra_lbits[code])-1 do - begin - _length_code[length] := uch(code); - Inc(length); - end; - end; - Assert (length = 256, 'tr_static_init: length <> 256'); - { Note that the length 255 (match length 258) can be represented - in two different ways: code 284 + 5 bits or code 285, so we - overwrite length_code[255] to use the best encoding: } - - _length_code[length-1] := uch(code); - - { Initialize the mapping dist (0..32K) -> dist code (0..29) } - dist := 0; - for code := 0 to 16-1 do - begin - base_dist[code] := dist; - for n := 0 to (1 shl extra_dbits[code])-1 do - begin - _dist_code[dist] := uch(code); - Inc(dist); - end; - end; - Assert (dist = 256, 'tr_static_init: dist <> 256'); - dist := dist shr 7; { from now on, all distances are divided by 128 } - for code := 16 to D_CODES-1 do - begin - base_dist[code] := dist shl 7; - for n := 0 to (1 shl (extra_dbits[code]-7))-1 do - begin - _dist_code[256 + dist] := uch(code); - Inc(dist); - end; - end; - Assert (dist = 256, 'tr_static_init: 256+dist <> 512'); - - { Construct the codes of the static literal tree } - for bits := 0 to MAX_BITS do - bl_count[bits] := 0; - n := 0; - while (n <= 143) do - begin - static_ltree[n].dl.Len := 8; - Inc(n); - Inc(bl_count[8]); - end; - while (n <= 255) do - begin - static_ltree[n].dl.Len := 9; - Inc(n); - Inc(bl_count[9]); - end; - while (n <= 279) do - begin - static_ltree[n].dl.Len := 7; - Inc(n); - Inc(bl_count[7]); - end; - while (n <= 287) do - begin - static_ltree[n].dl.Len := 8; - Inc(n); - Inc(bl_count[8]); - end; - - { Codes 286 and 287 do not exist, but we must include them in the - tree construction to get a canonical Huffman tree (longest code - all ones) } - - gen_codes(tree_ptr(@static_ltree), L_CODES+1, bl_count); - - { The static distance tree is trivial: } - for n := 0 to D_CODES-1 do - begin - static_dtree[n].dl.Len := 5; - static_dtree[n].fc.Code := bi_reverse(unsigned(n), 5); - end; - static_init_done := TRUE; - - gen_trees_header; { save to include file } -{$else} -begin -{$endif} { GEN_TREES_H) } -end; - -{ =========================================================================== - Initialize a new block. } -{local} - -procedure init_block(var s : deflate_state); -var - n : int; { iterates over tree elements } -begin - { Initialize the trees. } - for n := 0 to L_CODES-1 do - s.dyn_ltree[n].fc.Freq := 0; - for n := 0 to D_CODES-1 do - s.dyn_dtree[n].fc.Freq := 0; - for n := 0 to BL_CODES-1 do - s.bl_tree[n].fc.Freq := 0; - - s.dyn_ltree[END_BLOCK].fc.Freq := 1; - s.static_len := Long(0); - s.opt_len := Long(0); - s.matches := 0; - s.last_lit := 0; -end; - -const - SMALLEST = 1; -{ Index within the heap array of least frequent node in the Huffman tree } - -{ =========================================================================== - Initialize the tree data structures for a new zlib stream. } -procedure _tr_init(var s : deflate_state); -begin - tr_static_init; - - s.compressed_len := Long(0); - - s.l_desc.dyn_tree := tree_ptr(@s.dyn_ltree); - s.l_desc.stat_desc := @static_l_desc; - - s.d_desc.dyn_tree := tree_ptr(@s.dyn_dtree); - s.d_desc.stat_desc := @static_d_desc; - - s.bl_desc.dyn_tree := tree_ptr(@s.bl_tree); - s.bl_desc.stat_desc := @static_bl_desc; - - s.bi_buf := 0; - s.bi_valid := 0; - s.last_eob_len := 8; { enough lookahead for inflate } -{$ifdef DEBUG} - s.bits_sent := Long(0); -{$endif} - - { Initialize the first block of the first file: } - init_block(s); -end; - -{ =========================================================================== - Remove the smallest element from the heap and recreate the heap with - one less element. Updates heap and heap_len. - -macro pqremove(s, tree, top) -begin - top := s.heap[SMALLEST]; - s.heap[SMALLEST] := s.heap[s.heap_len]; - Dec(s.heap_len); - pqdownheap(s, tree, SMALLEST); -end -} - -{ =========================================================================== - Compares to subtrees, using the tree depth as tie breaker when - the subtrees have equal frequency. This minimizes the worst case length. - -macro smaller(tree, n, m, depth) - ( (tree[n].Freq < tree[m].Freq) or - ((tree[n].Freq = tree[m].Freq) and (depth[n] <= depth[m])) ) -} - -{ =========================================================================== - Restore the heap property by moving down the tree starting at node k, - exchanging a node with the smallest of its two sons if necessary, stopping - when the heap property is re-established (each father smaller than its - two sons). } -{local} - -procedure pqdownheap(var s : deflate_state; - var tree : tree_type; { the tree to restore } - k : int); { node to move down } -var - v : int; - j : int; -begin - v := s.heap[k]; - j := k shl 1; { left son of k } - while (j <= s.heap_len) do - begin - { Set j to the smallest of the two sons: } - if (j < s.heap_len) and - {smaller(tree, s.heap[j+1], s.heap[j], s.depth)} - ( (tree[s.heap[j+1]].fc.Freq < tree[s.heap[j]].fc.Freq) or - ((tree[s.heap[j+1]].fc.Freq = tree[s.heap[j]].fc.Freq) and - (s.depth[s.heap[j+1]] <= s.depth[s.heap[j]])) ) then - begin - Inc(j); - end; - { Exit if v is smaller than both sons } - if {(smaller(tree, v, s.heap[j], s.depth))} - ( (tree[v].fc.Freq < tree[s.heap[j]].fc.Freq) or - ((tree[v].fc.Freq = tree[s.heap[j]].fc.Freq) and - (s.depth[v] <= s.depth[s.heap[j]])) ) then - break; - { Exchange v with the smallest son } - s.heap[k] := s.heap[j]; - k := j; - - { And continue down the tree, setting j to the left son of k } - j := j shl 1; - end; - s.heap[k] := v; -end; - -{ =========================================================================== - Compute the optimal bit lengths for a tree and update the total bit length - for the current block. - IN assertion: the fields freq and dad are set, heap[heap_max] and - above are the tree nodes sorted by increasing frequency. - OUT assertions: the field len is set to the optimal bit length, the - array bl_count contains the frequencies for each bit length. - The length opt_len is updated; static_len is also updated if stree is - not null. } - -{local} -procedure gen_bitlen(var s : deflate_state; - var desc : tree_desc); { the tree descriptor } -var - tree : tree_ptr; - max_code : int; - stree : tree_ptr; {const} - extra : pzIntfArray; {const} - base : int; - max_length : int; - h : int; { heap index } - n, m : int; { iterate over the tree elements } - bits : int; { bit length } - xbits : int; { extra bits } - f : ush; { frequency } - overflow : int; { number of elements with bit length too large } -begin - tree := desc.dyn_tree; - max_code := desc.max_code; - stree := desc.stat_desc^.static_tree; - extra := desc.stat_desc^.extra_bits; - base := desc.stat_desc^.extra_base; - max_length := desc.stat_desc^.max_length; - overflow := 0; - - for bits := 0 to MAX_BITS do - s.bl_count[bits] := 0; - - { In a first pass, compute the optimal bit lengths (which may - overflow in the case of the bit length tree). } - - tree^[s.heap[s.heap_max]].dl.Len := 0; { root of the heap } - - for h := s.heap_max+1 to HEAP_SIZE-1 do - begin - n := s.heap[h]; - bits := tree^[tree^[n].dl.Dad].dl.Len + 1; - if (bits > max_length) then - begin - bits := max_length; - Inc(overflow); - end; - tree^[n].dl.Len := ush(bits); - { We overwrite tree[n].dl.Dad which is no longer needed } - - if (n > max_code) then - continue; { not a leaf node } - - Inc(s.bl_count[bits]); - xbits := 0; - if (n >= base) then - xbits := extra^[n-base]; - f := tree^[n].fc.Freq; - Inc(s.opt_len, ulg(f) * (bits + xbits)); - if (stree <> NIL) then - Inc(s.static_len, ulg(f) * (stree^[n].dl.Len + xbits)); - end; - if (overflow = 0) then - exit; - {$ifdef DEBUG} - Tracev(^M'bit length overflow'); - {$endif} - { This happens for example on obj2 and pic of the Calgary corpus } - - { Find the first bit length which could increase: } - repeat - bits := max_length-1; - while (s.bl_count[bits] = 0) do - Dec(bits); - Dec(s.bl_count[bits]); { move one leaf down the tree } - Inc(s.bl_count[bits+1], 2); { move one overflow item as its brother } - Dec(s.bl_count[max_length]); - { The brother of the overflow item also moves one step up, - but this does not affect bl_count[max_length] } - - Dec(overflow, 2); - until (overflow <= 0); - - { Now recompute all bit lengths, scanning in increasing frequency. - h is still equal to HEAP_SIZE. (It is simpler to reconstruct all - lengths instead of fixing only the wrong ones. This idea is taken - from 'ar' written by Haruhiko Okumura.) } - h := HEAP_SIZE; { Delphi3: compiler warning w/o this } - for bits := max_length downto 1 do - begin - n := s.bl_count[bits]; - while (n <> 0) do - begin - Dec(h); - m := s.heap[h]; - if (m > max_code) then - continue; - if (tree^[m].dl.Len <> unsigned(bits)) then - begin - {$ifdef DEBUG} - Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len) - +'.'+IntToStr(bits)); - {$ENDIF} - Inc(s.opt_len, (long(bits) - long(tree^[m].dl.Len)) - * long(tree^[m].fc.Freq) ); - tree^[m].dl.Len := ush(bits); - end; - Dec(n); - end; - end; -end; - -{ =========================================================================== - Construct one Huffman tree and assigns the code bit strings and lengths. - Update the total bit length for the current block. - IN assertion: the field freq is set for all tree elements. - OUT assertions: the fields len and code are set to the optimal bit length - and corresponding code. The length opt_len is updated; static_len is - also updated if stree is not null. The field max_code is set. } - -{local} -procedure build_tree(var s : deflate_state; - var desc : tree_desc); { the tree descriptor } - -var - tree : tree_ptr; - stree : tree_ptr; {const} - elems : int; - n, m : int; { iterate over heap elements } - max_code : int; { largest code with non zero frequency } - node : int; { new node being created } -begin - tree := desc.dyn_tree; - stree := desc.stat_desc^.static_tree; - elems := desc.stat_desc^.elems; - max_code := -1; - - { Construct the initial heap, with least frequent element in - heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. - heap[0] is not used. } - s.heap_len := 0; - s.heap_max := HEAP_SIZE; - - for n := 0 to elems-1 do - begin - if (tree^[n].fc.Freq <> 0) then - begin - max_code := n; - Inc(s.heap_len); - s.heap[s.heap_len] := n; - s.depth[n] := 0; - end - else - begin - tree^[n].dl.Len := 0; - end; - end; - - { The pkzip format requires that at least one distance code exists, - and that at least one bit should be sent even if there is only one - possible code. So to avoid special checks later on we force at least - two codes of non zero frequency. } - - while (s.heap_len < 2) do - begin - Inc(s.heap_len); - if (max_code < 2) then - begin - Inc(max_code); - s.heap[s.heap_len] := max_code; - node := max_code; - end - else - begin - s.heap[s.heap_len] := 0; - node := 0; - end; - tree^[node].fc.Freq := 1; - s.depth[node] := 0; - Dec(s.opt_len); - if (stree <> NIL) then - Dec(s.static_len, stree^[node].dl.Len); - { node is 0 or 1 so it does not have extra bits } - end; - desc.max_code := max_code; - - { The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, - establish sub-heaps of increasing lengths: } - - for n := s.heap_len div 2 downto 1 do - pqdownheap(s, tree^, n); - - { Construct the Huffman tree by repeatedly combining the least two - frequent nodes. } - - node := elems; { next internal node of the tree } - repeat - {pqremove(s, tree, n);} { n := node of least frequency } - n := s.heap[SMALLEST]; - s.heap[SMALLEST] := s.heap[s.heap_len]; - Dec(s.heap_len); - pqdownheap(s, tree^, SMALLEST); - - m := s.heap[SMALLEST]; { m := node of next least frequency } - - Dec(s.heap_max); - s.heap[s.heap_max] := n; { keep the nodes sorted by frequency } - Dec(s.heap_max); - s.heap[s.heap_max] := m; - - { Create a new node father of n and m } - tree^[node].fc.Freq := tree^[n].fc.Freq + tree^[m].fc.Freq; - { maximum } - if (s.depth[n] >= s.depth[m]) then - s.depth[node] := uch (s.depth[n] + 1) - else - s.depth[node] := uch (s.depth[m] + 1); - - tree^[m].dl.Dad := ush(node); - tree^[n].dl.Dad := ush(node); -{$ifdef DUMP_BL_TREE} - if (tree = tree_ptr(@s.bl_tree)) then - begin - WriteLn(#13'node ',node,'(',tree^[node].fc.Freq,') sons ',n, - '(',tree^[n].fc.Freq,') ', m, '(',tree^[m].fc.Freq,')'); - end; -{$endif} - { and insert the new node in the heap } - s.heap[SMALLEST] := node; - Inc(node); - pqdownheap(s, tree^, SMALLEST); - - until (s.heap_len < 2); - - Dec(s.heap_max); - s.heap[s.heap_max] := s.heap[SMALLEST]; - - { At this point, the fields freq and dad are set. We can now - generate the bit lengths. } - - gen_bitlen(s, desc); - - { The field len is now set, we can generate the bit codes } - gen_codes (tree, max_code, s.bl_count); -end; - -{ =========================================================================== - Scan a literal or distance tree to determine the frequencies of the codes - in the bit length tree. } - -{local} -procedure scan_tree(var s : deflate_state; - var tree : array of ct_data; { the tree to be scanned } - max_code : int); { and its largest code of non zero frequency } -var - n : int; { iterates over all tree elements } - prevlen : int; { last emitted length } - curlen : int; { length of current code } - nextlen : int; { length of next code } - count : int; { repeat count of the current code } - max_count : int; { max repeat count } - min_count : int; { min repeat count } -begin - prevlen := -1; - nextlen := tree[0].dl.Len; - count := 0; - max_count := 7; - min_count := 4; - - if (nextlen = 0) then - begin - max_count := 138; - min_count := 3; - end; - tree[max_code+1].dl.Len := ush($ffff); { guard } - - for n := 0 to max_code do - begin - curlen := nextlen; - nextlen := tree[n+1].dl.Len; - Inc(count); - if (count < max_count) and (curlen = nextlen) then - continue - else - if (count < min_count) then - Inc(s.bl_tree[curlen].fc.Freq, count) - else - if (curlen <> 0) then - begin - if (curlen <> prevlen) then - Inc(s.bl_tree[curlen].fc.Freq); - Inc(s.bl_tree[REP_3_6].fc.Freq); - end - else - if (count <= 10) then - Inc(s.bl_tree[REPZ_3_10].fc.Freq) - else - Inc(s.bl_tree[REPZ_11_138].fc.Freq); - - count := 0; - prevlen := curlen; - if (nextlen = 0) then - begin - max_count := 138; - min_count := 3; - end - else - if (curlen = nextlen) then - begin - max_count := 6; - min_count := 3; - end - else - begin - max_count := 7; - min_count := 4; - end; - end; -end; - -{ =========================================================================== - Send a literal or distance tree in compressed form, using the codes in - bl_tree. } - -{local} -procedure send_tree(var s : deflate_state; - var tree : array of ct_data; { the tree to be scanned } - max_code : int); { and its largest code of non zero frequency } - -var - n : int; { iterates over all tree elements } - prevlen : int; { last emitted length } - curlen : int; { length of current code } - nextlen : int; { length of next code } - count : int; { repeat count of the current code } - max_count : int; { max repeat count } - min_count : int; { min repeat count } -begin - prevlen := -1; - nextlen := tree[0].dl.Len; - count := 0; - max_count := 7; - min_count := 4; - - { tree[max_code+1].dl.Len := -1; } { guard already set } - if (nextlen = 0) then - begin - max_count := 138; - min_count := 3; - end; - - for n := 0 to max_code do - begin - curlen := nextlen; - nextlen := tree[n+1].dl.Len; - Inc(count); - if (count < max_count) and (curlen = nextlen) then - continue - else - if (count < min_count) then - begin - repeat - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(curlen)); - {$ENDIF} - send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len); - Dec(count); - until (count = 0); - end - else - if (curlen <> 0) then - begin - if (curlen <> prevlen) then - begin - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(curlen)); - {$ENDIF} - send_bits(s, s.bl_tree[curlen].fc.Code, s.bl_tree[curlen].dl.Len); - Dec(count); - end; - {$IFDEF DEBUG} - Assert((count >= 3) and (count <= 6), ' 3_6?'); - {$ENDIF} - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(REP_3_6)); - {$ENDIF} - send_bits(s, s.bl_tree[REP_3_6].fc.Code, s.bl_tree[REP_3_6].dl.Len); - send_bits(s, count-3, 2); - end - else - if (count <= 10) then - begin - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(REPZ_3_10)); - {$ENDIF} - send_bits(s, s.bl_tree[REPZ_3_10].fc.Code, s.bl_tree[REPZ_3_10].dl.Len); - send_bits(s, count-3, 3); - end - else - begin - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(REPZ_11_138)); - {$ENDIF} - send_bits(s, s.bl_tree[REPZ_11_138].fc.Code, s.bl_tree[REPZ_11_138].dl.Len); - send_bits(s, count-11, 7); - end; - count := 0; - prevlen := curlen; - if (nextlen = 0) then - begin - max_count := 138; - min_count := 3; - end - else - if (curlen = nextlen) then - begin - max_count := 6; - min_count := 3; - end - else - begin - max_count := 7; - min_count := 4; - end; - end; -end; - -{ =========================================================================== - Construct the Huffman tree for the bit lengths and return the index in - bl_order of the last bit length code to send. } - -{local} -function build_bl_tree(var s : deflate_state) : int; -var - max_blindex : int; { index of last bit length code of non zero freq } -begin - { Determine the bit length frequencies for literal and distance trees } - scan_tree(s, s.dyn_ltree, s.l_desc.max_code); - scan_tree(s, s.dyn_dtree, s.d_desc.max_code); - - { Build the bit length tree: } - build_tree(s, s.bl_desc); - { opt_len now includes the length of the tree representations, except - the lengths of the bit lengths codes and the 5+5+4 bits for the counts. } - - { Determine the number of bit length codes to send. The pkzip format - requires that at least 4 bit length codes be sent. (appnote.txt says - 3 but the actual value used is 4.) } - - for max_blindex := BL_CODES-1 downto 3 do - begin - if (s.bl_tree[bl_order[max_blindex]].dl.Len <> 0) then - break; - end; - { Update opt_len to include the bit length tree and counts } - Inc(s.opt_len, 3*(max_blindex+1) + 5+5+4); - {$ifdef DEBUG} - Tracev(^M'dyn trees: dyn %ld, stat %ld {s.opt_len, s.static_len}'); - {$ENDIF} - - build_bl_tree := max_blindex; -end; - -{ =========================================================================== - Send the header for a block using dynamic Huffman trees: the counts, the - lengths of the bit length codes, the literal tree and the distance tree. - IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. } - -{local} -procedure send_all_trees(var s : deflate_state; - lcodes : int; - dcodes : int; - blcodes : int); { number of codes for each tree } -var - rank : int; { index in bl_order } -begin - {$IFDEF DEBUG} - Assert ((lcodes >= 257) and (dcodes >= 1) and (blcodes >= 4), - 'not enough codes'); - Assert ((lcodes <= L_CODES) and (dcodes <= D_CODES) - and (blcodes <= BL_CODES), 'too many codes'); - Tracev(^M'bl counts: '); - {$ENDIF} - send_bits(s, lcodes-257, 5); { not +255 as stated in appnote.txt } - send_bits(s, dcodes-1, 5); - send_bits(s, blcodes-4, 4); { not -3 as stated in appnote.txt } - for rank := 0 to blcodes-1 do - begin - {$ifdef DEBUG} - Tracev(^M'bl code '+IntToStr(bl_order[rank])); - {$ENDIF} - send_bits(s, s.bl_tree[bl_order[rank]].dl.Len, 3); - end; - {$ifdef DEBUG} - Tracev(^M'bl tree: sent '+IntToStr(s.bits_sent)); - {$ENDIF} - - send_tree(s, s.dyn_ltree, lcodes-1); { literal tree } - {$ifdef DEBUG} - Tracev(^M'lit tree: sent '+IntToStr(s.bits_sent)); - {$ENDIF} - - send_tree(s, s.dyn_dtree, dcodes-1); { distance tree } - {$ifdef DEBUG} - Tracev(^M'dist tree: sent '+IntToStr(s.bits_sent)); - {$ENDIF} -end; - -{ =========================================================================== - Flush the bit buffer and align the output on a byte boundary } - -{local} -procedure bi_windup(var s : deflate_state); -begin - if (s.bi_valid > 8) then - begin - {put_short(s, s.bi_buf);} - s.pending_buf^[s.pending] := uch(s.bi_buf and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);; - Inc(s.pending); - end - else - if (s.bi_valid > 0) then - begin - {put_byte(s, (Byte)s^.bi_buf);} - s.pending_buf^[s.pending] := Byte(s.bi_buf); - Inc(s.pending); - end; - s.bi_buf := 0; - s.bi_valid := 0; -{$ifdef DEBUG} - s.bits_sent := (s.bits_sent+7) and (not 7); -{$endif} -end; - -{ =========================================================================== - Copy a stored block, storing first the length and its - one's complement if requested. } - -{local} -procedure copy_block(var s : deflate_state; - buf : pcharf; { the input data } - len : unsigned; { its length } - header : boolean); { true if block header must be written } -begin - bi_windup(s); { align on byte boundary } - s.last_eob_len := 8; { enough lookahead for inflate } - - if (header) then - begin - {put_short(s, (ush)len);} - s.pending_buf^[s.pending] := uch(ush(len) and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(len) shr 8);; - Inc(s.pending); - {put_short(s, (ush)~len);} - s.pending_buf^[s.pending] := uch(ush(not len) and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(not len) shr 8);; - Inc(s.pending); - -{$ifdef DEBUG} - Inc(s.bits_sent, 2*16); -{$endif} - end; -{$ifdef DEBUG} - Inc(s.bits_sent, ulg(len shl 3)); -{$endif} - while (len <> 0) do - begin - Dec(len); - {put_byte(s, *buf++);} - s.pending_buf^[s.pending] := buf^; - Inc(buf); - Inc(s.pending); - end; -end; - - -{ =========================================================================== - Send a stored block } - -procedure _tr_stored_block(var s : deflate_state; - buf : pcharf; { input block } - stored_len : ulg; { length of input block } - eof : boolean); { true if this is the last block for a file } - -begin - send_bits(s, (STORED_BLOCK shl 1)+ord(eof), 3); { send block type } - s.compressed_len := (s.compressed_len + 3 + 7) and ulg(not Long(7)); - Inc(s.compressed_len, (stored_len + 4) shl 3); - - copy_block(s, buf, unsigned(stored_len), TRUE); { with header } -end; - -{ =========================================================================== - Flush the bit buffer, keeping at most 7 bits in it. } - -{local} -procedure bi_flush(var s : deflate_state); -begin - if (s.bi_valid = 16) then - begin - {put_short(s, s.bi_buf);} - s.pending_buf^[s.pending] := uch(s.bi_buf and $ff); - Inc(s.pending); - s.pending_buf^[s.pending] := uch(ush(s.bi_buf) shr 8);; - Inc(s.pending); - - s.bi_buf := 0; - s.bi_valid := 0; - end - else - if (s.bi_valid >= 8) then - begin - {put_byte(s, (Byte)s^.bi_buf);} - s.pending_buf^[s.pending] := Byte(s.bi_buf); - Inc(s.pending); - - s.bi_buf := s.bi_buf shr 8; - Dec(s.bi_valid, 8); - end; -end; - - -{ =========================================================================== - Send one empty static block to give enough lookahead for inflate. - This takes 10 bits, of which 7 may remain in the bit buffer. - The current inflate code requires 9 bits of lookahead. If the - last two codes for the previous block (real code plus EOB) were coded - on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode - the last real code. In this case we send two empty static blocks instead - of one. (There are no problems if the previous block is stored or fixed.) - To simplify the code, we assume the worst case of last real code encoded - on one bit only. } - -procedure _tr_align(var s : deflate_state); -begin - send_bits(s, STATIC_TREES shl 1, 3); - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(END_BLOCK)); - {$ENDIF} - send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len); - Inc(s.compressed_len, Long(10)); { 3 for block type, 7 for EOB } - bi_flush(s); - { Of the 10 bits for the empty block, we have already sent - (10 - bi_valid) bits. The lookahead for the last real code (before - the EOB of the previous block) was thus at least one plus the length - of the EOB plus what we have just sent of the empty static block. } - if (1 + s.last_eob_len + 10 - s.bi_valid < 9) then - begin - send_bits(s, STATIC_TREES shl 1, 3); - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(END_BLOCK)); - {$ENDIF} - send_bits(s, static_ltree[END_BLOCK].fc.Code, static_ltree[END_BLOCK].dl.Len); - Inc(s.compressed_len, Long(10)); - bi_flush(s); - end; - s.last_eob_len := 7; -end; - -{ =========================================================================== - Set the data type to ASCII or BINARY, using a crude approximation: - binary if more than 20% of the bytes are <= 6 or >= 128, ascii otherwise. - IN assertion: the fields freq of dyn_ltree are set and the total of all - frequencies does not exceed 64K (to fit in an int on 16 bit machines). } - -{local} -procedure set_data_type(var s : deflate_state); -var - n : int; - ascii_freq : unsigned; - bin_freq : unsigned; -begin - n := 0; - ascii_freq := 0; - bin_freq := 0; - - while (n < 7) do - begin - Inc(bin_freq, s.dyn_ltree[n].fc.Freq); - Inc(n); - end; - while (n < 128) do - begin - Inc(ascii_freq, s.dyn_ltree[n].fc.Freq); - Inc(n); - end; - while (n < LITERALS) do - begin - Inc(bin_freq, s.dyn_ltree[n].fc.Freq); - Inc(n); - end; - if (bin_freq > (ascii_freq shr 2)) then - s.data_type := Byte(Z_BINARY) - else - s.data_type := Byte(Z_ASCII); -end; - -{ =========================================================================== - Send the block data compressed using the given Huffman trees } - -{local} -procedure compress_block(var s : deflate_state; - var ltree : array of ct_data; { literal tree } - var dtree : array of ct_data); { distance tree } -var - dist : unsigned; { distance of matched string } - lc : int; { match length or unmatched char (if dist == 0) } - lx : unsigned; { running index in l_buf } - code : unsigned; { the code to send } - extra : int; { number of extra bits to send } -begin - lx := 0; - if (s.last_lit <> 0) then - repeat - dist := s.d_buf^[lx]; - lc := s.l_buf^[lx]; - Inc(lx); - if (dist = 0) then - begin - { send a literal byte } - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(lc)); - Tracecv((lc > 31) and (lc < 128), ' '+AnsiChar(lc)+' '); - {$ENDIF} - send_bits(s, ltree[lc].fc.Code, ltree[lc].dl.Len); - end - else - begin - { Here, lc is the match length - MIN_MATCH } - code := _length_code[lc]; - { send the length code } - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(code+LITERALS+1)); - {$ENDIF} - send_bits(s, ltree[code+LITERALS+1].fc.Code, ltree[code+LITERALS+1].dl.Len); - extra := extra_lbits[code]; - if (extra <> 0) then - begin - Dec(lc, base_length[code]); - send_bits(s, lc, extra); { send the extra length bits } - end; - Dec(dist); { dist is now the match distance - 1 } - {code := d_code(dist);} - if (dist < 256) then - code := _dist_code[dist] - else - code := _dist_code[256+(dist shr 7)]; - - {$IFDEF DEBUG} - Assert (code < D_CODES, 'bad d_code'); - {$ENDIF} - - { send the distance code } - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(code)); - {$ENDIF} - send_bits(s, dtree[code].fc.Code, dtree[code].dl.Len); - extra := extra_dbits[code]; - if (extra <> 0) then - begin - Dec(dist, base_dist[code]); - send_bits(s, dist, extra); { send the extra distance bits } - end; - end; { literal or match pair ? } - - { Check that the overlay between pending_buf and d_buf+l_buf is ok: } - {$IFDEF DEBUG} - Assert(s.pending < s.lit_bufsize + 2*lx, 'pendingBuf overflow'); - {$ENDIF} - until (lx >= s.last_lit); - - {$ifdef DEBUG} - Tracevvv(#13'cd '+IntToStr(END_BLOCK)); - {$ENDIF} - send_bits(s, ltree[END_BLOCK].fc.Code, ltree[END_BLOCK].dl.Len); - s.last_eob_len := ltree[END_BLOCK].dl.Len; -end; - - -{ =========================================================================== - Determine the best encoding for the current block: dynamic trees, static - trees or store, and output the encoded block to the zip file. This function - returns the total compressed length for the file so far. } - -function _tr_flush_block (var s : deflate_state; - buf : pcharf; { input block, or NULL if too old } - stored_len : ulg; { length of input block } - eof : boolean) : ulg; { true if this is the last block for a file } -var - opt_lenb, static_lenb : ulg; { opt_len and static_len in bytes } - max_blindex : int; { index of last bit length code of non zero freq } -begin - max_blindex := 0; - - { Build the Huffman trees unless a stored block is forced } - if (s.level > 0) then - begin - { Check if the file is ascii or binary } - if (s.data_type = Z_UNKNOWN) then - set_data_type(s); - - { Construct the literal and distance trees } - build_tree(s, s.l_desc); - {$ifdef DEBUG} - Tracev(^M'lit data: dyn %ld, stat %ld {s.opt_len, s.static_len}'); - {$ENDIF} - - build_tree(s, s.d_desc); - {$ifdef DEBUG} - Tracev(^M'dist data: dyn %ld, stat %ld {s.opt_len, s.static_len}'); - {$ENDIF} - { At this point, opt_len and static_len are the total bit lengths of - the compressed block data, excluding the tree representations. } - - { Build the bit length tree for the above two trees, and get the index - in bl_order of the last bit length code to send. } - max_blindex := build_bl_tree(s); - - { Determine the best encoding. Compute first the block length in bytes} - opt_lenb := (s.opt_len+3+7) shr 3; - static_lenb := (s.static_len+3+7) shr 3; - - {$ifdef DEBUG} - Tracev(^M'opt %lu(%lu) stat %lu(%lu) stored %lu lit %u '+ - '{opt_lenb, s.opt_len, static_lenb, s.static_len, stored_len,'+ - 's.last_lit}'); - {$ENDIF} - - if (static_lenb <= opt_lenb) then - opt_lenb := static_lenb; - - end - else - begin - {$IFDEF DEBUG} - Assert(buf <> pcharf(NIL), 'lost buf'); - {$ENDIF} - static_lenb := stored_len + 5; - opt_lenb := static_lenb; { force a stored block } - end; - - { If compression failed and this is the first and last block, - and if the .zip file can be seeked (to rewrite the local header), - the whole file is transformed into a stored file: } - -{$ifdef STORED_FILE_OK} -{$ifdef FORCE_STORED_FILE} - if eof and (s.compressed_len = Long(0)) then - begin { force stored file } -{$else} - if (stored_len <= opt_lenb) and eof and (s.compressed_len=Long(0)) - and seekable()) do - begin -{$endif} - { Since LIT_BUFSIZE <= 2*WSIZE, the input data must be there: } - if (buf = pcharf(0)) then - error ('block vanished'); - - copy_block(buf, unsigned(stored_len), 0); { without header } - s.compressed_len := stored_len shl 3; - s.method := STORED; - end - else -{$endif} { STORED_FILE_OK } - -{$ifdef FORCE_STORED} - if (buf <> pcharf(0)) then - begin { force stored block } -{$else} - if (stored_len+4 <= opt_lenb) and (buf <> pcharf(0)) then - begin - { 4: two words for the lengths } -{$endif} - { The test buf <> NULL is only necessary if LIT_BUFSIZE > WSIZE. - Otherwise we can't have processed more than WSIZE input bytes since - the last block flush, because compression would have been - successful. If LIT_BUFSIZE <= WSIZE, it is never too late to - transform a block into a stored block. } - - _tr_stored_block(s, buf, stored_len, eof); - -{$ifdef FORCE_STATIC} - end - else - if (static_lenb >= 0) then - begin { force static trees } -{$else} - end - else - if (static_lenb = opt_lenb) then - begin -{$endif} - send_bits(s, (STATIC_TREES shl 1)+ord(eof), 3); - compress_block(s, static_ltree, static_dtree); - Inc(s.compressed_len, 3 + s.static_len); - end - else - begin - send_bits(s, (DYN_TREES shl 1)+ord(eof), 3); - send_all_trees(s, s.l_desc.max_code+1, s.d_desc.max_code+1, - max_blindex+1); - compress_block(s, s.dyn_ltree, s.dyn_dtree); - Inc(s.compressed_len, 3 + s.opt_len); - end; - {$ifdef DEBUG} - Assert (s.compressed_len = s.bits_sent, 'bad compressed size'); - {$ENDIF} - init_block(s); - - if (eof) then - begin - bi_windup(s); - Inc(s.compressed_len, 7); { align on byte boundary } - end; - {$ifdef DEBUG} - Tracev(#13'comprlen %lu(%lu) {s.compressed_len shr 3,'+ - 's.compressed_len-7*ord(eof)}'); - {$ENDIF} - - _tr_flush_block := s.compressed_len shr 3; -end; - - -{ =========================================================================== - Save the match info and tally the frequency counts. Return true if - the current block must be flushed. } - -function _tr_tally (var s : deflate_state; - dist : unsigned; { distance of matched string } - lc : unsigned) : boolean; { match length-MIN_MATCH or unmatched char (if dist=0) } -var - {$IFDEF DEBUG} - MAX_DIST : ush; - {$ENDIF} - code : ush; -{$ifdef TRUNCATE_BLOCK} -var - out_length : ulg; - in_length : ulg; - dcode : int; -{$endif} -begin - s.d_buf^[s.last_lit] := ush(dist); - s.l_buf^[s.last_lit] := uch(lc); - Inc(s.last_lit); - if (dist = 0) then - begin - { lc is the unmatched char } - Inc(s.dyn_ltree[lc].fc.Freq); - end - else - begin - Inc(s.matches); - { Here, lc is the match length - MIN_MATCH } - Dec(dist); { dist := match distance - 1 } - - {macro d_code(dist)} - if (dist) < 256 then - code := _dist_code[dist] - else - code := _dist_code[256+(dist shr 7)]; - {$IFDEF DEBUG} -{macro MAX_DIST(s) <=> ((s)^.w_size-MIN_LOOKAHEAD) - In order to simplify the code, particularly on 16 bit machines, match - distances are limited to MAX_DIST instead of WSIZE. } - MAX_DIST := ush(s.w_size-MIN_LOOKAHEAD); - Assert((dist < ush(MAX_DIST)) and - (ush(lc) <= ush(MAX_MATCH-MIN_MATCH)) and - (ush(code) < ush(D_CODES)), '_tr_tally: bad match'); - {$ENDIF} - Inc(s.dyn_ltree[_length_code[lc]+LITERALS+1].fc.Freq); - {s.dyn_dtree[d_code(dist)].Freq++;} - Inc(s.dyn_dtree[code].fc.Freq); - end; - -{$ifdef TRUNCATE_BLOCK} - { Try to guess if it is profitable to stop the current block here } - if (s.last_lit and $1fff = 0) and (s.level > 2) then - begin - { Compute an upper bound for the compressed length } - out_length := ulg(s.last_lit)*Long(8); - in_length := ulg(long(s.strstart) - s.block_start); - for dcode := 0 to D_CODES-1 do - begin - Inc(out_length, ulg(s.dyn_dtree[dcode].fc.Freq * - (Long(5)+extra_dbits[dcode])) ); - end; - out_length := out_length shr 3; - {$ifdef DEBUG} - Tracev(^M'last_lit %u, in %ld, out ~%ld(%ld%%) '); - { s.last_lit, in_length, out_length, - Long(100) - out_length*Long(100) div in_length)); } - {$ENDIF} - if (s.matches < s.last_lit div 2) and (out_length < in_length div 2) then - begin - _tr_tally := TRUE; - exit; - end; - end; -{$endif} - _tr_tally := (s.last_lit = s.lit_bufsize-1); - { We avoid equality with lit_bufsize because of wraparound at 64K - on 16 bit machines and because stored blocks are restricted to - 64K-1 bytes. } -end; - -end. \ No newline at end of file diff --git a/3rd/Imaging/Source/ZLib/imzconf.inc b/3rd/Imaging/Source/ZLib/imzconf.inc deleted file mode 100644 index d688a4bf2..000000000 --- a/3rd/Imaging/Source/ZLib/imzconf.inc +++ /dev/null @@ -1,25 +0,0 @@ -{ -------------------------------------------------------------------- } - -{$DEFINE MAX_MATCH_IS_258} - -{ Compile with -DMAXSEG_64K if the alloc function cannot allocate more - than 64k bytes at a time (needed on systems with 16-bit int). } - -{$UNDEF MAXSEG_64K} -{$DEFINE UNALIGNED_OK} { requires SizeOf(ush) = 2 ! } -{$UNDEF DYNAMIC_CRC_TABLE} -{$UNDEF FASTEST} -{$DEFINE Use32} -{$DEFINE patch112} { apply patch from the zlib home page } - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$UNDEF DEBUG} // for Delphi 2007 in DEBUG mode - -{$RANGECHECKS OFF} -{$OVERFLOWCHECKS OFF} -{ -------------------------------------------------------------------- } - - diff --git a/3rd/Imaging/Source/ZLib/imzdeflate.pas b/3rd/Imaging/Source/ZLib/imzdeflate.pas deleted file mode 100644 index dc5e96fd0..000000000 --- a/3rd/Imaging/Source/ZLib/imzdeflate.pas +++ /dev/null @@ -1,2129 +0,0 @@ -Unit imzdeflate; - -{ Orginal: deflate.h -- internal compression state - deflate.c -- compress data using the deflation algorithm - Copyright (C) 1995-1996 Jean-loup Gailly. - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - - -{ ALGORITHM - - The "deflation" process depends on being able to identify portions - of the input text which are identical to earlier input (within a - sliding window trailing behind the input currently being processed). - - The most straightforward technique turns out to be the fastest for - most input files: try all possible matches and select the longest. - The key feature of this algorithm is that insertions into the string - dictionary are very simple and thus fast, and deletions are avoided - completely. Insertions are performed at each input character, whereas - string matches are performed only when the previous match ends. So it - is preferable to spend more time in matches to allow very fast string - insertions and avoid deletions. The matching algorithm for small - strings is inspired from that of Rabin & Karp. A brute force approach - is used to find longer strings when a small match has been found. - A similar algorithm is used in comic (by Jan-Mark Wams) and freeze - (by Leonid Broukhis). - A previous version of this file used a more sophisticated algorithm - (by Fiala and Greene) which is guaranteed to run in linear amortized - time, but has a larger average cost, uses more memory and is patented. - However the F&G algorithm may be faster for some highly redundant - files if the parameter max_chain_length (described below) is too large. - - ACKNOWLEDGEMENTS - - The idea of lazy evaluation of matches is due to Jan-Mark Wams, and - I found it in 'freeze' written by Leonid Broukhis. - Thanks to many people for bug reports and testing. - - REFERENCES - - Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". - Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc - - A description of the Rabin and Karp algorithm is given in the book - "Algorithms" by R. Sedgewick, Addison-Wesley, p252. - - Fiala,E.R., and Greene,D.H. - Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595} - -interface - -{$I imzconf.inc} - -uses - imzutil, impaszlib; - - -function deflateInit_(strm : z_streamp; - level : int; - const version : AnsiString; - stream_size : int) : int; - - -function deflateInit (var strm : z_stream; level : int) : int; - -{ Initializes the internal stream state for compression. The fields - zalloc, zfree and opaque must be initialized before by the caller. - If zalloc and zfree are set to Z_NULL, deflateInit updates them to - use default allocation functions. - - The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: - 1 gives best speed, 9 gives best compression, 0 gives no compression at - all (the input data is simply copied a block at a time). - Z_DEFAULT_COMPRESSION requests a default compromise between speed and - compression (currently equivalent to level 6). - - deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not - enough memory, Z_STREAM_ERROR if level is not a valid compression level, - Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible - with the version assumed by the caller (ZLIB_VERSION). - msg is set to null if there is no error message. deflateInit does not - perform any compression: this will be done by deflate(). } - - -{EXPORT} -function deflate (var strm : z_stream; flush : int) : int; - -{ Performs one or both of the following actions: - - - Compress more input starting at next_in and update next_in and avail_in - accordingly. If not all input can be processed (because there is not - enough room in the output buffer), next_in and avail_in are updated and - processing will resume at this point for the next call of deflate(). - - - Provide more output starting at next_out and update next_out and avail_out - accordingly. This action is forced if the parameter flush is non zero. - Forcing flush frequently degrades the compression ratio, so this parameter - should be set only when necessary (in interactive applications). - Some output may be provided even if flush is not set. - - Before the call of deflate(), the application should ensure that at least - one of the actions is possible, by providing more input and/or consuming - more output, and updating avail_in or avail_out accordingly; avail_out - should never be zero before the call. The application can consume the - compressed output when it wants, for example when the output buffer is full - (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK - and with zero avail_out, it must be called again after making room in the - output buffer because there might be more output pending. - - If the parameter flush is set to Z_PARTIAL_FLUSH, the current compression - block is terminated and flushed to the output buffer so that the - decompressor can get all input data available so far. For method 9, a future - variant on method 8, the current block will be flushed but not terminated. - Z_SYNC_FLUSH has the same effect as partial flush except that the compressed - output is byte aligned (the compressor can clear its internal bit buffer) - and the current block is always terminated; this can be useful if the - compressor has to be restarted from scratch after an interruption (in which - case the internal state of the compressor may be lost). - If flush is set to Z_FULL_FLUSH, the compression block is terminated, a - special marker is output and the compression dictionary is discarded; this - is useful to allow the decompressor to synchronize if one compressed block - has been damaged (see inflateSync below). Flushing degrades compression and - so should be used only when necessary. Using Z_FULL_FLUSH too often can - seriously degrade the compression. If deflate returns with avail_out == 0, - this function must be called again with the same value of the flush - parameter and more output space (updated avail_out), until the flush is - complete (deflate returns with non-zero avail_out). - - If the parameter flush is set to Z_FINISH, all pending input is processed, - all pending output is flushed and deflate returns with Z_STREAM_END if there - was enough output space; if deflate returns with Z_OK, this function must be - called again with Z_FINISH and more output space (updated avail_out) but no - more input data, until it returns with Z_STREAM_END or an error. After - deflate has returned Z_STREAM_END, the only possible operations on the - stream are deflateReset or deflateEnd. - - Z_FINISH can be used immediately after deflateInit if all the compression - is to be done in a single step. In this case, avail_out must be at least - 0.1% larger than avail_in plus 12 bytes. If deflate does not return - Z_STREAM_END, then it must be called again as described above. - - deflate() may update data_type if it can make a good guess about - the input data type (Z_ASCII or Z_BINARY). In doubt, the data is considered - binary. This field is only for information purposes and does not affect - the compression algorithm in any manner. - - deflate() returns Z_OK if some progress has been made (more input - processed or more output produced), Z_STREAM_END if all input has been - consumed and all output has been produced (only when flush is set to - Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example - if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible. } - - -function deflateEnd (var strm : z_stream) : int; - -{ All dynamically allocated data structures for this stream are freed. - This function discards any unprocessed input and does not flush any - pending output. - - deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the - stream state was inconsistent, Z_DATA_ERROR if the stream was freed - prematurely (some input or output was discarded). In the error case, - msg may be set but then points to a static string (which must not be - deallocated). } - - - - - { Advanced functions } - -{ The following functions are needed only in some special applications. } - - -{EXPORT} -function deflateInit2 (var strm : z_stream; - level : int; - method : int; - windowBits : int; - memLevel : int; - strategy : int) : int; - -{ This is another version of deflateInit with more compression options. The - fields next_in, zalloc, zfree and opaque must be initialized before by - the caller. - - The method parameter is the compression method. It must be Z_DEFLATED in - this version of the library. (Method 9 will allow a 64K history buffer and - partial block flushes.) - - The windowBits parameter is the base two logarithm of the window size - (the size of the history buffer). It should be in the range 8..15 for this - version of the library (the value 16 will be allowed for method 9). Larger - values of this parameter result in better compression at the expense of - memory usage. The default value is 15 if deflateInit is used instead. - - The memLevel parameter specifies how much memory should be allocated - for the internal compression state. memLevel=1 uses minimum memory but - is slow and reduces compression ratio; memLevel=9 uses maximum memory - for optimal speed. The default value is 8. See zconf.h for total memory - usage as a function of windowBits and memLevel. - - The strategy parameter is used to tune the compression algorithm. Use the - value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a - filter (or predictor), or Z_HUFFMAN_ONLY to force Huffman encoding only (no - string match). Filtered data consists mostly of small values with a - somewhat random distribution. In this case, the compression algorithm is - tuned to compress them better. The effect of Z_FILTERED is to force more - Huffman coding and less string matching; it is somewhat intermediate - between Z_DEFAULT and Z_HUFFMAN_ONLY. The strategy parameter only affects - the compression ratio but not the correctness of the compressed output even - if it is not set appropriately. - - If next_in is not null, the library will use this buffer to hold also - some history information; the buffer must either hold the entire input - data, or have at least 1<<(windowBits+1) bytes and be writable. If next_in - is null, the library will allocate its own history buffer (and leave next_in - null). next_out need not be provided here but must be provided by the - application for the next call of deflate(). - - If the history buffer is provided by the application, next_in must - must never be changed by the application since the compressor maintains - information inside this buffer from call to call; the application - must provide more input only by increasing avail_in. next_in is always - reset by the library in this case. - - deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was - not enough memory, Z_STREAM_ERROR if a parameter is invalid (such as - an invalid method). msg is set to null if there is no error message. - deflateInit2 does not perform any compression: this will be done by - deflate(). } - - -{EXPORT} -function deflateSetDictionary (var strm : z_stream; - dictionary : pBytef; {const bytes} - dictLength : uint) : int; - -{ Initializes the compression dictionary (history buffer) from the given - byte sequence without producing any compressed output. This function must - be called immediately after deflateInit or deflateInit2, before any call - of deflate. The compressor and decompressor must use exactly the same - dictionary (see inflateSetDictionary). - The dictionary should consist of strings (byte sequences) that are likely - to be encountered later in the data to be compressed, with the most commonly - used strings preferably put towards the end of the dictionary. Using a - dictionary is most useful when the data to be compressed is short and - can be predicted with good accuracy; the data can then be compressed better - than with the default empty dictionary. In this version of the library, - only the last 32K bytes of the dictionary are used. - Upon return of this function, strm->adler is set to the Adler32 value - of the dictionary; the decompressor may later use this value to determine - which dictionary has been used by the compressor. (The Adler32 value - applies to the whole dictionary even if only a subset of the dictionary is - actually used by the compressor.) - - deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a - parameter is invalid (such as NULL dictionary) or the stream state - is inconsistent (for example if deflate has already been called for this - stream). deflateSetDictionary does not perform any compression: this will - be done by deflate(). } - -{EXPORT} -function deflateCopy (dest : z_streamp; - source : z_streamp) : int; - -{ Sets the destination stream as a complete copy of the source stream. If - the source stream is using an application-supplied history buffer, a new - buffer is allocated for the destination stream. The compressed output - buffer is always application-supplied. It's the responsibility of the - application to provide the correct values of next_out and avail_out for the - next call of deflate. - - This function can be useful when several compression strategies will be - tried, for example when there are several ways of pre-processing the input - data with a filter. The streams that will be discarded should then be freed - by calling deflateEnd. Note that deflateCopy duplicates the internal - compression state which can be quite large, so this strategy is slow and - can consume lots of memory. - - deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not - enough memory, Z_STREAM_ERROR if the source stream state was inconsistent - (such as zalloc being NULL). msg is left unchanged in both source and - destination. } - -{EXPORT} -function deflateReset (var strm : z_stream) : int; - -{ This function is equivalent to deflateEnd followed by deflateInit, - but does not free and reallocate all the internal compression state. - The stream will keep the same compression level and any other attributes - that may have been set by deflateInit2. - - deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source - stream state was inconsistent (such as zalloc or state being NIL). } - - -{EXPORT} -function deflateParams (var strm : z_stream; level : int; strategy : int) : int; - -{ Dynamically update the compression level and compression strategy. - This can be used to switch between compression and straight copy of - the input data, or to switch to a different kind of input data requiring - a different strategy. If the compression level is changed, the input - available so far is compressed with the old level (and may be flushed); - the new level will take effect only at the next call of deflate(). - - Before the call of deflateParams, the stream state must be set as for - a call of deflate(), since the currently available input may have to - be compressed and flushed. In particular, strm->avail_out must be non-zero. - - deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source - stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR - if strm->avail_out was zero. } - - -const - deflate_copyright : string = ' deflate 1.1.2 Copyright 1995-1998 Jean-loup Gailly '; - -{ If you use the zlib library in a product, an acknowledgment is welcome - in the documentation of your product. If for some reason you cannot - include such an acknowledgment, I would appreciate that you keep this - copyright string in the executable of your product. } - -implementation - -uses - imtrees, imadler; - -{ =========================================================================== - Function prototypes. } - -type - block_state = ( - need_more, { block not completed, need more input or more output } - block_done, { block flush performed } - finish_started, { finish started, need only more output at next deflate } - finish_done); { finish done, accept no more input or output } - -{ Compression function. Returns the block state after the call. } -type - compress_func = function(var s : deflate_state; flush : int) : block_state; - -{local} -procedure fill_window(var s : deflate_state); forward; -{local} -function deflate_stored(var s : deflate_state; flush : int) : block_state; forward; -{local} -function deflate_fast(var s : deflate_state; flush : int) : block_state; forward; -{local} -function deflate_slow(var s : deflate_state; flush : int) : block_state; forward; -{local} -procedure lm_init(var s : deflate_state); forward; - -{local} -procedure putShortMSB(var s : deflate_state; b : uInt); forward; -{local} -procedure flush_pending (var strm : z_stream); forward; -{local} -function read_buf(strm : z_streamp; - buf : pBytef; - size : unsigned) : int; forward; -{$ifdef ASMV} -procedure match_init; { asm code initialization } -function longest_match(var deflate_state; cur_match : IPos) : uInt; forward; -{$else} -{local} -function longest_match(var s : deflate_state; cur_match : IPos) : uInt; - forward; -{$endif} - -{$ifdef DEBUG} -{local} -procedure check_match(var s : deflate_state; - start, match : IPos; - length : int); forward; -{$endif} - -{ ========================================================================== - local data } - -const - ZNIL = 0; -{ Tail of hash chains } - -const - TOO_FAR = 4096; -{ Matches of length 3 are discarded if their distance exceeds TOO_FAR } - -const - MIN_LOOKAHEAD = (MAX_MATCH+MIN_MATCH+1); -{ Minimum amount of lookahead, except at the end of the input file. - See deflate.c for comments about the MIN_MATCH+1. } - -{macro MAX_DIST(var s : deflate_state) : uInt; -begin - MAX_DIST := (s.w_size - MIN_LOOKAHEAD); -end; - In order to simplify the code, particularly on 16 bit machines, match - distances are limited to MAX_DIST instead of WSIZE. } - - -{ Values for max_lazy_match, good_match and max_chain_length, depending on - the desired pack level (0..9). The values given below have been tuned to - exclude worst case performance for pathological files. Better values may be - found for specific files. } - -type - config = record - good_length : ush; { reduce lazy search above this match length } - max_lazy : ush; { do not perform lazy search above this match length } - nice_length : ush; { quit search above this match length } - max_chain : ush; - func : compress_func; - end; - -{local} -const - configuration_table : array[0..10-1] of config = ( -{ good lazy nice chain } -{0} (good_length:0; max_lazy:0; nice_length:0; max_chain:0; func:deflate_stored), { store only } -{1} (good_length:4; max_lazy:4; nice_length:8; max_chain:4; func:deflate_fast), { maximum speed, no lazy matches } -{2} (good_length:4; max_lazy:5; nice_length:16; max_chain:8; func:deflate_fast), -{3} (good_length:4; max_lazy:6; nice_length:32; max_chain:32; func:deflate_fast), - -{4} (good_length:4; max_lazy:4; nice_length:16; max_chain:16; func:deflate_slow), { lazy matches } -{5} (good_length:8; max_lazy:16; nice_length:32; max_chain:32; func:deflate_slow), -{6} (good_length:8; max_lazy:16; nice_length:128; max_chain:128; func:deflate_slow), -{7} (good_length:8; max_lazy:32; nice_length:128; max_chain:256; func:deflate_slow), -{8} (good_length:32; max_lazy:128; nice_length:258; max_chain:1024; func:deflate_slow), -{9} (good_length:32; max_lazy:258; nice_length:258; max_chain:4096; func:deflate_slow)); { maximum compression } - -{ Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 - For deflate_fast() (levels <= 3) good is ignored and lazy has a different - meaning. } - -const - EQUAL = 0; -{ result of memcmp for equal strings } - -{ ========================================================================== - Update a hash value with the given input byte - IN assertion: all calls to to UPDATE_HASH are made with consecutive - input characters, so that a running hash key can be computed from the - previous key instead of complete recalculation each time. - -macro UPDATE_HASH(s,h,c) - h := (( (h) shl s^.hash_shift) xor (c)) and s^.hash_mask; -} - -{ =========================================================================== - Insert string str in the dictionary and set match_head to the previous head - of the hash chain (the most recent string with same hash key). Return - the previous length of the hash chain. - If this file is compiled with -DFASTEST, the compression level is forced - to 1, and no hash chains are maintained. - IN assertion: all calls to to INSERT_STRING are made with consecutive - input characters and the first MIN_MATCH bytes of str are valid - (except for the last MIN_MATCH-1 bytes of the input file). } - -procedure INSERT_STRING(var s : deflate_state; - str : uInt; - var match_head : IPos); -begin -{$ifdef FASTEST} - {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])} - s.ins_h := ((s.ins_h shl s.hash_shift) xor - (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask; - match_head := s.head[s.ins_h] - s.head[s.ins_h] := Pos(str); -{$else} - {UPDATE_HASH(s, s.ins_h, s.window[(str) + (MIN_MATCH-1)])} - s.ins_h := ((s.ins_h shl s.hash_shift) xor - (s.window^[(str) + (MIN_MATCH-1)])) and s.hash_mask; - - match_head := s.head^[s.ins_h]; - s.prev^[(str) and s.w_mask] := match_head; - s.head^[s.ins_h] := Pos(str); -{$endif} -end; - -{ ========================================================================= - Initialize the hash table (avoiding 64K overflow for 16 bit systems). - prev[] will be initialized on the fly. - -macro CLEAR_HASH(s) - s^.head[s^.hash_size-1] := ZNIL; - zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0])); -} - -{ ======================================================================== } - -function deflateInit2_(var strm : z_stream; - level : int; - method : int; - windowBits : int; - memLevel : int; - strategy : int; - const version : AnsiString; - stream_size : int) : int; -var - s : deflate_state_ptr; - noheader : int; - - overlay : pushfArray; - { We overlay pending_buf and d_buf+l_buf. This works since the average - output size for (length,distance) codes is <= 24 bits. } -begin - noheader := 0; - if (version = '') or (version[1] <> ZLIB_VERSION[1]) or - (stream_size <> sizeof(z_stream)) then - begin - deflateInit2_ := Z_VERSION_ERROR; - exit; - end; - { - if (strm = Z_NULL) then - begin - deflateInit2_ := Z_STREAM_ERROR; - exit; - end; - } - { SetLength(strm.msg, 255); } - strm.msg := ''; - if not Assigned(strm.zalloc) then - begin - {$IFDEF FPC} strm.zalloc := @zcalloc; {$ELSE} - strm.zalloc := zcalloc; - {$ENDIF} - strm.opaque := voidpf(0); - end; - if not Assigned(strm.zfree) then - {$IFDEF FPC} strm.zfree := @zcfree; {$ELSE} - strm.zfree := zcfree; - {$ENDIF} - - if (level = Z_DEFAULT_COMPRESSION) then - level := 6; -{$ifdef FASTEST} - level := 1; -{$endif} - - if (windowBits < 0) then { undocumented feature: suppress zlib header } - begin - noheader := 1; - windowBits := -windowBits; - end; - if (memLevel < 1) or (memLevel > MAX_MEM_LEVEL) or (method <> Z_DEFLATED) - or (windowBits < 8) or (windowBits > 15) or (level < 0) - or (level > 9) or (strategy < 0) or (strategy > Z_HUFFMAN_ONLY) then - begin - deflateInit2_ := Z_STREAM_ERROR; - exit; - end; - - s := deflate_state_ptr (ZALLOC(strm, 1, sizeof(deflate_state))); - if (s = Z_NULL) then - begin - deflateInit2_ := Z_MEM_ERROR; - exit; - end; - strm.state := pInternal_state(s); - s^.strm := @strm; - - s^.noheader := noheader; - s^.w_bits := windowBits; - s^.w_size := 1 shl s^.w_bits; - s^.w_mask := s^.w_size - 1; - - s^.hash_bits := memLevel + 7; - s^.hash_size := 1 shl s^.hash_bits; - s^.hash_mask := s^.hash_size - 1; - s^.hash_shift := ((s^.hash_bits+MIN_MATCH-1) div MIN_MATCH); - - s^.window := pzByteArray (ZALLOC(strm, s^.w_size, 2*sizeof(Byte))); - s^.prev := pzPosfArray (ZALLOC(strm, s^.w_size, sizeof(Pos))); - s^.head := pzPosfArray (ZALLOC(strm, s^.hash_size, sizeof(Pos))); - - s^.lit_bufsize := 1 shl (memLevel + 6); { 16K elements by default } - - overlay := pushfArray (ZALLOC(strm, s^.lit_bufsize, sizeof(ush)+2)); - s^.pending_buf := pzByteArray (overlay); - s^.pending_buf_size := ulg(s^.lit_bufsize) * (sizeof(ush)+Long(2)); - - if (s^.window = Z_NULL) or (s^.prev = Z_NULL) or (s^.head = Z_NULL) - or (s^.pending_buf = Z_NULL) then - begin - {ERR_MSG(Z_MEM_ERROR);} - strm.msg := z_errmsg[z_errbase-Z_MEM_ERROR]; - deflateEnd (strm); - deflateInit2_ := Z_MEM_ERROR; - exit; - end; - s^.d_buf := pushfArray( @overlay^[s^.lit_bufsize div sizeof(ush)] ); - s^.l_buf := puchfArray( @s^.pending_buf^[(1+sizeof(ush))*s^.lit_bufsize] ); - - s^.level := level; - s^.strategy := strategy; - s^.method := Byte(method); - - deflateInit2_ := deflateReset(strm); -end; - -{ ========================================================================= } - -function deflateInit2(var strm : z_stream; - level : int; - method : int; - windowBits : int; - memLevel : int; - strategy : int) : int; -{ a macro } -begin - deflateInit2 := deflateInit2_(strm, level, method, windowBits, - memLevel, strategy, ZLIB_VERSION, sizeof(z_stream)); -end; - -{ ========================================================================= } - -function deflateInit_(strm : z_streamp; - level : int; - const version : AnsiString; - stream_size : int) : int; -begin - if (strm = Z_NULL) then - deflateInit_ := Z_STREAM_ERROR - else - deflateInit_ := deflateInit2_(strm^, level, Z_DEFLATED, MAX_WBITS, - DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, version, stream_size); - { To do: ignore strm^.next_in if we use it as window } -end; - -{ ========================================================================= } - -function deflateInit(var strm : z_stream; level : int) : int; -{ deflateInit is a macro to allow checking the zlib version - and the compiler's view of z_stream: } -begin - deflateInit := deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, - DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, ZLIB_VERSION, sizeof(z_stream)); -end; - -{ ======================================================================== } -function deflateSetDictionary (var strm : z_stream; - dictionary : pBytef; - dictLength : uInt) : int; -var - s : deflate_state_ptr; - length : uInt; - n : uInt; - hash_head : IPos; -var - MAX_DIST : uInt; {macro} -begin - length := dictLength; - hash_head := 0; - - if {(@strm = Z_NULL) or} - (strm.state = Z_NULL) or (dictionary = Z_NULL) - or (deflate_state_ptr(strm.state)^.status <> INIT_STATE) then - begin - deflateSetDictionary := Z_STREAM_ERROR; - exit; - end; - - s := deflate_state_ptr(strm.state); - strm.adler := adler32(strm.adler, dictionary, dictLength); - - if (length < MIN_MATCH) then - begin - deflateSetDictionary := Z_OK; - exit; - end; - MAX_DIST := (s^.w_size - MIN_LOOKAHEAD); - if (length > MAX_DIST) then - begin - length := MAX_DIST; -{$ifndef USE_DICT_HEAD} - Inc(dictionary, dictLength - length); { use the tail of the dictionary } -{$endif} - end; - - zmemcpy( pBytef(s^.window), dictionary, length); - s^.strstart := length; - s^.block_start := long(length); - - { Insert all strings in the hash table (except for the last two bytes). - s^.lookahead stays null, so s^.ins_h will be recomputed at the next - call of fill_window. } - - s^.ins_h := s^.window^[0]; - {UPDATE_HASH(s, s^.ins_h, s^.window[1]);} - s^.ins_h := ((s^.ins_h shl s^.hash_shift) xor (s^.window^[1])) - and s^.hash_mask; - - for n := 0 to length - MIN_MATCH do - begin - INSERT_STRING(s^, n, hash_head); - end; - {if (hash_head <> 0) then - hash_head := 0; - to make compiler happy } - deflateSetDictionary := Z_OK; -end; - -{ ======================================================================== } -function deflateReset (var strm : z_stream) : int; -var - s : deflate_state_ptr; -begin - if {(@strm = Z_NULL) or} - (strm.state = Z_NULL) - or (not Assigned(strm.zalloc)) or (not Assigned(strm.zfree)) then - begin - deflateReset := Z_STREAM_ERROR; - exit; - end; - - strm.total_out := 0; - strm.total_in := 0; - strm.msg := ''; { use zfree if we ever allocate msg dynamically } - strm.data_type := Z_UNKNOWN; - - s := deflate_state_ptr(strm.state); - s^.pending := 0; - s^.pending_out := pBytef(s^.pending_buf); - - if (s^.noheader < 0) then - begin - s^.noheader := 0; { was set to -1 by deflate(..., Z_FINISH); } - end; - if s^.noheader <> 0 then - s^.status := BUSY_STATE - else - s^.status := INIT_STATE; - strm.adler := 1; - s^.last_flush := Z_NO_FLUSH; - - _tr_init(s^); - lm_init(s^); - - deflateReset := Z_OK; -end; - -{ ======================================================================== } -function deflateParams(var strm : z_stream; - level : int; - strategy : int) : int; -var - s : deflate_state_ptr; - func : compress_func; - err : int; -begin - err := Z_OK; - if {(@strm = Z_NULL) or} (strm.state = Z_NULL) then - begin - deflateParams := Z_STREAM_ERROR; - exit; - end; - - s := deflate_state_ptr(strm.state); - - if (level = Z_DEFAULT_COMPRESSION) then - begin - level := 6; - end; - if (level < 0) or (level > 9) or (strategy < 0) - or (strategy > Z_HUFFMAN_ONLY) then - begin - deflateParams := Z_STREAM_ERROR; - exit; - end; - func := configuration_table[s^.level].func; - - if (@func <> @configuration_table[level].func) - and (strm.total_in <> 0) then - begin - { Flush the last buffer: } - err := deflate(strm, Z_PARTIAL_FLUSH); - end; - if (s^.level <> level) then - begin - s^.level := level; - s^.max_lazy_match := configuration_table[level].max_lazy; - s^.good_match := configuration_table[level].good_length; - s^.nice_match := configuration_table[level].nice_length; - s^.max_chain_length := configuration_table[level].max_chain; - end; - s^.strategy := strategy; - deflateParams := err; -end; - -{ ========================================================================= - Put a short in the pending buffer. The 16-bit value is put in MSB order. - IN assertion: the stream state is correct and there is enough room in - pending_buf. } - -{local} -procedure putShortMSB (var s : deflate_state; b : uInt); -begin - s.pending_buf^[s.pending] := Byte(b shr 8); - Inc(s.pending); - s.pending_buf^[s.pending] := Byte(b and $ff); - Inc(s.pending); -end; - -{ ========================================================================= - Flush as much pending output as possible. All deflate() output goes - through this function so some applications may wish to modify it - to avoid allocating a large strm^.next_out buffer and copying into it. - (See also read_buf()). } - -{local} -procedure flush_pending(var strm : z_stream); -var - len : unsigned; - s : deflate_state_ptr; -begin - s := deflate_state_ptr(strm.state); - len := s^.pending; - - if (len > strm.avail_out) then - len := strm.avail_out; - if (len = 0) then - exit; - - zmemcpy(strm.next_out, s^.pending_out, len); - Inc(strm.next_out, len); - Inc(s^.pending_out, len); - Inc(strm.total_out, len); - Dec(strm.avail_out, len); - Dec(s^.pending, len); - if (s^.pending = 0) then - begin - s^.pending_out := pBytef(s^.pending_buf); - end; -end; - -{ ========================================================================= } -function deflate (var strm : z_stream; flush : int) : int; -var - old_flush : int; { value of flush param for previous deflate call } - s : deflate_state_ptr; -var - header : uInt; - level_flags : uInt; -var - bstate : block_state; -begin - if {(@strm = Z_NULL) or} (strm.state = Z_NULL) - or (flush > Z_FINISH) or (flush < 0) then - begin - deflate := Z_STREAM_ERROR; - exit; - end; - s := deflate_state_ptr(strm.state); - - if (strm.next_out = Z_NULL) or - ((strm.next_in = Z_NULL) and (strm.avail_in <> 0)) or - ((s^.status = FINISH_STATE) and (flush <> Z_FINISH)) then - begin - {ERR_RETURN(strm^, Z_STREAM_ERROR);} - strm.msg := z_errmsg[z_errbase - Z_STREAM_ERROR]; - deflate := Z_STREAM_ERROR; - exit; - end; - if (strm.avail_out = 0) then - begin - {ERR_RETURN(strm^, Z_BUF_ERROR);} - strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR]; - deflate := Z_BUF_ERROR; - exit; - end; - - s^.strm := @strm; { just in case } - old_flush := s^.last_flush; - s^.last_flush := flush; - - { Write the zlib header } - if (s^.status = INIT_STATE) then - begin - - header := (Z_DEFLATED + ((s^.w_bits-8) shl 4)) shl 8; - level_flags := (s^.level-1) shr 1; - - if (level_flags > 3) then - level_flags := 3; - header := header or (level_flags shl 6); - if (s^.strstart <> 0) then - header := header or PRESET_DICT; - Inc(header, 31 - (header mod 31)); - - s^.status := BUSY_STATE; - putShortMSB(s^, header); - - { Save the adler32 of the preset dictionary: } - if (s^.strstart <> 0) then - begin - putShortMSB(s^, uInt(strm.adler shr 16)); - putShortMSB(s^, uInt(strm.adler and $ffff)); - end; - strm.adler := long(1); - end; - - { Flush as much pending output as possible } - if (s^.pending <> 0) then - begin - flush_pending(strm); - if (strm.avail_out = 0) then - begin - { Since avail_out is 0, deflate will be called again with - more output space, but possibly with both pending and - avail_in equal to zero. There won't be anything to do, - but this is not an error situation so make sure we - return OK instead of BUF_ERROR at next call of deflate: } - - s^.last_flush := -1; - deflate := Z_OK; - exit; - end; - - { Make sure there is something to do and avoid duplicate consecutive - flushes. For repeated and useless calls with Z_FINISH, we keep - returning Z_STREAM_END instead of Z_BUFF_ERROR. } - - end - else - if (strm.avail_in = 0) and (flush <= old_flush) - and (flush <> Z_FINISH) then - begin - {ERR_RETURN(strm^, Z_BUF_ERROR);} - strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR]; - deflate := Z_BUF_ERROR; - exit; - end; - - { User must not provide more input after the first FINISH: } - if (s^.status = FINISH_STATE) and (strm.avail_in <> 0) then - begin - {ERR_RETURN(strm^, Z_BUF_ERROR);} - strm.msg := z_errmsg[z_errbase - Z_BUF_ERROR]; - deflate := Z_BUF_ERROR; - exit; - end; - - { Start a new block or continue the current one. } - if (strm.avail_in <> 0) or (s^.lookahead <> 0) - or ((flush <> Z_NO_FLUSH) and (s^.status <> FINISH_STATE)) then - begin - bstate := configuration_table[s^.level].func(s^, flush); - - if (bstate = finish_started) or (bstate = finish_done) then - s^.status := FINISH_STATE; - - if (bstate = need_more) or (bstate = finish_started) then - begin - if (strm.avail_out = 0) then - s^.last_flush := -1; { avoid BUF_ERROR next call, see above } - - deflate := Z_OK; - exit; - { If flush != Z_NO_FLUSH && avail_out == 0, the next call - of deflate should use the same flush parameter to make sure - that the flush is complete. So we don't have to output an - empty block here, this will be done at next call. This also - ensures that for a very small output buffer, we emit at most - one empty block. } - end; - if (bstate = block_done) then - begin - if (flush = Z_PARTIAL_FLUSH) then - _tr_align(s^) - else - begin { FULL_FLUSH or SYNC_FLUSH } - _tr_stored_block(s^, pcharf(NIL), Long(0), FALSE); - { For a full flush, this empty block will be recognized - as a special marker by inflate_sync(). } - - if (flush = Z_FULL_FLUSH) then - begin - {macro CLEAR_HASH(s);} { forget history } - s^.head^[s^.hash_size-1] := ZNIL; - zmemzero(pBytef(s^.head), unsigned(s^.hash_size-1)*sizeof(s^.head^[0])); - end; - end; - - flush_pending(strm); - if (strm.avail_out = 0) then - begin - s^.last_flush := -1; { avoid BUF_ERROR at next call, see above } - deflate := Z_OK; - exit; - end; - - end; - end; - {$IFDEF DEBUG} - Assert(strm.avail_out > 0, 'bug2'); - {$ENDIF} - if (flush <> Z_FINISH) then - begin - deflate := Z_OK; - exit; - end; - - if (s^.noheader <> 0) then - begin - deflate := Z_STREAM_END; - exit; - end; - - { Write the zlib trailer (adler32) } - putShortMSB(s^, uInt(strm.adler shr 16)); - putShortMSB(s^, uInt(strm.adler and $ffff)); - flush_pending(strm); - { If avail_out is zero, the application will call deflate again - to flush the rest. } - - s^.noheader := -1; { write the trailer only once! } - if s^.pending <> 0 then - deflate := Z_OK - else - deflate := Z_STREAM_END; -end; - -{ ========================================================================= } -function deflateEnd (var strm : z_stream) : int; -var - status : int; - s : deflate_state_ptr; -begin - if {(@strm = Z_NULL) or} (strm.state = Z_NULL) then - begin - deflateEnd := Z_STREAM_ERROR; - exit; - end; - - s := deflate_state_ptr(strm.state); - status := s^.status; - if (status <> INIT_STATE) and (status <> BUSY_STATE) and - (status <> FINISH_STATE) then - begin - deflateEnd := Z_STREAM_ERROR; - exit; - end; - - { Deallocate in reverse order of allocations: } - TRY_FREE(strm, s^.pending_buf); - TRY_FREE(strm, s^.head); - TRY_FREE(strm, s^.prev); - TRY_FREE(strm, s^.window); - - ZFREE(strm, s); - strm.state := Z_NULL; - - if status = BUSY_STATE then - deflateEnd := Z_DATA_ERROR - else - deflateEnd := Z_OK; -end; - -{ ========================================================================= - Copy the source state to the destination state. - To simplify the source, this is not supported for 16-bit MSDOS (which - doesn't have enough memory anyway to duplicate compression states). } - - -{ ========================================================================= } -function deflateCopy (dest, source : z_streamp) : int; -{$ifndef MAXSEG_64K} -var - ds : deflate_state_ptr; - ss : deflate_state_ptr; - overlay : pushfArray; -{$endif} -begin -{$ifdef MAXSEG_64K} - deflateCopy := Z_STREAM_ERROR; - exit; -{$else} - - if (source = Z_NULL) or (dest = Z_NULL) or (source^.state = Z_NULL) then - begin - deflateCopy := Z_STREAM_ERROR; - exit; - end; - ss := deflate_state_ptr(source^.state); - dest^ := source^; - - ds := deflate_state_ptr( ZALLOC(dest^, 1, sizeof(deflate_state)) ); - if (ds = Z_NULL) then - begin - deflateCopy := Z_MEM_ERROR; - exit; - end; - dest^.state := pInternal_state(ds); - ds^ := ss^; - ds^.strm := dest; - - ds^.window := pzByteArray ( ZALLOC(dest^, ds^.w_size, 2*sizeof(Byte)) ); - ds^.prev := pzPosfArray ( ZALLOC(dest^, ds^.w_size, sizeof(Pos)) ); - ds^.head := pzPosfArray ( ZALLOC(dest^, ds^.hash_size, sizeof(Pos)) ); - overlay := pushfArray ( ZALLOC(dest^, ds^.lit_bufsize, sizeof(ush)+2) ); - ds^.pending_buf := pzByteArray ( overlay ); - - if (ds^.window = Z_NULL) or (ds^.prev = Z_NULL) or (ds^.head = Z_NULL) - or (ds^.pending_buf = Z_NULL) then - begin - deflateEnd (dest^); - deflateCopy := Z_MEM_ERROR; - exit; - end; - { following zmemcpy do not work for 16-bit MSDOS } - zmemcpy(pBytef(ds^.window), pBytef(ss^.window), ds^.w_size * 2 * sizeof(Byte)); - zmemcpy(pBytef(ds^.prev), pBytef(ss^.prev), ds^.w_size * sizeof(Pos)); - zmemcpy(pBytef(ds^.head), pBytef(ss^.head), ds^.hash_size * sizeof(Pos)); - zmemcpy(pBytef(ds^.pending_buf), pBytef(ss^.pending_buf), uInt(ds^.pending_buf_size)); - - ds^.pending_out := @ds^.pending_buf^[ptr2int(ss^.pending_out) - ptr2int(ss^.pending_buf)]; - ds^.d_buf := pushfArray (@overlay^[ds^.lit_bufsize div sizeof(ush)] ); - ds^.l_buf := puchfArray (@ds^.pending_buf^[(1+sizeof(ush))*ds^.lit_bufsize]); - - ds^.l_desc.dyn_tree := tree_ptr(@ds^.dyn_ltree); - ds^.d_desc.dyn_tree := tree_ptr(@ds^.dyn_dtree); - ds^.bl_desc.dyn_tree := tree_ptr(@ds^.bl_tree); - - deflateCopy := Z_OK; -{$endif} -end; - - -{ =========================================================================== - Read a new buffer from the current input stream, update the adler32 - and total number of bytes read. All deflate() input goes through - this function so some applications may wish to modify it to avoid - allocating a large strm^.next_in buffer and copying from it. - (See also flush_pending()). } - -{local} -function read_buf(strm : z_streamp; buf : pBytef; size : unsigned) : int; -var - len : unsigned; -begin - len := strm^.avail_in; - - if (len > size) then - len := size; - if (len = 0) then - begin - read_buf := 0; - exit; - end; - - Dec(strm^.avail_in, len); - - if deflate_state_ptr(strm^.state)^.noheader = 0 then - begin - strm^.adler := adler32(strm^.adler, strm^.next_in, len); - end; - zmemcpy(buf, strm^.next_in, len); - Inc(strm^.next_in, len); - Inc(strm^.total_in, len); - - read_buf := int(len); -end; - -{ =========================================================================== - Initialize the "longest match" routines for a new zlib stream } - -{local} -procedure lm_init (var s : deflate_state); -begin - s.window_size := ulg( uLong(2)*s.w_size); - - {macro CLEAR_HASH(s);} - s.head^[s.hash_size-1] := ZNIL; - zmemzero(pBytef(s.head), unsigned(s.hash_size-1)*sizeof(s.head^[0])); - - { Set the default configuration parameters: } - - s.max_lazy_match := configuration_table[s.level].max_lazy; - s.good_match := configuration_table[s.level].good_length; - s.nice_match := configuration_table[s.level].nice_length; - s.max_chain_length := configuration_table[s.level].max_chain; - - s.strstart := 0; - s.block_start := long(0); - s.lookahead := 0; - s.prev_length := MIN_MATCH-1; - s.match_length := MIN_MATCH-1; - s.match_available := FALSE; - s.ins_h := 0; -{$ifdef ASMV} - match_init; { initialize the asm code } -{$endif} -end; - -{ =========================================================================== - Set match_start to the longest match starting at the given string and - return its length. Matches shorter or equal to prev_length are discarded, - in which case the result is equal to prev_length and match_start is - garbage. - IN assertions: cur_match is the head of the hash chain for the current - string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 - OUT assertion: the match length is not greater than s^.lookahead. } - - -{$ifndef ASMV} -{ For 80x86 and 680x0, an optimized version will be provided in match.asm or - match.S. The code will be functionally equivalent. } - -{$ifndef FASTEST} - -{local} -function longest_match(var s : deflate_state; - cur_match : IPos { current match } - ) : uInt; -label - nextstep; -var - chain_length : unsigned; { max hash chain length } - {register} scan : pBytef; { current string } - {register} match : pBytef; { matched string } - {register} len : int; { length of current match } - best_len : int; { best match length so far } - nice_match : int; { stop if match long enough } - limit : IPos; - - prev : pzPosfArray; - wmask : uInt; -{$ifdef UNALIGNED_OK} - {register} strend : pBytef; - {register} scan_start : ush; - {register} scan_end : ush; -{$else} - {register} strend : pBytef; - {register} scan_end1 : Byte; - {register} scan_end : Byte; -{$endif} -var - MAX_DIST : uInt; -begin - chain_length := s.max_chain_length; { max hash chain length } - scan := @(s.window^[s.strstart]); - best_len := s.prev_length; { best match length so far } - nice_match := s.nice_match; { stop if match long enough } - - - MAX_DIST := s.w_size - MIN_LOOKAHEAD; -{In order to simplify the code, particularly on 16 bit machines, match -distances are limited to MAX_DIST instead of WSIZE. } - - if s.strstart > IPos(MAX_DIST) then - limit := s.strstart - IPos(MAX_DIST) - else - limit := ZNIL; - { Stop when cur_match becomes <= limit. To simplify the code, - we prevent matches with the string of window index 0. } - - prev := s.prev; - wmask := s.w_mask; - -{$ifdef UNALIGNED_OK} - { Compare two bytes at a time. Note: this is not always beneficial. - Try with and without -DUNALIGNED_OK to check. } - - strend := pBytef(@(s.window^[s.strstart + MAX_MATCH - 1])); - scan_start := pushf(scan)^; - scan_end := pushfArray(scan)^[best_len-1]; { fix } -{$else} - strend := pBytef(@(s.window^[s.strstart + MAX_MATCH])); - {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF} - scan_end1 := pzByteArray(scan)^[best_len-1]; - {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF} - scan_end := pzByteArray(scan)^[best_len]; -{$endif} - - { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. - It is easy to get rid of this optimization if necessary. } - {$IFDEF DEBUG} - Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever'); - {$ENDIF} - { Do not waste too much time if we already have a good match: } - if (s.prev_length >= s.good_match) then - begin - chain_length := chain_length shr 2; - end; - - { Do not look for matches beyond the end of the input. This is necessary - to make deflate deterministic. } - - if (uInt(nice_match) > s.lookahead) then - nice_match := s.lookahead; - {$IFDEF DEBUG} - Assert(ulg(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead'); - {$ENDIF} - repeat - {$IFDEF DEBUG} - Assert(cur_match < s.strstart, 'no future'); - {$ENDIF} - match := @(s.window^[cur_match]); - - { Skip to next match if the match length cannot increase - or if the match length is less than 2: } - -{$undef DO_UNALIGNED_OK} -{$ifdef UNALIGNED_OK} - {$ifdef MAX_MATCH_IS_258} - {$define DO_UNALIGNED_OK} - {$endif} -{$endif} - -{$ifdef DO_UNALIGNED_OK} - { This code assumes sizeof(unsigned short) = 2. Do not use - UNALIGNED_OK if your compiler uses a different size. } - {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF} - if (pushfArray(match)^[best_len-1] <> scan_end) or - (pushf(match)^ <> scan_start) then - goto nextstep; {continue;} - {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF} - - { It is not necessary to compare scan[2] and match[2] since they are - always equal when the other bytes match, given that the hash keys - are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at - strstart+3, +5, ... up to strstart+257. We check for insufficient - lookahead only every 4th comparison; the 128th check will be made - at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is - necessary to put more guard bytes at the end of the window, or - to check more often for insufficient lookahead. } - {$IFDEF DEBUG} - Assert(pzByteArray(scan)^[2] = pzByteArray(match)^[2], 'scan[2]?'); - {$ENDIF} - Inc(scan); - Inc(match); - - repeat - Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break; - Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break; - Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break; - Inc(scan,2); Inc(match,2); if (pushf(scan)^<>pushf(match)^) then break; - until (ptr2int(scan) >= ptr2int(strend)); - { The funny "do while" generates better code on most compilers } - - { Here, scan <= window+strstart+257 } - {$IFDEF DEBUG} - {$ifopt R+} {$define RangeCheck} {$endif} {$R-} - Assert(ptr2int(scan) <= - ptr2int(@(s.window^[unsigned(s.window_size-1)])), - 'wild scan'); - {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif} - {$ENDIF} - if (scan^ = match^) then - Inc(scan); - - len := (MAX_MATCH - 1) - int(ptr2int(strend)) + int(ptr2int(scan)); - scan := strend; - Dec(scan, (MAX_MATCH-1)); - -{$else} { UNALIGNED_OK } - - {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF} - if (pzByteArray(match)^[best_len] <> scan_end) or - (pzByteArray(match)^[best_len-1] <> scan_end1) or - (match^ <> scan^) then - goto nextstep; {continue;} - {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF} - Inc(match); - if (match^ <> pzByteArray(scan)^[1]) then - goto nextstep; {continue;} - - { The check at best_len-1 can be removed because it will be made - again later. (This heuristic is not always a win.) - It is not necessary to compare scan[2] and match[2] since they - are always equal when the other bytes match, given that - the hash keys are equal and that HASH_BITS >= 8. } - - Inc(scan, 2); - Inc(match); - {$IFDEF DEBUG} - Assert( scan^ = match^, 'match[2]?'); - {$ENDIF} - { We check for insufficient lookahead only every 8th comparison; - the 256th check will be made at strstart+258. } - - repeat - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - Inc(scan); Inc(match); if (scan^ <> match^) then break; - until (ptr2int(scan) >= ptr2int(strend)); - - {$IFDEF DEBUG} - Assert(ptr2int(scan) <= - ptr2int(@(s.window^[unsigned(s.window_size-1)])), - 'wild scan'); - {$ENDIF} - - len := MAX_MATCH - int(ptr2int(strend) - ptr2int(scan)); - scan := strend; - Dec(scan, MAX_MATCH); - -{$endif} { UNALIGNED_OK } - - if (len > best_len) then - begin - s.match_start := cur_match; - best_len := len; - if (len >= nice_match) then - break; - {$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF} -{$ifdef UNALIGNED_OK} - scan_end := pzByteArray(scan)^[best_len-1]; -{$else} - scan_end1 := pzByteArray(scan)^[best_len-1]; - scan_end := pzByteArray(scan)^[best_len]; -{$endif} - {$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF} - end; - nextstep: - cur_match := prev^[cur_match and wmask]; - Dec(chain_length); - until (cur_match <= limit) or (chain_length = 0); - - if (uInt(best_len) <= s.lookahead) then - longest_match := uInt(best_len) - else - longest_match := s.lookahead; -end; -{$endif} { ASMV } - -{$else} { FASTEST } -{ --------------------------------------------------------------------------- - Optimized version for level = 1 only } - -{local} -function longest_match(var s : deflate_state; - cur_match : IPos { current match } - ) : uInt; -var - {register} scan : pBytef; { current string } - {register} match : pBytef; { matched string } - {register} len : int; { length of current match } - {register} strend : pBytef; -begin - scan := @s.window^[s.strstart]; - strend := @s.window^[s.strstart + MAX_MATCH]; - - - { The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. - It is easy to get rid of this optimization if necessary. } - {$IFDEF DEBUG} - Assert((s.hash_bits >= 8) and (MAX_MATCH = 258), 'Code too clever'); - - Assert(ulg(s.strstart) <= s.window_size-MIN_LOOKAHEAD, 'need lookahead'); - - Assert(cur_match < s.strstart, 'no future'); - {$ENDIF} - match := s.window + cur_match; - - { Return failure if the match length is less than 2: } - - if (match[0] <> scan[0]) or (match[1] <> scan[1]) then - begin - longest_match := MIN_MATCH-1; - exit; - end; - - { The check at best_len-1 can be removed because it will be made - again later. (This heuristic is not always a win.) - It is not necessary to compare scan[2] and match[2] since they - are always equal when the other bytes match, given that - the hash keys are equal and that HASH_BITS >= 8. } - - scan += 2, match += 2; - Assert(scan^ = match^, 'match[2]?'); - - { We check for insufficient lookahead only every 8th comparison; - the 256th check will be made at strstart+258. } - - repeat - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - Inc(scan); Inc(match); if scan^<>match^ then break; - until (ptr2int(scan) >= ptr2int(strend)); - - Assert(scan <= s.window+unsigned(s.window_size-1), 'wild scan'); - - len := MAX_MATCH - int(strend - scan); - - if (len < MIN_MATCH) then - begin - return := MIN_MATCH - 1; - exit; - end; - - s.match_start := cur_match; - if len <= s.lookahead then - longest_match := len - else - longest_match := s.lookahead; -end; -{$endif} { FASTEST } - -{$ifdef DEBUG} -{ =========================================================================== - Check that the match at match_start is indeed a match. } - -{local} -procedure check_match(var s : deflate_state; - start, match : IPos; - length : int); -begin - exit; - { check that the match is indeed a match } - if (zmemcmp(pBytef(@s.window^[match]), - pBytef(@s.window^[start]), length) <> EQUAL) then - begin - WriteLn(' start ',start,', match ',match ,' length ', length); - repeat - Write(AnsiChar(s.window^[match]), AnsiChar(s.window^[start])); - Inc(match); - Inc(start); - Dec(length); - Until (length = 0); - z_error('invalid match'); - end; - if (z_verbose > 1) then - begin - Write('\\[',start-match,',',length,']'); - repeat - Write(AnsiChar(s.window^[start])); - Inc(start); - Dec(length); - Until (length = 0); - end; -end; -{$endif} - -{ =========================================================================== - Fill the window when the lookahead becomes insufficient. - Updates strstart and lookahead. - - IN assertion: lookahead < MIN_LOOKAHEAD - OUT assertions: strstart <= window_size-MIN_LOOKAHEAD - At least one byte has been read, or avail_in = 0; reads are - performed for at least two bytes (required for the zip translate_eol - option -- not supported here). } - -{local} -procedure fill_window(var s : deflate_state); -var - {register} n, m : unsigned; - {register} p : pPosf; - more : unsigned; { Amount of free space at the end of the window. } - wsize : uInt; -begin - wsize := s.w_size; - repeat - more := unsigned(s.window_size -ulg(s.lookahead) -ulg(s.strstart)); - - { Deal with !@#$% 64K limit: } - if (more = 0) and (s.strstart = 0) and (s.lookahead = 0) then - more := wsize - else - if (more = unsigned(-1)) then - begin - { Very unlikely, but possible on 16 bit machine if strstart = 0 - and lookahead = 1 (input done one byte at time) } - Dec(more); - - { If the window is almost full and there is insufficient lookahead, - move the upper half to the lower one to make room in the upper half.} - end - else - if (s.strstart >= wsize+ {MAX_DIST}(wsize-MIN_LOOKAHEAD)) then - begin - zmemcpy( pBytef(s.window), pBytef(@(s.window^[wsize])), - unsigned(wsize)); - Dec(s.match_start, wsize); - Dec(s.strstart, wsize); { we now have strstart >= MAX_DIST } - Dec(s.block_start, long(wsize)); - - { Slide the hash table (could be avoided with 32 bit values - at the expense of memory usage). We slide even when level = 0 - to keep the hash table consistent if we switch back to level > 0 - later. (Using level 0 permanently is not an optimal usage of - zlib, so we don't care about this pathological case.) } - - n := s.hash_size; - p := @s.head^[n]; - repeat - Dec(p); - m := p^; - if (m >= wsize) then - p^ := Pos(m-wsize) - else - p^ := Pos(ZNIL); - Dec(n); - Until (n=0); - - n := wsize; -{$ifndef FASTEST} - p := @s.prev^[n]; - repeat - Dec(p); - m := p^; - if (m >= wsize) then - p^ := Pos(m-wsize) - else - p^:= Pos(ZNIL); - { If n is not on any hash chain, prev^[n] is garbage but - its value will never be used. } - Dec(n); - Until (n=0); -{$endif} - Inc(more, wsize); - end; - if (s.strm^.avail_in = 0) then - exit; - - {* If there was no sliding: - * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && - * more == window_size - lookahead - strstart - * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) - * => more >= window_size - 2*WSIZE + 2 - * In the BIG_MEM or MMAP case (not yet supported), - * window_size == input_size + MIN_LOOKAHEAD && - * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. - * Otherwise, window_size == 2*WSIZE so more >= 2. - * If there was sliding, more >= WSIZE. So in all cases, more >= 2. } - - {$IFDEF DEBUG} - Assert(more >= 2, 'more < 2'); - {$ENDIF} - - n := read_buf(s.strm, pBytef(@(s.window^[s.strstart + s.lookahead])), - more); - Inc(s.lookahead, n); - - { Initialize the hash value now that we have some input: } - if (s.lookahead >= MIN_MATCH) then - begin - s.ins_h := s.window^[s.strstart]; - {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);} - s.ins_h := ((s.ins_h shl s.hash_shift) xor s.window^[s.strstart+1]) - and s.hash_mask; -{$ifdef MIN_MATCH <> 3} - Call UPDATE_HASH() MIN_MATCH-3 more times -{$endif} - end; - { If the whole input has less than MIN_MATCH bytes, ins_h is garbage, - but this is not important since only literal bytes will be emitted. } - - until (s.lookahead >= MIN_LOOKAHEAD) or (s.strm^.avail_in = 0); -end; - -{ =========================================================================== - Flush the current block, with given end-of-file flag. - IN assertion: strstart is set to the end of the current match. } - -procedure FLUSH_BLOCK_ONLY(var s : deflate_state; eof : boolean); {macro} -begin - if (s.block_start >= Long(0)) then - _tr_flush_block(s, pcharf(@s.window^[unsigned(s.block_start)]), - ulg(long(s.strstart) - s.block_start), eof) - else - _tr_flush_block(s, pcharf(Z_NULL), - ulg(long(s.strstart) - s.block_start), eof); - - s.block_start := s.strstart; - flush_pending(s.strm^); - {$IFDEF DEBUG} - Tracev('[FLUSH]'); - {$ENDIF} -end; - -{ Same but force premature exit if necessary. -macro FLUSH_BLOCK(var s : deflate_state; eof : boolean) : boolean; -var - result : block_state; -begin - FLUSH_BLOCK_ONLY(s, eof); - if (s.strm^.avail_out = 0) then - begin - if eof then - result := finish_started - else - result := need_more; - exit; - end; -end; -} - -{ =========================================================================== - Copy without compression as much as possible from the input stream, return - the current block state. - This function does not insert new strings in the dictionary since - uncompressible data is probably not useful. This function is used - only for the level=0 compression option. - NOTE: this function should be optimized to avoid extra copying from - window to pending_buf. } - - -{local} -function deflate_stored(var s : deflate_state; flush : int) : block_state; -{ Stored blocks are limited to 0xffff bytes, pending_buf is limited - to pending_buf_size, and each stored block has a 5 byte header: } -var - max_block_size : ulg; - max_start : ulg; -begin - max_block_size := $ffff; - if (max_block_size > s.pending_buf_size - 5) then - max_block_size := s.pending_buf_size - 5; - - { Copy as much as possible from input to output: } - while TRUE do - begin - { Fill the window as much as possible: } - if (s.lookahead <= 1) then - begin - {$IFDEF DEBUG} - Assert( (s.strstart < s.w_size + {MAX_DIST}s.w_size-MIN_LOOKAHEAD) or - (s.block_start >= long(s.w_size)), 'slide too late'); - {$ENDIF} - fill_window(s); - if (s.lookahead = 0) and (flush = Z_NO_FLUSH) then - begin - deflate_stored := need_more; - exit; - end; - - if (s.lookahead = 0) then - break; { flush the current block } - end; - {$IFDEF DEBUG} - Assert(s.block_start >= long(0), 'block gone'); - {$ENDIF} - Inc(s.strstart, s.lookahead); - s.lookahead := 0; - - { Emit a stored block if pending_buf will be full: } - max_start := s.block_start + max_block_size; - if (s.strstart = 0) or (ulg(s.strstart) >= max_start) then - begin - { strstart = 0 is possible when wraparound on 16-bit machine } - s.lookahead := s.strstart - uInt(max_start); - s.strstart := uInt(max_start); - {FLUSH_BLOCK(s, FALSE);} - FLUSH_BLOCK_ONLY(s, FALSE); - if (s.strm^.avail_out = 0) then - begin - deflate_stored := need_more; - exit; - end; - end; - - { Flush if we may have to slide, otherwise block_start may become - negative and the data will be gone: } - - if (s.strstart - uInt(s.block_start) >= {MAX_DIST} - s.w_size-MIN_LOOKAHEAD) then - begin - {FLUSH_BLOCK(s, FALSE);} - FLUSH_BLOCK_ONLY(s, FALSE); - if (s.strm^.avail_out = 0) then - begin - deflate_stored := need_more; - exit; - end; - end; - end; - - {FLUSH_BLOCK(s, flush = Z_FINISH);} - FLUSH_BLOCK_ONLY(s, flush = Z_FINISH); - if (s.strm^.avail_out = 0) then - begin - if flush = Z_FINISH then - deflate_stored := finish_started - else - deflate_stored := need_more; - exit; - end; - - if flush = Z_FINISH then - deflate_stored := finish_done - else - deflate_stored := block_done; -end; - -{ =========================================================================== - Compress as much as possible from the input stream, return the current - block state. - This function does not perform lazy evaluation of matches and inserts - new strings in the dictionary only for unmatched strings or for short - matches. It is used only for the fast compression options. } - -{local} -function deflate_fast(var s : deflate_state; flush : int) : block_state; -var - hash_head : IPos; { head of the hash chain } - bflush : boolean; { set if current block must be flushed } -begin - hash_head := ZNIL; - while TRUE do - begin - { Make sure that we always have enough lookahead, except - at the end of the input file. We need MAX_MATCH bytes - for the next match, plus MIN_MATCH bytes to insert the - string following the next match. } - - if (s.lookahead < MIN_LOOKAHEAD) then - begin - fill_window(s); - if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then - begin - deflate_fast := need_more; - exit; - end; - - if (s.lookahead = 0) then - break; { flush the current block } - end; - - - { Insert the string window[strstart .. strstart+2] in the - dictionary, and set hash_head to the head of the hash chain: } - - if (s.lookahead >= MIN_MATCH) then - begin - INSERT_STRING(s, s.strstart, hash_head); - end; - - { Find the longest match, discarding those <= prev_length. - At this point we have always match_length < MIN_MATCH } - if (hash_head <> ZNIL) and - (s.strstart - hash_head <= (s.w_size-MIN_LOOKAHEAD){MAX_DIST}) then - begin - { To simplify the code, we prevent matches with the string - of window index 0 (in particular we have to avoid a match - of the string with itself at the start of the input file). } - if (s.strategy <> Z_HUFFMAN_ONLY) then - begin - s.match_length := longest_match (s, hash_head); - end; - { longest_match() sets match_start } - end; - if (s.match_length >= MIN_MATCH) then - begin - {$IFDEF DEBUG} - check_match(s, s.strstart, s.match_start, s.match_length); - {$ENDIF} - - {_tr_tally_dist(s, s.strstart - s.match_start, - s.match_length - MIN_MATCH, bflush);} - bflush := _tr_tally(s, s.strstart - s.match_start, - s.match_length - MIN_MATCH); - - Dec(s.lookahead, s.match_length); - - { Insert new strings in the hash table only if the match length - is not too large. This saves time but degrades compression. } - -{$ifndef FASTEST} - if (s.match_length <= s.max_insert_length) - and (s.lookahead >= MIN_MATCH) then - begin - Dec(s.match_length); { string at strstart already in hash table } - repeat - Inc(s.strstart); - INSERT_STRING(s, s.strstart, hash_head); - { strstart never exceeds WSIZE-MAX_MATCH, so there are - always MIN_MATCH bytes ahead. } - Dec(s.match_length); - until (s.match_length = 0); - Inc(s.strstart); - end - else -{$endif} - - begin - Inc(s.strstart, s.match_length); - s.match_length := 0; - s.ins_h := s.window^[s.strstart]; - {UPDATE_HASH(s, s.ins_h, s.window[s.strstart+1]);} - s.ins_h := (( s.ins_h shl s.hash_shift) xor - s.window^[s.strstart+1]) and s.hash_mask; -if MIN_MATCH <> 3 then { the linker removes this } -begin - {Call UPDATE_HASH() MIN_MATCH-3 more times} -end; - - { If lookahead < MIN_MATCH, ins_h is garbage, but it does not - matter since it will be recomputed at next deflate call. } - - end; - end - else - begin - { No match, output a literal byte } - {$IFDEF DEBUG} - Tracevv(AnsiChar(s.window^[s.strstart])); - {$ENDIF} - {_tr_tally_lit (s, 0, s.window^[s.strstart], bflush);} - bflush := _tr_tally (s, 0, s.window^[s.strstart]); - - Dec(s.lookahead); - Inc(s.strstart); - end; - if bflush then - begin {FLUSH_BLOCK(s, FALSE);} - FLUSH_BLOCK_ONLY(s, FALSE); - if (s.strm^.avail_out = 0) then - begin - deflate_fast := need_more; - exit; - end; - end; - end; - {FLUSH_BLOCK(s, flush = Z_FINISH);} - FLUSH_BLOCK_ONLY(s, flush = Z_FINISH); - if (s.strm^.avail_out = 0) then - begin - if flush = Z_FINISH then - deflate_fast := finish_started - else - deflate_fast := need_more; - exit; - end; - - if flush = Z_FINISH then - deflate_fast := finish_done - else - deflate_fast := block_done; -end; - -{ =========================================================================== - Same as above, but achieves better compression. We use a lazy - evaluation for matches: a match is finally adopted only if there is - no better match at the next window position. } - -{local} -function deflate_slow(var s : deflate_state; flush : int) : block_state; -var - hash_head : IPos; { head of hash chain } - bflush : boolean; { set if current block must be flushed } -var - max_insert : uInt; -begin - hash_head := ZNIL; - - { Process the input block. } - while TRUE do - begin - { Make sure that we always have enough lookahead, except - at the end of the input file. We need MAX_MATCH bytes - for the next match, plus MIN_MATCH bytes to insert the - string following the next match. } - - if (s.lookahead < MIN_LOOKAHEAD) then - begin - fill_window(s); - if (s.lookahead < MIN_LOOKAHEAD) and (flush = Z_NO_FLUSH) then - begin - deflate_slow := need_more; - exit; - end; - - if (s.lookahead = 0) then - break; { flush the current block } - end; - - { Insert the string window[strstart .. strstart+2] in the - dictionary, and set hash_head to the head of the hash chain: } - - if (s.lookahead >= MIN_MATCH) then - begin - INSERT_STRING(s, s.strstart, hash_head); - end; - - { Find the longest match, discarding those <= prev_length. } - - s.prev_length := s.match_length; - s.prev_match := s.match_start; - s.match_length := MIN_MATCH-1; - - if (hash_head <> ZNIL) and (s.prev_length < s.max_lazy_match) and - (s.strstart - hash_head <= {MAX_DIST}(s.w_size-MIN_LOOKAHEAD)) then - begin - { To simplify the code, we prevent matches with the string - of window index 0 (in particular we have to avoid a match - of the string with itself at the start of the input file). } - - if (s.strategy <> Z_HUFFMAN_ONLY) then - begin - s.match_length := longest_match (s, hash_head); - end; - { longest_match() sets match_start } - - if (s.match_length <= 5) and ((s.strategy = Z_FILTERED) or - ((s.match_length = MIN_MATCH) and - (s.strstart - s.match_start > TOO_FAR))) then - begin - { If prev_match is also MIN_MATCH, match_start is garbage - but we will ignore the current match anyway. } - - s.match_length := MIN_MATCH-1; - end; - end; - { If there was a match at the previous step and the current - match is not better, output the previous match: } - - if (s.prev_length >= MIN_MATCH) - and (s.match_length <= s.prev_length) then - begin - max_insert := s.strstart + s.lookahead - MIN_MATCH; - { Do not insert strings in hash table beyond this. } - {$ifdef DEBUG} - check_match(s, s.strstart-1, s.prev_match, s.prev_length); - {$endif} - - {_tr_tally_dist(s, s->strstart -1 - s->prev_match, - s->prev_length - MIN_MATCH, bflush);} - bflush := _tr_tally(s, s.strstart -1 - s.prev_match, - s.prev_length - MIN_MATCH); - - { Insert in hash table all strings up to the end of the match. - strstart-1 and strstart are already inserted. If there is not - enough lookahead, the last two strings are not inserted in - the hash table. } - - Dec(s.lookahead, s.prev_length-1); - Dec(s.prev_length, 2); - repeat - Inc(s.strstart); - if (s.strstart <= max_insert) then - begin - INSERT_STRING(s, s.strstart, hash_head); - end; - Dec(s.prev_length); - until (s.prev_length = 0); - s.match_available := FALSE; - s.match_length := MIN_MATCH-1; - Inc(s.strstart); - - if (bflush) then {FLUSH_BLOCK(s, FALSE);} - begin - FLUSH_BLOCK_ONLY(s, FALSE); - if (s.strm^.avail_out = 0) then - begin - deflate_slow := need_more; - exit; - end; - end; - end - else - if (s.match_available) then - begin - { If there was no match at the previous position, output a - single literal. If there was a match but the current match - is longer, truncate the previous match to a single literal. } - {$IFDEF DEBUG} - Tracevv(AnsiChar(s.window^[s.strstart-1])); - {$ENDIF} - bflush := _tr_tally (s, 0, s.window^[s.strstart-1]); - - if bflush then - begin - FLUSH_BLOCK_ONLY(s, FALSE); - end; - Inc(s.strstart); - Dec(s.lookahead); - if (s.strm^.avail_out = 0) then - begin - deflate_slow := need_more; - exit; - end; - end - else - begin - { There is no previous match to compare with, wait for - the next step to decide. } - - s.match_available := TRUE; - Inc(s.strstart); - Dec(s.lookahead); - end; - end; - - {$IFDEF DEBUG} - Assert (flush <> Z_NO_FLUSH, 'no flush?'); - {$ENDIF} - if (s.match_available) then - begin - {$IFDEF DEBUG} - Tracevv(AnsiChar(s.window^[s.strstart-1])); - bflush := - {$ENDIF} - _tr_tally (s, 0, s.window^[s.strstart-1]); - s.match_available := FALSE; - end; - {FLUSH_BLOCK(s, flush = Z_FINISH);} - FLUSH_BLOCK_ONLY(s, flush = Z_FINISH); - if (s.strm^.avail_out = 0) then - begin - if flush = Z_FINISH then - deflate_slow := finish_started - else - deflate_slow := need_more; - exit; - end; - if flush = Z_FINISH then - deflate_slow := finish_done - else - deflate_slow := block_done; -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/imzinflate.pas b/3rd/Imaging/Source/ZLib/imzinflate.pas deleted file mode 100644 index 69849508f..000000000 --- a/3rd/Imaging/Source/ZLib/imzinflate.pas +++ /dev/null @@ -1,750 +0,0 @@ -Unit imzinflate; - -{ inflate.c -- zlib interface to inflate modules - Copyright (C) 1995-1998 Mark Adler - - Pascal tranlastion - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -uses - imzutil, impaszlib, iminfblock, iminfutil; - -function inflateInit(var z : z_stream) : int; - -{ Initializes the internal stream state for decompression. The fields - zalloc, zfree and opaque must be initialized before by the caller. If - zalloc and zfree are set to Z_NULL, inflateInit updates them to use default - allocation functions. - - inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not - enough memory, Z_VERSION_ERROR if the zlib library version is incompatible - with the version assumed by the caller. msg is set to null if there is no - error message. inflateInit does not perform any decompression: this will be - done by inflate(). } - - - -function inflateInit_(z : z_streamp; - const version : AnsiString; - stream_size : int) : int; - - -function inflateInit2_(var z: z_stream; - w : int; - const version : AnsiString; - stream_size : int) : int; - -function inflateInit2(var z: z_stream; - windowBits : int) : int; - -{ - This is another version of inflateInit with an extra parameter. The - fields next_in, avail_in, zalloc, zfree and opaque must be initialized - before by the caller. - - The windowBits parameter is the base two logarithm of the maximum window - size (the size of the history buffer). It should be in the range 8..15 for - this version of the library. The default value is 15 if inflateInit is used - instead. If a compressed stream with a larger window size is given as - input, inflate() will return with the error code Z_DATA_ERROR instead of - trying to allocate a larger window. - - inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough - memory, Z_STREAM_ERROR if a parameter is invalid (such as a negative - memLevel). msg is set to null if there is no error message. inflateInit2 - does not perform any decompression apart from reading the zlib header if - present: this will be done by inflate(). (So next_in and avail_in may be - modified, but next_out and avail_out are unchanged.) -} - - - -function inflateEnd(var z : z_stream) : int; - -{ - All dynamically allocated data structures for this stream are freed. - This function discards any unprocessed input and does not flush any - pending output. - - inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state - was inconsistent. In the error case, msg may be set but then points to a - static string (which must not be deallocated). -} - -function inflateReset(var z : z_stream) : int; - -{ - This function is equivalent to inflateEnd followed by inflateInit, - but does not free and reallocate all the internal decompression state. - The stream will keep attributes that may have been set by inflateInit2. - - inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source - stream state was inconsistent (such as zalloc or state being NULL). -} - - -function inflate(var z : z_stream; - f : int) : int; -{ - inflate decompresses as much data as possible, and stops when the input - buffer becomes empty or the output buffer becomes full. It may introduce - some output latency (reading input without producing any output) - except when forced to flush. - - The detailed semantics are as follows. inflate performs one or both of the - following actions: - - - Decompress more input starting at next_in and update next_in and avail_in - accordingly. If not all input can be processed (because there is not - enough room in the output buffer), next_in is updated and processing - will resume at this point for the next call of inflate(). - - - Provide more output starting at next_out and update next_out and avail_out - accordingly. inflate() provides as much output as possible, until there - is no more input data or no more space in the output buffer (see below - about the flush parameter). - - Before the call of inflate(), the application should ensure that at least - one of the actions is possible, by providing more input and/or consuming - more output, and updating the next_* and avail_* values accordingly. - The application can consume the uncompressed output when it wants, for - example when the output buffer is full (avail_out == 0), or after each - call of inflate(). If inflate returns Z_OK and with zero avail_out, it - must be called again after making room in the output buffer because there - might be more output pending. - - If the parameter flush is set to Z_SYNC_FLUSH, inflate flushes as much - output as possible to the output buffer. The flushing behavior of inflate is - not specified for values of the flush parameter other than Z_SYNC_FLUSH - and Z_FINISH, but the current implementation actually flushes as much output - as possible anyway. - - inflate() should normally be called until it returns Z_STREAM_END or an - error. However if all decompression is to be performed in a single step - (a single call of inflate), the parameter flush should be set to - Z_FINISH. In this case all pending input is processed and all pending - output is flushed; avail_out must be large enough to hold all the - uncompressed data. (The size of the uncompressed data may have been saved - by the compressor for this purpose.) The next operation on this stream must - be inflateEnd to deallocate the decompression state. The use of Z_FINISH - is never required, but can be used to inform inflate that a faster routine - may be used for the single inflate() call. - - If a preset dictionary is needed at this point (see inflateSetDictionary - below), inflate sets strm-adler to the adler32 checksum of the - dictionary chosen by the compressor and returns Z_NEED_DICT; otherwise - it sets strm->adler to the adler32 checksum of all output produced - so far (that is, total_out bytes) and returns Z_OK, Z_STREAM_END or - an error code as described below. At the end of the stream, inflate() - checks that its computed adler32 checksum is equal to that saved by the - compressor and returns Z_STREAM_END only if the checksum is correct. - - inflate() returns Z_OK if some progress has been made (more input processed - or more output produced), Z_STREAM_END if the end of the compressed data has - been reached and all uncompressed output has been produced, Z_NEED_DICT if a - preset dictionary is needed at this point, Z_DATA_ERROR if the input data was - corrupted (input stream not conforming to the zlib format or incorrect - adler32 checksum), Z_STREAM_ERROR if the stream structure was inconsistent - (for example if next_in or next_out was NULL), Z_MEM_ERROR if there was not - enough memory, Z_BUF_ERROR if no progress is possible or if there was not - enough room in the output buffer when Z_FINISH is used. In the Z_DATA_ERROR - case, the application may then call inflateSync to look for a good - compression block. -} - - -function inflateSetDictionary(var z : z_stream; - dictionary : pBytef; {const array of byte} - dictLength : uInt) : int; - -{ - Initializes the decompression dictionary from the given uncompressed byte - sequence. This function must be called immediately after a call of inflate - if this call returned Z_NEED_DICT. The dictionary chosen by the compressor - can be determined from the Adler32 value returned by this call of - inflate. The compressor and decompressor must use exactly the same - dictionary (see deflateSetDictionary). - - inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a - parameter is invalid (such as NULL dictionary) or the stream state is - inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the - expected one (incorrect Adler32 value). inflateSetDictionary does not - perform any decompression: this will be done by subsequent calls of - inflate(). -} - -function inflateSync(var z : z_stream) : int; - -{ - Skips invalid compressed data until a full flush point (see above the - description of deflate with Z_FULL_FLUSH) can be found, or until all - available input is skipped. No output is provided. - - inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR - if no more input was provided, Z_DATA_ERROR if no flush point has been found, - or Z_STREAM_ERROR if the stream structure was inconsistent. In the success - case, the application may save the current current value of total_in which - indicates where valid compressed data was found. In the error case, the - application may repeatedly call inflateSync, providing more input each time, - until success or end of the input data. -} - - -function inflateSyncPoint(var z : z_stream) : int; - - -implementation - -uses - imadler; - -function inflateReset(var z : z_stream) : int; -begin - if (z.state = Z_NULL) then - begin - inflateReset := Z_STREAM_ERROR; - exit; - end; - z.total_out := 0; - z.total_in := 0; - z.msg := ''; - if z.state^.nowrap then - z.state^.mode := BLOCKS - else - z.state^.mode := METHOD; - inflate_blocks_reset(z.state^.blocks^, z, Z_NULL); - {$IFDEF DEBUG} - Tracev('inflate: reset'); - {$ENDIF} - inflateReset := Z_OK; -end; - - -function inflateEnd(var z : z_stream) : int; -begin - if (z.state = Z_NULL) or not Assigned(z.zfree) then - begin - inflateEnd := Z_STREAM_ERROR; - exit; - end; - if (z.state^.blocks <> Z_NULL) then - inflate_blocks_free(z.state^.blocks, z); - ZFREE(z, z.state); - z.state := Z_NULL; - {$IFDEF DEBUG} - Tracev('inflate: end'); - {$ENDIF} - inflateEnd := Z_OK; -end; - - -function inflateInit2_(var z: z_stream; - w : int; - const version : AnsiString; - stream_size : int) : int; -begin - if (version = '') or (version[1] <> ZLIB_VERSION[1]) or - (stream_size <> sizeof(z_stream)) then - begin - inflateInit2_ := Z_VERSION_ERROR; - exit; - end; - { initialize state } - { SetLength(strm.msg, 255); } - z.msg := ''; - if not Assigned(z.zalloc) then - begin - {$IFDEF FPC} z.zalloc := @zcalloc; {$ELSE} - z.zalloc := zcalloc; - {$endif} - z.opaque := voidpf(0); - end; - if not Assigned(z.zfree) then - {$IFDEF FPC} z.zfree := @zcfree; {$ELSE} - z.zfree := zcfree; - {$ENDIF} - - z.state := pInternal_state( ZALLOC(z,1,sizeof(internal_state)) ); - if (z.state = Z_NULL) then - begin - inflateInit2_ := Z_MEM_ERROR; - exit; - end; - - z.state^.blocks := Z_NULL; - - { handle undocumented nowrap option (no zlib header or check) } - z.state^.nowrap := FALSE; - if (w < 0) then - begin - w := - w; - z.state^.nowrap := TRUE; - end; - - { set window size } - if (w < 8) or (w > 15) then - begin - inflateEnd(z); - inflateInit2_ := Z_STREAM_ERROR; - exit; - end; - z.state^.wbits := uInt(w); - - { create inflate_blocks state } - if z.state^.nowrap then - z.state^.blocks := inflate_blocks_new(z, NIL, uInt(1) shl w) - else - {$IFDEF FPC} - z.state^.blocks := inflate_blocks_new(z, @adler32, uInt(1) shl w); - {$ELSE} - z.state^.blocks := inflate_blocks_new(z, adler32, uInt(1) shl w); - {$ENDIF} - if (z.state^.blocks = Z_NULL) then - begin - inflateEnd(z); - inflateInit2_ := Z_MEM_ERROR; - exit; - end; - {$IFDEF DEBUG} - Tracev('inflate: allocated'); - {$ENDIF} - { reset state } - inflateReset(z); - inflateInit2_ := Z_OK; -end; - -function inflateInit2(var z: z_stream; windowBits : int) : int; -begin - inflateInit2 := inflateInit2_(z, windowBits, ZLIB_VERSION, sizeof(z_stream)); -end; - - -function inflateInit(var z : z_stream) : int; -{ inflateInit is a macro to allow checking the zlib version - and the compiler's view of z_stream: } -begin - inflateInit := inflateInit2_(z, DEF_WBITS, ZLIB_VERSION, sizeof(z_stream)); -end; - -function inflateInit_(z : z_streamp; - const version : AnsiString; - stream_size : int) : int; -begin - { initialize state } - if (z = Z_NULL) then - inflateInit_ := Z_STREAM_ERROR - else - inflateInit_ := inflateInit2_(z^, DEF_WBITS, version, stream_size); -end; - -function inflate(var z : z_stream; - f : int) : int; -var - r : int; - b : uInt; -begin - if (z.state = Z_NULL) or (z.next_in = Z_NULL) then - begin - inflate := Z_STREAM_ERROR; - exit; - end; - if f = Z_FINISH then - f := Z_BUF_ERROR - else - f := Z_OK; - r := Z_BUF_ERROR; - while True do - case (z.state^.mode) of - BLOCKS: - begin - r := inflate_blocks(z.state^.blocks^, z, r); - if (r = Z_DATA_ERROR) then - begin - z.state^.mode := BAD; - z.state^.sub.marker := 0; { can try inflateSync } - continue; { break C-switch } - end; - if (r = Z_OK) then - r := f; - if (r <> Z_STREAM_END) then - begin - inflate := r; - exit; - end; - r := f; - inflate_blocks_reset(z.state^.blocks^, z, @z.state^.sub.check.was); - if (z.state^.nowrap) then - begin - z.state^.mode := DONE; - continue; { break C-switch } - end; - z.state^.mode := CHECK4; { falltrough } - end; - CHECK4: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - - {z.state^.sub.check.need := uLong(NEXTBYTE(z)) shl 24;} - Dec(z.avail_in); - Inc(z.total_in); - z.state^.sub.check.need := uLong(z.next_in^) shl 24; - Inc(z.next_in); - - z.state^.mode := CHECK3; { falltrough } - end; - CHECK3: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - {Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 16);} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 16); - Inc(z.next_in); - - z.state^.mode := CHECK2; { falltrough } - end; - CHECK2: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - - {Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 8);} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 8); - Inc(z.next_in); - - z.state^.mode := CHECK1; { falltrough } - end; - CHECK1: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - {Inc( z.state^.sub.check.need, uLong(NEXTBYTE(z)) );} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) ); - Inc(z.next_in); - - - if (z.state^.sub.check.was <> z.state^.sub.check.need) then - begin - z.state^.mode := BAD; - z.msg := 'incorrect data check'; - z.state^.sub.marker := 5; { can't try inflateSync } - continue; { break C-switch } - end; - {$IFDEF DEBUG} - Tracev('inflate: zlib check ok'); - {$ENDIF} - z.state^.mode := DONE; { falltrough } - end; - DONE: - begin - inflate := Z_STREAM_END; - exit; - end; - METHOD: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; {} - - {z.state^.sub.method := NEXTBYTE(z);} - Dec(z.avail_in); - Inc(z.total_in); - z.state^.sub.method := z.next_in^; - Inc(z.next_in); - - if ((z.state^.sub.method and $0f) <> Z_DEFLATED) then - begin - z.state^.mode := BAD; - z.msg := 'unknown compression method'; - z.state^.sub.marker := 5; { can't try inflateSync } - continue; { break C-switch } - end; - if ((z.state^.sub.method shr 4) + 8 > z.state^.wbits) then - begin - z.state^.mode := BAD; - z.msg := 'invalid window size'; - z.state^.sub.marker := 5; { can't try inflateSync } - continue; { break C-switch } - end; - z.state^.mode := FLAG; - { fall trough } - end; - FLAG: - begin - {NEEDBYTE} - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; {} - {b := NEXTBYTE(z);} - Dec(z.avail_in); - Inc(z.total_in); - b := z.next_in^; - Inc(z.next_in); - - if (((z.state^.sub.method shl 8) + b) mod 31) <> 0 then {% mod ?} - begin - z.state^.mode := BAD; - z.msg := 'incorrect header check'; - z.state^.sub.marker := 5; { can't try inflateSync } - continue; { break C-switch } - end; - {$IFDEF DEBUG} - Tracev('inflate: zlib header ok'); - {$ENDIF} - if ((b and PRESET_DICT) = 0) then - begin - z.state^.mode := BLOCKS; - continue; { break C-switch } - end; - z.state^.mode := DICT4; - { falltrough } - end; - DICT4: - begin - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - - {z.state^.sub.check.need := uLong(NEXTBYTE(z)) shl 24;} - Dec(z.avail_in); - Inc(z.total_in); - z.state^.sub.check.need := uLong(z.next_in^) shl 24; - Inc(z.next_in); - - z.state^.mode := DICT3; { falltrough } - end; - DICT3: - begin - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - {Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 16);} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 16); - Inc(z.next_in); - - z.state^.mode := DICT2; { falltrough } - end; - DICT2: - begin - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - r := f; - - {Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) shl 8);} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) shl 8); - Inc(z.next_in); - - z.state^.mode := DICT1; { falltrough } - end; - DICT1: - begin - if (z.avail_in = 0) then - begin - inflate := r; - exit; - end; - { r := f; --- wird niemals benutzt } - {Inc(z.state^.sub.check.need, uLong(NEXTBYTE(z)) );} - Dec(z.avail_in); - Inc(z.total_in); - Inc(z.state^.sub.check.need, uLong(z.next_in^) ); - Inc(z.next_in); - - z.adler := z.state^.sub.check.need; - z.state^.mode := DICT0; - inflate := Z_NEED_DICT; - exit; - end; - DICT0: - begin - z.state^.mode := BAD; - z.msg := 'need dictionary'; - z.state^.sub.marker := 0; { can try inflateSync } - inflate := Z_STREAM_ERROR; - exit; - end; - BAD: - begin - inflate := Z_DATA_ERROR; - exit; - end; - else - begin - inflate := Z_STREAM_ERROR; - exit; - end; - end; -{$ifdef NEED_DUMMY_result} - result := Z_STREAM_ERROR; { Some dumb compilers complain without this } -{$endif} -end; - -function inflateSetDictionary(var z : z_stream; - dictionary : pBytef; {const array of byte} - dictLength : uInt) : int; -var - length : uInt; -begin - length := dictLength; - - if (z.state = Z_NULL) or (z.state^.mode <> DICT0) then - begin - inflateSetDictionary := Z_STREAM_ERROR; - exit; - end; - if (adler32(Long(1), dictionary, dictLength) <> z.adler) then - begin - inflateSetDictionary := Z_DATA_ERROR; - exit; - end; - z.adler := Long(1); - - if (length >= (uInt(1) shl z.state^.wbits)) then - begin - length := (1 shl z.state^.wbits)-1; - Inc( dictionary, dictLength - length); - end; - inflate_set_dictionary(z.state^.blocks^, dictionary^, length); - z.state^.mode := BLOCKS; - inflateSetDictionary := Z_OK; -end; - - -function inflateSync(var z : z_stream) : int; -const - mark : packed array[0..3] of byte = (0, 0, $ff, $ff); -var - n : uInt; { number of bytes to look at } - p : pBytef; { pointer to bytes } - m : uInt; { number of marker bytes found in a row } - r, w : uLong; { temporaries to save total_in and total_out } -begin - { set up } - if (z.state = Z_NULL) then - begin - inflateSync := Z_STREAM_ERROR; - exit; - end; - if (z.state^.mode <> BAD) then - begin - z.state^.mode := BAD; - z.state^.sub.marker := 0; - end; - n := z.avail_in; - if (n = 0) then - begin - inflateSync := Z_BUF_ERROR; - exit; - end; - p := z.next_in; - m := z.state^.sub.marker; - - { search } - while (n <> 0) and (m < 4) do - begin - if (p^ = mark[m]) then - Inc(m) - else - if (p^ <> 0) then - m := 0 - else - m := 4 - m; - Inc(p); - Dec(n); - end; - - { restore } - Inc(z.total_in, ptr2int(p) - ptr2int(z.next_in)); - z.next_in := p; - z.avail_in := n; - z.state^.sub.marker := m; - - - { return no joy or set up to restart on a new block } - if (m <> 4) then - begin - inflateSync := Z_DATA_ERROR; - exit; - end; - r := z.total_in; - w := z.total_out; - inflateReset(z); - z.total_in := r; - z.total_out := w; - z.state^.mode := BLOCKS; - inflateSync := Z_OK; -end; - - -{ - returns true if inflate is currently at the end of a block generated - by Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP - implementation to provide an additional safety check. PPP uses Z_SYNC_FLUSH - but removes the length bytes of the resulting empty stored block. When - decompressing, PPP checks that at the end of input packet, inflate is - waiting for these length bytes. -} - -function inflateSyncPoint(var z : z_stream) : int; -begin - if (z.state = Z_NULL) or (z.state^.blocks = Z_NULL) then - begin - inflateSyncPoint := Z_STREAM_ERROR; - exit; - end; - inflateSyncPoint := inflate_blocks_sync_point(z.state^.blocks^); -end; - -end. diff --git a/3rd/Imaging/Source/ZLib/imzutil.pas b/3rd/Imaging/Source/ZLib/imzutil.pas deleted file mode 100644 index 420b5fbd0..000000000 --- a/3rd/Imaging/Source/ZLib/imzutil.pas +++ /dev/null @@ -1,191 +0,0 @@ -Unit imzutil; - -{ - Copyright (C) 1998 by Jacques Nomssi Nzali - For conditions of distribution and use, see copyright notice in readme.txt -} - -interface - -{$I imzconf.inc} - -{ Type declarations } - -type - {Byte = usigned char; 8 bits} - Bytef = byte; - charf = byte; - - int = longint; - intf = int; - uInt = cardinal; { 16 bits or more } - uIntf = uInt; - - Long = longint; - uLong = Cardinal; - uLongf = uLong; - - voidp = pointer; - voidpf = voidp; - pBytef = ^Bytef; - pIntf = ^intf; - puIntf = ^uIntf; - puLong = ^uLongf; - - ptr2int = uInt; -{ a pointer to integer casting is used to do pointer arithmetic. - ptr2int must be an integer type and sizeof(ptr2int) must be less - than sizeof(pointer) - Nomssi } - -type - zByteArray = array[0..(MaxInt div SizeOf(Bytef))-1] of Bytef; - pzByteArray = ^zByteArray; -type - zIntfArray = array[0..(MaxInt div SizeOf(Intf))-1] of Intf; - pzIntfArray = ^zIntfArray; -type - zuIntArray = array[0..(MaxInt div SizeOf(uInt))-1] of uInt; - PuIntArray = ^zuIntArray; - -{ Type declarations - only for deflate } - -type - uch = Byte; - uchf = uch; { FAR } - ush = Word; - ushf = ush; - ulg = LongInt; - - unsigned = uInt; - - pcharf = ^charf; - puchf = ^uchf; - pushf = ^ushf; - -type - zuchfArray = zByteArray; - puchfArray = ^zuchfArray; -type - zushfArray = array[0..(MaxInt div SizeOf(ushf))-1] of ushf; - pushfArray = ^zushfArray; - -procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt); -function zmemcmp(s1p, s2p : pBytef; len : uInt) : int; -procedure zmemzero(destp : pBytef; len : uInt); -procedure zcfree(opaque : voidpf; ptr : voidpf); -function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf; - -implementation - -procedure zmemcpy(destp : pBytef; sourcep : pBytef; len : uInt); -begin - Move(sourcep^, destp^, len); -end; - -function zmemcmp(s1p, s2p : pBytef; len : uInt) : int; -var - j : uInt; - source, - dest : pBytef; -begin - source := s1p; - dest := s2p; - for j := 0 to pred(len) do - begin - if (source^ <> dest^) then - begin - zmemcmp := 2*Ord(source^ > dest^)-1; - exit; - end; - Inc(source); - Inc(dest); - end; - zmemcmp := 0; -end; - -procedure zmemzero(destp : pBytef; len : uInt); -begin - FillChar(destp^, len, 0); -end; - -procedure zcfree(opaque : voidpf; ptr : voidpf); -{$ifdef Delphi16} -var - Handle : THandle; -{$endif} -{$IFDEF FPC} -var - memsize : uint; -{$ENDIF} -begin - (* - {$IFDEF DPMI} - {h :=} GlobalFreePtr(ptr); - {$ELSE} - {$IFDEF CALL_DOS} - dosFree(ptr); - {$ELSE} - {$ifdef HugeMem} - FreeMemHuge(ptr); - {$else} - {$ifdef Delphi16} - Handle := GlobalHandle(LH(ptr).H); { HiWord(LongInt(ptr)) } - GlobalUnLock(Handle); - GlobalFree(Handle); - {$else} - {$IFDEF FPC} - Dec(puIntf(ptr)); - memsize := puIntf(ptr)^; - FreeMem(ptr, memsize+SizeOf(uInt)); - {$ELSE} - FreeMem(ptr); { Delphi 2,3,4 } - {$ENDIF} - {$endif} - {$endif} - {$ENDIF} - {$ENDIF} - *) - FreeMem(ptr); -end; - -function zcalloc (opaque : voidpf; items : uInt; size : uInt) : voidpf; -var - p : voidpf; - memsize : uLong; -{$ifdef Delphi16} - handle : THandle; -{$endif} -begin - memsize := uLong(items) * size; - (* - { $IFDEF DPMI} - p := GlobalAllocPtr(gmem_moveable, memsize); - { $ELSE} - { $IFDEF CALLDOS} - p := dosAlloc(memsize); - { $ELSE} - {$ifdef HugeMem} - GetMemHuge(p, memsize); - { $else} - { $ifdef Delphi16} - Handle := GlobalAlloc(HeapAllocFlags, memsize); - p := GlobalLock(Handle); - { $else} - { $IFDEF FPC} - GetMem(p, memsize+SizeOf(uInt)); - puIntf(p)^:= memsize; - Inc(puIntf(p)); - { $ELSE} - GetMem(p, memsize); { Delphi: p := AllocMem(memsize); } - { $ENDIF} - { $endif} - { $endif} - { $ENDIF} - { $ENDIF} - *) - GetMem(p, memsize); - zcalloc := p; -end; - -end. - diff --git a/3rd/Imaging/Source/ZLib/readme.txt b/3rd/Imaging/Source/ZLib/readme.txt deleted file mode 100644 index f9d80877e..000000000 --- a/3rd/Imaging/Source/ZLib/readme.txt +++ /dev/null @@ -1,129 +0,0 @@ -_____________________________________________________________________________ - -PASZLIB 1.0 May 11th, 1998 - -Based on the zlib 1.1.2, a general purpose data compression library. - -Copyright (C) 1998,1999,2000 by NOMSSI NZALI Jacques H. C. -[kn&n DES] See "Legal issues" for conditions of distribution and use. -_____________________________________________________________________________ - - -Introduction -============ - -The 'zlib' compression library provides in-memory compression and -decompression functions, including integrity checks of the uncompressed -data. This version of the library supports only one compression method -(deflation) but other algorithms will be added later and will have the same -stream interface. - -Compression can be done in a single step if the buffers are large -enough (for example if an input file is mmap'ed), or can be done by -repeated calls of the compression function. In the latter case, the -application must provide more input and/or consume the output -(providing more output space) before each call. - -The default memory requirements for deflate are 256K plus a few kilobytes -for small objects. The default memory requirements for inflate are 32K -plus a few kilobytes for small objects. - -Change Log -========== - -March 24th 2000 - minizip code by Gilles Vollant ported to Pascal. - z_stream.msg defined as string[255] to avoid problems - with Delphi 2+ dynamic string handling. - changes to silence Delphi 5 compiler warning. If you - have Delphi 5, defines Delphi5 in zconf.inc - -May 7th 1999 - Some changes for FPC - deflateCopy() has new parameters - trees.pas - record constant definition -June 17th 1998 - Applied official 1.1.2 patch. - Memcheck turned off by default. - zutil.pas patch for Delphi 1 memory allocation corrected. - dzlib.txt file added. - compress2() is now exported - -June 25th 1998 - fixed a conversion bug: in inftrees.pas, ZFREE(z, v) was - missing in line 574; - -File list -========= - -Here is a road map to the files in the Paszlib distribution. - -readme.txt Introduction, Documentation -dzlib.txt Changes to Delphi sources for Paszlib stream classes - -include file - -zconf.inc Configuration declarations. - -Pascal source code files: - -adler.pas compute the Adler-32 checksum of a data stream -crc.pas compute the CRC-32 of a data stream -gzio.pas IO on .gz files -infblock.pas interpret and process block types to last block -infcodes.pas process literals and length/distance pairs -inffast.pas process literals and length/distance pairs fast -inftrees.pas generate Huffman trees for efficient decoding -infutil.pas types and macros common to blocks and codes -strutils.pas string utilities -trees.pas output deflated data using Huffman coding -zcompres.pas compress a memory buffer -zdeflate.pas compress data using the deflation algorithm -zinflate.pas zlib interface to inflate modules -zlib.pas zlib data structures. read the comments there! -zuncompr.pas decompress a memory buffer -zutil.pas - -minizip/ziputils.pas data structure and IO on .zip file -minizip/unzip.pas -minizip/zip.pas - -Test applications - -example.pas usage example of the zlib compression library -minigzip.pas simulate gzip using the zlib compression library -minizip/miniunz.pas simulates unzip using the zlib compression library -minizip/minizip.pas simulates zip using the zlib compression library - -Legal issues -============ - -Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali - - This software is provided 'as-is', without any express or implied - warranty. In no event will the author be held liable for any damages - arising from the use of this software. - - Permission is granted to anyone to use this software for any purpose, - including commercial applications, and to alter it and redistribute it - freely, subject to the following restrictions: - - 1. The origin of this software must not be misrepresented; you must not - claim that you wrote the original software. If you use this software - in a product, an acknowledgment in the product documentation would be - appreciated but is not required. - 2. Altered source versions must be plainly marked as such, and must not be - misrepresented as being the original software. - 3. This notice may not be removed or altered from any source distribution. - - -Archive Locations: -================== - -Check the Paszlib home page with links - - http://www.tu-chemnitz.de/~nomssi/paszlib.html - -The data format used by the zlib library is described by RFCs (Request for -Comments) 1950 to 1952 in the files ftp://ds.internic.net/rfc/rfc1950.txt -(zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). -These documents are also available in other formats from -ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html. -____________________________________________________________________________ -Jacques Nomssi Nzali March 24th, 2000 \ No newline at end of file diff --git a/3rd/internettools b/3rd/internettools new file mode 160000 index 000000000..4f7490dd0 --- /dev/null +++ b/3rd/internettools @@ -0,0 +1 @@ +Subproject commit 4f7490dd05ed6f2eeffa157f7921f46ae835ce53 diff --git a/3rd/synapse/README.txt b/3rd/synapse/README.txt deleted file mode 100644 index 722c14b61..000000000 --- a/3rd/synapse/README.txt +++ /dev/null @@ -1,45 +0,0 @@ -Synapse -The synchronyous socket library. - -File content: - -1.) About Synapse -2.) Distribution package -3.) Installation instructions -4.) Usage notes - -Synapse homesite is at http://synapse.ararat.cz/ -On homesite is Wiki documentation system and other informations. - -1.) About Synapse - -SYNAPSE library aims to create complete library of classes and functions -that would markedly simplify application programming of network communication -using Winsock. - -2.) Distribution package - -Package must be unpacked with subdirectories. -There are these derectories: - -\Html - Off-line version of Synapse support WEB -\Source - Synapse source code -\Source\Lib - shared units -\Source\Demo - Synapse demo applications - - -3.) Installation instructions - -There aren't any difficulties with current distribution other than add -\Source\Lib directory to library or search path. (...or you can simply put all -required Synapse files into your project directory.) - -4.) Usage notes - -Simply write BLCKSOCK to USES section in your source code -(or any other unit from package, when you need it). -To read documentation, simply open INDEX.HTM file (in HTML subdirectory) -on your HTML browser. - -Last update 2006-09-12 - diff --git a/3rd/synapse/Release.txt b/3rd/synapse/Release.txt deleted file mode 100644 index 8a744cf1d..000000000 --- a/3rd/synapse/Release.txt +++ /dev/null @@ -1,2 +0,0 @@ -Release 39 -2009-10-08 diff --git a/3rd/synapse/licence.txt b/3rd/synapse/licence.txt deleted file mode 100644 index f1f925535..000000000 --- a/3rd/synapse/licence.txt +++ /dev/null @@ -1,28 +0,0 @@ -Copyright (c)1999-2002, Lukas Gebauer -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -Redistributions of source code must retain the above copyright notice, this -list of conditions and the following disclaimer. - -Redistributions in binary form must reproduce the above copyright notice, -this list of conditions and the following disclaimer in the documentation -and/or other materials provided with the distribution. - -Neither the name of Lukas Gebauer nor the names of its contributors may -be used to endorse or promote products derived from this software without -specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. diff --git a/3rd/synapse/source/asn1util.pas b/3rd/synapse/source/asn1util.pas deleted file mode 100644 index 57780868d..000000000 --- a/3rd/synapse/source/asn1util.pas +++ /dev/null @@ -1,520 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.001.000 | -|==============================================================================| -| Content: support for ASN.1 BER coding and decoding | -|==============================================================================| -| Copyright (c)1999-2014, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2014 | -| Portions created by Hernan Sanchez are Copyright (c) 2000. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Hernan Sanchez (hernan.sanchez@iname.com) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{: @abstract(Utilities for handling ASN.1 BER encoding) -By this unit you can parse ASN.1 BER encoded data to elements or build back any - elements to ASN.1 BER encoded buffer. You can dump ASN.1 BER encoded data to - human readable form for easy debugging, too. - -Supported element types are: ASN1_BOOL, ASN1_INT, ASN1_OCTSTR, ASN1_NULL, - ASN1_OBJID, ASN1_ENUM, ASN1_SEQ, ASN1_SETOF, ASN1_IPADDR, ASN1_COUNTER, - ASN1_GAUGE, ASN1_TIMETICKS, ASN1_OPAQUE - -For sample of using, look to @link(TSnmpSend) or @link(TLdapSend)class. -} - -{$Q-} -{$H+} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit asn1util; - -interface - -uses - SysUtils, Classes, synautil; - -const - ASN1_BOOL = $01; - ASN1_INT = $02; - ASN1_OCTSTR = $04; - ASN1_NULL = $05; - ASN1_OBJID = $06; - ASN1_ENUM = $0a; - ASN1_SEQ = $30; - ASN1_SETOF = $31; - ASN1_IPADDR = $40; - ASN1_COUNTER = $41; - ASN1_GAUGE = $42; - ASN1_TIMETICKS = $43; - ASN1_OPAQUE = $44; - ASN1_COUNTER64 = $46; - -{:Encodes OID item to binary form.} -function ASNEncOIDItem(Value: Int64): AnsiString; - -{:Decodes an OID item of the next element in the "Buffer" from the "Start" - position.} -function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Int64; - -{:Encodes the length of ASN.1 element to binary.} -function ASNEncLen(Len: Integer): AnsiString; - -{:Decodes length of next element in "Buffer" from the "Start" position.} -function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer; - -{:Encodes a signed integer to ASN.1 binary} -function ASNEncInt(Value: Int64): AnsiString; - -{:Encodes unsigned integer into ASN.1 binary} -function ASNEncUInt(Value: Integer): AnsiString; - -{:Encodes ASN.1 object to binary form.} -function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString; - -{:Beginning with the "Start" position, decode the ASN.1 item of the next element - in "Buffer". Type of item is stored in "ValueType."} -function ASNItem(var Start: Integer; const Buffer: AnsiString; - var ValueType: Integer): AnsiString; - -{:Encodes an MIB OID string to binary form.} -function MibToId(Mib: String): AnsiString; - -{:Decodes MIB OID from binary form to string form.} -function IdToMib(const Id: AnsiString): String; - -{:Encodes an one number from MIB OID to binary form. (used internally from -@link(MibToId))} -function IntMibToStr(const Value: AnsiString): AnsiString; - -{:Convert ASN.1 BER encoded buffer to human readable form for debugging.} -function ASNdump(const Value: AnsiString): AnsiString; - -implementation - -{==============================================================================} -function ASNEncOIDItem(Value: Int64): AnsiString; -var - x: Int64; - xm: Byte; - b: Boolean; -begin - x := Value; - b := False; - Result := ''; - repeat - xm := x mod 128; - x := x div 128; - if b then - xm := xm or $80; - if x > 0 then - b := True; - Result := AnsiChar(xm) + Result; - until x = 0; -end; - -{==============================================================================} -function ASNDecOIDItem(var Start: Integer; const Buffer: AnsiString): Int64; -var - x: Integer; - b: Boolean; -begin - Result := 0; - repeat - Result := Result * 128; - x := Ord(Buffer[Start]); - Inc(Start); - b := x > $7F; - x := x and $7F; - Result := Result + x; - until not b; -end; - -{==============================================================================} -function ASNEncLen(Len: Integer): AnsiString; -var - x, y: Integer; -begin - if Len < $80 then - Result := AnsiChar(Len) - else - begin - x := Len; - Result := ''; - repeat - y := x mod 256; - x := x div 256; - Result := AnsiChar(y) + Result; - until x = 0; - y := Length(Result); - y := y or $80; - Result := AnsiChar(y) + Result; - end; -end; - -{==============================================================================} -function ASNDecLen(var Start: Integer; const Buffer: AnsiString): Integer; -var - x, n: Integer; -begin - x := Ord(Buffer[Start]); - Inc(Start); - if x < $80 then - Result := x - else - begin - Result := 0; - x := x and $7F; - for n := 1 to x do - begin - Result := Result * 256; - x := Ord(Buffer[Start]); - Inc(Start); - Result := Result + x; - end; - end; -end; - -{==============================================================================} -function ASNEncInt(Value: Int64): AnsiString; -var - x: Int64; - y: byte; - neg: Boolean; -begin - neg := Value < 0; - x := Abs(Value); - if neg then - x := x - 1; - Result := ''; - repeat - y := x mod 256; - x := x div 256; - if neg then - y := not y; - Result := AnsiChar(y) + Result; - until x = 0; - if (not neg) and (Result[1] > #$7F) then - Result := #0 + Result; - if (neg) and (Result[1] < #$80) then - Result := #$FF + Result; -end; - -{==============================================================================} -function ASNEncUInt(Value: Integer): AnsiString; -var - x, y: Integer; - neg: Boolean; -begin - neg := Value < 0; - x := Value; - if neg then - x := x and $7FFFFFFF; - Result := ''; - repeat - y := x mod 256; - x := x div 256; - Result := AnsiChar(y) + Result; - until x = 0; - if neg then - Result[1] := AnsiChar(Ord(Result[1]) or $80); -end; - -{==============================================================================} -function ASNObject(const Data: AnsiString; ASNType: Integer): AnsiString; -begin - Result := AnsiChar(ASNType) + ASNEncLen(Length(Data)) + Data; -end; - -{==============================================================================} -function ASNItem(var Start: Integer; const Buffer: AnsiString; - var ValueType: Integer): AnsiString; -var - ASNType: Integer; - ASNSize: Integer; - y: int64; - n: Integer; - x: byte; - s: AnsiString; - c: AnsiChar; - neg: Boolean; - l: Integer; -begin - Result := ''; - ValueType := ASN1_NULL; - l := Length(Buffer); - if l < (Start + 1) then - Exit; - ASNType := Ord(Buffer[Start]); - ValueType := ASNType; - Inc(Start); - ASNSize := ASNDecLen(Start, Buffer); - if (Start + ASNSize - 1) > l then - Exit; - if (ASNType and $20) > 0 then -// Result := '$' + IntToHex(ASNType, 2) - Result := Copy(Buffer, Start, ASNSize) - else - case ASNType of - ASN1_INT, ASN1_ENUM, ASN1_BOOL: - begin - y := 0; - neg := False; - for n := 1 to ASNSize do - begin - x := Ord(Buffer[Start]); - if (n = 1) and (x > $7F) then - neg := True; - if neg then - x := not x; - y := y * 256 + x; - Inc(Start); - end; - if neg then - y := -(y + 1); - Result := IntToStr(y); - end; - ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS, ASN1_COUNTER64: - begin - y := 0; - for n := 1 to ASNSize do - begin - y := y * 256 + Ord(Buffer[Start]); - Inc(Start); - end; - Result := IntToStr(y); - end; - ASN1_OCTSTR, ASN1_OPAQUE: - begin - for n := 1 to ASNSize do - begin - c := AnsiChar(Buffer[Start]); - Inc(Start); - s := s + c; - end; - Result := s; - end; - ASN1_OBJID: - begin - for n := 1 to ASNSize do - begin - c := AnsiChar(Buffer[Start]); - Inc(Start); - s := s + c; - end; - Result := IdToMib(s); - end; - ASN1_IPADDR: - begin - s := ''; - for n := 1 to ASNSize do - begin - if (n <> 1) then - s := s + '.'; - y := Ord(Buffer[Start]); - Inc(Start); - s := s + IntToStr(y); - end; - Result := s; - end; - ASN1_NULL: - begin - Result := ''; - Start := Start + ASNSize; - end; - else // unknown - begin - for n := 1 to ASNSize do - begin - c := AnsiChar(Buffer[Start]); - Inc(Start); - s := s + c; - end; - Result := s; - end; - end; -end; - -{==============================================================================} -function MibToId(Mib: String): AnsiString; -var - x: Integer; - - function WalkInt(var s: String): Integer; - var - x: Integer; - t: AnsiString; - begin - x := Pos('.', s); - if x < 1 then - begin - t := s; - s := ''; - end - else - begin - t := Copy(s, 1, x - 1); - s := Copy(s, x + 1, Length(s) - x); - end; - Result := StrToIntDef(t, 0); - end; - -begin - Result := ''; - x := WalkInt(Mib); - x := x * 40 + WalkInt(Mib); - Result := ASNEncOIDItem(x); - while Mib <> '' do - begin - x := WalkInt(Mib); - Result := Result + ASNEncOIDItem(x); - end; -end; - -{==============================================================================} -function IdToMib(const Id: AnsiString): String; -var - x, y, n: Integer; -begin - Result := ''; - n := 1; - while Length(Id) + 1 > n do - begin - x := ASNDecOIDItem(n, Id); - if (n - 1) = 1 then - begin - y := x div 40; - x := x mod 40; - Result := IntToStr(y); - end; - Result := Result + '.' + IntToStr(x); - end; -end; - -{==============================================================================} -function IntMibToStr(const Value: AnsiString): AnsiString; -var - n, y: Integer; -begin - y := 0; - for n := 1 to Length(Value) - 1 do - y := y * 256 + Ord(Value[n]); - Result := IntToStr(y); -end; - -{==============================================================================} -function ASNdump(const Value: AnsiString): AnsiString; -var - i, at, x, n: integer; - s, indent: AnsiString; - il: TStringList; -begin - il := TStringList.Create; - try - Result := ''; - i := 1; - indent := ''; - while i < Length(Value) do - begin - for n := il.Count - 1 downto 0 do - begin - x := StrToIntDef(il[n], 0); - if x <= i then - begin - il.Delete(n); - Delete(indent, 1, 2); - end; - end; - s := ASNItem(i, Value, at); - Result := Result + indent + '$' + IntToHex(at, 2); - if (at and $20) > 0 then - begin - x := Length(s); - Result := Result + ' constructed: length ' + IntToStr(x); - indent := indent + ' '; - il.Add(IntToStr(x + i - 1)); - end - else - begin - case at of - ASN1_BOOL: - Result := Result + ' BOOL: '; - ASN1_INT: - Result := Result + ' INT: '; - ASN1_ENUM: - Result := Result + ' ENUM: '; - ASN1_COUNTER: - Result := Result + ' COUNTER: '; - ASN1_GAUGE: - Result := Result + ' GAUGE: '; - ASN1_TIMETICKS: - Result := Result + ' TIMETICKS: '; - ASN1_OCTSTR: - Result := Result + ' OCTSTR: '; - ASN1_OPAQUE: - Result := Result + ' OPAQUE: '; - ASN1_OBJID: - Result := Result + ' OBJID: '; - ASN1_IPADDR: - Result := Result + ' IPADDR: '; - ASN1_NULL: - Result := Result + ' NULL: '; - ASN1_COUNTER64: - Result := Result + ' COUNTER64: '; - else // other - Result := Result + ' unknown: '; - end; - if IsBinaryString(s) then - s := DumpExStr(s); - Result := Result + s; - end; - Result := Result + #$0d + #$0a; - end; - finally - il.Free; - end; -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/blcksock.pas b/3rd/synapse/source/blcksock.pas deleted file mode 100644 index c1f4d3d32..000000000 --- a/3rd/synapse/source/blcksock.pas +++ /dev/null @@ -1,4354 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 009.009.001 | -|==============================================================================| -| Content: Library base | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)1999-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{ -Special thanks to Gregor Ibic - (Intelicom d.o.o., http://www.intelicom.si) - for good inspiration about SSL programming. -} - -{$DEFINE ONCEWINSOCK} -{Note about define ONCEWINSOCK: -If you remove this compiler directive, then socket interface is loaded and -initialized on constructor of TBlockSocket class for each socket separately. -Socket interface is used only if your need it. - -If you leave this directive here, then socket interface is loaded and -initialized only once at start of your program! It boost performace on high -count of created and destroyed sockets. It eliminate possible small resource -leak on Windows systems too. -} - -//{$DEFINE RAISEEXCEPT} -{When you enable this define, then is Raiseexcept property is on by default -} - -{:@abstract(Synapse's library core) - -Core with implementation basic socket classes. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$IFDEF VER125} - {$DEFINE BCB} -{$ENDIF} -{$IFDEF BCB} - {$ObjExportAll On} -{$ENDIF} -{$Q-} -{$H+} -{$M+} -{$TYPEDADDRESS OFF} - - -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit blcksock; - -interface - -uses - SysUtils, Classes, - synafpc, - synsock, synautil, synacode, synaip -{$IFDEF CIL} - ,System.Net - ,System.Net.Sockets - ,System.Text -{$ENDIF} - ; - -const - - SynapseRelease = '40'; - - cLocalhost = '127.0.0.1'; - cAnyHost = '0.0.0.0'; - cBroadcast = '255.255.255.255'; - c6Localhost = '::1'; - c6AnyHost = '::0'; - c6Broadcast = 'ffff::1'; - cAnyPort = '0'; - CR = #$0d; - LF = #$0a; - CRLF = CR + LF; - c64k = 65536; - -type - - {:@abstract(Exception clas used by Synapse) - When you enable generating of exceptions, this exception is raised by - Synapse's units.} - ESynapseError = class(Exception) - private - FErrorCode: Integer; - FErrorMessage: string; - published - {:Code of error. Value depending on used operating system} - property ErrorCode: Integer read FErrorCode Write FErrorCode; - {:Human readable description of error.} - property ErrorMessage: string read FErrorMessage Write FErrorMessage; - end; - - {:Types of OnStatus events} - THookSocketReason = ( - {:Resolving is begin. Resolved IP and port is in parameter in format like: - 'localhost.somewhere.com:25'.} - HR_ResolvingBegin, - {:Resolving is done. Resolved IP and port is in parameter in format like: - 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!} - HR_ResolvingEnd, - {:Socket created by CreateSocket method. It reporting Family of created - socket too!} - HR_SocketCreate, - {:Socket closed by CloseSocket method.} - HR_SocketClose, - {:Socket binded to IP and Port. Binded IP and Port is in parameter in format - like: 'localhost.somewhere.com:25'.} - HR_Bind, - {:Socket connected to IP and Port. Connected IP and Port is in parameter in - format like: 'localhost.somewhere.com:25'.} - HR_Connect, - {:Called when CanRead method is used with @True result.} - HR_CanRead, - {:Called when CanWrite method is used with @True result.} - HR_CanWrite, - {:Socket is swithed to Listen mode. (TCP socket only)} - HR_Listen, - {:Socket Accepting client connection. (TCP socket only)} - HR_Accept, - {:report count of bytes readed from socket. Number is in parameter string. - If you need is in integer, you must use StrToInt function!} - HR_ReadCount, - {:report count of bytes writed to socket. Number is in parameter string. If - you need is in integer, you must use StrToInt function!} - HR_WriteCount, - {:If is limiting of bandwidth on, then this reason is called when sending or - receiving is stopped for satisfy bandwidth limit. Parameter is count of - waiting milliseconds.} - HR_Wait, - {:report situation where communication error occured. When raiseexcept is - @true, then exception is called after this Hook reason.} - HR_Error - ); - - {:Procedural type for OnStatus event. Sender is calling TBlockSocket object, - Reason is one of set Status events and value is optional data.} - THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason; - const Value: String) of object; - - {:This procedural type is used for DataFilter hooks.} - THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object; - - {:This procedural type is used for hook OnCreateSocket. By this hook you can - insert your code after initialisation of socket. (you can set special socket - options, etc.)} - THookCreateSocket = procedure(Sender: TObject) of object; - - {:This procedural type is used for monitoring of communication.} - THookMonitor = procedure(Sender: TObject; Writing: Boolean; - const Buffer: TMemory; Len: Integer) of object; - - {:This procedural type is used for hook OnAfterConnect. By this hook you can - insert your code after TCP socket has been sucessfully connected.} - THookAfterConnect = procedure(Sender: TObject) of object; - - {:This procedural type is used for hook OnVerifyCert. By this hook you can - insert your additional certificate verification code. Usefull to verify server - CN against URL. } - - THookVerifyCert = function(Sender: TObject):boolean of object; - - {:This procedural type is used for hook OnHeartbeat. By this hook you can - call your code repeately during long socket operations. - You must enable heartbeats by @Link(HeartbeatRate) property!} - THookHeartbeat = procedure(Sender: TObject) of object; - - {:Specify family of socket.} - TSocketFamily = ( - {:Default mode. Socket family is defined by target address for connection. - It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address - as destination, then is used IPv6 mode. othervise is used IPv4 mode. - However this mode not working properly with preliminary IPv6 supports!} - SF_Any, - {:Turn this class to pure IPv4 mode. This mode is totally compatible with - previous Synapse releases.} - SF_IP4, - {:Turn to only IPv6 mode.} - SF_IP6 - ); - - {:specify possible values of SOCKS modes.} - TSocksType = ( - ST_Socks5, - ST_Socks4 - ); - - {:Specify requested SSL/TLS version for secure connection.} - TSSLType = ( - LT_all, - LT_SSLv2, - LT_SSLv3, - LT_TLSv1, - LT_TLSv1_1, - LT_SSHv2 - ); - - {:Specify type of socket delayed option.} - TSynaOptionType = ( - SOT_Linger, - SOT_RecvBuff, - SOT_SendBuff, - SOT_NonBlock, - SOT_RecvTimeout, - SOT_SendTimeout, - SOT_Reuse, - SOT_TTL, - SOT_Broadcast, - SOT_MulticastTTL, - SOT_MulticastLoop - ); - - {:@abstract(this object is used for remember delayed socket option set.)} - TSynaOption = class(TObject) - public - Option: TSynaOptionType; - Enabled: Boolean; - Value: Integer; - end; - - TCustomSSL = class; - TSSLClass = class of TCustomSSL; - - {:@abstract(Basic IP object.) - This is parent class for other class with protocol implementations. Do not - use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket), - @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.} - TBlockSocket = class(TObject) - private - FOnStatus: THookSocketStatus; - FOnReadFilter: THookDataFilter; - FOnCreateSocket: THookCreateSocket; - FOnMonitor: THookMonitor; - FOnHeartbeat: THookHeartbeat; - FLocalSin: TVarSin; - FRemoteSin: TVarSin; - FTag: integer; - FBuffer: AnsiString; - FRaiseExcept: Boolean; - FNonBlockMode: Boolean; - FMaxLineLength: Integer; - FMaxSendBandwidth: Integer; - FNextSend: LongWord; - FMaxRecvBandwidth: Integer; - FNextRecv: LongWord; - FConvertLineEnd: Boolean; - FLastCR: Boolean; - FLastLF: Boolean; - FBinded: Boolean; - FFamily: TSocketFamily; - FFamilySave: TSocketFamily; - FIP6used: Boolean; - FPreferIP4: Boolean; - FDelayedOptions: TList; - FInterPacketTimeout: Boolean; - {$IFNDEF CIL} - FFDSet: TFDSet; - {$ENDIF} - FRecvCounter: Integer; - FSendCounter: Integer; - FSendMaxChunk: Integer; - FStopFlag: Boolean; - FNonblockSendTimeout: Integer; - FHeartbeatRate: integer; - FConnectionTimeout: integer; - {$IFNDEF ONCEWINSOCK} - FWsaDataOnce: TWSADATA; - {$ENDIF} - function GetSizeRecvBuffer: Integer; - procedure SetSizeRecvBuffer(Size: Integer); - function GetSizeSendBuffer: Integer; - procedure SetSizeSendBuffer(Size: Integer); - procedure SetNonBlockMode(Value: Boolean); - procedure SetTTL(TTL: integer); - function GetTTL:integer; - procedure SetFamily(Value: TSocketFamily); virtual; - procedure SetSocket(Value: TSocket); virtual; - function GetWsaData: TWSAData; - function FamilyToAF(f: TSocketFamily): TAddrFamily; - protected - FSocket: TSocket; - FLastError: Integer; - FLastErrorDesc: string; - FOwner: TObject; - procedure SetDelayedOption(const Value: TSynaOption); - procedure DelayedOption(const Value: TSynaOption); - procedure ProcessDelayedOptions; - procedure InternalCreateSocket(Sin: TVarSin); - procedure SetSin(var Sin: TVarSin; IP, Port: string); - function GetSinIP(Sin: TVarSin): string; - function GetSinPort(Sin: TVarSin): Integer; - procedure DoStatus(Reason: THookSocketReason; const Value: string); - procedure DoReadFilter(Buffer: TMemory; var Len: Integer); - procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer); - procedure DoCreateSocket; - procedure DoHeartbeat; - procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); - procedure SetBandwidth(Value: Integer); - function TestStopFlag: Boolean; - procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual; - function InternalCanRead(Timeout: Integer): Boolean; virtual; - public - constructor Create; - - {:Create object and load all necessary socket library. What library is - loaded is described by STUB parameter. If STUB is empty string, then is - loaded default libraries.} - constructor CreateAlternate(Stub: string); - destructor Destroy; override; - - {:If @link(family) is not SF_Any, then create socket with type defined in - @link(Family) property. If family is SF_Any, then do nothing! (socket is - created automaticly when you know what type of socket you need to create. - (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created, - then is aplyed all stored delayed socket options.} - procedure CreateSocket; - - {:It create socket. Address resolving of Value tells what type of socket is - created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If - value is resolved as IPv6 address, then is created IPv6 socket.} - procedure CreateSocketByName(const Value: String); - - {:Destroy socket in use. This method is also automatically called from - object destructor.} - procedure CloseSocket; virtual; - - {:Abort any work on Socket and destroy them.} - procedure AbortSocket; virtual; - - {:Connects socket to local IP address and PORT. IP address may be numeric or - symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT - - it may be number or mnemonic port ('23', 'telnet'). - - If port value is '0', system chooses itself and conects unused port in the - range 1024 to 4096 (this depending by operating system!). Structure - LocalSin is filled after calling this method. - - Note: If you call this on non-created socket, then socket is created - automaticly. - - Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this - case is used implicit system bind instead.} - procedure Bind(IP, Port: string); - - {:Connects socket to remote IP address and PORT. The same rules as with - @link(BIND) method are valid. The only exception is that PORT with 0 value - will not be connected! - - Structures LocalSin and RemoteSin will be filled with valid values. - - When you call this on non-created socket, then socket is created - automaticly. Type of created socket is by @link(Family) property. If is - used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is - created socket for IPv6. When you have family on SF_Any (default!), then - type of created socket is determined by address resolving of destination - address. (Not work properly on prilimitary winsock IPv6 support!)} - procedure Connect(IP, Port: string); virtual; - - {:Sets socket to receive mode for new incoming connections. It is necessary - to use @link(TBlockSocket.BIND) function call before this method to select - receiving port!} - procedure Listen; virtual; - - {:Waits until new incoming connection comes. After it comes a new socket is - automatically created (socket handler is returned by this function as - result).} - function Accept: TSocket; virtual; - - {:Sends data of LENGTH from BUFFER address via connected socket. System - automatically splits data to packets.} - function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual; - - {:One data BYTE is sent via connected socket.} - procedure SendByte(Data: Byte); virtual; - - {:Send data string via connected socket. Any terminator is not added! If you - need send true string with CR-LF termination, you must add CR-LF characters - to sended string! Because any termination is not added automaticly, you can - use this function for sending any binary data in binary string.} - procedure SendString(Data: AnsiString); virtual; - - {:Send integer as four bytes to socket.} - procedure SendInteger(Data: integer); virtual; - - {:Send data as one block to socket. Each block begin with 4 bytes with - length of data in block. This 4 bytes is added automaticly by this - function.} - procedure SendBlock(const Data: AnsiString); virtual; - - {:Send data from stream to socket.} - procedure SendStreamRaw(const Stream: TStream); virtual; - - {:Send content of stream to socket. It using @link(SendBlock) method} - procedure SendStream(const Stream: TStream); virtual; - - {:Send content of stream to socket. It using @link(SendBlock) method and - this is compatible with streams in Indy library.} - procedure SendStreamIndy(const Stream: TStream); virtual; - - {:Note: This is low-level receive function. You must be sure if data is - waiting for read before call this function for avoid deadlock! - - Waits until allocated buffer is filled by received data. Returns number of - data received, which equals to LENGTH value under normal operation. If it - is not equal the communication channel is possibly broken. - - On stream oriented sockets if is received 0 bytes, it mean 'socket is - closed!" - - On datagram socket is readed first waiting datagram.} - function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions! - - Method waits until data is received. If no data is received within TIMEOUT - (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods - serves for reading any size of data (i.e. one megabyte...). This method is - preffered for reading from stream sockets (like TCP).} - function RecvBufferEx(Buffer: Tmemory; Len: Integer; - Timeout: Integer): Integer; virtual; - - {:Similar to @link(RecvBufferEx), but readed data is stored in binary - string, not in memory buffer.} - function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions. - - Waits until one data byte is received which is also returned as function - result. If no data is received within TIMEOUT (in milliseconds)period, - @link(LastError) is set to WSAETIMEDOUT and result have value 0.} - function RecvByte(Timeout: Integer): Byte; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions. - - Waits until one four bytes are received and return it as one Ineger Value. - If no data is received within TIMEOUT (in milliseconds)period, - @link(LastError) is set to WSAETIMEDOUT and result have value 0.} - function RecvInteger(Timeout: Integer): Integer; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions. - - Method waits until data string is received. This string is terminated by - CR-LF characters. The resulting string is returned without this termination - (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be - exactly CR-LF. See @link(ConvertLineEnd) description. If no data is - received within TIMEOUT (in milliseconds) period, @link(LastError) is set - to WSAETIMEDOUT. You may also specify maximum length of reading data by - @link(MaxLineLength) property.} - function RecvString(Timeout: Integer): AnsiString; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions. - - Method waits until data string is received. This string is terminated by - Terminator string. The resulting string is returned without this - termination. If no data is received within TIMEOUT (in milliseconds) - period, @link(LastError) is set to WSAETIMEDOUT. You may also specify - maximum length of reading data by @link(MaxLineLength) property.} - function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual; - - {:Note: This is high-level receive function. It using internal - @link(LineBuffer) and you can combine this function freely with other - high-level functions. - - Method reads all data waiting for read. If no data is received within - TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. - Methods serves for reading unknown size of data. Because before call this - function you don't know size of received data, returned data is stored in - dynamic size binary string. This method is preffered for reading from - stream sockets (like TCP). It is very goot for receiving datagrams too! - (UDP protocol)} - function RecvPacket(Timeout: Integer): AnsiString; virtual; - - {:Read one block of data from socket. Each block begin with 4 bytes with - length of data in block. This function read first 4 bytes for get lenght, - then it wait for reported count of bytes.} - function RecvBlock(Timeout: Integer): AnsiString; virtual; - - {:Read all data from socket to stream until socket is closed (or any error - occured.)} - procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual; - {:Read requested count of bytes from socket to stream.} - procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); - - {:Receive data to stream. It using @link(RecvBlock) method.} - procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual; - - {:Receive data to stream. This function is compatible with similar function - in Indy library. It using @link(RecvBlock) method.} - procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual; - - {:Same as @link(RecvBuffer), but readed data stays in system input buffer. - Warning: this function not respect data in @link(LineBuffer)! Is not - recommended to use this function!} - function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual; - - {:Same as @link(RecvByte), but readed data stays in input system buffer. - Warning: this function not respect data in @link(LineBuffer)! Is not - recommended to use this function!} - function PeekByte(Timeout: Integer): Byte; virtual; - - {:On stream sockets it returns number of received bytes waiting for picking. - 0 is returned when there is no such data. On datagram socket it returns - length of the first waiting datagram. Returns 0 if no datagram is waiting.} - function WaitingData: Integer; virtual; - - {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer), - return their length instead.} - function WaitingDataEx: Integer; - - {:Clear all waiting data for read from buffers.} - procedure Purge; - - {:Sets linger. Enabled linger means that the system waits another LINGER - (in milliseconds) time for delivery of sent data. This function is only for - stream type of socket! (TCP)} - procedure SetLinger(Enable: Boolean; Linger: Integer); - - {:Actualize values in @link(LocalSin).} - procedure GetSinLocal; - - {:Actualize values in @link(RemoteSin).} - procedure GetSinRemote; - - {:Actualize values in @link(LocalSin) and @link(RemoteSin).} - procedure GetSins; - - {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.} - procedure ResetLastError; - - {:If you "manually" call Socket API functions, forward their return code as - parameter to this function, which evaluates it, eventually calls - GetLastError and found error code returns and stores to @link(LastError).} - function SockCheck(SockResult: Integer): Integer; virtual; - - {:If @link(LastError) contains some error code and @link(RaiseExcept) - property is @true, raise adequate exception.} - procedure ExceptCheck; - - {:Returns local computer name as numerical or symbolic value. It try get - fully qualified domain name. Name is returned in the format acceptable by - functions demanding IP as input parameter.} - function LocalName: string; - - {:Try resolve name to all possible IP address. i.e. If you pass as name - result of @link(LocalName) method, you get all IP addresses used by local - system.} - procedure ResolveNameToIP(Name: string; const IPList: TStrings); - - {:Try resolve name to primary IP address. i.e. If you pass as name result of - @link(LocalName) method, you get primary IP addresses used by local system.} - function ResolveName(Name: string): string; - - {:Try resolve IP to their primary domain name. If IP not have domain name, - then is returned original IP.} - function ResolveIPToName(IP: string): string; - - {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)} - function ResolvePort(Port: string): Word; - - {:Set information about remote side socket. It is good for seting remote - side for sending UDP packet, etc.} - procedure SetRemoteSin(IP, Port: string); - - {:Picks IP socket address from @link(LocalSin).} - function GetLocalSinIP: string; virtual; - - {:Picks IP socket address from @link(RemoteSin).} - function GetRemoteSinIP: string; virtual; - - {:Picks socket PORT number from @link(LocalSin).} - function GetLocalSinPort: Integer; virtual; - - {:Picks socket PORT number from @link(RemoteSin).} - function GetRemoteSinPort: Integer; virtual; - - {:Return @TRUE, if you can read any data from socket or is incoming - connection on TCP based socket. Status is tested for time Timeout (in - milliseconds). If value in Timeout is 0, status is only tested and - continue. If value in Timeout is -1, run is breaked and waiting for read - data maybe forever. - - This function is need only on special cases, when you need use - @link(RecvBuffer) function directly! read functioms what have timeout as - calling parameter, calling this function internally.} - function CanRead(Timeout: Integer): Boolean; virtual; - - {:Same as @link(CanRead), but additionally return @TRUE if is some data in - @link(LineBuffer).} - function CanReadEx(Timeout: Integer): Boolean; virtual; - - {:Return @TRUE, if you can to socket write any data (not full sending - buffer). Status is tested for time Timeout (in milliseconds). If value in - Timeout is 0, status is only tested and continue. If value in Timeout is - -1, run is breaked and waiting for write data maybe forever. - - This function is need only on special cases!} - function CanWrite(Timeout: Integer): Boolean; virtual; - - {:Same as @link(SendBuffer), but send datagram to address from - @link(RemoteSin). Usefull for sending reply to datagram received by - function @link(RecvBufferFrom).} - function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual; - - {:Note: This is low-lever receive function. You must be sure if data is - waiting for read before call this function for avoid deadlock! - - Receives first waiting datagram to allocated buffer. If there is no waiting - one, then waits until one comes. Returns length of datagram stored in - BUFFER. If length exceeds buffer datagram is truncated. After this - @link(RemoteSin) structure contains information about sender of UDP packet.} - function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual; -{$IFNDEF CIL} - {:This function is for check for incoming data on set of sockets. Whitch - sockets is checked is decribed by SocketList Tlist with TBlockSocket - objects. TList may have maximal number of objects defined by FD_SETSIZE - constant. Return @TRUE, if you can from some socket read any data or is - incoming connection on TCP based socket. Status is tested for time Timeout - (in milliseconds). If value in Timeout is 0, status is only tested and - continue. If value in Timeout is -1, run is breaked and waiting for read - data maybe forever. If is returned @TRUE, CanReadList TList is filled by all - TBlockSocket objects what waiting for read.} - function GroupCanRead(const SocketList: TList; Timeout: Integer; - const CanReadList: TList): Boolean; -{$ENDIF} - {:By this method you may turn address reuse mode for local @link(bind). It - is good specially for UDP protocol. Using this with TCP protocol is - hazardous!} - procedure EnableReuse(Value: Boolean); - - {:Try set timeout for all sending and receiving operations, if socket - provider can do it. (It not supported by all socket providers!)} - procedure SetTimeout(Timeout: Integer); - - {:Try set timeout for all sending operations, if socket provider can do it. - (It not supported by all socket providers!)} - procedure SetSendTimeout(Timeout: Integer); - - {:Try set timeout for all receiving operations, if socket provider can do - it. (It not supported by all socket providers!)} - procedure SetRecvTimeout(Timeout: Integer); - - {:Return value of socket type.} - function GetSocketType: integer; Virtual; - - {:Return value of protocol type for socket creation.} - function GetSocketProtocol: integer; Virtual; - - {:WSA structure with information about socket provider. On non-windows - platforms this structure is simulated!} - property WSAData: TWSADATA read GetWsaData; - - {:FDset structure prepared for usage with this socket.} - property FDset: TFDSet read FFDset; - - {:Structure describing local socket side.} - property LocalSin: TVarSin read FLocalSin write FLocalSin; - - {:Structure describing remote socket side.} - property RemoteSin: TVarSin read FRemoteSin write FRemoteSin; - - {:Socket handler. Suitable for "manual" calls to socket API or manual - connection of socket to a previously created socket (i.e by Accept method - on TCP socket)} - property Socket: TSocket read FSocket write SetSocket; - - {:Last socket operation error code. Error codes are described in socket - documentation. Human readable error description is stored in - @link(LastErrorDesc) property.} - property LastError: Integer read FLastError; - - {:Human readable error description of @link(LastError) code.} - property LastErrorDesc: string read FLastErrorDesc; - - {:Buffer used by all high-level receiving functions. This buffer is used for - optimized reading of data from socket. In normal cases you not need access - to this buffer directly!} - property LineBuffer: AnsiString read FBuffer write FBuffer; - - {:Size of Winsock receive buffer. If it is not supported by socket provider, - it return as size one kilobyte.} - property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer; - - {:Size of Winsock send buffer. If it is not supported by socket provider, it - return as size one kilobyte.} - property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer; - - {:If @True, turn class to non-blocking mode. Not all functions are working - properly in this mode, you must know exactly what you are doing! However - when you have big experience with non-blocking programming, then you can - optimise your program by non-block mode!} - property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode; - - {:Set Time-to-live value. (if system supporting it!)} - property TTL: Integer read GetTTL Write SetTTL; - - {:If is @true, then class in in IPv6 mode.} - property IP6used: Boolean read FIP6used; - - {:Return count of received bytes on this socket from begin of current - connection.} - property RecvCounter: Integer read FRecvCounter; - - {:Return count of sended bytes on this socket from begin of current - connection.} - property SendCounter: Integer read FSendCounter; - published - {:Return descriptive string for given error code. This is class function. - You may call it without created object!} - class function GetErrorDesc(ErrorCode: Integer): string; - - {:Return descriptive string for @link(LastError).} - function GetErrorDescEx: string; virtual; - - {:this value is for free use.} - property Tag: Integer read FTag write FTag; - - {:If @true, winsock errors raises exception. Otherwise is setted - @link(LastError) value only and you must check it from your program! Default - value is @false.} - property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept; - - {:Define maximum length in bytes of @link(LineBuffer) for high-level - receiving functions. If this functions try to read more data then this - limit, error is returned! If value is 0 (default), no limitation is used. - This is very good protection for stupid attacks to your server by sending - lot of data without proper terminator... until all your memory is allocated - by LineBuffer! - - Note: This maximum length is checked only in functions, what read unknown - number of bytes! (like @link(RecvString) or @link(RecvTerminated))} - property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength; - - {:Define maximal bandwidth for all sending operations in bytes per second. - If value is 0 (default), bandwidth limitation is not used.} - property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth; - - {:Define maximal bandwidth for all receiving operations in bytes per second. - If value is 0 (default), bandwidth limitation is not used.} - property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth; - - {:Define maximal bandwidth for all sending and receiving operations in bytes - per second. If value is 0 (default), bandwidth limitation is not used.} - property MaxBandwidth: Integer Write SetBandwidth; - - {:Do a conversion of non-standard line terminators to CRLF. (Off by default) - If @True, then terminators like sigle CR, single LF or LFCR are converted - to CRLF internally. This have effect only in @link(RecvString) method!} - property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd; - - {:Specified Family of this socket. When you are using Windows preliminary - support for IPv6, then I recommend to set this property!} - property Family: TSocketFamily read FFamily Write SetFamily; - - {:When resolving of domain name return both IPv4 and IPv6 addresses, then - specify if is used IPv4 (dafault - @true) or IPv6.} - property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4; - - {:By default (@true) is all timeouts used as timeout between two packets in - reading operations. If you set this to @false, then Timeouts is for overall - reading operation!} - property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout; - - {:All sended datas was splitted by this value.} - property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk; - - {:By setting this property to @true you can stop any communication. You can - use this property for soft abort of communication.} - property StopFlag: Boolean read FStopFlag Write FStopFlag; - - {:Timeout for data sending by non-blocking socket mode.} - property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout; - - {:Timeout for @link(Connect) call. Default value 0 means default system timeout. - Non-zero value means timeout in millisecond.} - property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout; - - {:This event is called by various reasons. It is good for monitoring socket, - create gauges for data transfers, etc.} - property OnStatus: THookSocketStatus read FOnStatus write FOnStatus; - - {:this event is good for some internal thinks about filtering readed datas. - It is used by telnet client by example.} - property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter; - - {:This event is called after real socket creation for setting special socket - options, because you not know when socket is created. (it is depended on - Ipv4, IPv6 or automatic mode)} - property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket; - - {:This event is good for monitoring content of readed or writed datas.} - property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor; - - {:This event is good for calling your code during long socket operations. - (Example, for refresing UI if class in not called within the thread.) - Rate of heartbeats can be modified by @link(HeartbeatRate) property.} - property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat; - - {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing. - Default value 0 disabling heartbeats! Value is in milliseconds. - Real rate can be higher or smaller then this value, because it depending - on real socket operations too! - Note: Each heartbeat slowing socket processing.} - property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate; - {:What class own this socket? Used by protocol implementation classes.} - property Owner: TObject read FOwner Write FOwner; - end; - - {:@abstract(Support for SOCKS4 and SOCKS5 proxy) - Layer with definition all necessary properties and functions for - implementation SOCKS proxy client. Do not use this class directly.} - TSocksBlockSocket = class(TBlockSocket) - protected - FSocksIP: string; - FSocksPort: string; - FSocksTimeout: integer; - FSocksUsername: string; - FSocksPassword: string; - FUsingSocks: Boolean; - FSocksResolver: Boolean; - FSocksLastError: integer; - FSocksResponseIP: string; - FSocksResponsePort: string; - FSocksLocalIP: string; - FSocksLocalPort: string; - FSocksRemoteIP: string; - FSocksRemotePort: string; - FBypassFlag: Boolean; - FSocksType: TSocksType; - function SocksCode(IP, Port: string): Ansistring; - function SocksDecode(Value: Ansistring): integer; - public - constructor Create; - - {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do - authorisation to proxy. This is needed only in special cases! (it is called - internally!)} - function SocksOpen: Boolean; - - {:Send specified request to SOCKS proxy. This is needed only in special - cases! (it is called internally!)} - function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean; - - {:Receive response to previosly sended request. This is needed only in - special cases! (it is called internally!)} - function SocksResponse: Boolean; - - {:Is @True when class is using SOCKS proxy.} - property UsingSocks: Boolean read FUsingSocks; - - {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.} - property SocksLastError: integer read FSocksLastError; - published - {:Address of SOCKS server. If value is empty string, SOCKS support is - disabled. Assingning any value to this property enable SOCKS mode. - Warning: You cannot combine this mode with HTTP-tunneling mode!} - property SocksIP: string read FSocksIP write FSocksIP; - - {:Port of SOCKS server. Default value is '1080'.} - property SocksPort: string read FSocksPort write FSocksPort; - - {:If you need authorisation on SOCKS server, set username here.} - property SocksUsername: string read FSocksUsername write FSocksUsername; - - {:If you need authorisation on SOCKS server, set password here.} - property SocksPassword: string read FSocksPassword write FSocksPassword; - - {:Specify timeout for communicatin with SOCKS server. Default is one minute.} - property SocksTimeout: integer read FSocksTimeout write FSocksTimeout; - - {:If @True, all symbolic names of target hosts is not translated to IP's - locally, but resolving is by SOCKS proxy. Default is @True.} - property SocksResolver: Boolean read FSocksResolver write FSocksResolver; - - {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too. - When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is - used SOCKS4a. Othervise is used pure SOCKS4.} - property SocksType: TSocksType read FSocksType write FSocksType; - end; - - {:@abstract(Implementation of TCP socket.) - Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin), - SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy - (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.} - TTCPBlockSocket = class(TSocksBlockSocket) - protected - FOnAfterConnect: THookAfterConnect; - FSSL: TCustomSSL; - FHTTPTunnelIP: string; - FHTTPTunnelPort: string; - FHTTPTunnel: Boolean; - FHTTPTunnelRemoteIP: string; - FHTTPTunnelRemotePort: string; - FHTTPTunnelUser: string; - FHTTPTunnelPass: string; - FHTTPTunnelTimeout: integer; - procedure SocksDoConnect(IP, Port: string); - procedure HTTPTunnelDoConnect(IP, Port: string); - procedure DoAfterConnect; - public - {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation - (see @link(SSLImplementation))} - constructor Create; - - {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation} - constructor CreateWithSSL(SSLPlugin: TSSLClass); - destructor Destroy; override; - - {:See @link(TBlockSocket.CloseSocket)} - procedure CloseSocket; override; - - {:See @link(TBlockSocket.WaitingData)} - function WaitingData: Integer; override; - - {:Sets socket to receive mode for new incoming connections. It is necessary - to use @link(TBlockSocket.BIND) function call before this method to select - receiving port! - - If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND - method of SOCKS.)} - procedure Listen; override; - - {:Waits until new incoming connection comes. After it comes a new socket is - automatically created (socket handler is returned by this function as - result). - - If you use SOCKS, new socket is not created! In this case is used same - socket as socket for listening! So, you can accept only one connection in - SOCKS mode.} - function Accept: TSocket; override; - - {:Connects socket to remote IP address and PORT. The same rules as with - @link(TBlockSocket.BIND) method are valid. The only exception is that PORT - with 0 value will not be connected. After call to this method - a communication channel between local and remote socket is created. Local - socket is assigned automatically if not controlled by previous call to - @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin) - and @link(TBlockSocket.RemoteSin) will be filled with valid values. - - If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified - in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.) - - If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP - tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP - protocol.) - - Note: If you call this on non-created socket, then socket is created - automaticly.} - procedure Connect(IP, Port: string); override; - - {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin - allows it) mode, then call this method. This method switch this class to - SSL mode and do SSL/TSL handshake.} - procedure SSLDoConnect; - - {:By this method you can downgrade existing SSL/TLS connection to normal TCP - connection.} - procedure SSLDoShutdown; - - {:If you need use this component as SSL/TLS TCP server, then after accepting - of inbound connection you need start SSL/TLS session by this method. Before - call this function, you must have assigned all neeeded certificates and - keys!} - function SSLAcceptConnection: Boolean; - - {:See @link(TBlockSocket.GetLocalSinIP)} - function GetLocalSinIP: string; override; - - {:See @link(TBlockSocket.GetRemoteSinIP)} - function GetRemoteSinIP: string; override; - - {:See @link(TBlockSocket.GetLocalSinPort)} - function GetLocalSinPort: Integer; override; - - {:See @link(TBlockSocket.GetRemoteSinPort)} - function GetRemoteSinPort: Integer; override; - - {:See @link(TBlockSocket.SendBuffer)} - function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override; - - {:See @link(TBlockSocket.RecvBuffer)} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - - {:Return value of socket type. For TCP return SOCK_STREAM.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For TCP return - IPPROTO_TCP.} - function GetSocketProtocol: integer; override; - - {:Class implementing SSL/TLS support. It is allways some descendant - of @link(TCustomSSL) class. When programmer not select some SSL plugin - class, then is used @link(TSSLNone)} - property SSL: TCustomSSL read FSSL; - - {:@True if is used HTTP tunnel mode.} - property HTTPTunnel: Boolean read FHTTPTunnel; - published - {:Return descriptive string for @link(LastError). On case of error - in SSL/TLS subsystem, it returns right error description.} - function GetErrorDescEx: string; override; - - {:Specify IP address of HTTP proxy. Assingning non-empty value to this - property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing - TCP connection through HTTP proxy server. (If policy on HTTP proxy server - allow this!) Warning: You cannot combine this mode with SOCK5 mode!} - property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP; - - {:Specify port of HTTP proxy for HTTP-tunneling.} - property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort; - - {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel - mode. If you not need authorisation, then let this property empty.} - property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser; - - {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel - mode.} - property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass; - - {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.} - property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout; - - {:This event is called after sucessful TCP socket connection.} - property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect; - end; - - {:@abstract(Datagram based communication) - This class implementing datagram based communication instead default stream - based communication style.} - TDgramBlockSocket = class(TSocksBlockSocket) - public - {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for - sending data.} - procedure Connect(IP, Port: string); override; - - {:Silently redirected to @link(TBlockSocket.SendBufferTo).} - function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override; - - {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).} - function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override; - end; - - {:@abstract(Implementation of UDP socket.) - NOTE: in this class is all receiving redirected to RecvBufferFrom. You can - use for reading any receive function. Preffered is RecvPacket! Similary all - sending is redirected to SendbufferTo. You can use for sending UDP packet any - sending function, like SendString. - - Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5 - proxy (only unicasts! Outgoing and incomming.)} - TUDPBlockSocket = class(TDgramBlockSocket) - protected - FSocksControlSock: TTCPBlockSocket; - function UdpAssociation: Boolean; - procedure SetMulticastTTL(TTL: integer); - function GetMulticastTTL:integer; - public - destructor Destroy; override; - - {:Enable or disable sending of broadcasts. If seting OK, result is @true. - This method is not supported in SOCKS5 mode! IPv6 does not support - broadcasts! In this case you must use Multicasts instead.} - procedure EnableBroadcast(Value: Boolean); - - {:See @link(TBlockSocket.SendBufferTo)} - function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override; - - {:See @link(TBlockSocket.RecvBufferFrom)} - function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override; -{$IFNDEF CIL} - {:Add this socket to given multicast group. You cannot use Multicasts in - SOCKS mode!} - procedure AddMulticast(MCastIP:string); - - {:Remove this socket from given multicast group.} - procedure DropMulticast(MCastIP:string); -{$ENDIF} - {:All sended multicast datagrams is loopbacked to your interface too. (you - can read your sended datas.) You can disable this feature by this function. - This function not working on some Windows systems!} - procedure EnableMulticastLoop(Value: Boolean); - - {:Return value of socket type. For UDP return SOCK_DGRAM.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For UDP return - IPPROTO_UDP.} - function GetSocketProtocol: integer; override; - - {:Set Time-to-live value for multicasts packets. It define number of routers - for transfer of datas. If you set this to 1 (dafault system value), then - multicasts packet goes only to you local network. If you need transport - multicast packet to worldwide, then increase this value, but be carefull, - lot of routers on internet does not transport multicasts packets!} - property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL; - end; - - {:@abstract(Implementation of RAW ICMP socket.) - For this object you must have rights for creating RAW sockets!} - TICMPBlockSocket = class(TDgramBlockSocket) - public - {:Return value of socket type. For RAW and ICMP return SOCK_RAW.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For ICMP returns - IPPROTO_ICMP or IPPROTO_ICMPV6} - function GetSocketProtocol: integer; override; - end; - - {:@abstract(Implementation of RAW socket.) - For this object you must have rights for creating RAW sockets!} - TRAWBlockSocket = class(TBlockSocket) - public - {:Return value of socket type. For RAW and ICMP return SOCK_RAW.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For RAW returns - IPPROTO_RAW.} - function GetSocketProtocol: integer; override; - end; - - {:@abstract(Implementation of PGM-message socket.) - Not all systems supports this protocol!} - TPGMMessageBlockSocket = class(TBlockSocket) - public - {:Return value of socket type. For PGM-message return SOCK_RDM.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For PGM-message returns - IPPROTO_RM.} - function GetSocketProtocol: integer; override; - end; - - {:@abstract(Implementation of PGM-stream socket.) - Not all systems supports this protocol!} - TPGMStreamBlockSocket = class(TBlockSocket) - public - {:Return value of socket type. For PGM-stream return SOCK_STREAM.} - function GetSocketType: integer; override; - - {:Return value of protocol type for socket creation. For PGM-stream returns - IPPROTO_RM.} - function GetSocketProtocol: integer; override; - end; - - {:@abstract(Parent class for all SSL plugins.) - This is abstract class defining interface for other SSL plugins. - - Instance of this class will be created for each @link(TTCPBlockSocket). - - Warning: not all methods and propertis can work in all existing SSL plugins! - Please, read documentation of used SSL plugin.} - TCustomSSL = class(TObject) - private - protected - FOnVerifyCert: THookVerifyCert; - FSocket: TTCPBlockSocket; - FSSLEnabled: Boolean; - FLastError: integer; - FLastErrorDesc: string; - FSSLType: TSSLType; - FKeyPassword: string; - FCiphers: string; - FCertificateFile: string; - FPrivateKeyFile: string; - FCertificate: Ansistring; - FPrivateKey: Ansistring; - FPFX: Ansistring; - FPFXfile: string; - FCertCA: Ansistring; - FCertCAFile: string; - FTrustCertificate: Ansistring; - FTrustCertificateFile: string; - FVerifyCert: Boolean; - FUsername: string; - FPassword: string; - FSSHChannelType: string; - FSSHChannelArg1: string; - FSSHChannelArg2: string; - FCertComplianceLevel: integer; - FSNIHost: string; - procedure ReturnError; - procedure SetCertCAFile(const Value: string); virtual; - function DoVerifyCert:boolean; - function CreateSelfSignedCert(Host: string): Boolean; virtual; - public - {: Create plugin class. it is called internally from @link(TTCPBlockSocket)} - constructor Create(const Value: TTCPBlockSocket); virtual; - - {: Assign settings (certificates and configuration) from another SSL plugin - class.} - procedure Assign(const Value: TCustomSSL); virtual; - - {: return description of used plugin. It usually return name and version - of used SSL library.} - function LibVersion: String; virtual; - - {: return name of used plugin.} - function LibName: String; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for start SSL connection.} - function Connect: boolean; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for acept new SSL connection.} - function Accept: boolean; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for hard shutdown of SSL connection. (for example, - before socket is closed)} - function Shutdown: boolean; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for soft shutdown of SSL connection. (for example, - when you need to continue with unprotected connection.)} - function BiShutdown: boolean; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for sending some datas by SSL connection.} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for receiving some datas by SSL connection.} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; virtual; - - {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)! - - Here is needed code for getting count of datas what waiting for read. - If SSL plugin not allows this, then it should return 0.} - function WaitingData: Integer; virtual; - - {:Return string with identificator of SSL/TLS version of existing - connection.} - function GetSSLVersion: string; virtual; - - {:Return subject of remote SSL peer.} - function GetPeerSubject: string; virtual; - - {:Return Serial number if remote X509 certificate.} - function GetPeerSerialNo: integer; virtual; - - {:Return issuer certificate of remote SSL peer.} - function GetPeerIssuer: string; virtual; - - {:Return peer name from remote side certificate. This is good for verify, - if certificate is generated for remote side IP name.} - function GetPeerName: string; virtual; - - {:Returns has of peer name from remote side certificate. This is good - for fast remote side authentication.} - function GetPeerNameHash: cardinal; virtual; - - {:Return fingerprint of remote SSL peer.} - function GetPeerFingerprint: string; virtual; - - {:Return all detailed information about certificate from remote side of - SSL/TLS connection. Result string can be multilined! Each plugin can return - this informations in different format!} - function GetCertInfo: string; virtual; - - {:Return currently used Cipher.} - function GetCipherName: string; virtual; - - {:Return currently used number of bits in current Cipher algorythm.} - function GetCipherBits: integer; virtual; - - {:Return number of bits in current Cipher algorythm.} - function GetCipherAlgBits: integer; virtual; - - {:Return result value of verify remote side certificate. Look to OpenSSL - documentation for possible values. For example 0 is successfuly verified - certificate, or 18 is self-signed certificate.} - function GetVerifyCert: integer; virtual; - - {: Resurn @true if SSL mode is enabled on existing cvonnection.} - property SSLEnabled: Boolean read FSSLEnabled; - - {:Return error code of last SSL operation. 0 is OK.} - property LastError: integer read FLastError; - - {:Return error description of last SSL operation.} - property LastErrorDesc: string read FLastErrorDesc; - published - {:Here you can specify requested SSL/TLS mode. Default is autodetection, but - on some servers autodetection not working properly. In this case you must - specify requested SSL/TLS mode by your hand!} - property SSLType: TSSLType read FSSLType write FSSLType; - - {:Password for decrypting of encoded certificate or key.} - property KeyPassword: string read FKeyPassword write FKeyPassword; - - {:Username for possible credentials.} - property Username: string read FUsername write FUsername; - - {:password for possible credentials.} - property Password: string read FPassword write FPassword; - - {:By this property you can modify default set of SSL/TLS ciphers.} - property Ciphers: string read FCiphers write FCiphers; - - {:Used for loading certificate from disk file. See to plugin documentation - if this method is supported and how!} - property CertificateFile: string read FCertificateFile write FCertificateFile; - - {:Used for loading private key from disk file. See to plugin documentation - if this method is supported and how!} - property PrivateKeyFile: string read FPrivateKeyFile write FPrivateKeyFile; - - {:Used for loading certificate from binary string. See to plugin documentation - if this method is supported and how!} - property Certificate: Ansistring read FCertificate write FCertificate; - - {:Used for loading private key from binary string. See to plugin documentation - if this method is supported and how!} - property PrivateKey: Ansistring read FPrivateKey write FPrivateKey; - - {:Used for loading PFX from binary string. See to plugin documentation - if this method is supported and how!} - property PFX: Ansistring read FPFX write FPFX; - - {:Used for loading PFX from disk file. See to plugin documentation - if this method is supported and how!} - property PFXfile: string read FPFXfile write FPFXfile; - - {:Used for loading trusted certificates from disk file. See to plugin documentation - if this method is supported and how!} - property TrustCertificateFile: string read FTrustCertificateFile write FTrustCertificateFile; - - {:Used for loading trusted certificates from binary string. See to plugin documentation - if this method is supported and how!} - property TrustCertificate: Ansistring read FTrustCertificate write FTrustCertificate; - - {:Used for loading CA certificates from binary string. See to plugin documentation - if this method is supported and how!} - property CertCA: Ansistring read FCertCA write FCertCA; - - {:Used for loading CA certificates from disk file. See to plugin documentation - if this method is supported and how!} - property CertCAFile: string read FCertCAFile write SetCertCAFile; - - {:If @true, then is verified client certificate. (it is good for writing - SSL/TLS servers.) When you are not server, but you are client, then if this - property is @true, verify servers certificate.} - property VerifyCert: Boolean read FVerifyCert write FVerifyCert; - - {:channel type for possible SSH connections} - property SSHChannelType: string read FSSHChannelType write FSSHChannelType; - - {:First argument of channel type for possible SSH connections} - property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1; - - {:Second argument of channel type for possible SSH connections} - property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2; - - {: Level of standards compliance level - (CryptLib: values in cryptlib.pas, -1: use default value ) } - property CertComplianceLevel:integer read FCertComplianceLevel write FCertComplianceLevel; - - {:This event is called when verifying the server certificate immediatally after - a successfull verification in the ssl library.} - property OnVerifyCert: THookVerifyCert read FOnVerifyCert write FOnVerifyCert; - - {: Server Name Identification. Host name to send to server. If empty the host name - found in URL will be used, which should be the normal use (http Header Host = SNI Host). - The value is cleared after the connection is established. - (SNI support requires OpenSSL 0.9.8k or later. Cryptlib not supported, yet ) } - property SNIHost:string read FSNIHost write FSNIHost; - end; - - {:@abstract(Default SSL plugin with no SSL support.) - Dummy SSL plugin implementation for applications without SSL/TLS support.} - TSSLNone = class (TCustomSSL) - public - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - end; - - {:@abstract(Record with definition of IP packet header.) - For reading data from ICMP or RAW sockets.} - TIPHeader = record - VerLen: Byte; - TOS: Byte; - TotalLen: Word; - Identifer: Word; - FragOffsets: Word; - TTL: Byte; - Protocol: Byte; - CheckSum: Word; - SourceIp: LongWord; - DestIp: LongWord; - Options: LongWord; - end; - - {:@abstract(Parent class of application protocol implementations.) - By this class is defined common properties.} - TSynaClient = Class(TObject) - protected - FTargetHost: string; - FTargetPort: string; - FIPInterface: string; - FTimeout: integer; - FUserName: string; - FPassword: string; - public - constructor Create; - published - {:Specify terget server IP (or symbolic name). Default is 'localhost'.} - property TargetHost: string read FTargetHost Write FTargetHost; - - {:Specify terget server port (or symbolic name).} - property TargetPort: string read FTargetPort Write FTargetPort; - - {:Defined local socket address. (outgoing IP address). By default is used - '0.0.0.0' as wildcard for default IP.} - property IPInterface: string read FIPInterface Write FIPInterface; - - {:Specify default timeout for socket operations.} - property Timeout: integer read FTimeout Write FTimeout; - - {:If protocol need user authorization, then fill here username.} - property UserName: string read FUserName Write FUserName; - - {:If protocol need user authorization, then fill here password.} - property Password: string read FPassword Write FPassword; - end; - -var - {:Selected SSL plugin. Default is @link(TSSLNone). - - Do not change this value directly!!! - - Just add your plugin unit to your project uses instead. Each plugin unit have - initialization code what modify this variable.} - SSLImplementation: TSSLClass = TSSLNone; - -implementation - -{$IFDEF ONCEWINSOCK} -var - WsaDataOnce: TWSADATA; - e: ESynapseError; -{$ENDIF} - - -constructor TBlockSocket.Create; -begin - CreateAlternate(''); -end; - -constructor TBlockSocket.CreateAlternate(Stub: string); -{$IFNDEF ONCEWINSOCK} -var - e: ESynapseError; -{$ENDIF} -begin - inherited Create; - FDelayedOptions := TList.Create; - FRaiseExcept := False; -{$IFDEF RAISEEXCEPT} - FRaiseExcept := True; -{$ENDIF} - FSocket := INVALID_SOCKET; - FBuffer := ''; - FLastCR := False; - FLastLF := False; - FBinded := False; - FNonBlockMode := False; - FMaxLineLength := 0; - FMaxSendBandwidth := 0; - FNextSend := 0; - FMaxRecvBandwidth := 0; - FNextRecv := 0; - FConvertLineEnd := False; - FFamily := SF_Any; - FFamilySave := SF_Any; - FIP6used := False; - FPreferIP4 := True; - FInterPacketTimeout := True; - FRecvCounter := 0; - FSendCounter := 0; - FSendMaxChunk := c64k; - FStopFlag := False; - FNonblockSendTimeout := 15000; - FHeartbeatRate := 0; - FConnectionTimeout := 0; - FOwner := nil; -{$IFNDEF ONCEWINSOCK} - if Stub = '' then - Stub := DLLStackName; - if not InitSocketInterface(Stub) then - begin - e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!'); - e.ErrorCode := 0; - e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!'; - raise e; - end; - SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce)); - ExceptCheck; -{$ENDIF} -end; - -destructor TBlockSocket.Destroy; -var - n: integer; - p: TSynaOption; -begin - CloseSocket; -{$IFNDEF ONCEWINSOCK} - synsock.WSACleanup; - DestroySocketInterface; -{$ENDIF} - for n := FDelayedOptions.Count - 1 downto 0 do - begin - p := TSynaOption(FDelayedOptions[n]); - p.Free; - end; - FDelayedOptions.Free; - inherited Destroy; -end; - -function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily; -begin - case f of - SF_ip4: - Result := AF_INET; - SF_ip6: - Result := AF_INET6; - else - Result := AF_UNSPEC; - end; -end; - -procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption); -var - li: TLinger; - x: integer; - buf: TMemory; -{$IFNDEF MSWINDOWS} - timeval: TTimeval; -{$ENDIF} -begin - case value.Option of - SOT_Linger: - begin - {$IFDEF CIL} - li := TLinger.Create(Value.Enabled, Value.Value div 1000); - synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li); - {$ELSE} - li.l_onoff := Ord(Value.Enabled); - li.l_linger := Value.Value div 1000; - buf := @li; - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li)); - {$ENDIF} - end; - SOT_RecvBuff: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - {$ELSE} - buf := @Value.Value; - {$ENDIF} - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), - buf, SizeOf(Value.Value)); - end; - SOT_SendBuff: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - {$ELSE} - buf := @Value.Value; - {$ENDIF} - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), - buf, SizeOf(Value.Value)); - end; - SOT_NonBlock: - begin - FNonBlockMode := Value.Enabled; - x := Ord(FNonBlockMode); - synsock.IoctlSocket(FSocket, FIONBIO, x); - end; - SOT_RecvTimeout: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO), - buf, SizeOf(Value.Value)); - {$ELSE} - {$IFDEF MSWINDOWS} - buf := @Value.Value; - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO), - buf, SizeOf(Value.Value)); - {$ELSE} - timeval.tv_sec:=Value.Value div 1000; - timeval.tv_usec:=(Value.Value mod 1000) * 1000; - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO), - @timeval, SizeOf(timeval)); - {$ENDIF} - {$ENDIF} - end; - SOT_SendTimeout: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - {$ELSE} - {$IFDEF MSWINDOWS} - buf := @Value.Value; - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO), - buf, SizeOf(Value.Value)); - {$ELSE} - timeval.tv_sec:=Value.Value div 1000; - timeval.tv_usec:=(Value.Value mod 1000) * 1000; - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO), - @timeval, SizeOf(timeval)); - {$ENDIF} - {$ENDIF} - end; - SOT_Reuse: - begin - x := Ord(Value.Enabled); - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(x); - {$ELSE} - buf := @x; - {$ENDIF} - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x)); - end; - SOT_TTL: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - {$ELSE} - buf := @Value.Value; - {$ENDIF} - if FIP6Used then - synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS), - buf, SizeOf(Value.Value)) - else - synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL), - buf, SizeOf(Value.Value)); - end; - SOT_Broadcast: - begin -//#todo1 broadcasty na IP6 - x := Ord(Value.Enabled); - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(x); - {$ELSE} - buf := @x; - {$ENDIF} - synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x)); - end; - SOT_MulticastTTL: - begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(value.Value); - {$ELSE} - buf := @Value.Value; - {$ENDIF} - if FIP6Used then - synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS), - buf, SizeOf(Value.Value)) - else - synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL), - buf, SizeOf(Value.Value)); - end; - SOT_MulticastLoop: - begin - x := Ord(Value.Enabled); - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(x); - {$ELSE} - buf := @x; - {$ENDIF} - if FIP6Used then - synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_LOOP), buf, SizeOf(x)) - else - synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x)); - end; - end; - Value.free; -end; - -procedure TBlockSocket.DelayedOption(const Value: TSynaOption); -begin - if FSocket = INVALID_SOCKET then - begin - FDelayedOptions.Insert(0, Value); - end - else - SetDelayedOption(Value); -end; - -procedure TBlockSocket.ProcessDelayedOptions; -var - n: integer; - d: TSynaOption; -begin - for n := FDelayedOptions.Count - 1 downto 0 do - begin - d := TSynaOption(FDelayedOptions[n]); - SetDelayedOption(d); - end; - FDelayedOptions.Clear; -end; - -procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string); -var - f: TSocketFamily; -begin - DoStatus(HR_ResolvingBegin, IP + ':' + Port); - ResetLastError; - //if socket exists, then use their type, else use users selection - f := SF_Any; - if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then - begin - if IsIP(IP) then - f := SF_IP4 - else - if IsIP6(IP) then - f := SF_IP6; - end - else - f := FFamily; - FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f), - GetSocketprotocol, GetSocketType, FPreferIP4); - DoStatus(HR_ResolvingEnd, GetSinIP(sin) + ':' + IntTostr(GetSinPort(sin))); -end; - -function TBlockSocket.GetSinIP(Sin: TVarSin): string; -begin - Result := synsock.GetSinIP(sin); -end; - -function TBlockSocket.GetSinPort(Sin: TVarSin): Integer; -begin - Result := synsock.GetSinPort(sin); -end; - -procedure TBlockSocket.CreateSocket; -var - sin: TVarSin; -begin - //dummy for SF_Any Family mode - ResetLastError; - if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then - begin - {$IFDEF CIL} - if FFamily = SF_IP6 then - sin := TVarSin.Create(IPAddress.Parse('::0'), 0) - else - sin := TVarSin.Create(IPAddress.Parse('0.0.0.0'), 0); - {$ELSE} - FillChar(Sin, Sizeof(Sin), 0); - if FFamily = SF_IP6 then - sin.sin_family := AF_INET6 - else - sin.sin_family := AF_INET; - {$ENDIF} - InternalCreateSocket(Sin); - end; -end; - -procedure TBlockSocket.CreateSocketByName(const Value: String); -var - sin: TVarSin; -begin - ResetLastError; - if FSocket = INVALID_SOCKET then - begin - SetSin(sin, value, '0'); - if FLastError = 0 then - InternalCreateSocket(Sin); - end; -end; - -procedure TBlockSocket.InternalCreateSocket(Sin: TVarSin); -begin - FStopFlag := False; - FRecvCounter := 0; - FSendCounter := 0; - ResetLastError; - if FSocket = INVALID_SOCKET then - begin - FBuffer := ''; - FBinded := False; - FIP6Used := Sin.AddressFamily = AF_INET6; - FSocket := synsock.Socket(integer(Sin.AddressFamily), GetSocketType, GetSocketProtocol); - if FSocket = INVALID_SOCKET then - FLastError := synsock.WSAGetLastError; - {$IFNDEF CIL} - FD_ZERO(FFDSet); - FD_SET(FSocket, FFDSet); - {$ENDIF} - ExceptCheck; - if FIP6used then - DoStatus(HR_SocketCreate, 'IPv6') - else - DoStatus(HR_SocketCreate, 'IPv4'); - ProcessDelayedOptions; - DoCreateSocket; - end; -end; - -procedure TBlockSocket.CloseSocket; -begin - AbortSocket; -end; - -procedure TBlockSocket.AbortSocket; -var - n: integer; - p: TSynaOption; -begin - if FSocket <> INVALID_SOCKET then - synsock.CloseSocket(FSocket); - FSocket := INVALID_SOCKET; - for n := FDelayedOptions.Count - 1 downto 0 do - begin - p := TSynaOption(FDelayedOptions[n]); - p.Free; - end; - FDelayedOptions.Clear; - FFamily := FFamilySave; - DoStatus(HR_SocketClose, ''); -end; - -procedure TBlockSocket.Bind(IP, Port: string); -var - Sin: TVarSin; -begin - ResetLastError; - if (FSocket <> INVALID_SOCKET) - or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then - begin - SetSin(Sin, IP, Port); - if FLastError = 0 then - begin - if FSocket = INVALID_SOCKET then - InternalCreateSocket(Sin); - SockCheck(synsock.Bind(FSocket, Sin)); - GetSinLocal; - FBuffer := ''; - FBinded := True; - end; - ExceptCheck; - DoStatus(HR_Bind, IP + ':' + Port); - end; -end; - -procedure TBlockSocket.Connect(IP, Port: string); -var - Sin: TVarSin; - b: boolean; -begin - SetSin(Sin, IP, Port); - if FLastError = 0 then - begin - if FSocket = INVALID_SOCKET then - InternalCreateSocket(Sin); - if FConnectionTimeout > 0 then - begin - // connect in non-blocking mode - b := NonBlockMode; - NonBlockMode := true; - SockCheck(synsock.Connect(FSocket, Sin)); - if (FLastError = WSAEINPROGRESS) OR (FLastError = WSAEWOULDBLOCK) then - if not CanWrite(FConnectionTimeout) then - FLastError := WSAETIMEDOUT; - NonBlockMode := b; - end - else - SockCheck(synsock.Connect(FSocket, Sin)); - if FLastError = 0 then - GetSins; - FBuffer := ''; - FLastCR := False; - FLastLF := False; - end; - ExceptCheck; - DoStatus(HR_Connect, IP + ':' + Port); -end; - -procedure TBlockSocket.Listen; -begin - SockCheck(synsock.Listen(FSocket, SOMAXCONN)); - GetSins; - ExceptCheck; - DoStatus(HR_Listen, ''); -end; - -function TBlockSocket.Accept: TSocket; -begin - Result := synsock.Accept(FSocket, FRemoteSin); -/// SockCheck(Result); - ExceptCheck; - DoStatus(HR_Accept, ''); -end; - -procedure TBlockSocket.GetSinLocal; -begin - synsock.GetSockName(FSocket, FLocalSin); -end; - -procedure TBlockSocket.GetSinRemote; -begin - synsock.GetPeerName(FSocket, FRemoteSin); -end; - -procedure TBlockSocket.GetSins; -begin - GetSinLocal; - GetSinRemote; -end; - -procedure TBlockSocket.SetBandwidth(Value: Integer); -begin - MaxSendBandwidth := Value; - MaxRecvBandwidth := Value; -end; - -procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); -var - x: LongWord; - y: LongWord; - n: integer; -begin - if FStopFlag then - exit; - if MaxB > 0 then - begin - y := GetTick; - if Next > y then - begin - x := Next - y; - if x > 0 then - begin - DoStatus(HR_Wait, IntToStr(x)); - sleep(x mod 250); - for n := 1 to x div 250 do - if FStopFlag then - Break - else - sleep(250); - end; - end; - Next := GetTick + Trunc((Length / MaxB) * 1000); - end; -end; - -function TBlockSocket.TestStopFlag: Boolean; -begin - DoHeartbeat; - Result := FStopFlag; - if Result then - begin - FStopFlag := False; - FLastError := WSAECONNABORTED; - ExceptCheck; - end; -end; - - -function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; -{$IFNDEF CIL} -var - x, y: integer; - l, r: integer; - p: Pointer; -{$ENDIF} -begin - Result := 0; - if TestStopFlag then - Exit; - DoMonitor(True, Buffer, Length); -{$IFDEF CIL} - Result := synsock.Send(FSocket, Buffer, Length, 0); -{$ELSE} - l := Length; - x := 0; - while x < l do - begin - y := l - x; - if y > FSendMaxChunk then - y := FSendMaxChunk; - if y > 0 then - begin - LimitBandwidth(y, FMaxSendBandwidth, FNextsend); - p := IncPoint(Buffer, x); - r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL); - SockCheck(r); - if FLastError = WSAEWOULDBLOCK then - begin - if CanWrite(FNonblockSendTimeout) then - begin - r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL); - SockCheck(r); - end - else - FLastError := WSAETIMEDOUT; - end; - if FLastError <> 0 then - Break; - Inc(x, r); - Inc(Result, r); - Inc(FSendCounter, r); - DoStatus(HR_WriteCount, IntToStr(r)); - end - else - break; - end; -{$ENDIF} - ExceptCheck; -end; - -procedure TBlockSocket.SendByte(Data: Byte); -{$IFDEF CIL} -var - buf: TMemory; -{$ENDIF} -begin -{$IFDEF CIL} - setlength(buf, 1); - buf[0] := Data; - SendBuffer(buf, 1); -{$ELSE} - SendBuffer(@Data, 1); -{$ENDIF} -end; - -procedure TBlockSocket.SendString(Data: AnsiString); -var - buf: TMemory; -begin - {$IFDEF CIL} - buf := BytesOf(Data); - {$ELSE} - buf := Pointer(data); - {$ENDIF} - SendBuffer(buf, Length(Data)); -end; - -procedure TBlockSocket.SendInteger(Data: integer); -var - buf: TMemory; -begin - {$IFDEF CIL} - buf := System.BitConverter.GetBytes(Data); - {$ELSE} - buf := @Data; - {$ENDIF} - SendBuffer(buf, SizeOf(Data)); -end; - -procedure TBlockSocket.SendBlock(const Data: AnsiString); -var - i: integer; -begin - i := SwapBytes(Length(data)); - SendString(Codelongint(i) + Data); -end; - -procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); -var - l: integer; - yr: integer; - s: AnsiString; - b: boolean; -{$IFDEF CIL} - buf: TMemory; -{$ENDIF} -begin - b := true; - l := 0; - if WithSize then - begin - l := Stream.Size - Stream.Position;; - if not Indy then - l := synsock.HToNL(l); - end; - repeat - {$IFDEF CIL} - Setlength(buf, FSendMaxChunk); - yr := Stream.read(buf, FSendMaxChunk); - if yr > 0 then - begin - if WithSize and b then - begin - b := false; - SendString(CodeLongInt(l)); - end; - SendBuffer(buf, yr); - if FLastError <> 0 then - break; - end - {$ELSE} - Setlength(s, FSendMaxChunk); - yr := Stream.read(Pointer(s)^, FSendMaxChunk); - if yr > 0 then - begin - SetLength(s, yr); - if WithSize and b then - begin - b := false; - SendString(CodeLongInt(l) + s); - end - else - SendString(s); - if FLastError <> 0 then - break; - end - {$ENDIF} - until yr <= 0; -end; - -procedure TBlockSocket.SendStreamRaw(const Stream: TStream); -begin - InternalSendStream(Stream, false, false); -end; - -procedure TBlockSocket.SendStreamIndy(const Stream: TStream); -begin - InternalSendStream(Stream, true, true); -end; - -procedure TBlockSocket.SendStream(const Stream: TStream); -begin - InternalSendStream(Stream, true, false); -end; - -function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer; -begin - Result := 0; - if TestStopFlag then - Exit; - LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); -// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL); - Result := synsock.Recv(FSocket, Buffer, Length, MSG_NOSIGNAL); - if Result = 0 then - FLastError := WSAECONNRESET - else - SockCheck(Result); - ExceptCheck; - if Result > 0 then - begin - Inc(FRecvCounter, Result); - DoStatus(HR_ReadCount, IntToStr(Result)); - DoMonitor(False, Buffer, Result); - DoReadFilter(Buffer, Result); - end; -end; - -function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer; - Timeout: Integer): Integer; -var - s: AnsiString; - rl, l: integer; - ti: LongWord; -{$IFDEF CIL} - n: integer; - b: TMemory; -{$ENDIF} -begin - ResetLastError; - Result := 0; - if Len > 0 then - begin - rl := 0; - repeat - ti := GetTick; - s := RecvPacket(Timeout); - l := Length(s); - if (rl + l) > Len then - l := Len - rl; - {$IFDEF CIL} - b := BytesOf(s); - for n := 0 to l do - Buffer[rl + n] := b[n]; - {$ELSE} - Move(Pointer(s)^, IncPoint(Buffer, rl)^, l); - {$ENDIF} - rl := rl + l; - if FLastError <> 0 then - Break; - if rl >= Len then - Break; - if not FInterPacketTimeout then - begin - Timeout := Timeout - integer(TickDelta(ti, GetTick)); - if Timeout <= 0 then - begin - FLastError := WSAETIMEDOUT; - Break; - end; - end; - until False; - delete(s, 1, l); - FBuffer := s; - Result := rl; - end; -end; - -function TBlockSocket.RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; -var - x: integer; -{$IFDEF CIL} - buf: Tmemory; -{$ENDIF} -begin - Result := ''; - if Len > 0 then - begin - {$IFDEF CIL} - Setlength(Buf, Len); - x := RecvBufferEx(buf, Len , Timeout); - if FLastError = 0 then - begin - SetLength(Buf, x); - Result := StringOf(buf); - end - else - Result := ''; - {$ELSE} - Setlength(Result, Len); - x := RecvBufferEx(Pointer(Result), Len , Timeout); - if FLastError = 0 then - SetLength(Result, x) - else - Result := ''; - {$ENDIF} - end; -end; - -function TBlockSocket.RecvPacket(Timeout: Integer): AnsiString; -var - x: integer; -{$IFDEF CIL} - buf: TMemory; -{$ENDIF} -begin - Result := ''; - ResetLastError; - if FBuffer <> '' then - begin - Result := FBuffer; - FBuffer := ''; - end - else - begin - {$IFDEF MSWINDOWS} - //not drain CPU on large downloads... - Sleep(0); - {$ENDIF} - x := WaitingData; - if x > 0 then - begin - {$IFDEF CIL} - SetLength(Buf, x); - x := RecvBuffer(Buf, x); - if x >= 0 then - begin - SetLength(Buf, x); - Result := StringOf(Buf); - end; - {$ELSE} - SetLength(Result, x); - x := RecvBuffer(Pointer(Result), x); - if x >= 0 then - SetLength(Result, x); - {$ENDIF} - end - else - begin - if CanRead(Timeout) then - begin - x := WaitingData; - if x = 0 then - FLastError := WSAECONNRESET; - if x > 0 then - begin - {$IFDEF CIL} - SetLength(Buf, x); - x := RecvBuffer(Buf, x); - if x >= 0 then - begin - SetLength(Buf, x); - result := StringOf(Buf); - end; - {$ELSE} - SetLength(Result, x); - x := RecvBuffer(Pointer(Result), x); - if x >= 0 then - SetLength(Result, x); - {$ENDIF} - end; - end - else - FLastError := WSAETIMEDOUT; - end; - end; - if FConvertLineEnd and (Result <> '') then - begin - if FLastCR and (Result[1] = LF) then - Delete(Result, 1, 1); - if FLastLF and (Result[1] = CR) then - Delete(Result, 1, 1); - FLastCR := False; - FLastLF := False; - end; - ExceptCheck; -end; - - -function TBlockSocket.RecvByte(Timeout: Integer): Byte; -begin - Result := 0; - ResetLastError; - if FBuffer = '' then - FBuffer := RecvPacket(Timeout); - if (FLastError = 0) and (FBuffer <> '') then - begin - Result := Ord(FBuffer[1]); - Delete(FBuffer, 1, 1); - end; - ExceptCheck; -end; - -function TBlockSocket.RecvInteger(Timeout: Integer): Integer; -var - s: AnsiString; -begin - Result := 0; - s := RecvBufferStr(4, Timeout); - if FLastError = 0 then - Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536; -end; - -function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; -var - x: Integer; - s: AnsiString; - l: Integer; - CorCRLF: Boolean; - t: AnsiString; - tl: integer; - ti: LongWord; -begin - ResetLastError; - Result := ''; - l := Length(Terminator); - if l = 0 then - Exit; - tl := l; - CorCRLF := FConvertLineEnd and (Terminator = CRLF); - s := ''; - x := 0; - repeat - //get rest of FBuffer or incomming new data... - ti := GetTick; - s := s + RecvPacket(Timeout); - if FLastError <> 0 then - Break; - x := 0; - if Length(s) > 0 then - if CorCRLF then - begin - t := ''; - x := PosCRLF(s, t); - tl := Length(t); - if t = CR then - FLastCR := True; - if t = LF then - FLastLF := True; - end - else - begin - x := pos(Terminator, s); - tl := l; - end; - if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then - begin - FLastError := WSAENOBUFS; - Break; - end; - if x > 0 then - Break; - if not FInterPacketTimeout then - begin - Timeout := Timeout - integer(TickDelta(ti, GetTick)); - if Timeout <= 0 then - begin - FLastError := WSAETIMEDOUT; - Break; - end; - end; - until False; - if x > 0 then - begin - Result := Copy(s, 1, x - 1); - Delete(s, 1, x + tl - 1); - end; - FBuffer := s; - ExceptCheck; -end; - -function TBlockSocket.RecvString(Timeout: Integer): AnsiString; -var - s: AnsiString; -begin - Result := ''; - s := RecvTerminated(Timeout, CRLF); - if FLastError = 0 then - Result := s; -end; - -function TBlockSocket.RecvBlock(Timeout: Integer): AnsiString; -var - x: integer; -begin - Result := ''; - x := RecvInteger(Timeout); - if FLastError = 0 then - Result := RecvBufferStr(x, Timeout); -end; - -procedure TBlockSocket.RecvStreamRaw(const Stream: TStream; Timeout: Integer); -var - s: AnsiString; -begin - repeat - s := RecvPacket(Timeout); - if FLastError = 0 then - WriteStrToStream(Stream, s); - until FLastError <> 0; -end; - -procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); -var - s: AnsiString; - n: integer; -{$IFDEF CIL} - buf: TMemory; -{$ENDIF} -begin - for n := 1 to (Size div FSendMaxChunk) do - begin - {$IFDEF CIL} - SetLength(buf, FSendMaxChunk); - RecvBufferEx(buf, FSendMaxChunk, Timeout); - if FLastError <> 0 then - Exit; - Stream.Write(buf, FSendMaxChunk); - {$ELSE} - s := RecvBufferStr(FSendMaxChunk, Timeout); - if FLastError <> 0 then - Exit; - WriteStrToStream(Stream, s); - {$ENDIF} - end; - n := Size mod FSendMaxChunk; - if n > 0 then - begin - {$IFDEF CIL} - SetLength(buf, n); - RecvBufferEx(buf, n, Timeout); - if FLastError <> 0 then - Exit; - Stream.Write(buf, n); - {$ELSE} - s := RecvBufferStr(n, Timeout); - if FLastError <> 0 then - Exit; - WriteStrToStream(Stream, s); - {$ENDIF} - end; -end; - -procedure TBlockSocket.RecvStreamIndy(const Stream: TStream; Timeout: Integer); -var - x: integer; -begin - x := RecvInteger(Timeout); - x := synsock.NToHL(x); - if FLastError = 0 then - RecvStreamSize(Stream, Timeout, x); -end; - -procedure TBlockSocket.RecvStream(const Stream: TStream; Timeout: Integer); -var - x: integer; -begin - x := RecvInteger(Timeout); - if FLastError = 0 then - RecvStreamSize(Stream, Timeout, x); -end; - -function TBlockSocket.PeekBuffer(Buffer: TMemory; Length: Integer): Integer; -begin - {$IFNDEF CIL} -// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL); - Result := synsock.Recv(FSocket, Buffer, Length, MSG_PEEK + MSG_NOSIGNAL); - SockCheck(Result); - ExceptCheck; - {$ENDIF} -end; - -function TBlockSocket.PeekByte(Timeout: Integer): Byte; -var - s: string; -begin - {$IFNDEF CIL} - Result := 0; - if CanRead(Timeout) then - begin - SetLength(s, 1); - PeekBuffer(Pointer(s), 1); - if s <> '' then - Result := Ord(s[1]); - end - else - FLastError := WSAETIMEDOUT; - ExceptCheck; - {$ENDIF} -end; - -procedure TBlockSocket.ResetLastError; -begin - FLastError := 0; - FLastErrorDesc := ''; -end; - -function TBlockSocket.SockCheck(SockResult: Integer): Integer; -begin - ResetLastError; - if SockResult = integer(SOCKET_ERROR) then - begin - FLastError := synsock.WSAGetLastError; - FLastErrorDesc := GetErrorDescEx; - end; - Result := FLastError; -end; - -procedure TBlockSocket.ExceptCheck; -var - e: ESynapseError; -begin - FLastErrorDesc := GetErrorDescEx; - if (LastError <> 0) and (LastError <> WSAEINPROGRESS) - and (LastError <> WSAEWOULDBLOCK) then - begin - DoStatus(HR_Error, IntToStr(FLastError) + ',' + FLastErrorDesc); - if FRaiseExcept then - begin - e := ESynapseError.Create(Format('Synapse TCP/IP Socket error %d: %s', - [FLastError, FLastErrorDesc])); - e.ErrorCode := FLastError; - e.ErrorMessage := FLastErrorDesc; - raise e; - end; - end; -end; - -function TBlockSocket.WaitingData: Integer; -var - x: Integer; -begin - Result := 0; - if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then - Result := x; - if Result > c64k then - Result := c64k; -end; - -function TBlockSocket.WaitingDataEx: Integer; -begin - if FBuffer <> '' then - Result := Length(FBuffer) - else - Result := WaitingData; -end; - -procedure TBlockSocket.Purge; -begin - Sleep(1); - try - while (Length(FBuffer) > 0) or (WaitingData > 0) do - begin - RecvPacket(0); - if FLastError <> 0 then - break; - end; - except - on exception do; - end; - ResetLastError; -end; - -procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_Linger; - d.Enabled := Enable; - d.Value := Linger; - DelayedOption(d); -end; - -function TBlockSocket.LocalName: string; -begin - Result := synsock.GetHostName; - if Result = '' then - Result := '127.0.0.1'; -end; - -procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings); -begin - IPList.Clear; - synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList); - if IPList.Count = 0 then - IPList.Add(cAnyHost); -end; - -function TBlockSocket.ResolveName(Name: string): string; -var - l: TStringList; -begin - l := TStringList.Create; - try - ResolveNameToIP(Name, l); - Result := l[0]; - finally - l.Free; - end; -end; - -function TBlockSocket.ResolvePort(Port: string): Word; -begin - Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType); -end; - -function TBlockSocket.ResolveIPToName(IP: string): string; -begin - if not IsIP(IP) and not IsIp6(IP) then - IP := ResolveName(IP); - Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType); -end; - -procedure TBlockSocket.SetRemoteSin(IP, Port: string); -begin - SetSin(FRemoteSin, IP, Port); -end; - -function TBlockSocket.GetLocalSinIP: string; -begin - Result := GetSinIP(FLocalSin); -end; - -function TBlockSocket.GetRemoteSinIP: string; -begin - Result := GetSinIP(FRemoteSin); -end; - -function TBlockSocket.GetLocalSinPort: Integer; -begin - Result := GetSinPort(FLocalSin); -end; - -function TBlockSocket.GetRemoteSinPort: Integer; -begin - Result := GetSinPort(FRemoteSin); -end; - -function TBlockSocket.InternalCanRead(Timeout: Integer): Boolean; -{$IFDEF CIL} -begin - Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectRead); -{$ELSE} -var - TimeVal: PTimeVal; - TimeV: TTimeVal; - x: Integer; - FDSet: TFDSet; -begin - TimeV.tv_usec := (Timeout mod 1000) * 1000; - TimeV.tv_sec := Timeout div 1000; - TimeVal := @TimeV; - if Timeout = -1 then - TimeVal := nil; - FDSet := FFdSet; - x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal); - SockCheck(x); - if FLastError <> 0 then - x := 0; - Result := x > 0; -{$ENDIF} -end; - -function TBlockSocket.CanRead(Timeout: Integer): Boolean; -var - ti, tr: Integer; - n: integer; -begin - if (FHeartbeatRate <> 0) and (Timeout <> -1) then - begin - ti := Timeout div FHeartbeatRate; - tr := Timeout mod FHeartbeatRate; - end - else - begin - ti := 0; - tr := Timeout; - end; - Result := InternalCanRead(tr); - if not Result then - for n := 0 to ti do - begin - DoHeartbeat; - if FStopFlag then - begin - Result := False; - FStopFlag := False; - Break; - end; - Result := InternalCanRead(FHeartbeatRate); - if Result then - break; - end; - ExceptCheck; - if Result then - DoStatus(HR_CanRead, ''); -end; - -function TBlockSocket.CanWrite(Timeout: Integer): Boolean; -{$IFDEF CIL} -begin - Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite); -{$ELSE} -var - TimeVal: PTimeVal; - TimeV: TTimeVal; - x: Integer; - FDSet: TFDSet; -begin - TimeV.tv_usec := (Timeout mod 1000) * 1000; - TimeV.tv_sec := Timeout div 1000; - TimeVal := @TimeV; - if Timeout = -1 then - TimeVal := nil; - FDSet := FFdSet; - x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal); - SockCheck(x); - if FLastError <> 0 then - x := 0; - Result := x > 0; -{$ENDIF} - ExceptCheck; - if Result then - DoStatus(HR_CanWrite, ''); -end; - -function TBlockSocket.CanReadEx(Timeout: Integer): Boolean; -begin - if FBuffer <> '' then - Result := True - else - Result := CanRead(Timeout); -end; - -function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer; -begin - Result := 0; - if TestStopFlag then - Exit; - DoMonitor(True, Buffer, Length); - LimitBandwidth(Length, FMaxSendBandwidth, FNextsend); - Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin); - SockCheck(Result); - ExceptCheck; - Inc(FSendCounter, Result); - DoStatus(HR_WriteCount, IntToStr(Result)); -end; - -function TBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; -begin - Result := 0; - if TestStopFlag then - Exit; - LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); - Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin); - SockCheck(Result); - ExceptCheck; - Inc(FRecvCounter, Result); - DoStatus(HR_ReadCount, IntToStr(Result)); - DoMonitor(False, Buffer, Result); -end; - -function TBlockSocket.GetSizeRecvBuffer: Integer; -var - l: Integer; -{$IFDEF CIL} - buf: TMemory; -{$ENDIF} -begin -{$IFDEF CIL} - setlength(buf, 4); - SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), buf, l)); - Result := System.BitConverter.ToInt32(buf,0); -{$ELSE} - l := SizeOf(Result); - SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, l)); - if FLastError <> 0 then - Result := 1024; - ExceptCheck; -{$ENDIF} -end; - -procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_RecvBuff; - d.Value := Size; - DelayedOption(d); -end; - -function TBlockSocket.GetSizeSendBuffer: Integer; -var - l: Integer; -{$IFDEF CIL} - buf: TMemory; -{$ENDIF} -begin -{$IFDEF CIL} - setlength(buf, 4); - SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), buf, l)); - Result := System.BitConverter.ToInt32(buf,0); -{$ELSE} - l := SizeOf(Result); - SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, l)); - if FLastError <> 0 then - Result := 1024; - ExceptCheck; -{$ENDIF} -end; - -procedure TBlockSocket.SetSizeSendBuffer(Size: Integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_SendBuff; - d.Value := Size; - DelayedOption(d); -end; - -procedure TBlockSocket.SetNonBlockMode(Value: Boolean); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_nonblock; - d.Enabled := Value; - DelayedOption(d); -end; - -procedure TBlockSocket.SetTimeout(Timeout: Integer); -begin - SetSendTimeout(Timeout); - SetRecvTimeout(Timeout); -end; - -procedure TBlockSocket.SetSendTimeout(Timeout: Integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_sendtimeout; - d.Value := Timeout; - DelayedOption(d); -end; - -procedure TBlockSocket.SetRecvTimeout(Timeout: Integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_recvtimeout; - d.Value := Timeout; - DelayedOption(d); -end; - -{$IFNDEF CIL} -function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer; - const CanReadList: TList): boolean; -var - FDSet: TFDSet; - TimeVal: PTimeVal; - TimeV: TTimeVal; - x, n: Integer; - Max: Integer; -begin - TimeV.tv_usec := (Timeout mod 1000) * 1000; - TimeV.tv_sec := Timeout div 1000; - TimeVal := @TimeV; - if Timeout = -1 then - TimeVal := nil; - FD_ZERO(FDSet); - Max := 0; - for n := 0 to SocketList.Count - 1 do - if TObject(SocketList.Items[n]) is TBlockSocket then - begin - if TBlockSocket(SocketList.Items[n]).Socket > Max then - Max := TBlockSocket(SocketList.Items[n]).Socket; - FD_SET(TBlockSocket(SocketList.Items[n]).Socket, FDSet); - end; - x := synsock.Select(Max + 1, @FDSet, nil, nil, TimeVal); - SockCheck(x); - ExceptCheck; - if FLastError <> 0 then - x := 0; - Result := x > 0; - CanReadList.Clear; - if Result then - for n := 0 to SocketList.Count - 1 do - if TObject(SocketList.Items[n]) is TBlockSocket then - if FD_ISSET(TBlockSocket(SocketList.Items[n]).Socket, FDSet) then - CanReadList.Add(TBlockSocket(SocketList.Items[n])); -end; -{$ENDIF} - -procedure TBlockSocket.EnableReuse(Value: Boolean); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_reuse; - d.Enabled := Value; - DelayedOption(d); -end; - -procedure TBlockSocket.SetTTL(TTL: integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_TTL; - d.Value := TTL; - DelayedOption(d); -end; - -function TBlockSocket.GetTTL:integer; -var - l: Integer; -begin -{$IFNDEF CIL} - l := SizeOf(Result); - if FIP6Used then - synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l) - else - synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l); -{$ENDIF} -end; - -procedure TBlockSocket.SetFamily(Value: TSocketFamily); -begin - FFamily := Value; - FFamilySave := Value; -end; - -procedure TBlockSocket.SetSocket(Value: TSocket); -begin - FRecvCounter := 0; - FSendCounter := 0; - FSocket := Value; -{$IFNDEF CIL} - FD_ZERO(FFDSet); - FD_SET(FSocket, FFDSet); -{$ENDIF} - GetSins; - FIP6Used := FRemoteSin.AddressFamily = AF_INET6; -end; - -function TBlockSocket.GetWsaData: TWSAData; -begin - {$IFDEF ONCEWINSOCK} - Result := WsaDataOnce; - {$ELSE} - Result := FWsaDataOnce; - {$ENDIF} -end; - -function TBlockSocket.GetSocketType: integer; -begin - Result := 0; -end; - -function TBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_IP); -end; - -procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string); -begin - if assigned(OnStatus) then - OnStatus(Self, Reason, Value); -end; - -procedure TBlockSocket.DoReadFilter(Buffer: TMemory; var Len: Integer); -var - s: AnsiString; -begin - if assigned(OnReadFilter) then - if Len > 0 then - begin - {$IFDEF CIL} - s := StringOf(Buffer); - {$ELSE} - SetLength(s, Len); - Move(Buffer^, Pointer(s)^, Len); - {$ENDIF} - OnReadFilter(Self, s); - if Length(s) > Len then - SetLength(s, Len); - Len := Length(s); - {$IFDEF CIL} - Buffer := BytesOf(s); - {$ELSE} - Move(Pointer(s)^, Buffer^, Len); - {$ENDIF} - end; -end; - -procedure TBlockSocket.DoCreateSocket; -begin - if assigned(OnCreateSocket) then - OnCreateSocket(Self); -end; - -procedure TBlockSocket.DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer); -begin - if assigned(OnMonitor) then - begin - OnMonitor(Self, Writing, Buffer, Len); - end; -end; - -procedure TBlockSocket.DoHeartbeat; -begin - if assigned(OnHeartbeat) and (FHeartbeatRate <> 0) then - begin - OnHeartbeat(Self); - end; -end; - -function TBlockSocket.GetErrorDescEx: string; -begin - Result := GetErrorDesc(FLastError); -end; - -class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string; -begin -{$IFDEF CIL} - if ErrorCode = 0 then - Result := '' - else - begin - Result := WSAGetLastErrorDesc; - if Result = '' then - Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')'; - end; -{$ELSE} - case ErrorCode of - 0: - Result := ''; - WSAEINTR: {10004} - Result := 'Interrupted system call'; - WSAEBADF: {10009} - Result := 'Bad file number'; - WSAEACCES: {10013} - Result := 'Permission denied'; - WSAEFAULT: {10014} - Result := 'Bad address'; - WSAEINVAL: {10022} - Result := 'Invalid argument'; - WSAEMFILE: {10024} - Result := 'Too many open files'; - WSAEWOULDBLOCK: {10035} - Result := 'Operation would block'; - WSAEINPROGRESS: {10036} - Result := 'Operation now in progress'; - WSAEALREADY: {10037} - Result := 'Operation already in progress'; - WSAENOTSOCK: {10038} - Result := 'Socket operation on nonsocket'; - WSAEDESTADDRREQ: {10039} - Result := 'Destination address required'; - WSAEMSGSIZE: {10040} - Result := 'Message too long'; - WSAEPROTOTYPE: {10041} - Result := 'Protocol wrong type for Socket'; - WSAENOPROTOOPT: {10042} - Result := 'Protocol not available'; - WSAEPROTONOSUPPORT: {10043} - Result := 'Protocol not supported'; - WSAESOCKTNOSUPPORT: {10044} - Result := 'Socket not supported'; - WSAEOPNOTSUPP: {10045} - Result := 'Operation not supported on Socket'; - WSAEPFNOSUPPORT: {10046} - Result := 'Protocol family not supported'; - WSAEAFNOSUPPORT: {10047} - Result := 'Address family not supported'; - WSAEADDRINUSE: {10048} - Result := 'Address already in use'; - WSAEADDRNOTAVAIL: {10049} - Result := 'Can''t assign requested address'; - WSAENETDOWN: {10050} - Result := 'Network is down'; - WSAENETUNREACH: {10051} - Result := 'Network is unreachable'; - WSAENETRESET: {10052} - Result := 'Network dropped connection on reset'; - WSAECONNABORTED: {10053} - Result := 'Software caused connection abort'; - WSAECONNRESET: {10054} - Result := 'Connection reset by peer'; - WSAENOBUFS: {10055} - Result := 'No Buffer space available'; - WSAEISCONN: {10056} - Result := 'Socket is already connected'; - WSAENOTCONN: {10057} - Result := 'Socket is not connected'; - WSAESHUTDOWN: {10058} - Result := 'Can''t send after Socket shutdown'; - WSAETOOMANYREFS: {10059} - Result := 'Too many references:can''t splice'; - WSAETIMEDOUT: {10060} - Result := 'Connection timed out'; - WSAECONNREFUSED: {10061} - Result := 'Connection refused'; - WSAELOOP: {10062} - Result := 'Too many levels of symbolic links'; - WSAENAMETOOLONG: {10063} - Result := 'File name is too long'; - WSAEHOSTDOWN: {10064} - Result := 'Host is down'; - WSAEHOSTUNREACH: {10065} - Result := 'No route to host'; - WSAENOTEMPTY: {10066} - Result := 'Directory is not empty'; - WSAEPROCLIM: {10067} - Result := 'Too many processes'; - WSAEUSERS: {10068} - Result := 'Too many users'; - WSAEDQUOT: {10069} - Result := 'Disk quota exceeded'; - WSAESTALE: {10070} - Result := 'Stale NFS file handle'; - WSAEREMOTE: {10071} - Result := 'Too many levels of remote in path'; - WSASYSNOTREADY: {10091} - Result := 'Network subsystem is unusable'; - WSAVERNOTSUPPORTED: {10092} - Result := 'Winsock DLL cannot support this application'; - WSANOTINITIALISED: {10093} - Result := 'Winsock not initialized'; - WSAEDISCON: {10101} - Result := 'Disconnect'; - WSAHOST_NOT_FOUND: {11001} - Result := 'Host not found'; - WSATRY_AGAIN: {11002} - Result := 'Non authoritative - host not found'; - WSANO_RECOVERY: {11003} - Result := 'Non recoverable error'; - WSANO_DATA: {11004} - Result := 'Valid name, no data record of requested type' - else - Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')'; - end; -{$ENDIF} -end; - -{======================================================================} - -constructor TSocksBlockSocket.Create; -begin - inherited Create; - FSocksIP:= ''; - FSocksPort:= '1080'; - FSocksTimeout:= 60000; - FSocksUsername:= ''; - FSocksPassword:= ''; - FUsingSocks := False; - FSocksResolver := True; - FSocksLastError := 0; - FSocksResponseIP := ''; - FSocksResponsePort := ''; - FSocksLocalIP := ''; - FSocksLocalPort := ''; - FSocksRemoteIP := ''; - FSocksRemotePort := ''; - FBypassFlag := False; - FSocksType := ST_Socks5; -end; - -function TSocksBlockSocket.SocksOpen: boolean; -var - Buf: AnsiString; - n: integer; -begin - Result := False; - FUsingSocks := False; - if FSocksType <> ST_Socks5 then - begin - FUsingSocks := True; - Result := True; - end - else - begin - FBypassFlag := True; - try - if FSocksUsername = '' then - Buf := #5 + #1 + #0 - else - Buf := #5 + #2 + #2 +#0; - SendString(Buf); - Buf := RecvBufferStr(2, FSocksTimeout); - if Length(Buf) < 2 then - Exit; - if Buf[1] <> #5 then - Exit; - n := Ord(Buf[2]); - case n of - 0: //not need authorisation - ; - 2: - begin - Buf := #1 + AnsiChar(Length(FSocksUsername)) + FSocksUsername - + AnsiChar(Length(FSocksPassword)) + FSocksPassword; - SendString(Buf); - Buf := RecvBufferStr(2, FSocksTimeout); - if Length(Buf) < 2 then - Exit; - if Buf[2] <> #0 then - Exit; - end; - else - //other authorisation is not supported! - Exit; - end; - FUsingSocks := True; - Result := True; - finally - FBypassFlag := False; - end; - end; -end; - -function TSocksBlockSocket.SocksRequest(Cmd: Byte; - const IP, Port: string): Boolean; -var - Buf: AnsiString; -begin - FBypassFlag := True; - try - if FSocksType <> ST_Socks5 then - Buf := #4 + AnsiChar(Cmd) + SocksCode(IP, Port) - else - Buf := #5 + AnsiChar(Cmd) + #0 + SocksCode(IP, Port); - SendString(Buf); - Result := FLastError = 0; - finally - FBypassFlag := False; - end; -end; - -function TSocksBlockSocket.SocksResponse: Boolean; -var - Buf, s: AnsiString; - x: integer; -begin - Result := False; - FBypassFlag := True; - try - FSocksResponseIP := ''; - FSocksResponsePort := ''; - FSocksLastError := -1; - if FSocksType <> ST_Socks5 then - begin - Buf := RecvBufferStr(8, FSocksTimeout); - if FLastError <> 0 then - Exit; - if Buf[1] <> #0 then - Exit; - FSocksLastError := Ord(Buf[2]); - end - else - begin - Buf := RecvBufferStr(4, FSocksTimeout); - if FLastError <> 0 then - Exit; - if Buf[1] <> #5 then - Exit; - case Ord(Buf[4]) of - 1: - s := RecvBufferStr(4, FSocksTimeout); - 3: - begin - x := RecvByte(FSocksTimeout); - if FLastError <> 0 then - Exit; - s := AnsiChar(x) + RecvBufferStr(x, FSocksTimeout); - end; - 4: - s := RecvBufferStr(16, FSocksTimeout); - else - Exit; - end; - Buf := Buf + s + RecvBufferStr(2, FSocksTimeout); - if FLastError <> 0 then - Exit; - FSocksLastError := Ord(Buf[2]); - end; - if ((FSocksLastError <> 0) and (FSocksLastError <> 90)) then - Exit; - SocksDecode(Buf); - Result := True; - finally - FBypassFlag := False; - end; -end; - -function TSocksBlockSocket.SocksCode(IP, Port: string): Ansistring; -var - ip6: TIp6Bytes; - n: integer; -begin - if FSocksType <> ST_Socks5 then - begin - Result := CodeInt(ResolvePort(Port)); - if not FSocksResolver then - IP := ResolveName(IP); - if IsIP(IP) then - begin - Result := Result + IPToID(IP); - Result := Result + FSocksUsername + #0; - end - else - begin - Result := Result + IPToID('0.0.0.1'); - Result := Result + FSocksUsername + #0; - Result := Result + IP + #0; - end; - end - else - begin - if not FSocksResolver then - IP := ResolveName(IP); - if IsIP(IP) then - Result := #1 + IPToID(IP) - else - if IsIP6(IP) then - begin - ip6 := StrToIP6(IP); - Result := #4; - for n := 0 to 15 do - Result := Result + AnsiChar(ip6[n]); - end - else - Result := #3 + AnsiChar(Length(IP)) + IP; - Result := Result + CodeInt(ResolvePort(Port)); - end; -end; - -function TSocksBlockSocket.SocksDecode(Value: Ansistring): integer; -var - Atyp: Byte; - y, n: integer; - w: Word; - ip6: TIp6Bytes; -begin - FSocksResponsePort := '0'; - Result := 0; - if FSocksType <> ST_Socks5 then - begin - if Length(Value) < 8 then - Exit; - Result := 3; - w := DecodeInt(Value, Result); - FSocksResponsePort := IntToStr(w); - FSocksResponseIP := Format('%d.%d.%d.%d', - [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]); - Result := 9; - end - else - begin - if Length(Value) < 4 then - Exit; - Atyp := Ord(Value[4]); - Result := 5; - case Atyp of - 1: - begin - if Length(Value) < 10 then - Exit; - FSocksResponseIP := Format('%d.%d.%d.%d', - [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]); - Result := 9; - end; - 3: - begin - y := Ord(Value[5]); - if Length(Value) < (5 + y + 2) then - Exit; - for n := 6 to 6 + y - 1 do - FSocksResponseIP := FSocksResponseIP + Value[n]; - Result := 5 + y + 1; - end; - 4: - begin - if Length(Value) < 22 then - Exit; - for n := 0 to 15 do - ip6[n] := ord(Value[n + 5]); - FSocksResponseIP := IP6ToStr(ip6); - Result := 21; - end; - else - Exit; - end; - w := DecodeInt(Value, Result); - FSocksResponsePort := IntToStr(w); - Result := Result + 2; - end; -end; - -{======================================================================} - -procedure TDgramBlockSocket.Connect(IP, Port: string); -begin - SetRemoteSin(IP, Port); - InternalCreateSocket(FRemoteSin); - FBuffer := ''; - DoStatus(HR_Connect, IP + ':' + Port); -end; - -function TDgramBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer; -begin - Result := RecvBufferFrom(Buffer, Length); -end; - -function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; -begin - Result := SendBufferTo(Buffer, Length); -end; - -{======================================================================} - -destructor TUDPBlockSocket.Destroy; -begin - if Assigned(FSocksControlSock) then - FSocksControlSock.Free; - inherited; -end; - -procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_Broadcast; - d.Enabled := Value; - DelayedOption(d); -end; - -function TUDPBlockSocket.UdpAssociation: Boolean; -var - b: Boolean; -begin - Result := True; - FUsingSocks := False; - if FSocksIP <> '' then - begin - Result := False; - if not Assigned(FSocksControlSock) then - FSocksControlSock := TTCPBlockSocket.Create; - FSocksControlSock.CloseSocket; - FSocksControlSock.CreateSocketByName(FSocksIP); - FSocksControlSock.Connect(FSocksIP, FSocksPort); - if FSocksControlSock.LastError <> 0 then - Exit; - // if not assigned local port, assign it! - if not FBinded then - Bind(cAnyHost, cAnyPort); - //open control TCP connection to SOCKS - FSocksControlSock.FSocksUsername := FSocksUsername; - FSocksControlSock.FSocksPassword := FSocksPassword; - b := FSocksControlSock.SocksOpen; - if b then - b := FSocksControlSock.SocksRequest(3, GetLocalSinIP, IntToStr(GetLocalSinPort)); - if b then - b := FSocksControlSock.SocksResponse; - if not b and (FLastError = 0) then - FLastError := WSANO_RECOVERY; - FUsingSocks :=FSocksControlSock.UsingSocks; - FSocksRemoteIP := FSocksControlSock.FSocksResponseIP; - FSocksRemotePort := FSocksControlSock.FSocksResponsePort; - Result := b and (FLastError = 0); - end; -end; - -function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer; -var - SIp: string; - SPort: integer; - Buf: Ansistring; -begin - Result := 0; - FUsingSocks := False; - if (FSocksIP <> '') and (not UdpAssociation) then - FLastError := WSANO_RECOVERY - else - begin - if FUsingSocks then - begin -{$IFNDEF CIL} - Sip := GetRemoteSinIp; - SPort := GetRemoteSinPort; - SetRemoteSin(FSocksRemoteIP, FSocksRemotePort); - SetLength(Buf,Length); - Move(Buffer^, Pointer(Buf)^, Length); - Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf; - Result := inherited SendBufferTo(Pointer(Buf), System.Length(buf)); - SetRemoteSin(Sip, IntToStr(SPort)); -{$ENDIF} - end - else - Result := inherited SendBufferTo(Buffer, Length); - end; -end; - -function TUDPBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; -var - Buf: Ansistring; - x: integer; -begin - Result := inherited RecvBufferFrom(Buffer, Length); - if FUsingSocks then - begin -{$IFNDEF CIL} - SetLength(Buf, Result); - Move(Buffer^, Pointer(Buf)^, Result); - x := SocksDecode(Buf); - Result := Result - x + 1; - Buf := Copy(Buf, x, Result); - Move(Pointer(Buf)^, Buffer^, Result); - SetRemoteSin(FSocksResponseIP, FSocksResponsePort); -{$ENDIF} - end; -end; - -{$IFNDEF CIL} -procedure TUDPBlockSocket.AddMulticast(MCastIP: string); -var - Multicast: TIP_mreq; - Multicast6: TIPv6_mreq; - n: integer; - ip6: Tip6bytes; -begin - if FIP6Used then - begin - ip6 := StrToIp6(MCastIP); - for n := 0 to 15 do - Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n]; - Multicast6.ipv6mr_interface := 0; - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP, - PAnsiChar(@Multicast6), SizeOf(Multicast6))); - end - else - begin - Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP)); -// Multicast.imr_interface.S_addr := INADDR_ANY; - Multicast.imr_interface.S_addr := FLocalSin.sin_addr.S_addr; - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP, - PAnsiChar(@Multicast), SizeOf(Multicast))); - end; - ExceptCheck; -end; - -procedure TUDPBlockSocket.DropMulticast(MCastIP: string); -var - Multicast: TIP_mreq; - Multicast6: TIPv6_mreq; - n: integer; - ip6: Tip6bytes; -begin - if FIP6Used then - begin - ip6 := StrToIp6(MCastIP); - for n := 0 to 15 do - Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n]; - Multicast6.ipv6mr_interface := 0; - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP, - PAnsiChar(@Multicast6), SizeOf(Multicast6))); - end - else - begin - Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP)); -// Multicast.imr_interface.S_addr := INADDR_ANY; - Multicast.imr_interface.S_addr := FLocalSin.sin_addr.S_addr; - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP, - PAnsiChar(@Multicast), SizeOf(Multicast))); - end; - ExceptCheck; -end; -{$ENDIF} - -procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_MulticastTTL; - d.Value := TTL; - DelayedOption(d); -end; - -function TUDPBlockSocket.GetMulticastTTL:integer; -var - l: Integer; -begin -{$IFNDEF CIL} - l := SizeOf(Result); - if FIP6Used then - synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l) - else - synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l); -{$ENDIF} -end; - -procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean); -var - d: TSynaOption; -begin - d := TSynaOption.Create; - d.Option := SOT_MulticastLoop; - d.Enabled := Value; - DelayedOption(d); -end; - -function TUDPBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_DGRAM); -end; - -function TUDPBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_UDP); -end; - -{======================================================================} -constructor TTCPBlockSocket.CreateWithSSL(SSLPlugin: TSSLClass); -begin - inherited Create; - FSSL := SSLPlugin.Create(self); - FHTTPTunnelIP := ''; - FHTTPTunnelPort := ''; - FHTTPTunnel := False; - FHTTPTunnelRemoteIP := ''; - FHTTPTunnelRemotePort := ''; - FHTTPTunnelUser := ''; - FHTTPTunnelPass := ''; - FHTTPTunnelTimeout := 30000; -end; - -constructor TTCPBlockSocket.Create; -begin - CreateWithSSL(SSLImplementation); -end; - -destructor TTCPBlockSocket.Destroy; -begin - inherited Destroy; - FSSL.Free; -end; - -function TTCPBlockSocket.GetErrorDescEx: string; -begin - Result := inherited GetErrorDescEx; - if (FLastError = WSASYSNOTREADY) and (self.SSL.LastError <> 0) then - begin - Result := self.SSL.LastErrorDesc; - end; -end; - -procedure TTCPBlockSocket.CloseSocket; -begin - if FSSL.SSLEnabled then - FSSL.Shutdown; - if (FSocket <> INVALID_SOCKET) and (FLastError = 0) then - begin - Synsock.Shutdown(FSocket, 1); - Purge; - end; - inherited CloseSocket; -end; - -procedure TTCPBlockSocket.DoAfterConnect; -begin - if assigned(OnAfterConnect) then - begin - OnAfterConnect(Self); - end; -end; - -function TTCPBlockSocket.WaitingData: Integer; -begin - Result := 0; - if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then - Result := FSSL.WaitingData; - if Result = 0 then - Result := inherited WaitingData; -end; - -procedure TTCPBlockSocket.Listen; -var - b: Boolean; - Sip,SPort: string; -begin - if FSocksIP = '' then - begin - inherited Listen; - end - else - begin - Sip := GetLocalSinIP; - if Sip = cAnyHost then - Sip := LocalName; - SPort := IntToStr(GetLocalSinPort); - inherited Connect(FSocksIP, FSocksPort); - b := SocksOpen; - if b then - b := SocksRequest(2, Sip, SPort); - if b then - b := SocksResponse; - if not b and (FLastError = 0) then - FLastError := WSANO_RECOVERY; - FSocksLocalIP := FSocksResponseIP; - if FSocksLocalIP = cAnyHost then - FSocksLocalIP := FSocksIP; - FSocksLocalPort := FSocksResponsePort; - FSocksRemoteIP := ''; - FSocksRemotePort := ''; - ExceptCheck; - DoStatus(HR_Listen, ''); - end; -end; - -function TTCPBlockSocket.Accept: TSocket; -begin - if FUsingSocks then - begin - if not SocksResponse and (FLastError = 0) then - FLastError := WSANO_RECOVERY; - FSocksRemoteIP := FSocksResponseIP; - FSocksRemotePort := FSocksResponsePort; - Result := FSocket; - ExceptCheck; - DoStatus(HR_Accept, ''); - end - else - begin - result := inherited Accept; - end; -end; - -procedure TTCPBlockSocket.Connect(IP, Port: string); -begin - if FSocksIP <> '' then - SocksDoConnect(IP, Port) - else - if FHTTPTunnelIP <> '' then - HTTPTunnelDoConnect(IP, Port) - else - inherited Connect(IP, Port); - if FLasterror = 0 then - DoAfterConnect; -end; - -procedure TTCPBlockSocket.SocksDoConnect(IP, Port: string); -var - b: Boolean; -begin - inherited Connect(FSocksIP, FSocksPort); - if FLastError = 0 then - begin - b := SocksOpen; - if b then - b := SocksRequest(1, IP, Port); - if b then - b := SocksResponse; - if not b and (FLastError = 0) then - FLastError := WSASYSNOTREADY; - FSocksLocalIP := FSocksResponseIP; - FSocksLocalPort := FSocksResponsePort; - FSocksRemoteIP := IP; - FSocksRemotePort := Port; - end; - ExceptCheck; - DoStatus(HR_Connect, IP + ':' + Port); -end; - -procedure TTCPBlockSocket.HTTPTunnelDoConnect(IP, Port: string); -//bugfixed by Mike Green (mgreen@emixode.com) -var - s: string; -begin - Port := IntToStr(ResolvePort(Port)); - inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort); - if FLastError <> 0 then - Exit; - FHTTPTunnel := False; - if IsIP6(IP) then - IP := '[' + IP + ']'; - SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF); - if FHTTPTunnelUser <> '' then - Sendstring('Proxy-Authorization: Basic ' + - EncodeBase64(FHTTPTunnelUser + ':' + FHTTPTunnelPass) + CRLF); - SendString(CRLF); - repeat - s := RecvTerminated(FHTTPTunnelTimeout, #$0a); - if FLastError <> 0 then - Break; - if (Pos('HTTP/', s) = 1) and (Length(s) > 11) then - FHTTPTunnel := s[10] = '2'; - until (s = '') or (s = #$0d); - if (FLasterror = 0) and not FHTTPTunnel then - FLastError := WSAECONNREFUSED; - FHTTPTunnelRemoteIP := IP; - FHTTPTunnelRemotePort := Port; - ExceptCheck; -end; - -procedure TTCPBlockSocket.SSLDoConnect; -begin - ResetLastError; - if not FSSL.Connect then - FLastError := WSASYSNOTREADY; - ExceptCheck; -end; - -procedure TTCPBlockSocket.SSLDoShutdown; -begin - ResetLastError; - FSSL.BiShutdown; -end; - -function TTCPBlockSocket.GetLocalSinIP: string; -begin - if FUsingSocks then - Result := FSocksLocalIP - else - Result := inherited GetLocalSinIP; -end; - -function TTCPBlockSocket.GetRemoteSinIP: string; -begin - if FUsingSocks then - Result := FSocksRemoteIP - else - if FHTTPTunnel then - Result := FHTTPTunnelRemoteIP - else - Result := inherited GetRemoteSinIP; -end; - -function TTCPBlockSocket.GetLocalSinPort: Integer; -begin - if FUsingSocks then - Result := StrToIntDef(FSocksLocalPort, 0) - else - Result := inherited GetLocalSinPort; -end; - -function TTCPBlockSocket.GetRemoteSinPort: Integer; -begin - if FUsingSocks then - Result := ResolvePort(FSocksRemotePort) - else - if FHTTPTunnel then - Result := StrToIntDef(FHTTPTunnelRemotePort, 0) - else - Result := inherited GetRemoteSinPort; -end; - -function TTCPBlockSocket.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - if FSSL.SSLEnabled then - begin - Result := 0; - if TestStopFlag then - Exit; - ResetLastError; - LimitBandwidth(Len, FMaxRecvBandwidth, FNextRecv); - Result := FSSL.RecvBuffer(Buffer, Len); - if FSSL.LastError <> 0 then - FLastError := WSASYSNOTREADY; - ExceptCheck; - Inc(FRecvCounter, Result); - DoStatus(HR_ReadCount, IntToStr(Result)); - DoMonitor(False, Buffer, Result); - DoReadFilter(Buffer, Result); - end - else - Result := inherited RecvBuffer(Buffer, Len); -end; - -function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer; -var - x, y: integer; - l, r: integer; -{$IFNDEF CIL} - p: Pointer; -{$ENDIF} -begin - if FSSL.SSLEnabled then - begin - Result := 0; - if TestStopFlag then - Exit; - ResetLastError; - DoMonitor(True, Buffer, Length); -{$IFDEF CIL} - Result := FSSL.SendBuffer(Buffer, Length); - if FSSL.LastError <> 0 then - FLastError := WSASYSNOTREADY; - Inc(FSendCounter, Result); - DoStatus(HR_WriteCount, IntToStr(Result)); -{$ELSE} - l := Length; - x := 0; - while x < l do - begin - y := l - x; - if y > FSendMaxChunk then - y := FSendMaxChunk; - if y > 0 then - begin - LimitBandwidth(y, FMaxSendBandwidth, FNextsend); - p := IncPoint(Buffer, x); - r := FSSL.SendBuffer(p, y); - if FSSL.LastError <> 0 then - FLastError := WSASYSNOTREADY; - if Flasterror <> 0 then - Break; - Inc(x, r); - Inc(Result, r); - Inc(FSendCounter, r); - DoStatus(HR_WriteCount, IntToStr(r)); - end - else - break; - end; -{$ENDIF} - ExceptCheck; - end - else - Result := inherited SendBuffer(Buffer, Length); -end; - -function TTCPBlockSocket.SSLAcceptConnection: Boolean; -begin - ResetLastError; - if not FSSL.Accept then - FLastError := WSASYSNOTREADY; - ExceptCheck; - Result := FLastError = 0; -end; - -function TTCPBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_STREAM); -end; - -function TTCPBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_TCP); -end; - -{======================================================================} - -function TICMPBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_RAW); -end; - -function TICMPBlockSocket.GetSocketProtocol: integer; -begin - if FIP6Used then - Result := integer(IPPROTO_ICMPV6) - else - Result := integer(IPPROTO_ICMP); -end; - -{======================================================================} - -function TRAWBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_RAW); -end; - -function TRAWBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_RAW); -end; - -{======================================================================} - -function TPGMmessageBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_RDM); -end; - -function TPGMmessageBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_RM); -end; - -{======================================================================} - -function TPGMstreamBlockSocket.GetSocketType: integer; -begin - Result := integer(SOCK_STREAM); -end; - -function TPGMstreamBlockSocket.GetSocketProtocol: integer; -begin - Result := integer(IPPROTO_RM); -end; - -{======================================================================} - -constructor TSynaClient.Create; -begin - inherited Create; - FIPInterface := cAnyHost; - FTargetHost := cLocalhost; - FTargetPort := cAnyPort; - FTimeout := 5000; - FUsername := ''; - FPassword := ''; -end; - -{======================================================================} - -constructor TCustomSSL.Create(const Value: TTCPBlockSocket); -begin - inherited Create; - FSocket := Value; - FSSLEnabled := False; - FUsername := ''; - FPassword := ''; - FLastError := 0; - FLastErrorDesc := ''; - FVerifyCert := False; - FSSLType := LT_all; - FKeyPassword := ''; - FCiphers := ''; - FCertificateFile := ''; - FPrivateKeyFile := ''; - FCertCAFile := ''; - FCertCA := ''; - FTrustCertificate := ''; - FTrustCertificateFile := ''; - FCertificate := ''; - FPrivateKey := ''; - FPFX := ''; - FPFXfile := ''; - FSSHChannelType := ''; - FSSHChannelArg1 := ''; - FSSHChannelArg2 := ''; - FCertComplianceLevel := -1; //default - FSNIHost := ''; -end; - -procedure TCustomSSL.Assign(const Value: TCustomSSL); -begin - FUsername := Value.Username; - FPassword := Value.Password; - FVerifyCert := Value.VerifyCert; - FSSLType := Value.SSLType; - FKeyPassword := Value.KeyPassword; - FCiphers := Value.Ciphers; - FCertificateFile := Value.CertificateFile; - FPrivateKeyFile := Value.PrivateKeyFile; - FCertCAFile := Value.CertCAFile; - FCertCA := Value.CertCA; - FTrustCertificate := Value.TrustCertificate; - FTrustCertificateFile := Value.TrustCertificateFile; - FCertificate := Value.Certificate; - FPrivateKey := Value.PrivateKey; - FPFX := Value.PFX; - FPFXfile := Value.PFXfile; - FCertComplianceLevel := Value.CertComplianceLevel; - FSNIHost := Value.FSNIHost; -end; - -procedure TCustomSSL.ReturnError; -begin - FLastError := -1; - FLastErrorDesc := 'SSL/TLS support is not compiled!'; -end; - -function TCustomSSL.LibVersion: String; -begin - Result := ''; -end; - -function TCustomSSL.LibName: String; -begin - Result := ''; -end; - -function TCustomSSL.CreateSelfSignedCert(Host: string): Boolean; -begin - Result := False; -end; - -function TCustomSSL.Connect: boolean; -begin - ReturnError; - Result := False; -end; - -function TCustomSSL.Accept: boolean; -begin - ReturnError; - Result := False; -end; - -function TCustomSSL.Shutdown: boolean; -begin - ReturnError; - Result := False; -end; - -function TCustomSSL.BiShutdown: boolean; -begin - ReturnError; - Result := False; -end; - -function TCustomSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - ReturnError; - Result := integer(SOCKET_ERROR); -end; - -procedure TCustomSSL.SetCertCAFile(const Value: string); -begin - FCertCAFile := Value; -end; - -function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - ReturnError; - Result := integer(SOCKET_ERROR); -end; - -function TCustomSSL.WaitingData: Integer; -begin - ReturnError; - Result := 0; -end; - -function TCustomSSL.GetSSLVersion: string; -begin - Result := ''; -end; - -function TCustomSSL.GetPeerSubject: string; -begin - Result := ''; -end; - -function TCustomSSL.GetPeerSerialNo: integer; -begin - Result := -1; -end; - -function TCustomSSL.GetPeerName: string; -begin - Result := ''; -end; - -function TCustomSSL.GetPeerNameHash: cardinal; -begin - Result := 0; -end; - -function TCustomSSL.GetPeerIssuer: string; -begin - Result := ''; -end; - -function TCustomSSL.GetPeerFingerprint: string; -begin - Result := ''; -end; - -function TCustomSSL.GetCertInfo: string; -begin - Result := ''; -end; - -function TCustomSSL.GetCipherName: string; -begin - Result := ''; -end; - -function TCustomSSL.GetCipherBits: integer; -begin - Result := 0; -end; - -function TCustomSSL.GetCipherAlgBits: integer; -begin - Result := 0; -end; - -function TCustomSSL.GetVerifyCert: integer; -begin - Result := 1; -end; - -function TCustomSSL.DoVerifyCert:boolean; -begin - if assigned(OnVerifyCert) then - begin - result:=OnVerifyCert(Self); - end - else - result:=true; -end; - - -{======================================================================} - -function TSSLNone.LibVersion: String; -begin - Result := 'Without SSL support'; -end; - -function TSSLNone.LibName: String; -begin - Result := 'ssl_none'; -end; - -{======================================================================} - -initialization -begin -{$IFDEF ONCEWINSOCK} - if not InitSocketInterface(DLLStackName) then - begin - e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!'); - e.ErrorCode := 0; - e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!'; - raise e; - end; - synsock.WSAStartup(WinsockLevel, WsaDataOnce); -{$ENDIF} -end; - -finalization -begin -{$IFDEF ONCEWINSOCK} - synsock.WSACleanup; - DestroySocketInterface; -{$ENDIF} -end; - -end. diff --git a/3rd/synapse/source/clamsend.pas b/3rd/synapse/source/clamsend.pas deleted file mode 100644 index 8d3c2d649..000000000 --- a/3rd/synapse/source/clamsend.pas +++ /dev/null @@ -1,277 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.001 | -|==============================================================================| -| Content: ClamAV-daemon client | -|==============================================================================| -| Copyright (c)2005-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2005-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract( ClamAV-daemon client) - -This unit is capable to do antivirus scan of your data by TCP channel to ClamD -daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net) -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit clamsend; - -interface - -uses - SysUtils, Classes, - synsock, blcksock, synautil; - -const - cClamProtocol = '3310'; - -type - - {:@abstract(Implementation of ClamAV-daemon client protocol) - By this class you can scan any your data by ClamAV opensource antivirus. - - This class can connect to ClamD by TCP channel, send your data to ClamD - and read result.} - TClamSend = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FDSock: TTCPBlockSocket; - FSession: boolean; - function Login: boolean; virtual; - function Logout: Boolean; virtual; - function OpenStream: Boolean; virtual; - public - constructor Create; - destructor Destroy; override; - - {:Call any command to ClamD. Used internally by other methods.} - function DoCommand(const Value: AnsiString): AnsiString; virtual; - - {:Return ClamAV version and version of loaded databases.} - function GetVersion: AnsiString; virtual; - - {:Scan content of TStrings.} - function ScanStrings(const Value: TStrings): AnsiString; virtual; - - {:Scan content of TStream.} - function ScanStream(const Value: TStream): AnsiString; virtual; - - {:Scan content of TStrings by new 0.95 API.} - function ScanStrings2(const Value: TStrings): AnsiString; virtual; - - {:Scan content of TStream by new 0.95 API.} - function ScanStream2(const Value: TStream): AnsiString; virtual; - published - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - - {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.} - property DSock: TTCPBlockSocket read FDSock; - - {:Can turn-on session mode of communication with ClamD. Default is @false, - because ClamAV developers design their TCP code very badly and session mode - is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs - and this mode will be possible in future.} - property Session: boolean read FSession write FSession; - end; - -implementation - -constructor TClamSend.Create; -begin - inherited Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FDSock := TTCPBlockSocket.Create; - FDSock.Owner := self; - FTimeout := 60000; - FTargetPort := cClamProtocol; - FSession := false; -end; - -destructor TClamSend.Destroy; -begin - Logout; - FDSock.Free; - FSock.Free; - inherited Destroy; -end; - -function TClamSend.DoCommand(const Value: AnsiString): AnsiString; -begin - Result := ''; - if not FSession then - FSock.CloseSocket - else - FSock.SendString(Value + LF); - if not FSession or (FSock.LastError <> 0) then - begin - if Login then - FSock.SendString(Value + LF) - else - Exit; - end; - Result := FSock.RecvTerminated(FTimeout, LF); -end; - -function TClamSend.Login: boolean; -begin - Result := False; - Sock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError <> 0 then - Exit; - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError <> 0 then - Exit; - if FSession then - FSock.SendString('SESSION' + LF); - Result := FSock.LastError = 0; -end; - -function TClamSend.Logout: Boolean; -begin - FSock.SendString('END' + LF); - Result := FSock.LastError = 0; - FSock.CloseSocket; -end; - -function TClamSend.GetVersion: AnsiString; -begin - Result := DoCommand('nVERSION'); -end; - -function TClamSend.OpenStream: Boolean; -var - S: AnsiString; -begin - Result := False; - s := DoCommand('nSTREAM'); - if (s <> '') and (Copy(s, 1, 4) = 'PORT') then - begin - s := SeparateRight(s, ' '); - FDSock.CloseSocket; - FDSock.Bind(FIPInterface, cAnyPort); - if FDSock.LastError <> 0 then - Exit; - FDSock.Connect(FTargetHost, s); - if FDSock.LastError <> 0 then - Exit; - Result := True; - end; -end; - -function TClamSend.ScanStrings(const Value: TStrings): AnsiString; -begin - Result := ''; - if OpenStream then - begin - DSock.SendString(Value.Text); - DSock.CloseSocket; - Result := FSock.RecvTerminated(FTimeout, LF); - end; -end; - -function TClamSend.ScanStream(const Value: TStream): AnsiString; -begin - Result := ''; - if OpenStream then - begin - DSock.SendStreamRaw(Value); - DSock.CloseSocket; - Result := FSock.RecvTerminated(FTimeout, LF); - end; -end; - -function TClamSend.ScanStrings2(const Value: TStrings): AnsiString; -var - i: integer; - s: AnsiString; -begin - Result := ''; - if not FSession then - FSock.CloseSocket - else - FSock.sendstring('nINSTREAM' + LF); - if not FSession or (FSock.LastError <> 0) then - begin - if Login then - FSock.sendstring('nINSTREAM' + LF) - else - Exit; - end; - s := Value.text; - i := length(s); - FSock.SendString(CodeLongint(i) + s + #0#0#0#0); - Result := FSock.RecvTerminated(FTimeout, LF); -end; - -function TClamSend.ScanStream2(const Value: TStream): AnsiString; -var - i: integer; -begin - Result := ''; - if not FSession then - FSock.CloseSocket - else - FSock.sendstring('nINSTREAM' + LF); - if not FSession or (FSock.LastError <> 0) then - begin - if Login then - FSock.sendstring('nINSTREAM' + LF) - else - Exit; - end; - i := value.Size; - FSock.SendString(CodeLongint(i)); - FSock.SendStreamRaw(Value); - FSock.SendString(#0#0#0#0); - Result := FSock.RecvTerminated(FTimeout, LF); -end; - -end. diff --git a/3rd/synapse/source/dnssend.pas b/3rd/synapse/source/dnssend.pas deleted file mode 100644 index 84c14cc76..000000000 --- a/3rd/synapse/source/dnssend.pas +++ /dev/null @@ -1,603 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.007.006 | -|==============================================================================| -| Content: DNS client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} -{: @abstract(DNS client by UDP or TCP) -Support for sending DNS queries by UDP or TCP protocol. It can retrieve zone - transfers too! - -Used RFC: RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit dnssend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, synaip, synsock; - -const - cDnsProtocol = '53'; - - QTYPE_A = 1; - QTYPE_NS = 2; - QTYPE_MD = 3; - QTYPE_MF = 4; - QTYPE_CNAME = 5; - QTYPE_SOA = 6; - QTYPE_MB = 7; - QTYPE_MG = 8; - QTYPE_MR = 9; - QTYPE_NULL = 10; - QTYPE_WKS = 11; // - QTYPE_PTR = 12; - QTYPE_HINFO = 13; - QTYPE_MINFO = 14; - QTYPE_MX = 15; - QTYPE_TXT = 16; - - QTYPE_RP = 17; - QTYPE_AFSDB = 18; - QTYPE_X25 = 19; - QTYPE_ISDN = 20; - QTYPE_RT = 21; - QTYPE_NSAP = 22; - QTYPE_NSAPPTR = 23; - QTYPE_SIG = 24; // RFC-2065 - QTYPE_KEY = 25; // RFC-2065 - QTYPE_PX = 26; - QTYPE_GPOS = 27; - QTYPE_AAAA = 28; - QTYPE_LOC = 29; // RFC-1876 - QTYPE_NXT = 30; // RFC-2065 - - QTYPE_SRV = 33; - QTYPE_NAPTR = 35; // RFC-2168 - QTYPE_KX = 36; - QTYPE_SPF = 99; - - QTYPE_AXFR = 252; - QTYPE_MAILB = 253; // - QTYPE_MAILA = 254; // - QTYPE_ALL = 255; - -type - {:@abstract(Implementation of DNS protocol by UDP or TCP protocol.) - - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TDNSSend = class(TSynaClient) - private - FID: Word; - FRCode: Integer; - FBuffer: AnsiString; - FSock: TUDPBlockSocket; - FTCPSock: TTCPBlockSocket; - FUseTCP: Boolean; - FAnswerInfo: TStringList; - FNameserverInfo: TStringList; - FAdditionalInfo: TStringList; - FAuthoritative: Boolean; - FTruncated: Boolean; - function CompressName(const Value: AnsiString): AnsiString; - function CodeHeader: AnsiString; - function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString; - function DecodeLabels(var From: Integer): AnsiString; - function DecodeString(var From: Integer): AnsiString; - function DecodeResource(var i: Integer; const Info: TStringList; - QType: Integer): AnsiString; - function RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString; - function DecodeResponse(const Buf: AnsiString; const Reply: TStrings; - QType: Integer):boolean; - public - constructor Create; - destructor Destroy; override; - - {:Query a DNSHost for QType resources correspond to a name. Supported QType - values are: Qtype_A, Qtype_NS, Qtype_MD, Qtype_MF, Qtype_CNAME, Qtype_SOA, - Qtype_MB, Qtype_MG, Qtype_MR, Qtype_NULL, Qtype_PTR, Qtype_HINFO, - Qtype_MINFO, Qtype_MX, Qtype_TXT, Qtype_RP, Qtype_AFSDB, Qtype_X25, - Qtype_ISDN, Qtype_RT, Qtype_NSAP, Qtype_NSAPPTR, Qtype_PX, Qtype_GPOS, - Qtype_KX. - - Type for zone transfers QTYPE_AXFR is supported too, but only in TCP mode! - - "Name" is domain name or host name for queried resource. If "name" is - IP address, automatically convert to reverse domain form (.in-addr.arpa). - - If result is @true, Reply contains resource records. One record on one line. - If Resource record have multiple fields, they are stored on line divided by - comma. (example: MX record contains value 'rs.cesnet.cz' with preference - number 10, string in Reply is: '10,rs.cesnet.cz'). All numbers or IP address - in resource are converted to string form.} - function DNSQuery(Name: AnsiString; QType: Integer; - const Reply: TStrings): Boolean; - published - - {:Socket object used for UDP operation. Good for seting OnStatus hook, etc.} - property Sock: TUDPBlockSocket read FSock; - - {:Socket object used for TCP operation. Good for seting OnStatus hook, etc.} - property TCPSock: TTCPBlockSocket read FTCPSock; - - {:if @true, then is used TCP protocol instead UDP. It is needed for zone - transfers, etc.} - property UseTCP: Boolean read FUseTCP Write FUseTCP; - - {:After DNS operation contains ResultCode of DNS operation. - Values are: 0-no error, 1-format error, 2-server failure, 3-name error, - 4-not implemented, 5-refused.} - property RCode: Integer read FRCode; - - {:@True, if answer is authoritative.} - property Authoritative: Boolean read FAuthoritative; - - {:@True, if answer is truncated to 512 bytes.} - property Truncated: Boolean read FTRuncated; - - {:Detailed informations from name server reply. One record per line. Record - have comma delimited entries with type number, TTL and data filelds. - This information contains detailed information about query reply.} - property AnswerInfo: TStringList read FAnswerInfo; - - {:Detailed informations from name server reply. One record per line. Record - have comma delimited entries with type number, TTL and data filelds. - This information contains detailed information about nameserver.} - property NameserverInfo: TStringList read FNameserverInfo; - - {:Detailed informations from name server reply. One record per line. Record - have comma delimited entries with type number, TTL and data filelds. - This information contains detailed additional information.} - property AdditionalInfo: TStringList read FAdditionalInfo; - end; - -{:A very useful function, and example of it's use is found in the TDNSSend object. - This function is used to get mail servers for a domain and sort them by - preference numbers. "Servers" contains only the domain names of the mail - servers in the right order (without preference number!). The first domain name - will always be the highest preferenced mail server. Returns boolean @TRUE if - all went well.} -function GetMailServers(const DNSHost, Domain: AnsiString; - const Servers: TStrings): Boolean; - -implementation - -constructor TDNSSend.Create; -begin - inherited Create; - FSock := TUDPBlockSocket.Create; - FSock.Owner := self; - FTCPSock := TTCPBlockSocket.Create; - FTCPSock.Owner := self; - FUseTCP := False; - FTimeout := 10000; - FTargetPort := cDnsProtocol; - FAnswerInfo := TStringList.Create; - FNameserverInfo := TStringList.Create; - FAdditionalInfo := TStringList.Create; - Randomize; -end; - -destructor TDNSSend.Destroy; -begin - FAnswerInfo.Free; - FNameserverInfo.Free; - FAdditionalInfo.Free; - FTCPSock.Free; - FSock.Free; - inherited Destroy; -end; - -function TDNSSend.CompressName(const Value: AnsiString): AnsiString; -var - n: Integer; - s: AnsiString; -begin - Result := ''; - if Value = '' then - Result := #0 - else - begin - s := ''; - for n := 1 to Length(Value) do - if Value[n] = '.' then - begin - Result := Result + AnsiChar(Length(s)) + s; - s := ''; - end - else - s := s + Value[n]; - if s <> '' then - Result := Result + AnsiChar(Length(s)) + s; - Result := Result + #0; - end; -end; - -function TDNSSend.CodeHeader: AnsiString; -begin - FID := Random(32767); - Result := CodeInt(FID); // ID - Result := Result + CodeInt($0100); // flags - Result := Result + CodeInt(1); // QDCount - Result := Result + CodeInt(0); // ANCount - Result := Result + CodeInt(0); // NSCount - Result := Result + CodeInt(0); // ARCount -end; - -function TDNSSend.CodeQuery(const Name: AnsiString; QType: Integer): AnsiString; -begin - Result := CompressName(Name); - Result := Result + CodeInt(QType); - Result := Result + CodeInt(1); // Type INTERNET -end; - -function TDNSSend.DecodeString(var From: Integer): AnsiString; -var - Len: integer; -begin - Len := Ord(FBuffer[From]); - Inc(From); - Result := Copy(FBuffer, From, Len); - Inc(From, Len); -end; - -function TDNSSend.DecodeLabels(var From: Integer): AnsiString; -var - l, f: Integer; -begin - Result := ''; - while True do - begin - if From >= Length(FBuffer) then - Break; - l := Ord(FBuffer[From]); - Inc(From); - if l = 0 then - Break; - if Result <> '' then - Result := Result + '.'; - if (l and $C0) = $C0 then - begin - f := l and $3F; - f := f * 256 + Ord(FBuffer[From]) + 1; - Inc(From); - Result := Result + DecodeLabels(f); - Break; - end - else - begin - Result := Result + Copy(FBuffer, From, l); - Inc(From, l); - end; - end; -end; - -function TDNSSend.DecodeResource(var i: Integer; const Info: TStringList; - QType: Integer): AnsiString; -var - Rname: AnsiString; - RType, Len, j, x, y, z, n: Integer; - R: AnsiString; - t1, t2, ttl: integer; - ip6: TIp6bytes; -begin - Result := ''; - R := ''; - Rname := DecodeLabels(i); - RType := DecodeInt(FBuffer, i); - Inc(i, 4); - t1 := DecodeInt(FBuffer, i); - Inc(i, 2); - t2 := DecodeInt(FBuffer, i); - Inc(i, 2); - ttl := t1 * 65536 + t2; - Len := DecodeInt(FBuffer, i); - Inc(i, 2); // i point to begin of data - j := i; - i := i + len; // i point to next record - if Length(FBuffer) >= (i - 1) then - case RType of - QTYPE_A: - begin - R := IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - end; - QTYPE_AAAA: - begin - for n := 0 to 15 do - ip6[n] := ord(FBuffer[j + n]); - R := IP6ToStr(ip6); - end; - QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB, - QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP, - QTYPE_NSAPPTR: - R := DecodeLabels(j); - QTYPE_SOA: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - for n := 1 to 5 do - begin - x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2); - Inc(j, 4); - R := R + ',' + IntToStr(x); - end; - end; - QTYPE_NULL: - begin - end; - QTYPE_WKS: - begin - end; - QTYPE_HINFO: - begin - R := DecodeString(j); - R := R + ',' + DecodeString(j); - end; - QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX: - begin - x := DecodeInt(FBuffer, j); - Inc(j, 2); - R := IntToStr(x); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_TXT, QTYPE_SPF: - begin - R := ''; - while j < i do - R := R + DecodeString(j); - end; - QTYPE_GPOS: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_PX: - begin - x := DecodeInt(FBuffer, j); - Inc(j, 2); - R := IntToStr(x); - R := R + ',' + DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_SRV: - // Author: Dan - begin - x := DecodeInt(FBuffer, j); - Inc(j, 2); - y := DecodeInt(FBuffer, j); - Inc(j, 2); - z := DecodeInt(FBuffer, j); - Inc(j, 2); - R := IntToStr(x); // Priority - R := R + ',' + IntToStr(y); // Weight - R := R + ',' + IntToStr(z); // Port - R := R + ',' + DecodeLabels(j); // Server DNS Name - end; - end; - if R <> '' then - Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R); - if QType = RType then - Result := R; -end; - -function TDNSSend.RecvTCPResponse(const WorkSock: TBlockSocket): AnsiString; -var - l: integer; -begin - Result := ''; - l := WorkSock.recvbyte(FTimeout) * 256 + WorkSock.recvbyte(FTimeout); - if l > 0 then - Result := WorkSock.RecvBufferStr(l, FTimeout); -end; - -function TDNSSend.DecodeResponse(const Buf: AnsiString; const Reply: TStrings; - QType: Integer):boolean; -var - n, i: Integer; - flag, qdcount, ancount, nscount, arcount: Integer; - s: AnsiString; -begin - Result := False; - Reply.Clear; - FAnswerInfo.Clear; - FNameserverInfo.Clear; - FAdditionalInfo.Clear; - FAuthoritative := False; - if (Length(Buf) > 13) and (FID = DecodeInt(Buf, 1)) then - begin - Result := True; - flag := DecodeInt(Buf, 3); - FRCode := Flag and $000F; - FAuthoritative := (Flag and $0400) > 0; - FTruncated := (Flag and $0200) > 0; - if FRCode = 0 then - begin - qdcount := DecodeInt(Buf, 5); - ancount := DecodeInt(Buf, 7); - nscount := DecodeInt(Buf, 9); - arcount := DecodeInt(Buf, 11); - i := 13; //begin of body - if (qdcount > 0) and (Length(Buf) > i) then //skip questions - for n := 1 to qdcount do - begin - while (Buf[i] <> #0) and ((Ord(Buf[i]) and $C0) <> $C0) do - Inc(i); - Inc(i, 5); - end; - if (ancount > 0) and (Length(Buf) > i) then // decode reply - for n := 1 to ancount do - begin - s := DecodeResource(i, FAnswerInfo, QType); - if s <> '' then - Reply.Add(s); - end; - if (nscount > 0) and (Length(Buf) > i) then // decode nameserver info - for n := 1 to nscount do - DecodeResource(i, FNameserverInfo, QType); - if (arcount > 0) and (Length(Buf) > i) then // decode additional info - for n := 1 to arcount do - DecodeResource(i, FAdditionalInfo, QType); - end; - end; -end; - -function TDNSSend.DNSQuery(Name: AnsiString; QType: Integer; - const Reply: TStrings): Boolean; -var - WorkSock: TBlockSocket; - t: TStringList; - b: boolean; -begin - Result := False; - if IsIP(Name) then - Name := ReverseIP(Name) + '.in-addr.arpa'; - if IsIP6(Name) then - Name := ReverseIP6(Name) + '.ip6.arpa'; - FBuffer := CodeHeader + CodeQuery(Name, QType); - if FUseTCP then - WorkSock := FTCPSock - else - WorkSock := FSock; - WorkSock.Bind(FIPInterface, cAnyPort); - WorkSock.Connect(FTargetHost, FTargetPort); - if FUseTCP then - FBuffer := Codeint(length(FBuffer)) + FBuffer; - WorkSock.SendString(FBuffer); - if FUseTCP then - FBuffer := RecvTCPResponse(WorkSock) - else - FBuffer := WorkSock.RecvPacket(FTimeout); - if FUseTCP and (QType = QTYPE_AXFR) then //zone transfer - begin - t := TStringList.Create; - try - repeat - b := DecodeResponse(FBuffer, Reply, QType); - if (t.Count > 1) and (AnswerInfo.Count > 0) then //find end of transfer - b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]); - if b then - begin - t.AddStrings(AnswerInfo); - FBuffer := RecvTCPResponse(WorkSock); - if FBuffer = '' then - Break; - if WorkSock.LastError <> 0 then - Break; - end; - until not b; - Reply.Assign(t); - Result := True; - finally - t.free; - end; - end - else //normal query - if WorkSock.LastError = 0 then - Result := DecodeResponse(FBuffer, Reply, QType); -end; - -{==============================================================================} - -function GetMailServers(const DNSHost, Domain: AnsiString; - const Servers: TStrings): Boolean; -var - DNS: TDNSSend; - t: TStringList; - n, m, x: Integer; -begin - Result := False; - Servers.Clear; - t := TStringList.Create; - DNS := TDNSSend.Create; - try - DNS.TargetHost := DNSHost; - if DNS.DNSQuery(Domain, QType_MX, t) then - begin - { normalize preference number to 5 digits } - for n := 0 to t.Count - 1 do - begin - x := Pos(',', t[n]); - if x > 0 then - for m := 1 to 6 - x do - t[n] := '0' + t[n]; - end; - { sort server list } - t.Sorted := True; - { result is sorted list without preference numbers } - for n := 0 to t.Count - 1 do - begin - x := Pos(',', t[n]); - Servers.Add(Copy(t[n], x + 1, Length(t[n]) - x)); - end; - Result := True; - end; - finally - DNS.Free; - t.Free; - end; -end; - -end. diff --git a/3rd/synapse/source/ftpsend.pas b/3rd/synapse/source/ftpsend.pas deleted file mode 100644 index 0d3683500..000000000 --- a/3rd/synapse/source/ftpsend.pas +++ /dev/null @@ -1,1964 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 004.000.000 | -|==============================================================================| -| Content: FTP client | -|==============================================================================| -| Copyright (c)1999-2011, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Petr Esner | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{: @abstract(FTP client protocol) - -Used RFC: RFC-959, RFC-2228, RFC-2428 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$TYPEINFO ON}// Borland changed defualt Visibility from Public to Published - // and it requires RTTI to be generated $M+ -{$M+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit ftpsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, synaip, synsock; - -const - cFtpProtocol = '21'; - cFtpDataProtocol = '20'; - - {:Terminating value for TLogonActions} - FTP_OK = 255; - {:Terminating value for TLogonActions} - FTP_ERR = 254; - -type - {:Array for holding definition of logon sequence.} - TLogonActions = array [0..17] of byte; - - {:Procedural type for OnStatus event. Sender is calling @link(TFTPSend) object. - Value is FTP command or reply to this comand. (if it is reply, Response - is @True).} - TFTPStatus = procedure(Sender: TObject; Response: Boolean; - const Value: string) of object; - - {: @abstract(Object for holding file information) parsed from directory - listing of FTP server.} - TFTPListRec = class(TObject) - private - FFileName: String; - FDirectory: Boolean; - FReadable: Boolean; - FFileSize: int64; - FFileTime: TDateTime; - FOriginalLine: string; - FMask: string; - FPermission: String; - public - {: You can assign another TFTPListRec to this object.} - procedure Assign(Value: TFTPListRec); virtual; - {:name of file} - property FileName: string read FFileName write FFileName; - {:if name is subdirectory not file.} - property Directory: Boolean read FDirectory write FDirectory; - {:if you have rights to read} - property Readable: Boolean read FReadable write FReadable; - {:size of file in bytes} - property FileSize: int64 read FFileSize write FFileSize; - {:date and time of file. Local server timezone is used. Any timezone - conversions was not done!} - property FileTime: TDateTime read FFileTime write FFileTime; - {:original unparsed line} - property OriginalLine: string read FOriginalLine write FOriginalLine; - {:mask what was used for parsing} - property Mask: string read FMask write FMask; - {:permission string (depending on used mask!)} - property Permission: string read FPermission write FPermission; - end; - - {:@abstract(This is TList of TFTPListRec objects.) - This object is used for holding lististing of all files information in listed - directory on FTP server.} - TFTPList = class(TObject) - protected - FList: TList; - FLines: TStringList; - FMasks: TStringList; - FUnparsedLines: TStringList; - Monthnames: string; - BlockSize: string; - DirFlagValue: string; - FileName: string; - VMSFileName: string; - Day: string; - Month: string; - ThreeMonth: string; - YearTime: string; - Year: string; - Hours: string; - HoursModif: Ansistring; - Minutes: string; - Seconds: string; - Size: Ansistring; - Permissions: Ansistring; - DirFlag: string; - function GetListItem(Index: integer): TFTPListRec; virtual; - function ParseEPLF(Value: string): Boolean; virtual; - procedure ClearStore; virtual; - function ParseByMask(Value, NextValue, Mask: ansistring): Integer; virtual; - function CheckValues: Boolean; virtual; - procedure FillRecord(const Value: TFTPListRec); virtual; - public - {:Constructor. You not need create this object, it is created by TFTPSend - class as their property.} - constructor Create; - destructor Destroy; override; - - {:Clear list.} - procedure Clear; virtual; - - {:count of holded @link(TFTPListRec) objects} - function Count: integer; virtual; - - {:Assigns one list to another} - procedure Assign(Value: TFTPList); virtual; - - {:try to parse raw directory listing in @link(lines) to list of - @link(TFTPListRec).} - procedure ParseLines; virtual; - - {:By this property you have access to list of @link(TFTPListRec). - This is for compatibility only. Please, use @link(Items) instead.} - property List: TList read FList; - - {:By this property you have access to list of @link(TFTPListRec).} - property Items[Index: Integer]: TFTPListRec read GetListItem; default; - - {:Set of lines with RAW directory listing for @link(parseLines)} - property Lines: TStringList read FLines; - - {:Set of masks for directory listing parser. It is predefined by default, - however you can modify it as you need. (for example, you can add your own - definition mask.) Mask is same as mask used in TotalCommander.} - property Masks: TStringList read FMasks; - - {:After @link(ParseLines) it holding lines what was not sucessfully parsed.} - property UnparsedLines: TStringList read FUnparsedLines; - end; - - {:@abstract(Implementation of FTP protocol.) - Note: Are you missing properties for setting Username and Password? Look to - parent @link(TSynaClient) object! (Username and Password have default values - for "anonymous" FTP login) - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TFTPSend = class(TSynaClient) - protected - FOnStatus: TFTPStatus; - FSock: TTCPBlockSocket; - FDSock: TTCPBlockSocket; - FResultCode: Integer; - FResultString: string; - FFullResult: TStringList; - FAccount: string; - FFWHost: string; - FFWPort: string; - FFWUsername: string; - FFWPassword: string; - FFWMode: integer; - FDataStream: TMemoryStream; - FDataIP: string; - FDataPort: string; - FDirectFile: Boolean; - FDirectFileName: string; - FCanResume: Boolean; - FPassiveMode: Boolean; - FForceDefaultPort: Boolean; - FForceOldPort: Boolean; - FFtpList: TFTPList; - FBinaryMode: Boolean; - FAutoTLS: Boolean; - FIsTLS: Boolean; - FIsDataTLS: Boolean; - FTLSonData: Boolean; - FFullSSL: Boolean; - function Auth(Mode: integer): Boolean; virtual; - function Connect: Boolean; virtual; - function InternalStor(const Command: string; RestoreAt: int64): Boolean; virtual; - function DataSocket: Boolean; virtual; - function AcceptDataSocket: Boolean; virtual; - procedure DoStatus(Response: Boolean; const Value: string); virtual; - public - {:Custom definition of login sequence. You can use this when you set - @link(FWMode) to value -1.} - CustomLogon: TLogonActions; - - constructor Create; - destructor Destroy; override; - - {:Waits and read FTP server response. You need this only in special cases!} - function ReadResult: Integer; virtual; - - {:Parse remote side information of data channel from value string (returned - by PASV command). This function you need only in special cases!} - procedure ParseRemote(Value: string); virtual; - - {:Parse remote side information of data channel from value string (returned - by EPSV command). This function you need only in special cases!} - procedure ParseRemoteEPSV(Value: string); virtual; - - {:Send Value as FTP command to FTP server. Returned result code is result of - this function. - This command is good for sending site specific command, or non-standard - commands.} - function FTPCommand(const Value: string): integer; virtual; - - {:Connect and logon to FTP server. If you specify any FireWall, connect to - firewall and throw them connect to FTP server. Login sequence depending on - @link(FWMode).} - function Login: Boolean; virtual; - - {:Logoff and disconnect from FTP server.} - function Logout: Boolean; virtual; - - {:Break current transmission of data. (You can call this method from - Sock.OnStatus event, or from another thread.)} - procedure Abort; virtual; - - {:Break current transmission of data. It is same as Abort, but it send abort - telnet commands prior ABOR FTP command. Some servers need it. (You can call - this method from Sock.OnStatus event, or from another thread.)} - procedure TelnetAbort; virtual; - - {:Download directory listing of Directory on FTP server. If Directory is - empty string, download listing of current working directory. - If NameList is @true, download only names of files in directory. - (internally use NLST command instead LIST command) - If NameList is @false, returned list is also parsed to @link(FTPList) - property.} - function List(Directory: string; NameList: Boolean): Boolean; virtual; - - {:Read data from FileName on FTP server. If Restore is @true and server - supports resume dowloads, download is resumed. (received is only rest - of file)} - function RetrieveFile(const FileName: string; Restore: Boolean): Boolean; virtual; - - {:Send data to FileName on FTP server. If Restore is @true and server - supports resume upload, upload is resumed. (send only rest of file) - In this case if remote file is same length as local file, nothing will be - done. If remote file is larger then local, resume is disabled and file is - transfered from begin!} - function StoreFile(const FileName: string; Restore: Boolean): Boolean; virtual; - - {:Send data to FTP server and assing unique name for this file.} - function StoreUniqueFile: Boolean; virtual; - - {:Append data to FileName on FTP server.} - function AppendFile(const FileName: string): Boolean; virtual; - - {:Rename on FTP server file with OldName to NewName.} - function RenameFile(const OldName, NewName: string): Boolean; virtual; - - {:Delete file FileName on FTP server.} - function DeleteFile(const FileName: string): Boolean; virtual; - - {:Return size of Filename file on FTP server. If command failed (i.e. not - implemented), return -1.} - function FileSize(const FileName: string): int64; virtual; - - {:Send NOOP command to FTP server for preserve of disconnect by inactivity - timeout.} - function NoOp: Boolean; virtual; - - {:Change currect working directory to Directory on FTP server.} - function ChangeWorkingDir(const Directory: string): Boolean; virtual; - - {:walk to upper directory on FTP server.} - function ChangeToParentDir: Boolean; virtual; - - {:walk to root directory on FTP server. (May not work with all servers properly!)} - function ChangeToRootDir: Boolean; virtual; - - {:Delete Directory on FTP server.} - function DeleteDir(const Directory: string): Boolean; virtual; - - {:Create Directory on FTP server.} - function CreateDir(const Directory: string): Boolean; virtual; - - {:Return current working directory on FTP server.} - function GetCurrentDir: String; virtual; - - {:Establish data channel to FTP server and retrieve data. - This function you need only in special cases, i.e. when you need to implement - some special unsupported FTP command!} - function DataRead(const DestStream: TStream): Boolean; virtual; - - {:Establish data channel to FTP server and send data. - This function you need only in special cases, i.e. when you need to implement - some special unsupported FTP command.} - function DataWrite(const SourceStream: TStream): Boolean; virtual; - published - {:After FTP command contains result number of this operation.} - property ResultCode: Integer read FResultCode; - - {:After FTP command contains main line of result.} - property ResultString: string read FResultString; - - {:After any FTP command it contains all lines of FTP server reply.} - property FullResult: TStringList read FFullResult; - - {:Account information used in some cases inside login sequence.} - property Account: string read FAccount Write FAccount; - - {:Address of firewall. If empty string (default), firewall not used.} - property FWHost: string read FFWHost Write FFWHost; - - {:port of firewall. standard value is same port as ftp server used. (21)} - property FWPort: string read FFWPort Write FFWPort; - - {:Username for login to firewall. (if needed)} - property FWUsername: string read FFWUsername Write FFWUsername; - - {:password for login to firewall. (if needed)} - property FWPassword: string read FFWPassword Write FFWPassword; - - {:Type of Firewall. Used only if you set some firewall address. Supported - predefined firewall login sequences are described by comments in source - file where you can see pseudocode decribing each sequence.} - property FWMode: integer read FFWMode Write FFWMode; - - {:Socket object used for TCP/IP operation on control channel. Good for - seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - - {:Socket object used for TCP/IP operation on data channel. Good for seting - OnStatus hook, etc.} - property DSock: TTCPBlockSocket read FDSock; - - {:If you not use @link(DirectFile) mode, all data transfers is made to or - from this stream.} - property DataStream: TMemoryStream read FDataStream; - - {:After data connection is established, contains remote side IP of this - connection.} - property DataIP: string read FDataIP; - - {:After data connection is established, contains remote side port of this - connection.} - property DataPort: string read FDataPort; - - {:Mode of data handling by data connection. If @False, all data operations - are made to or from @link(DataStream) TMemoryStream. - If @true, data operations is made directly to file in your disk. (filename - is specified by @link(DirectFileName) property.) Dafault is @False!} - property DirectFile: Boolean read FDirectFile Write FDirectFile; - - {:Filename for direct disk data operations.} - property DirectFileName: string read FDirectFileName Write FDirectFileName; - - {:Indicate after @link(Login) if remote server support resume downloads and - uploads.} - property CanResume: Boolean read FCanResume; - - {:If true (default value), all transfers is made by passive method. - It is safer method for various firewalls.} - property PassiveMode: Boolean read FPassiveMode Write FPassiveMode; - - {:Force to listen for dataconnection on standard port (20). Default is @false, - dataconnections will be made to any non-standard port reported by PORT FTP - command. This setting is not used, if you use passive mode.} - property ForceDefaultPort: Boolean read FForceDefaultPort Write FForceDefaultPort; - - {:When is @true, then is disabled EPSV and EPRT support. However without this - commands you cannot use IPv6! (Disabling of this commands is needed only - when you are behind some crap firewall/NAT.} - property ForceOldPort: Boolean read FForceOldPort Write FForceOldPort; - - {:You may set this hook for monitoring FTP commands and replies.} - property OnStatus: TFTPStatus read FOnStatus write FOnStatus; - - {:After LIST command is here parsed list of files in given directory.} - property FtpList: TFTPList read FFtpList; - - {:if @true (default), then data transfers is in binary mode. If this is set - to @false, then ASCII mode is used.} - property BinaryMode: Boolean read FBinaryMode Write FBinaryMode; - - {:if is true, then if server support upgrade to SSL/TLS mode, then use them.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:if server listen on SSL/TLS port, then you set this to true.} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - - {:Signalise, if control channel is in SSL/TLS mode.} - property IsTLS: Boolean read FIsTLS; - - {:Signalise, if data transfers is in SSL/TLS mode.} - property IsDataTLS: Boolean read FIsDataTLS; - - {:If @true (default), then try to use SSL/TLS on data transfers too. - If @false, then SSL/TLS is used only for control connection.} - property TLSonData: Boolean read FTLSonData write FTLSonData; - end; - -{:A very useful function, and example of use can be found in the TFtpSend object. - Dowload specified file from FTP server to LocalFile.} -function FtpGetFile(const IP, Port, FileName, LocalFile, - User, Pass: string): Boolean; - -{:A very useful function, and example of use can be found in the TFtpSend object. - Upload specified LocalFile to FTP server.} -function FtpPutFile(const IP, Port, FileName, LocalFile, - User, Pass: string): Boolean; - -{:A very useful function, and example of use can be found in the TFtpSend object. - Initiate transfer of file between two FTP servers.} -function FtpInterServerTransfer( - const FromIP, FromPort, FromFile, FromUser, FromPass: string; - const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean; - -implementation - -constructor TFTPSend.Create; -begin - inherited Create; - FFullResult := TStringList.Create; - FDataStream := TMemoryStream.Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.ConvertLineEnd := True; - FDSock := TTCPBlockSocket.Create; - FDSock.Owner := self; - FFtpList := TFTPList.Create; - FTimeout := 300000; - FTargetPort := cFtpProtocol; - FUsername := 'anonymous'; - FPassword := 'anonymous@' + FSock.LocalName; - FDirectFile := False; - FPassiveMode := True; - FForceDefaultPort := False; - FForceOldPort := false; - FAccount := ''; - FFWHost := ''; - FFWPort := cFtpProtocol; - FFWUsername := ''; - FFWPassword := ''; - FFWMode := 0; - FBinaryMode := True; - FAutoTLS := False; - FFullSSL := False; - FIsTLS := False; - FIsDataTLS := False; - FTLSonData := True; -end; - -destructor TFTPSend.Destroy; -begin - FDSock.Free; - FSock.Free; - FFTPList.Free; - FDataStream.Free; - FFullResult.Free; - inherited Destroy; -end; - -procedure TFTPSend.DoStatus(Response: Boolean; const Value: string); -begin - if assigned(OnStatus) then - OnStatus(Self, Response, Value); -end; - -function TFTPSend.ReadResult: Integer; -var - s, c: AnsiString; -begin - FFullResult.Clear; - c := ''; - repeat - s := FSock.RecvString(FTimeout); - if c = '' then - if length(s) > 3 then - if s[4] in [' ', '-'] then - c :=Copy(s, 1, 3); - FResultString := s; - FFullResult.Add(s); - DoStatus(True, s); - if FSock.LastError <> 0 then - Break; - until (c <> '') and (Pos(c + ' ', s) = 1); - Result := StrToIntDef(c, 0); - FResultCode := Result; -end; - -function TFTPSend.FTPCommand(const Value: string): integer; -begin - FSock.Purge; - FSock.SendString(Value + CRLF); - DoStatus(False, Value); - Result := ReadResult; -end; - -// based on idea by Petr Esner -function TFTPSend.Auth(Mode: integer): Boolean; -const - //if not USER then - // if not PASS then - // if not ACCT then ERROR! - //OK! - Action0: TLogonActions = - (0, FTP_OK, 3, - 1, FTP_OK, 6, - 2, FTP_OK, FTP_ERR, - 0, 0, 0, 0, 0, 0, 0, 0, 0); - - //if not USER then - // if not PASS then ERROR! - //if SITE then ERROR! - //if not USER then - // if not PASS then - // if not ACCT then ERROR! - //OK! - Action1: TLogonActions = - (3, 6, 3, - 4, 6, FTP_ERR, - 5, FTP_ERR, 9, - 0, FTP_OK, 12, - 1, FTP_OK, 15, - 2, FTP_OK, FTP_ERR); - - //if not USER then - // if not PASS then ERROR! - //if USER '@' then OK! - //if not PASS then - // if not ACCT then ERROR! - //OK! - Action2: TLogonActions = - (3, 6, 3, - 4, 6, FTP_ERR, - 6, FTP_OK, 9, - 1, FTP_OK, 12, - 2, FTP_OK, FTP_ERR, - 0, 0, 0); - - //if not USER then - // if not PASS then ERROR! - //if not USER then - // if not PASS then - // if not ACCT then ERROR! - //OK! - Action3: TLogonActions = - (3, 6, 3, - 4, 6, FTP_ERR, - 0, FTP_OK, 9, - 1, FTP_OK, 12, - 2, FTP_OK, FTP_ERR, - 0, 0, 0); - - //OPEN - //if not USER then - // if not PASS then - // if not ACCT then ERROR! - //OK! - Action4: TLogonActions = - (7, 3, 3, - 0, FTP_OK, 6, - 1, FTP_OK, 9, - 2, FTP_OK, FTP_ERR, - 0, 0, 0, 0, 0, 0); - - //if USER '@' then OK! - //if not PASS then - // if not ACCT then ERROR! - //OK! - Action5: TLogonActions = - (6, FTP_OK, 3, - 1, FTP_OK, 6, - 2, FTP_OK, FTP_ERR, - 0, 0, 0, 0, 0, 0, 0, 0, 0); - - //if not USER @ then - // if not PASS then ERROR! - //if not USER then - // if not PASS then - // if not ACCT then ERROR! - //OK! - Action6: TLogonActions = - (8, 6, 3, - 4, 6, FTP_ERR, - 0, FTP_OK, 9, - 1, FTP_OK, 12, - 2, FTP_OK, FTP_ERR, - 0, 0, 0); - - //if USER @ then ERROR! - //if not PASS then - // if not ACCT then ERROR! - //OK! - Action7: TLogonActions = - (9, FTP_ERR, 3, - 1, FTP_OK, 6, - 2, FTP_OK, FTP_ERR, - 0, 0, 0, 0, 0, 0, 0, 0, 0); - - //if not USER @@ then - // if not PASS @ then - // if not ACCT then ERROR! - //OK! - Action8: TLogonActions = - (10, FTP_OK, 3, - 11, FTP_OK, 6, - 2, FTP_OK, FTP_ERR, - 0, 0, 0, 0, 0, 0, 0, 0, 0); -var - FTPServer: string; - LogonActions: TLogonActions; - i: integer; - s: string; - x: integer; -begin - Result := False; - if FFWHost = '' then - Mode := 0; - if (FTargetPort = cFtpProtocol) or (FTargetPort = '21') then - FTPServer := FTargetHost - else - FTPServer := FTargetHost + ':' + FTargetPort; - case Mode of - -1: - LogonActions := CustomLogon; - 1: - LogonActions := Action1; - 2: - LogonActions := Action2; - 3: - LogonActions := Action3; - 4: - LogonActions := Action4; - 5: - LogonActions := Action5; - 6: - LogonActions := Action6; - 7: - LogonActions := Action7; - 8: - LogonActions := Action8; - else - LogonActions := Action0; - end; - i := 0; - repeat - case LogonActions[i] of - 0: s := 'USER ' + FUserName; - 1: s := 'PASS ' + FPassword; - 2: s := 'ACCT ' + FAccount; - 3: s := 'USER ' + FFWUserName; - 4: s := 'PASS ' + FFWPassword; - 5: s := 'SITE ' + FTPServer; - 6: s := 'USER ' + FUserName + '@' + FTPServer; - 7: s := 'OPEN ' + FTPServer; - 8: s := 'USER ' + FFWUserName + '@' + FTPServer; - 9: s := 'USER ' + FUserName + '@' + FTPServer + ' ' + FFWUserName; - 10: s := 'USER ' + FUserName + '@' + FFWUserName + '@' + FTPServer; - 11: s := 'PASS ' + FPassword + '@' + FFWPassword; - end; - x := FTPCommand(s); - x := x div 100; - if (x <> 2) and (x <> 3) then - Exit; - i := LogonActions[i + x - 1]; - case i of - FTP_ERR: - Exit; - FTP_OK: - begin - Result := True; - Exit; - end; - end; - until False; -end; - - -function TFTPSend.Connect: Boolean; -begin - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - if FFWHost = '' then - FSock.Connect(FTargetHost, FTargetPort) - else - FSock.Connect(FFWHost, FFWPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TFTPSend.Login: Boolean; -var - x: integer; -begin - Result := False; - FCanResume := False; - if not Connect then - Exit; - FIsTLS := FFullSSL; - FIsDataTLS := False; - repeat - x := ReadResult div 100; - until x <> 1; - if x <> 2 then - Exit; - if FAutoTLS and not(FIsTLS) then - if (FTPCommand('AUTH TLS') div 100) = 2 then - begin - FSock.SSLDoConnect; - FIsTLS := FSock.LastError = 0; - if not FIsTLS then - begin - Result := False; - Exit; - end; - end; - if not Auth(FFWMode) then - Exit; - if FIsTLS then - begin - FTPCommand('PBSZ 0'); - if FTLSonData then - FIsDataTLS := (FTPCommand('PROT P') div 100) = 2; - if not FIsDataTLS then - FTPCommand('PROT C'); - end; - FTPCommand('TYPE I'); - FTPCommand('STRU F'); - FTPCommand('MODE S'); - if FTPCommand('REST 0') = 350 then - if FTPCommand('REST 1') = 350 then - begin - FTPCommand('REST 0'); - FCanResume := True; - end; - Result := True; -end; - -function TFTPSend.Logout: Boolean; -begin - Result := (FTPCommand('QUIT') div 100) = 2; - FSock.CloseSocket; -end; - -procedure TFTPSend.ParseRemote(Value: string); -var - n: integer; - nb, ne: integer; - s: string; - x: integer; -begin - Value := trim(Value); - nb := Pos('(',Value); - ne := Pos(')',Value); - if (nb = 0) or (ne = 0) then - begin - nb:=RPos(' ',Value); - s:=Copy(Value, nb + 1, Length(Value) - nb); - end - else - begin - s:=Copy(Value,nb+1,ne-nb-1); - end; - for n := 1 to 4 do - if n = 1 then - FDataIP := Fetch(s, ',') - else - FDataIP := FDataIP + '.' + Fetch(s, ','); - x := StrToIntDef(Fetch(s, ','), 0) * 256; - x := x + StrToIntDef(Fetch(s, ','), 0); - FDataPort := IntToStr(x); -end; - -procedure TFTPSend.ParseRemoteEPSV(Value: string); -var - n: integer; - s, v: AnsiString; -begin - s := SeparateRight(Value, '('); - s := Trim(SeparateLeft(s, ')')); - Delete(s, Length(s), 1); - v := ''; - for n := Length(s) downto 1 do - if s[n] in ['0'..'9'] then - v := s[n] + v - else - Break; - FDataPort := v; - FDataIP := FTargetHost; -end; - -function TFTPSend.DataSocket: boolean; -var - s: string; -begin - Result := False; - if FIsDataTLS then - FPassiveMode := True; - if FPassiveMode then - begin - if FSock.IP6used then - s := '2' - else - s := '1'; - if FSock.IP6used and not(FForceOldPort) and ((FTPCommand('EPSV ' + s) div 100) = 2) then - begin - ParseRemoteEPSV(FResultString); - end - else - if FSock.IP6used then - Exit - else - begin - if (FTPCommand('PASV') div 100) <> 2 then - Exit; - ParseRemote(FResultString); - end; - FDSock.CloseSocket; - FDSock.Bind(FIPInterface, cAnyPort); - FDSock.Connect(FDataIP, FDataPort); - Result := FDSock.LastError = 0; - end - else - begin - FDSock.CloseSocket; - if FForceDefaultPort then - s := cFtpDataProtocol - else - s := '0'; - //data conection from same interface as command connection - FDSock.Bind(FSock.GetLocalSinIP, s); - if FDSock.LastError <> 0 then - Exit; - FDSock.SetLinger(True, 10000); - FDSock.Listen; - FDSock.GetSins; - FDataIP := FDSock.GetLocalSinIP; - FDataIP := FDSock.ResolveName(FDataIP); - FDataPort := IntToStr(FDSock.GetLocalSinPort); - if FSock.IP6used and (not FForceOldPort) then - begin - if IsIp6(FDataIP) then - s := '2' - else - s := '1'; - s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|'; - Result := (FTPCommand(s) div 100) = 2; - end; - if not Result and IsIP(FDataIP) then - begin - s := ReplaceString(FDataIP, '.', ','); - s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256) - + ',' + IntToStr(FDSock.GetLocalSinPort mod 256); - Result := (FTPCommand(s) div 100) = 2; - end; - end; -end; - -function TFTPSend.AcceptDataSocket: Boolean; -var - x: TSocket; -begin - if FPassiveMode then - Result := True - else - begin - Result := False; - if FDSock.CanRead(FTimeout) then - begin - x := FDSock.Accept; - if not FDSock.UsingSocks then - FDSock.CloseSocket; - FDSock.Socket := x; - Result := True; - end; - end; - if Result and FIsDataTLS then - begin - FDSock.SSL.Assign(FSock.SSL); - FDSock.SSLDoConnect; - Result := FDSock.LastError = 0; - end; -end; - -function TFTPSend.DataRead(const DestStream: TStream): Boolean; -var - x: integer; -begin - Result := False; - try - if not AcceptDataSocket then - Exit; - FDSock.RecvStreamRaw(DestStream, FTimeout); - FDSock.CloseSocket; - x := ReadResult; - Result := (x div 100) = 2; - finally - FDSock.CloseSocket; - end; -end; - -function TFTPSend.DataWrite(const SourceStream: TStream): Boolean; -var - x: integer; - b: Boolean; -begin - Result := False; - try - if not AcceptDataSocket then - Exit; - FDSock.SendStreamRaw(SourceStream); - b := FDSock.LastError = 0; - FDSock.CloseSocket; - x := ReadResult; - Result := b and ((x div 100) = 2); - finally - FDSock.CloseSocket; - end; -end; - -function TFTPSend.List(Directory: string; NameList: Boolean): Boolean; -var - x: integer; -begin - Result := False; - FDataStream.Clear; - FFTPList.Clear; - if Directory <> '' then - Directory := ' ' + Directory; - FTPCommand('TYPE A'); - if not DataSocket then - Exit; - if NameList then - x := FTPCommand('NLST' + Directory) - else - x := FTPCommand('LIST' + Directory); - if (x div 100) <> 1 then - Exit; - Result := DataRead(FDataStream); - if (not NameList) and Result then - begin - FDataStream.Position := 0; - FFTPList.Lines.LoadFromStream(FDataStream); - FFTPList.ParseLines; - end; - FDataStream.Position := 0; -end; - -function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean; -var - RetrStream: TStream; -begin - Result := False; - if FileName = '' then - Exit; - if not DataSocket then - Exit; - Restore := Restore and FCanResume; - if FDirectFile then - if Restore and FileExists(FDirectFileName) then - RetrStream := TFileStream.Create(FDirectFileName, - fmOpenReadWrite or fmShareExclusive) - else - RetrStream := TFileStream.Create(FDirectFileName, - fmCreate or fmShareDenyWrite) - else - RetrStream := FDataStream; - try - if FBinaryMode then - FTPCommand('TYPE I') - else - FTPCommand('TYPE A'); - if Restore then - begin - RetrStream.Position := RetrStream.Size; - if (FTPCommand('REST ' + IntToStr(RetrStream.Size)) div 100) <> 3 then - Exit; - end - else - if RetrStream is TMemoryStream then - TMemoryStream(RetrStream).Clear; - if (FTPCommand('RETR ' + FileName) div 100) <> 1 then - Exit; - Result := DataRead(RetrStream); - if not FDirectFile then - RetrStream.Position := 0; - finally - if FDirectFile then - RetrStream.Free; - end; -end; - -function TFTPSend.InternalStor(const Command: string; RestoreAt: int64): Boolean; -var - SendStream: TStream; - StorSize: int64; -begin - Result := False; - if FDirectFile then - if not FileExists(FDirectFileName) then - Exit - else - SendStream := TFileStream.Create(FDirectFileName, - fmOpenRead or fmShareDenyWrite) - else - SendStream := FDataStream; - try - if not DataSocket then - Exit; - if FBinaryMode then - FTPCommand('TYPE I') - else - FTPCommand('TYPE A'); - StorSize := SendStream.Size; - if not FCanResume then - RestoreAt := 0; - if (StorSize > 0) and (RestoreAt = StorSize) then - begin - Result := True; - Exit; - end; - if RestoreAt > StorSize then - RestoreAt := 0; - FTPCommand('ALLO ' + IntToStr(StorSize - RestoreAt)); - if FCanResume then - if (FTPCommand('REST ' + IntToStr(RestoreAt)) div 100) <> 3 then - Exit; - SendStream.Position := RestoreAt; - if (FTPCommand(Command) div 100) <> 1 then - Exit; - Result := DataWrite(SendStream); - finally - if FDirectFile then - SendStream.Free; - end; -end; - -function TFTPSend.StoreFile(const FileName: string; Restore: Boolean): Boolean; -var - RestoreAt: int64; -begin - Result := False; - if FileName = '' then - Exit; - RestoreAt := 0; - Restore := Restore and FCanResume; - if Restore then - begin - RestoreAt := Self.FileSize(FileName); - if RestoreAt < 0 then - RestoreAt := 0; - end; - Result := InternalStor('STOR ' + FileName, RestoreAt); -end; - -function TFTPSend.StoreUniqueFile: Boolean; -begin - Result := InternalStor('STOU', 0); -end; - -function TFTPSend.AppendFile(const FileName: string): Boolean; -begin - Result := False; - if FileName = '' then - Exit; - Result := InternalStor('APPE ' + FileName, 0); -end; - -function TFTPSend.NoOp: Boolean; -begin - Result := (FTPCommand('NOOP') div 100) = 2; -end; - -function TFTPSend.RenameFile(const OldName, NewName: string): Boolean; -begin - Result := False; - if (FTPCommand('RNFR ' + OldName) div 100) <> 3 then - Exit; - Result := (FTPCommand('RNTO ' + NewName) div 100) = 2; -end; - -function TFTPSend.DeleteFile(const FileName: string): Boolean; -begin - Result := (FTPCommand('DELE ' + FileName) div 100) = 2; -end; - -function TFTPSend.FileSize(const FileName: string): int64; -var - s: string; -begin - Result := -1; - if (FTPCommand('SIZE ' + FileName) div 100) = 2 then - begin - s := Trim(SeparateRight(ResultString, ' ')); - s := Trim(SeparateLeft(s, ' ')); - {$IFDEF VER100} - Result := StrToIntDef(s, -1); - {$ELSE} - Result := StrToInt64Def(s, -1); - {$ENDIF} - end; -end; - -function TFTPSend.ChangeWorkingDir(const Directory: string): Boolean; -begin - Result := (FTPCommand('CWD ' + Directory) div 100) = 2; -end; - -function TFTPSend.ChangeToParentDir: Boolean; -begin - Result := (FTPCommand('CDUP') div 100) = 2; -end; - -function TFTPSend.ChangeToRootDir: Boolean; -begin - Result := ChangeWorkingDir('/'); -end; - -function TFTPSend.DeleteDir(const Directory: string): Boolean; -begin - Result := (FTPCommand('RMD ' + Directory) div 100) = 2; -end; - -function TFTPSend.CreateDir(const Directory: string): Boolean; -begin - Result := (FTPCommand('MKD ' + Directory) div 100) = 2; -end; - -function TFTPSend.GetCurrentDir: String; -begin - Result := ''; - if (FTPCommand('PWD') div 100) = 2 then - begin - Result := SeparateRight(FResultString, '"'); - Result := Trim(Separateleft(Result, '"')); - end; -end; - -procedure TFTPSend.Abort; -begin - FSock.SendString('ABOR' + CRLF); - FDSock.StopFlag := True; -end; - -procedure TFTPSend.TelnetAbort; -begin - FSock.SendString(#$FF + #$F4 + #$FF + #$F2); - Abort; -end; - -{==============================================================================} - -procedure TFTPListRec.Assign(Value: TFTPListRec); -begin - FFileName := Value.FileName; - FDirectory := Value.Directory; - FReadable := Value.Readable; - FFileSize := Value.FileSize; - FFileTime := Value.FileTime; - FOriginalLine := Value.OriginalLine; - FMask := Value.Mask; -end; - -constructor TFTPList.Create; -begin - inherited Create; - FList := TList.Create; - FLines := TStringList.Create; - FMasks := TStringList.Create; - FUnparsedLines := TStringList.Create; - //various UNIX - FMasks.add('pppppppppp $!!!S*$TTT$DD$hh mm ss$YYYY$n*'); - FMasks.add('pppppppppp $!!!S*$DD$TTT$hh mm ss$YYYY$n*'); - FMasks.add('pppppppppp $!!!S*$TTT$DD$UUUUU$n*'); //mostly used UNIX format - FMasks.add('pppppppppp $!!!S*$DD$TTT$UUUUU$n*'); - //MacOS - FMasks.add('pppppppppp $!!S*$TTT$DD$UUUUU$n*'); - FMasks.add('pppppppppp $!S*$TTT$DD$UUUUU$n*'); - //Novell - FMasks.add('d $!S*$TTT$DD$UUUUU$n*'); - //Windows - FMasks.add('MM DD YY hh mmH !S* n*'); - FMasks.add('MM DD YY hh mmH $ d!n*'); - FMasks.add('MM DD YYYY hh mmH !S* n*'); - FMasks.add('MM DD YYYY hh mmH $ d!n*'); - FMasks.add('DD MM YYYY hh mmH !S* n*'); - FMasks.add('DD MM YYYY hh mmH $ d!n*'); - //VMS - FMasks.add('v*$ DD TTT YYYY hh mm'); - FMasks.add('v*$!DD TTT YYYY hh mm'); - FMasks.add('n*$ YYYY MM DD hh mm$S*'); - //AS400 - FMasks.add('!S*$MM DD YY hh mm ss !n*'); - FMasks.add('!S*$DD MM YY hh mm ss !n*'); - FMasks.add('n*!S*$MM DD YY hh mm ss d'); - FMasks.add('n*!S*$DD MM YY hh mm ss d'); - //VxWorks - FMasks.add('$S* TTT DD YYYY hh mm ss $n* $ d'); - FMasks.add('$S* TTT DD YYYY hh mm ss $n*'); - //Distinct - FMasks.add('d $S*$TTT DD YYYY hh mm$n*'); - FMasks.add('d $S*$TTT DD$hh mm$n*'); - //PC-NFSD - FMasks.add('nnnnnnnn.nnn dSSSSSSSSSSS MM DD YY hh mmH'); - //VOS - FMasks.add('- SSSSS YY MM DD hh mm ss n*'); - FMasks.add('- d= SSSSS YY MM DD hh mm ss n*'); - //Unissys ClearPath - FMasks.add('nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn SSSSSSSSS MM DD YYYY hh mm'); - FMasks.add('n*\x SSSSSSSSS MM DD YYYY hh mm'); - //IBM - FMasks.add('- SSSSSSSSSSSS d MM DD YYYY hh mm n*'); - //OS9 - FMasks.add('- YY MM DD hhmm d SSSSSSSSS n*'); - //tandem - FMasks.add('nnnnnnnn SSSSSSS DD TTT YY hh mm ss'); - //MVS - FMasks.add('- YYYY MM DD SSSSS d=O n*'); - //BullGCOS8 - FMasks.add(' $S* MM DD YY hh mm ss !n*'); - FMasks.add('d $S* MM DD YY !n*'); - //BullGCOS7 - FMasks.add(' TTT DD YYYY n*'); - FMasks.add(' d n*'); -end; - -destructor TFTPList.Destroy; -begin - Clear; - FList.Free; - FLines.Free; - FMasks.Free; - FUnparsedLines.Free; - inherited Destroy; -end; - -procedure TFTPList.Clear; -var - n:integer; -begin - for n := 0 to FList.Count - 1 do - if Assigned(FList[n]) then - TFTPListRec(FList[n]).Free; - FList.Clear; - FLines.Clear; - FUnparsedLines.Clear; -end; - -function TFTPList.Count: integer; -begin - Result := FList.Count; -end; - -function TFTPList.GetListItem(Index: integer): TFTPListRec; -begin - Result := nil; - if Index < Count then - Result := TFTPListRec(FList[Index]); -end; - -procedure TFTPList.Assign(Value: TFTPList); -var - flr: TFTPListRec; - n: integer; -begin - Clear; - for n := 0 to Value.Count - 1 do - begin - flr := TFTPListRec.Create; - flr.Assign(Value[n]); - Flist.Add(flr); - end; - Lines.Assign(Value.Lines); - Masks.Assign(Value.Masks); - UnparsedLines.Assign(Value.UnparsedLines); -end; - -procedure TFTPList.ClearStore; -begin - Monthnames := ''; - BlockSize := ''; - DirFlagValue := ''; - FileName := ''; - VMSFileName := ''; - Day := ''; - Month := ''; - ThreeMonth := ''; - YearTime := ''; - Year := ''; - Hours := ''; - HoursModif := ''; - Minutes := ''; - Seconds := ''; - Size := ''; - Permissions := ''; - DirFlag := ''; -end; - -function TFTPList.ParseByMask(Value, NextValue, Mask: AnsiString): Integer; -var - Ivalue, IMask: integer; - MaskC, LastMaskC: AnsiChar; - c: AnsiChar; - s: string; -begin - ClearStore; - Result := 0; - if Value = '' then - Exit; - if Mask = '' then - Exit; - Ivalue := 1; - IMask := 1; - Result := 1; - LastMaskC := ' '; - while Imask <= Length(mask) do - begin - if (Mask[Imask] <> '*') and (Ivalue > Length(Value)) then - begin - Result := 0; - Exit; - end; - MaskC := Mask[Imask]; - if Ivalue > Length(Value) then - Exit; - c := Value[Ivalue]; - case MaskC of - 'n': - FileName := FileName + c; - 'v': - VMSFileName := VMSFileName + c; - '.': - begin - if c in ['.', ' '] then - FileName := TrimSP(FileName) + '.' - else - begin - Result := 0; - Exit; - end; - end; - 'D': - Day := Day + c; - 'M': - Month := Month + c; - 'T': - ThreeMonth := ThreeMonth + c; - 'U': - YearTime := YearTime + c; - 'Y': - Year := Year + c; - 'h': - Hours := Hours + c; - 'H': - HoursModif := HoursModif + c; - 'm': - Minutes := Minutes + c; - 's': - Seconds := Seconds + c; - 'S': - Size := Size + c; - 'p': - Permissions := Permissions + c; - 'd': - DirFlag := DirFlag + c; - 'x': - if c <> ' ' then - begin - Result := 0; - Exit; - end; - '*': - begin - s := ''; - if LastMaskC in ['n', 'v'] then - begin - if Imask = Length(Mask) then - s := Copy(Value, IValue, Maxint) - else - while IValue <= Length(Value) do - begin - if Value[Ivalue] = ' ' then - break; - s := s + Value[Ivalue]; - Inc(Ivalue); - end; - if LastMaskC = 'n' then - FileName := FileName + s - else - VMSFileName := VMSFileName + s; - end - else - begin - while IValue <= Length(Value) do - begin - if not(Value[Ivalue] in ['0'..'9']) then - break; - s := s + Value[Ivalue]; - Inc(Ivalue); - end; - case LastMaskC of - 'S': - Size := Size + s; - end; - end; - Dec(IValue); - end; - '!': - begin - while IValue <= Length(Value) do - begin - if Value[Ivalue] = ' ' then - break; - Inc(Ivalue); - end; - while IValue <= Length(Value) do - begin - if Value[Ivalue] <> ' ' then - break; - Inc(Ivalue); - end; - Dec(IValue); - end; - '$': - begin - while IValue <= Length(Value) do - begin - if not(Value[Ivalue] in [' ', #9]) then - break; - Inc(Ivalue); - end; - Dec(IValue); - end; - '=': - begin - s := ''; - case LastmaskC of - 'S': - begin - while Imask <= Length(Mask) do - begin - if not(Mask[Imask] in ['0'..'9']) then - break; - s := s + Mask[Imask]; - Inc(Imask); - end; - Dec(Imask); - BlockSize := s; - end; - 'T': - begin - Monthnames := Copy(Mask, IMask, 12 * 3); - Inc(IMask, 12 * 3); - end; - 'd': - begin - Inc(Imask); - DirFlagValue := Mask[Imask]; - end; - end; - end; - '\': - begin - Value := NextValue; - IValue := 0; - Result := 2; - end; - end; - Inc(Ivalue); - Inc(Imask); - LastMaskC := MaskC; - end; -end; - -function TFTPList.CheckValues: Boolean; -var - x, n: integer; -begin - Result := false; - if FileName <> '' then - begin - if pos('?', VMSFilename) > 0 then - Exit; - if pos('*', VMSFilename) > 0 then - Exit; - end; - if VMSFileName <> '' then - if pos(';', VMSFilename) <= 0 then - Exit; - if (FileName = '') and (VMSFileName = '') then - Exit; - if Permissions <> '' then - begin - if length(Permissions) <> 10 then - Exit; - for n := 1 to 10 do - if not(Permissions[n] in - ['a', 'b', 'c', 'd', 'h', 'l', 'p', 'r', 's', 't', 'w', 'x', 'y', '-']) then - Exit; - end; - if Day <> '' then - begin - Day := TrimSP(Day); - x := StrToIntDef(day, -1); - if (x < 1) or (x > 31) then - Exit; - end; - if Month <> '' then - begin - Month := TrimSP(Month); - x := StrToIntDef(Month, -1); - if (x < 1) or (x > 12) then - Exit; - end; - if Hours <> '' then - begin - Hours := TrimSP(Hours); - x := StrToIntDef(Hours, -1); - if (x < 0) or (x > 24) then - Exit; - end; - if HoursModif <> '' then - begin - if not (HoursModif[1] in ['a', 'A', 'p', 'P']) then - Exit; - end; - if Minutes <> '' then - begin - Minutes := TrimSP(Minutes); - x := StrToIntDef(Minutes, -1); - if (x < 0) or (x > 59) then - Exit; - end; - if Seconds <> '' then - begin - Seconds := TrimSP(Seconds); - x := StrToIntDef(Seconds, -1); - if (x < 0) or (x > 59) then - Exit; - end; - if Size <> '' then - begin - Size := TrimSP(Size); - for n := 1 to Length(Size) do - if not (Size[n] in ['0'..'9']) then - Exit; - end; - - if length(Monthnames) = (12 * 3) then - for n := 1 to 12 do - CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3); - if ThreeMonth <> '' then - begin - x := GetMonthNumber(ThreeMonth); - if (x = 0) then - Exit; - end; - if YearTime <> '' then - begin - YearTime := ReplaceString(YearTime, '-', ':'); - if pos(':', YearTime) > 0 then - begin - if (GetTimeFromstr(YearTime) = -1) then - Exit; - end - else - begin - YearTime := TrimSP(YearTime); - x := StrToIntDef(YearTime, -1); - if (x = -1) then - Exit; - if (x < 1900) or (x > 2100) then - Exit; - end; - end; - if Year <> '' then - begin - Year := TrimSP(Year); - x := StrToIntDef(Year, -1); - if (x = -1) then - Exit; - if Length(Year) = 4 then - begin - if not((x > 1900) and (x < 2100)) then - Exit; - end - else - if Length(Year) = 2 then - begin - if not((x >= 0) and (x <= 99)) then - Exit; - end - else - if Length(Year) = 3 then - begin - if not((x >= 100) and (x <= 110)) then - Exit; - end - else - Exit; - end; - Result := True; -end; - -procedure TFTPList.FillRecord(const Value: TFTPListRec); -var - s: string; - x: integer; - myear: Word; - mmonth: Word; - mday: Word; - mhours, mminutes, mseconds: word; - n: integer; -begin - s := DirFlagValue; - if s = '' then - s := 'D'; - s := Uppercase(s); - Value.Directory := s = Uppercase(DirFlag); - if FileName <> '' then - Value.FileName := SeparateLeft(Filename, ' -> '); - if VMSFileName <> '' then - begin - Value.FileName := VMSFilename; - Value.Directory := Pos('.DIR;',VMSFilename) > 0; - end; - Value.FileName := TrimSPRight(Value.FileName); - Value.Readable := not Value.Directory; - if BlockSize <> '' then - x := StrToIntDef(BlockSize, 1) - else - x := 1; - {$IFDEF VER100} - Value.FileSize := x * StrToIntDef(Size, 0); - {$ELSE} - Value.FileSize := x * StrToInt64Def(Size, 0); - {$ENDIF} - - DecodeDate(Date,myear,mmonth,mday); - mhours := 0; - mminutes := 0; - mseconds := 0; - - if Day <> '' then - mday := StrToIntDef(day, 1); - if Month <> '' then - mmonth := StrToIntDef(Month, 1); - if length(Monthnames) = (12 * 3) then - for n := 1 to 12 do - CustomMonthNames[n] := Copy(Monthnames, ((n - 1) * 3) + 1, 3); - if ThreeMonth <> '' then - mmonth := GetMonthNumber(ThreeMonth); - if Year <> '' then - begin - myear := StrToIntDef(Year, 0); - if (myear <= 99) and (myear > 50) then - myear := myear + 1900; - if myear <= 50 then - myear := myear + 2000; - end; - if YearTime <> '' then - begin - if pos(':', YearTime) > 0 then - begin - YearTime := TrimSP(YearTime); - mhours := StrToIntDef(Separateleft(YearTime, ':'), 0); - mminutes := StrToIntDef(SeparateRight(YearTime, ':'), 0); - if (Encodedate(myear, mmonth, mday) - + EncodeTime(mHours, mminutes, 0, 0)) > now then - Dec(mYear); - end - else - myear := StrToIntDef(YearTime, 0); - end; - if Minutes <> '' then - mminutes := StrToIntDef(Minutes, 0); - if Seconds <> '' then - mseconds := StrToIntDef(Seconds, 0); - if Hours <> '' then - begin - mHours := StrToIntDef(Hours, 0); - if HoursModif <> '' then - if Uppercase(HoursModif[1]) = 'P' then - if mHours <> 12 then - mHours := MHours + 12; - end; - Value.FileTime := Encodedate(myear, mmonth, mday) - + EncodeTime(mHours, mminutes, mseconds, 0); - if Permissions <> '' then - begin - Value.Permission := Permissions; - Value.Readable := Uppercase(permissions)[2] = 'R'; - if Uppercase(permissions)[1] = 'D' then - begin - Value.Directory := True; - Value.Readable := false; - end - else - if Uppercase(permissions)[1] = 'L' then - Value.Directory := True; - end; -end; - -function TFTPList.ParseEPLF(Value: string): Boolean; -var - s, os: string; - flr: TFTPListRec; -begin - Result := False; - if Value <> '' then - if Value[1] = '+' then - begin - os := Value; - Delete(Value, 1, 1); - flr := TFTPListRec.create; - flr.FileName := SeparateRight(Value, #9); - s := Fetch(Value, ','); - while s <> '' do - begin - if s[1] = #9 then - Break; - case s[1] of - '/': - flr.Directory := true; - 'r': - flr.Readable := true; - 's': - {$IFDEF VER100} - flr.FileSize := StrToIntDef(Copy(s, 2, Length(s) - 1), 0); - {$ELSE} - flr.FileSize := StrToInt64Def(Copy(s, 2, Length(s) - 1), 0); - {$ENDIF} - 'm': - flr.FileTime := (StrToIntDef(Copy(s, 2, Length(s) - 1), 0) / 86400) - + 25569; - end; - s := Fetch(Value, ','); - end; - if flr.FileName <> '' then - if (flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..'))) - or (flr.FileName = '') then - flr.free - else - begin - flr.OriginalLine := os; - flr.Mask := 'EPLF'; - Flist.Add(flr); - Result := True; - end; - end; -end; - -procedure TFTPList.ParseLines; -var - flr: TFTPListRec; - n, m: Integer; - S: string; - x: integer; - b: Boolean; -begin - n := 0; - while n < Lines.Count do - begin - if n = Lines.Count - 1 then - s := '' - else - s := Lines[n + 1]; - b := False; - x := 0; - if ParseEPLF(Lines[n]) then - begin - b := True; - x := 1; - end - else - for m := 0 to Masks.Count - 1 do - begin - x := ParseByMask(Lines[n], s, Masks[m]); - if x > 0 then - if CheckValues then - begin - flr := TFTPListRec.create; - FillRecord(flr); - flr.OriginalLine := Lines[n]; - flr.Mask := Masks[m]; - if flr.Directory and ((flr.FileName = '.') or (flr.FileName = '..')) then - flr.free - else - Flist.Add(flr); - b := True; - Break; - end; - end; - if not b then - FUnparsedLines.Add(Lines[n]); - Inc(n); - if x > 1 then - Inc(n, x - 1); - end; -end; - -{==============================================================================} - -function FtpGetFile(const IP, Port, FileName, LocalFile, - User, Pass: string): Boolean; -begin - Result := False; - with TFTPSend.Create do - try - if User <> '' then - begin - Username := User; - Password := Pass; - end; - TargetHost := IP; - TargetPort := Port; - if not Login then - Exit; - DirectFileName := LocalFile; - DirectFile:=True; - Result := RetrieveFile(FileName, False); - Logout; - finally - Free; - end; -end; - -function FtpPutFile(const IP, Port, FileName, LocalFile, - User, Pass: string): Boolean; -begin - Result := False; - with TFTPSend.Create do - try - if User <> '' then - begin - Username := User; - Password := Pass; - end; - TargetHost := IP; - TargetPort := Port; - if not Login then - Exit; - DirectFileName := LocalFile; - DirectFile:=True; - Result := StoreFile(FileName, False); - Logout; - finally - Free; - end; -end; - -function FtpInterServerTransfer( - const FromIP, FromPort, FromFile, FromUser, FromPass: string; - const ToIP, ToPort, ToFile, ToUser, ToPass: string): Boolean; -var - FromFTP, ToFTP: TFTPSend; - s: string; - x: integer; -begin - Result := False; - FromFTP := TFTPSend.Create; - toFTP := TFTPSend.Create; - try - if FromUser <> '' then - begin - FromFTP.Username := FromUser; - FromFTP.Password := FromPass; - end; - if ToUser <> '' then - begin - ToFTP.Username := ToUser; - ToFTP.Password := ToPass; - end; - FromFTP.TargetHost := FromIP; - FromFTP.TargetPort := FromPort; - ToFTP.TargetHost := ToIP; - ToFTP.TargetPort := ToPort; - if not FromFTP.Login then - Exit; - if not ToFTP.Login then - Exit; - if (FromFTP.FTPCommand('PASV') div 100) <> 2 then - Exit; - FromFTP.ParseRemote(FromFTP.ResultString); - s := ReplaceString(FromFTP.DataIP, '.', ','); - s := 'PORT ' + s + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) div 256) - + ',' + IntToStr(StrToIntDef(FromFTP.DataPort, 0) mod 256); - if (ToFTP.FTPCommand(s) div 100) <> 2 then - Exit; - x := ToFTP.FTPCommand('RETR ' + FromFile); - if (x div 100) <> 1 then - Exit; - x := FromFTP.FTPCommand('STOR ' + ToFile); - if (x div 100) <> 1 then - Exit; - FromFTP.Timeout := 21600000; - x := FromFTP.ReadResult; - if (x div 100) <> 2 then - Exit; - ToFTP.Timeout := 21600000; - x := ToFTP.ReadResult; - if (x div 100) <> 2 then - Exit; - Result := True; - finally - ToFTP.Free; - FromFTP.Free; - end; -end; - -end. diff --git a/3rd/synapse/source/ftptsend.pas b/3rd/synapse/source/ftptsend.pas deleted file mode 100644 index 6ab4173cd..000000000 --- a/3rd/synapse/source/ftptsend.pas +++ /dev/null @@ -1,403 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.001 | -|==============================================================================| -| Content: Trivial FTP (TFTP) client and server | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{: @abstract(TFTP client and server protocol) - -Used RFC: RFC-1350 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit ftptsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil; - -const - cTFTPProtocol = '69'; - - cTFTP_RRQ = word(1); - cTFTP_WRQ = word(2); - cTFTP_DTA = word(3); - cTFTP_ACK = word(4); - cTFTP_ERR = word(5); - -type - {:@abstract(Implementation of TFTP client and server) - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TTFTPSend = class(TSynaClient) - private - FSock: TUDPBlockSocket; - FErrorCode: integer; - FErrorString: string; - FData: TMemoryStream; - FRequestIP: string; - FRequestPort: string; - function SendPacket(Cmd: word; Serial: word; const Value: string): Boolean; - function RecvPacket(Serial: word; var Value: string): Boolean; - public - constructor Create; - destructor Destroy; override; - - {:Upload @link(data) as file to TFTP server.} - function SendFile(const Filename: string): Boolean; - - {:Download file from TFTP server to @link(data).} - function RecvFile(const Filename: string): Boolean; - - {:Acts as TFTP server and wait for client request. When some request - incoming within Timeout, result is @true and parametres is filled with - information from request. You must handle this request, validate it, and - call @link(ReplyError), @link(ReplyRecv) or @link(ReplySend) for send reply - to TFTP Client.} - function WaitForRequest(var Req: word; var filename: string): Boolean; - - {:send error to TFTP client, when you acts as TFTP server.} - procedure ReplyError(Error: word; Description: string); - - {:Accept uploaded file from TFTP client to @link(data), when you acts as - TFTP server.} - function ReplyRecv: Boolean; - - {:Accept download request file from TFTP client and send content of - @link(data), when you acts as TFTP server.} - function ReplySend: Boolean; - published - {:Code of TFTP error.} - property ErrorCode: integer read FErrorCode; - - {:Human readable decription of TFTP error. (if is sended by remote side)} - property ErrorString: string read FErrorString; - - {:MemoryStream with datas for sending or receiving} - property Data: TMemoryStream read FData; - - {:Address of TFTP remote side.} - property RequestIP: string read FRequestIP write FRequestIP; - - {:Port of TFTP remote side.} - property RequestPort: string read FRequestPort write FRequestPort; - end; - -implementation - -constructor TTFTPSend.Create; -begin - inherited Create; - FSock := TUDPBlockSocket.Create; - FSock.Owner := self; - FTargetPort := cTFTPProtocol; - FData := TMemoryStream.Create; - FErrorCode := 0; - FErrorString := ''; -end; - -destructor TTFTPSend.Destroy; -begin - FSock.Free; - FData.Free; - inherited Destroy; -end; - -function TTFTPSend.SendPacket(Cmd: word; Serial: word; const Value: string): Boolean; -var - s, sh: string; -begin - FErrorCode := 0; - FErrorString := ''; - Result := false; - if Cmd <> 2 then - s := CodeInt(Cmd) + CodeInt(Serial) + Value - else - s := CodeInt(Cmd) + Value; - FSock.SendString(s); - s := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - if length(s) >= 4 then - begin - sh := CodeInt(4) + CodeInt(Serial); - if Pos(sh, s) = 1 then - Result := True - else - if s[1] = #5 then - begin - FErrorCode := DecodeInt(s, 3); - Delete(s, 1, 4); - FErrorString := SeparateLeft(s, #0); - end; - end; -end; - -function TTFTPSend.RecvPacket(Serial: word; var Value: string): Boolean; -var - s: string; - ser: word; -begin - FErrorCode := 0; - FErrorString := ''; - Result := False; - Value := ''; - s := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - if length(s) >= 4 then - if DecodeInt(s, 1) = 3 then - begin - ser := DecodeInt(s, 3); - if ser = Serial then - begin - Delete(s, 1, 4); - Value := s; - S := CodeInt(4) + CodeInt(ser); - FSock.SendString(s); - Result := FSock.LastError = 0; - end - else - begin - S := CodeInt(5) + CodeInt(5) + 'Unexcepted serial#' + #0; - FSock.SendString(s); - end; - end; - if DecodeInt(s, 1) = 5 then - begin - FErrorCode := DecodeInt(s, 3); - Delete(s, 1, 4); - FErrorString := SeparateLeft(s, #0); - end; -end; - -function TTFTPSend.SendFile(const Filename: string): Boolean; -var - s: string; - ser: word; - n, n1, n2: integer; -begin - Result := False; - FErrorCode := 0; - FErrorString := ''; - FSock.CloseSocket; - FSock.Connect(FTargetHost, FTargetPort); - try - if FSock.LastError = 0 then - begin - s := Filename + #0 + 'octet' + #0; - if not Sendpacket(2, 0, s) then - Exit; - ser := 1; - FData.Position := 0; - n1 := FData.Size div 512; - n2 := FData.Size mod 512; - for n := 1 to n1 do - begin - s := ReadStrFromStream(FData, 512); -// SetLength(s, 512); -// FData.Read(pointer(s)^, 512); - if not Sendpacket(3, ser, s) then - Exit; - inc(ser); - end; - s := ReadStrFromStream(FData, n2); -// SetLength(s, n2); -// FData.Read(pointer(s)^, n2); - if not Sendpacket(3, ser, s) then - Exit; - Result := True; - end; - finally - FSock.CloseSocket; - end; -end; - -function TTFTPSend.RecvFile(const Filename: string): Boolean; -var - s: string; - ser: word; -begin - Result := False; - FErrorCode := 0; - FErrorString := ''; - FSock.CloseSocket; - FSock.Connect(FTargetHost, FTargetPort); - try - if FSock.LastError = 0 then - begin - s := CodeInt(1) + Filename + #0 + 'octet' + #0; - FSock.SendString(s); - if FSock.LastError <> 0 then - Exit; - FData.Clear; - ser := 1; - repeat - if not RecvPacket(ser, s) then - Exit; - inc(ser); - WriteStrToStream(FData, s); -// FData.Write(pointer(s)^, length(s)); - until length(s) <> 512; - FData.Position := 0; - Result := true; - end; - finally - FSock.CloseSocket; - end; -end; - -function TTFTPSend.WaitForRequest(var Req: word; var filename: string): Boolean; -var - s: string; -begin - Result := False; - FErrorCode := 0; - FErrorString := ''; - FSock.CloseSocket; - FSock.Bind('0.0.0.0', FTargetPort); - if FSock.LastError = 0 then - begin - s := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - if Length(s) >= 4 then - begin - FRequestIP := FSock.GetRemoteSinIP; - FRequestPort := IntToStr(FSock.GetRemoteSinPort); - Req := DecodeInt(s, 1); - delete(s, 1, 2); - filename := Trim(SeparateLeft(s, #0)); - s := SeparateRight(s, #0); - s := SeparateLeft(s, #0); - Result := lowercase(trim(s)) = 'octet'; - end; - end; -end; - -procedure TTFTPSend.ReplyError(Error: word; Description: string); -var - s: string; -begin - FSock.CloseSocket; - FSock.Connect(FRequestIP, FRequestPort); - s := CodeInt(5) + CodeInt(Error) + Description + #0; - FSock.SendString(s); - FSock.CloseSocket; -end; - -function TTFTPSend.ReplyRecv: Boolean; -var - s: string; - ser: integer; -begin - Result := False; - FErrorCode := 0; - FErrorString := ''; - FSock.CloseSocket; - FSock.Connect(FRequestIP, FRequestPort); - try - s := CodeInt(4) + CodeInt(0); - FSock.SendString(s); - FData.Clear; - ser := 1; - repeat - if not RecvPacket(ser, s) then - Exit; - inc(ser); - WriteStrToStream(FData, s); -// FData.Write(pointer(s)^, length(s)); - until length(s) <> 512; - FData.Position := 0; - Result := true; - finally - FSock.CloseSocket; - end; -end; - -function TTFTPSend.ReplySend: Boolean; -var - s: string; - ser: word; - n, n1, n2: integer; -begin - Result := False; - FErrorCode := 0; - FErrorString := ''; - FSock.CloseSocket; - FSock.Connect(FRequestIP, FRequestPort); - try - ser := 1; - FData.Position := 0; - n1 := FData.Size div 512; - n2 := FData.Size mod 512; - for n := 1 to n1 do - begin - s := ReadStrFromStream(FData, 512); -// SetLength(s, 512); -// FData.Read(pointer(s)^, 512); - if not Sendpacket(3, ser, s) then - Exit; - inc(ser); - end; - s := ReadStrFromStream(FData, n2); -// SetLength(s, n2); -// FData.Read(pointer(s)^, n2); - if not Sendpacket(3, ser, s) then - Exit; - Result := True; - finally - FSock.CloseSocket; - end; -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/httpsend.pas b/3rd/synapse/source/httpsend.pas deleted file mode 100644 index 695a00ac8..000000000 --- a/3rd/synapse/source/httpsend.pas +++ /dev/null @@ -1,848 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 003.012.008 | -|==============================================================================| -| Content: HTTP client | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(HTTP protocol client) - -Used RFC: RFC-1867, RFC-1947, RFC-2388, RFC-2616 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit httpsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, synaip, synacode, synsock; - -const - cHttpProtocol = '80'; - -type - {:These encoding types are used internally by the THTTPSend object to identify - the transfer data types.} - TTransferEncoding = (TE_UNKNOWN, TE_IDENTITY, TE_CHUNKED); - - {:abstract(Implementation of HTTP protocol.)} - THTTPSend = class(TSynaClient) - protected - FSock: TTCPBlockSocket; - FTransferEncoding: TTransferEncoding; - FAliveHost: string; - FAlivePort: string; - FHeaders: TStringList; - FDocument: TMemoryStream; - FMimeType: string; - FProtocol: string; - FKeepAlive: Boolean; - FKeepAliveTimeout: integer; - FStatus100: Boolean; - FProxyHost: string; - FProxyPort: string; - FProxyUser: string; - FProxyPass: string; - FResultCode: Integer; - FResultString: string; - FUserAgent: string; - FCookies: TStringList; - FDownloadSize: integer; - FUploadSize: integer; - FRangeStart: integer; - FRangeEnd: integer; - FAddPortNumberToHost: Boolean; - function ReadUnknown: Boolean; virtual; - function ReadIdentity(Size: Integer): Boolean; - function ReadChunked: Boolean; - procedure ParseCookies; - function PrepareHeaders: AnsiString; - function InternalDoConnect(needssl: Boolean): Boolean; - function InternalConnect(needssl: Boolean): Boolean; - public - constructor Create; - destructor Destroy; override; - - {:Reset headers, document and Mimetype.} - procedure Clear; - - {:Decode ResultCode and ResultString from Value.} - procedure DecodeStatus(const Value: string); - - {:Connects to host defined in URL and accesses resource defined in URL by - method. If Document is not empty, send it to the server as part of the HTTP - request. Server response is in Document and headers. Connection may be - authorised by username and password in URL. If you define proxy properties, - connection is made by this proxy. - If all OK, result is @true, else result is @false. - - If you use 'https:' instead of 'http:' in the URL, your request is made - by SSL/TLS connection (if you do not specify port, then port 443 is used - instead of standard port 80). If you use SSL/TLS request and you have - defined HTTP proxy, then HTTP-tunnel mode is automatically used .} - function HTTPMethod(const Method, URL: string): Boolean; - - {:You can call this method from OnStatus event to break current data - transfer. (or from another thread.)} - procedure Abort; - published - {:Before HTTP operation you may define any non-standard headers for HTTP - request, except: 'Expect: 100-continue', 'Content-Length', 'Content-Type', - 'Connection', 'Authorization', 'Proxy-Authorization' and 'Host' headers. - After HTTP operation, it contains full headers of the returned document.} - property Headers: TStringList read FHeaders; - - {:Stringlist with name-value stringlist pairs. Each pair is one cookie. - After the HTTP request is returned, cookies are parsed to this stringlist. - You can leave these cookies untouched for next HTTP requests. You can also - save this stringlist for later use.} - property Cookies: TStringList read FCookies; - - {:Stream with document to send (before request), or with document received - from HTTP server (after request).} - property Document: TMemoryStream read FDocument; - - {:If you need to download only part of a requested document, specify here - the position of subpart begin. If 0, the full document is requested.} - property RangeStart: integer read FRangeStart Write FRangeStart; - - {:If you need to download only part of a requested document, specify here - the position of subpart end. If 0, the document from rangeStart to end of - document is requested. - (Useful for resuming broken downloads, for example.)} - property RangeEnd: integer read FRangeEnd Write FRangeEnd; - - {:Mime type of sending data. Default is: 'text/html'.} - property MimeType: string read FMimeType Write FMimeType; - - {:Define protocol version. Possible values are: '1.1', '1.0' (default) - and '0.9'.} - property Protocol: string read FProtocol Write FProtocol; - - {:If @true (default value), keepalives in HTTP protocol 1.1 is enabled.} - property KeepAlive: Boolean read FKeepAlive Write FKeepAlive; - - {:Define timeout for keepalives in seconds!} - property KeepAliveTimeout: integer read FKeepAliveTimeout Write FKeepAliveTimeout; - - {:if @true, then the server is requested for 100status capability when - uploading data. Default is @false (off).} - property Status100: Boolean read FStatus100 Write FStatus100; - - {:Address of proxy server (IP address or domain name) where you want to - connect in @link(HTTPMethod) method.} - property ProxyHost: string read FProxyHost Write FProxyHost; - - {:Port number for proxy connection. Default value is 8080.} - property ProxyPort: string read FProxyPort Write FProxyPort; - - {:Username for connection to proxy server used in HTTPMethod method.} - property ProxyUser: string read FProxyUser Write FProxyUser; - - {:Password for connection to proxy server used in HTTPMethod method.} - property ProxyPass: string read FProxyPass Write FProxyPass; - - {:Here you can specify custom User-Agent identification. - Default: 'Mozilla/4.0 (compatible; Synapse)'} - property UserAgent: string read FUserAgent Write FUserAgent; - - {:Operation result code after successful @link(HTTPMethod) method.} - property ResultCode: Integer read FResultCode; - - {:Operation result string after successful @link(HTTPMethod) method.} - property ResultString: string read FResultString; - - {:if this value is not 0, then data download is pending. In this case you - have here the total size of downloaded data. Useful for drawing download - progressbar from OnStatus event.} - property DownloadSize: integer read FDownloadSize; - - {:if this value is not 0, then data upload is pending. In this case you have - here the total size of uploaded data. Useful for drawing upload progressbar - from OnStatus event.} - property UploadSize: integer read FUploadSize; - - {:Socket object used for TCP/IP operation. - Good for setting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - - {:Allows to switch off port number in 'Host:' HTTP header. By default @TRUE. - Some buggy servers do not like port informations in this header.} - property AddPortNumberToHost: Boolean read FAddPortNumberToHost write FAddPortNumberToHost; - end; - -{:A very useful function, and example of use can be found in the THTTPSend - object. It implements the GET method of the HTTP protocol. This function sends - the GET method for URL document to an HTTP server. Returned document is in the - "Response" stringlist (without any headers). Returns boolean TRUE if all went - well.} -function HttpGetText(const URL: string; const Response: TStrings): Boolean; - -{:A very useful function, and example of use can be found in the THTTPSend - object. It implements the GET method of the HTTP protocol. This function sends - the GET method for URL document to an HTTP server. Returned document is in the - "Response" stream. Returns boolean TRUE if all went well.} -function HttpGetBinary(const URL: string; const Response: TStream): Boolean; - -{:A very useful function, and example of use can be found in the THTTPSend - object. It implements the POST method of the HTTP protocol. This function sends - the SEND method for a URL document to an HTTP server. The document to be sent - is located in the "Data" stream. The returned document is in the "Data" stream. - Returns boolean TRUE if all went well.} -function HttpPostBinary(const URL: string; const Data: TStream): Boolean; - -{:A very useful function, and example of use can be found in the THTTPSend - object. It implements the POST method of the HTTP protocol. This function is - good for POSTing form data. It sends the POST method for a URL document to - an HTTP server. You must prepare the form data in the same manner as you would - the URL data, and pass this prepared data to "URLdata". The following is - a sample of how the data would appear: 'name=Lukas&field1=some%20data'. - The information in the field must be encoded by the EncodeURLElement function. - The returned document is in the "Data" stream. Returns boolean TRUE if all - went well.} -function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean; - -{:A very useful function, and example of use can be found in the THTTPSend - object. It implements the POST method of the HTTP protocol. This function sends - the POST method for a URL document to an HTTP server. This function simulates - posting of file by HTML form using the 'multipart/form-data' method. The posted - file is in the DATA stream. Its name is Filename string. Fieldname is for the - name of the form field with the file. (simulates HTML INPUT FILE) The returned - document is in the ResultData Stringlist. Returns boolean TRUE if all - went well.} -function HttpPostFile(const URL, FieldName, FileName: string; - const Data: TStream; const ResultData: TStrings): Boolean; - -implementation - -constructor THTTPSend.Create; -begin - inherited Create; - FHeaders := TStringList.Create; - FCookies := TStringList.Create; - FDocument := TMemoryStream.Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.ConvertLineEnd := True; - FSock.SizeRecvBuffer := c64k; - FSock.SizeSendBuffer := c64k; - FTimeout := 90000; - FTargetPort := cHttpProtocol; - FProxyHost := ''; - FProxyPort := '8080'; - FProxyUser := ''; - FProxyPass := ''; - FAliveHost := ''; - FAlivePort := ''; - FProtocol := '1.0'; - FKeepAlive := True; - FStatus100 := False; - FUserAgent := 'Mozilla/4.0 (compatible; Synapse)'; - FDownloadSize := 0; - FUploadSize := 0; - FAddPortNumberToHost := true; - FKeepAliveTimeout := 300; - Clear; -end; - -destructor THTTPSend.Destroy; -begin - FSock.Free; - FDocument.Free; - FCookies.Free; - FHeaders.Free; - inherited Destroy; -end; - -procedure THTTPSend.Clear; -begin - FRangeStart := 0; - FRangeEnd := 0; - FDocument.Clear; - FHeaders.Clear; - FMimeType := 'text/html'; -end; - -procedure THTTPSend.DecodeStatus(const Value: string); -var - s, su: string; -begin - s := Trim(SeparateRight(Value, ' ')); - su := Trim(SeparateLeft(s, ' ')); - FResultCode := StrToIntDef(su, 0); - FResultString := Trim(SeparateRight(s, ' ')); - if FResultString = s then - FResultString := ''; -end; - -function THTTPSend.PrepareHeaders: AnsiString; -begin - if FProtocol = '0.9' then - Result := FHeaders[0] + CRLF - else -{$IFNDEF MSWINDOWS} - Result := {$IFDEF UNICODE}AnsiString{$ENDIF}(AdjustLineBreaks(FHeaders.Text, tlbsCRLF)); -{$ELSE} - Result := FHeaders.Text; -{$ENDIF} -end; - -function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean; -begin - Result := False; - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError <> 0 then - Exit; - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError <> 0 then - Exit; - if needssl then - begin - if (FSock.SSL.SNIHost='') then - FSock.SSL.SNIHost:=FTargetHost; - FSock.SSLDoConnect; - FSock.SSL.SNIHost:=''; //don't need it anymore and don't wan't to reuse it in next connection - if FSock.LastError <> 0 then - Exit; - end; - FAliveHost := FTargetHost; - FAlivePort := FTargetPort; - Result := True; -end; - -function THTTPSend.InternalConnect(needssl: Boolean): Boolean; -begin - if FSock.Socket = INVALID_SOCKET then - Result := InternalDoConnect(needssl) - else - if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) - or FSock.CanRead(0) then - Result := InternalDoConnect(needssl) - else - Result := True; -end; - -function THTTPSend.HTTPMethod(const Method, URL: string): Boolean; -var - Sending, Receiving: Boolean; - status100: Boolean; - status100error: string; - ToClose: Boolean; - Size: Integer; - Prot, User, Pass, Host, Port, Path, Para, URI: string; - s, su: AnsiString; - HttpTunnel: Boolean; - n: integer; - pp: string; - UsingProxy: boolean; - l: TStringList; - x: integer; -begin - {initial values} - Result := False; - FResultCode := 500; - FResultString := ''; - FDownloadSize := 0; - FUploadSize := 0; - - URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para); - User := DecodeURL(user); - Pass := DecodeURL(pass); - if User = '' then - begin - User := FUsername; - Pass := FPassword; - end; - if UpperCase(Prot) = 'HTTPS' then - begin - HttpTunnel := FProxyHost <> ''; - FSock.HTTPTunnelIP := FProxyHost; - FSock.HTTPTunnelPort := FProxyPort; - FSock.HTTPTunnelUser := FProxyUser; - FSock.HTTPTunnelPass := FProxyPass; - end - else - begin - HttpTunnel := False; - FSock.HTTPTunnelIP := ''; - FSock.HTTPTunnelPort := ''; - FSock.HTTPTunnelUser := ''; - FSock.HTTPTunnelPass := ''; - end; - UsingProxy := (FProxyHost <> '') and not(HttpTunnel); - Sending := FDocument.Size > 0; - {Headers for Sending data} - status100 := FStatus100 and Sending and (FProtocol = '1.1'); - if status100 then - FHeaders.Insert(0, 'Expect: 100-continue'); - if Sending then - begin - FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size)); - if FMimeType <> '' then - FHeaders.Insert(0, 'Content-Type: ' + FMimeType); - end; - { setting User-agent } - if FUserAgent <> '' then - FHeaders.Insert(0, 'User-Agent: ' + FUserAgent); - { setting Ranges } - if (FRangeStart > 0) or (FRangeEnd > 0) then - begin - if FRangeEnd >= FRangeStart then - FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-' + IntToStr(FRangeEnd)) - else - FHeaders.Insert(0, 'Range: bytes=' + IntToStr(FRangeStart) + '-'); - end; - { setting Cookies } - s := ''; - for n := 0 to FCookies.Count - 1 do - begin - if s <> '' then - s := s + '; '; - s := s + FCookies[n]; - end; - if s <> '' then - FHeaders.Insert(0, 'Cookie: ' + s); - { setting KeepAlives } - pp := ''; - if UsingProxy then - pp := 'Proxy-'; - if FKeepAlive then - begin - FHeaders.Insert(0, pp + 'Connection: keep-alive'); - FHeaders.Insert(0, 'Keep-Alive: ' + IntToStr(FKeepAliveTimeout)); - end - else - FHeaders.Insert(0, pp + 'Connection: close'); - { set target servers/proxy, authorizations, etc... } - if User <> '' then - FHeaders.Insert(0, 'Authorization: Basic ' + EncodeBase64(User + ':' + Pass)); - if UsingProxy and (FProxyUser <> '') then - FHeaders.Insert(0, 'Proxy-Authorization: Basic ' + - EncodeBase64(FProxyUser + ':' + FProxyPass)); - if isIP6(Host) then - s := '[' + Host + ']' - else - s := Host; - if FAddPortNumberToHost - and (((Port <> '80') and (UpperCase(Prot) = 'HTTP')) - or ((Port <> '443') and (UpperCase(Prot) = 'HTTPS'))) then - FHeaders.Insert(0, 'Host: ' + s + ':' + Port) - else - FHeaders.Insert(0, 'Host: ' + s); - if UsingProxy then - URI := Prot + '://' + s + ':' + Port + URI; - if URI = '/*' then - URI := '*'; - if FProtocol = '0.9' then - FHeaders.Insert(0, UpperCase(Method) + ' ' + URI) - else - FHeaders.Insert(0, UpperCase(Method) + ' ' + URI + ' HTTP/' + FProtocol); - if UsingProxy then - begin - FTargetHost := FProxyHost; - FTargetPort := FProxyPort; - end - else - begin - FTargetHost := Host; - FTargetPort := Port; - end; - if FHeaders[FHeaders.Count - 1] <> '' then - FHeaders.Add(''); - - { connect } - if not InternalConnect(UpperCase(Prot) = 'HTTPS') then - begin - FAliveHost := ''; - FAlivePort := ''; - Exit; - end; - - { reading Status } - FDocument.Position := 0; - Status100Error := ''; - if status100 then - begin - { send Headers } - FSock.SendString(PrepareHeaders); - if FSock.LastError <> 0 then - Exit; - repeat - s := FSock.RecvString(FTimeout); - if s <> '' then - Break; - until FSock.LastError <> 0; - DecodeStatus(s); - Status100Error := s; - repeat - s := FSock.recvstring(FTimeout); - if s = '' then - Break; - until FSock.LastError <> 0; - if (FResultCode >= 100) and (FResultCode < 200) then - begin - { we can upload content } - Status100Error := ''; - FUploadSize := FDocument.Size; - FSock.SendBuffer(FDocument.Memory, FDocument.Size); - end; - end - else - { upload content } - if sending then - begin - if FDocument.Size >= c64k then - begin - FSock.SendString(PrepareHeaders); - FUploadSize := FDocument.Size; - FSock.SendBuffer(FDocument.Memory, FDocument.Size); - end - else - begin - s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size); - FUploadSize := Length(s); - FSock.SendString(s); - end; - end - else - begin - { we not need to upload document, send headers only } - FSock.SendString(PrepareHeaders); - end; - - if FSock.LastError <> 0 then - Exit; - - Clear; - Size := -1; - FTransferEncoding := TE_UNKNOWN; - - { read status } - if Status100Error = '' then - begin - repeat - repeat - s := FSock.RecvString(FTimeout); - if s <> '' then - Break; - until FSock.LastError <> 0; - if Pos('HTTP/', UpperCase(s)) = 1 then - begin - FHeaders.Add(s); - DecodeStatus(s); - end - else - begin - { old HTTP 0.9 and some buggy servers not send result } - s := s + CRLF; - WriteStrToStream(FDocument, s); - FResultCode := 0; - end; - until (FSock.LastError <> 0) or (FResultCode <> 100); - end - else - FHeaders.Add(Status100Error); - - { if need receive headers, receive and parse it } - ToClose := FProtocol <> '1.1'; - if FHeaders.Count > 0 then - begin - l := TStringList.Create; - try - repeat - s := FSock.RecvString(FTimeout); - l.Add(s); - if s = '' then - Break; - until FSock.LastError <> 0; - x := 0; - while l.Count > x do - begin - s := NormalizeHeader(l, x); - FHeaders.Add(s); - su := UpperCase(s); - if Pos('CONTENT-LENGTH:', su) = 1 then - begin - Size := StrToIntDef(Trim(SeparateRight(s, ':')), -1); - if (Size <> -1) and (FTransferEncoding = TE_UNKNOWN) then - FTransferEncoding := TE_IDENTITY; - end; - if Pos('CONTENT-TYPE:', su) = 1 then - FMimeType := Trim(SeparateRight(s, ':')); - if Pos('TRANSFER-ENCODING:', su) = 1 then - begin - s := Trim(SeparateRight(su, ':')); - if Pos('CHUNKED', s) > 0 then - FTransferEncoding := TE_CHUNKED; - end; - if UsingProxy then - begin - if Pos('PROXY-CONNECTION:', su) = 1 then - if Pos('CLOSE', su) > 0 then - ToClose := True; - end - else - begin - if Pos('CONNECTION:', su) = 1 then - if Pos('CLOSE', su) > 0 then - ToClose := True; - end; - end; - finally - l.free; - end; - end; - - Result := FSock.LastError = 0; - if not Result then - Exit; - - {if need receive response body, read it} - Receiving := Method <> 'HEAD'; - Receiving := Receiving and (FResultCode <> 204); - Receiving := Receiving and (FResultCode <> 304); - if Receiving then - case FTransferEncoding of - TE_UNKNOWN: - Result := ReadUnknown; - TE_IDENTITY: - Result := ReadIdentity(Size); - TE_CHUNKED: - Result := ReadChunked; - end; - - FDocument.Seek(0, soFromBeginning); - if ToClose then - begin - FSock.CloseSocket; - FAliveHost := ''; - FAlivePort := ''; - end; - ParseCookies; -end; - -function THTTPSend.ReadUnknown: Boolean; -var - s: ansistring; -begin - Result := false; - repeat - s := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - WriteStrToStream(FDocument, s); - until FSock.LastError <> 0; - if FSock.LastError = WSAECONNRESET then - begin - Result := true; - FSock.ResetLastError; - end; -end; - -function THTTPSend.ReadIdentity(Size: Integer): Boolean; -begin - if Size > 0 then - begin - FDownloadSize := Size; - FSock.RecvStreamSize(FDocument, FTimeout, Size); - FDocument.Position := FDocument.Size; - Result := FSock.LastError = 0; - end - else - Result := true; -end; - -function THTTPSend.ReadChunked: Boolean; -var - s: ansistring; - Size: Integer; -begin - repeat - repeat - s := FSock.RecvString(FTimeout); - until (s <> '') or (FSock.LastError <> 0); - if FSock.LastError <> 0 then - Break; - s := Trim(SeparateLeft(s, ' ')); - s := Trim(SeparateLeft(s, ';')); - Size := StrToIntDef('$' + s, 0); - if Size = 0 then - Break; - if not ReadIdentity(Size) then - break; - until False; - Result := FSock.LastError = 0; -end; - -procedure THTTPSend.ParseCookies; -var - n: integer; - s: string; - sn, sv: string; -begin - for n := 0 to FHeaders.Count - 1 do - if Pos('set-cookie:', lowercase(FHeaders[n])) = 1 then - begin - s := SeparateRight(FHeaders[n], ':'); - s := trim(SeparateLeft(s, ';')); - sn := trim(SeparateLeft(s, '=')); - sv := trim(SeparateRight(s, '=')); - FCookies.Values[sn] := sv; - end; -end; - -procedure THTTPSend.Abort; -begin - FSock.StopFlag := True; -end; - -{==============================================================================} - -function HttpGetText(const URL: string; const Response: TStrings): Boolean; -var - HTTP: THTTPSend; -begin - HTTP := THTTPSend.Create; - try - Result := HTTP.HTTPMethod('GET', URL); - if Result then - Response.LoadFromStream(HTTP.Document); - finally - HTTP.Free; - end; -end; - -function HttpGetBinary(const URL: string; const Response: TStream): Boolean; -var - HTTP: THTTPSend; -begin - HTTP := THTTPSend.Create; - try - Result := HTTP.HTTPMethod('GET', URL); - if Result then - begin - Response.Seek(0, soFromBeginning); - Response.CopyFrom(HTTP.Document, 0); - end; - finally - HTTP.Free; - end; -end; - -function HttpPostBinary(const URL: string; const Data: TStream): Boolean; -var - HTTP: THTTPSend; -begin - HTTP := THTTPSend.Create; - try - HTTP.Document.CopyFrom(Data, 0); - HTTP.MimeType := 'Application/octet-stream'; - Result := HTTP.HTTPMethod('POST', URL); - Data.Size := 0; - if Result then - begin - Data.Seek(0, soFromBeginning); - Data.CopyFrom(HTTP.Document, 0); - end; - finally - HTTP.Free; - end; -end; - -function HttpPostURL(const URL, URLData: string; const Data: TStream): Boolean; -var - HTTP: THTTPSend; -begin - HTTP := THTTPSend.Create; - try - WriteStrToStream(HTTP.Document, URLData); - HTTP.MimeType := 'application/x-www-form-urlencoded'; - Result := HTTP.HTTPMethod('POST', URL); - if Result then - Data.CopyFrom(HTTP.Document, 0); - finally - HTTP.Free; - end; -end; - -function HttpPostFile(const URL, FieldName, FileName: string; - const Data: TStream; const ResultData: TStrings): Boolean; -var - HTTP: THTTPSend; - Bound, s: string; -begin - Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary'; - HTTP := THTTPSend.Create; - try - s := '--' + Bound + CRLF; - s := s + 'content-disposition: form-data; name="' + FieldName + '";'; - s := s + ' filename="' + FileName +'"' + CRLF; - s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF; - WriteStrToStream(HTTP.Document, s); - HTTP.Document.CopyFrom(Data, 0); - s := CRLF + '--' + Bound + '--' + CRLF; - WriteStrToStream(HTTP.Document, s); - HTTP.MimeType := 'multipart/form-data; boundary=' + Bound; - Result := HTTP.HTTPMethod('POST', URL); - if Result then - ResultData.LoadFromStream(HTTP.Document); - finally - HTTP.Free; - end; -end; - -end. diff --git a/3rd/synapse/source/imapsend.pas b/3rd/synapse/source/imapsend.pas deleted file mode 100644 index 85ac3fa23..000000000 --- a/3rd/synapse/source/imapsend.pas +++ /dev/null @@ -1,869 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.005.003 | -|==============================================================================| -| Content: IMAP4rev1 client | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2001-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(IMAP4 rev1 protocol client) - -Used RFC: RFC-2060, RFC-2595 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit imapsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil; - -const - cIMAPProtocol = '143'; - -type - {:@abstract(Implementation of IMAP4 protocol.) - Note: Are you missing properties for setting Username and Password? Look to - parent @link(TSynaClient) object! - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TIMAPSend = class(TSynaClient) - protected - FSock: TTCPBlockSocket; - FTagCommand: integer; - FResultString: string; - FFullResult: TStringList; - FIMAPcap: TStringList; - FAuthDone: Boolean; - FSelectedFolder: string; - FSelectedCount: integer; - FSelectedRecent: integer; - FSelectedUIDvalidity: integer; - FUID: Boolean; - FAutoTLS: Boolean; - FFullSSL: Boolean; - function ReadResult: string; - function AuthLogin: Boolean; - function Connect: Boolean; - procedure ParseMess(Value:TStrings); - procedure ParseFolderList(Value:TStrings); - procedure ParseSelect; - procedure ParseSearch(Value:TStrings); - procedure ProcessLiterals; - public - constructor Create; - destructor Destroy; override; - - {:By this function you can call any IMAP command. Result of this command is - in adequate properties.} - function IMAPcommand(Value: string): string; - - {:By this function you can call any IMAP command what need upload any data. - Result of this command is in adequate properties.} - function IMAPuploadCommand(Value: string; const Data:TStrings): string; - - {:Call CAPABILITY command and fill IMAPcap property by new values.} - function Capability: Boolean; - - {:Connect to IMAP server and do login to this server. This command begin - session.} - function Login: Boolean; - - {:Disconnect from IMAP server and terminate session session. If exists some - deleted and non-purged messages, these messages are not deleted!} - function Logout: Boolean; - - {:Do NOOP. It is for prevent disconnect by timeout.} - function NoOp: Boolean; - - {:Lists folder names. You may specify level of listing. If you specify - FromFolder as empty string, return is all folders in system.} - function List(FromFolder: string; const FolderList: TStrings): Boolean; - - {:Lists folder names what match search criteria. You may specify level of - listing. If you specify FromFolder as empty string, return is all folders - in system.} - function ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean; - - {:Lists subscribed folder names. You may specify level of listing. If you - specify FromFolder as empty string, return is all subscribed folders in - system.} - function ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean; - - {:Lists subscribed folder names what matching search criteria. You may - specify level of listing. If you specify FromFolder as empty string, return - is all subscribed folders in system.} - function ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean; - - {:Create a new folder.} - function CreateFolder(FolderName: string): Boolean; - - {:Delete a folder.} - function DeleteFolder(FolderName: string): Boolean; - - {:Rename folder names.} - function RenameFolder(FolderName, NewFolderName: string): Boolean; - - {:Subscribe folder.} - function SubscribeFolder(FolderName: string): Boolean; - - {:Unsubscribe folder.} - function UnsubscribeFolder(FolderName: string): Boolean; - - {:Select folder.} - function SelectFolder(FolderName: string): Boolean; - - {:Select folder, but only for reading. Any changes are not allowed!} - function SelectROFolder(FolderName: string): Boolean; - - {:Close a folder. (end of Selected state)} - function CloseFolder: Boolean; - - {:Ask for given status of folder. I.e. if you specify as value 'UNSEEN', - result is number of unseen messages in folder. For another status - indentificator check IMAP documentation and documentation of your IMAP - server (each IMAP server can have their own statuses.)} - function StatusFolder(FolderName, Value: string): integer; - - {:Hardly delete all messages marked as 'deleted' in current selected folder.} - function ExpungeFolder: Boolean; - - {:Touch to folder. (use as update status of folder, etc.)} - function CheckFolder: Boolean; - - {:Append given message to specified folder.} - function AppendMess(ToFolder: string; const Mess: TStrings): Boolean; - - {:'Delete' message from current selected folder. It mark message as Deleted. - Real deleting will be done after sucessfull @link(CloseFolder) or - @link(ExpungeFolder)} - function DeleteMess(MessID: integer): boolean; - - {:Get full message from specified message in selected folder.} - function FetchMess(MessID: integer; const Mess: TStrings): Boolean; - - {:Get message headers only from specified message in selected folder.} - function FetchHeader(MessID: integer; const Headers: TStrings): Boolean; - - {:Return message size of specified message from current selected folder.} - function MessageSize(MessID: integer): integer; - - {:Copy message from current selected folder to another folder.} - function CopyMess(MessID: integer; ToFolder: string): Boolean; - - {:Return message numbers from currently selected folder as result - of searching. Search criteria is very complex language (see to IMAP - specification) similar to SQL (but not same syntax!).} - function SearchMess(Criteria: string; const FoundMess: TStrings): Boolean; - - {:Sets flags of message from current selected folder.} - function SetFlagsMess(MessID: integer; Flags: string): Boolean; - - {:Gets flags of message from current selected folder.} - function GetFlagsMess(MessID: integer; var Flags: string): Boolean; - - {:Add flags to message's flags.} - function AddFlagsMess(MessID: integer; Flags: string): Boolean; - - {:Remove flags from message's flags.} - function DelFlagsMess(MessID: integer; Flags: string): Boolean; - - {:Call STARTTLS command for upgrade connection to SSL/TLS mode.} - function StartTLS: Boolean; - - {:return UID of requested message ID.} - function GetUID(MessID: integer; var UID : Integer): Boolean; - - {:Try to find given capabily in capabilty string returned from IMAP server.} - function FindCap(const Value: string): string; - published - {:Status line with result of last operation.} - property ResultString: string read FResultString; - - {:Full result of last IMAP operation.} - property FullResult: TStringList read FFullResult; - - {:List of server capabilites.} - property IMAPcap: TStringList read FIMAPcap; - - {:Authorization is successful done.} - property AuthDone: Boolean read FAuthDone; - - {:Turn on or off usage of UID (unicate identificator) of messages instead - only sequence numbers.} - property UID: Boolean read FUID Write FUID; - - {:Name of currently selected folder.} - property SelectedFolder: string read FSelectedFolder; - - {:Count of messages in currently selected folder.} - property SelectedCount: integer read FSelectedCount; - - {:Count of not-visited messages in currently selected folder.} - property SelectedRecent: integer read FSelectedRecent; - - {:This number with name of folder is unique indentificator of folder. - (If someone delete folder and next create new folder with exactly same name - of folder, this number is must be different!)} - property SelectedUIDvalidity: integer read FSelectedUIDvalidity; - - {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:SSL/TLS mode is used from first contact to server. Servers with full - SSL/TLS mode usualy using non-standard TCP port!} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - end; - -implementation - -constructor TIMAPSend.Create; -begin - inherited Create; - FFullResult := TStringList.Create; - FIMAPcap := TStringList.Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.ConvertLineEnd := True; - FSock.SizeRecvBuffer := 32768; - FSock.SizeSendBuffer := 32768; - FTimeout := 60000; - FTargetPort := cIMAPProtocol; - FTagCommand := 0; - FSelectedFolder := ''; - FSelectedCount := 0; - FSelectedRecent := 0; - FSelectedUIDvalidity := 0; - FUID := False; - FAutoTLS := False; - FFullSSL := False; -end; - -destructor TIMAPSend.Destroy; -begin - FSock.Free; - FIMAPcap.Free; - FFullResult.Free; - inherited Destroy; -end; - - -function TIMAPSend.ReadResult: string; -var - s: string; - x, l: integer; -begin - Result := ''; - FFullResult.Clear; - FResultString := ''; - repeat - s := FSock.RecvString(FTimeout); - if Pos('S' + IntToStr(FTagCommand) + ' ', s) = 1 then - begin - FResultString := s; - break; - end - else - FFullResult.Add(s); - if (s <> '') and (s[Length(s)]='}') then - begin - s := Copy(s, 1, Length(s) - 1); - x := RPos('{', s); - s := Copy(s, x + 1, Length(s) - x); - l := StrToIntDef(s, -1); - if l <> -1 then - begin - s := FSock.RecvBufferStr(l, FTimeout); - FFullResult.Add(s); - end; - end; - until FSock.LastError <> 0; - s := Trim(separateright(FResultString, ' ')); - Result:=uppercase(Trim(separateleft(s, ' '))); -end; - -procedure TIMAPSend.ProcessLiterals; -var - l: TStringList; - n, x: integer; - b: integer; - s: string; -begin - l := TStringList.Create; - try - l.Assign(FFullResult); - FFullResult.Clear; - b := 0; - for n := 0 to l.Count - 1 do - begin - s := l[n]; - if b > 0 then - begin - FFullResult[FFullresult.Count - 1] := - FFullResult[FFullresult.Count - 1] + s; - inc(b); - if b > 2 then - b := 0; - end - else - begin - if (s <> '') and (s[Length(s)]='}') then - begin - x := RPos('{', s); - Delete(s, x, Length(s) - x + 1); - b := 1; - end - else - b := 0; - FFullResult.Add(s); - end; - end; - finally - l.Free; - end; -end; - -function TIMAPSend.IMAPcommand(Value: string): string; -begin - Inc(FTagCommand); - FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + CRLF); - Result := ReadResult; -end; - -function TIMAPSend.IMAPuploadCommand(Value: string; const Data:TStrings): string; -var - l: integer; -begin - Inc(FTagCommand); - l := Length(Data.Text); - FSock.SendString('S' + IntToStr(FTagCommand) + ' ' + Value + ' {'+ IntToStr(l) + '}' + CRLF); - FSock.RecvString(FTimeout); - FSock.SendString(Data.Text + CRLF); - Result := ReadResult; -end; - -procedure TIMAPSend.ParseMess(Value:TStrings); -var - n: integer; -begin - Value.Clear; - for n := 0 to FFullResult.Count - 2 do - if (length(FFullResult[n]) > 0) and (FFullResult[n][Length(FFullResult[n])] = '}') then - begin - Value.Text := FFullResult[n + 1]; - Break; - end; -end; - -procedure TIMAPSend.ParseFolderList(Value:TStrings); -var - n, x: integer; - s: string; -begin - ProcessLiterals; - Value.Clear; - for n := 0 to FFullResult.Count - 1 do - begin - s := FFullResult[n]; - if (s <> '') and (Pos('\NOSELECT', UpperCase(s)) = 0) then - begin - if s[Length(s)] = '"' then - begin - Delete(s, Length(s), 1); - x := RPos('"', s); - end - else - x := RPos(' ', s); - if (x > 0) then - Value.Add(Copy(s, x + 1, Length(s) - x)); - end; - end; -end; - -procedure TIMAPSend.ParseSelect; -var - n: integer; - s, t: string; -begin - ProcessLiterals; - FSelectedCount := 0; - FSelectedRecent := 0; - FSelectedUIDvalidity := 0; - for n := 0 to FFullResult.Count - 1 do - begin - s := uppercase(FFullResult[n]); - if Pos(' EXISTS', s) > 0 then - begin - t := Trim(separateleft(s, ' EXISTS')); - t := Trim(separateright(t, '* ')); - FSelectedCount := StrToIntDef(t, 0); - end; - if Pos(' RECENT', s) > 0 then - begin - t := Trim(separateleft(s, ' RECENT')); - t := Trim(separateright(t, '* ')); - FSelectedRecent := StrToIntDef(t, 0); - end; - if Pos('UIDVALIDITY', s) > 0 then - begin - t := Trim(separateright(s, 'UIDVALIDITY ')); - t := Trim(separateleft(t, ']')); - FSelectedUIDvalidity := StrToIntDef(t, 0); - end; - end; -end; - -procedure TIMAPSend.ParseSearch(Value:TStrings); -var - n: integer; - s: string; -begin - ProcessLiterals; - Value.Clear; - for n := 0 to FFullResult.Count - 1 do - begin - s := uppercase(FFullResult[n]); - if Pos('* SEARCH', s) = 1 then - begin - s := Trim(SeparateRight(s, '* SEARCH')); - while s <> '' do - Value.Add(Fetch(s, ' ')); - end; - end; -end; - -function TIMAPSend.FindCap(const Value: string): string; -var - n: Integer; - s: string; -begin - s := UpperCase(Value); - Result := ''; - for n := 0 to FIMAPcap.Count - 1 do - if Pos(s, UpperCase(FIMAPcap[n])) = 1 then - begin - Result := FIMAPcap[n]; - Break; - end; -end; - -function TIMAPSend.AuthLogin: Boolean; -begin - Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK'; -end; - -function TIMAPSend.Connect: Boolean; -begin - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TIMAPSend.Capability: Boolean; -var - n: Integer; - s, t: string; -begin - Result := False; - FIMAPcap.Clear; - s := IMAPcommand('CAPABILITY'); - if s = 'OK' then - begin - ProcessLiterals; - for n := 0 to FFullResult.Count - 1 do - if Pos('* CAPABILITY ', FFullResult[n]) = 1 then - begin - s := Trim(SeparateRight(FFullResult[n], '* CAPABILITY ')); - while not (s = '') do - begin - t := Trim(separateleft(s, ' ')); - s := Trim(separateright(s, ' ')); - if s = t then - s := ''; - FIMAPcap.Add(t); - end; - end; - Result := True; - end; -end; - -function TIMAPSend.Login: Boolean; -var - s: string; -begin - FSelectedFolder := ''; - FSelectedCount := 0; - FSelectedRecent := 0; - FSelectedUIDvalidity := 0; - Result := False; - FAuthDone := False; - if not Connect then - Exit; - s := FSock.RecvString(FTimeout); - if Pos('* PREAUTH', s) = 1 then - FAuthDone := True - else - if Pos('* OK', s) = 1 then - FAuthDone := False - else - Exit; - if Capability then - begin - if Findcap('IMAP4rev1') = '' then - Exit; - if FAutoTLS and (Findcap('STARTTLS') <> '') then - if StartTLS then - Capability; - end; - Result := AuthLogin; -end; - -function TIMAPSend.Logout: Boolean; -begin - Result := IMAPcommand('LOGOUT') = 'OK'; - FSelectedFolder := ''; - FSock.CloseSocket; -end; - -function TIMAPSend.NoOp: Boolean; -begin - Result := IMAPcommand('NOOP') = 'OK'; -end; - -function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean; -begin - Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK'; - ParseFolderList(FolderList); -end; - -function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean; -begin - Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK'; - ParseFolderList(FolderList); -end; - -function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean; -begin - Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK'; - ParseFolderList(FolderList); -end; - -function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean; -begin - Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK'; - ParseFolderList(FolderList); -end; - -function TIMAPSend.CreateFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK'; -end; - -function TIMAPSend.DeleteFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK'; -end; - -function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean; -begin - Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK'; -end; - -function TIMAPSend.SubscribeFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK'; -end; - -function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK'; -end; - -function TIMAPSend.SelectFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK'; - FSelectedFolder := FolderName; - ParseSelect; -end; - -function TIMAPSend.SelectROFolder(FolderName: string): Boolean; -begin - Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK'; - FSelectedFolder := FolderName; - ParseSelect; -end; - -function TIMAPSend.CloseFolder: Boolean; -begin - Result := IMAPcommand('CLOSE') = 'OK'; - FSelectedFolder := ''; -end; - -function TIMAPSend.StatusFolder(FolderName, Value: string): integer; -var - n: integer; - s, t: string; -begin - Result := -1; - Value := Uppercase(Value); - if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then - begin - ProcessLiterals; - for n := 0 to FFullResult.Count - 1 do - begin - s := FFullResult[n]; -// s := UpperCase(FFullResult[n]); - if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then - begin - t := SeparateRight(s, Value); - t := SeparateLeft(t, ')'); - t := trim(t); - Result := StrToIntDef(t, -1); - Break; - end; - end; - end; -end; - -function TIMAPSend.ExpungeFolder: Boolean; -begin - Result := IMAPcommand('EXPUNGE') = 'OK'; -end; - -function TIMAPSend.CheckFolder: Boolean; -begin - Result := IMAPcommand('CHECK') = 'OK'; -end; - -function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean; -begin - Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK'; -end; - -function TIMAPSend.DeleteMess(MessID: integer): boolean; -var - s: string; -begin - s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (\Deleted)'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; -end; - -function TIMAPSend.FetchMess(MessID: integer; const Mess: TStrings): Boolean; -var - s: string; -begin - s := 'FETCH ' + IntToStr(MessID) + ' (RFC822)'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; - ParseMess(Mess); -end; - -function TIMAPSend.FetchHeader(MessID: integer; const Headers: TStrings): Boolean; -var - s: string; -begin - s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.HEADER)'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; - ParseMess(Headers); -end; - -function TIMAPSend.MessageSize(MessID: integer): integer; -var - n: integer; - s, t: string; -begin - Result := -1; - s := 'FETCH ' + IntToStr(MessID) + ' (RFC822.SIZE)'; - if FUID then - s := 'UID ' + s; - if IMAPcommand(s) = 'OK' then - begin - ProcessLiterals; - for n := 0 to FFullResult.Count - 1 do - begin - s := UpperCase(FFullResult[n]); - if (Pos('* ', s) = 1) and (Pos('RFC822.SIZE', s) > 0 ) then - begin - t := SeparateRight(s, 'RFC822.SIZE '); - t := Trim(SeparateLeft(t, ')')); - t := Trim(SeparateLeft(t, ' ')); - Result := StrToIntDef(t, -1); - Break; - end; - end; - end; -end; - -function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean; -var - s: string; -begin - s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; -end; - -function TIMAPSend.SearchMess(Criteria: string; const FoundMess: TStrings): Boolean; -var - s: string; -begin - s := 'SEARCH ' + Criteria; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; - ParseSearch(FoundMess); -end; - -function TIMAPSend.SetFlagsMess(MessID: integer; Flags: string): Boolean; -var - s: string; -begin - s := 'STORE ' + IntToStr(MessID) + ' FLAGS.SILENT (' + Flags + ')'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; -end; - -function TIMAPSend.AddFlagsMess(MessID: integer; Flags: string): Boolean; -var - s: string; -begin - s := 'STORE ' + IntToStr(MessID) + ' +FLAGS.SILENT (' + Flags + ')'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; -end; - -function TIMAPSend.DelFlagsMess(MessID: integer; Flags: string): Boolean; -var - s: string; -begin - s := 'STORE ' + IntToStr(MessID) + ' -FLAGS.SILENT (' + Flags + ')'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; -end; - -function TIMAPSend.GetFlagsMess(MessID: integer; var Flags: string): Boolean; -var - s: string; - n: integer; -begin - Flags := ''; - s := 'FETCH ' + IntToStr(MessID) + ' (FLAGS)'; - if FUID then - s := 'UID ' + s; - Result := IMAPcommand(s) = 'OK'; - ProcessLiterals; - for n := 0 to FFullResult.Count - 1 do - begin - s := uppercase(FFullResult[n]); - if (Pos('* ', s) = 1) and (Pos('FLAGS', s) > 0 ) then - begin - s := SeparateRight(s, 'FLAGS'); - s := Separateright(s, '('); - Flags := Trim(SeparateLeft(s, ')')); - end; - end; -end; - -function TIMAPSend.StartTLS: Boolean; -begin - Result := False; - if FindCap('STARTTLS') <> '' then - begin - if IMAPcommand('STARTTLS') = 'OK' then - begin - Fsock.SSLDoConnect; - Result := FSock.LastError = 0; - end; - end; -end; - -//Paul Buskermolen -function TIMAPSend.GetUID(MessID: integer; var UID : Integer): boolean; -var - s, sUid: string; - n: integer; -begin - sUID := ''; - s := 'FETCH ' + IntToStr(MessID) + ' UID'; - Result := IMAPcommand(s) = 'OK'; - ProcessLiterals; - for n := 0 to FFullResult.Count - 1 do - begin - s := uppercase(FFullResult[n]); - if Pos('FETCH (UID', s) >= 1 then - begin - s := Separateright(s, '(UID '); - sUID := Trim(SeparateLeft(s, ')')); - end; - end; - UID := StrToIntDef(sUID, 0); -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/jedi.inc b/3rd/synapse/source/jedi.inc deleted file mode 100644 index d1b456302..000000000 --- a/3rd/synapse/source/jedi.inc +++ /dev/null @@ -1,1430 +0,0 @@ -{$IFNDEF JEDI_INC} -{$DEFINE JEDI_INC} - -{**************************************************************************************************} -{ } -{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License");} -{ you may not use this file except in compliance with the License. You may obtain a copy of the } -{ License at http://www.mozilla.org/MPL/ } -{ } -{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } -{ ANY KIND, either express or implied. See the License for the specific language governing rights } -{ and limitations under the License. } -{ } -{ The Original Code is: jedi.inc. } -{ The Initial Developer of the Original Code is Project JEDI http://www.delphi-jedi.org } -{ } -{ Alternatively, the contents of this file may be used under the terms of the GNU Lesser General } -{ Public License (the "LGPL License"), in which case the provisions of the LGPL License are } -{ applicable instead of those above. If you wish to allow use of your version of this file only } -{ under the terms of the LGPL License and not to allow others to use your version of this file } -{ under the MPL, indicate your decision by deleting the provisions above and replace them with } -{ the notice and other provisions required by the LGPL License. If you do not delete the } -{ provisions above, a recipient may use your version of this file under either the MPL or the } -{ LGPL License. } -{ } -{ For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html } -{ } -{**************************************************************************************************} -{ } -{ This file defines various generic compiler directives used in different libraries, e.g. in the } -{ JEDI Code Library (JCL) and JEDI Visual Component Library Library (JVCL). The directives in } -{ this file are of generic nature and consist mostly of mappings from the VERXXX directives } -{ defined by Delphi, C++Builder and FPC to friendly names such as DELPHI5 and } -{ SUPPORTS_WIDESTRING. These friendly names are subsequently used in the libraries to test for } -{ compiler versions and/or whether the compiler supports certain features (such as widestrings or } -{ 64 bit integers. The libraries provide an additional, library specific, include file. For the } -{ JCL e.g. this is jcl.inc. These files should be included in source files instead of this file } -{ (which is pulled in automatically). } -{ } -{**************************************************************************************************} -{ } -{ Last modified: $Date:: 2012-09-04 16:01:38 +0200 (út, 04 9 2012) $ } -{ Revision: $Rev:: 161 $ } -{ Author: $Author:: outchy $ } -{ } -{**************************************************************************************************} - -(* - -- Development environment directives - - This file defines two directives to indicate which development environment the - library is being compiled with. Currently this can either be Delphi, Kylix, - C++Builder or FPC. - - Directive Description - ------------------------------------------------------------------------------ - DELPHI Defined if compiled with Delphi - KYLIX Defined if compiled with Kylix - DELPHICOMPILER Defined if compiled with Delphi or Kylix/Delphi - BCB Defined if compiled with C++Builder - CPPBUILDER Defined if compiled with C++Builder (alias for BCB) - BCBCOMPILER Defined if compiled with C++Builder or Kylix/C++ - DELPHILANGUAGE Defined if compiled with Delphi, Kylix or C++Builder - BORLAND Defined if compiled with Delphi, Kylix or C++Builder - FPC Defined if compiled with FPC - -- Platform Directives - - Platform directives are not all explicitly defined in this file, some are - defined by the compiler itself. They are listed here only for completeness. - - Directive Description - ------------------------------------------------------------------------------ - WIN32 Defined when target platform is 32 bit Windows - WIN64 Defined when target platform is 64 bit Windows - MSWINDOWS Defined when target platform is 32 bit Windows - LINUX Defined when target platform is Linux - UNIX Defined when target platform is Unix-like (including Linux) - CLR Defined when target platform is .NET - -- Architecture directives. These are auto-defined by FPC - CPU32 and CPU64 are mostly for generic pointer size dependant differences rather - than for a specific architecture. - - CPU386 Defined when target platform is native x86 (win32) - CPUx86_64 Defined when target platform is native x86_64 (win64) - CPU32 Defined when target is 32-bit - CPU64 Defined when target is 64-bit - CPUASM Defined when target assembler is available - -- Visual library Directives - - The following directives indicate for a visual library. In a Delphi/BCB - (Win32) application you need to define the VisualCLX symbol in the project - options, if you want to use the VisualCLX library. Alternatively you can use - the IDE expert, which is distributed with the JCL to do this automatically. - - Directive Description - ------------------------------------------------------------------------------ - VCL Defined for Delphi/BCB (Win32) exactly if VisualCLX is not defined - VisualCLX Defined for Kylix; needs to be defined for Delphi/BCB to - use JCL with VisualCLX applications. - - -- Other cross-platform related defines - - These symbols are intended to help in writing portable code. - - Directive Description - ------------------------------------------------------------------------------ - PUREPASCAL Code is machine-independent (as opposed to assembler code) - Win32API Code is specific for the Win32 API; - use instead of "{$IFNDEF CLR} {$IFDEF MSWINDOWS}" constructs - - -- Delphi Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Delphi (ie DELPHI is defined). - - Directive Description - ------------------------------------------------------------------------------ - DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) - DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) - DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) - DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) - DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) - DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) - DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) - DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) - DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) - DELPHI9 Alias for DELPHI2005 - DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) - DELPHI2006 Alias for DELPHI10 - DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) - DELPHI2007 Alias for DELPHI11 - DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) - DELPHI2009 Alias for DELPHI12 - DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) - DELPHI2010 Alias for DELPHI14 - DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) - DELPHIXE Alias for DELPHI15 - DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) - DELPHIXE2 Alias for DELPHI16 - DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) - DELPHIXE3 Alias for DELPHI17 - DELPHI1_UP Defined when compiling with Delphi 1 or higher - DELPHI2_UP Defined when compiling with Delphi 2 or higher - DELPHI3_UP Defined when compiling with Delphi 3 or higher - DELPHI4_UP Defined when compiling with Delphi 4 or higher - DELPHI5_UP Defined when compiling with Delphi 5 or higher - DELPHI6_UP Defined when compiling with Delphi 6 or higher - DELPHI7_UP Defined when compiling with Delphi 7 or higher - DELPHI8_UP Defined when compiling with Delphi 8 or higher - DELPHI2005_UP Defined when compiling with Delphi 2005 or higher - DELPHI9_UP Alias for DELPHI2005_UP - DELPHI10_UP Defined when compiling with Delphi 2006 or higher - DELPHI2006_UP Alias for DELPHI10_UP - DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHI2007_UP Alias for DELPHI11_UP - DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHI2009_UP Alias for DELPHI12_UP - DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHI2010_UP Alias for DELPHI14_UP - DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHIXE_UP Alias for DELPHI15_UP - DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHIXE2_UP Alias for DELPHI16_UP - DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHIXE3_UP Alias for DELPHI17_UP - - -- Kylix Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is Kylix (ie KYLIX is defined). - - Directive Description - ------------------------------------------------------------------------------ - KYLIX1 Defined when compiling with Kylix 1 - KYLIX2 Defined when compiling with Kylix 2 - KYLIX3 Defined when compiling with Kylix 3 (Codename CORTEZ) - KYLIX1_UP Defined when compiling with Kylix 1 or higher - KYLIX2_UP Defined when compiling with Kylix 2 or higher - KYLIX3_UP Defined when compiling with Kylix 3 or higher - - -- Delphi Compiler Versions (Delphi / Kylix, not in BCB mode) - - Directive Description - ------------------------------------------------------------------------------ - DELPHICOMPILER1 Defined when compiling with Delphi 1 - DELPHICOMPILER2 Defined when compiling with Delphi 2 - DELPHICOMPILER3 Defined when compiling with Delphi 3 - DELPHICOMPILER4 Defined when compiling with Delphi 4 - DELPHICOMPILER5 Defined when compiling with Delphi 5 - DELPHICOMPILER6 Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 - DELPHICOMPILER7 Defined when compiling with Delphi 7 - DELPHICOMPILER8 Defined when compiling with Delphi 8 - DELPHICOMPILER9 Defined when compiling with Delphi 2005 - DELPHICOMPILER10 Defined when compiling with Delphi Personality of BDS 4.0 - DELPHICOMPILER11 Defined when compiling with Delphi 2007 for Win32 - DELPHICOMPILER12 Defined when compiling with Delphi Personality of BDS 6.0 - DELPHICOMPILER14 Defined when compiling with Delphi Personality of BDS 7.0 - DELPHICOMPILER15 Defined when compiling with Delphi Personality of BDS 8.0 - DELPHICOMPILER16 Defined when compiling with Delphi Personality of BDS 9.0 - DELPHICOMPILER17 Defined when compiling with Delphi Personality of BDS 10.0 - DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher - DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher - DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher - DELPHICOMPILER4_UP Defined when compiling with Delphi 4 or higher - DELPHICOMPILER5_UP Defined when compiling with Delphi 5 or higher - DELPHICOMPILER6_UP Defined when compiling with Delphi 6 or Kylix 1, 2 or 3 or higher - DELPHICOMPILER7_UP Defined when compiling with Delphi 7 or higher - DELPHICOMPILER8_UP Defined when compiling with Delphi 8 or higher - DELPHICOMPILER9_UP Defined when compiling with Delphi 2005 - DELPHICOMPILER10_UP Defined when compiling with Delphi 2006 or higher - DELPHICOMPILER11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHICOMPILER12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHICOMPILER14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHICOMPILER15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHICOMPILER16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHICOMPILER17_UP Defined when compiling with Delphi XE3 for Win32 or higher - - -- C++Builder Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. These directives are only defined if - the compiler is C++Builder (ie BCB is defined). - - Directive Description - ------------------------------------------------------------------------------ - BCB1 Defined when compiling with C++Builder 1 - BCB3 Defined when compiling with C++Builder 3 - BCB4 Defined when compiling with C++Builder 4 - BCB5 Defined when compiling with C++Builder 5 (Codename RAMPAGE) - BCB6 Defined when compiling with C++Builder 6 (Codename RIPTIDE) - BCB10 Defined when compiling with C++Builder Personality of BDS 4.0 (also known as C++Builder 2006) (Codename DEXTER) - BCB11 Defined when compiling with C++Builder Personality of RAD Studio 2007 (also known as C++Builder 2007) (Codename COGSWELL) - BCB12 Defined when compiling with C++Builder Personality of RAD Studio 2009 (also known as C++Builder 2009) (Codename TIBURON) - BCB14 Defined when compiling with C++Builder Personality of RAD Studio 2010 (also known as C++Builder 2010) (Codename WEAVER) - BCB15 Defined when compiling with C++Builder Personality of RAD Studio XE (also known as C++Builder XE) (Codename FULCRUM) - BCB16 Defined when compiling with C++Builder Personality of RAD Studio XE2 (also known as C++Builder XE2) (Codename PULSAR) - BCB17 Defined when compiling with C++Builder Personality of RAD Studio XE3 (also known as C++Builder XE3) (Codename WATERDRAGON) - BCB1_UP Defined when compiling with C++Builder 1 or higher - BCB3_UP Defined when compiling with C++Builder 3 or higher - BCB4_UP Defined when compiling with C++Builder 4 or higher - BCB5_UP Defined when compiling with C++Builder 5 or higher - BCB6_UP Defined when compiling with C++Builder 6 or higher - BCB10_UP Defined when compiling with C++Builder Personality of BDS 4.0 or higher - BCB11_UP Defined when compiling with C++Builder Personality of RAD Studio 2007 or higher - BCB12_UP Defined when compiling with C++Builder Personality of RAD Studio 2009 or higher - BCB14_UP Defined when compiling with C++Builder Personality of RAD Studio 2010 or higher - BCB15_UP Defined when compiling with C++Builder Personality of RAD Studio XE or higher - BCB16_UP Defined when compiling with C++Builder Personality of RAD Studio XE2 or higher - BCB17_UP Defined when compiling with C++Builder Personality of RAD Studio XE3 or higher - - -- RAD Studio / Borland Developer Studio Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated IDE. These directives are only defined if - the IDE is Borland Developer Studio Version 2 or above. - - Note: Borland Developer Studio 2006 is marketed as Delphi 2006 or C++Builder 2006, - but those provide only different labels for identical content. - - Directive Description - ------------------------------------------------------------------------------ - BDS Defined when compiling with BDS version of dcc32.exe (Codename SIDEWINDER) - BDS2 Defined when compiling with BDS 2.0 (Delphi 8) (Codename OCTANE) - BDS3 Defined when compiling with BDS 3.0 (Delphi 2005) (Codename DIAMONDBACK) - BDS4 Defined when compiling with BDS 4.0 (Borland Developer Studio 2006) (Codename DEXTER) - BDS5 Defined when compiling with BDS 5.0 (CodeGear RAD Studio 2007) (Codename HIGHLANDER) - BDS6 Defined when compiling with BDS 6.0 (CodeGear RAD Studio 2009) (Codename TIBURON) - BDS7 Defined when compiling with BDS 7.0 (Embarcadero RAD Studio 2010) (Codename WEAVER) - BDS8 Defined when compiling with BDS 8.0 (Embarcadero RAD Studio XE) (Codename FULCRUM) - BDS9 Defined when compiling with BDS 9.0 (Embarcadero RAD Studio XE2) (Codename PULSAR) - BDS10 Defined when compiling with BDS 10.0 (Embarcadero RAD Studio XE3) (Codename WATERDRAGON) - BDS2_UP Defined when compiling with BDS 2.0 or higher - BDS3_UP Defined when compiling with BDS 3.0 or higher - BDS4_UP Defined when compiling with BDS 4.0 or higher - BDS5_UP Defined when compiling with BDS 5.0 or higher - BDS6_UP Defined when compiling with BDS 6.0 or higher - BDS7_UP Defined when compiling with BDS 7.0 or higher - BDS8_UP Defined when compiling with BDS 8.0 or higher - BDS9_UP Defined when compiling with BDS 9.0 or higher - BDS10_UP Defined when compiling with BDS 10.0 or higher - -- Compiler Versions - - The following directives are direct mappings from the VERXXX directives to a - friendly name of the associated compiler. Unlike the DELPHI_X and BCB_X - directives, these directives are indepedent of the development environment. - That is, they are defined regardless of whether compilation takes place using - Delphi or C++Builder. - - Directive Description - ------------------------------------------------------------------------------ - COMPILER1 Defined when compiling with Delphi 1 - COMPILER2 Defined when compiling with Delphi 2 or C++Builder 1 - COMPILER3 Defined when compiling with Delphi 3 - COMPILER35 Defined when compiling with C++Builder 3 - COMPILER4 Defined when compiling with Delphi 4 or C++Builder 4 - COMPILER5 Defined when compiling with Delphi 5 or C++Builder 5 - COMPILER6 Defined when compiling with Delphi 6 or C++Builder 6 - COMPILER7 Defined when compiling with Delphi 7 - COMPILER8 Defined when compiling with Delphi 8 - COMPILER9 Defined when compiling with Delphi 9 - COMPILER10 Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 - COMPILER11 Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 - COMPILER12 Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 - COMPILER14 Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 - COMPILER15 Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 - COMPILER16 Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 - COMPILER17 Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 - COMPILER1_UP Defined when compiling with Delphi 1 or higher - COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher - COMPILER3_UP Defined when compiling with Delphi 3 or higher - COMPILER35_UP Defined when compiling with C++Builder 3 or higher - COMPILER4_UP Defined when compiling with Delphi 4 or C++Builder 4 or higher - COMPILER5_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - COMPILER6_UP Defined when compiling with Delphi 6 or C++Builder 6 or higher - COMPILER7_UP Defined when compiling with Delphi 7 - COMPILER8_UP Defined when compiling with Delphi 8 - COMPILER9_UP Defined when compiling with Delphi Personalities of BDS 3.0 - COMPILER10_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - COMPILER11_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - COMPILER12_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - COMPILER14_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - COMPILER15_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - COMPILER16_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - COMPILER17_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - - -- RTL Versions - - Use e.g. following to determine the exact RTL version since version 14.0: - {$IFDEF CONDITIONALEXPRESSIONS} - {$IF Declared(RTLVersion) and (RTLVersion >= 14.2)} - // code for Delphi 6.02 or higher, Kylix 2 or higher, C++Builder 6 or higher - ... - {$IFEND} - {$ENDIF} - - Directive Description - ------------------------------------------------------------------------------ - RTL80_UP Defined when compiling with Delphi 1 or higher - RTL90_UP Defined when compiling with Delphi 2 or higher - RTL93_UP Defined when compiling with C++Builder 1 or higher - RTL100_UP Defined when compiling with Delphi 3 or higher - RTL110_UP Defined when compiling with C++Builder 3 or higher - RTL120_UP Defined when compiling with Delphi 4 or higher - RTL125_UP Defined when compiling with C++Builder 4 or higher - RTL130_UP Defined when compiling with Delphi 5 or C++Builder 5 or higher - RTL140_UP Defined when compiling with Delphi 6, Kylix 1, 2 or 3 or C++Builder 6 or higher - RTL150_UP Defined when compiling with Delphi 7 or higher - RTL160_UP Defined when compiling with Delphi 8 or higher - RTL170_UP Defined when compiling with Delphi Personalities of BDS 3.0 or higher - RTL180_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 4.0 or higher - RTL185_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 5.0 or higher - RTL190_UP Defined when compiling with Delphi.NET of BDS 5.0 or higher - RTL200_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher - RTL210_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher - RTL220_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher - RTL230_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher - RTL240_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher - - -- CLR Versions - - Directive Description - ------------------------------------------------------------------------------ - CLR Defined when compiling for .NET - CLR10 Defined when compiling for .NET 1.0 (may be overriden by FORCE_CLR10) - CLR10_UP Defined when compiling for .NET 1.0 or higher - CLR11 Defined when compiling for .NET 1.1 (may be overriden by FORCE_CLR11) - CLR11_UP Defined when compiling for .NET 1.1 or higher - CLR20 Defined when compiling for .NET 2.0 (may be overriden by FORCE_CLR20) - CLR20_UP Defined when compiling for .NET 2.0 or higher - - -- Feature Directives - - The features directives are used to test if the compiler supports specific - features, such as method overloading, and adjust the sources accordingly. Use - of these directives is preferred over the use of the DELPHI and COMPILER - directives. - - Directive Description - ------------------------------------------------------------------------------ - SUPPORTS_CONSTPARAMS Compiler supports const parameters (D1+) - SUPPORTS_SINGLE Compiler supports the Single type (D1+) - SUPPORTS_DOUBLE Compiler supports the Double type (D1+) - SUPPORTS_EXTENDED Compiler supports the Extended type (D1+) - SUPPORTS_CURRENCY Compiler supports the Currency type (D2+) - SUPPORTS_THREADVAR Compiler supports threadvar declarations (D2+) - SUPPORTS_OUTPARAMS Compiler supports out parameters (D3+) - SUPPORTS_VARIANT Compiler supports variant (D2+) - SUPPORTS_WIDECHAR Compiler supports the WideChar type (D2+) - SUPPORTS_WIDESTRING Compiler supports the WideString type (D3+/BCB3+) - SUPPORTS_INTERFACE Compiler supports interfaces (D3+/BCB3+) - SUPPORTS_DISPINTERFACE Compiler supports dispatch interfaces (D3+/BCB3+) - SUPPORTS_DISPID Compiler supports dispatch ids (D3+/BCB3+/FPC) - SUPPORTS_EXTSYM Compiler supports the $EXTERNALSYM directive (D4+/BCB3+) - SUPPORTS_NODEFINE Compiler supports the $NODEFINE directive (D4+/BCB3+) - SUPPORTS_LONGWORD Compiler supports the LongWord type (unsigned 32 bit) (D4+/BCB4+) - SUPPORTS_INT64 Compiler supports the Int64 type (D4+/BCB4+) - SUPPORTS_UINT64 Compiler supports the UInt64 type (D XE+ ?) - SUPPORTS_DYNAMICARRAYS Compiler supports dynamic arrays (D4+/BCB4+) - SUPPORTS_DEFAULTPARAMS Compiler supports default parameters (D4+/BCB4+) - SUPPORTS_OVERLOAD Compiler supports overloading (D4+/BCB4+) - SUPPORTS_IMPLEMENTS Compiler supports implements (D4+/BCB4+) - SUPPORTS_DEPRECATED Compiler supports the deprecated directive (D6+/BCB6+) - SUPPORTS_PLATFORM Compiler supports the platform directive (D6+/BCB6+) - SUPPORTS_LIBRARY Compiler supports the library directive (D6+/BCB6+/FPC) - SUPPORTS_LOCAL Compiler supports the local directive (D6+/BCB6+) - SUPPORTS_SETPEFLAGS Compiler supports the SetPEFlags directive (D6+/BCB6+) - SUPPORTS_EXPERIMENTAL_WARNINGS Compiler supports the WARN SYMBOL_EXPERIMENTAL and WARN UNIT_EXPERIMENTAL directives (D6+/BCB6+) - SUPPORTS_INLINE Compiler supports the inline directive (D9+/FPC) - SUPPORTS_FOR_IN Compiler supports for in loops (D9+) - SUPPORTS_NESTED_CONSTANTS Compiler supports nested constants (D9+) - SUPPORTS_NESTED_TYPES Compiler supports nested types (D9+) - SUPPORTS_REGION Compiler supports the REGION and ENDREGION directives (D9+) - SUPPORTS_ENHANCED_RECORDS Compiler supports class [operator|function|procedure] for record types (D9.NET, D10+) - SUPPORTS_CLASS_FIELDS Compiler supports class fields (D9.NET, D10+) - SUPPORTS_CLASS_HELPERS Compiler supports class helpers (D9.NET, D10+) - SUPPORTS_CLASS_OPERATORS Compiler supports class operators (D9.NET, D10+) - SUPPORTS_CLASS_CTORDTORS Compiler supports class contructors/destructors (D14+) - SUPPORTS_STRICT Compiler supports strict keyword (D9.NET, D10+) - SUPPORTS_STATIC Compiler supports static keyword (D9.NET, D10+) - SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+) - SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+) - SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+) - SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+) - ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) - ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC) - ACCEPT_LIBRARY Compiler supports or ignores the library directive (D6+/BCB6+) - SUPPORTS_CUSTOMVARIANTS Compiler supports custom variants (D6+/BCB6+) - SUPPORTS_VARARGS Compiler supports varargs (D6+/BCB6+) - SUPPORTS_ENUMVALUE Compiler supports assigning ordinalities to values of enums (D6+/BCB6+) - SUPPORTS_DEPRECATED_WARNINGS Compiler supports deprecated warnings (D6+/BCB6+) - SUPPORTS_LIBRARY_WARNINGS Compiler supports library warnings (D6+/BCB6+) - SUPPORTS_PLATFORM_WARNINGS Compiler supports platform warnings (D6+/BCB6+) - SUPPORTS_UNSAFE_WARNINGS Compiler supports unsafe warnings (D7) - SUPPORTS_WEAKPACKAGEUNIT Compiler supports the WEAKPACKAGEUNIT directive - SUPPORTS_COMPILETIME_MESSAGES Compiler supports the MESSAGE directive - SUPPORTS_PACKAGES Compiler supports Packages - HAS_UNIT_LIBC Unit Libc exists (Kylix, FPC on Linux/x86) - HAS_UNIT_RTLCONSTS Unit RTLConsts exists (D6+/BCB6+/FPC) - HAS_UNIT_TYPES Unit Types exists (D6+/BCB6+/FPC) - HAS_UNIT_VARIANTS Unit Variants exists (D6+/BCB6+/FPC) - HAS_UNIT_STRUTILS Unit StrUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_DATEUTILS Unit DateUtils exists (D6+/BCB6+/FPC) - HAS_UNIT_CONTNRS Unit contnrs exists (D6+/BCB6+/FPC) - HAS_UNIT_HTTPPROD Unit HTTPProd exists (D9+) - HAS_UNIT_GIFIMG Unit GifImg exists (D11+) - HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+) - HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+) - HAS_UNIT_CHARACTER Unit Character exists (D12+) - XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) - SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+) - SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+) - SUPPORTS_INT_ALIASES Types Int8, Int16, Int32, UInt8, UInt16 and UInt32 are defined in the unit System (D12+) - HAS_UNIT_RTTI Unit RTTI is available (D14+) - SUPPORTS_CAST_INTERFACE_TO_OBJ The compiler supports casts from interfaces to objects (D14+) - SUPPORTS_DELAYED_LOADING The compiler generates stubs for delaying imported function loads (D14+) - HAS_UNIT_REGULAREXPRESSIONSAPI Unit RegularExpressionsAPI is available (D15+) - HAS_UNIT_SYSTEM_UITYPES Unit System.UITypes is available (D16+) - HAS_UNIT_SYSTEM_ACTIONS Unit System.Actions is available (D17+) - - -- Compiler Settings - - The compiler settings directives indicate whether a specific compiler setting - is in effect. This facilitates changing compiler settings locally in a more - compact and readible manner. - - Directive Description - ------------------------------------------------------------------------------ - ALIGN_ON Compiling in the A+ state (no alignment) - BOOLEVAL_ON Compiling in the B+ state (complete boolean evaluation) - ASSERTIONS_ON Compiling in the C+ state (assertions on) - DEBUGINFO_ON Compiling in the D+ state (debug info generation on) - IMPORTEDDATA_ON Compiling in the G+ state (creation of imported data references) - LONGSTRINGS_ON Compiling in the H+ state (string defined as AnsiString) - IOCHECKS_ON Compiling in the I+ state (I/O checking enabled) - WRITEABLECONST_ON Compiling in the J+ state (typed constants can be modified) - LOCALSYMBOLS Compiling in the L+ state (local symbol generation) - LOCALSYMBOLS_ON Alias of LOCALSYMBOLS - TYPEINFO_ON Compiling in the M+ state (RTTI generation on) - OPTIMIZATION_ON Compiling in the O+ state (code optimization on) - OPENSTRINGS_ON Compiling in the P+ state (variable string parameters are openstrings) - OVERFLOWCHECKS_ON Compiling in the Q+ state (overflow checing on) - RANGECHECKS_ON Compiling in the R+ state (range checking on) - TYPEDADDRESS_ON Compiling in the T+ state (pointers obtained using the @ operator are typed) - SAFEDIVIDE_ON Compiling in the U+ state (save FDIV instruction through RTL emulation) - VARSTRINGCHECKS_ON Compiling in the V+ state (type checking of shortstrings) - STACKFRAMES_ON Compiling in the W+ state (generation of stack frames) - EXTENDEDSYNTAX_ON Compiling in the X+ state (Delphi extended syntax enabled) -*) - -{$DEFINE BORLAND} - -{ Set FreePascal to Delphi mode } -{$IFDEF FPC} - {$MODE DELPHI} -// {$ASMMODE Intel} //Not needed and raise error on non-intel platforms! - {$UNDEF BORLAND} - {$DEFINE CPUASM} - // FPC defines CPU32, CPU64 and Unix automatically -{$ENDIF} - -{$IFDEF BORLAND} - {$IFDEF LINUX} - {$DEFINE KYLIX} - {$ENDIF LINUX} - {$IFNDEF CLR} - {$IFNDEF CPUX86} - {$IFNDEF CPUX64} - {$DEFINE CPU386} // For Borland compilers select the x86 compat assembler by default - {$DEFINE CPU32} // Assume Borland compilers are 32-bit (rather than 64-bit) - {$DEFINE CPUASM} - {$ELSE ~CPUX64} - {$DEFINE CPU64} - {$DEFINE CPUASM} - {$DEFINE DELPHI64_TEMPORARY} - {$ENDIF ~CPUX64} - {$ELSE ~CPUX86} - {$DEFINE CPU386} - {$DEFINE CPU32} - {$DEFINE CPUASM} - {$ENDIF ~CPUX86} - {$ENDIF ~CLR} -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ VERXXX to COMPILERX, DELPHIX and BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BORLAND} - {$IFDEF KYLIX} - {$I kylix.inc} // FPC incompatible stuff - {$ELSE ~KYLIX} - - {$DEFINE UNKNOWN_COMPILER_VERSION} - - {$IFDEF VER80} - {$DEFINE COMPILER1} - {$DEFINE DELPHI1} - {$DEFINE DELPHICOMPILER1} - {$DEFINE RTL80_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER90} - {$DEFINE COMPILER2} - {$DEFINE DELPHI2} - {$DEFINE DELPHICOMPILER2} - {$DEFINE RTL90_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER93} - {$DEFINE COMPILER2} - {$DEFINE BCB1} - {$DEFINE BCB} - {$DEFINE RTL93_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER100} - {$DEFINE COMPILER3} - {$DEFINE DELPHI3} - {$DEFINE DELPHICOMPILER3} - {$DEFINE RTL100_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER110} - {$DEFINE COMPILER35} - {$DEFINE BCB3} - {$DEFINE BCB} - {$DEFINE RTL110_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER120} - {$DEFINE COMPILER4} - {$DEFINE DELPHI4} - {$DEFINE DELPHICOMPILER4} - {$DEFINE RTL120_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER125} - {$DEFINE COMPILER4} - {$DEFINE BCB4} - {$DEFINE BCB} - {$DEFINE RTL125_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER130} - {$DEFINE COMPILER5} - {$IFDEF BCB} - {$DEFINE BCB5} - {$ELSE} - {$DEFINE DELPHI5} - {$DEFINE DELPHICOMPILER5} - {$ENDIF} - {$DEFINE RTL130_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER140} - {$DEFINE COMPILER6} - {$IFDEF BCB} - {$DEFINE BCB6} - {$ELSE} - {$DEFINE DELPHI6} - {$DEFINE DELPHICOMPILER6} - {$ENDIF} - {$DEFINE RTL140_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER150} - {$DEFINE COMPILER7} - {$DEFINE DELPHI7} - {$DEFINE DELPHICOMPILER7} - {$DEFINE RTL150_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER160} - {$DEFINE BDS2} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR10} - {$ENDIF CLR} - {$DEFINE COMPILER8} - {$DEFINE DELPHI8} - {$DEFINE DELPHICOMPILER8} - {$DEFINE RTL160_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER170} - {$DEFINE BDS3} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$DEFINE COMPILER9} - {$DEFINE DELPHI9} - {$DEFINE DELPHI2005} // synonym to DELPHI9 - {$DEFINE DELPHICOMPILER9} - {$DEFINE RTL170_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER180} - {$DEFINE BDS} - {$IFDEF CLR} - {$DEFINE CLR11} - {$ENDIF CLR} - {$IFDEF VER185} - {$DEFINE BDS5} - {$DEFINE COMPILER11} - {$IFDEF BCB} - {$DEFINE BCB11} - {$ELSE} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$ENDIF} - {$DEFINE RTL185_UP} - {$ELSE ~~VER185} - {$DEFINE BDS4} - {$DEFINE COMPILER10} - {$IFDEF BCB} - {$DEFINE BCB10} - {$ELSE} - {$DEFINE DELPHI10} - {$DEFINE DELPHI2006} // synonym to DELPHI10 - {$DEFINE DELPHICOMPILER10} - {$ENDIF} - {$DEFINE RTL180_UP} - {$ENDIF ~VER185} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$IFDEF VER190} // Delphi 2007 for .NET - {$DEFINE BDS} - {$DEFINE BDS5} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER11} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} // synonym to DELPHI11 - {$DEFINE DELPHICOMPILER11} - {$DEFINE RTL190_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER190} - - {$IFDEF VER200} // RAD Studio 2009 - {$DEFINE BDS} - {$DEFINE BDS6} - {$IFDEF CLR} - {$DEFINE CLR20} - {$ENDIF CLR} - {$DEFINE COMPILER12} - {$IFDEF BCB} - {$DEFINE BCB12} - {$ELSE} - {$DEFINE DELPHI12} - {$DEFINE DELPHI2009} // synonym to DELPHI12 - {$DEFINE DELPHICOMPILER12} - {$ENDIF BCB} - {$IFDEF CLR} - {$DEFINE RTL190_UP} - {$ELSE} - {$DEFINE RTL200_UP} - {$ENDIF} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER200} - - {$IFDEF VER210} // RAD Studio 2010 - {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER14} - {$IFDEF BCB} - {$DEFINE BCB14} - {$ELSE} - {$DEFINE DELPHI14} - {$DEFINE DELPHI2010} // synonym to DELPHI14 - {$DEFINE DELPHICOMPILER14} - {$ENDIF BCB} - {$DEFINE RTL210_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER210} - - {$IFDEF VER220} // RAD Studio XE - {$DEFINE BDS} - {$DEFINE BDS8} - {$DEFINE COMPILER15} - {$IFDEF BCB} - {$DEFINE BCB15} - {$ELSE} - {$DEFINE DELPHI15} - {$DEFINE DELPHIXE} // synonym to DELPHI15 - {$DEFINE DELPHICOMPILER15} - {$ENDIF BCB} - {$DEFINE RTL220_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER220} - - {$IFDEF VER230} // RAD Studio XE2 - {$DEFINE BDS} - {$DEFINE BDS9} - {$DEFINE COMPILER16} - {$IFDEF BCB} - {$DEFINE BCB16} - {$ELSE} - {$DEFINE DELPHI16} - {$DEFINE DELPHIXE2} // synonym to DELPHI16 - {$DEFINE DELPHICOMPILER16} - {$ENDIF BCB} - {$DEFINE RTL230_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER230} - - {$IFDEF VER240} // RAD Studio XE3 - {$DEFINE BDS} - {$DEFINE BDS10} - {$DEFINE COMPILER17} - {$IFDEF BCB} - {$DEFINE BCB17} - {$ELSE} - {$DEFINE DELPHI17} - {$DEFINE DELPHIXE3} // synonym to DELPHI17 - {$DEFINE DELPHICOMPILER17} - {$ENDIF BCB} - {$DEFINE RTL240_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER240} - - {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) - {$DEFINE BDS} - {$DEFINE BDS10} - {$DEFINE COMPILER17} - {$IFDEF BCB} - {$DEFINE BCB17} - {$ELSE} - {$DEFINE DELPHI17} - {$DEFINE DELPHIXE3} // synonym to DELPHI17 - {$DEFINE DELPHICOMPILER17} - {$ENDIF BCB} - {$DEFINE RTL240_UP} - {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF} - - {$ENDIF ~KYLIX} - - {$IFDEF BCB} - {$DEFINE CPPBUILDER} - {$DEFINE BCBCOMPILER} - {$ELSE ~BCB} - {$DEFINE DELPHI} - {$DEFINE DELPHICOMPILER} - {$ENDIF ~BCB} - -{$ENDIF BORLAND} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI17} {$DEFINE DELPHI17_UP} {$ENDIF} -{$IFDEF DELPHI16} {$DEFINE DELPHI16_UP} {$ENDIF} -{$IFDEF DELPHI15} {$DEFINE DELPHI15_UP} {$ENDIF} -{$IFDEF DELPHI14} {$DEFINE DELPHI14_UP} {$ENDIF} -{$IFDEF DELPHI12} {$DEFINE DELPHI12_UP} {$ENDIF} -{$IFDEF DELPHI11} {$DEFINE DELPHI11_UP} {$ENDIF} -{$IFDEF DELPHI10} {$DEFINE DELPHI10_UP} {$ENDIF} -{$IFDEF DELPHI9} {$DEFINE DELPHI9_UP} {$ENDIF} -{$IFDEF DELPHI8} {$DEFINE DELPHI8_UP} {$ENDIF} -{$IFDEF DELPHI7} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI6} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI5} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI4} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI3} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI2} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI1} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHIX_UP from DELPHIX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHI17_UP} - {$DEFINE DELPHIXE3_UP} // synonym to DELPHI17_UP - {$DEFINE DELPHI16_UP} -{$ENDIF} - -{$IFDEF DELPHI16_UP} - {$DEFINE DELPHIXE2_UP} // synonym to DELPHI16_UP - {$DEFINE DELPHI15_UP} -{$ENDIF} - -{$IFDEF DELPHI15_UP} - {$DEFINE DELPHIXE_UP} // synonym to DELPHI15_UP - {$DEFINE DELPHI14_UP} -{$ENDIF} - -{$IFDEF DELPHI14_UP} - {$DEFINE DELPHI2010_UP} // synonym to DELPHI14_UP - {$DEFINE DELPHI12_UP} -{$ENDIF} - -{$IFDEF DELPHI12_UP} - {$DEFINE DELPHI2009_UP} // synonym to DELPHI12_UP - {$DEFINE DELPHI11_UP} -{$ENDIF} - -{$IFDEF DELPHI11_UP} - {$DEFINE DELPHI2007_UP} // synonym to DELPHI11_UP - {$DEFINE DELPHI10_UP} -{$ENDIF} - -{$IFDEF DELPHI10_UP} - {$DEFINE DELPHI2006_UP} // synonym to DELPHI10_UP - {$DEFINE DELPHI9_UP} -{$ENDIF} - -{$IFDEF DELPHI9_UP} - {$DEFINE DELPHI2005_UP} // synonym to DELPHI9_UP - {$DEFINE DELPHI8_UP} -{$ENDIF} - -{$IFDEF DELPHI8_UP} {$DEFINE DELPHI7_UP} {$ENDIF} -{$IFDEF DELPHI7_UP} {$DEFINE DELPHI6_UP} {$ENDIF} -{$IFDEF DELPHI6_UP} {$DEFINE DELPHI5_UP} {$ENDIF} -{$IFDEF DELPHI5_UP} {$DEFINE DELPHI4_UP} {$ENDIF} -{$IFDEF DELPHI4_UP} {$DEFINE DELPHI3_UP} {$ENDIF} -{$IFDEF DELPHI3_UP} {$DEFINE DELPHI2_UP} {$ENDIF} -{$IFDEF DELPHI2_UP} {$DEFINE DELPHI1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB17} {$DEFINE BCB17_UP} {$ENDIF} -{$IFDEF BCB16} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB15} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB14} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB12} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB11} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB10} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB6} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB5} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB4} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB3} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB1} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BCBX_UP from BCBX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BCB17_UP} {$DEFINE BCB16_UP} {$ENDIF} -{$IFDEF BCB16_UP} {$DEFINE BCB15_UP} {$ENDIF} -{$IFDEF BCB15_UP} {$DEFINE BCB14_UP} {$ENDIF} -{$IFDEF BCB14_UP} {$DEFINE BCB12_UP} {$ENDIF} -{$IFDEF BCB12_UP} {$DEFINE BCB11_UP} {$ENDIF} -{$IFDEF BCB11_UP} {$DEFINE BCB10_UP} {$ENDIF} -{$IFDEF BCB10_UP} {$DEFINE BCB6_UP} {$ENDIF} -{$IFDEF BCB6_UP} {$DEFINE BCB5_UP} {$ENDIF} -{$IFDEF BCB5_UP} {$DEFINE BCB4_UP} {$ENDIF} -{$IFDEF BCB4_UP} {$DEFINE BCB3_UP} {$ENDIF} -{$IFDEF BCB3_UP} {$DEFINE BCB1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS10} {$DEFINE BDS10_UP} {$ENDIF} -{$IFDEF BDS9} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS8} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS7} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS6} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS5} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS4} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS3} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS2} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ BDSX_UP from BDSX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF BDS10_UP} {$DEFINE BDS9_UP} {$ENDIF} -{$IFDEF BDS9_UP} {$DEFINE BDS8_UP} {$ENDIF} -{$IFDEF BDS8_UP} {$DEFINE BDS7_UP} {$ENDIF} -{$IFDEF BDS7_UP} {$DEFINE BDS6_UP} {$ENDIF} -{$IFDEF BDS6_UP} {$DEFINE BDS5_UP} {$ENDIF} -{$IFDEF BDS5_UP} {$DEFINE BDS4_UP} {$ENDIF} -{$IFDEF BDS4_UP} {$DEFINE BDS3_UP} {$ENDIF} -{$IFDEF BDS3_UP} {$DEFINE BDS2_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER17} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER1} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER17_UP} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER16_UP} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER15_UP} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER14_UP} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER12_UP} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER11_UP} {$DEFINE DELPHICOMPILER10_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER10_UP} {$DEFINE DELPHICOMPILER9_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER9_UP} {$DEFINE DELPHICOMPILER8_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER8_UP} {$DEFINE DELPHICOMPILER7_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER7_UP} {$DEFINE DELPHICOMPILER6_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER6_UP} {$DEFINE DELPHICOMPILER5_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER5_UP} {$DEFINE DELPHICOMPILER4_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER4_UP} {$DEFINE DELPHICOMPILER3_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER3_UP} {$DEFINE DELPHICOMPILER2_UP} {$ENDIF} -{$IFDEF DELPHICOMPILER2_UP} {$DEFINE DELPHICOMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} -{$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER11} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER10} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER9} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER8} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER7} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER6} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER5} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER4} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER35} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER3} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER2} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER1} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ COMPILERX_UP from COMPILERX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} -{$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} -{$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} -{$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} -{$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} -{$IFDEF COMPILER11_UP} {$DEFINE COMPILER10_UP} {$ENDIF} -{$IFDEF COMPILER10_UP} {$DEFINE COMPILER9_UP} {$ENDIF} -{$IFDEF COMPILER9_UP} {$DEFINE COMPILER8_UP} {$ENDIF} -{$IFDEF COMPILER8_UP} {$DEFINE COMPILER7_UP} {$ENDIF} -{$IFDEF COMPILER7_UP} {$DEFINE COMPILER6_UP} {$ENDIF} -{$IFDEF COMPILER6_UP} {$DEFINE COMPILER5_UP} {$ENDIF} -{$IFDEF COMPILER5_UP} {$DEFINE COMPILER4_UP} {$ENDIF} -{$IFDEF COMPILER4_UP} {$DEFINE COMPILER35_UP} {$ENDIF} -{$IFDEF COMPILER35_UP} {$DEFINE COMPILER3_UP} {$ENDIF} -{$IFDEF COMPILER3_UP} {$DEFINE COMPILER2_UP} {$ENDIF} -{$IFDEF COMPILER2_UP} {$DEFINE COMPILER1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ RTLX_UP from RTLX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF RTL240_UP} {$DEFINE RTL230_UP} {$ENDIF} -{$IFDEF RTL230_UP} {$DEFINE RTL220_UP} {$ENDIF} -{$IFDEF RTL220_UP} {$DEFINE RTL210_UP} {$ENDIF} -{$IFDEF RTL210_UP} {$DEFINE RTL200_UP} {$ENDIF} -{$IFDEF RTL200_UP} {$DEFINE RTL190_UP} {$ENDIF} -{$IFDEF RTL190_UP} {$DEFINE RTL185_UP} {$ENDIF} -{$IFDEF RTL185_UP} {$DEFINE RTL180_UP} {$ENDIF} -{$IFDEF RTL180_UP} {$DEFINE RTL170_UP} {$ENDIF} -{$IFDEF RTL170_UP} {$DEFINE RTL160_UP} {$ENDIF} -{$IFDEF RTL160_UP} {$DEFINE RTL150_UP} {$ENDIF} -{$IFDEF RTL150_UP} {$DEFINE RTL145_UP} {$ENDIF} -{$IFDEF RTL145_UP} {$DEFINE RTL142_UP} {$ENDIF} -{$IFDEF RTL142_UP} {$DEFINE RTL140_UP} {$ENDIF} -{$IFDEF RTL140_UP} {$DEFINE RTL130_UP} {$ENDIF} -{$IFDEF RTL130_UP} {$DEFINE RTL125_UP} {$ENDIF} -{$IFDEF RTL125_UP} {$DEFINE RTL120_UP} {$ENDIF} -{$IFDEF RTL120_UP} {$DEFINE RTL110_UP} {$ENDIF} -{$IFDEF RTL110_UP} {$DEFINE RTL100_UP} {$ENDIF} -{$IFDEF RTL100_UP} {$DEFINE RTL93_UP} {$ENDIF} -{$IFDEF RTL93_UP} {$DEFINE RTL90_UP} {$ENDIF} -{$IFDEF RTL90_UP} {$DEFINE RTL80_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Check for CLR overrides of default detection } -{------------------------------------------------------------------------------} - -{$IFDEF CLR} - {$IFDEF FORCE_CLR10} - {$DEFINE CLR10} - {$UNDEF CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR10} - - {$IFDEF FORCE_CLR11} - {$UNDEF CLR10} - {$DEFINE CLR11} - {$UNDEF CLR20} - {$ENDIF FORCE_CLR11} - - {$IFDEF FORCE_CLR20} - {$UNDEF CLR10} - {$UNDEF CLR11} - {$DEFINE CLR20} - {$ENDIF FORCE_CLR20} -{$ENDIF CLR} - -{------------------------------------------------------------------------------} -{ CLRX from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR10} {$DEFINE CLR10_UP} {$ENDIF} -{$IFDEF CLR11} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR20} {$DEFINE CLR20_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ CLRX_UP from CLRX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF CLR20_UP} {$DEFINE CLR11_UP} {$ENDIF} -{$IFDEF CLR11_UP} {$DEFINE CLR10_UP} {$ENDIF} - -{------------------------------------------------------------------------------} - -{$IFDEF DELPHICOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{$IFDEF BCBCOMPILER} - {$DEFINE DELPHILANGUAGE} -{$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3} {$DEFINE KYLIX3_UP} {$ENDIF} -{$IFDEF KYLIX2} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX1} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ KYLIXX_UP from KYLIXX_UP mappings } -{------------------------------------------------------------------------------} - -{$IFDEF KYLIX3_UP} {$DEFINE KYLIX2_UP} {$ENDIF} -{$IFDEF KYLIX2_UP} {$DEFINE KYLIX1_UP} {$ENDIF} - -{------------------------------------------------------------------------------} -{ Map COMPILERX_UP to friendly feature names } -{------------------------------------------------------------------------------} - -{$IFDEF FPC} - {$IFDEF VER1_0} - Please use FPC 2.0 or higher to compile this. - {$ELSE} - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDECHAR} - {$DEFINE SUPPORTS_WIDESTRING} - {$IFDEF HASINTF} - {$DEFINE SUPPORTS_INTERFACE} - {$ENDIF} - {$IFDEF HASVARIANT} - {$DEFINE SUPPORTS_VARIANT} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_SINGLE} - {$DEFINE SUPPORTS_SINGLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_DOUBLE} - {$DEFINE SUPPORTS_DOUBLE} - {$ENDIF} - {$IFDEF FPC_HAS_TYPE_EXTENDED} - {$DEFINE SUPPORTS_EXTENDED} - {$ENDIF} - {$IFDEF HASCURRENCY} - {$DEFINE SUPPORTS_CURRENCY} - {$ENDIF} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings - {$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} - - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$IFDEF LINUX} - {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} - {$DEFINE HAS_UNIT_CONTNRS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE HAS_UNIT_RTLCONSTS} - - {$DEFINE XPLATFORM_RTL} - - {$IFDEF VER2_2} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_IMPLEMENTS} - {$DEFINE SUPPORTS_DISPID} - {$ELSE} - {$UNDEF SUPPORTS_DISPINTERFACE} - {$UNDEF SUPPORTS_IMPLEMENTS} - {$endif} - {$UNDEF SUPPORTS_UNSAFE_WARNINGS} - {$ENDIF} -{$ENDIF FPC} - -{$IFDEF CLR} - {$DEFINE SUPPORTS_UNICODE} -{$ENDIF CLR} - -{$IFDEF COMPILER1_UP} - {$DEFINE SUPPORTS_CONSTPARAMS} - {$DEFINE SUPPORTS_SINGLE} - {$DEFINE SUPPORTS_DOUBLE} - {$DEFINE SUPPORTS_EXTENDED} - {$DEFINE SUPPORTS_PACKAGES} -{$ENDIF COMPILER1_UP} - -{$IFDEF COMPILER2_UP} - {$DEFINE SUPPORTS_CURRENCY} - {$DEFINE SUPPORTS_THREADVAR} - {$DEFINE SUPPORTS_VARIANT} - {$DEFINE SUPPORTS_WIDECHAR} -{$ENDIF COMPILER2_UP} - -{$IFDEF COMPILER3_UP} - {$DEFINE SUPPORTS_OUTPARAMS} - {$DEFINE SUPPORTS_WIDESTRING} - {$DEFINE SUPPORTS_INTERFACE} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_DISPID} - {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF COMPILER3_UP} - -{$IFDEF COMPILER35_UP} - {$DEFINE SUPPORTS_EXTSYM} - {$DEFINE SUPPORTS_NODEFINE} -{$ENDIF COMPILER35_UP} - -{$IFDEF COMPILER4_UP} - {$DEFINE SUPPORTS_LONGWORD} - {$DEFINE SUPPORTS_INT64} - {$DEFINE SUPPORTS_DYNAMICARRAYS} - {$DEFINE SUPPORTS_DEFAULTPARAMS} - {$DEFINE SUPPORTS_OVERLOAD} - {$DEFINE SUPPORTS_IMPLEMENTS} -{$ENDIF COMPILER4_UP} - -{$IFDEF COMPILER6_UP} - {$DEFINE SUPPORTS_DEPRECATED} - {$DEFINE SUPPORTS_LIBRARY} - {$DEFINE SUPPORTS_PLATFORM} - {$DEFINE SUPPORTS_LOCAL} - {$DEFINE SUPPORTS_SETPEFLAGS} - {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} - {$DEFINE ACCEPT_DEPRECATED} - {$DEFINE ACCEPT_PLATFORM} - {$DEFINE ACCEPT_LIBRARY} - {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} - {$DEFINE SUPPORTS_LIBRARY_WARNINGS} - {$DEFINE SUPPORTS_PLATFORM_WARNINGS} - {$DEFINE SUPPORTS_CUSTOMVARIANTS} - {$DEFINE SUPPORTS_VARARGS} - {$DEFINE SUPPORTS_ENUMVALUE} - {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} -{$ENDIF COMPILER6_UP} - -{$IFDEF COMPILER7_UP} - {$DEFINE SUPPORTS_UNSAFE_WARNINGS} -{$ENDIF COMPILER7_UP} - -{$IFDEF COMPILER9_UP} - {$DEFINE SUPPORTS_FOR_IN} - {$DEFINE SUPPORTS_INLINE} - {$DEFINE SUPPORTS_NESTED_CONSTANTS} - {$DEFINE SUPPORTS_NESTED_TYPES} - {$DEFINE SUPPORTS_REGION} - {$IFDEF CLR} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$ENDIF CLR} -{$ENDIF COMPILER9_UP} - -{$IFDEF COMPILER10_UP} - {$DEFINE SUPPORTS_ENHANCED_RECORDS} - {$DEFINE SUPPORTS_CLASS_FIELDS} - {$DEFINE SUPPORTS_CLASS_HELPERS} - {$DEFINE SUPPORTS_CLASS_OPERATORS} - {$DEFINE SUPPORTS_STRICT} - {$DEFINE SUPPORTS_STATIC} - {$DEFINE SUPPORTS_FINAL} - {$DEFINE SUPPORTS_METHODINFO} -{$ENDIF COMPILER10_UP} - -{$IFDEF COMPILER11_UP} - {$IFDEF CLR} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$ENDIF CLR} -{$ENDIF COMPILER11_UP} - -{$IFDEF COMPILER12_UP} - {$DEFINE SUPPORTS_GENERICS} - {$DEFINE SUPPORTS_DEPRECATED_DETAILS} - {$DEFINE SUPPORTS_INT_ALIASES} - {$IFNDEF CLR} - {$DEFINE SUPPORTS_UNICODE} - {$DEFINE SUPPORTS_UNICODE_STRING} - {$ENDIF CLR} -{$ENDIF COMPILER12_UP} - -{$IFDEF COMPILER14_UP} - {$DEFINE SUPPORTS_CLASS_CTORDTORS} - {$DEFINE HAS_UNIT_RTTI} - {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} - {$DEFINE SUPPORTS_DELAYED_LOADING} -{$ENDIF COMPILER14_UP} - -{$IFDEF COMPILER16_UP} - {$DEFINE USE_64BIT_TYPES} -{$ENDIF COMPILER16_UP} - -{$IFDEF RTL130_UP} - {$DEFINE HAS_UNIT_CONTNRS} -{$ENDIF RTL130_UP} - -{$IFDEF RTL140_UP} - {$IFDEF LINUX} - {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} - {$DEFINE HAS_UNIT_RTLCONSTS} - {$DEFINE HAS_UNIT_TYPES} - {$DEFINE HAS_UNIT_VARIANTS} - {$DEFINE HAS_UNIT_STRUTILS} - {$DEFINE HAS_UNIT_DATEUTILS} - {$DEFINE XPLATFORM_RTL} -{$ENDIF RTL140_UP} - -{$IFDEF RTL170_UP} - {$DEFINE HAS_UNIT_HTTPPROD} -{$ENDIF RTL170_UP} - -{$IFDEF RTL185_UP} - {$DEFINE HAS_UNIT_GIFIMG} -{$ENDIF RTL185_UP} - -{$IFDEF RTL200_UP} - {$DEFINE HAS_UNIT_ANSISTRINGS} - {$DEFINE HAS_UNIT_PNGIMAGE} - {$DEFINE HAS_UNIT_CHARACTER} -{$ENDIF RTL200_UP} - -{$IFDEF RTL220_UP} - {$DEFINE SUPPORTS_UINT64} - {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} -{$ENDIF RTL220_UP} - -{$IFDEF RTL230_UP} - {$DEFINE HAS_UNITSCOPE} - {$DEFINE HAS_UNIT_SYSTEM_UITYPES} -{$ENDIF RTL230_UP} - -{$IFDEF RTL240_UP} - {$DEFINE HAS_UNIT_SYSTEM_ACTIONS} -{$ENDIF RTL240_UP} - -{------------------------------------------------------------------------------} -{ Cross-platform related defines } -{------------------------------------------------------------------------------} - -{$IFNDEF CPUASM} - {$DEFINE PUREPASCAL} -{$ENDIF ~CPUASM} - -{$IFDEF WIN32} - {$DEFINE MSWINDOWS} // predefined for D6+/BCB6+ - {$DEFINE Win32API} -{$ENDIF} - -{$IFDEF DELPHILANGUAGE} - {$IFDEF LINUX} - {$DEFINE UNIX} - {$ENDIF} - - {$IFNDEF CONSOLE} - {$IFDEF LINUX} - {$DEFINE VisualCLX} - {$ENDIF} - {$IFNDEF VisualCLX} - {$DEFINE VCL} - {$ENDIF} - {$ENDIF ~CONSOLE} -{$ENDIF DELPHILANGUAGE} - -{------------------------------------------------------------------------------} -{ Compiler settings } -{------------------------------------------------------------------------------} - -{$IFOPT A+} {$DEFINE ALIGN_ON} {$ENDIF} -{$IFOPT B+} {$DEFINE BOOLEVAL_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT C+} {$DEFINE ASSERTIONS_ON} {$ENDIF} -{$ENDIF} -{$IFOPT D+} {$DEFINE DEBUGINFO_ON} {$ENDIF} -{$IFOPT G+} {$DEFINE IMPORTEDDATA_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT H+} {$DEFINE LONGSTRINGS_ON} {$ENDIF} -{$ENDIF} - -// Hints -{$IFOPT I+} {$DEFINE IOCHECKS_ON} {$ENDIF} -{$IFDEF COMPILER2_UP} - {$IFOPT J+} {$DEFINE WRITEABLECONST_ON} {$ENDIF} -{$ENDIF} -{$IFOPT L+} {$DEFINE LOCALSYMBOLS} {$DEFINE LOCALSYMBOLS_ON} {$ENDIF} -{$IFOPT M+} {$DEFINE TYPEINFO_ON} {$ENDIF} -{$IFOPT O+} {$DEFINE OPTIMIZATION_ON} {$ENDIF} -{$IFOPT P+} {$DEFINE OPENSTRINGS_ON} {$ENDIF} -{$IFOPT Q+} {$DEFINE OVERFLOWCHECKS_ON} {$ENDIF} -{$IFOPT R+} {$DEFINE RANGECHECKS_ON} {$ENDIF} - -// Real compatibility -{$IFOPT T+} {$DEFINE TYPEDADDRESS_ON} {$ENDIF} -{$IFOPT U+} {$DEFINE SAFEDIVIDE_ON} {$ENDIF} -{$IFOPT V+} {$DEFINE VARSTRINGCHECKS_ON} {$ENDIF} -{$IFOPT W+} {$DEFINE STACKFRAMES_ON} {$ENDIF} - -// Warnings -{$IFOPT X+} {$DEFINE EXTENDEDSYNTAX_ON} {$ENDIF} - -// for Delphi/BCB trial versions remove the point from the line below -{.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} - -{$ENDIF ~JEDI_INC} diff --git a/3rd/synapse/source/kylix.inc b/3rd/synapse/source/kylix.inc deleted file mode 100644 index 55f095e1d..000000000 --- a/3rd/synapse/source/kylix.inc +++ /dev/null @@ -1,30 +0,0 @@ -// -// This is FPC-incompatible code and was excluded from jedi.inc for this reason -// -// Kylix 3/C++ for some reason evaluates CompilerVersion comparisons to False, -// if the constant to compare with is a floating point value - weird. -// The "+" sign prevents Kylix/Delphi from issueing a warning about comparing -// signed and unsigned values. -// - {$IF not Declared(CompilerVersion)} - {$DEFINE KYLIX1} - {$DEFINE COMPILER6} - {$DEFINE DELPHICOMPILER6} - {$DEFINE RTL140_UP} - {$ELSEIF Declared(CompilerVersion) and (CompilerVersion > +14)} - {$DEFINE KYLIX2} - {$DEFINE COMPILER6} - {$DEFINE DELPHICOMPILER6} - {$DEFINE RTL142_UP} - {$ELSEIF Declared(CompilerVersion) and (CompilerVersion < +15)} - {$DEFINE KYLIX3} - {$DEFINE COMPILER6} - {$IFNDEF BCB} - {$DEFINE DELPHICOMPILER6} - {$ENDIF} - {$DEFINE RTL145_UP} - {$ELSE} - Add new Kylix version - {$IFEND} - - diff --git a/3rd/synapse/source/laz_synapse.lpk b/3rd/synapse/source/laz_synapse.lpk deleted file mode 100644 index b7151a0f8..000000000 --- a/3rd/synapse/source/laz_synapse.lpk +++ /dev/null @@ -1,167 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/3rd/synapse/source/laz_synapse.pas b/3rd/synapse/source/laz_synapse.pas deleted file mode 100644 index 62d0f113c..000000000 --- a/3rd/synapse/source/laz_synapse.pas +++ /dev/null @@ -1,18 +0,0 @@ -{ This file was automatically created by Lazarus. Do not edit! - This source is only used to compile and install the package. - } - -unit laz_synapse; - -interface - -uses - asn1util, blcksock, clamsend, dnssend, ftpsend, ftptsend, httpsend, - imapsend, ldapsend, mimeinln, mimemess, mimepart, nntpsend, pingsend, - pop3send, slogsend, smtpsend, snmpsend, sntpsend, synachar, synacode, - synacrypt, synadbg, synafpc, synaicnv, synaip, synamisc, synaser, synautil, - synsock, tlntsend; - -implementation - -end. diff --git a/3rd/synapse/source/ldapsend.pas b/3rd/synapse/source/ldapsend.pas deleted file mode 100644 index 0bcac3958..000000000 --- a/3rd/synapse/source/ldapsend.pas +++ /dev/null @@ -1,1261 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.007.001 | -|==============================================================================| -| Content: LDAP client | -|==============================================================================| -| Copyright (c)1999-2014, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2014. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(LDAP client) - -Used RFC: RFC-2251, RFC-2254, RFC-2696, RFC-2829, RFC-2830 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit ldapsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, asn1util, synacode; - -const - cLDAPProtocol = '389'; - - LDAP_ASN1_BIND_REQUEST = $60; - LDAP_ASN1_BIND_RESPONSE = $61; - LDAP_ASN1_UNBIND_REQUEST = $42; - LDAP_ASN1_SEARCH_REQUEST = $63; - LDAP_ASN1_SEARCH_ENTRY = $64; - LDAP_ASN1_SEARCH_DONE = $65; - LDAP_ASN1_SEARCH_REFERENCE = $73; - LDAP_ASN1_MODIFY_REQUEST = $66; - LDAP_ASN1_MODIFY_RESPONSE = $67; - LDAP_ASN1_ADD_REQUEST = $68; - LDAP_ASN1_ADD_RESPONSE = $69; - LDAP_ASN1_DEL_REQUEST = $4A; - LDAP_ASN1_DEL_RESPONSE = $6B; - LDAP_ASN1_MODIFYDN_REQUEST = $6C; - LDAP_ASN1_MODIFYDN_RESPONSE = $6D; - LDAP_ASN1_COMPARE_REQUEST = $6E; - LDAP_ASN1_COMPARE_RESPONSE = $6F; - LDAP_ASN1_ABANDON_REQUEST = $70; - LDAP_ASN1_EXT_REQUEST = $77; - LDAP_ASN1_EXT_RESPONSE = $78; - LDAP_ASN1_CONTROLS = $A0; - - -type - - {:@abstract(LDAP attribute with list of their values) - This class holding name of LDAP attribute and list of their values. This is - descendant of TStringList class enhanced by some new properties.} - TLDAPAttribute = class(TStringList) - private - FAttributeName: AnsiString; - FIsBinary: Boolean; - protected - function Get(Index: integer): string; override; - procedure Put(Index: integer; const Value: string); override; - procedure SetAttributeName(Value: AnsiString); - public - function Add(const S: string): Integer; override; - published - {:Name of LDAP attribute.} - property AttributeName: AnsiString read FAttributeName Write SetAttributeName; - {:Return @true when attribute contains binary data.} - property IsBinary: Boolean read FIsBinary; - end; - - {:@abstract(List of @link(TLDAPAttribute)) - This object can hold list of TLDAPAttribute objects.} - TLDAPAttributeList = class(TObject) - private - FAttributeList: TList; - function GetAttribute(Index: integer): TLDAPAttribute; - public - constructor Create; - destructor Destroy; override; - {:Clear list.} - procedure Clear; - {:Return count of TLDAPAttribute objects in list.} - function Count: integer; - {:Add new TLDAPAttribute object to list.} - function Add: TLDAPAttribute; - {:Delete one TLDAPAttribute object from list.} - procedure Del(Index: integer); - {:Find and return attribute with requested name. Returns nil if not found.} - function Find(AttributeName: AnsiString): TLDAPAttribute; - {:Find and return attribute value with requested name. Returns empty string if not found.} - function Get(AttributeName: AnsiString): string; - {:List of TLDAPAttribute objects.} - property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default; - end; - - {:@abstract(LDAP result object) - This object can hold LDAP object. (their name and all their attributes with - values)} - TLDAPResult = class(TObject) - private - FObjectName: AnsiString; - FAttributes: TLDAPAttributeList; - public - constructor Create; - destructor Destroy; override; - published - {:Name of this LDAP object.} - property ObjectName: AnsiString read FObjectName write FObjectName; - {:Here is list of object attributes.} - property Attributes: TLDAPAttributeList read FAttributes; - end; - - {:@abstract(List of LDAP result objects) - This object can hold list of LDAP objects. (for example result of LDAP SEARCH.)} - TLDAPResultList = class(TObject) - private - FResultList: TList; - function GetResult(Index: integer): TLDAPResult; - public - constructor Create; - destructor Destroy; override; - {:Clear all TLDAPResult objects in list.} - procedure Clear; - {:Return count of TLDAPResult objects in list.} - function Count: integer; - {:Create and add new TLDAPResult object to list.} - function Add: TLDAPResult; - {:List of TLDAPResult objects.} - property Items[Index: Integer]: TLDAPResult read GetResult; default; - end; - - {:Define possible operations for LDAP MODIFY operations.} - TLDAPModifyOp = ( - MO_Add, - MO_Delete, - MO_Replace - ); - - {:Specify possible values for search scope.} - TLDAPSearchScope = ( - SS_BaseObject, - SS_SingleLevel, - SS_WholeSubtree - ); - - {:Specify possible values about alias dereferencing.} - TLDAPSearchAliases = ( - SA_NeverDeref, - SA_InSearching, - SA_FindingBaseObj, - SA_Always - ); - - {:@abstract(Implementation of LDAP client) - (version 2 and 3) - - Note: Are you missing properties for setting Username and Password? Look to - parent @link(TSynaClient) object! - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TLDAPSend = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FResultCode: Integer; - FResultString: AnsiString; - FFullResult: AnsiString; - FAutoTLS: Boolean; - FFullSSL: Boolean; - FSeq: integer; - FResponseCode: integer; - FResponseDN: AnsiString; - FReferals: TStringList; - FVersion: integer; - FSearchScope: TLDAPSearchScope; - FSearchAliases: TLDAPSearchAliases; - FSearchSizeLimit: integer; - FSearchTimeLimit: integer; - FSearchPageSize: integer; - FSearchCookie: AnsiString; - FSearchResult: TLDAPResultList; - FExtName: AnsiString; - FExtValue: AnsiString; - function Connect: Boolean; - function BuildPacket(const Value: AnsiString): AnsiString; - function ReceiveResponse: AnsiString; - function DecodeResponse(const Value: AnsiString): AnsiString; - function LdapSasl(Value: AnsiString): AnsiString; - function TranslateFilter(Value: AnsiString): AnsiString; - function GetErrorString(Value: integer): AnsiString; - public - constructor Create; - destructor Destroy; override; - - {:Try to connect to LDAP server and start secure channel, when it is required.} - function Login: Boolean; - - {:Try to bind to LDAP server with @link(TSynaClient.Username) and - @link(TSynaClient.Password). If this is empty strings, then it do annonymous - Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous - mode. - - This method using plaintext transport of password! It is not secure!} - function Bind: Boolean; - - {:Try to bind to LDAP server with @link(TSynaClient.Username) and - @link(TSynaClient.Password). If this is empty strings, then it do annonymous - Bind. When you not call Bind on LDAPv3, then is automaticly used anonymous - mode. - - This method using SASL with DIGEST-MD5 method for secure transfer of your - password.} - function BindSasl: Boolean; - - {:Close connection to LDAP server.} - function Logout: Boolean; - - {:Modify content of LDAP attribute on this object.} - function Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean; - - {:Add list of attributes to specified object.} - function Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean; - - {:Delete this LDAP object from server.} - function Delete(obj: AnsiString): Boolean; - - {:Modify object name of this LDAP object.} - function ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean; - - {:Try to compare Attribute value with this LDAP object.} - function Compare(obj, AttributeValue: AnsiString): Boolean; - - {:Search LDAP base for LDAP objects by Filter.} - function Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString; - const Attributes: TStrings): Boolean; - - {:Call any LDAPv3 extended command.} - function Extended(const Name, Value: AnsiString): Boolean; - - {:Try to start SSL/TLS connection to LDAP server.} - function StartTLS: Boolean; - published - {:Specify version of used LDAP protocol. Default value is 3.} - property Version: integer read FVersion Write FVersion; - - {:Result code of last LDAP operation.} - property ResultCode: Integer read FResultCode; - - {:Human readable description of result code of last LDAP operation.} - property ResultString: AnsiString read FResultString; - - {:Binary string with full last response of LDAP server. This string is - encoded by ASN.1 BER encoding! You need this only for debugging.} - property FullResult: AnsiString read FFullResult; - - {:If @true, then try to start TSL mode in Login procedure.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:If @true, then use connection to LDAP server through SSL/TLS tunnel.} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - - {:Sequence number of last LDAp command. It is incremented by any LDAP command.} - property Seq: integer read FSeq; - - {:Specify what search scope is used in search command.} - property SearchScope: TLDAPSearchScope read FSearchScope Write FSearchScope; - - {:Specify how to handle aliases in search command.} - property SearchAliases: TLDAPSearchAliases read FSearchAliases Write FSearchAliases; - - {:Specify result size limit in search command. Value 0 means without limit.} - property SearchSizeLimit: integer read FSearchSizeLimit Write FSearchSizeLimit; - - {:Specify search time limit in search command (seconds). Value 0 means - without limit.} - property SearchTimeLimit: integer read FSearchTimeLimit Write FSearchTimeLimit; - - {:Specify number of results to return per search request. Value 0 means - no paging.} - property SearchPageSize: integer read FSearchPageSize Write FSearchPageSize; - - {:Cookie returned by paged search results. Use an empty string for the first - search request.} - property SearchCookie: AnsiString read FSearchCookie Write FSearchCookie; - - {:Here is result of search command.} - property SearchResult: TLDAPResultList read FSearchResult; - - {:On each LDAP operation can LDAP server return some referals URLs. Here is - their list.} - property Referals: TStringList read FReferals; - - {:When you call @link(Extended) operation, then here is result Name returned - by server.} - property ExtName: AnsiString read FExtName; - - {:When you call @link(Extended) operation, then here is result Value returned - by server.} - property ExtValue: AnsiString read FExtValue; - - {:TCP socket used by all LDAP operations.} - property Sock: TTCPBlockSocket read FSock; - end; - -{:Dump result of LDAP SEARCH into human readable form. Good for debugging.} -function LDAPResultDump(const Value: TLDAPResultList): AnsiString; - -implementation - -{==============================================================================} -function TLDAPAttribute.Add(const S: string): Integer; -begin - Result := inherited Add(''); - Put(Result,S); -end; - -function TLDAPAttribute.Get(Index: integer): string; -begin - Result := inherited Get(Index); - if FIsbinary then - Result := DecodeBase64(Result); -end; - -procedure TLDAPAttribute.Put(Index: integer; const Value: string); -var - s: AnsiString; -begin - s := Value; - if FIsbinary then - s := EncodeBase64(Value) - else - s :=UnquoteStr(s, '"'); - inherited Put(Index, s); -end; - -procedure TLDAPAttribute.SetAttributeName(Value: AnsiString); -begin - FAttributeName := Value; - FIsBinary := Pos(';binary', Lowercase(value)) > 0; -end; - -{==============================================================================} -constructor TLDAPAttributeList.Create; -begin - inherited Create; - FAttributeList := TList.Create; -end; - -destructor TLDAPAttributeList.Destroy; -begin - Clear; - FAttributeList.Free; - inherited Destroy; -end; - -procedure TLDAPAttributeList.Clear; -var - n: integer; - x: TLDAPAttribute; -begin - for n := Count - 1 downto 0 do - begin - x := GetAttribute(n); - if Assigned(x) then - x.Free; - end; - FAttributeList.Clear; -end; - -function TLDAPAttributeList.Count: integer; -begin - Result := FAttributeList.Count; -end; - -function TLDAPAttributeList.Get(AttributeName: AnsiString): string; -var - x: TLDAPAttribute; -begin - Result := ''; - x := self.Find(AttributeName); - if x <> nil then - if x.Count > 0 then - Result := x[0]; -end; - -function TLDAPAttributeList.GetAttribute(Index: integer): TLDAPAttribute; -begin - Result := nil; - if Index < Count then - Result := TLDAPAttribute(FAttributeList[Index]); -end; - -function TLDAPAttributeList.Add: TLDAPAttribute; -begin - Result := TLDAPAttribute.Create; - FAttributeList.Add(Result); -end; - -procedure TLDAPAttributeList.Del(Index: integer); -var - x: TLDAPAttribute; -begin - x := GetAttribute(Index); - if Assigned(x) then - x.free; - FAttributeList.Delete(Index); -end; - -function TLDAPAttributeList.Find(AttributeName: AnsiString): TLDAPAttribute; -var - n: integer; - x: TLDAPAttribute; -begin - Result := nil; - AttributeName := lowercase(AttributeName); - for n := 0 to Count - 1 do - begin - x := GetAttribute(n); - if Assigned(x) then - if lowercase(x.AttributeName) = Attributename then - begin - result := x; - break; - end; - end; -end; - -{==============================================================================} -constructor TLDAPResult.Create; -begin - inherited Create; - FAttributes := TLDAPAttributeList.Create; -end; - -destructor TLDAPResult.Destroy; -begin - FAttributes.Free; - inherited Destroy; -end; - -{==============================================================================} -constructor TLDAPResultList.Create; -begin - inherited Create; - FResultList := TList.Create; -end; - -destructor TLDAPResultList.Destroy; -begin - Clear; - FResultList.Free; - inherited Destroy; -end; - -procedure TLDAPResultList.Clear; -var - n: integer; - x: TLDAPResult; -begin - for n := Count - 1 downto 0 do - begin - x := GetResult(n); - if Assigned(x) then - x.Free; - end; - FResultList.Clear; -end; - -function TLDAPResultList.Count: integer; -begin - Result := FResultList.Count; -end; - -function TLDAPResultList.GetResult(Index: integer): TLDAPResult; -begin - Result := nil; - if Index < Count then - Result := TLDAPResult(FResultList[Index]); -end; - -function TLDAPResultList.Add: TLDAPResult; -begin - Result := TLDAPResult.Create; - FResultList.Add(Result); -end; - -{==============================================================================} -constructor TLDAPSend.Create; -begin - inherited Create; - FReferals := TStringList.Create; - FFullResult := ''; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FTimeout := 60000; - FTargetPort := cLDAPProtocol; - FAutoTLS := False; - FFullSSL := False; - FSeq := 0; - FVersion := 3; - FSearchScope := SS_WholeSubtree; - FSearchAliases := SA_Always; - FSearchSizeLimit := 0; - FSearchTimeLimit := 0; - FSearchPageSize := 0; - FSearchCookie := ''; - FSearchResult := TLDAPResultList.Create; -end; - -destructor TLDAPSend.Destroy; -begin - FSock.Free; - FSearchResult.Free; - FReferals.Free; - inherited Destroy; -end; - -function TLDAPSend.GetErrorString(Value: integer): AnsiString; -begin - case Value of - 0: - Result := 'Success'; - 1: - Result := 'Operations error'; - 2: - Result := 'Protocol error'; - 3: - Result := 'Time limit Exceeded'; - 4: - Result := 'Size limit Exceeded'; - 5: - Result := 'Compare FALSE'; - 6: - Result := 'Compare TRUE'; - 7: - Result := 'Auth method not supported'; - 8: - Result := 'Strong auth required'; - 9: - Result := '-- reserved --'; - 10: - Result := 'Referal'; - 11: - Result := 'Admin limit exceeded'; - 12: - Result := 'Unavailable critical extension'; - 13: - Result := 'Confidentality required'; - 14: - Result := 'Sasl bind in progress'; - 16: - Result := 'No such attribute'; - 17: - Result := 'Undefined attribute type'; - 18: - Result := 'Inappropriate matching'; - 19: - Result := 'Constraint violation'; - 20: - Result := 'Attribute or value exists'; - 21: - Result := 'Invalid attribute syntax'; - 32: - Result := 'No such object'; - 33: - Result := 'Alias problem'; - 34: - Result := 'Invalid DN syntax'; - 36: - Result := 'Alias dereferencing problem'; - 48: - Result := 'Inappropriate authentication'; - 49: - Result := 'Invalid credentials'; - 50: - Result := 'Insufficient access rights'; - 51: - Result := 'Busy'; - 52: - Result := 'Unavailable'; - 53: - Result := 'Unwilling to perform'; - 54: - Result := 'Loop detect'; - 64: - Result := 'Naming violation'; - 65: - Result := 'Object class violation'; - 66: - Result := 'Not allowed on non leaf'; - 67: - Result := 'Not allowed on RDN'; - 68: - Result := 'Entry already exists'; - 69: - Result := 'Object class mods prohibited'; - 71: - Result := 'Affects multiple DSAs'; - 80: - Result := 'Other'; - else - Result := '--unknown--'; - end; -end; - -function TLDAPSend.Connect: Boolean; -begin - // Do not call this function! It is calling by LOGIN method! - FSock.CloseSocket; - FSock.LineBuffer := ''; - FSeq := 0; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TLDAPSend.BuildPacket(const Value: AnsiString): AnsiString; -begin - Inc(FSeq); - Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value, ASN1_SEQ); -end; - -function TLDAPSend.ReceiveResponse: AnsiString; -var - x: Byte; - i,j: integer; -begin - Result := ''; - FFullResult := ''; - x := FSock.RecvByte(FTimeout); - if x <> ASN1_SEQ then - Exit; - Result := AnsiChar(x); - x := FSock.RecvByte(FTimeout); - Result := Result + AnsiChar(x); - if x < $80 then - i := 0 - else - i := x and $7F; - if i > 0 then - Result := Result + FSock.RecvBufferStr(i, Ftimeout); - if FSock.LastError <> 0 then - begin - Result := ''; - Exit; - end; - //get length of LDAP packet - j := 2; - i := ASNDecLen(j, Result); - //retreive rest of LDAP packet - if i > 0 then - Result := Result + FSock.RecvBufferStr(i, Ftimeout); - if FSock.LastError <> 0 then - begin - Result := ''; - Exit; - end; - FFullResult := Result; -end; - -function TLDAPSend.DecodeResponse(const Value: AnsiString): AnsiString; -var - i, x: integer; - Svt: Integer; - s, t: AnsiString; -begin - Result := ''; - FResultCode := -1; - FResultstring := ''; - FResponseCode := -1; - FResponseDN := ''; - FReferals.Clear; - i := 1; - ASNItem(i, Value, Svt); - x := StrToIntDef(ASNItem(i, Value, Svt), 0); - if (svt <> ASN1_INT) or (x <> FSeq) then - Exit; - s := ASNItem(i, Value, Svt); - FResponseCode := svt; - if FResponseCode in [LDAP_ASN1_BIND_RESPONSE, LDAP_ASN1_SEARCH_DONE, - LDAP_ASN1_MODIFY_RESPONSE, LDAP_ASN1_ADD_RESPONSE, LDAP_ASN1_DEL_RESPONSE, - LDAP_ASN1_MODIFYDN_RESPONSE, LDAP_ASN1_COMPARE_RESPONSE, - LDAP_ASN1_EXT_RESPONSE] then - begin - FResultCode := StrToIntDef(ASNItem(i, Value, Svt), -1); - FResponseDN := ASNItem(i, Value, Svt); - FResultString := ASNItem(i, Value, Svt); - if FResultString = '' then - FResultString := GetErrorString(FResultCode); - if FResultCode = 10 then - begin - s := ASNItem(i, Value, Svt); - if svt = $A3 then - begin - x := 1; - while x < Length(s) do - begin - t := ASNItem(x, s, Svt); - FReferals.Add(t); - end; - end; - end; - end; - Result := Copy(Value, i, Length(Value) - i + 1); -end; - -function TLDAPSend.LdapSasl(Value: AnsiString): AnsiString; -var - nonce, cnonce, nc, realm, qop, uri, response: AnsiString; - s: AnsiString; - a1, a2: AnsiString; - l: TStringList; - n: integer; -begin - l := TStringList.Create; - try - nonce := ''; - realm := ''; - l.CommaText := Value; - n := IndexByBegin('nonce=', l); - if n >= 0 then - nonce := UnQuoteStr(Trim(SeparateRight(l[n], 'nonce=')), '"'); - n := IndexByBegin('realm=', l); - if n >= 0 then - realm := UnQuoteStr(Trim(SeparateRight(l[n], 'realm=')), '"'); - cnonce := IntToHex(GetTick, 8); - nc := '00000001'; - qop := 'auth'; - uri := 'ldap/' + FSock.ResolveIpToName(FSock.GetRemoteSinIP); - a1 := md5(FUsername + ':' + realm + ':' + FPassword) - + ':' + nonce + ':' + cnonce; - a2 := 'AUTHENTICATE:' + uri; - s := strtohex(md5(a1))+':' + nonce + ':' + nc + ':' + cnonce + ':' - + qop +':'+strtohex(md5(a2)); - response := strtohex(md5(s)); - - Result := 'username="' + Fusername + '",realm="' + realm + '",nonce="'; - Result := Result + nonce + '",cnonce="' + cnonce + '",nc=' + nc + ',qop='; - Result := Result + qop + ',digest-uri="' + uri + '",response=' + response; - finally - l.Free; - end; -end; - -function TLDAPSend.TranslateFilter(Value: AnsiString): AnsiString; -var - x: integer; - s, t, l: AnsiString; - r: string; - c: Ansichar; - attr, rule: AnsiString; - dn: Boolean; -begin - Result := ''; - if Value = '' then - Exit; - s := Value; - if Value[1] = '(' then - begin - x := RPos(')', Value); - s := Copy(Value, 2, x - 2); - end; - if s = '' then - Exit; - case s[1] of - '!': - // NOT rule (recursive call) - begin - Result := ASNOBject(TranslateFilter(GetBetween('(', ')', s)), $A2); - end; - '&': - // AND rule (recursive call) - begin - repeat - t := GetBetween('(', ')', s); - s := Trim(SeparateRight(s, t)); - if s <> '' then - if s[1] = ')' then - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1); - Result := Result + TranslateFilter(t); - until s = ''; - Result := ASNOBject(Result, $A0); - end; - '|': - // OR rule (recursive call) - begin - repeat - t := GetBetween('(', ')', s); - s := Trim(SeparateRight(s, t)); - if s <> '' then - if s[1] = ')' then - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1); - Result := Result + TranslateFilter(t); - until s = ''; - Result := ASNOBject(Result, $A1); - end; - else - begin - l := Trim(SeparateLeft(s, '=')); - r := Trim(SeparateRight(s, '=')); - if l <> '' then - begin - c := l[Length(l)]; - case c of - ':': - // Extensible match - begin - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1); - dn := False; - attr := ''; - rule := ''; - if Pos(':dn', l) > 0 then - begin - dn := True; - l := ReplaceString(l, ':dn', ''); - end; - attr := Trim(SeparateLeft(l, ':')); - rule := Trim(SeparateRight(l, ':')); - if rule = l then - rule := ''; - if rule <> '' then - Result := ASNObject(rule, $81); - if attr <> '' then - Result := Result + ASNObject(attr, $82); - Result := Result + ASNObject(DecodeTriplet(r, '\'), $83); - if dn then - Result := Result + ASNObject(AsnEncInt($ff), $84) - else - Result := Result + ASNObject(AsnEncInt(0), $84); - Result := ASNOBject(Result, $a9); - end; - '~': - // Approx match - begin - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1); - Result := ASNOBject(l, ASN1_OCTSTR) - + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR); - Result := ASNOBject(Result, $a8); - end; - '>': - // Greater or equal match - begin - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1); - Result := ASNOBject(l, ASN1_OCTSTR) - + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR); - Result := ASNOBject(Result, $a5); - end; - '<': - // Less or equal match - begin - {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1); - Result := ASNOBject(l, ASN1_OCTSTR) - + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR); - Result := ASNOBject(Result, $a6); - end; - else - // present - if r = '*' then - Result := ASNOBject(l, $87) - else - if Pos('*', r) > 0 then - // substrings - begin - s := Fetch(r, '*'); - if s <> '' then - Result := ASNOBject(DecodeTriplet(s, '\'), $80); - while r <> '' do - begin - if Pos('*', r) <= 0 then - break; - s := Fetch(r, '*'); - Result := Result + ASNOBject(DecodeTriplet(s, '\'), $81); - end; - if r <> '' then - Result := Result + ASNOBject(DecodeTriplet(r, '\'), $82); - Result := ASNOBject(l, ASN1_OCTSTR) - + ASNOBject(Result, ASN1_SEQ); - Result := ASNOBject(Result, $a4); - end - else - begin - // Equality match - Result := ASNOBject(l, ASN1_OCTSTR) - + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR); - Result := ASNOBject(Result, $a3); - end; - end; - end; - end; - end; -end; - -function TLDAPSend.Login: Boolean; -begin - Result := False; - if not Connect then - Exit; - Result := True; - if FAutoTLS then - Result := StartTLS; -end; - -function TLDAPSend.Bind: Boolean; -var - s: AnsiString; -begin - s := ASNObject(ASNEncInt(FVersion), ASN1_INT) - + ASNObject(FUsername, ASN1_OCTSTR) - + ASNObject(FPassword, $80); - s := ASNObject(s, LDAP_ASN1_BIND_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.BindSasl: Boolean; -var - s, t: AnsiString; - x, xt: integer; - digreq: AnsiString; -begin - Result := False; - if FPassword = '' then - Result := Bind - else - begin - digreq := ASNObject(ASNEncInt(FVersion), ASN1_INT) - + ASNObject('', ASN1_OCTSTR) - + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3); - digreq := ASNObject(digreq, LDAP_ASN1_BIND_REQUEST); - Fsock.SendString(BuildPacket(digreq)); - s := ReceiveResponse; - t := DecodeResponse(s); - if FResultCode = 14 then - begin - s := t; - x := 1; - t := ASNItem(x, s, xt); - s := ASNObject(ASNEncInt(FVersion), ASN1_INT) - + ASNObject('', ASN1_OCTSTR) - + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR) - + ASNObject(LdapSasl(t), ASN1_OCTSTR), $A3); - s := ASNObject(s, LDAP_ASN1_BIND_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - if FResultCode = 14 then - begin - Fsock.SendString(BuildPacket(digreq)); - s := ReceiveResponse; - DecodeResponse(s); - end; - Result := FResultCode = 0; - end; - end; -end; - -function TLDAPSend.Logout: Boolean; -begin - Fsock.SendString(BuildPacket(ASNObject('', LDAP_ASN1_UNBIND_REQUEST))); - FSock.CloseSocket; - Result := True; -end; - -function TLDAPSend.Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean; -var - s: AnsiString; - n: integer; -begin - s := ''; - for n := 0 to Value.Count -1 do - s := s + ASNObject(Value[n], ASN1_OCTSTR); - s := ASNObject(Value.AttributeName, ASN1_OCTSTR) + ASNObject(s, ASN1_SETOF); - s := ASNObject(ASNEncInt(Ord(Op)), ASN1_ENUM) + ASNObject(s, ASN1_SEQ); - s := ASNObject(s, ASN1_SEQ); - s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ); - s := ASNObject(s, LDAP_ASN1_MODIFY_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean; -var - s, t: AnsiString; - n, m: integer; -begin - s := ''; - for n := 0 to Value.Count - 1 do - begin - t := ''; - for m := 0 to Value[n].Count - 1 do - t := t + ASNObject(Value[n][m], ASN1_OCTSTR); - t := ASNObject(Value[n].AttributeName, ASN1_OCTSTR) - + ASNObject(t, ASN1_SETOF); - s := s + ASNObject(t, ASN1_SEQ); - end; - s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ); - s := ASNObject(s, LDAP_ASN1_ADD_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.Delete(obj: AnsiString): Boolean; -var - s: AnsiString; -begin - s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteOldRDN: Boolean): Boolean; -var - s: AnsiString; -begin - s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR); - if DeleteOldRDN then - s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL) - else - s := s + ASNObject(ASNEncInt(0), ASN1_BOOL); - if newSuperior <> '' then - s := s + ASNObject(newSuperior, $80); - s := ASNObject(s, LDAP_ASN1_MODIFYDN_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.Compare(obj, AttributeValue: AnsiString): Boolean; -var - s: AnsiString; -begin - s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR) - + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR); - s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ); - s := ASNObject(s, LDAP_ASN1_COMPARE_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - DecodeResponse(s); - Result := FResultCode = 0; -end; - -function TLDAPSend.Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString; - const Attributes: TStrings): Boolean; -var - s, t, u, c: AnsiString; - n, i, x: integer; - r: TLDAPResult; - a: TLDAPAttribute; -begin - FSearchResult.Clear; - FReferals.Clear; - s := ASNObject(obj, ASN1_OCTSTR); - s := s + ASNObject(ASNEncInt(Ord(FSearchScope)), ASN1_ENUM); - s := s + ASNObject(ASNEncInt(Ord(FSearchAliases)), ASN1_ENUM); - s := s + ASNObject(ASNEncInt(FSearchSizeLimit), ASN1_INT); - s := s + ASNObject(ASNEncInt(FSearchTimeLimit), ASN1_INT); - if TypesOnly then - s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL) - else - s := s + ASNObject(ASNEncInt(0), ASN1_BOOL); - if Filter = '' then - Filter := '(objectclass=*)'; - t := TranslateFilter(Filter); - if t = '' then - s := s + ASNObject('', ASN1_NULL) - else - s := s + t; - t := ''; - for n := 0 to Attributes.Count - 1 do - t := t + ASNObject(Attributes[n], ASN1_OCTSTR); - s := s + ASNObject(t, ASN1_SEQ); - s := ASNObject(s, LDAP_ASN1_SEARCH_REQUEST); - if FSearchPageSize > 0 then - begin - c := ASNObject('1.2.840.113556.1.4.319', ASN1_OCTSTR); // controlType: pagedResultsControl - c := c + ASNObject(ASNEncInt(0), ASN1_BOOL); // criticality: FALSE - t := ASNObject(ASNEncInt(FSearchPageSize), ASN1_INT); // page size - t := t + ASNObject(FSearchCookie, ASN1_OCTSTR); // search cookie - t := ASNObject(t, ASN1_SEQ); // wrap with SEQUENCE - c := c + ASNObject(t, ASN1_OCTSTR); // add searchControlValue as OCTET STRING - c := ASNObject(c, ASN1_SEQ); // wrap with SEQUENCE - s := s + ASNObject(c, LDAP_ASN1_CONTROLS); // append Controls to SearchRequest - end; - Fsock.SendString(BuildPacket(s)); - repeat - s := ReceiveResponse; - t := DecodeResponse(s); - if FResponseCode = LDAP_ASN1_SEARCH_ENTRY then - begin - //dekoduj zaznam - r := FSearchResult.Add; - n := 1; - r.ObjectName := ASNItem(n, t, x); - ASNItem(n, t, x); - if x = ASN1_SEQ then - begin - while n < Length(t) do - begin - s := ASNItem(n, t, x); - if x = ASN1_SEQ then - begin - i := n + Length(s); - a := r.Attributes.Add; - u := ASNItem(n, t, x); - a.AttributeName := u; - ASNItem(n, t, x); - if x = ASN1_SETOF then - while n < i do - begin - u := ASNItem(n, t, x); - a.Add(u); - end; - end; - end; - end; - end; - if FResponseCode = LDAP_ASN1_SEARCH_REFERENCE then - begin - n := 1; - while n < Length(t) do - FReferals.Add(ASNItem(n, t, x)); - end; - until FResponseCode = LDAP_ASN1_SEARCH_DONE; - n := 1; - ASNItem(n, t, x); - if x = LDAP_ASN1_CONTROLS then - begin - ASNItem(n, t, x); - if x = ASN1_SEQ then - begin - s := ASNItem(n, t, x); - if s = '1.2.840.113556.1.4.319' then - begin - s := ASNItem(n, t, x); // searchControlValue - n := 1; - ASNItem(n, s, x); - if x = ASN1_SEQ then - begin - ASNItem(n, s, x); // total number of result records, if known, otherwise 0 - FSearchCookie := ASNItem(n, s, x); // active search cookie, empty when done - end; - end; - end; - end; - Result := FResultCode = 0; -end; - -function TLDAPSend.Extended(const Name, Value: AnsiString): Boolean; -var - s, t: AnsiString; - x, xt: integer; -begin - s := ASNObject(Name, $80); - if Value <> '' then - s := s + ASNObject(Value, $81); - s := ASNObject(s, LDAP_ASN1_EXT_REQUEST); - Fsock.SendString(BuildPacket(s)); - s := ReceiveResponse; - t := DecodeResponse(s); - Result := FResultCode = 0; - if Result then - begin - x := 1; - FExtName := ASNItem(x, t, xt); - FExtValue := ASNItem(x, t, xt); - end; -end; - - -function TLDAPSend.StartTLS: Boolean; -begin - Result := Extended('1.3.6.1.4.1.1466.20037', ''); - if Result then - begin - Fsock.SSLDoConnect; - Result := FSock.LastError = 0; - end; -end; - -{==============================================================================} -function LDAPResultDump(const Value: TLDAPResultList): AnsiString; -var - n, m, o: integer; - r: TLDAPResult; - a: TLDAPAttribute; -begin - Result := 'Results: ' + IntToStr(Value.Count) + CRLF +CRLF; - for n := 0 to Value.Count - 1 do - begin - Result := Result + 'Result: ' + IntToStr(n) + CRLF; - r := Value[n]; - Result := Result + ' Object: ' + r.ObjectName + CRLF; - for m := 0 to r.Attributes.Count - 1 do - begin - a := r.Attributes[m]; - Result := Result + ' Attribute: ' + a.AttributeName + CRLF; - for o := 0 to a.Count - 1 do - Result := Result + ' ' + a[o] + CRLF; - end; - end; -end; - -end. diff --git a/3rd/synapse/source/mimeinln.pas b/3rd/synapse/source/mimeinln.pas deleted file mode 100644 index 924dd5fd2..000000000 --- a/3rd/synapse/source/mimeinln.pas +++ /dev/null @@ -1,263 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.011 | -|==============================================================================| -| Content: Inline MIME support procedures and functions | -|==============================================================================| -| Copyright (c)1999-2006, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2006. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Utilities for inline MIME) -Support for Inline MIME encoding and decoding. - -Used RFC: RFC-2047, RFC-2231 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit mimeinln; - -interface - -uses - SysUtils, Classes, - synachar, synacode, synautil; - -{:Decodes mime inline encoding (i.e. in headers) uses target characterset "CP".} -function InlineDecode(const Value: string; CP: TMimeChar): string; - -{:Encodes string to MIME inline encoding. The source characterset is "CP", and - the target charset is "MimeP".} -function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string; - -{:Returns @true, if "Value" contains characters needed for inline coding.} -function NeedInline(const Value: AnsiString): boolean; - -{:Inline mime encoding similar to @link(InlineEncode), but you can specify - source charset, and the target characterset is automatically assigned.} -function InlineCodeEx(const Value: string; FromCP: TMimeChar): string; - -{:Inline MIME encoding similar to @link(InlineEncode), but the source charset - is automatically set to the system default charset, and the target charset is - automatically assigned from set of allowed encoding for MIME.} -function InlineCode(const Value: string): string; - -{:Converts e-mail address to canonical mime form. You can specify source charset.} -function InlineEmailEx(const Value: string; FromCP: TMimeChar): string; - -{:Converts e-mail address to canonical mime form. Source charser it system - default charset.} -function InlineEmail(const Value: string): string; - -implementation - -{==============================================================================} - -function InlineDecode(const Value: string; CP: TMimeChar): string; -var - s, su, v: string; - x, y, z, n: Integer; - ichar: TMimeChar; - c: Char; - - function SearchEndInline(const Value: string; be: Integer): Integer; - var - n, q: Integer; - begin - q := 0; - Result := 0; - for n := be + 2 to Length(Value) - 1 do - if Value[n] = '?' then - begin - Inc(q); - if (q > 2) and (Value[n + 1] = '=') then - begin - Result := n; - Break; - end; - end; - end; - -begin - Result := ''; - v := Value; - x := Pos('=?', v); - y := SearchEndInline(v, x); - //fix for broken coding with begin, but not with end. - if (x > 0) and (y <= 0) then - y := Length(Result); - while (y > x) and (x > 0) do - begin - s := Copy(v, 1, x - 1); - if Trim(s) <> '' then - Result := Result + s; - s := Copy(v, x, y - x + 2); - Delete(v, 1, y + 1); - su := Copy(s, 3, Length(s) - 4); - z := Pos('?', su); - if (Length(su) >= (z + 2)) and (su[z + 2] = '?') then - begin - ichar := GetCPFromID(SeparateLeft(Copy(su, 1, z - 1), '*')); - c := UpperCase(su)[z + 1]; - su := Copy(su, z + 3, Length(su) - z - 2); - if c = 'B' then - begin - s := DecodeBase64(su); - s := CharsetConversion(s, ichar, CP); - end; - if c = 'Q' then - begin - s := ''; - for n := 1 to Length(su) do - if su[n] = '_' then - s := s + ' ' - else - s := s + su[n]; - s := DecodeQuotedPrintable(s); - s := CharsetConversion(s, ichar, CP); - end; - end; - Result := Result + s; - x := Pos('=?', v); - y := SearchEndInline(v, x); - end; - Result := Result + v; -end; - -{==============================================================================} - -function InlineEncode(const Value: string; CP, MimeP: TMimeChar): string; -var - s, s1, e: string; - n: Integer; -begin - s := CharsetConversion(Value, CP, MimeP); - s := EncodeSafeQuotedPrintable(s); - e := GetIdFromCP(MimeP); - s1 := ''; - Result := ''; - for n := 1 to Length(s) do - if s[n] = ' ' then - begin -// s1 := s1 + '=20'; - s1 := s1 + '_'; - if Length(s1) > 32 then - begin - if Result <> '' then - Result := Result + ' '; - Result := Result + '=?' + e + '?Q?' + s1 + '?='; - s1 := ''; - end; - end - else - s1 := s1 + s[n]; - if s1 <> '' then - begin - if Result <> '' then - Result := Result + ' '; - Result := Result + '=?' + e + '?Q?' + s1 + '?='; - end; -end; - -{==============================================================================} - -function NeedInline(const Value: AnsiString): boolean; -var - n: Integer; -begin - Result := False; - for n := 1 to Length(Value) do - if Value[n] in (SpecialChar + NonAsciiChar - ['_']) then - begin - Result := True; - Break; - end; -end; - -{==============================================================================} - -function InlineCodeEx(const Value: string; FromCP: TMimeChar): string; -var - c: TMimeChar; -begin - if NeedInline(Value) then - begin - c := IdealCharsetCoding(Value, FromCP, IdealCharsets); - Result := InlineEncode(Value, FromCP, c); - end - else - Result := Value; -end; - -{==============================================================================} - -function InlineCode(const Value: string): string; -begin - Result := InlineCodeEx(Value, GetCurCP); -end; - -{==============================================================================} - -function InlineEmailEx(const Value: string; FromCP: TMimeChar): string; -var - sd, se: string; -begin - sd := GetEmailDesc(Value); - se := GetEmailAddr(Value); - if sd = '' then - Result := se - else - Result := '"' + InlineCodeEx(sd, FromCP) + '" <' + se + '>'; -end; - -{==============================================================================} - -function InlineEmail(const Value: string): string; -begin - Result := InlineEmailEx(Value, GetCurCP); -end; - -end. diff --git a/3rd/synapse/source/mimemess.pas b/3rd/synapse/source/mimemess.pas deleted file mode 100644 index 0067b4ab8..000000000 --- a/3rd/synapse/source/mimemess.pas +++ /dev/null @@ -1,851 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.006.000 | -|==============================================================================| -| Content: MIME message object | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2012. | -| Portions created by Petr Fejfar are Copyright (c)2011-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM From distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(MIME message handling) -Classes for easy handling with e-mail message. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$M+} - -unit mimemess; - -interface - -uses - Classes, SysUtils, - mimepart, synachar, synautil, mimeinln; - -type - - {:Possible values for message priority} - TMessPriority = (MP_unknown, MP_low, MP_normal, MP_high); - - {:@abstract(Object for basic e-mail header fields.)} - TMessHeader = class(TObject) - private - FFrom: string; - FToList: TStringList; - FCCList: TStringList; - FSubject: string; - FOrganization: string; - FCustomHeaders: TStringList; - FDate: TDateTime; - FXMailer: string; - FCharsetCode: TMimeChar; - FReplyTo: string; - FMessageID: string; - FPriority: TMessPriority; - Fpri: TMessPriority; - Fxpri: TMessPriority; - Fxmspri: TMessPriority; - protected - function ParsePriority(value: string): TMessPriority; - function DecodeHeader(value: string): boolean; virtual; - public - constructor Create; virtual; - destructor Destroy; override; - - {:Clears all data fields.} - procedure Clear; virtual; - - {Add headers from from this object to Value.} - procedure EncodeHeaders(const Value: TStrings); virtual; - - {:Parse header from Value to this object.} - procedure DecodeHeaders(const Value: TStrings); - - {:Try find specific header in CustomHeader. Search is case insensitive. - This is good for reading any non-parsed header.} - function FindHeader(Value: string): string; - - {:Try find specific headers in CustomHeader. This metod is for repeatly used - headers like 'received' header, etc. Search is case insensitive. - This is good for reading ano non-parsed header.} - procedure FindHeaderList(Value: string; const HeaderList: TStrings); - published - {:Sender of message.} - property From: string read FFrom Write FFrom; - - {:Stringlist with receivers of message. (one per line)} - property ToList: TStringList read FToList; - - {:Stringlist with Carbon Copy receivers of message. (one per line)} - property CCList: TStringList read FCCList; - - {:Subject of message.} - property Subject: string read FSubject Write FSubject; - - {:Organization string.} - property Organization: string read FOrganization Write FOrganization; - - {:After decoding contains all headers lines witch not have parsed to any - other structures in this object. It mean: this conatins all other headers - except: - - X-MAILER, FROM, SUBJECT, ORGANIZATION, TO, CC, DATE, MIME-VERSION, - CONTENT-TYPE, CONTENT-DESCRIPTION, CONTENT-DISPOSITION, CONTENT-ID, - CONTENT-TRANSFER-ENCODING, REPLY-TO, MESSAGE-ID, X-MSMAIL-PRIORITY, - X-PRIORITY, PRIORITY - - When you encode headers, all this lines is added as headers. Be carefull - for duplicites!} - property CustomHeaders: TStringList read FCustomHeaders; - - {:Date and time of message.} - property Date: TDateTime read FDate Write FDate; - - {:Mailer identification.} - property XMailer: string read FXMailer Write FXMailer; - - {:Address for replies} - property ReplyTo: string read FReplyTo Write FReplyTo; - - {:message indetifier} - property MessageID: string read FMessageID Write FMessageID; - - {:message priority} - property Priority: TMessPriority read FPriority Write FPriority; - - {:Specify base charset. By default is used system charset.} - property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode; - end; - - TMessHeaderClass = class of TMessHeader; - - {:@abstract(Object for handling of e-mail message.)} - TMimeMess = class(TObject) - private - FMessagePart: TMimePart; - FLines: TStringList; - FHeader: TMessHeader; - public - constructor Create; - {:create this object and assign your own descendant of @link(TMessHeader) - object to @link(header) property. So, you can create your own message - headers parser and use it by this object.} - constructor CreateAltHeaders(HeadClass: TMessHeaderClass); - destructor Destroy; override; - - {:Reset component to default state.} - procedure Clear; virtual; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then one subpart, - you must have PartParent of multipart type!} - function AddPart(const PartParent: TMimePart): TMimePart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - This part is marked as multipart with secondary MIME type specified by - MultipartType parameter. (typical value is 'mixed') - - This part can be used as PartParent for another parts (include next - multipart). If you need only one part, then you not need Multipart part.} - function AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - After creation of part set type to text part and set all necessary - properties. Content of part is readed from value stringlist.} - function AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - After creation of part set type to text part and set all necessary - properties. Content of part is readed from value stringlist. You can select - your charset and your encoding type. If Raw is @true, then it not doing - charset conversion!} - function AddPartTextEx(const Value: TStrings; const PartParent: TMimePart; - PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - After creation of part set type to text part to HTML type and set all - necessary properties. Content of HTML part is readed from Value stringlist.} - function AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart; - - {:Same as @link(AddPartText), but content is readed from file} - function AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart; - - {:Same as @link(AddPartHTML), but content is readed from file} - function AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, - you must have PartParent of multipart type! - - After creation of part set type to binary and set all necessary properties. - MIME primary and secondary types defined automaticly by filename extension. - Content of binary part is readed from Stream. This binary part is encoded - as file attachment.} - function AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart; - - {:Same as @link(AddPartBinary), but content is readed from file} - function AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - After creation of part set type to binary and set all necessary properties. - MIME primary and secondary types defined automaticly by filename extension. - Content of binary part is readed from Stream. - - This binary part is encoded as inline data with given Conten ID (cid). - Content ID can be used as reference ID in HTML source in HTML part.} - function AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart; - - {:Same as @link(AddPartHTMLBinary), but content is readed from file} - function AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart; - - {:Add MIME part as subpart of PartParent. If you need set root MIME part, - then set as PartParent @NIL value. If you need set more then 1 subpart, you - must have PartParent of multipart type! - - After creation of part set type to message and set all necessary properties. - MIME primary and secondary types are setted to 'message/rfc822'. - Content of raw RFC-822 message is readed from Stream.} - function AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart; - - {:Same as @link(AddPartMess), but content is readed from file} - function AddPartMessFromFile(const FileName: string; const PartParent: TMimePart): TMimepart; - - {:Compose message from @link(MessagePart) to @link(Lines). Headers from - @link(Header) object is added also.} - procedure EncodeMessage; virtual; - - {:Decode message from @link(Lines) to @link(MessagePart). Massage headers - are parsed into @link(Header) object.} - procedure DecodeMessage; virtual; - - {pf} - {: HTTP message is received by @link(THTTPSend) component in two parts: - headers are stored in @link(THTTPSend.Headers) and a body in memory stream - @link(THTTPSend.Document). - - On the top of it, HTTP connections are always 8-bit, hence data are - transferred in native format i.e. no transfer encoding is applied. - - This method operates the similiar way and produces the same - result as @link(DecodeMessage). - } - procedure DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream); - {/pf} - published - {:@link(TMimePart) object with decoded MIME message. This object can handle - any number of nested @link(TMimePart) objects itself. It is used for handle - any tree of MIME subparts.} - property MessagePart: TMimePart read FMessagePart; - - {:Raw MIME encoded message.} - property Lines: TStringList read FLines; - - {:Object for e-mail header fields. This object is created automaticly. - Do not free this object!} - property Header: TMessHeader read FHeader; - end; - -implementation - -{==============================================================================} - -constructor TMessHeader.Create; -begin - inherited Create; - FToList := TStringList.Create; - FCCList := TStringList.Create; - FCustomHeaders := TStringList.Create; - FCharsetCode := GetCurCP; -end; - -destructor TMessHeader.Destroy; -begin - FCustomHeaders.Free; - FCCList.Free; - FToList.Free; - inherited Destroy; -end; - -{==============================================================================} - -procedure TMessHeader.Clear; -begin - FFrom := ''; - FToList.Clear; - FCCList.Clear; - FSubject := ''; - FOrganization := ''; - FCustomHeaders.Clear; - FDate := 0; - FXMailer := ''; - FReplyTo := ''; - FMessageID := ''; - FPriority := MP_unknown; -end; - -procedure TMessHeader.EncodeHeaders(const Value: TStrings); -var - n: Integer; - s: string; -begin - if FDate = 0 then - FDate := Now; - for n := FCustomHeaders.Count - 1 downto 0 do - if FCustomHeaders[n] <> '' then - Value.Insert(0, FCustomHeaders[n]); - if FPriority <> MP_unknown then - case FPriority of - MP_high: - begin - Value.Insert(0, 'X-MSMAIL-Priority: High'); - Value.Insert(0, 'X-Priority: 1'); - Value.Insert(0, 'Priority: urgent'); - end; - MP_low: - begin - Value.Insert(0, 'X-MSMAIL-Priority: low'); - Value.Insert(0, 'X-Priority: 5'); - Value.Insert(0, 'Priority: non-urgent'); - end; - end; - if FReplyTo <> '' then - Value.Insert(0, 'Reply-To: ' + GetEmailAddr(FReplyTo)); - if FMessageID <> '' then - Value.Insert(0, 'Message-ID: <' + trim(FMessageID) + '>'); - if FXMailer = '' then - Value.Insert(0, 'X-mailer: Synapse - Pascal TCP/IP library by Lukas Gebauer') - else - Value.Insert(0, 'X-mailer: ' + FXMailer); - Value.Insert(0, 'MIME-Version: 1.0 (produced by Synapse)'); - if FOrganization <> '' then - Value.Insert(0, 'Organization: ' + InlineCodeEx(FOrganization, FCharsetCode)); - s := ''; - for n := 0 to FCCList.Count - 1 do - if s = '' then - s := InlineEmailEx(FCCList[n], FCharsetCode) - else - s := s + ', ' + InlineEmailEx(FCCList[n], FCharsetCode); - if s <> '' then - Value.Insert(0, 'CC: ' + s); - Value.Insert(0, 'Date: ' + Rfc822DateTime(FDate)); - if FSubject <> '' then - Value.Insert(0, 'Subject: ' + InlineCodeEx(FSubject, FCharsetCode)); - s := ''; - for n := 0 to FToList.Count - 1 do - if s = '' then - s := InlineEmailEx(FToList[n], FCharsetCode) - else - s := s + ', ' + InlineEmailEx(FToList[n], FCharsetCode); - if s <> '' then - Value.Insert(0, 'To: ' + s); - Value.Insert(0, 'From: ' + InlineEmailEx(FFrom, FCharsetCode)); -end; - -function TMessHeader.ParsePriority(value: string): TMessPriority; -var - s: string; - x: integer; -begin - Result := MP_unknown; - s := Trim(separateright(value, ':')); - s := Separateleft(s, ' '); - x := StrToIntDef(s, -1); - if x >= 0 then - case x of - 1, 2: - Result := MP_High; - 3: - Result := MP_Normal; - 4, 5: - Result := MP_Low; - end - else - begin - s := lowercase(s); - if (s = 'urgent') or (s = 'high') or (s = 'highest') then - Result := MP_High; - if (s = 'normal') or (s = 'medium') then - Result := MP_Normal; - if (s = 'low') or (s = 'lowest') - or (s = 'no-priority') or (s = 'non-urgent') then - Result := MP_Low; - end; -end; - -function TMessHeader.DecodeHeader(value: string): boolean; -var - s, t: string; - cp: TMimeChar; -begin - Result := True; - cp := FCharsetCode; - s := uppercase(value); - if Pos('X-MAILER:', s) = 1 then - begin - FXMailer := Trim(SeparateRight(Value, ':')); - Exit; - end; - if Pos('FROM:', s) = 1 then - begin - FFrom := InlineDecode(Trim(SeparateRight(Value, ':')), cp); - Exit; - end; - if Pos('SUBJECT:', s) = 1 then - begin - FSubject := InlineDecode(Trim(SeparateRight(Value, ':')), cp); - Exit; - end; - if Pos('ORGANIZATION:', s) = 1 then - begin - FOrganization := InlineDecode(Trim(SeparateRight(Value, ':')), cp); - Exit; - end; - if Pos('TO:', s) = 1 then - begin - s := Trim(SeparateRight(Value, ':')); - repeat - t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp); - if t <> '' then - FToList.Add(t); - until s = ''; - Exit; - end; - if Pos('CC:', s) = 1 then - begin - s := Trim(SeparateRight(Value, ':')); - repeat - t := InlineDecode(Trim(FetchEx(s, ',', '"')), cp); - if t <> '' then - FCCList.Add(t); - until s = ''; - Exit; - end; - if Pos('DATE:', s) = 1 then - begin - FDate := DecodeRfcDateTime(Trim(SeparateRight(Value, ':'))); - Exit; - end; - if Pos('REPLY-TO:', s) = 1 then - begin - FReplyTo := InlineDecode(Trim(SeparateRight(Value, ':')), cp); - Exit; - end; - if Pos('MESSAGE-ID:', s) = 1 then - begin - FMessageID := GetEmailAddr(Trim(SeparateRight(Value, ':'))); - Exit; - end; - if Pos('PRIORITY:', s) = 1 then - begin - FPri := ParsePriority(value); - Exit; - end; - if Pos('X-PRIORITY:', s) = 1 then - begin - FXPri := ParsePriority(value); - Exit; - end; - if Pos('X-MSMAIL-PRIORITY:', s) = 1 then - begin - FXmsPri := ParsePriority(value); - Exit; - end; - if Pos('MIME-VERSION:', s) = 1 then - Exit; - if Pos('CONTENT-TYPE:', s) = 1 then - Exit; - if Pos('CONTENT-DESCRIPTION:', s) = 1 then - Exit; - if Pos('CONTENT-DISPOSITION:', s) = 1 then - Exit; - if Pos('CONTENT-ID:', s) = 1 then - Exit; - if Pos('CONTENT-TRANSFER-ENCODING:', s) = 1 then - Exit; - Result := False; -end; - -procedure TMessHeader.DecodeHeaders(const Value: TStrings); -var - s: string; - x: Integer; -begin - Clear; - Fpri := MP_unknown; - Fxpri := MP_unknown; - Fxmspri := MP_unknown; - x := 0; - while Value.Count > x do - begin - s := NormalizeHeader(Value, x); - if s = '' then - Break; - if not DecodeHeader(s) then - FCustomHeaders.Add(s); - end; - if Fpri <> MP_unknown then - FPriority := Fpri - else - if Fxpri <> MP_unknown then - FPriority := Fxpri - else - if Fxmspri <> MP_unknown then - FPriority := Fxmspri -end; - -function TMessHeader.FindHeader(Value: string): string; -var - n: integer; -begin - Result := ''; - for n := 0 to FCustomHeaders.Count - 1 do - if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then - begin - Result := Trim(SeparateRight(FCustomHeaders[n], ':')); - break; - end; -end; - -procedure TMessHeader.FindHeaderList(Value: string; const HeaderList: TStrings); -var - n: integer; -begin - HeaderList.Clear; - for n := 0 to FCustomHeaders.Count - 1 do - if Pos(UpperCase(Value), UpperCase(FCustomHeaders[n])) = 1 then - begin - HeaderList.Add(Trim(SeparateRight(FCustomHeaders[n], ':'))); - end; -end; - -{==============================================================================} - -constructor TMimeMess.Create; -begin - CreateAltHeaders(TMessHeader); -end; - -constructor TMimeMess.CreateAltHeaders(HeadClass: TMessHeaderClass); -begin - inherited Create; - FMessagePart := TMimePart.Create; - FLines := TStringList.Create; - FHeader := HeadClass.Create; -end; - -destructor TMimeMess.Destroy; -begin - FMessagePart.Free; - FHeader.Free; - FLines.Free; - inherited Destroy; -end; - -{==============================================================================} - -procedure TMimeMess.Clear; -begin - FMessagePart.Clear; - FLines.Clear; - FHeader.Clear; -end; - -{==============================================================================} - -function TMimeMess.AddPart(const PartParent: TMimePart): TMimePart; -begin - if PartParent = nil then - Result := FMessagePart - else - Result := PartParent.AddSubPart; - Result.Clear; -end; - -{==============================================================================} - -function TMimeMess.AddPartMultipart(const MultipartType: String; const PartParent: TMimePart): TMimePart; -begin - Result := AddPart(PartParent); - with Result do - begin - Primary := 'Multipart'; - Secondary := MultipartType; - Description := 'Multipart message'; - Boundary := GenerateBoundary; - EncodePartHeader; - end; -end; - -function TMimeMess.AddPartText(const Value: TStrings; const PartParent: TMimePart): TMimepart; -begin - Result := AddPart(PartParent); - with Result do - begin - Value.SaveToStream(DecodedLines); - Primary := 'text'; - Secondary := 'plain'; - Description := 'Message text'; - Disposition := 'inline'; - CharsetCode := IdealCharsetCoding(Value.Text, TargetCharset, IdealCharsets); - EncodingCode := ME_QUOTED_PRINTABLE; - EncodePart; - EncodePartHeader; - end; -end; - -function TMimeMess.AddPartTextEx(const Value: TStrings; const PartParent: TMimePart; - PartCharset: TMimeChar; Raw: Boolean; PartEncoding: TMimeEncoding): TMimepart; -begin - Result := AddPart(PartParent); - with Result do - begin - Value.SaveToStream(DecodedLines); - Primary := 'text'; - Secondary := 'plain'; - Description := 'Message text'; - Disposition := 'inline'; - CharsetCode := PartCharset; - EncodingCode := PartEncoding; - ConvertCharset := not Raw; - EncodePart; - EncodePartHeader; - end; -end; - -function TMimeMess.AddPartHTML(const Value: TStrings; const PartParent: TMimePart): TMimepart; -begin - Result := AddPart(PartParent); - with Result do - begin - Value.SaveToStream(DecodedLines); - Primary := 'text'; - Secondary := 'html'; - Description := 'HTML text'; - Disposition := 'inline'; - CharsetCode := UTF_8; - EncodingCode := ME_QUOTED_PRINTABLE; - EncodePart; - EncodePartHeader; - end; -end; - -function TMimeMess.AddPartTextFromFile(const FileName: String; const PartParent: TMimePart): TMimepart; -var - tmp: TStrings; -begin - tmp := TStringList.Create; - try - tmp.LoadFromFile(FileName); - Result := AddPartText(tmp, PartParent); - Finally - tmp.Free; - end; -end; - -function TMimeMess.AddPartHTMLFromFile(const FileName: String; const PartParent: TMimePart): TMimepart; -var - tmp: TStrings; -begin - tmp := TStringList.Create; - try - tmp.LoadFromFile(FileName); - Result := AddPartHTML(tmp, PartParent); - Finally - tmp.Free; - end; -end; - -function TMimeMess.AddPartBinary(const Stream: TStream; const FileName: string; const PartParent: TMimePart): TMimepart; -begin - Result := AddPart(PartParent); - Result.DecodedLines.LoadFromStream(Stream); - Result.MimeTypeFromExt(FileName); - Result.Description := 'Attached file: ' + FileName; - Result.Disposition := 'attachment'; - Result.FileName := FileName; - Result.EncodingCode := ME_BASE64; - Result.EncodePart; - Result.EncodePartHeader; -end; - -function TMimeMess.AddPartBinaryFromFile(const FileName: string; const PartParent: TMimePart): TMimepart; -var - tmp: TMemoryStream; -begin - tmp := TMemoryStream.Create; - try - tmp.LoadFromFile(FileName); - Result := AddPartBinary(tmp, ExtractFileName(FileName), PartParent); - finally - tmp.Free; - end; -end; - -function TMimeMess.AddPartHTMLBinary(const Stream: TStream; const FileName, Cid: string; const PartParent: TMimePart): TMimepart; -begin - Result := AddPart(PartParent); - Result.DecodedLines.LoadFromStream(Stream); - Result.MimeTypeFromExt(FileName); - Result.Description := 'Included file: ' + FileName; - Result.Disposition := 'inline'; - Result.ContentID := Cid; - Result.FileName := FileName; - Result.EncodingCode := ME_BASE64; - Result.EncodePart; - Result.EncodePartHeader; -end; - -function TMimeMess.AddPartHTMLBinaryFromFile(const FileName, Cid: string; const PartParent: TMimePart): TMimepart; -var - tmp: TMemoryStream; -begin - tmp := TMemoryStream.Create; - try - tmp.LoadFromFile(FileName); - Result :=AddPartHTMLBinary(tmp, ExtractFileName(FileName), Cid, PartParent); - finally - tmp.Free; - end; -end; - -function TMimeMess.AddPartMess(const Value: TStrings; const PartParent: TMimePart): TMimepart; -var - part: Tmimepart; -begin - Result := AddPart(PartParent); - part := AddPart(result); - part.lines.addstrings(Value); - part.DecomposeParts; - with Result do - begin - Primary := 'message'; - Secondary := 'rfc822'; - Description := 'E-mail Message'; - EncodePart; - EncodePartHeader; - end; -end; - -function TMimeMess.AddPartMessFromFile(const FileName: String; const PartParent: TMimePart): TMimepart; -var - tmp: TStrings; -begin - tmp := TStringList.Create; - try - tmp.LoadFromFile(FileName); - Result := AddPartMess(tmp, PartParent); - Finally - tmp.Free; - end; -end; - -{==============================================================================} - -procedure TMimeMess.EncodeMessage; -var - l: TStringList; - x: integer; -begin - //merge headers from THeaders and header field from MessagePart - l := TStringList.Create; - try - FHeader.EncodeHeaders(l); - x := IndexByBegin('CONTENT-TYPE', FMessagePart.Headers); - if x >= 0 then - l.add(FMessagePart.Headers[x]); - x := IndexByBegin('CONTENT-DESCRIPTION', FMessagePart.Headers); - if x >= 0 then - l.add(FMessagePart.Headers[x]); - x := IndexByBegin('CONTENT-DISPOSITION', FMessagePart.Headers); - if x >= 0 then - l.add(FMessagePart.Headers[x]); - x := IndexByBegin('CONTENT-ID', FMessagePart.Headers); - if x >= 0 then - l.add(FMessagePart.Headers[x]); - x := IndexByBegin('CONTENT-TRANSFER-ENCODING', FMessagePart.Headers); - if x >= 0 then - l.add(FMessagePart.Headers[x]); - FMessagePart.Headers.Assign(l); - finally - l.Free; - end; - FMessagePart.ComposeParts; - FLines.Assign(FMessagePart.Lines); -end; - -{==============================================================================} - -procedure TMimeMess.DecodeMessage; -begin - FHeader.Clear; - FHeader.DecodeHeaders(FLines); - FMessagePart.Lines.Assign(FLines); - FMessagePart.DecomposeParts; -end; - -{pf} -procedure TMimeMess.DecodeMessageBinary(AHeader:TStrings; AData:TMemoryStream); -begin - FHeader.Clear; - FLines.Clear; - FLines.Assign(AHeader); - FHeader.DecodeHeaders(FLines); - FMessagePart.DecomposePartsBinary(AHeader,PANSIChar(AData.Memory),PANSIChar(AData.Memory)+AData.Size); -end; -{/pf} - -end. diff --git a/3rd/synapse/source/mimepart.pas b/3rd/synapse/source/mimepart.pas deleted file mode 100644 index a637e676b..000000000 --- a/3rd/synapse/source/mimepart.pas +++ /dev/null @@ -1,1227 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.009.000 | -|==============================================================================| -| Content: MIME support procedures and functions | -|==============================================================================| -| Copyright (c)1999-200812 | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2012. | -| Portions created by Petr Fejfar are Copyright (c)2011-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(MIME part handling) -Handling with MIME parts. - -Used RFC: RFC-2045 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$Q-} -{$R-} -{$M+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit mimepart; - -interface - -uses - SysUtils, Classes, - synafpc, - synachar, synacode, synautil, mimeinln; - -type - - TMimePart = class; - - {:@abstract(Procedural type for @link(TMimepart.Walkpart) hook). This hook is used for - easy walking through MIME subparts.} - THookWalkPart = procedure(const Sender: TMimePart) of object; - - {:The four types of MIME parts. (textual, multipart, message or any other - binary data.)} - TMimePrimary = (MP_TEXT, MP_MULTIPART, MP_MESSAGE, MP_BINARY); - - {:The various types of possible part encodings.} - TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE, - ME_BASE64, ME_UU, ME_XX); - - {:@abstract(Object for working with parts of MIME e-mail.) - Each TMimePart object can handle any number of nested subparts as new - TMimepart objects. It can handle any tree hierarchy structure of nested MIME - subparts itself. - - Basic tasks are: - - Decoding of MIME message: - - store message into Lines property - - call DecomposeParts. Now you have decomposed MIME parts in all nested levels! - - now you can explore all properties and subparts. (You can use WalkPart method) - - if you need decode part, call DecodePart. - - Encoding of MIME message: - - - if you need multipart message, you must create subpart by AddSubPart. - - set all properties of all parts. - - set content of part into DecodedLines stream - - encode this stream by EncodePart. - - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!) - - encoded MIME message is stored in Lines property. - } - TMimePart = class(TObject) - private - FPrimary: string; - FPrimaryCode: TMimePrimary; - FSecondary: string; - FEncoding: string; - FEncodingCode: TMimeEncoding; - FDefaultCharset: string; - FCharset: string; - FCharsetCode: TMimeChar; - FTargetCharset: TMimeChar; - FDescription: string; - FDisposition: string; - FContentID: string; - FBoundary: string; - FFileName: string; - FLines: TStringList; - FPartBody: TStringList; - FHeaders: TStringList; - FPrePart: TStringList; - FPostPart: TStringList; - FDecodedLines: TMemoryStream; - FSubParts: TList; - FOnWalkPart: THookWalkPart; - FMaxLineLength: integer; - FSubLevel: integer; - FMaxSubLevel: integer; - FAttachInside: boolean; - FConvertCharset: Boolean; - FForcedHTMLConvert: Boolean; - FBinaryDecomposer: boolean; - procedure SetPrimary(Value: string); - procedure SetEncoding(Value: string); - procedure SetCharset(Value: string); - function IsUUcode(Value: string): boolean; - public - constructor Create; - destructor Destroy; override; - - {:Assign content of another object to this object. (Only this part, - not subparts!)} - procedure Assign(Value: TMimePart); - - {:Assign content of another object to this object. (With all subparts!)} - procedure AssignSubParts(Value: TMimePart); - - {:Clear all data values to default values. It also call @link(ClearSubparts).} - procedure Clear; - - {:Decode Mime part from @link(Lines) to @link(DecodedLines).} - procedure DecodePart; - - {:Parse header lines from Headers property into another properties.} - procedure DecodePartHeader; - - {:Encode mime part from @link(DecodedLines) to @link(Lines) and build mime - headers.} - procedure EncodePart; - - {:Build header lines in Headers property from another properties.} - procedure EncodePartHeader; - - {:generate primary and secondary mime type from filename extension in value. - If type not recognised, it return 'Application/octet-string' type.} - procedure MimeTypeFromExt(Value: string); - - {:Return number of decomposed subparts. (On this level! Each of this - subparts can hold any number of their own nested subparts!)} - function GetSubPartCount: integer; - - {:Get nested subpart object as new TMimePart. For getting maximum possible - index you can use @link(GetSubPartCount) method.} - function GetSubPart(index: integer): TMimePart; - - {:delete subpart on given index.} - procedure DeleteSubPart(index: integer); - - {:Clear and destroy all subpart TMimePart objects.} - procedure ClearSubParts; - - {:Add and create new subpart.} - function AddSubPart: TMimePart; - - {:E-mail message in @link(Lines) property is parsed into this object. - E-mail headers are stored in @link(Headers) property and is parsed into - another properties automaticly. Not need call @link(DecodePartHeader)! - Content of message (part) is stored into @link(PartBody) property. This - part is in undecoded form! If you need decode it, then you must call - @link(DecodePart) method by your hands. Lot of another properties is filled - also. - - Decoding of parts you must call separately due performance reasons. (Not - needed to decode all parts in all reasons.) - - For each MIME subpart is created new TMimepart object (accessible via - method @link(GetSubPart)).} - procedure DecomposeParts; - - {pf} - {: HTTP message is received by @link(THTTPSend) component in two parts: - headers are stored in @link(THTTPSend.Headers) and a body in memory stream - @link(THTTPSend.Document). - - On the top of it, HTTP connections are always 8-bit, hence data are - transferred in native format i.e. no transfer encoding is applied. - - This method operates the similiar way and produces the same - result as @link(DecomposeParts). - } - procedure DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar); - {/pf} - - {:This part and all subparts is composed into one MIME message stored in - @link(Lines) property.} - procedure ComposeParts; - - {:By calling this method is called @link(OnWalkPart) event for each part - and their subparts. It is very good for calling some code for each part in - MIME message} - procedure WalkPart; - - {:Return @true when is possible create next subpart. (@link(maxSublevel) - is still not reached)} - function CanSubPart: boolean; - published - {:Primary Mime type of part. (i.e. 'application') Writing to this property - automaticly generate value of @link(PrimaryCode).} - property Primary: string read FPrimary write SetPrimary; - - {:String representation of used Mime encoding in part. (i.e. 'base64') - Writing to this property automaticly generate value of @link(EncodingCode).} - property Encoding: string read FEncoding write SetEncoding; - - {:String representation of used Mime charset in part. (i.e. 'iso-8859-1') - Writing to this property automaticly generate value of @link(CharsetCode). - Charset is used only for text parts.} - property Charset: string read FCharset write SetCharset; - - {:Define default charset for decoding text MIME parts without charset - specification. Default value is 'ISO-8859-1' by RCF documents. - But Microsoft Outlook use windows codings as default. This property allows - properly decode textual parts from some broken versions of Microsoft - Outlook. (this is bad software!)} - property DefaultCharset: string read FDefaultCharset write FDefaultCharset; - - {:Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART, - MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.} - property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode; - - {:Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT, - ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is - ME_7BIT.} - property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode; - - {:Decoded charset type. Possible values are defined in @link(SynaChar) unit.} - property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode; - - {:System charset type. Default value is charset used by default in your - operating system.} - property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset; - - {:If @true, then do internal charset translation of part content between @link(CharsetCode) - and @link(TargetCharset)} - property ConvertCharset: Boolean read FConvertCharset Write FConvertCharset; - - {:If @true, then allways do internal charset translation of HTML parts - by MIME even it have their own charset in META tag. Default is @false.} - property ForcedHTMLConvert: Boolean read FForcedHTMLConvert Write FForcedHTMLConvert; - - {:Secondary Mime type of part. (i.e. 'mixed')} - property Secondary: string read FSecondary Write FSecondary; - - {:Description of Mime part.} - property Description: string read FDescription Write FDescription; - - {:Value of content disposition field. (i.e. 'inline' or 'attachment')} - property Disposition: string read FDisposition Write FDisposition; - - {:Content ID.} - property ContentID: string read FContentID Write FContentID; - - {:Boundary delimiter of multipart Mime part. Used only in multipart part.} - property Boundary: string read FBoundary Write FBoundary; - - {:Filename of file in binary part.} - property FileName: string read FFileName Write FFileName; - - {:String list with lines contains mime part (It can be a full message).} - property Lines: TStringList read FLines; - - {:Encoded form of MIME part data.} - property PartBody: TStringList read FPartBody; - - {:All header lines of MIME part.} - property Headers: TStringList read FHeaders; - - {:On multipart this contains part of message between first line of message - and first boundary.} - property PrePart: TStringList read FPrePart; - - {:On multipart this contains part of message between last boundary and end - of message.} - property PostPart: TStringList read FPostPart; - - {:Stream with decoded form of budy part.} - property DecodedLines: TMemoryStream read FDecodedLines; - - {:Show nested level in subpart tree. Value 0 means root part. 1 means - subpart from this root. etc.} - property SubLevel: integer read FSubLevel write FSubLevel; - - {:Specify maximum sublevel value for decomposing.} - property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel; - - {:When is @true, then this part maybe(!) have included some uuencoded binary - data.} - property AttachInside: boolean read FAttachInside; - - {:Here you can assign hook procedure for walking through all part and their - subparts.} - property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart; - - {:Here you can specify maximum line length for encoding of MIME part. - If line is longer, then is splitted by standard of MIME. Correct MIME - mailers can de-split this line into original length.} - property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength; - end; - -const - MaxMimeType = 25; - MimeType: array[0..MaxMimeType, 0..2] of string = - ( - ('AU', 'audio', 'basic'), - ('AVI', 'video', 'x-msvideo'), - ('BMP', 'image', 'BMP'), - ('DOC', 'application', 'MSWord'), - ('EPS', 'application', 'Postscript'), - ('GIF', 'image', 'GIF'), - ('JPEG', 'image', 'JPEG'), - ('JPG', 'image', 'JPEG'), - ('MID', 'audio', 'midi'), - ('MOV', 'video', 'quicktime'), - ('MPEG', 'video', 'MPEG'), - ('MPG', 'video', 'MPEG'), - ('MP2', 'audio', 'mpeg'), - ('MP3', 'audio', 'mpeg'), - ('PDF', 'application', 'PDF'), - ('PNG', 'image', 'PNG'), - ('PS', 'application', 'Postscript'), - ('QT', 'video', 'quicktime'), - ('RA', 'audio', 'x-realaudio'), - ('RTF', 'application', 'RTF'), - ('SND', 'audio', 'basic'), - ('TIF', 'image', 'TIFF'), - ('TIFF', 'image', 'TIFF'), - ('WAV', 'audio', 'x-wav'), - ('WPD', 'application', 'Wordperfect5.1'), - ('ZIP', 'application', 'ZIP') - ); - -{:Generates a unique boundary string.} -function GenerateBoundary: string; - -implementation - -{==============================================================================} - -constructor TMIMEPart.Create; -begin - inherited Create; - FOnWalkPart := nil; - FLines := TStringList.Create; - FPartBody := TStringList.Create; - FHeaders := TStringList.Create; - FPrePart := TStringList.Create; - FPostPart := TStringList.Create; - FDecodedLines := TMemoryStream.Create; - FSubParts := TList.Create; - FTargetCharset := GetCurCP; - //was 'US-ASCII' before, but RFC-ignorant Outlook sometimes using default - //system charset instead. - FDefaultCharset := GetIDFromCP(GetCurCP); - FMaxLineLength := 78; - FSubLevel := 0; - FMaxSubLevel := -1; - FAttachInside := false; - FConvertCharset := true; - FForcedHTMLConvert := false; -end; - -destructor TMIMEPart.Destroy; -begin - ClearSubParts; - FSubParts.Free; - FDecodedLines.Free; - FPartBody.Free; - FLines.Free; - FHeaders.Free; - FPrePart.Free; - FPostPart.Free; - inherited Destroy; -end; - -{==============================================================================} - -procedure TMIMEPart.Clear; -begin - FPrimary := ''; - FEncoding := ''; - FCharset := ''; - FPrimaryCode := MP_TEXT; - FEncodingCode := ME_7BIT; - FCharsetCode := ISO_8859_1; - FTargetCharset := GetCurCP; - FSecondary := ''; - FDisposition := ''; - FContentID := ''; - FDescription := ''; - FBoundary := ''; - FFileName := ''; - FAttachInside := False; - FPartBody.Clear; - FHeaders.Clear; - FPrePart.Clear; - FPostPart.Clear; - FDecodedLines.Clear; - FConvertCharset := true; - FForcedHTMLConvert := false; - ClearSubParts; -end; - -{==============================================================================} - -procedure TMIMEPart.Assign(Value: TMimePart); -begin - Primary := Value.Primary; - Encoding := Value.Encoding; - Charset := Value.Charset; - DefaultCharset := Value.DefaultCharset; - PrimaryCode := Value.PrimaryCode; - EncodingCode := Value.EncodingCode; - CharsetCode := Value.CharsetCode; - TargetCharset := Value.TargetCharset; - Secondary := Value.Secondary; - Description := Value.Description; - Disposition := Value.Disposition; - ContentID := Value.ContentID; - Boundary := Value.Boundary; - FileName := Value.FileName; - Lines.Assign(Value.Lines); - PartBody.Assign(Value.PartBody); - Headers.Assign(Value.Headers); - PrePart.Assign(Value.PrePart); - PostPart.Assign(Value.PostPart); - MaxLineLength := Value.MaxLineLength; - FAttachInside := Value.AttachInside; - FConvertCharset := Value.ConvertCharset; -end; - -{==============================================================================} - -procedure TMIMEPart.AssignSubParts(Value: TMimePart); -var - n: integer; - p: TMimePart; -begin - Assign(Value); - for n := 0 to Value.GetSubPartCount - 1 do - begin - p := AddSubPart; - p.AssignSubParts(Value.GetSubPart(n)); - end; -end; - -{==============================================================================} - -function TMIMEPart.GetSubPartCount: integer; -begin - Result := FSubParts.Count; -end; - -{==============================================================================} - -function TMIMEPart.GetSubPart(index: integer): TMimePart; -begin - Result := nil; - if Index < GetSubPartCount then - Result := TMimePart(FSubParts[Index]); -end; - -{==============================================================================} - -procedure TMIMEPart.DeleteSubPart(index: integer); -begin - if Index < GetSubPartCount then - begin - GetSubPart(Index).Free; - FSubParts.Delete(Index); - end; -end; - -{==============================================================================} - -procedure TMIMEPart.ClearSubParts; -var - n: integer; -begin - for n := 0 to GetSubPartCount - 1 do - TMimePart(FSubParts[n]).Free; - FSubParts.Clear; -end; - -{==============================================================================} - -function TMIMEPart.AddSubPart: TMimePart; -begin - Result := TMimePart.Create; - Result.DefaultCharset := FDefaultCharset; - FSubParts.Add(Result); - Result.SubLevel := FSubLevel + 1; - Result.MaxSubLevel := FMaxSubLevel; -end; - -{==============================================================================} - -procedure TMIMEPart.DecomposeParts; -var - x: integer; - s: string; - Mime: TMimePart; - - procedure SkipEmpty; - begin - while FLines.Count > x do - begin - s := TrimRight(FLines[x]); - if s <> '' then - Break; - Inc(x); - end; - end; - -begin - FBinaryDecomposer := false; - x := 0; - Clear; - //extract headers - while FLines.Count > x do - begin - s := NormalizeHeader(FLines, x); - if s = '' then - Break; - FHeaders.Add(s); - end; - DecodePartHeader; - //extract prepart - if FPrimaryCode = MP_MULTIPART then - begin - while FLines.Count > x do - begin - s := FLines[x]; - Inc(x); - if TrimRight(s) = '--' + FBoundary then - Break; - FPrePart.Add(s); - if not FAttachInside then - FAttachInside := IsUUcode(s); - end; - end; - //extract body part - if FPrimaryCode = MP_MULTIPART then - begin - repeat - if CanSubPart then - begin - Mime := AddSubPart; - while FLines.Count > x do - begin - s := FLines[x]; - Inc(x); - if Pos('--' + FBoundary, s) = 1 then - Break; - Mime.Lines.Add(s); - end; - Mime.DecomposeParts; - end - else - begin - s := FLines[x]; - Inc(x); - FPartBody.Add(s); - end; - if x >= FLines.Count then - break; - until s = '--' + FBoundary + '--'; - end; - if (FPrimaryCode = MP_MESSAGE) and CanSubPart then - begin - Mime := AddSubPart; - SkipEmpty; - while FLines.Count > x do - begin - s := TrimRight(FLines[x]); - Inc(x); - Mime.Lines.Add(s); - end; - Mime.DecomposeParts; - end - else - begin - while FLines.Count > x do - begin - s := FLines[x]; - Inc(x); - FPartBody.Add(s); - if not FAttachInside then - FAttachInside := IsUUcode(s); - end; - end; - //extract postpart - if FPrimaryCode = MP_MULTIPART then - begin - while FLines.Count > x do - begin - s := TrimRight(FLines[x]); - Inc(x); - FPostPart.Add(s); - if not FAttachInside then - FAttachInside := IsUUcode(s); - end; - end; -end; - -procedure TMIMEPart.DecomposePartsBinary(AHeader:TStrings; AStx,AEtx:PANSIChar); -var - x: integer; - s: ANSIString; - Mime: TMimePart; - BOP: PANSIChar; // Beginning of Part - EOP: PANSIChar; // End of Part - - function ___HasUUCode(ALines:TStrings): boolean; - var - x: integer; - begin - Result := FALSE; - for x:=0 to ALines.Count-1 do - if IsUUcode(ALInes[x]) then - begin - Result := TRUE; - exit; - end; - end; - -begin - FBinaryDecomposer := true; - Clear; - // Parse passed headers (THTTPSend returns HTTP headers and body separately) - x := 0; - while x 0 then - x := d1 - else - if d3 > 0 then - x := d3 - else - x := d2 - 1; - t := Copy(s, 1, x); - Delete(s, 1, x); - end; - Flines.Add(t); - until s = ''; - end; - - Flines.Add(''); - //add body - //if multipart - if FPrimaryCode = MP_MULTIPART then - begin - Flines.AddStrings(FPrePart); - for n := 0 to GetSubPartCount - 1 do - begin - Flines.Add('--' + FBoundary); - mime := GetSubPart(n); - mime.ComposeParts; - FLines.AddStrings(mime.Lines); - end; - Flines.Add('--' + FBoundary + '--'); - Flines.AddStrings(FPostPart); - end; - //if message - if FPrimaryCode = MP_MESSAGE then - begin - if GetSubPartCount > 0 then - begin - mime := GetSubPart(0); - mime.ComposeParts; - FLines.AddStrings(mime.Lines); - end; - end - else - //if normal part - begin - FLines.AddStrings(FPartBody); - end; -end; - -{==============================================================================} - -procedure TMIMEPart.DecodePart; -var - n: Integer; - s, t, t2: string; - b: Boolean; -begin - FDecodedLines.Clear; - {pf} - // The part decomposer passes data via TStringList which appends trailing line - // break inherently. But in a case of native 8-bit data transferred withouth - // encoding (default e.g. for HTTP protocol), the redundant line terminators - // has to be removed - if FBinaryDecomposer and (FPartBody.Count=1) then - begin - case FEncodingCode of - ME_QUOTED_PRINTABLE: - s := DecodeQuotedPrintable(FPartBody[0]); - ME_BASE64: - s := DecodeBase64(FPartBody[0]); - ME_UU, ME_XX: - begin - s := ''; - for n := 0 to FPartBody.Count - 1 do - if FEncodingCode = ME_UU then - s := s + DecodeUU(FPartBody[n]) - else - s := s + DecodeXX(FPartBody[n]); - end; - else - s := FPartBody[0]; - end; - end - else - {/pf} - case FEncodingCode of - ME_QUOTED_PRINTABLE: - s := DecodeQuotedPrintable(FPartBody.Text); - ME_BASE64: - s := DecodeBase64(FPartBody.Text); - ME_UU, ME_XX: - begin - s := ''; - for n := 0 to FPartBody.Count - 1 do - if FEncodingCode = ME_UU then - s := s + DecodeUU(FPartBody[n]) - else - s := s + DecodeXX(FPartBody[n]); - end; - else - s := FPartBody.Text; - end; - if FConvertCharset and (FPrimaryCode = MP_TEXT) then - if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then - begin - b := false; - t2 := uppercase(s); - t := SeparateLeft(t2, ''); - if length(t) <> length(s) then - begin - t := SeparateRight(t, ''); - t := ReplaceString(t, '"', ''); - t := ReplaceString(t, ' ', ''); - b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0; - end; - //workaround for shitty M$ Outlook 11 which is placing this information - //outside section - if not b then - begin - t := Copy(t2, 1, 2048); - t := ReplaceString(t, '"', ''); - t := ReplaceString(t, ' ', ''); - b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0; - end; - if not b then - s := CharsetConversion(s, FCharsetCode, FTargetCharset); - end - else - s := CharsetConversion(s, FCharsetCode, FTargetCharset); - WriteStrToStream(FDecodedLines, s); - FDecodedLines.Seek(0, soFromBeginning); -end; - -{==============================================================================} - -procedure TMIMEPart.DecodePartHeader; -var - n: integer; - s, su, fn: string; - st, st2: string; -begin - Primary := 'text'; - FSecondary := 'plain'; - FDescription := ''; - Charset := FDefaultCharset; - FFileName := ''; - //was 7bit before, but this is more compatible with RFC-ignorant outlook - Encoding := '8BIT'; - FDisposition := ''; - FContentID := ''; - fn := ''; - for n := 0 to FHeaders.Count - 1 do - if FHeaders[n] <> '' then - begin - s := FHeaders[n]; - su := UpperCase(s); - if Pos('CONTENT-TYPE:', su) = 1 then - begin - st := Trim(SeparateRight(su, ':')); - st2 := Trim(SeparateLeft(st, ';')); - Primary := Trim(SeparateLeft(st2, '/')); - FSecondary := Trim(SeparateRight(st2, '/')); - if (FSecondary = Primary) and (Pos('/', st2) < 1) then - FSecondary := ''; - case FPrimaryCode of - MP_TEXT: - begin - Charset := UpperCase(GetParameter(s, 'charset')); - FFileName := GetParameter(s, 'name'); - end; - MP_MULTIPART: - FBoundary := GetParameter(s, 'Boundary'); - MP_MESSAGE: - begin - end; - MP_BINARY: - FFileName := GetParameter(s, 'name'); - end; - end; - if Pos('CONTENT-TRANSFER-ENCODING:', su) = 1 then - Encoding := Trim(SeparateRight(su, ':')); - if Pos('CONTENT-DESCRIPTION:', su) = 1 then - FDescription := Trim(SeparateRight(s, ':')); - if Pos('CONTENT-DISPOSITION:', su) = 1 then - begin - FDisposition := SeparateRight(su, ':'); - FDisposition := Trim(SeparateLeft(FDisposition, ';')); - fn := GetParameter(s, 'FileName'); - end; - if Pos('CONTENT-ID:', su) = 1 then - FContentID := Trim(SeparateRight(s, ':')); - end; - if fn <> '' then - FFileName := fn; - FFileName := InlineDecode(FFileName, FTargetCharset); - FFileName := ExtractFileName(FFileName); -end; - -{==============================================================================} - -procedure TMIMEPart.EncodePart; -var - l: TStringList; - s, t: string; - n, x: Integer; - d1, d2: integer; -begin - if (FEncodingCode = ME_UU) or (FEncodingCode = ME_XX) then - Encoding := 'base64'; - l := TStringList.Create; - FPartBody.Clear; - FDecodedLines.Seek(0, soFromBeginning); - try - case FPrimaryCode of - MP_MULTIPART, MP_MESSAGE: - FPartBody.LoadFromStream(FDecodedLines); - MP_TEXT, MP_BINARY: - begin - s := ReadStrFromStream(FDecodedLines, FDecodedLines.Size); - if FConvertCharset and (FPrimaryCode = MP_TEXT) and (FEncodingCode <> ME_7BIT) then - s := GetBOM(FCharSetCode) + CharsetConversion(s, FTargetCharset, FCharsetCode); - if FEncodingCode = ME_BASE64 then - begin - x := 1; - while x <= length(s) do - begin - t := copy(s, x, 54); - x := x + length(t); - t := EncodeBase64(t); - FPartBody.Add(t); - end; - end - else - begin - if FPrimaryCode = MP_BINARY then - l.Add(s) - else - l.Text := s; - for n := 0 to l.Count - 1 do - begin - s := l[n]; - if FEncodingCode = ME_QUOTED_PRINTABLE then - begin - s := EncodeQuotedPrintable(s); - repeat - if Length(s) < FMaxLineLength then - begin - t := s; - s := ''; - end - else - begin - d1 := RPosEx('=', s, FMaxLineLength); - d2 := RPosEx(' ', s, FMaxLineLength); - if (d1 = 0) and (d2 = 0) then - x := FMaxLineLength - else - if d1 > d2 then - x := d1 - 1 - else - x := d2 - 1; - if x = 0 then - x := FMaxLineLength; - t := Copy(s, 1, x); - Delete(s, 1, x); - if s <> '' then - t := t + '='; - end; - FPartBody.Add(t); - until s = ''; - end - else - FPartBody.Add(s); - end; - if (FPrimaryCode = MP_BINARY) - and (FEncodingCode = ME_QUOTED_PRINTABLE) then - FPartBody[FPartBody.Count - 1] := FPartBody[FPartBody.Count - 1] + '='; - end; - end; - end; - finally - l.Free; - end; -end; - -{==============================================================================} - -procedure TMIMEPart.EncodePartHeader; -var - s: string; -begin - FHeaders.Clear; - if FSecondary = '' then - case FPrimaryCode of - MP_TEXT: - FSecondary := 'plain'; - MP_MULTIPART: - FSecondary := 'mixed'; - MP_MESSAGE: - FSecondary := 'rfc822'; - MP_BINARY: - FSecondary := 'octet-stream'; - end; - if FDescription <> '' then - FHeaders.Insert(0, 'Content-Description: ' + FDescription); - if FDisposition <> '' then - begin - s := ''; - if FFileName <> '' then - s := '; FileName=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"'); - FHeaders.Insert(0, 'Content-Disposition: ' + LowerCase(FDisposition) + s); - end; - if FContentID <> '' then - FHeaders.Insert(0, 'Content-ID: ' + FContentID); - - case FEncodingCode of - ME_7BIT: - s := '7bit'; - ME_8BIT: - s := '8bit'; - ME_QUOTED_PRINTABLE: - s := 'Quoted-printable'; - ME_BASE64: - s := 'Base64'; - end; - case FPrimaryCode of - MP_TEXT, - MP_BINARY: FHeaders.Insert(0, 'Content-Transfer-Encoding: ' + s); - end; - case FPrimaryCode of - MP_TEXT: - s := FPrimary + '/' + FSecondary + '; charset=' + GetIDfromCP(FCharsetCode); - MP_MULTIPART: - s := FPrimary + '/' + FSecondary + '; boundary="' + FBoundary + '"'; - MP_MESSAGE, MP_BINARY: - s := FPrimary + '/' + FSecondary; - end; - if FFileName <> '' then - s := s + '; name=' + QuoteStr(InlineCodeEx(FileName, FTargetCharset), '"'); - FHeaders.Insert(0, 'Content-type: ' + s); -end; - -{==============================================================================} - -procedure TMIMEPart.MimeTypeFromExt(Value: string); -var - s: string; - n: Integer; -begin - Primary := ''; - FSecondary := ''; - s := UpperCase(ExtractFileExt(Value)); - if s = '' then - s := UpperCase(Value); - s := SeparateRight(s, '.'); - for n := 0 to MaxMimeType do - if MimeType[n, 0] = s then - begin - Primary := MimeType[n, 1]; - FSecondary := MimeType[n, 2]; - Break; - end; - if Primary = '' then - Primary := 'application'; - if FSecondary = '' then - FSecondary := 'octet-stream'; -end; - -{==============================================================================} - -procedure TMIMEPart.WalkPart; -var - n: integer; - m: TMimepart; -begin - if assigned(OnWalkPart) then - begin - OnWalkPart(self); - for n := 0 to GetSubPartCount - 1 do - begin - m := GetSubPart(n); - m.OnWalkPart := OnWalkPart; - m.WalkPart; - end; - end; -end; - -{==============================================================================} - -procedure TMIMEPart.SetPrimary(Value: string); -var - s: string; -begin - FPrimary := Value; - s := UpperCase(Value); - FPrimaryCode := MP_BINARY; - if Pos('TEXT', s) = 1 then - FPrimaryCode := MP_TEXT; - if Pos('MULTIPART', s) = 1 then - FPrimaryCode := MP_MULTIPART; - if Pos('MESSAGE', s) = 1 then - FPrimaryCode := MP_MESSAGE; -end; - -procedure TMIMEPart.SetEncoding(Value: string); -var - s: string; -begin - FEncoding := Value; - s := UpperCase(Value); - FEncodingCode := ME_7BIT; - if Pos('8BIT', s) = 1 then - FEncodingCode := ME_8BIT; - if Pos('QUOTED-PRINTABLE', s) = 1 then - FEncodingCode := ME_QUOTED_PRINTABLE; - if Pos('BASE64', s) = 1 then - FEncodingCode := ME_BASE64; - if Pos('X-UU', s) = 1 then - FEncodingCode := ME_UU; - if Pos('X-XX', s) = 1 then - FEncodingCode := ME_XX; -end; - -procedure TMIMEPart.SetCharset(Value: string); -begin - if value <> '' then - begin - FCharset := Value; - FCharsetCode := GetCPFromID(Value); - end; -end; - -function TMIMEPart.CanSubPart: boolean; -begin - Result := True; - if FMaxSubLevel <> -1 then - Result := FMaxSubLevel > FSubLevel; -end; - -function TMIMEPart.IsUUcode(Value: string): boolean; -begin - Value := UpperCase(Value); - Result := (pos('BEGIN ', Value) = 1) and (Trim(SeparateRight(Value, ' ')) <> ''); -end; - -{==============================================================================} - -function GenerateBoundary: string; -var - x, y: Integer; -begin - y := GetTick; - x := y; - while TickDelta(y, x) = 0 do - begin - Sleep(1); - x := GetTick; - end; - Randomize; - y := Random(MaxInt); - Result := IntToHex(x, 8) + '_' + IntToHex(y, 8) + '_Synapse_boundary'; -end; - -end. diff --git a/3rd/synapse/source/nntpsend.pas b/3rd/synapse/source/nntpsend.pas deleted file mode 100644 index ec1af16ed..000000000 --- a/3rd/synapse/source/nntpsend.pas +++ /dev/null @@ -1,483 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.005.003 | -|==============================================================================| -| Content: NNTP client | -|==============================================================================| -| Copyright (c)1999-2011, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2011. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(NNTP client) -NNTP (network news transfer protocol) - -Used RFC: RFC-977, RFC-2980 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} - {$WARN SUSPICIOUS_TYPECAST OFF} -{$ENDIF} - -unit nntpsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil; - -const - cNNTPProtocol = '119'; - -type - - {:abstract(Implementation of Network News Transfer Protocol. - - Note: Are you missing properties for setting Username and Password? Look to - parent @link(TSynaClient) object! - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TNNTPSend = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FResultCode: Integer; - FResultString: string; - FData: TStringList; - FDataToSend: TStringList; - FAutoTLS: Boolean; - FFullSSL: Boolean; - FNNTPcap: TStringList; - function ReadResult: Integer; - function ReadData: boolean; - function SendData: boolean; - function Connect: Boolean; - public - constructor Create; - destructor Destroy; override; - - {:Connects to NNTP server and begin session.} - function Login: Boolean; - - {:Logout from NNTP server and terminate session.} - function Logout: Boolean; - - {:By this you can call any NNTP command.} - function DoCommand(const Command: string): boolean; - - {:by this you can call any NNTP command. This variant is used for commands - for download information from server.} - function DoCommandRead(const Command: string): boolean; - - {:by this you can call any NNTP command. This variant is used for commands - for upload information to server.} - function DoCommandWrite(const Command: string): boolean; - - {:Download full message to @link(data) property. Value can be number of - message or message-id (in brackets).} - function GetArticle(const Value: string): Boolean; - - {:Download only body of message to @link(data) property. Value can be number - of message or message-id (in brackets).} - function GetBody(const Value: string): Boolean; - - {:Download only headers of message to @link(data) property. Value can be - number of message or message-id (in brackets).} - function GetHead(const Value: string): Boolean; - - {:Get message status. Value can be number of message or message-id - (in brackets).} - function GetStat(const Value: string): Boolean; - - {:Select given group.} - function SelectGroup(const Value: string): Boolean; - - {:Tell to server 'I have mesage with given message-ID.' If server need this - message, message is uploaded to server.} - function IHave(const MessID: string): Boolean; - - {:Move message pointer to last item in group.} - function GotoLast: Boolean; - - {:Move message pointer to next item in group.} - function GotoNext: Boolean; - - {:Download to @link(data) property list of all groups on NNTP server.} - function ListGroups: Boolean; - - {:Download to @link(data) property list of all groups created after given time.} - function ListNewGroups(Since: TDateTime): Boolean; - - {:Download to @link(data) property list of message-ids in given group since - given time.} - function NewArticles(const Group: string; Since: TDateTime): Boolean; - - {:Upload new article to server. (for new messages by you)} - function PostArticle: Boolean; - - {:Tells to remote NNTP server 'I am not NNTP client, but I am another NNTP - server'.} - function SwitchToSlave: Boolean; - - {:Call NNTP XOVER command.} - function Xover(xoStart, xoEnd: string): boolean; - - {:Call STARTTLS command for upgrade connection to SSL/TLS mode.} - function StartTLS: Boolean; - - {:Try to find given capability in extension list. This list is getted after - successful login to NNTP server. If extension capability is not found, - then return is empty string.} - function FindCap(const Value: string): string; - - {:Try get list of server extensions. List is returned in @link(data) property.} - function ListExtensions: Boolean; - published - {:Result code number of last operation.} - property ResultCode: Integer read FResultCode; - - {:String description of last result code from NNTP server.} - property ResultString: string read FResultString; - - {:Readed data. (message, etc.)} - property Data: TStringList read FData; - - {:If is set to @true, then upgrade to SSL/TLS mode after login if remote - server support it.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:SSL/TLS mode is used from first contact to server. Servers with full - SSL/TLS mode usualy using non-standard TCP port!} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - end; - -implementation - -constructor TNNTPSend.Create; -begin - inherited Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FData := TStringList.Create; - FDataToSend := TStringList.Create; - FNNTPcap := TStringList.Create; - FSock.ConvertLineEnd := True; - FTimeout := 60000; - FTargetPort := cNNTPProtocol; - FAutoTLS := False; - FFullSSL := False; -end; - -destructor TNNTPSend.Destroy; -begin - FSock.Free; - FDataToSend.Free; - FData.Free; - FNNTPcap.Free; - inherited Destroy; -end; - -function TNNTPSend.ReadResult: Integer; -var - s: string; -begin - Result := 0; - FData.Clear; - s := FSock.RecvString(FTimeout); - FResultString := Copy(s, 5, Length(s) - 4); - if FSock.LastError <> 0 then - Exit; - if Length(s) >= 3 then - Result := StrToIntDef(Copy(s, 1, 3), 0); - FResultCode := Result; -end; - -function TNNTPSend.ReadData: boolean; -var - s: string; -begin - repeat - s := FSock.RecvString(FTimeout); - if s = '.' then - break; - if (s <> '') and (s[1] = '.') then - s := Copy(s, 2, Length(s) - 1); - FData.Add(s); - until FSock.LastError <> 0; - Result := FSock.LastError = 0; -end; - -function TNNTPSend.SendData: boolean; -var - s: string; - n: integer; -begin - for n := 0 to FDataToSend.Count - 1 do - begin - s := FDataToSend[n]; - if (s <> '') and (s[1] = '.') then - s := s + '.'; - FSock.SendString(s + CRLF); - if FSock.LastError <> 0 then - break; - end; - if FDataToSend.Count = 0 then - FSock.SendString(CRLF); - if FSock.LastError = 0 then - FSock.SendString('.' + CRLF); - FDataToSend.Clear; - Result := FSock.LastError = 0; -end; - -function TNNTPSend.Connect: Boolean; -begin - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TNNTPSend.Login: Boolean; -begin - Result := False; - FNNTPcap.Clear; - if not Connect then - Exit; - Result := (ReadResult div 100) = 2; - if Result then - begin - ListExtensions; - FNNTPcap.Assign(Fdata); - if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then - Result := StartTLS; - end; - if (FUsername <> '') and Result then - begin - FSock.SendString('AUTHINFO USER ' + FUsername + CRLF); - if (ReadResult div 100) = 3 then - begin - FSock.SendString('AUTHINFO PASS ' + FPassword + CRLF); - Result := (ReadResult div 100) = 2; - end; - end; -end; - -function TNNTPSend.Logout: Boolean; -begin - FSock.SendString('QUIT' + CRLF); - Result := (ReadResult div 100) = 2; - FSock.CloseSocket; -end; - -function TNNTPSend.DoCommand(const Command: string): Boolean; -begin - FSock.SendString(Command + CRLF); - Result := (ReadResult div 100) = 2; - Result := Result and (FSock.LastError = 0); -end; - -function TNNTPSend.DoCommandRead(const Command: string): Boolean; -begin - Result := DoCommand(Command); - if Result then - begin - Result := ReadData; - Result := Result and (FSock.LastError = 0); - end; -end; - -function TNNTPSend.DoCommandWrite(const Command: string): Boolean; -var - x: integer; -begin - FDataToSend.Assign(FData); - FSock.SendString(Command + CRLF); - x := (ReadResult div 100); - if x = 3 then - begin - SendData; - x := (ReadResult div 100); - end; - Result := x = 2; - Result := Result and (FSock.LastError = 0); -end; - -function TNNTPSend.GetArticle(const Value: string): Boolean; -var - s: string; -begin - s := 'ARTICLE'; - if Value <> '' then - s := s + ' ' + Value; - Result := DoCommandRead(s); -end; - -function TNNTPSend.GetBody(const Value: string): Boolean; -var - s: string; -begin - s := 'BODY'; - if Value <> '' then - s := s + ' ' + Value; - Result := DoCommandRead(s); -end; - -function TNNTPSend.GetHead(const Value: string): Boolean; -var - s: string; -begin - s := 'HEAD'; - if Value <> '' then - s := s + ' ' + Value; - Result := DoCommandRead(s); -end; - -function TNNTPSend.GetStat(const Value: string): Boolean; -var - s: string; -begin - s := 'STAT'; - if Value <> '' then - s := s + ' ' + Value; - Result := DoCommand(s); -end; - -function TNNTPSend.SelectGroup(const Value: string): Boolean; -begin - Result := DoCommand('GROUP ' + Value); -end; - -function TNNTPSend.IHave(const MessID: string): Boolean; -begin - Result := DoCommandWrite('IHAVE ' + MessID); -end; - -function TNNTPSend.GotoLast: Boolean; -begin - Result := DoCommand('LAST'); -end; - -function TNNTPSend.GotoNext: Boolean; -begin - Result := DoCommand('NEXT'); -end; - -function TNNTPSend.ListGroups: Boolean; -begin - Result := DoCommandRead('LIST'); -end; - -function TNNTPSend.ListNewGroups(Since: TDateTime): Boolean; -begin - Result := DoCommandRead('NEWGROUPS ' + SimpleDateTime(Since) + ' GMT'); -end; - -function TNNTPSend.NewArticles(const Group: string; Since: TDateTime): Boolean; -begin - Result := DoCommandRead('NEWNEWS ' + Group + ' ' + SimpleDateTime(Since) + ' GMT'); -end; - -function TNNTPSend.PostArticle: Boolean; -begin - Result := DoCommandWrite('POST'); -end; - -function TNNTPSend.SwitchToSlave: Boolean; -begin - Result := DoCommand('SLAVE'); -end; - -function TNNTPSend.Xover(xoStart, xoEnd: string): Boolean; -var - s: string; -begin - s := 'XOVER ' + xoStart; - if xoEnd <> xoStart then - s := s + '-' + xoEnd; - Result := DoCommandRead(s); -end; - -function TNNTPSend.StartTLS: Boolean; -begin - Result := False; - if FindCap('STARTTLS') <> '' then - begin - if DoCommand('STARTTLS') then - begin - Fsock.SSLDoConnect; - Result := FSock.LastError = 0; - end; - end; -end; - -function TNNTPSend.ListExtensions: Boolean; -begin - Result := DoCommandRead('LIST EXTENSIONS'); -end; - -function TNNTPSend.FindCap(const Value: string): string; -var - n: Integer; - s: string; -begin - s := UpperCase(Value); - Result := ''; - for n := 0 to FNNTPcap.Count - 1 do - if Pos(s, UpperCase(FNNTPcap[n])) = 1 then - begin - Result := FNNTPcap[n]; - Break; - end; -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/pingsend.pas b/3rd/synapse/source/pingsend.pas deleted file mode 100644 index 1a4e331f8..000000000 --- a/3rd/synapse/source/pingsend.pas +++ /dev/null @@ -1,720 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 004.000.002 | -|==============================================================================| -| Content: PING sender | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(ICMP PING implementation.) -Allows create PING and TRACEROUTE. Or you can diagnose your network. - -This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying - to use RAW sockets. - -Warning: For use of RAW sockets you must have some special rights on some - systems. So, it working allways when you have administator/root rights. - Otherwise you can have problems! - -Note: This unit is NOT portable to .NET! - Use native .NET classes for Ping instead. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$R-} -{$H+} - -{$IFDEF CIL} - Sorry, this unit is not for .NET! -{$ENDIF} -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit pingsend; - -interface - -uses - SysUtils, - synsock, blcksock, synautil, synafpc, synaip -{$IFDEF MSWINDOWS} - , windows -{$ENDIF} - ; - -const - ICMP_ECHO = 8; - ICMP_ECHOREPLY = 0; - ICMP_UNREACH = 3; - ICMP_TIME_EXCEEDED = 11; -//rfc-2292 - ICMP6_ECHO = 128; - ICMP6_ECHOREPLY = 129; - ICMP6_UNREACH = 1; - ICMP6_TIME_EXCEEDED = 3; - -type - {:List of possible ICMP reply packet types.} - TICMPError = ( - IE_NoError, - IE_Other, - IE_TTLExceed, - IE_UnreachOther, - IE_UnreachRoute, - IE_UnreachAdmin, - IE_UnreachAddr, - IE_UnreachPort - ); - - {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)} - TPINGSend = class(TSynaClient) - private - FSock: TICMPBlockSocket; - FBuffer: Ansistring; - FSeq: Integer; - FId: Integer; - FPacketSize: Integer; - FPingTime: Integer; - FIcmpEcho: Byte; - FIcmpEchoReply: Byte; - FIcmpUnreach: Byte; - FReplyFrom: string; - FReplyType: byte; - FReplyCode: byte; - FReplyError: TICMPError; - FReplyErrorDesc: string; - FTTL: Byte; - Fsin: TVarSin; - function Checksum(Value: AnsiString): Word; - function Checksum6(Value: AnsiString): Word; - function ReadPacket: Boolean; - procedure TranslateError; - procedure TranslateErrorIpHlp(value: integer); - function InternalPing(const Host: string): Boolean; - function InternalPingIpHlp(const Host: string): Boolean; - function IsHostIP6(const Host: string): Boolean; - procedure GenErrorDesc; - public - {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is - @true.} - function Ping(const Host: string): Boolean; - constructor Create; - destructor Destroy; override; - published - {:Size of PING packet. Default size is 32 bytes.} - property PacketSize: Integer read FPacketSize Write FPacketSize; - - {:Time between request and reply.} - property PingTime: Integer read FPingTime; - - {:From this address is sended reply for your PING request. It maybe not your - requested destination, when some error occured!} - property ReplyFrom: string read FReplyFrom; - - {:ICMP type of PING reply. Each protocol using another values! For IPv4 and - IPv6 are used different values!} - property ReplyType: byte read FReplyType; - - {:ICMP code of PING reply. Each protocol using another values! For IPv4 and - IPv6 are used different values! For protocol independent value look to - @link(ReplyError)} - property ReplyCode: byte read FReplyCode; - - {:Return type of returned ICMP message. This value is independent on used - protocol!} - property ReplyError: TICMPError read FReplyError; - - {:Return human readable description of returned packet type.} - property ReplyErrorDesc: string read FReplyErrorDesc; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TICMPBlockSocket read FSock; - - {:TTL value for ICMP query} - property TTL: byte read FTTL write FTTL; - end; - -{:A very useful function and example of its use would be found in the TPINGSend - object. Use it to ping to any host. If successful, returns the ping time in - milliseconds. Returns -1 if an error occurred.} -function PingHost(const Host: string): Integer; - -{:A very useful function and example of its use would be found in the TPINGSend - object. Use it to TraceRoute to any host.} -function TraceRouteHost(const Host: string): string; - -implementation - -type - {:Record for ICMP ECHO packet header.} - TIcmpEchoHeader = packed record - i_type: Byte; - i_code: Byte; - i_checkSum: Word; - i_Id: Word; - i_seq: Word; - TimeStamp: integer; - end; - - {:record used internally by TPingSend for compute checksum of ICMPv6 packet - pseudoheader.} - TICMP6Packet = packed record - in_source: TInAddr6; - in_dest: TInAddr6; - Length: integer; - free0: Byte; - free1: Byte; - free2: Byte; - proto: Byte; - end; - -{$IFDEF MSWINDOWS} -const - DLLIcmpName = 'iphlpapi.dll'; -type - TIP_OPTION_INFORMATION = record - TTL: Byte; - TOS: Byte; - Flags: Byte; - OptionsSize: Byte; - OptionsData: PAnsiChar; - end; - PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION; - - TICMP_ECHO_REPLY = record - Address: TInAddr; - Status: integer; - RoundTripTime: integer; - DataSize: Word; - Reserved: Word; - Data: pointer; - Options: TIP_OPTION_INFORMATION; - end; - PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY; - - TICMPV6_ECHO_REPLY = record - Address: TSockAddrIn6; - Status: integer; - RoundTripTime: integer; - end; - PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY; - - TIcmpCreateFile = function: integer; stdcall; - TIcmpCloseHandle = function(handle: integer): boolean; stdcall; - TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer; - ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer; - RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION; - ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall; - TIcmp6CreateFile = function: integer; stdcall; - TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer; - ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6; - RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION; - ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall; - -var - IcmpDllHandle: TLibHandle = 0; - IcmpHelper4: boolean = false; - IcmpHelper6: boolean = false; - IcmpCreateFile: TIcmpCreateFile = nil; - IcmpCloseHandle: TIcmpCloseHandle = nil; - IcmpSendEcho2: TIcmpSendEcho2 = nil; - Icmp6CreateFile: TIcmp6CreateFile = nil; - Icmp6SendEcho2: TIcmp6SendEcho2 = nil; -{$ENDIF} -{==============================================================================} - -constructor TPINGSend.Create; -begin - inherited Create; - FSock := TICMPBlockSocket.Create; - FSock.Owner := self; - FTimeout := 5000; - FPacketSize := 32; - FSeq := 0; - Randomize; - FTTL := 128; -end; - -destructor TPINGSend.Destroy; -begin - FSock.Free; - inherited Destroy; -end; - -function TPINGSend.ReadPacket: Boolean; -begin - FBuffer := FSock.RecvPacket(Ftimeout); - Result := FSock.LastError = 0; -end; - -procedure TPINGSend.GenErrorDesc; -begin - case FReplyError of - IE_NoError: - FReplyErrorDesc := ''; - IE_Other: - FReplyErrorDesc := 'Unknown error'; - IE_TTLExceed: - FReplyErrorDesc := 'TTL Exceeded'; - IE_UnreachOther: - FReplyErrorDesc := 'Unknown unreachable'; - IE_UnreachRoute: - FReplyErrorDesc := 'No route to destination'; - IE_UnreachAdmin: - FReplyErrorDesc := 'Administratively prohibited'; - IE_UnreachAddr: - FReplyErrorDesc := 'Address unreachable'; - IE_UnreachPort: - FReplyErrorDesc := 'Port unreachable'; - end; -end; - -function TPINGSend.IsHostIP6(const Host: string): Boolean; -var - f: integer; -begin - f := AF_UNSPEC; - if IsIp(Host) then - f := AF_INET - else - if IsIp6(Host) then - f := AF_INET6; - synsock.SetVarSin(Fsin, host, '0', f, - IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4); - result := Fsin.sin_family = AF_INET6; -end; - -function TPINGSend.Ping(const Host: string): Boolean; -var - b: boolean; -begin - FPingTime := -1; - FReplyFrom := ''; - FReplyType := 0; - FReplyCode := 0; - FReplyError := IE_Other; - GenErrorDesc; - FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize); -{$IFDEF MSWINDOWS} - b := IsHostIP6(host); - if not(b) and IcmpHelper4 then - result := InternalPingIpHlp(host) - else - if b and IcmpHelper6 then - result := InternalPingIpHlp(host) - else - result := InternalPing(host); -{$ELSE} - result := InternalPing(host); -{$ENDIF} -end; - -function TPINGSend.InternalPing(const Host: string): Boolean; -var - IPHeadPtr: ^TIPHeader; - IpHdrLen: Integer; - IcmpEchoHeaderPtr: ^TICMPEchoHeader; - t: Boolean; - x: cardinal; - IcmpReqHead: string; -begin - Result := False; - FSock.TTL := FTTL; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(Host, '0'); - if FSock.LastError <> 0 then - Exit; - FSock.SizeRecvBuffer := 60 * 1024; - if FSock.IP6used then - begin - FIcmpEcho := ICMP6_ECHO; - FIcmpEchoReply := ICMP6_ECHOREPLY; - FIcmpUnreach := ICMP6_UNREACH; - end - else - begin - FIcmpEcho := ICMP_ECHO; - FIcmpEchoReply := ICMP_ECHOREPLY; - FIcmpUnreach := ICMP_UNREACH; - end; - IcmpEchoHeaderPtr := Pointer(FBuffer); - with IcmpEchoHeaderPtr^ do - begin - i_type := FIcmpEcho; - i_code := 0; - i_CheckSum := 0; - FId := System.Random(32767); - i_Id := FId; - TimeStamp := GetTick; - Inc(FSeq); - i_Seq := FSeq; - if fSock.IP6used then - i_CheckSum := CheckSum6(FBuffer) - else - i_CheckSum := CheckSum(FBuffer); - end; - FSock.SendString(FBuffer); - // remember first 8 bytes of ICMP packet - IcmpReqHead := Copy(FBuffer, 1, 8); - x := GetTick; - repeat - t := ReadPacket; - if not t then - break; - if fSock.IP6used then - begin -{$IFNDEF MSWINDOWS} - IcmpEchoHeaderPtr := Pointer(FBuffer); -{$ELSE} -//WinXP SP1 with networking update doing this think by another way ;-O -// FBuffer := StringOfChar(#0, 4) + FBuffer; - IcmpEchoHeaderPtr := Pointer(FBuffer); -// IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply; -{$ENDIF} - end - else - begin - IPHeadPtr := Pointer(FBuffer); - IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4; - IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1]; - end; - //check for timeout - if TickDelta(x, GetTick) > FTimeout then - begin - t := false; - Break; - end; - //it discard sometimes possible 'echoes' of previosly sended packet - //or other unwanted ICMP packets... - until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho) - and ((IcmpEchoHeaderPtr^.i_id = FId) - or (Pos(IcmpReqHead, FBuffer) > 0)); - if t then - begin - FPingTime := TickDelta(x, GetTick); - FReplyFrom := FSock.GetRemoteSinIP; - FReplyType := IcmpEchoHeaderPtr^.i_type; - FReplyCode := IcmpEchoHeaderPtr^.i_code; - TranslateError; - Result := True; - end; -end; - -function TPINGSend.Checksum(Value: AnsiString): Word; -var - CkSum: integer; - Num, Remain: Integer; - n, i: Integer; -begin - Num := Length(Value) div 2; - Remain := Length(Value) mod 2; - CkSum := 0; - i := 1; - for n := 0 to Num - 1 do - begin - CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i)); - inc(i, 2); - end; - if Remain <> 0 then - CkSum := CkSum + Ord(Value[Length(Value)]); - CkSum := (CkSum shr 16) + (CkSum and $FFFF); - CkSum := CkSum + (CkSum shr 16); - Result := Word(not CkSum); -end; - -function TPINGSend.Checksum6(Value: AnsiString): Word; -const - IOC_OUT = $40000000; - IOC_IN = $80000000; - IOC_INOUT = (IOC_IN or IOC_OUT); - IOC_WS2 = $08000000; - SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT; -var - ICMP6Ptr: ^TICMP6Packet; - s: AnsiString; - b: integer; - ip6: TSockAddrIn6; - x: integer; -begin - Result := 0; -{$IFDEF MSWINDOWS} - s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value; - ICMP6Ptr := Pointer(s); - x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY, - @FSock.RemoteSin, SizeOf(FSock.RemoteSin), - @ip6, SizeOf(ip6), @b, nil, nil); - if x <> -1 then - ICMP6Ptr^.in_dest := ip6.sin6_addr - else - ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr; - ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr; - ICMP6Ptr^.Length := synsock.htonl(Length(Value)); - ICMP6Ptr^.proto := IPPROTO_ICMPV6; - Result := Checksum(s); -{$ENDIF} -end; - -procedure TPINGSend.TranslateError; -begin - if fSock.IP6used then - begin - case FReplyType of - ICMP6_ECHOREPLY: - FReplyError := IE_NoError; - ICMP6_TIME_EXCEEDED: - FReplyError := IE_TTLExceed; - ICMP6_UNREACH: - case FReplyCode of - 0: - FReplyError := IE_UnreachRoute; - 3: - FReplyError := IE_UnreachAddr; - 4: - FReplyError := IE_UnreachPort; - 1: - FReplyError := IE_UnreachAdmin; - else - FReplyError := IE_UnreachOther; - end; - else - FReplyError := IE_Other; - end; - end - else - begin - case FReplyType of - ICMP_ECHOREPLY: - FReplyError := IE_NoError; - ICMP_TIME_EXCEEDED: - FReplyError := IE_TTLExceed; - ICMP_UNREACH: - case FReplyCode of - 0: - FReplyError := IE_UnreachRoute; - 1: - FReplyError := IE_UnreachAddr; - 3: - FReplyError := IE_UnreachPort; - 13: - FReplyError := IE_UnreachAdmin; - else - FReplyError := IE_UnreachOther; - end; - else - FReplyError := IE_Other; - end; - end; - GenErrorDesc; -end; - -procedure TPINGSend.TranslateErrorIpHlp(value: integer); -begin - case value of - 11000, 0: - FReplyError := IE_NoError; - 11013: - FReplyError := IE_TTLExceed; - 11002: - FReplyError := IE_UnreachRoute; - 11003: - FReplyError := IE_UnreachAddr; - 11005: - FReplyError := IE_UnreachPort; - 11004: - FReplyError := IE_UnreachAdmin; - else - FReplyError := IE_Other; - end; - GenErrorDesc; -end; - -function TPINGSend.InternalPingIpHlp(const Host: string): Boolean; -{$IFDEF MSWINDOWS} -var - PingIp6: boolean; - PingHandle: integer; - r: integer; - ipo: TIP_OPTION_INFORMATION; - RBuff: Ansistring; - ip4reply: PICMP_ECHO_REPLY; - ip6reply: PICMPV6_ECHO_REPLY; - ip6: TSockAddrIn6; -begin - Result := False; - PingIp6 := Fsin.sin_family = AF_INET6; - if pingIp6 then - PingHandle := Icmp6CreateFile - else - PingHandle := IcmpCreateFile; - if PingHandle <> -1 then - begin - try - ipo.TTL := FTTL; - ipo.TOS := 0; - ipo.Flags := 0; - ipo.OptionsSize := 0; - ipo.OptionsData := nil; - setlength(RBuff, 4096); - if pingIp6 then - begin - FillChar(ip6, sizeof(ip6), 0); - r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin, - PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout); - if r > 0 then - begin - RBuff := #0 + #0 + RBuff; - ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff)); - FPingTime := ip6reply^.RoundTripTime; - ip6reply^.Address.sin6_family := AF_INET6; - FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address)); - TranslateErrorIpHlp(ip6reply^.Status); - Result := True; - end; - end - else - begin - r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr, - PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout); - if r > 0 then - begin - ip4reply := PICMP_ECHO_REPLY(pointer(RBuff)); - FPingTime := ip4reply^.RoundTripTime; - FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr)); - TranslateErrorIpHlp(ip4reply^.Status); - Result := True; - end; - end - finally - IcmpCloseHandle(PingHandle); - end; - end; -end; -{$ELSE} -begin - result := false; -end; -{$ENDIF} - -{==============================================================================} - -function PingHost(const Host: string): Integer; -begin - with TPINGSend.Create do - try - Result := -1; - if Ping(Host) then - if ReplyError = IE_NoError then - Result := PingTime; - finally - Free; - end; -end; - -function TraceRouteHost(const Host: string): string; -var - Ping: TPingSend; - ttl : byte; -begin - Result := ''; - Ping := TPINGSend.Create; - try - ttl := 1; - repeat - ping.TTL := ttl; - inc(ttl); - if ttl > 30 then - Break; - if not ping.Ping(Host) then - begin - Result := Result + cAnyHost+ ' Timeout' + CRLF; - continue; - end; - if (ping.ReplyError <> IE_NoError) - and (ping.ReplyError <> IE_TTLExceed) then - begin - Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF; - break; - end; - Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF; - until ping.ReplyError = IE_NoError; - finally - Ping.Free; - end; -end; - -{$IFDEF MSWINDOWS} -initialization -begin - IcmpHelper4 := false; - IcmpHelper6 := false; - IcmpDllHandle := LoadLibrary(DLLIcmpName); - if IcmpDllHandle <> 0 then - begin - IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile'); - IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle'); - IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2'); - Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile'); - Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2'); - IcmpHelper4 := assigned(IcmpCreateFile) - and assigned(IcmpCloseHandle) - and assigned(IcmpSendEcho2); - IcmpHelper6 := assigned(Icmp6CreateFile) - and assigned(Icmp6SendEcho2); - end; -end; - -finalization -begin - FreeLibrary(IcmpDllHandle); -end; -{$ENDIF} - -end. diff --git a/3rd/synapse/source/pop3send.pas b/3rd/synapse/source/pop3send.pas deleted file mode 100644 index 05c5ac0dc..000000000 --- a/3rd/synapse/source/pop3send.pas +++ /dev/null @@ -1,483 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.006.002 | -|==============================================================================| -| Content: POP3 client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2001-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(POP3 protocol client) - -Used RFC: RFC-1734, RFC-1939, RFC-2195, RFC-2449, RFC-2595 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$M+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit pop3send; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, synacode; - -const - cPop3Protocol = '110'; - -type - - {:The three types of possible authorization methods for "logging in" to a POP3 - server.} - TPOP3AuthType = (POP3AuthAll, POP3AuthLogin, POP3AuthAPOP); - - {:@abstract(Implementation of POP3 client protocol.) - - Note: Are you missing properties for setting Username and Password? Look to - parent @link(TSynaClient) object! - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TPOP3Send = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FResultCode: Integer; - FResultString: string; - FFullResult: TStringList; - FStatCount: Integer; - FStatSize: Integer; - FListSize: Integer; - FTimeStamp: string; - FAuthType: TPOP3AuthType; - FPOP3cap: TStringList; - FAutoTLS: Boolean; - FFullSSL: Boolean; - function ReadResult(Full: Boolean): Integer; - function Connect: Boolean; - function AuthLogin: Boolean; - function AuthApop: Boolean; - public - constructor Create; - destructor Destroy; override; - - {:You can call any custom by this method. Call Command without trailing CRLF. - If MultiLine parameter is @true, multilined response are expected. - Result is @true on sucess.} - function CustomCommand(const Command: string; MultiLine: Boolean): boolean; - - {:Call CAPA command for get POP3 server capabilites. - note: not all servers support this command!} - function Capability: Boolean; - - {:Connect to remote POP3 host. If all OK, result is @true.} - function Login: Boolean; - - {:Disconnects from POP3 server.} - function Logout: Boolean; - - {:Send RSET command. If all OK, result is @true.} - function Reset: Boolean; - - {:Send NOOP command. If all OK, result is @true.} - function NoOp: Boolean; - - {:Send STAT command and fill @link(StatCount) and @link(StatSize) property. - If all OK, result is @true.} - function Stat: Boolean; - - {:Send LIST command. If Value is 0, LIST is for all messages. After - successful operation is listing in FullResult. If all OK, result is @True.} - function List(Value: Integer): Boolean; - - {:Send RETR command. After successful operation dowloaded message in - @link(FullResult). If all OK, result is @true.} - function Retr(Value: Integer): Boolean; - - {:Send RETR command. After successful operation dowloaded message in - @link(Stream). If all OK, result is @true.} - function RetrStream(Value: Integer; Stream: TStream): Boolean; - - {:Send DELE command for delete specified message. If all OK, result is @true.} - function Dele(Value: Integer): Boolean; - - {:Send TOP command. After successful operation dowloaded headers of message - and maxlines count of message in @link(FullResult). If all OK, result is - @true.} - function Top(Value, Maxlines: Integer): Boolean; - - {:Send UIDL command. If Value is 0, UIDL is for all messages. After - successful operation is listing in FullResult. If all OK, result is @True.} - function Uidl(Value: Integer): Boolean; - - {:Call STLS command for upgrade connection to SSL/TLS mode.} - function StartTLS: Boolean; - - {:Try to find given capabily in capabilty string returned from POP3 server - by CAPA command.} - function FindCap(const Value: string): string; - published - {:Result code of last POP3 operation. 0 - error, 1 - OK.} - property ResultCode: Integer read FResultCode; - - {:Result string of last POP3 operation.} - property ResultString: string read FResultString; - - {:Stringlist with full lines returned as result of POP3 operation. I.e. if - operation is LIST, this property is filled by list of messages. If - operation is RETR, this property have downloaded message.} - property FullResult: TStringList read FFullResult; - - {:After STAT command is there count of messages in inbox.} - property StatCount: Integer read FStatCount; - - {:After STAT command is there size of all messages in inbox.} - property StatSize: Integer read FStatSize; - - {:After LIST 0 command size of all messages on server, After LIST x size of message x on server} - property ListSize: Integer read FListSize; - - {:If server support this, after comnnect is in this property timestamp of - remote server.} - property TimeStamp: string read FTimeStamp; - - {:Type of authorisation for login to POP3 server. Dafault is autodetect one - of possible authorisation. Autodetect do this: - - If remote POP3 server support APOP, try login by APOP method. If APOP is - not supported, or if APOP login failed, try classic USER+PASS login method.} - property AuthType: TPOP3AuthType read FAuthType Write FAuthType; - - {:If is set to @true, then upgrade to SSL/TLS mode if remote server support it.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:SSL/TLS mode is used from first contact to server. Servers with full - SSL/TLS mode usualy using non-standard TCP port!} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - end; - -implementation - -constructor TPOP3Send.Create; -begin - inherited Create; - FFullResult := TStringList.Create; - FPOP3cap := TStringList.Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.ConvertLineEnd := true; - FTimeout := 60000; - FTargetPort := cPop3Protocol; - FStatCount := 0; - FStatSize := 0; - FListSize := 0; - FAuthType := POP3AuthAll; - FAutoTLS := False; - FFullSSL := False; -end; - -destructor TPOP3Send.Destroy; -begin - FSock.Free; - FPOP3cap.Free; - FullResult.Free; - inherited Destroy; -end; - -function TPOP3Send.ReadResult(Full: Boolean): Integer; -var - s: AnsiString; -begin - Result := 0; - FFullResult.Clear; - s := FSock.RecvString(FTimeout); - if Pos('+OK', s) = 1 then - Result := 1; - FResultString := s; - if Full and (Result = 1) then - repeat - s := FSock.RecvString(FTimeout); - if s = '.' then - Break; - if s <> '' then - if s[1] = '.' then - Delete(s, 1, 1); - FFullResult.Add(s); - until FSock.LastError <> 0; - if not Full and (Result = 1) then - FFullResult.Add(SeparateRight(FResultString, ' ')); - if FSock.LastError <> 0 then - Result := 0; - FResultCode := Result; -end; - -function TPOP3Send.CustomCommand(const Command: string; MultiLine: Boolean): boolean; -begin - FSock.SendString(Command + CRLF); - Result := ReadResult(MultiLine) <> 0; -end; - -function TPOP3Send.AuthLogin: Boolean; -begin - Result := False; - if not CustomCommand('USER ' + FUserName, False) then - exit; - Result := CustomCommand('PASS ' + FPassword, False) -end; - -function TPOP3Send.AuthAPOP: Boolean; -var - s: string; -begin - s := StrToHex(MD5(FTimeStamp + FPassWord)); - Result := CustomCommand('APOP ' + FUserName + ' ' + s, False); -end; - -function TPOP3Send.Connect: Boolean; -begin - // Do not call this function! It is calling by LOGIN method! - FStatCount := 0; - FStatSize := 0; - FSock.CloseSocket; - FSock.LineBuffer := ''; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TPOP3Send.Capability: Boolean; -begin - FPOP3cap.Clear; - Result := CustomCommand('CAPA', True); - if Result then - FPOP3cap.AddStrings(FFullResult); -end; - -function TPOP3Send.Login: Boolean; -var - s, s1: string; -begin - Result := False; - FTimeStamp := ''; - if not Connect then - Exit; - if ReadResult(False) <> 1 then - Exit; - s := SeparateRight(FResultString, '<'); - if s <> FResultString then - begin - s1 := Trim(SeparateLeft(s, '>')); - if s1 <> s then - FTimeStamp := '<' + s1 + '>'; - end; - Result := False; - if Capability then - if FAutoTLS and (Findcap('STLS') <> '') then - if StartTLS then - Capability - else - begin - Result := False; - Exit; - end; - if (FTimeStamp <> '') and not (FAuthType = POP3AuthLogin) then - begin - Result := AuthApop; - if not Result then - begin - if not Connect then - Exit; - if ReadResult(False) <> 1 then - Exit; - end; - end; - if not Result and not (FAuthType = POP3AuthAPOP) then - Result := AuthLogin; -end; - -function TPOP3Send.Logout: Boolean; -begin - Result := CustomCommand('QUIT', False); - FSock.CloseSocket; -end; - -function TPOP3Send.Reset: Boolean; -begin - Result := CustomCommand('RSET', False); -end; - -function TPOP3Send.NoOp: Boolean; -begin - Result := CustomCommand('NOOP', False); -end; - -function TPOP3Send.Stat: Boolean; -var - s: string; -begin - Result := CustomCommand('STAT', False); - if Result then - begin - s := SeparateRight(ResultString, '+OK '); - FStatCount := StrToIntDef(Trim(SeparateLeft(s, ' ')), 0); - FStatSize := StrToIntDef(Trim(SeparateRight(s, ' ')), 0); - end; -end; - -function TPOP3Send.List(Value: Integer): Boolean; -var - s: string; - n: integer; -begin - if Value = 0 then - s := 'LIST' - else - s := 'LIST ' + IntToStr(Value); - Result := CustomCommand(s, Value = 0); - FListSize := 0; - if Result then - if Value <> 0 then - begin - s := SeparateRight(ResultString, '+OK '); - FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0); - end - else - for n := 0 to FFullResult.Count - 1 do - FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0); -end; - -function TPOP3Send.Retr(Value: Integer): Boolean; -begin - Result := CustomCommand('RETR ' + IntToStr(Value), True); -end; - -//based on code by Miha Vrhovnik -function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean; -var - s: string; -begin - Result := False; - FFullResult.Clear; - Stream.Size := 0; - FSock.SendString('RETR ' + IntToStr(Value) + CRLF); - - s := FSock.RecvString(FTimeout); - if Pos('+OK', s) = 1 then - Result := True; - FResultString := s; - if Result then begin - repeat - s := FSock.RecvString(FTimeout); - if s = '.' then - Break; - if s <> '' then begin - if s[1] = '.' then - Delete(s, 1, 1); - end; - WriteStrToStream(Stream, s); - WriteStrToStream(Stream, CRLF); - until FSock.LastError <> 0; - end; - - if Result then - FResultCode := 1 - else - FResultCode := 0; -end; - -function TPOP3Send.Dele(Value: Integer): Boolean; -begin - Result := CustomCommand('DELE ' + IntToStr(Value), False); -end; - -function TPOP3Send.Top(Value, Maxlines: Integer): Boolean; -begin - Result := CustomCommand('TOP ' + IntToStr(Value) + ' ' + IntToStr(Maxlines), True); -end; - -function TPOP3Send.Uidl(Value: Integer): Boolean; -var - s: string; -begin - if Value = 0 then - s := 'UIDL' - else - s := 'UIDL ' + IntToStr(Value); - Result := CustomCommand(s, Value = 0); -end; - -function TPOP3Send.StartTLS: Boolean; -begin - Result := False; - if CustomCommand('STLS', False) then - begin - Fsock.SSLDoConnect; - Result := FSock.LastError = 0; - end; -end; - -function TPOP3Send.FindCap(const Value: string): string; -var - n: Integer; - s: string; -begin - s := UpperCase(Value); - Result := ''; - for n := 0 to FPOP3cap.Count - 1 do - if Pos(s, UpperCase(FPOP3cap[n])) = 1 then - begin - Result := FPOP3cap[n]; - Break; - end; -end; - -end. diff --git a/3rd/synapse/source/slogsend.pas b/3rd/synapse/source/slogsend.pas deleted file mode 100644 index 900f6c01a..000000000 --- a/3rd/synapse/source/slogsend.pas +++ /dev/null @@ -1,320 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.002.003 | -|==============================================================================| -| Content: SysLog client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2001-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Christian Brosius | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(BSD SYSLOG protocol) - -Used RFC: RFC-3164 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -unit slogsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil; - -const - cSysLogProtocol = '514'; - - FCL_Kernel = 0; - FCL_UserLevel = 1; - FCL_MailSystem = 2; - FCL_System = 3; - FCL_Security = 4; - FCL_Syslogd = 5; - FCL_Printer = 6; - FCL_News = 7; - FCL_UUCP = 8; - FCL_Clock = 9; - FCL_Authorization = 10; - FCL_FTP = 11; - FCL_NTP = 12; - FCL_LogAudit = 13; - FCL_LogAlert = 14; - FCL_Time = 15; - FCL_Local0 = 16; - FCL_Local1 = 17; - FCL_Local2 = 18; - FCL_Local3 = 19; - FCL_Local4 = 20; - FCL_Local5 = 21; - FCL_Local6 = 22; - FCL_Local7 = 23; - -type - {:@abstract(Define possible priority of Syslog message)} - TSyslogSeverity = (Emergency, Alert, Critical, Error, Warning, Notice, Info, - Debug); - - {:@abstract(encoding or decoding of SYSLOG message)} - TSyslogMessage = class(TObject) - private - FFacility:Byte; - FSeverity:TSyslogSeverity; - FDateTime:TDateTime; - FTag:String; - FMessage:String; - FLocalIP:String; - function GetPacketBuf:String; - procedure SetPacketBuf(Value:String); - public - {:Reset values to defaults} - procedure Clear; - published - {:Define facilicity of Syslog message. For specify you may use predefined - FCL_* constants. Default is "FCL_Local0".} - property Facility:Byte read FFacility write FFacility; - - {:Define possible priority of Syslog message. Default is "Debug".} - property Severity:TSyslogSeverity read FSeverity write FSeverity; - - {:date and time of Syslog message} - property DateTime:TDateTime read FDateTime write FDateTime; - - {:This is used for identify process of this message. Default is filename - of your executable file.} - property Tag:String read FTag write FTag; - - {:Text of your message for log.} - property LogMessage:String read FMessage write FMessage; - - {:IP address of message sender.} - property LocalIP:String read FLocalIP write FLocalIP; - - {:This property holds encoded binary SYSLOG packet} - property PacketBuf:String read GetPacketBuf write SetPacketBuf; - end; - - {:@abstract(This object implement BSD SysLog client) - - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TSyslogSend = class(TSynaClient) - private - FSock: TUDPBlockSocket; - FSysLogMessage: TSysLogMessage; - public - constructor Create; - destructor Destroy; override; - {:Send Syslog UDP packet defined by @link(SysLogMessage).} - function DoIt: Boolean; - published - {:Syslog message for send} - property SysLogMessage:TSysLogMessage read FSysLogMessage write FSysLogMessage; - end; - -{:Simply send packet to specified Syslog server.} -function ToSysLog(const SyslogServer: string; Facil: Byte; - Sever: TSyslogSeverity; const Content: string): Boolean; - -implementation - -function TSyslogMessage.GetPacketBuf:String; -begin - Result := '<' + IntToStr((FFacility * 8) + Ord(FSeverity)) + '>'; - Result := Result + CDateTime(FDateTime) + ' '; - Result := Result + FLocalIP + ' '; - Result := Result + FTag + ': ' + FMessage; -end; - -procedure TSyslogMessage.SetPacketBuf(Value:String); -var StrBuf:String; - IntBuf,Pos:Integer; -begin - if Length(Value) < 1 then exit; - Pos := 1; - if Value[Pos] <> '<' then exit; - Inc(Pos); - // Facility and Severity - StrBuf := ''; - while (Value[Pos] <> '>')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - IntBuf := StrToInt(StrBuf); - FFacility := IntBuf div 8; - case (IntBuf mod 8)of - 0:FSeverity := Emergency; - 1:FSeverity := Alert; - 2:FSeverity := Critical; - 3:FSeverity := Error; - 4:FSeverity := Warning; - 5:FSeverity := Notice; - 6:FSeverity := Info; - 7:FSeverity := Debug; - end; - // DateTime - Inc(Pos); - StrBuf := ''; - // Month - while (Value[Pos] <> ' ')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - // Day - while (Value[Pos] <> ' ')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - // Time - while (Value[Pos] <> ' ')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - FDateTime := DecodeRFCDateTime(StrBuf); - Inc(Pos); - - // LocalIP - StrBuf := ''; - while (Value[Pos] <> ' ')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - FLocalIP := StrBuf; - Inc(Pos); - // Tag - StrBuf := ''; - while (Value[Pos] <> ':')do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - FTag := StrBuf; - // LogMessage - Inc(Pos); - StrBuf := ''; - while (Pos <= Length(Value))do - begin - StrBuf := StrBuf + Value[Pos]; - Inc(Pos); - end; - FMessage := TrimSP(StrBuf); -end; - -procedure TSysLogMessage.Clear; -begin - FFacility := FCL_Local0; - FSeverity := Debug; - FTag := ExtractFileName(ParamStr(0)); - FMessage := ''; - FLocalIP := '0.0.0.0'; -end; - -//------------------------------------------------------------------------------ - -constructor TSyslogSend.Create; -begin - inherited Create; - FSock := TUDPBlockSocket.Create; - FSock.Owner := self; - FSysLogMessage := TSysLogMessage.Create; - FTargetPort := cSysLogProtocol; -end; - -destructor TSyslogSend.Destroy; -begin - FSock.Free; - FSysLogMessage.Free; - inherited Destroy; -end; - -function TSyslogSend.DoIt: Boolean; -var - L: TStringList; -begin - Result := False; - L := TStringList.Create; - try - FSock.ResolveNameToIP(FSock.Localname, L); - if L.Count < 1 then - FSysLogMessage.LocalIP := '0.0.0.0' - else - FSysLogMessage.LocalIP := L[0]; - finally - L.Free; - end; - FSysLogMessage.DateTime := Now; - if Length(FSysLogMessage.PacketBuf) <= 1024 then - begin - FSock.Connect(FTargetHost, FTargetPort); - FSock.SendString(FSysLogMessage.PacketBuf); - Result := FSock.LastError = 0; - end; -end; - -{==============================================================================} - -function ToSysLog(const SyslogServer: string; Facil: Byte; - Sever: TSyslogSeverity; const Content: string): Boolean; -begin - with TSyslogSend.Create do - try - TargetHost :=SyslogServer; - SysLogMessage.Facility := Facil; - SysLogMessage.Severity := Sever; - SysLogMessage.LogMessage := Content; - Result := DoIt; - finally - Free; - end; -end; - -end. diff --git a/3rd/synapse/source/smtpsend.pas b/3rd/synapse/source/smtpsend.pas deleted file mode 100644 index e023a38ff..000000000 --- a/3rd/synapse/source/smtpsend.pas +++ /dev/null @@ -1,724 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 003.005.001 | -|==============================================================================| -| Content: SMTP client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(SMTP client) - -Used RFC: RFC-1869, RFC-1870, RFC-1893, RFC-2034, RFC-2104, RFC-2195, RFC-2487, - RFC-2554, RFC-2821 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit smtpsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil, synacode; - -const - cSmtpProtocol = '25'; - -type - {:@abstract(Implementation of SMTP and ESMTP procotol), - include some ESMTP extensions, include SSL/TLS too. - - Note: Are you missing properties for setting Username and Password for ESMTP? - Look to parent @link(TSynaClient) object! - - Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TSMTPSend = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FResultCode: Integer; - FResultString: string; - FFullResult: TStringList; - FESMTPcap: TStringList; - FESMTP: Boolean; - FAuthDone: Boolean; - FESMTPSize: Boolean; - FMaxSize: Integer; - FEnhCode1: Integer; - FEnhCode2: Integer; - FEnhCode3: Integer; - FSystemName: string; - FAutoTLS: Boolean; - FFullSSL: Boolean; - procedure EnhancedCode(const Value: string); - function ReadResult: Integer; - function AuthLogin: Boolean; - function AuthCram: Boolean; - function AuthPlain: Boolean; - function Helo: Boolean; - function Ehlo: Boolean; - function Connect: Boolean; - public - constructor Create; - destructor Destroy; override; - - {:Connects to SMTP server (defined in @link(TSynaClient.TargetHost)) and - begin SMTP session. (First try ESMTP EHLO, next old HELO handshake). Parses - ESMTP capabilites and if you specified Username and password and remote - server can handle AUTH command, try login by AUTH command. Preffered login - method is CRAM-MD5 (if safer!). If all OK, result is @true, else result is - @false.} - function Login: Boolean; - - {:Close SMTP session (QUIT command) and disconnect from SMTP server.} - function Logout: Boolean; - - {:Send RSET SMTP command for reset SMTP session. If all OK, result is @true, - else result is @false.} - function Reset: Boolean; - - {:Send NOOP SMTP command for keep SMTP session. If all OK, result is @true, - else result is @false.} - function NoOp: Boolean; - - {:Send MAIL FROM SMTP command for set sender e-mail address. If sender's - e-mail address is empty string, transmited message is error message. - - If size not 0 and remote server can handle SIZE parameter, append SIZE - parameter to request. If all OK, result is @true, else result is @false.} - function MailFrom(const Value: string; Size: Integer): Boolean; - - {:Send RCPT TO SMTP command for set receiver e-mail address. It cannot be an - empty string. If all OK, result is @true, else result is @false.} - function MailTo(const Value: string): Boolean; - - {:Send DATA SMTP command and transmit message data. If all OK, result is - @true, else result is @false.} - function MailData(const Value: Tstrings): Boolean; - - {:Send ETRN SMTP command for start sending of remote queue for domain in - Value. If all OK, result is @true, else result is @false.} - function Etrn(const Value: string): Boolean; - - {:Send VRFY SMTP command for check receiver e-mail address. It cannot be - an empty string. If all OK, result is @true, else result is @false.} - function Verify(const Value: string): Boolean; - - {:Call STARTTLS command for upgrade connection to SSL/TLS mode.} - function StartTLS: Boolean; - - {:Return string descriptive text for enhanced result codes stored in - @link(EnhCode1), @link(EnhCode2) and @link(EnhCode3).} - function EnhCodeString: string; - - {:Try to find specified capability in ESMTP response.} - function FindCap(const Value: string): string; - published - {:result code of last SMTP command.} - property ResultCode: Integer read FResultCode; - - {:result string of last SMTP command (begin with string representation of - result code).} - property ResultString: string read FResultString; - - {:All result strings of last SMTP command (result is maybe multiline!).} - property FullResult: TStringList read FFullResult; - - {:List of ESMTP capabilites of remote ESMTP server. (If you connect to ESMTP - server only!).} - property ESMTPcap: TStringList read FESMTPcap; - - {:@TRUE if you successfuly logged to ESMTP server.} - property ESMTP: Boolean read FESMTP; - - {:@TRUE if you successfuly pass authorisation to remote server.} - property AuthDone: Boolean read FAuthDone; - - {:@TRUE if remote server can handle SIZE parameter.} - property ESMTPSize: Boolean read FESMTPSize; - - {:When @link(ESMTPsize) is @TRUE, contains max length of message that remote - server can handle.} - property MaxSize: Integer read FMaxSize; - - {:First digit of Enhanced result code. If last operation does not have - enhanced result code, values is 0.} - property EnhCode1: Integer read FEnhCode1; - - {:Second digit of Enhanced result code. If last operation does not have - enhanced result code, values is 0.} - property EnhCode2: Integer read FEnhCode2; - - {:Third digit of Enhanced result code. If last operation does not have - enhanced result code, values is 0.} - property EnhCode3: Integer read FEnhCode3; - - {:name of our system used in HELO and EHLO command. Implicit value is - internet address of your machine.} - property SystemName: string read FSystemName Write FSystemName; - - {:If is set to true, then upgrade to SSL/TLS mode if remote server support it.} - property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; - - {:SSL/TLS mode is used from first contact to server. Servers with full - SSL/TLS mode usualy using non-standard TCP port!} - property FullSSL: Boolean read FFullSSL Write FFullSSL; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - end; - -{:A very useful function and example of its use would be found in the TSMTPsend - object. Send maildata (text of e-mail with all SMTP headers! For example when - text of message is created by @link(TMimemess) object) from "MailFrom" e-mail - address to "MailTo" e-mail address (If you need more then one receiver, then - separate their addresses by comma). - - Function sends e-mail to a SMTP server defined in "SMTPhost" parameter. - Username and password are used for authorization to the "SMTPhost". If you - don't want authorization, set "Username" and "Password" to empty strings. If - e-mail message is successfully sent, the result returns @true. - - If you need use different port number then standard, then add this port number - to SMTPhost after colon. (i.e. '127.0.0.1:1025')} -function SendToRaw(const MailFrom, MailTo, SMTPHost: string; - const MailData: TStrings; const Username, Password: string): Boolean; - -{:A very useful function and example of its use would be found in the TSMTPsend - object. Send "Maildata" (text of e-mail without any SMTP headers!) from - "MailFrom" e-mail address to "MailTo" e-mail address with "Subject". (If you - need more then one receiver, then separate their addresses by comma). - - This function constructs all needed SMTP headers (with DATE header) and sends - the e-mail to the SMTP server defined in the "SMTPhost" parameter. If the - e-mail message is successfully sent, the result will be @TRUE. - - If you need use different port number then standard, then add this port number - to SMTPhost after colon. (i.e. '127.0.0.1:1025')} -function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string; - const MailData: TStrings): Boolean; - -{:A very useful function and example of its use would be found in the TSMTPsend - object. Sends "MailData" (text of e-mail without any SMTP headers!) from - "MailFrom" e-mail address to "MailTo" e-mail address (If you need more then one - receiver, then separate their addresses by comma). - - This function sends the e-mail to the SMTP server defined in the "SMTPhost" - parameter. Username and password are used for authorization to the "SMTPhost". - If you dont want authorization, set "Username" and "Password" to empty Strings. - If the e-mail message is successfully sent, the result will be @TRUE. - - If you need use different port number then standard, then add this port number - to SMTPhost after colon. (i.e. '127.0.0.1:1025')} -function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string; - const MailData: TStrings; const Username, Password: string): Boolean; - -implementation - -constructor TSMTPSend.Create; -begin - inherited Create; - FFullResult := TStringList.Create; - FESMTPcap := TStringList.Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.ConvertLineEnd := true; - FTimeout := 60000; - FTargetPort := cSmtpProtocol; - FSystemName := FSock.LocalName; - FAutoTLS := False; - FFullSSL := False; -end; - -destructor TSMTPSend.Destroy; -begin - FSock.Free; - FESMTPcap.Free; - FFullResult.Free; - inherited Destroy; -end; - -procedure TSMTPSend.EnhancedCode(const Value: string); -var - s, t: string; - e1, e2, e3: Integer; -begin - FEnhCode1 := 0; - FEnhCode2 := 0; - FEnhCode3 := 0; - s := Copy(Value, 5, Length(Value) - 4); - t := Trim(SeparateLeft(s, '.')); - s := Trim(SeparateRight(s, '.')); - if t = '' then - Exit; - if Length(t) > 1 then - Exit; - e1 := StrToIntDef(t, 0); - if e1 = 0 then - Exit; - t := Trim(SeparateLeft(s, '.')); - s := Trim(SeparateRight(s, '.')); - if t = '' then - Exit; - if Length(t) > 3 then - Exit; - e2 := StrToIntDef(t, 0); - t := Trim(SeparateLeft(s, ' ')); - if t = '' then - Exit; - if Length(t) > 3 then - Exit; - e3 := StrToIntDef(t, 0); - FEnhCode1 := e1; - FEnhCode2 := e2; - FEnhCode3 := e3; -end; - -function TSMTPSend.ReadResult: Integer; -var - s: String; -begin - Result := 0; - FFullResult.Clear; - repeat - s := FSock.RecvString(FTimeout); - FResultString := s; - FFullResult.Add(s); - if FSock.LastError <> 0 then - Break; - until Pos('-', s) <> 4; - s := FFullResult[0]; - if Length(s) >= 3 then - Result := StrToIntDef(Copy(s, 1, 3), 0); - FResultCode := Result; - EnhancedCode(s); -end; - -function TSMTPSend.AuthLogin: Boolean; -begin - Result := False; - FSock.SendString('AUTH LOGIN' + CRLF); - if ReadResult <> 334 then - Exit; - FSock.SendString(EncodeBase64(FUsername) + CRLF); - if ReadResult <> 334 then - Exit; - FSock.SendString(EncodeBase64(FPassword) + CRLF); - Result := ReadResult = 235; -end; - -function TSMTPSend.AuthCram: Boolean; -var - s: ansistring; -begin - Result := False; - FSock.SendString('AUTH CRAM-MD5' + CRLF); - if ReadResult <> 334 then - Exit; - s := Copy(FResultString, 5, Length(FResultString) - 4); - s := DecodeBase64(s); - s := HMAC_MD5(s, FPassword); - s := FUsername + ' ' + StrToHex(s); - FSock.SendString(EncodeBase64(s) + CRLF); - Result := ReadResult = 235; -end; - -function TSMTPSend.AuthPlain: Boolean; -var - s: ansistring; -begin - s := ansichar(0) + FUsername + ansichar(0) + FPassword; - FSock.SendString('AUTH PLAIN ' + EncodeBase64(s) + CRLF); - Result := ReadResult = 235; -end; - -function TSMTPSend.Connect: Boolean; -begin - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - if FSock.LastError = 0 then - FSock.Connect(FTargetHost, FTargetPort); - if FSock.LastError = 0 then - if FFullSSL then - FSock.SSLDoConnect; - Result := FSock.LastError = 0; -end; - -function TSMTPSend.Helo: Boolean; -var - x: Integer; -begin - FSock.SendString('HELO ' + FSystemName + CRLF); - x := ReadResult; - Result := (x >= 250) and (x <= 259); -end; - -function TSMTPSend.Ehlo: Boolean; -var - x: Integer; -begin - FSock.SendString('EHLO ' + FSystemName + CRLF); - x := ReadResult; - Result := (x >= 250) and (x <= 259); -end; - -function TSMTPSend.Login: Boolean; -var - n: Integer; - auths: string; - s: string; -begin - Result := False; - FESMTP := True; - FAuthDone := False; - FESMTPcap.clear; - FESMTPSize := False; - FMaxSize := 0; - if not Connect then - Exit; - if ReadResult <> 220 then - Exit; - if not Ehlo then - begin - FESMTP := False; - if not Helo then - Exit; - end; - Result := True; - if FESMTP then - begin - for n := 1 to FFullResult.Count - 1 do - FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4)); - if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then - if StartTLS then - begin - Ehlo; - FESMTPcap.Clear; - for n := 1 to FFullResult.Count - 1 do - FESMTPcap.Add(Copy(FFullResult[n], 5, Length(FFullResult[n]) - 4)); - end - else - begin - Result := False; - Exit; - end; - if not ((FUsername = '') and (FPassword = '')) then - begin - s := FindCap('AUTH '); - if s = '' then - s := FindCap('AUTH='); - auths := UpperCase(s); - if s <> '' then - begin - if Pos('CRAM-MD5', auths) > 0 then - FAuthDone := AuthCram; - if (not FauthDone) and (Pos('PLAIN', auths) > 0) then - FAuthDone := AuthPlain; - if (not FauthDone) and (Pos('LOGIN', auths) > 0) then - FAuthDone := AuthLogin; - end; - end; - s := FindCap('SIZE'); - if s <> '' then - begin - FESMTPsize := True; - FMaxSize := StrToIntDef(Copy(s, 6, Length(s) - 5), 0); - end; - end; -end; - -function TSMTPSend.Logout: Boolean; -begin - FSock.SendString('QUIT' + CRLF); - Result := ReadResult = 221; - FSock.CloseSocket; -end; - -function TSMTPSend.Reset: Boolean; -begin - FSock.SendString('RSET' + CRLF); - Result := ReadResult div 100 = 2; -end; - -function TSMTPSend.NoOp: Boolean; -begin - FSock.SendString('NOOP' + CRLF); - Result := ReadResult div 100 = 2; -end; - -function TSMTPSend.MailFrom(const Value: string; Size: Integer): Boolean; -var - s: string; -begin - s := 'MAIL FROM:<' + Value + '>'; - if FESMTPsize and (Size > 0) then - s := s + ' SIZE=' + IntToStr(Size); - FSock.SendString(s + CRLF); - Result := ReadResult div 100 = 2; -end; - -function TSMTPSend.MailTo(const Value: string): Boolean; -begin - FSock.SendString('RCPT TO:<' + Value + '>' + CRLF); - Result := ReadResult div 100 = 2; -end; - -function TSMTPSend.MailData(const Value: TStrings): Boolean; -var - n: Integer; - s: string; - t: string; - x: integer; -begin - Result := False; - FSock.SendString('DATA' + CRLF); - if ReadResult <> 354 then - Exit; - t := ''; - x := 1500; - for n := 0 to Value.Count - 1 do - begin - s := Value[n]; - if Length(s) >= 1 then - if s[1] = '.' then - s := '.' + s; - if Length(t) + Length(s) >= x then - begin - FSock.SendString(t); - t := ''; - end; - t := t + s + CRLF; - end; - if t <> '' then - FSock.SendString(t); - FSock.SendString('.' + CRLF); - Result := ReadResult div 100 = 2; -end; - -function TSMTPSend.Etrn(const Value: string): Boolean; -var - x: Integer; -begin - FSock.SendString('ETRN ' + Value + CRLF); - x := ReadResult; - Result := (x >= 250) and (x <= 259); -end; - -function TSMTPSend.Verify(const Value: string): Boolean; -var - x: Integer; -begin - FSock.SendString('VRFY ' + Value + CRLF); - x := ReadResult; - Result := (x >= 250) and (x <= 259); -end; - -function TSMTPSend.StartTLS: Boolean; -begin - Result := False; - if FindCap('STARTTLS') <> '' then - begin - FSock.SendString('STARTTLS' + CRLF); - if (ReadResult = 220) and (FSock.LastError = 0) then - begin - Fsock.SSLDoConnect; - Result := FSock.LastError = 0; - end; - end; -end; - -function TSMTPSend.EnhCodeString: string; -var - s, t: string; -begin - s := IntToStr(FEnhCode2) + '.' + IntToStr(FEnhCode3); - t := ''; - if s = '0.0' then t := 'Other undefined Status'; - if s = '1.0' then t := 'Other address status'; - if s = '1.1' then t := 'Bad destination mailbox address'; - if s = '1.2' then t := 'Bad destination system address'; - if s = '1.3' then t := 'Bad destination mailbox address syntax'; - if s = '1.4' then t := 'Destination mailbox address ambiguous'; - if s = '1.5' then t := 'Destination mailbox address valid'; - if s = '1.6' then t := 'Mailbox has moved'; - if s = '1.7' then t := 'Bad sender''s mailbox address syntax'; - if s = '1.8' then t := 'Bad sender''s system address'; - if s = '2.0' then t := 'Other or undefined mailbox status'; - if s = '2.1' then t := 'Mailbox disabled, not accepting messages'; - if s = '2.2' then t := 'Mailbox full'; - if s = '2.3' then t := 'Message Length exceeds administrative limit'; - if s = '2.4' then t := 'Mailing list expansion problem'; - if s = '3.0' then t := 'Other or undefined mail system status'; - if s = '3.1' then t := 'Mail system full'; - if s = '3.2' then t := 'System not accepting network messages'; - if s = '3.3' then t := 'System not capable of selected features'; - if s = '3.4' then t := 'Message too big for system'; - if s = '3.5' then t := 'System incorrectly configured'; - if s = '4.0' then t := 'Other or undefined network or routing status'; - if s = '4.1' then t := 'No answer from host'; - if s = '4.2' then t := 'Bad connection'; - if s = '4.3' then t := 'Routing server failure'; - if s = '4.4' then t := 'Unable to route'; - if s = '4.5' then t := 'Network congestion'; - if s = '4.6' then t := 'Routing loop detected'; - if s = '4.7' then t := 'Delivery time expired'; - if s = '5.0' then t := 'Other or undefined protocol status'; - if s = '5.1' then t := 'Invalid command'; - if s = '5.2' then t := 'Syntax error'; - if s = '5.3' then t := 'Too many recipients'; - if s = '5.4' then t := 'Invalid command arguments'; - if s = '5.5' then t := 'Wrong protocol version'; - if s = '6.0' then t := 'Other or undefined media error'; - if s = '6.1' then t := 'Media not supported'; - if s = '6.2' then t := 'Conversion required and prohibited'; - if s = '6.3' then t := 'Conversion required but not supported'; - if s = '6.4' then t := 'Conversion with loss performed'; - if s = '6.5' then t := 'Conversion failed'; - if s = '7.0' then t := 'Other or undefined security status'; - if s = '7.1' then t := 'Delivery not authorized, message refused'; - if s = '7.2' then t := 'Mailing list expansion prohibited'; - if s = '7.3' then t := 'Security conversion required but not possible'; - if s = '7.4' then t := 'Security features not supported'; - if s = '7.5' then t := 'Cryptographic failure'; - if s = '7.6' then t := 'Cryptographic algorithm not supported'; - if s = '7.7' then t := 'Message integrity failure'; - s := '???-'; - if FEnhCode1 = 2 then s := 'Success-'; - if FEnhCode1 = 4 then s := 'Persistent Transient Failure-'; - if FEnhCode1 = 5 then s := 'Permanent Failure-'; - Result := s + t; -end; - -function TSMTPSend.FindCap(const Value: string): string; -var - n: Integer; - s: string; -begin - s := UpperCase(Value); - Result := ''; - for n := 0 to FESMTPcap.Count - 1 do - if Pos(s, UpperCase(FESMTPcap[n])) = 1 then - begin - Result := FESMTPcap[n]; - Break; - end; -end; - -{==============================================================================} - -function SendToRaw(const MailFrom, MailTo, SMTPHost: string; - const MailData: TStrings; const Username, Password: string): Boolean; -var - SMTP: TSMTPSend; - s, t: string; -begin - Result := False; - SMTP := TSMTPSend.Create; - try -// if you need SOCKS5 support, uncomment next lines: - // SMTP.Sock.SocksIP := '127.0.0.1'; - // SMTP.Sock.SocksPort := '1080'; -// if you need support for upgrade session to TSL/SSL, uncomment next lines: - // SMTP.AutoTLS := True; -// if you need support for TSL/SSL tunnel, uncomment next lines: - // SMTP.FullSSL := True; - SMTP.TargetHost := Trim(SeparateLeft(SMTPHost, ':')); - s := Trim(SeparateRight(SMTPHost, ':')); - if (s <> '') and (s <> SMTPHost) then - SMTP.TargetPort := s; - SMTP.Username := Username; - SMTP.Password := Password; - if SMTP.Login then - begin - if SMTP.MailFrom(GetEmailAddr(MailFrom), Length(MailData.Text)) then - begin - s := MailTo; - repeat - t := GetEmailAddr(Trim(FetchEx(s, ',', '"'))); - if t <> '' then - Result := SMTP.MailTo(t); - if not Result then - Break; - until s = ''; - if Result then - Result := SMTP.MailData(MailData); - end; - SMTP.Logout; - end; - finally - SMTP.Free; - end; -end; - -function SendToEx(const MailFrom, MailTo, Subject, SMTPHost: string; - const MailData: TStrings; const Username, Password: string): Boolean; -var - t: TStrings; -begin - t := TStringList.Create; - try - t.Assign(MailData); - t.Insert(0, ''); - t.Insert(0, 'X-mailer: Synapse - Delphi & Kylix TCP/IP library by Lukas Gebauer'); - t.Insert(0, 'Subject: ' + Subject); - t.Insert(0, 'Date: ' + Rfc822DateTime(now)); - t.Insert(0, 'To: ' + MailTo); - t.Insert(0, 'From: ' + MailFrom); - Result := SendToRaw(MailFrom, MailTo, SMTPHost, t, Username, Password); - finally - t.Free; - end; -end; - -function SendTo(const MailFrom, MailTo, Subject, SMTPHost: string; - const MailData: TStrings): Boolean; -begin - Result := SendToEx(MailFrom, MailTo, Subject, SMTPHost, MailData, '', ''); -end; - -end. diff --git a/3rd/synapse/source/snmpsend.pas b/3rd/synapse/source/snmpsend.pas deleted file mode 100644 index 6e44c04e5..000000000 --- a/3rd/synapse/source/snmpsend.pas +++ /dev/null @@ -1,1266 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 004.000.000 | -|==============================================================================| -| Content: SNMP client | -|==============================================================================| -| Copyright (c)1999-2011, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2011. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Jean-Fabien Connault (cycocrew@worldnet.fr) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(SNMP client) -Supports SNMPv1 include traps, SNMPv2c and SNMPv3 include authorization -and privacy encryption. - -Used RFC: RFC-1157, RFC-1901, RFC-3412, RFC-3414, RFC-3416, RFC-3826 - -Supported Authorization hashes: MD5, SHA1 -Supported Privacy encryptions: DES, 3DES, AES -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit snmpsend; - -interface - -uses - Classes, SysUtils, - blcksock, synautil, asn1util, synaip, synacode, synacrypt; - -const - cSnmpProtocol = '161'; - cSnmpTrapProtocol = '162'; - - SNMP_V1 = 0; - SNMP_V2C = 1; - SNMP_V3 = 3; - - //PDU type - PDUGetRequest = $A0; - PDUGetNextRequest = $A1; - PDUGetResponse = $A2; - PDUSetRequest = $A3; - PDUTrap = $A4; //Obsolete - //for SNMPv2 - PDUGetBulkRequest = $A5; - PDUInformRequest = $A6; - PDUTrapV2 = $A7; - PDUReport = $A8; - - //errors - ENoError = 0; - ETooBig = 1; - ENoSuchName = 2; - EBadValue = 3; - EReadOnly = 4; - EGenErr = 5; - //errors SNMPv2 - ENoAccess = 6; - EWrongType = 7; - EWrongLength = 8; - EWrongEncoding = 9; - EWrongValue = 10; - ENoCreation = 11; - EInconsistentValue = 12; - EResourceUnavailable = 13; - ECommitFailed = 14; - EUndoFailed = 15; - EAuthorizationError = 16; - ENotWritable = 17; - EInconsistentName = 18; - -type - - {:@abstract(Possible values for SNMPv3 flags.) - This flags specify level of authorization and encryption.} - TV3Flags = ( - NoAuthNoPriv, - AuthNoPriv, - AuthPriv); - - {:@abstract(Type of SNMPv3 authorization)} - TV3Auth = ( - AuthMD5, - AuthSHA1); - - {:@abstract(Type of SNMPv3 privacy)} - TV3Priv = ( - PrivDES, - Priv3DES, - PrivAES); - - {:@abstract(Data object with one record of MIB OID and corresponding values.)} - TSNMPMib = class(TObject) - protected - FOID: AnsiString; - FValue: AnsiString; - FValueType: Integer; - published - {:OID number in string format.} - property OID: AnsiString read FOID write FOID; - - {:Value of OID object in string format.} - property Value: AnsiString read FValue write FValue; - - {:Define type of Value. Supported values are defined in @link(asn1util). - For queries use ASN1_NULL, becouse you don't know type in response!} - property ValueType: Integer read FValueType write FValueType; - end; - - {:@abstract(It holding all information for SNMPv3 agent synchronization) - Used internally.} - TV3Sync = record - EngineID: AnsiString; - EngineBoots: integer; - EngineTime: integer; - EngineStamp: Cardinal; - end; - - {:@abstract(Data object abstracts SNMP data packet)} - TSNMPRec = class(TObject) - protected - FVersion: Integer; - FPDUType: Integer; - FID: Integer; - FErrorStatus: Integer; - FErrorIndex: Integer; - FCommunity: AnsiString; - FSNMPMibList: TList; - FMaxSize: Integer; - FFlags: TV3Flags; - FFlagReportable: Boolean; - FContextEngineID: AnsiString; - FContextName: AnsiString; - FAuthMode: TV3Auth; - FAuthEngineID: AnsiString; - FAuthEngineBoots: integer; - FAuthEngineTime: integer; - FAuthEngineTimeStamp: cardinal; - FUserName: AnsiString; - FPassword: AnsiString; - FAuthKey: AnsiString; - FPrivMode: TV3Priv; - FPrivPassword: AnsiString; - FPrivKey: AnsiString; - FPrivSalt: AnsiString; - FPrivSaltCounter: integer; - FOldTrapEnterprise: AnsiString; - FOldTrapHost: AnsiString; - FOldTrapGen: Integer; - FOldTrapSpec: Integer; - FOldTrapTimeTicks: Integer; - function Pass2Key(const Value: AnsiString): AnsiString; - function EncryptPDU(const value: AnsiString): AnsiString; - function DecryptPDU(const value: AnsiString): AnsiString; - public - constructor Create; - destructor Destroy; override; - - {:Decode SNMP packet in buffer to object properties.} - function DecodeBuf(Buffer: AnsiString): Boolean; - - {:Encode obeject properties to SNMP packet.} - function EncodeBuf: AnsiString; - - {:Clears all object properties to default values.} - procedure Clear; - - {:Add entry to @link(SNMPMibList). For queries use value as empty string, - and ValueType as ASN1_NULL.} - procedure MIBAdd(const MIB, Value: AnsiString; ValueType: Integer); - - {:Delete entry from @link(SNMPMibList).} - procedure MIBDelete(Index: Integer); - - {:Search @link(SNMPMibList) list for MIB and return correspond value.} - function MIBGet(const MIB: AnsiString): AnsiString; - - {:return number of entries in MIB array.} - function MIBCount: integer; - - {:Return MIB information from given row of MIB array.} - function MIBByIndex(Index: Integer): TSNMPMib; - - {:List of @link(TSNMPMib) objects.} - property SNMPMibList: TList read FSNMPMibList; - published - {:Version of SNMP packet. Default value is 0 (SNMP ver. 1). You can use - value 1 for SNMPv2c or value 3 for SNMPv3.} - property Version: Integer read FVersion write FVersion; - - {:Community string for autorize access to SNMP server. (Case sensitive!) - Community string is not used in SNMPv3! Use @link(Username) and - @link(password) instead!} - property Community: AnsiString read FCommunity write FCommunity; - - {:Define type of SNMP operation.} - property PDUType: Integer read FPDUType write FPDUType; - - {:Contains ID number. Not need to use.} - property ID: Integer read FID write FID; - - {:When packet is reply, contains error code. Supported values are defined by - E* constants.} - property ErrorStatus: Integer read FErrorStatus write FErrorStatus; - - {:Point to error position in reply packet. Not usefull for users. It only - good for debugging!} - property ErrorIndex: Integer read FErrorIndex write FErrorIndex; - - {:special value for GetBulkRequest of SNMPv2 and v3.} - property NonRepeaters: Integer read FErrorStatus write FErrorStatus; - - {:special value for GetBulkRequest of SNMPv2 and v3.} - property MaxRepetitions: Integer read FErrorIndex write FErrorIndex; - - {:Maximum message size in bytes for SNMPv3. For sending is default 1472 bytes.} - property MaxSize: Integer read FMaxSize write FMaxSize; - - {:Specify if message is authorised or encrypted. Used only in SNMPv3.} - property Flags: TV3Flags read FFlags write FFlags; - - {:For SNMPv3.... If is @true, SNMP agent must send reply (at least with some - error).} - property FlagReportable: Boolean read FFlagReportable write FFlagReportable; - - {:For SNMPv3. If not specified, is used value from @link(AuthEngineID)} - property ContextEngineID: AnsiString read FContextEngineID write FContextEngineID; - - {:For SNMPv3.} - property ContextName: AnsiString read FContextName write FContextName; - - {:For SNMPv3. Specify Authorization mode. (specify used hash for - authorization)} - property AuthMode: TV3Auth read FAuthMode write FAuthMode; - - {:For SNMPv3. Specify Privacy mode.} - property PrivMode: TV3Priv read FPrivMode write FPrivMode; - - {:value used by SNMPv3 authorisation for synchronization with SNMP agent.} - property AuthEngineID: AnsiString read FAuthEngineID write FAuthEngineID; - - {:value used by SNMPv3 authorisation for synchronization with SNMP agent.} - property AuthEngineBoots: Integer read FAuthEngineBoots write FAuthEngineBoots; - - {:value used by SNMPv3 authorisation for synchronization with SNMP agent.} - property AuthEngineTime: Integer read FAuthEngineTime write FAuthEngineTime; - - {:value used by SNMPv3 authorisation for synchronization with SNMP agent.} - property AuthEngineTimeStamp: Cardinal read FAuthEngineTimeStamp Write FAuthEngineTimeStamp; - - {:SNMPv3 authorization username} - property UserName: AnsiString read FUserName write FUserName; - - {:SNMPv3 authorization password} - property Password: AnsiString read FPassword write FPassword; - - {:For SNMPv3. Computed Athorization key from @link(password).} - property AuthKey: AnsiString read FAuthKey write FAuthKey; - - {:SNMPv3 privacy password} - property PrivPassword: AnsiString read FPrivPassword write FPrivPassword; - - {:For SNMPv3. Computed Privacy key from @link(PrivPassword).} - property PrivKey: AnsiString read FPrivKey write FPrivKey; - - {:MIB value to identify the object that sent the TRAPv1.} - property OldTrapEnterprise: AnsiString read FOldTrapEnterprise write FOldTrapEnterprise; - - {:Address of TRAPv1 sender (IP address).} - property OldTrapHost: AnsiString read FOldTrapHost write FOldTrapHost; - - {:Generic TRAPv1 identification.} - property OldTrapGen: Integer read FOldTrapGen write FOldTrapGen; - - {:Specific TRAPv1 identification.} - property OldTrapSpec: Integer read FOldTrapSpec write FOldTrapSpec; - - {:Number of 1/100th of seconds since last reboot or power up. (for TRAPv1)} - property OldTrapTimeTicks: Integer read FOldTrapTimeTicks write FOldTrapTimeTicks; - end; - - {:@abstract(Implementation of SNMP protocol.) - - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TSNMPSend = class(TSynaClient) - protected - FSock: TUDPBlockSocket; - FBuffer: AnsiString; - FHostIP: AnsiString; - FQuery: TSNMPRec; - FReply: TSNMPRec; - function InternalSendSnmp(const Value: TSNMPRec): Boolean; - function InternalRecvSnmp(const Value: TSNMPRec): Boolean; - function InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean; - function GetV3EngineID: AnsiString; - function GetV3Sync: TV3Sync; - public - constructor Create; - destructor Destroy; override; - - {:Connects to a Host and send there query. If in timeout SNMP server send - back query, result is @true. If is used SNMPv3, then it synchronize self - with SNMPv3 agent first. (It is needed for SNMPv3 auhorization!)} - function SendRequest: Boolean; - - {:Send SNMP packet only, but not waits for reply. Good for sending traps.} - function SendTrap: Boolean; - - {:Receive SNMP packet only. Good for receiving traps.} - function RecvTrap: Boolean; - - {:Mapped to @link(SendRequest) internally. This function is only for - backward compatibility.} - function DoIt: Boolean; - published - {:contains raw binary form of SNMP packet. Good for debugging.} - property Buffer: AnsiString read FBuffer write FBuffer; - - {:After SNMP operation hold IP address of remote side.} - property HostIP: AnsiString read FHostIP; - - {:Data object contains SNMP query.} - property Query: TSNMPRec read FQuery; - - {:Data object contains SNMP reply.} - property Reply: TSNMPRec read FReply; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TUDPBlockSocket read FSock; - end; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It implements basic GET method of the SNMP protocol. The MIB value is - located in the "OID" variable, and is sent to the requested "SNMPHost" with - the proper "Community" access identifier. Upon a successful retrieval, "Value" - will contain the information requested. If the SNMP operation is successful, - the result returns @true.} -function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; - -{:This is useful function and example of use TSNMPSend object. It implements - the basic SET method of the SNMP protocol. If the SNMP operation is successful, - the result is @true. "Value" is value of MIB Oid for "SNMPHost" with "Community" - access identifier. You must specify "ValueType" too.} -function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It implements basic GETNEXT method of the SNMP protocol. The MIB value - is located in the "OID" variable, and is sent to the requested "SNMPHost" with - the proper "Community" access identifier. Upon a successful retrieval, "Value" - will contain the information requested. If the SNMP operation is successful, - the result returns @true.} -function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It implements basic read of SNMP MIB tables. As BaseOID you must - specify basic MIB OID of requested table (base IOD is OID without row and - column specificator!) - Table is readed into stringlist, where each string is comma delimited string. - - Warning: this function is not have best performance. For better performance - you must write your own function. best performace you can get by knowledge - of structuture of table and by more then one MIB on one query. } -function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It implements basic read of SNMP MIB table element. As BaseOID you must - specify basic MIB OID of requested table (base IOD is OID without row and - column specificator!) - As next you must specify identificator of row and column for specify of needed - field of table.} -function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It implements a TRAPv1 to send with all data in the parameters.} -function SendTrap(const Dest, Source, Enterprise, Community: AnsiString; - Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString; - MIBtype: Integer): Integer; - -{:A very useful function and example of its use would be found in the TSNMPSend - object. It receives a TRAPv1 and returns all the data that comes with it.} -function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString; - var Generic, Specific, Seconds: Integer; const MIBName, - MIBValue: TStringList): Integer; - -implementation - -{==============================================================================} - -constructor TSNMPRec.Create; -begin - inherited Create; - FSNMPMibList := TList.Create; - Clear; - FAuthMode := AuthMD5; - FPassword := ''; - FPrivMode := PrivDES; - FPrivPassword := ''; - FID := 1; - FMaxSize := 1472; -end; - -destructor TSNMPRec.Destroy; -var - i: Integer; -begin - for i := 0 to FSNMPMibList.Count - 1 do - TSNMPMib(FSNMPMibList[i]).Free; - FSNMPMibList.Clear; - FSNMPMibList.Free; - inherited Destroy; -end; - -function TSNMPRec.Pass2Key(const Value: AnsiString): AnsiString; -var - key: AnsiString; -begin - case FAuthMode of - AuthMD5: - begin - key := MD5LongHash(Value, 1048576); - Result := MD5(key + FAuthEngineID + key); - end; - AuthSHA1: - begin - key := SHA1LongHash(Value, 1048576); - Result := SHA1(key + FAuthEngineID + key); - end; - else - Result := ''; - end; -end; - -function TSNMPRec.DecryptPDU(const value: AnsiString): AnsiString; -var - des: TSynaDes; - des3: TSyna3Des; - aes: TSynaAes; - s: string; -begin - FPrivKey := ''; - if FFlags <> AuthPriv then - Result := value - else - begin - case FPrivMode of - Priv3DES: - begin - FPrivKey := Pass2Key(FPrivPassword); - FPrivKey := FPrivKey + Pass2Key(FPrivKey); - des3 := TSyna3Des.Create(PadString(FPrivKey, 24, #0)); - try - s := PadString(FPrivKey, 32, #0); - delete(s, 1, 24); - des3.SetIV(xorstring(s, FPrivSalt)); - s := des3.DecryptCBC(value); - Result := s; - finally - des3.free; - end; - end; - PrivAES: - begin - FPrivKey := Pass2Key(FPrivPassword); - aes := TSynaAes.Create(PadString(FPrivKey, 16, #0)); - try - s := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FAuthEngineTime) + FPrivSalt; - aes.SetIV(s); - s := aes.DecryptCFBblock(value); - Result := s; - finally - aes.free; - end; - end; - else //PrivDES as default - begin - FPrivKey := Pass2Key(FPrivPassword); - des := TSynaDes.Create(PadString(FPrivKey, 8, #0)); - try - s := PadString(FPrivKey, 16, #0); - delete(s, 1, 8); - des.SetIV(xorstring(s, FPrivSalt)); - s := des.DecryptCBC(value); - Result := s; - finally - des.free; - end; - end; - end; - end; -end; - -function TSNMPRec.DecodeBuf(Buffer: AnsiString): Boolean; -var - Pos: Integer; - EndPos: Integer; - sm, sv: AnsiString; - Svt: Integer; - s: AnsiString; - Spos: integer; - x: Byte; -begin - Clear; - Result := False; - if Length(Buffer) < 2 then - Exit; - if (Ord(Buffer[1]) and $20) = 0 then - Exit; - Pos := 2; - EndPos := ASNDecLen(Pos, Buffer); - if Length(Buffer) < (EndPos + 2) then - Exit; - Self.FVersion := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - - if FVersion = 3 then - begin - ASNItem(Pos, Buffer, Svt); //header data seq - ASNItem(Pos, Buffer, Svt); //ID - FMaxSize := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - s := ASNItem(Pos, Buffer, Svt); - x := 0; - if s <> '' then - x := Ord(s[1]); - FFlagReportable := (x and 4) > 0; - x := x and 3; - case x of - 1: - FFlags := AuthNoPriv; - 3: - FFlags := AuthPriv; - else - FFlags := NoAuthNoPriv; - end; - - x := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - s := ASNItem(Pos, Buffer, Svt); //SecurityParameters - //if SecurityModel is USM, then try to decode SecurityParameters - if (x = 3) and (s <> '') then - begin - spos := 1; - ASNItem(SPos, s, Svt); - FAuthEngineID := ASNItem(SPos, s, Svt); - FAuthEngineBoots := StrToIntDef(ASNItem(SPos, s, Svt), 0); - FAuthEngineTime := StrToIntDef(ASNItem(SPos, s, Svt), 0); - FAuthEngineTimeStamp := GetTick; - FUserName := ASNItem(SPos, s, Svt); - FAuthKey := ASNItem(SPos, s, Svt); - FPrivSalt := ASNItem(SPos, s, Svt); - end; - //scopedPDU - if FFlags = AuthPriv then - begin - x := Pos; - s := ASNItem(Pos, Buffer, Svt); - if Svt <> ASN1_OCTSTR then - exit; - s := DecryptPDU(s); - //replace encoded content by decoded version and continue - Buffer := copy(Buffer, 1, x - 1); - Buffer := Buffer + s; - Pos := x; - if length(Buffer) < EndPos then - EndPos := length(buffer); - end; - ASNItem(Pos, Buffer, Svt); //skip sequence mark - FContextEngineID := ASNItem(Pos, Buffer, Svt); - FContextName := ASNItem(Pos, Buffer, Svt); - end - else - begin - //old packet - Self.FCommunity := ASNItem(Pos, Buffer, Svt); - end; - - ASNItem(Pos, Buffer, Svt); - Self.FPDUType := Svt; - if Self.FPDUType = PDUTrap then - begin - FOldTrapEnterprise := ASNItem(Pos, Buffer, Svt); - FOldTrapHost := ASNItem(Pos, Buffer, Svt); - FOldTrapGen := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - FOldTrapSpec := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - FOldTrapTimeTicks := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - end - else - begin - Self.FID := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - Self.FErrorStatus := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - Self.FErrorIndex := StrToIntDef(ASNItem(Pos, Buffer, Svt), 0); - end; - ASNItem(Pos, Buffer, Svt); - while Pos < EndPos do - begin - ASNItem(Pos, Buffer, Svt); - Sm := ASNItem(Pos, Buffer, Svt); - Sv := ASNItem(Pos, Buffer, Svt); - if sm <> '' then - Self.MIBAdd(sm, sv, Svt); - end; - Result := True; -end; - -function TSNMPRec.EncryptPDU(const value: AnsiString): AnsiString; -var - des: TSynaDes; - des3: TSyna3Des; - aes: TSynaAes; - s: string; - x: integer; -begin - FPrivKey := ''; - if FFlags <> AuthPriv then - Result := Value - else - begin - case FPrivMode of - Priv3DES: - begin - FPrivKey := Pass2Key(FPrivPassword); - FPrivKey := FPrivKey + Pass2Key(FPrivKey); - des3 := TSyna3Des.Create(PadString(FPrivKey, 24, #0)); - try - s := PadString(FPrivKey, 32, #0); - delete(s, 1, 24); - FPrivSalt := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FPrivSaltCounter); - inc(FPrivSaltCounter); - s := xorstring(s, FPrivSalt); - des3.SetIV(s); - x := length(value) mod 8; - x := 8 - x; - if x = 8 then - x := 0; - s := des3.EncryptCBC(value + Stringofchar(#0, x)); - Result := ASNObject(s, ASN1_OCTSTR); - finally - des3.free; - end; - end; - PrivAES: - begin - FPrivKey := Pass2Key(FPrivPassword); - aes := TSynaAes.Create(PadString(FPrivKey, 16, #0)); - try - FPrivSalt := CodeLongInt(0) + CodeLongInt(FPrivSaltCounter); - inc(FPrivSaltCounter); - s := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FAuthEngineTime) + FPrivSalt; - aes.SetIV(s); - s := aes.EncryptCFBblock(value); - Result := ASNObject(s, ASN1_OCTSTR); - finally - aes.free; - end; - end; - else //PrivDES as default - begin - FPrivKey := Pass2Key(FPrivPassword); - des := TSynaDes.Create(PadString(FPrivKey, 8, #0)); - try - s := PadString(FPrivKey, 16, #0); - delete(s, 1, 8); - FPrivSalt := CodeLongInt(FAuthEngineBoots) + CodeLongInt(FPrivSaltCounter); - inc(FPrivSaltCounter); - s := xorstring(s, FPrivSalt); - des.SetIV(s); - x := length(value) mod 8; - x := 8 - x; - if x = 8 then - x := 0; - s := des.EncryptCBC(value + Stringofchar(#0, x)); - Result := ASNObject(s, ASN1_OCTSTR); - finally - des.free; - end; - end; - end; - end; -end; - -function TSNMPRec.EncodeBuf: AnsiString; -var - s: AnsiString; - SNMPMib: TSNMPMib; - n: Integer; - pdu, head, auth, authbeg: AnsiString; - x: Byte; -begin - pdu := ''; - for n := 0 to FSNMPMibList.Count - 1 do - begin - SNMPMib := TSNMPMib(FSNMPMibList[n]); - case SNMPMib.ValueType of - ASN1_INT: - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject(ASNEncInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType); - ASN1_COUNTER, ASN1_GAUGE, ASN1_TIMETICKS: - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject(ASNEncUInt(StrToIntDef(SNMPMib.Value, 0)), SNMPMib.ValueType); - ASN1_OBJID: - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject(MibToID(SNMPMib.Value), SNMPMib.ValueType); - ASN1_IPADDR: - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject(IPToID(SNMPMib.Value), SNMPMib.ValueType); - ASN1_NULL: - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject('', ASN1_NULL); - else - s := ASNObject(MibToID(SNMPMib.OID), ASN1_OBJID) + - ASNObject(SNMPMib.Value, SNMPMib.ValueType); - end; - pdu := pdu + ASNObject(s, ASN1_SEQ); - end; - pdu := ASNObject(pdu, ASN1_SEQ); - - if Self.FPDUType = PDUTrap then - pdu := ASNObject(MibToID(FOldTrapEnterprise), ASN1_OBJID) + - ASNObject(IPToID(FOldTrapHost), ASN1_IPADDR) + - ASNObject(ASNEncInt(FOldTrapGen), ASN1_INT) + - ASNObject(ASNEncInt(FOldTrapSpec), ASN1_INT) + - ASNObject(ASNEncUInt(FOldTrapTimeTicks), ASN1_TIMETICKS) + - pdu - else - pdu := ASNObject(ASNEncInt(Self.FID), ASN1_INT) + - ASNObject(ASNEncInt(Self.FErrorStatus), ASN1_INT) + - ASNObject(ASNEncInt(Self.FErrorIndex), ASN1_INT) + - pdu; - pdu := ASNObject(pdu, Self.FPDUType); - - if FVersion = 3 then - begin - if FContextEngineID = '' then - FContextEngineID := FAuthEngineID; - //complete PDUv3... - pdu := ASNObject(FContextEngineID, ASN1_OCTSTR) - + ASNObject(FContextName, ASN1_OCTSTR) - + pdu; - pdu := ASNObject(pdu, ASN1_SEQ); - //encrypt PDU if Priv mode is enabled - pdu := EncryptPDU(pdu); - - //prepare flags - case FFlags of - AuthNoPriv: - x := 1; - AuthPriv: - x := 3; - else - x := 0; - end; - if FFlagReportable then - x := x or 4; - head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT); - s := ASNObject(ASNEncInt(FID), ASN1_INT) - + ASNObject(ASNEncInt(FMaxSize), ASN1_INT) - + ASNObject(AnsiChar(x), ASN1_OCTSTR) - //encode security model USM - + ASNObject(ASNEncInt(3), ASN1_INT); - head := head + ASNObject(s, ASN1_SEQ); - - //compute engine time difference - if FAuthEngineTimeStamp = 0 then //out of sync - x := 0 - else - x := TickDelta(FAuthEngineTimeStamp, GetTick) div 1000; - - authbeg := ASNObject(FAuthEngineID, ASN1_OCTSTR) - + ASNObject(ASNEncInt(FAuthEngineBoots), ASN1_INT) - + ASNObject(ASNEncInt(FAuthEngineTime + x), ASN1_INT) - + ASNObject(FUserName, ASN1_OCTSTR); - - - case FFlags of - AuthNoPriv, - AuthPriv: - begin - s := authbeg + ASNObject(StringOfChar(#0, 12), ASN1_OCTSTR) - + ASNObject(FPrivSalt, ASN1_OCTSTR); - s := ASNObject(s, ASN1_SEQ); - s := head + ASNObject(s, ASN1_OCTSTR); - s := ASNObject(s + pdu, ASN1_SEQ); - //in s is entire packet without auth info... - case FAuthMode of - AuthMD5: - begin - s := HMAC_MD5(s, Pass2Key(FPassword) + StringOfChar(#0, 48)); - //strip to HMAC-MD5-96 - delete(s, 13, 4); - end; - AuthSHA1: - begin - s := HMAC_SHA1(s, Pass2Key(FPassword) + StringOfChar(#0, 44)); - //strip to HMAC-SHA-96 - delete(s, 13, 8); - end; - else - s := ''; - end; - FAuthKey := s; - end; - end; - - auth := authbeg + ASNObject(FAuthKey, ASN1_OCTSTR) - + ASNObject(FPrivSalt, ASN1_OCTSTR); - auth := ASNObject(auth, ASN1_SEQ); - - head := head + ASNObject(auth, ASN1_OCTSTR); - Result := ASNObject(head + pdu, ASN1_SEQ); - end - else - begin - head := ASNObject(ASNEncInt(Self.FVersion), ASN1_INT) + - ASNObject(Self.FCommunity, ASN1_OCTSTR); - Result := ASNObject(head + pdu, ASN1_SEQ); - end; - inc(self.FID); -end; - -procedure TSNMPRec.Clear; -var - i: Integer; -begin - FVersion := SNMP_V1; - FCommunity := 'public'; - FUserName := ''; - FPDUType := 0; - FErrorStatus := 0; - FErrorIndex := 0; - for i := 0 to FSNMPMibList.Count - 1 do - TSNMPMib(FSNMPMibList[i]).Free; - FSNMPMibList.Clear; - FOldTrapEnterprise := ''; - FOldTrapHost := ''; - FOldTrapGen := 0; - FOldTrapSpec := 0; - FOldTrapTimeTicks := 0; - FFlags := NoAuthNoPriv; - FFlagReportable := false; - FContextEngineID := ''; - FContextName := ''; - FAuthEngineID := ''; - FAuthEngineBoots := 0; - FAuthEngineTime := 0; - FAuthEngineTimeStamp := 0; - FAuthKey := ''; - FPrivKey := ''; - FPrivSalt := ''; - FPrivSaltCounter := random(maxint); -end; - -procedure TSNMPRec.MIBAdd(const MIB, Value: AnsiString; ValueType: Integer); -var - SNMPMib: TSNMPMib; -begin - SNMPMib := TSNMPMib.Create; - SNMPMib.OID := MIB; - SNMPMib.Value := Value; - SNMPMib.ValueType := ValueType; - FSNMPMibList.Add(SNMPMib); -end; - -procedure TSNMPRec.MIBDelete(Index: Integer); -begin - if (Index >= 0) and (Index < MIBCount) then - begin - TSNMPMib(FSNMPMibList[Index]).Free; - FSNMPMibList.Delete(Index); - end; -end; - -function TSNMPRec.MIBCount: integer; -begin - Result := FSNMPMibList.Count; -end; - -function TSNMPRec.MIBByIndex(Index: Integer): TSNMPMib; -begin - Result := nil; - if (Index >= 0) and (Index < MIBCount) then - Result := TSNMPMib(FSNMPMibList[Index]); -end; - -function TSNMPRec.MIBGet(const MIB: AnsiString): AnsiString; -var - i: Integer; -begin - Result := ''; - for i := 0 to MIBCount - 1 do - begin - if ((TSNMPMib(FSNMPMibList[i])).OID = MIB) then - begin - Result := (TSNMPMib(FSNMPMibList[i])).Value; - Break; - end; - end; -end; - -{==============================================================================} - -constructor TSNMPSend.Create; -begin - inherited Create; - FQuery := TSNMPRec.Create; - FReply := TSNMPRec.Create; - FQuery.Clear; - FReply.Clear; - FSock := TUDPBlockSocket.Create; - FSock.Owner := self; - FTimeout := 5000; - FTargetPort := cSnmpProtocol; - FHostIP := ''; -end; - -destructor TSNMPSend.Destroy; -begin - FSock.Free; - FReply.Free; - FQuery.Free; - inherited Destroy; -end; - -function TSNMPSend.InternalSendSnmp(const Value: TSNMPRec): Boolean; -begin - FBuffer := Value.EncodeBuf; - FSock.SendString(FBuffer); - Result := FSock.LastError = 0; -end; - -function TSNMPSend.InternalRecvSnmp(const Value: TSNMPRec): Boolean; -begin - Result := False; - FReply.Clear; - FHostIP := cAnyHost; - FBuffer := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - begin - FHostIP := FSock.GetRemoteSinIP; - Result := Value.DecodeBuf(FBuffer); - end; -end; - -function TSNMPSend.InternalSendRequest(const QValue, RValue: TSNMPRec): Boolean; -begin - Result := False; - RValue.AuthMode := QValue.AuthMode; - RValue.Password := QValue.Password; - RValue.PrivMode := QValue.PrivMode; - RValue.PrivPassword := QValue.PrivPassword; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); - if InternalSendSnmp(QValue) then - Result := InternalRecvSnmp(RValue); -end; - -function TSNMPSend.SendRequest: Boolean; -var - sync: TV3Sync; -begin - Result := False; - if FQuery.FVersion = 3 then - begin - sync := GetV3Sync; - FQuery.AuthEngineBoots := Sync.EngineBoots; - FQuery.AuthEngineTime := Sync.EngineTime; - FQuery.AuthEngineTimeStamp := Sync.EngineStamp; - FQuery.AuthEngineID := Sync.EngineID; - end; - Result := InternalSendRequest(FQuery, FReply); -end; - -function TSNMPSend.SendTrap: Boolean; -begin - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); - Result := InternalSendSnmp(FQuery); -end; - -function TSNMPSend.RecvTrap: Boolean; -begin - FSock.Bind(FIPInterface, FTargetPort); - Result := InternalRecvSnmp(FReply); -end; - -function TSNMPSend.DoIt: Boolean; -begin - Result := SendRequest; -end; - -function TSNMPSend.GetV3EngineID: AnsiString; -var - DisQuery: TSNMPRec; -begin - Result := ''; - DisQuery := TSNMPRec.Create; - try - DisQuery.Version := 3; - DisQuery.UserName := ''; - DisQuery.FlagReportable := True; - DisQuery.PDUType := PDUGetRequest; - if InternalSendRequest(DisQuery, FReply) then - Result := FReply.FAuthEngineID; - finally - DisQuery.Free; - end; -end; - -function TSNMPSend.GetV3Sync: TV3Sync; -var - SyncQuery: TSNMPRec; -begin - Result.EngineID := GetV3EngineID; - Result.EngineBoots := FReply.AuthEngineBoots; - Result.EngineTime := FReply.AuthEngineTime; - Result.EngineStamp := FReply.AuthEngineTimeStamp; - if Result.EngineTime = 0 then - begin - //still not have sync... - SyncQuery := TSNMPRec.Create; - try - SyncQuery.Version := 3; - SyncQuery.UserName := FQuery.UserName; - SyncQuery.Password := FQuery.Password; - SyncQuery.FlagReportable := True; - SyncQuery.Flags := FQuery.Flags; - SyncQuery.AuthMode := FQuery.AuthMode; - SyncQuery.PrivMode := FQuery.PrivMode; - SyncQuery.PrivPassword := FQuery.PrivPassword; - SyncQuery.PDUType := PDUGetRequest; - SyncQuery.AuthEngineID := FReply.FAuthEngineID; - if InternalSendRequest(SyncQuery, FReply) then - begin - Result.EngineBoots := FReply.AuthEngineBoots; - Result.EngineTime := FReply.AuthEngineTime; - Result.EngineStamp := FReply.AuthEngineTimeStamp; - end; - finally - SyncQuery.Free; - end; - end; -end; - -{==============================================================================} - -function SNMPGet(const OID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; -var - SNMPSend: TSNMPSend; -begin - SNMPSend := TSNMPSend.Create; - try - SNMPSend.Query.Clear; - SNMPSend.Query.Community := Community; - SNMPSend.Query.PDUType := PDUGetRequest; - SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL); - SNMPSend.TargetHost := SNMPHost; - Result := SNMPSend.SendRequest; - Value := ''; - if Result then - Value := SNMPSend.Reply.MIBGet(OID); - finally - SNMPSend.Free; - end; -end; - -function SNMPSet(const OID, Community, SNMPHost, Value: AnsiString; ValueType: Integer): Boolean; -var - SNMPSend: TSNMPSend; -begin - SNMPSend := TSNMPSend.Create; - try - SNMPSend.Query.Clear; - SNMPSend.Query.Community := Community; - SNMPSend.Query.PDUType := PDUSetRequest; - SNMPSend.Query.MIBAdd(OID, Value, ValueType); - SNMPSend.TargetHost := SNMPHost; - Result := SNMPSend.Sendrequest = True; - finally - SNMPSend.Free; - end; -end; - -function InternalGetNext(const SNMPSend: TSNMPSend; var OID: AnsiString; - const Community: AnsiString; var Value: AnsiString): Boolean; -begin - SNMPSend.Query.Clear; - SNMPSend.Query.ID := SNMPSend.Query.ID + 1; - SNMPSend.Query.Community := Community; - SNMPSend.Query.PDUType := PDUGetNextRequest; - SNMPSend.Query.MIBAdd(OID, '', ASN1_NULL); - Result := SNMPSend.Sendrequest; - Value := ''; - if Result then - if SNMPSend.Reply.SNMPMibList.Count > 0 then - begin - OID := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).OID; - Value := TSNMPMib(SNMPSend.Reply.SNMPMibList[0]).Value; - end; -end; - -function SNMPGetNext(var OID: AnsiString; const Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; -var - SNMPSend: TSNMPSend; -begin - SNMPSend := TSNMPSend.Create; - try - SNMPSend.TargetHost := SNMPHost; - Result := InternalGetNext(SNMPSend, OID, Community, Value); - finally - SNMPSend.Free; - end; -end; - -function SNMPGetTable(const BaseOID, Community, SNMPHost: AnsiString; const Value: TStrings): Boolean; -var - OID: AnsiString; - s: AnsiString; - col,row: String; - x: integer; - SNMPSend: TSNMPSend; - RowList: TStringList; -begin - Value.Clear; - SNMPSend := TSNMPSend.Create; - RowList := TStringList.Create; - try - SNMPSend.TargetHost := SNMPHost; - OID := BaseOID; - repeat - Result := InternalGetNext(SNMPSend, OID, Community, s); - if Pos(BaseOID, OID) <> 1 then - break; - row := separateright(oid, baseoid + '.'); - col := fetch(row, '.'); - - if IsBinaryString(s) then - s := StrToHex(s); - x := RowList.indexOf(Row); - if x < 0 then - begin - x := RowList.add(Row); - Value.Add(''); - end; - if (Value[x] <> '') then - Value[x] := Value[x] + ','; - Value[x] := Value[x] + AnsiQuotedStr(s, '"'); - until not result; - finally - SNMPSend.Free; - RowList.Free; - end; -end; - -function SNMPGetTableElement(const BaseOID, RowID, ColID, Community, SNMPHost: AnsiString; var Value: AnsiString): Boolean; -var - s: AnsiString; -begin - s := BaseOID + '.' + ColID + '.' + RowID; - Result := SnmpGet(s, Community, SNMPHost, Value); -end; - -function SendTrap(const Dest, Source, Enterprise, Community: AnsiString; - Generic, Specific, Seconds: Integer; const MIBName, MIBValue: AnsiString; - MIBtype: Integer): Integer; -var - SNMPSend: TSNMPSend; -begin - SNMPSend := TSNMPSend.Create; - try - SNMPSend.TargetHost := Dest; - SNMPSend.TargetPort := cSnmpTrapProtocol; - SNMPSend.Query.Community := Community; - SNMPSend.Query.Version := SNMP_V1; - SNMPSend.Query.PDUType := PDUTrap; - SNMPSend.Query.OldTrapHost := Source; - SNMPSend.Query.OldTrapEnterprise := Enterprise; - SNMPSend.Query.OldTrapGen := Generic; - SNMPSend.Query.OldTrapSpec := Specific; - SNMPSend.Query.OldTrapTimeTicks := Seconds; - SNMPSend.Query.MIBAdd(MIBName, MIBValue, MIBType); - Result := Ord(SNMPSend.SendTrap); - finally - SNMPSend.Free; - end; -end; - -function RecvTrap(var Dest, Source, Enterprise, Community: AnsiString; - var Generic, Specific, Seconds: Integer; - const MIBName, MIBValue: TStringList): Integer; -var - SNMPSend: TSNMPSend; - i: Integer; -begin - SNMPSend := TSNMPSend.Create; - try - Result := 0; - SNMPSend.TargetPort := cSnmpTrapProtocol; - if SNMPSend.RecvTrap then - begin - Result := 1; - Dest := SNMPSend.HostIP; - Community := SNMPSend.Reply.Community; - Source := SNMPSend.Reply.OldTrapHost; - Enterprise := SNMPSend.Reply.OldTrapEnterprise; - Generic := SNMPSend.Reply.OldTrapGen; - Specific := SNMPSend.Reply.OldTrapSpec; - Seconds := SNMPSend.Reply.OldTrapTimeTicks; - MIBName.Clear; - MIBValue.Clear; - for i := 0 to SNMPSend.Reply.SNMPMibList.Count - 1 do - begin - MIBName.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).OID); - MIBValue.Add(TSNMPMib(SNMPSend.Reply.SNMPMibList[i]).Value); - end; - end; - finally - SNMPSend.Free; - end; -end; - - -end. - - diff --git a/3rd/synapse/source/sntpsend.pas b/3rd/synapse/source/sntpsend.pas deleted file mode 100644 index 4aa0bbf94..000000000 --- a/3rd/synapse/source/sntpsend.pas +++ /dev/null @@ -1,374 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 003.000.003 | -|==============================================================================| -| Content: SNTP client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Patrick Chevalley | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract( NTP and SNTP client) - -Used RFC: RFC-1305, RFC-2030 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -unit sntpsend; - -interface - -uses - SysUtils, - synsock, blcksock, synautil; - -const - cNtpProtocol = '123'; - -type - - {:@abstract(Record containing the NTP packet.)} - TNtp = packed record - mode: Byte; - stratum: Byte; - poll: Byte; - Precision: Byte; - RootDelay: Longint; - RootDisperson: Longint; - RefID: Longint; - Ref1: Longint; - Ref2: Longint; - Org1: Longint; - Org2: Longint; - Rcv1: Longint; - Rcv2: Longint; - Xmit1: Longint; - Xmit2: Longint; - end; - - {:@abstract(Implementation of NTP and SNTP client protocol), - include time synchronisation. It can send NTP or SNTP time queries, or it - can receive NTP broadcasts too. - - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TSNTPSend = class(TSynaClient) - private - FNTPReply: TNtp; - FNTPTime: TDateTime; - FNTPOffset: double; - FNTPDelay: double; - FMaxSyncDiff: double; - FSyncTime: Boolean; - FSock: TUDPBlockSocket; - FBuffer: AnsiString; - FLi, FVn, Fmode : byte; - function StrToNTP(const Value: AnsiString): TNtp; - function NTPtoStr(const Value: Tntp): AnsiString; - procedure ClearNTP(var Value: Tntp); - public - constructor Create; - destructor Destroy; override; - - {:Decode 128 bit timestamp used in NTP packet to TDateTime type.} - function DecodeTs(Nsec, Nfrac: Longint): TDateTime; - - {:Decode TDateTime type to 128 bit timestamp used in NTP packet.} - procedure EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint); - - {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all - is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are - valid.} - function GetSNTP: Boolean; - - {:Send request to @link(TSynaClient.TargetHost) and wait for reply. If all - is OK, then result is @true and @link(NTPReply) and @link(NTPTime) are - valid. Result time is after all needed corrections.} - function GetNTP: Boolean; - - {:Wait for broadcast NTP packet. If all OK, result is @true and - @link(NTPReply) and @link(NTPTime) are valid.} - function GetBroadcastNTP: Boolean; - - {:Holds last received NTP packet.} - property NTPReply: TNtp read FNTPReply; - published - {:Date and time of remote NTP or SNTP server. (UTC time!!!)} - property NTPTime: TDateTime read FNTPTime; - - {:Offset between your computer and remote NTP or SNTP server.} - property NTPOffset: Double read FNTPOffset; - - {:Delay between your computer and remote NTP or SNTP server.} - property NTPDelay: Double read FNTPDelay; - - {:Define allowed maximum difference between your time and remote time for - synchronising time. If difference is bigger, your system time is not - changed!} - property MaxSyncDiff: double read FMaxSyncDiff write FMaxSyncDiff; - - {:If @true, after successfull getting time is local computer clock - synchronised to given time. - For synchronising time you must have proper rights! (Usually Administrator)} - property SyncTime: Boolean read FSyncTime write FSyncTime; - - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TUDPBlockSocket read FSock; - end; - -implementation - -constructor TSNTPSend.Create; -begin - inherited Create; - FSock := TUDPBlockSocket.Create; - FSock.Owner := self; - FTimeout := 5000; - FTargetPort := cNtpProtocol; - FMaxSyncDiff := 3600; - FSyncTime := False; -end; - -destructor TSNTPSend.Destroy; -begin - FSock.Free; - inherited Destroy; -end; - -function TSNTPSend.StrToNTP(const Value: AnsiString): TNtp; -begin - if length(FBuffer) >= SizeOf(Result) then - begin - Result.mode := ord(Value[1]); - Result.stratum := ord(Value[2]); - Result.poll := ord(Value[3]); - Result.Precision := ord(Value[4]); - Result.RootDelay := DecodeLongInt(value, 5); - Result.RootDisperson := DecodeLongInt(value, 9); - Result.RefID := DecodeLongInt(value, 13); - Result.Ref1 := DecodeLongInt(value, 17); - Result.Ref2 := DecodeLongInt(value, 21); - Result.Org1 := DecodeLongInt(value, 25); - Result.Org2 := DecodeLongInt(value, 29); - Result.Rcv1 := DecodeLongInt(value, 33); - Result.Rcv2 := DecodeLongInt(value, 37); - Result.Xmit1 := DecodeLongInt(value, 41); - Result.Xmit2 := DecodeLongInt(value, 45); - end; - -end; - -function TSNTPSend.NTPtoStr(const Value: Tntp): AnsiString; -begin - SetLength(Result, 4); - Result[1] := AnsiChar(Value.mode); - Result[2] := AnsiChar(Value.stratum); - Result[3] := AnsiChar(Value.poll); - Result[4] := AnsiChar(Value.precision); - Result := Result + CodeLongInt(Value.RootDelay); - Result := Result + CodeLongInt(Value.RootDisperson); - Result := Result + CodeLongInt(Value.RefID); - Result := Result + CodeLongInt(Value.Ref1); - Result := Result + CodeLongInt(Value.Ref2); - Result := Result + CodeLongInt(Value.Org1); - Result := Result + CodeLongInt(Value.Org2); - Result := Result + CodeLongInt(Value.Rcv1); - Result := Result + CodeLongInt(Value.Rcv2); - Result := Result + CodeLongInt(Value.Xmit1); - Result := Result + CodeLongInt(Value.Xmit2); -end; - -procedure TSNTPSend.ClearNTP(var Value: Tntp); -begin - Value.mode := 0; - Value.stratum := 0; - Value.poll := 0; - Value.Precision := 0; - Value.RootDelay := 0; - Value.RootDisperson := 0; - Value.RefID := 0; - Value.Ref1 := 0; - Value.Ref2 := 0; - Value.Org1 := 0; - Value.Org2 := 0; - Value.Rcv1 := 0; - Value.Rcv2 := 0; - Value.Xmit1 := 0; - Value.Xmit2 := 0; -end; - -function TSNTPSend.DecodeTs(Nsec, Nfrac: Longint): TDateTime; -const - maxi = 4294967295.0; -var - d, d1: Double; -begin - d := Nsec; - if d < 0 then - d := maxi + d + 1; - d1 := Nfrac; - if d1 < 0 then - d1 := maxi + d1 + 1; - d1 := d1 / maxi; - d1 := Trunc(d1 * 10000) / 10000; - Result := (d + d1) / 86400; - Result := Result + 2; -end; - -procedure TSNTPSend.EncodeTs(dt: TDateTime; var Nsec, Nfrac: Longint); -const - maxi = 4294967295.0; - maxilongint = 2147483647; -var - d, d1: Double; -begin - d := (dt - 2) * 86400; - d1 := frac(d); - if d > maxilongint then - d := d - maxi - 1; - d := trunc(d); - d1 := Trunc(d1 * 10000) / 10000; - d1 := d1 * maxi; - if d1 > maxilongint then - d1 := d1 - maxi - 1; - Nsec:=trunc(d); - Nfrac:=trunc(d1); -end; - -function TSNTPSend.GetBroadcastNTP: Boolean; -var - x: Integer; -begin - Result := False; - FSock.Bind(FIPInterface, FTargetPort); - FBuffer := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - begin - x := Length(FBuffer); - if (FTargetHost = '0.0.0.0') or (FSock.GetRemoteSinIP = FSock.ResolveName(FTargetHost)) then - if x >= SizeOf(NTPReply) then - begin - FNTPReply := StrToNTP(FBuffer); - FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2); - if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then - SetUTTime(FNTPTime); - Result := True; - end; - end; -end; - -function TSNTPSend.GetSNTP: Boolean; -var - q: TNtp; - x: Integer; -begin - Result := False; - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); - ClearNtp(q); - q.mode := $1B; - FBuffer := NTPtoStr(q); - FSock.SendString(FBuffer); - FBuffer := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - begin - x := Length(FBuffer); - if x >= SizeOf(NTPReply) then - begin - FNTPReply := StrToNTP(FBuffer); - FNTPTime := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2); - if FSyncTime and ((abs(FNTPTime - GetUTTime) * 86400) <= FMaxSyncDiff) then - SetUTTime(FNTPTime); - Result := True; - end; - end; -end; - -function TSNTPSend.GetNTP: Boolean; -var - q: TNtp; - x: Integer; - t1, t2, t3, t4 : TDateTime; -begin - Result := False; - FSock.CloseSocket; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); - ClearNtp(q); - q.mode := $1B; - t1 := GetUTTime; - EncodeTs(t1, q.org1, q.org2); - FBuffer := NTPtoStr(q); - FSock.SendString(FBuffer); - FBuffer := FSock.RecvPacket(FTimeout); - if FSock.LastError = 0 then - begin - x := Length(FBuffer); - t4 := GetUTTime; - if x >= SizeOf(NTPReply) then - begin - FNTPReply := StrToNTP(FBuffer); - FLi := (NTPReply.mode and $C0) shr 6; - FVn := (NTPReply.mode and $38) shr 3; - Fmode := NTPReply.mode and $07; - if (Fli < 3) and (Fmode = 4) and - (NTPReply.stratum >= 1) and (NTPReply.stratum <= 15) and - (NTPReply.Rcv1 <> 0) and (NTPReply.Xmit1 <> 0) - then begin - t2 := DecodeTs(NTPReply.Rcv1, NTPReply.Rcv2); - t3 := DecodeTs(NTPReply.Xmit1, NTPReply.Xmit2); - FNTPDelay := (T4 - T1) - (T2 - T3); - FNTPTime := t3 + FNTPDelay / 2; - FNTPOffset := (((T2 - T1) + (T3 - T4)) / 2) * 86400; - FNTPDelay := FNTPDelay * 86400; - if FSyncTime and ((abs(FNTPTime - t1) * 86400) <= FMaxSyncDiff) then - SetUTTime(FNTPTime); - Result := True; - end - else result:=false; - end; - end; -end; - -end. diff --git a/3rd/synapse/source/ssdotnet.inc b/3rd/synapse/source/ssdotnet.inc deleted file mode 100644 index 8a54cd8a1..000000000 --- a/3rd/synapse/source/ssdotnet.inc +++ /dev/null @@ -1,1099 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.000.002 | -|==============================================================================| -| Content: Socket Independent Platform Layer - .NET definition include | -|==============================================================================| -| Copyright (c)2004, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2004. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$IFDEF CIL} - -interface - -uses - SyncObjs, SysUtils, Classes, - System.Net, - System.Net.Sockets; - -const - DLLStackName = ''; - WinsockLevel = $0202; - -function InitSocketInterface(stack: string): Boolean; -function DestroySocketInterface: Boolean; - -type - u_char = Char; - u_short = Word; - u_int = Integer; - u_long = Longint; - pu_long = ^u_long; - pu_short = ^u_short; - PSockAddr = IPEndPoint; - DWORD = integer; - ULong = cardinal; - TMemory = Array of byte; - TLinger = LingerOption; - TSocket = socket; - TAddrFamily = AddressFamily; - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = packed record - wVersion: Word; - wHighVersion: Word; - szDescription: array[0..WSADESCRIPTION_LEN] of Char; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; - iMaxSockets: Word; - iMaxUdpDg: Word; -// lpVendorInfo: PChar; - end; - -const - MSG_NOSIGNAL = 0; - INVALID_SOCKET = nil; - AF_UNSPEC = AddressFamily.Unspecified; - AF_INET = AddressFamily.InterNetwork; - AF_INET6 = AddressFamily.InterNetworkV6; - SOCKET_ERROR = integer(-1); - - FIONREAD = integer($4004667f); - FIONBIO = integer($8004667e); - FIOASYNC = integer($8004667d); - - SOMAXCONN = integer($7fffffff); - - IPPROTO_IP = ProtocolType.IP; - IPPROTO_ICMP = ProtocolType.Icmp; - IPPROTO_IGMP = ProtocolType.Igmp; - IPPROTO_TCP = ProtocolType.Tcp; - IPPROTO_UDP = ProtocolType.Udp; - IPPROTO_RAW = ProtocolType.Raw; - IPPROTO_IPV6 = ProtocolType.IPV6; -// - IPPROTO_ICMPV6 = ProtocolType.Icmp; //?? - - SOCK_STREAM = SocketType.Stream; - SOCK_DGRAM = SocketType.Dgram; - SOCK_RAW = SocketType.Raw; - SOCK_RDM = SocketType.Rdm; - SOCK_SEQPACKET = SocketType.Seqpacket; - - SOL_SOCKET = SocketOptionLevel.Socket; - SOL_IP = SocketOptionLevel.Ip; - - - IP_OPTIONS = SocketOptionName.IPOptions; - IP_HDRINCL = SocketOptionName.HeaderIncluded; - IP_TOS = SocketOptionName.TypeOfService; { set/get IP Type Of Service } - IP_TTL = SocketOptionName.IpTimeToLive; { set/get IP Time To Live } - IP_MULTICAST_IF = SocketOptionName.MulticastInterface; { set/get IP multicast interface } - IP_MULTICAST_TTL = SocketOptionName.MulticastTimeToLive; { set/get IP multicast timetolive } - IP_MULTICAST_LOOP = SocketOptionName.MulticastLoopback; { set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = SocketOptionName.AddMembership; { add an IP group membership } - IP_DROP_MEMBERSHIP = SocketOptionName.DropMembership; { drop an IP group membership } - IP_DONTFRAGMENT = SocketOptionName.DontFragment; { set/get IP Don't Fragment flag } - - IPV6_UNICAST_HOPS = 8; // TTL - IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f - IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl - IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback - IPV6_JOIN_GROUP = 12; // add an IP group membership - IPV6_LEAVE_GROUP = 13; // drop an IP group membership - - SO_DEBUG = SocketOptionName.Debug; { turn on debugging info recording } - SO_ACCEPTCONN = SocketOptionName.AcceptConnection; { socket has had listen() } - SO_REUSEADDR = SocketOptionName.ReuseAddress; { allow local address reuse } - SO_KEEPALIVE = SocketOptionName.KeepAlive; { keep connections alive } - SO_DONTROUTE = SocketOptionName.DontRoute; { just use interface addresses } - SO_BROADCAST = SocketOptionName.Broadcast; { permit sending of broadcast msgs } - SO_USELOOPBACK = SocketOptionName.UseLoopback; { bypass hardware when possible } - SO_LINGER = SocketOptionName.Linger; { linger on close if data present } - SO_OOBINLINE = SocketOptionName.OutOfBandInline; { leave received OOB data in line } - SO_DONTLINGER = SocketOptionName.DontLinger; -{ Additional options. } - SO_SNDBUF = SocketOptionName.SendBuffer; { send buffer size } - SO_RCVBUF = SocketOptionName.ReceiveBuffer; { receive buffer size } - SO_SNDLOWAT = SocketOptionName.SendLowWater; { send low-water mark } - SO_RCVLOWAT = SocketOptionName.ReceiveLowWater; { receive low-water mark } - SO_SNDTIMEO = SocketOptionName.SendTimeout; { send timeout } - SO_RCVTIMEO = SocketOptionName.ReceiveTimeout; { receive timeout } - SO_ERROR = SocketOptionName.Error; { get error status and clear } - SO_TYPE = SocketOptionName.Type; { get socket type } - -{ WinSock 2 extension -- new options } -// SO_GROUP_ID = $2001; { ID of a socket group} -// SO_GROUP_PRIORITY = $2002; { the relative priority within a group} -// SO_MAX_MSG_SIZE = $2003; { maximum message size } -// SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure } -// SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure } -// SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA; -// PVD_CONFIG = $3001; {configuration info for service provider } -{ Option for opening sockets for synchronous access. } -// SO_OPENTYPE = $7008; -// SO_SYNCHRONOUS_ALERT = $10; -// SO_SYNCHRONOUS_NONALERT = $20; -{ Other NT-specific options. } -// SO_MAXDG = $7009; -// SO_MAXPATHDG = $700A; -// SO_UPDATE_ACCEPT_CONTEXT = $700B; -// SO_CONNECT_TIME = $700C; - - - { All Windows Sockets error constants are biased by WSABASEERR from the "normal" } - WSABASEERR = 10000; - -{ Windows Sockets definitions of regular Microsoft C error constants } - - WSAEINTR = (WSABASEERR+4); - WSAEBADF = (WSABASEERR+9); - WSAEACCES = (WSABASEERR+13); - WSAEFAULT = (WSABASEERR+14); - WSAEINVAL = (WSABASEERR+22); - WSAEMFILE = (WSABASEERR+24); - -{ Windows Sockets definitions of regular Berkeley error constants } - - WSAEWOULDBLOCK = (WSABASEERR+35); - WSAEINPROGRESS = (WSABASEERR+36); - WSAEALREADY = (WSABASEERR+37); - WSAENOTSOCK = (WSABASEERR+38); - WSAEDESTADDRREQ = (WSABASEERR+39); - WSAEMSGSIZE = (WSABASEERR+40); - WSAEPROTOTYPE = (WSABASEERR+41); - WSAENOPROTOOPT = (WSABASEERR+42); - WSAEPROTONOSUPPORT = (WSABASEERR+43); - WSAESOCKTNOSUPPORT = (WSABASEERR+44); - WSAEOPNOTSUPP = (WSABASEERR+45); - WSAEPFNOSUPPORT = (WSABASEERR+46); - WSAEAFNOSUPPORT = (WSABASEERR+47); - WSAEADDRINUSE = (WSABASEERR+48); - WSAEADDRNOTAVAIL = (WSABASEERR+49); - WSAENETDOWN = (WSABASEERR+50); - WSAENETUNREACH = (WSABASEERR+51); - WSAENETRESET = (WSABASEERR+52); - WSAECONNABORTED = (WSABASEERR+53); - WSAECONNRESET = (WSABASEERR+54); - WSAENOBUFS = (WSABASEERR+55); - WSAEISCONN = (WSABASEERR+56); - WSAENOTCONN = (WSABASEERR+57); - WSAESHUTDOWN = (WSABASEERR+58); - WSAETOOMANYREFS = (WSABASEERR+59); - WSAETIMEDOUT = (WSABASEERR+60); - WSAECONNREFUSED = (WSABASEERR+61); - WSAELOOP = (WSABASEERR+62); - WSAENAMETOOLONG = (WSABASEERR+63); - WSAEHOSTDOWN = (WSABASEERR+64); - WSAEHOSTUNREACH = (WSABASEERR+65); - WSAENOTEMPTY = (WSABASEERR+66); - WSAEPROCLIM = (WSABASEERR+67); - WSAEUSERS = (WSABASEERR+68); - WSAEDQUOT = (WSABASEERR+69); - WSAESTALE = (WSABASEERR+70); - WSAEREMOTE = (WSABASEERR+71); - -{ Extended Windows Sockets error constant definitions } - - WSASYSNOTREADY = (WSABASEERR+91); - WSAVERNOTSUPPORTED = (WSABASEERR+92); - WSANOTINITIALISED = (WSABASEERR+93); - WSAEDISCON = (WSABASEERR+101); - WSAENOMORE = (WSABASEERR+102); - WSAECANCELLED = (WSABASEERR+103); - WSAEEINVALIDPROCTABLE = (WSABASEERR+104); - WSAEINVALIDPROVIDER = (WSABASEERR+105); - WSAEPROVIDERFAILEDINIT = (WSABASEERR+106); - WSASYSCALLFAILURE = (WSABASEERR+107); - WSASERVICE_NOT_FOUND = (WSABASEERR+108); - WSATYPE_NOT_FOUND = (WSABASEERR+109); - WSA_E_NO_MORE = (WSABASEERR+110); - WSA_E_CANCELLED = (WSABASEERR+111); - WSAEREFUSED = (WSABASEERR+112); - -{ Error return codes from gethostbyname() and gethostbyaddr() - (when using the resolver). Note that these errors are - retrieved via WSAGetLastError() and must therefore follow - the rules for avoiding clashes with error numbers from - specific implementations or language run-time systems. - For this reason the codes are based at WSABASEERR+1001. - Note also that [WSA]NO_ADDRESS is defined only for - compatibility purposes. } - -{ Authoritative Answer: Host not found } - WSAHOST_NOT_FOUND = (WSABASEERR+1001); - HOST_NOT_FOUND = WSAHOST_NOT_FOUND; -{ Non-Authoritative: Host not found, or SERVERFAIL } - WSATRY_AGAIN = (WSABASEERR+1002); - TRY_AGAIN = WSATRY_AGAIN; -{ Non recoverable errors, FORMERR, REFUSED, NOTIMP } - WSANO_RECOVERY = (WSABASEERR+1003); - NO_RECOVERY = WSANO_RECOVERY; -{ Valid name, no data record of requested type } - WSANO_DATA = (WSABASEERR+1004); - NO_DATA = WSANO_DATA; -{ no address, look for MX record } - WSANO_ADDRESS = WSANO_DATA; - NO_ADDRESS = WSANO_ADDRESS; - - EWOULDBLOCK = WSAEWOULDBLOCK; - EINPROGRESS = WSAEINPROGRESS; - EALREADY = WSAEALREADY; - ENOTSOCK = WSAENOTSOCK; - EDESTADDRREQ = WSAEDESTADDRREQ; - EMSGSIZE = WSAEMSGSIZE; - EPROTOTYPE = WSAEPROTOTYPE; - ENOPROTOOPT = WSAENOPROTOOPT; - EPROTONOSUPPORT = WSAEPROTONOSUPPORT; - ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; - EOPNOTSUPP = WSAEOPNOTSUPP; - EPFNOSUPPORT = WSAEPFNOSUPPORT; - EAFNOSUPPORT = WSAEAFNOSUPPORT; - EADDRINUSE = WSAEADDRINUSE; - EADDRNOTAVAIL = WSAEADDRNOTAVAIL; - ENETDOWN = WSAENETDOWN; - ENETUNREACH = WSAENETUNREACH; - ENETRESET = WSAENETRESET; - ECONNABORTED = WSAECONNABORTED; - ECONNRESET = WSAECONNRESET; - ENOBUFS = WSAENOBUFS; - EISCONN = WSAEISCONN; - ENOTCONN = WSAENOTCONN; - ESHUTDOWN = WSAESHUTDOWN; - ETOOMANYREFS = WSAETOOMANYREFS; - ETIMEDOUT = WSAETIMEDOUT; - ECONNREFUSED = WSAECONNREFUSED; - ELOOP = WSAELOOP; - ENAMETOOLONG = WSAENAMETOOLONG; - EHOSTDOWN = WSAEHOSTDOWN; - EHOSTUNREACH = WSAEHOSTUNREACH; - ENOTEMPTY = WSAENOTEMPTY; - EPROCLIM = WSAEPROCLIM; - EUSERS = WSAEUSERS; - EDQUOT = WSAEDQUOT; - ESTALE = WSAESTALE; - EREMOTE = WSAEREMOTE; - - -type - TVarSin = IPEndpoint; - -{ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -var - in6addr_any, in6addr_loopback : TInAddr6; -} - -{procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); -} -{=============================================================================} - - function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; - function WSACleanup: Integer; - function WSAGetLastError: Integer; - function WSAGetLastErrorDesc: String; - function GetHostName: string; - function Shutdown(s: TSocket; how: Integer): Integer; -// function SetSockOpt(s: TSocket; level, optname: Integer; optval: PChar; -// optlen: Integer): Integer; - function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - optlen: Integer): Integer; - function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer; - function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - var optlen: Integer): Integer; -// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr; -// tolen: Integer): Integer; -/// function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer; -/// function Send(s: TSocket; const Buf; len, flags: Integer): Integer; -/// function Recv(s: TSocket; var Buf; len, flags: Integer): Integer; -// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; -// var fromlen: Integer): Integer; -/// function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer; -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; - function ntohs(netshort: u_short): u_short; - function ntohl(netlong: u_long): u_long; - function Listen(s: TSocket; backlog: Integer): Integer; - function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer; - function htons(hostshort: u_short): u_short; - function htonl(hostlong: u_long): u_long; -// function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - function GetSockName(s: TSocket; var name: TVarSin): Integer; -// function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - function GetPeerName(s: TSocket; var name: TVarSin): Integer; -// function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer; - function Connect(s: TSocket; const name: TVarSin): Integer; - function CloseSocket(s: TSocket): Integer; -// function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer; - function Bind(s: TSocket; const addr: TVarSin): Integer; -// function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; - function Accept(s: TSocket; var addr: TVarSin): TSocket; - function Socket(af, Struc, Protocol: Integer): TSocket; -// Select = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; -// timeout: PTimeVal): Longint; -// {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF}; - -// TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; -// cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; -// lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; -// lpCompletionRoutine: pointer): u_int; -// stdcall; - - function GetPortService(value: string): integer; - -function IsNewApi(Family: TAddrFamily): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): string; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string; -function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word; - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - -{==============================================================================} -implementation - -threadvar - WSALastError: integer; - WSALastErrorDesc: string; - -var - services: Array [0..139, 0..1] of string = - ( - ('echo', '7'), - ('discard', '9'), - ('sink', '9'), - ('null', '9'), - ('systat', '11'), - ('users', '11'), - ('daytime', '13'), - ('qotd', '17'), - ('quote', '17'), - ('chargen', '19'), - ('ttytst', '19'), - ('source', '19'), - ('ftp-data', '20'), - ('ftp', '21'), - ('telnet', '23'), - ('smtp', '25'), - ('mail', '25'), - ('time', '37'), - ('timeserver', '37'), - ('rlp', '39'), - ('nameserver', '42'), - ('name', '42'), - ('nickname', '43'), - ('whois', '43'), - ('domain', '53'), - ('bootps', '67'), - ('dhcps', '67'), - ('bootpc', '68'), - ('dhcpc', '68'), - ('tftp', '69'), - ('gopher', '70'), - ('finger', '79'), - ('http', '80'), - ('www', '80'), - ('www-http', '80'), - ('kerberos', '88'), - ('hostname', '101'), - ('hostnames', '101'), - ('iso-tsap', '102'), - ('rtelnet', '107'), - ('pop2', '109'), - ('postoffice', '109'), - ('pop3', '110'), - ('sunrpc', '111'), - ('rpcbind', '111'), - ('portmap', '111'), - ('auth', '113'), - ('ident', '113'), - ('tap', '113'), - ('uucp-path', '117'), - ('nntp', '119'), - ('usenet', '119'), - ('ntp', '123'), - ('epmap', '135'), - ('loc-srv', '135'), - ('netbios-ns', '137'), - ('nbname', '137'), - ('netbios-dgm', '138'), - ('nbdatagram', '138'), - ('netbios-ssn', '139'), - ('nbsession', '139'), - ('imap', '143'), - ('imap4', '143'), - ('pcmail-srv', '158'), - ('snmp', '161'), - ('snmptrap', '162'), - ('snmp-trap', '162'), - ('print-srv', '170'), - ('bgp', '179'), - ('irc', '194'), - ('ipx', '213'), - ('ldap', '389'), - ('https', '443'), - ('mcom', '443'), - ('microsoft-ds', '445'), - ('kpasswd', '464'), - ('isakmp', '500'), - ('ike', '500'), - ('exec', '512'), - ('biff', '512'), - ('comsat', '512'), - ('login', '513'), - ('who', '513'), - ('whod', '513'), - ('cmd', '514'), - ('shell', '514'), - ('syslog', '514'), - ('printer', '515'), - ('spooler', '515'), - ('talk', '517'), - ('ntalk', '517'), - ('efs', '520'), - ('router', '520'), - ('route', '520'), - ('routed', '520'), - ('timed', '525'), - ('timeserver', '525'), - ('tempo', '526'), - ('newdate', '526'), - ('courier', '530'), - ('rpc', '530'), - ('conference', '531'), - ('chat', '531'), - ('netnews', '532'), - ('readnews', '532'), - ('netwall', '533'), - ('uucp', '540'), - ('uucpd', '540'), - ('klogin', '543'), - ('kshell', '544'), - ('krcmd', '544'), - ('new-rwho', '550'), - ('new-who', '550'), - ('remotefs', '556'), - ('rfs', '556'), - ('rfs_server', '556'), - ('rmonitor', '560'), - ('rmonitord', '560'), - ('monitor', '561'), - ('ldaps', '636'), - ('sldap', '636'), - ('doom', '666'), - ('kerberos-adm', '749'), - ('kerberos-iv', '750'), - ('kpop', '1109'), - ('phone', '1167'), - ('ms-sql-s', '1433'), - ('ms-sql-m', '1434'), - ('wins', '1512'), - ('ingreslock', '1524'), - ('ingres', '1524'), - ('l2tp', '1701'), - ('pptp', '1723'), - ('radius', '1812'), - ('radacct', '1813'), - ('nfsd', '2049'), - ('nfs', '2049'), - ('knetd', '2053'), - ('gds_db', '3050'), - ('man', '9535') - ); - -{function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and - (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0)); -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and - (a^.s_un_dw.s_dw3 = 0) and - (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and - (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1))); -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80))); -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0))); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := (a^.s_un_b.s_b1 = char($FF)); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.s_un_b.s_b16 := char(1); -end; -} - -{=============================================================================} - -procedure NullErr; -begin - WSALastError := 0; - WSALastErrorDesc := ''; -end; - -procedure GetErrCode(E: System.Exception); -var - SE: System.Net.Sockets.SocketException; -begin - if E is System.Net.Sockets.SocketException then - begin - SE := E as System.Net.Sockets.SocketException; - WSALastError := SE.ErrorCode; - WSALastErrorDesc := SE.Message; - end -end; - -function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; -begin - NullErr; - with WSData do - begin - wVersion := wVersionRequired; - wHighVersion := $202; - szDescription := 'Synsock - Synapse Platform Independent Socket Layer'; - szSystemStatus := 'Running on .NET'; - iMaxSockets := 32768; - iMaxUdpDg := 8192; - end; - Result := 0; -end; - -function WSACleanup: Integer; -begin - NullErr; - Result := 0; -end; - -function WSAGetLastError: Integer; -begin - Result := WSALastError; -end; - -function WSAGetLastErrorDesc: String; -begin - Result := WSALastErrorDesc; -end; - -function GetHostName: string; -begin - Result := System.Net.DNS.GetHostName; -end; - -function Shutdown(s: TSocket; how: Integer): Integer; -begin - Result := 0; - NullErr; - try - s.ShutDown(SocketShutdown(how)); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - optlen: Integer): Integer; -begin - Result := 0; - NullErr; - try - s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function SetSockOptObj(s: TSocket; level, optname: Integer; optval: TObject): Integer; -begin - Result := 0; - NullErr; - try - s.SetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - var optlen: Integer): Integer; -begin - Result := 0; - NullErr; - try - s.GetSocketOption(SocketOptionLevel(level), SocketOptionName(optname), optval); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -//function SendTo(s: TSocket; const Buf; len, flags: Integer; addrto: TVarSin): Integer; -begin - NullErr; - try - result := s.SendTo(Buf, len, SocketFlags(flags), addrto); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -//function Send(s: TSocket; const Buf; len, flags: Integer): Integer; -begin - NullErr; - try - result := s.Send(Buf, len, SocketFlags(flags)); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -//function Recv(s: TSocket; var Buf; len, flags: Integer): Integer; -begin - NullErr; - try - result := s.Receive(Buf, len, SocketFlags(flags)); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; -// var fromlen: Integer): Integer; -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -//function RecvFrom(s: TSocket; var Buf; len, flags: Integer; from: TVarSin): Integer; -var - EP: EndPoint; -begin - NullErr; - try - EP := from; - result := s.ReceiveFrom(Buf, len, SocketFlags(flags), EndPoint(EP)); - from := EP as IPEndPoint; - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function ntohs(netshort: u_short): u_short; -begin - Result := IPAddress.NetworkToHostOrder(NetShort); -end; - -function ntohl(netlong: u_long): u_long; -begin - Result := IPAddress.NetworkToHostOrder(NetLong); -end; - -function Listen(s: TSocket; backlog: Integer): Integer; -begin - Result := 0; - NullErr; - try - s.Listen(backlog); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer; -var - inv, outv: TMemory; -begin - Result := 0; - NullErr; - try - if cmd = DWORD(FIONBIO) then - s.Blocking := arg = 0 - else - begin - inv := BitConverter.GetBytes(arg); - outv := BitConverter.GetBytes(integer(0)); - s.IOControl(cmd, inv, outv); - arg := BitConverter.ToInt32(outv, 0); - end; - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function htons(hostshort: u_short): u_short; -begin - Result := IPAddress.HostToNetworkOrder(Hostshort); -end; - -function htonl(hostlong: u_long): u_long; -begin - Result := IPAddress.HostToNetworkOrder(HostLong); -end; - -//function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; -function GetSockName(s: TSocket; var name: TVarSin): Integer; -begin - Result := 0; - NullErr; - try - Name := s.localEndPoint as IPEndpoint; - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -//function GetPeerName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -begin - Result := 0; - NullErr; - try - Name := s.RemoteEndPoint as IPEndpoint; - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -//function Connect(s: TSocket; name: PSockAddr; namelen: Integer): Integer; -function Connect(s: TSocket; const name: TVarSin): Integer; -begin - Result := 0; - NullErr; - try - s.Connect(name); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -function CloseSocket(s: TSocket): Integer; -begin - Result := 0; - NullErr; - try - s.Close; - except - on e: System.Net.Sockets.SocketException do - begin - Result := integer(SOCKET_ERROR); - end; - end; -end; - -//function Bind(s: TSocket; addr: PSockAddr; namelen: Integer): Integer; -function Bind(s: TSocket; const addr: TVarSin): Integer; -begin - Result := 0; - NullErr; - try - s.Bind(addr); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := integer(SOCKET_ERROR); - end; - end; -end; - -//function Accept(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; -function Accept(s: TSocket; var addr: TVarSin): TSocket; -begin - NullErr; - try - result := s.Accept(); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := nil; - end; - end; -end; - -function Socket(af, Struc, Protocol: Integer): TSocket; -begin - NullErr; - try - result := TSocket.Create(AddressFamily(af), SocketType(Struc), ProtocolType(Protocol)); - except - on e: System.Net.Sockets.SocketException do - begin - GetErrCode(e); - Result := nil; - end; - end; -end; - -{=============================================================================} -function GetPortService(value: string): integer; -var - n: integer; -begin - Result := 0; - value := Lowercase(value); - for n := 0 to High(Services) do - if services[n, 0] = value then - begin - Result := strtointdef(services[n, 1], 0); - break; - end; - if Result = 0 then - Result := StrToIntDef(value, 0); -end; - -{=============================================================================} -function IsNewApi(Family: TAddrFamily): Boolean; -begin - Result := true; -end; - -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -var - IPs: array of IPAddress; - n: integer; - ip4, ip6: string; - sip: string; -begin - sip := ''; - ip4 := ''; - ip6 := ''; - IPs := Dns.Resolve(IP).AddressList; - for n :=low(IPs) to high(IPs) do begin - if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then - ip4 := IPs[n].toString; - if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then - ip6 := IPs[n].toString; - if (ip4 <> '') and (ip6 <> '') then - break; - end; - case Family of - AF_UNSPEC: - begin - if (ip4 <> '') and (ip6 <> '') then - begin - if PreferIP4 then - sip := ip4 - else - Sip := ip6; - end - else - begin - sip := ip4; - if (ip6 <> '') then - sip := ip6; - end; - end; - AF_INET: - sip := ip4; - AF_INET6: - sip := ip6; - end; - sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port)); -end; - -function GetSinIP(Sin: TVarSin): string; -begin - Result := Sin.Address.ToString; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - Result := Sin.Port; -end; - -procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings); -var - IPs :array of IPAddress; - n: integer; -begin - IPList.Clear; - IPs := Dns.Resolve(Name).AddressList; - for n := low(IPs) to high(IPs) do - begin - if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET)) - or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then - begin - IPList.Add(IPs[n].toString); - end; - end; -end; - -function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word; -var - n: integer; -begin - Result := StrToIntDef(port, 0); - if Result = 0 then - begin - port := Lowercase(port); - for n := 0 to High(Services) do - if services[n, 0] = port then - begin - Result := strtointdef(services[n, 1], 0); - break; - end; - end; -end; - -function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string; -begin - Result := Dns.GetHostByAddress(IP).HostName; -end; - - -{=============================================================================} -function InitSocketInterface(stack: string): Boolean; -begin - Result := True; -end; - -function DestroySocketInterface: Boolean; -begin - NullErr; - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; -// SET_IN6_IF_ADDR_ANY (@in6addr_any); -// SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - NullErr; - SynSockCS.Free; -end; - -{$ENDIF} diff --git a/3rd/synapse/source/ssfpc.inc b/3rd/synapse/source/ssfpc.inc deleted file mode 100644 index 34f7af82f..000000000 --- a/3rd/synapse/source/ssfpc.inc +++ /dev/null @@ -1,925 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.005 | -|==============================================================================| -| Content: Socket Independent Platform Layer - FreePascal definition include | -|==============================================================================| -| Copyright (c)2006-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2006-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$IFDEF FPC} -{For FreePascal 2.x.x} - -//{$DEFINE FORCEOLDAPI} -{Note about define FORCEOLDAPI: -If you activate this compiler directive, then is allways used old socket API -for name resolution. If you leave this directive inactive, then the new API -is used, when running system allows it. - -For IPv6 support you must have new API! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$ifdef FreeBSD} -{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr -{$endif} -{$ifdef darwin} -{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr -{$endif} - -interface - -uses - SyncObjs, SysUtils, Classes, - synafpc, BaseUnix, Unix, termio, sockets, netdb; - -function InitSocketInterface(stack: string): Boolean; -function DestroySocketInterface: Boolean; - -const - DLLStackName = ''; - WinsockLevel = $0202; - - cLocalHost = '127.0.0.1'; - cAnyHost = '0.0.0.0'; - c6AnyHost = '::0'; - c6Localhost = '::1'; - cLocalHostStr = 'localhost'; - -type - TSocket = longint; - TAddrFamily = integer; - - TMemory = pointer; - - -type - TFDSet = Baseunix.TFDSet; - PFDSet = ^TFDSet; - Ptimeval = Baseunix.ptimeval; - Ttimeval = Baseunix.ttimeval; - -const - FIONREAD = termio.FIONREAD; - FIONBIO = termio.FIONBIO; - FIOASYNC = termio.FIOASYNC; - -const - IPPROTO_IP = 0; { Dummy } - IPPROTO_ICMP = 1; { Internet Control Message Protocol } - IPPROTO_IGMP = 2; { Internet Group Management Protocol} - IPPROTO_TCP = 6; { TCP } - IPPROTO_UDP = 17; { User Datagram Protocol } - IPPROTO_IPV6 = 41; - IPPROTO_ICMPV6 = 58; - IPPROTO_RM = 113; - - IPPROTO_RAW = 255; - IPPROTO_MAX = 256; - -type - PInAddr = ^TInAddr; - TInAddr = sockets.in_addr; - - PSockAddrIn = ^TSockAddrIn; - TSockAddrIn = sockets.TInetSockAddr; - - - TIP_mreq = record - imr_multiaddr: TInAddr; // IP multicast address of group - imr_interface: TInAddr; // local IP address of interface - end; - - - PInAddr6 = ^TInAddr6; - TInAddr6 = sockets.Tin6_addr; - - PSockAddrIn6 = ^TSockAddrIn6; - TSockAddrIn6 = sockets.TInetSockAddr6; - - - TIPv6_mreq = record - ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. - ipv6mr_interface: integer; // Interface index. - end; - -const - INADDR_ANY = $00000000; - INADDR_LOOPBACK = $7F000001; - INADDR_BROADCAST = $FFFFFFFF; - INADDR_NONE = $FFFFFFFF; - ADDR_ANY = INADDR_ANY; - INVALID_SOCKET = TSocket(NOT(0)); - SOCKET_ERROR = -1; - -Const - IP_TOS = sockets.IP_TOS; { int; IP type of service and precedence. } - IP_TTL = sockets.IP_TTL; { int; IP time to live. } - IP_HDRINCL = sockets.IP_HDRINCL; { int; Header is included with data. } - IP_OPTIONS = sockets.IP_OPTIONS; { ip_opts; IP per-packet options. } -// IP_ROUTER_ALERT = sockets.IP_ROUTER_ALERT; { bool } - IP_RECVOPTS = sockets.IP_RECVOPTS; { bool } - IP_RETOPTS = sockets.IP_RETOPTS; { bool } -// IP_PKTINFO = sockets.IP_PKTINFO; { bool } -// IP_PKTOPTIONS = sockets.IP_PKTOPTIONS; -// IP_PMTUDISC = sockets.IP_PMTUDISC; { obsolete name? } -// IP_MTU_DISCOVER = sockets.IP_MTU_DISCOVER; { int; see below } -// IP_RECVERR = sockets.IP_RECVERR; { bool } -// IP_RECVTTL = sockets.IP_RECVTTL; { bool } -// IP_RECVTOS = sockets.IP_RECVTOS; { bool } - IP_MULTICAST_IF = sockets.IP_MULTICAST_IF; { in_addr; set/get IP multicast i/f } - IP_MULTICAST_TTL = sockets.IP_MULTICAST_TTL; { u_char; set/get IP multicast ttl } - IP_MULTICAST_LOOP = sockets.IP_MULTICAST_LOOP; { i_char; set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = sockets.IP_ADD_MEMBERSHIP; { ip_mreq; add an IP group membership } - IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership } - - SOL_SOCKET = sockets.SOL_SOCKET; - - SO_DEBUG = sockets.SO_DEBUG; - SO_REUSEADDR = sockets.SO_REUSEADDR; - SO_TYPE = sockets.SO_TYPE; - SO_ERROR = sockets.SO_ERROR; - SO_DONTROUTE = sockets.SO_DONTROUTE; - SO_BROADCAST = sockets.SO_BROADCAST; - SO_SNDBUF = sockets.SO_SNDBUF; - SO_RCVBUF = sockets.SO_RCVBUF; - SO_KEEPALIVE = sockets.SO_KEEPALIVE; - SO_OOBINLINE = sockets.SO_OOBINLINE; -// SO_NO_CHECK = sockets.SO_NO_CHECK; -// SO_PRIORITY = sockets.SO_PRIORITY; - SO_LINGER = sockets.SO_LINGER; -// SO_BSDCOMPAT = sockets.SO_BSDCOMPAT; -// SO_REUSEPORT = sockets.SO_REUSEPORT; -// SO_PASSCRED = sockets.SO_PASSCRED; -// SO_PEERCRED = sockets.SO_PEERCRED; - SO_RCVLOWAT = sockets.SO_RCVLOWAT; - SO_SNDLOWAT = sockets.SO_SNDLOWAT; - SO_RCVTIMEO = sockets.SO_RCVTIMEO; - SO_SNDTIMEO = sockets.SO_SNDTIMEO; -{ Security levels - as per NRL IPv6 - don't actually do anything } -// SO_SECURITY_AUTHENTICATION = sockets.SO_SECURITY_AUTHENTICATION; -// SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT; -// SO_SECURITY_ENCRYPTION_NETWORK = sockets.SO_SECURITY_ENCRYPTION_NETWORK; -// SO_BINDTODEVICE = sockets.SO_BINDTODEVICE; -{ Socket filtering } -// SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER; -// SO_DETACH_FILTER = sockets.SO_DETACH_FILTER; - -{$IFDEF DARWIN} - SO_NOSIGPIPE = $1022; -{$ENDIF} - - SOMAXCONN = 1024; - - IPV6_UNICAST_HOPS = sockets.IPV6_UNICAST_HOPS; - IPV6_MULTICAST_IF = sockets.IPV6_MULTICAST_IF; - IPV6_MULTICAST_HOPS = sockets.IPV6_MULTICAST_HOPS; - IPV6_MULTICAST_LOOP = sockets.IPV6_MULTICAST_LOOP; - IPV6_JOIN_GROUP = sockets.IPV6_JOIN_GROUP; - IPV6_LEAVE_GROUP = sockets.IPV6_LEAVE_GROUP; - -const - SOCK_STREAM = 1; { stream socket } - SOCK_DGRAM = 2; { datagram socket } - SOCK_RAW = 3; { raw-protocol interface } - SOCK_RDM = 4; { reliably-delivered message } - SOCK_SEQPACKET = 5; { sequenced packet stream } - -{ TCP options. } - TCP_NODELAY = $0001; - -{ Address families. } - - AF_UNSPEC = 0; { unspecified } - AF_INET = 2; { internetwork: UDP, TCP, etc. } - AF_INET6 = 10; { Internetwork Version 6 } - AF_MAX = 24; - -{ Protocol families, same as address families for now. } - PF_UNSPEC = AF_UNSPEC; - PF_INET = AF_INET; - PF_INET6 = AF_INET6; - PF_MAX = AF_MAX; - -type -{ Structure used for manipulating linger option. } - PLinger = ^TLinger; - TLinger = packed record - l_onoff: integer; - l_linger: integer; - end; - -const - - MSG_OOB = sockets.MSG_OOB; // Process out-of-band data. - MSG_PEEK = sockets.MSG_PEEK; // Peek at incoming messages. - {$ifdef DARWIN} - MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE. - // Works under MAC OS X, but is undocumented, - // So FPC doesn't include it - {$else} - MSG_NOSIGNAL = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE. - {$endif} - -const - WSAEINTR = ESysEINTR; - WSAEBADF = ESysEBADF; - WSAEACCES = ESysEACCES; - WSAEFAULT = ESysEFAULT; - WSAEINVAL = ESysEINVAL; - WSAEMFILE = ESysEMFILE; - WSAEWOULDBLOCK = ESysEWOULDBLOCK; - WSAEINPROGRESS = ESysEINPROGRESS; - WSAEALREADY = ESysEALREADY; - WSAENOTSOCK = ESysENOTSOCK; - WSAEDESTADDRREQ = ESysEDESTADDRREQ; - WSAEMSGSIZE = ESysEMSGSIZE; - WSAEPROTOTYPE = ESysEPROTOTYPE; - WSAENOPROTOOPT = ESysENOPROTOOPT; - WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT; - WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT; - WSAEOPNOTSUPP = ESysEOPNOTSUPP; - WSAEPFNOSUPPORT = ESysEPFNOSUPPORT; - WSAEAFNOSUPPORT = ESysEAFNOSUPPORT; - WSAEADDRINUSE = ESysEADDRINUSE; - WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL; - WSAENETDOWN = ESysENETDOWN; - WSAENETUNREACH = ESysENETUNREACH; - WSAENETRESET = ESysENETRESET; - WSAECONNABORTED = ESysECONNABORTED; - WSAECONNRESET = ESysECONNRESET; - WSAENOBUFS = ESysENOBUFS; - WSAEISCONN = ESysEISCONN; - WSAENOTCONN = ESysENOTCONN; - WSAESHUTDOWN = ESysESHUTDOWN; - WSAETOOMANYREFS = ESysETOOMANYREFS; - WSAETIMEDOUT = ESysETIMEDOUT; - WSAECONNREFUSED = ESysECONNREFUSED; - WSAELOOP = ESysELOOP; - WSAENAMETOOLONG = ESysENAMETOOLONG; - WSAEHOSTDOWN = ESysEHOSTDOWN; - WSAEHOSTUNREACH = ESysEHOSTUNREACH; - WSAENOTEMPTY = ESysENOTEMPTY; - WSAEPROCLIM = -1; - WSAEUSERS = ESysEUSERS; - WSAEDQUOT = ESysEDQUOT; - WSAESTALE = ESysESTALE; - WSAEREMOTE = ESysEREMOTE; - WSASYSNOTREADY = -2; - WSAVERNOTSUPPORTED = -3; - WSANOTINITIALISED = -4; - WSAEDISCON = -5; - WSAHOST_NOT_FOUND = 1; - WSATRY_AGAIN = 2; - WSANO_RECOVERY = 3; - WSANO_DATA = -6; - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = packed record - wVersion: Word; - wHighVersion: Word; - szDescription: array[0..WSADESCRIPTION_LEN] of Char; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; - iMaxSockets: Word; - iMaxUdpDg: Word; - lpVendorInfo: PChar; - end; - - function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); - -var - in6addr_any, in6addr_loopback : TInAddr6; - -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); - -{=============================================================================} - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - -type - TVarSin = packed record - {$ifdef SOCK_HAS_SINLEN} - sin_len : cuchar; - {$endif} - case integer of - 0: (AddressFamily: sa_family_t); - 1: ( - case sin_family: sa_family_t of - AF_INET: (sin_port: word; - sin_addr: TInAddr; - sin_zero: array[0..7] of Char); - AF_INET6: (sin6_port: word; - sin6_flowinfo: longword; - sin6_addr: TInAddr6; - sin6_scope_id: longword); - ); - end; - -function SizeOfVarSin(sin: TVarSin): integer; - - function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; - function WSACleanup: Integer; - function WSAGetLastError: Integer; - function GetHostName: string; - function Shutdown(s: TSocket; how: Integer): Integer; - function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - optlen: Integer): Integer; - function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - var optlen: Integer): Integer; - function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; - function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; - function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; - function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; - function ntohs(netshort: word): word; - function ntohl(netlong: longword): longword; - function Listen(s: TSocket; backlog: Integer): Integer; - function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer; - function htons(hostshort: word): word; - function htonl(hostlong: longword): longword; - function GetSockName(s: TSocket; var name: TVarSin): Integer; - function GetPeerName(s: TSocket; var name: TVarSin): Integer; - function Connect(s: TSocket; const name: TVarSin): Integer; - function CloseSocket(s: TSocket): Integer; - function Bind(s: TSocket; const addr: TVarSin): Integer; - function Accept(s: TSocket; var addr: TVarSin): TSocket; - function Socket(af, Struc, Protocol: Integer): TSocket; - function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; - -function IsNewApi(Family: integer): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): string; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; - - -{==============================================================================} -implementation - - -function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0)); -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and - (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and - (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1)); -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80)); -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0)); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := (a^.u6_addr8[0] = $FF); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.u6_addr8[15] := 1; -end; - -{=============================================================================} - -function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; -begin - with WSData do - begin - wVersion := wVersionRequired; - wHighVersion := $202; - szDescription := 'Synsock - Synapse Platform Independent Socket Layer'; - szSystemStatus := 'Running on Unix/Linux by FreePascal'; - iMaxSockets := 32768; - iMaxUdpDg := 8192; - end; - Result := 0; -end; - -function WSACleanup: Integer; -begin - Result := 0; -end; - -function WSAGetLastError: Integer; -begin - Result := fpGetErrno; -end; - -function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean; -begin - Result := fpFD_ISSET(socket, fdset) <> 0; -end; - -procedure FD_SET(Socket: TSocket; var fdset: TFDSet); -begin - fpFD_SET(Socket, fdset); -end; - -procedure FD_CLR(Socket: TSocket; var fdset: TFDSet); -begin - fpFD_CLR(Socket, fdset); -end; - -procedure FD_ZERO(var fdset: TFDSet); -begin - fpFD_ZERO(fdset); -end; - -{=============================================================================} - -function SizeOfVarSin(sin: TVarSin): integer; -begin - case sin.sin_family of - AF_INET: - Result := SizeOf(TSockAddrIn); - AF_INET6: - Result := SizeOf(TSockAddrIn6); - else - Result := 0; - end; -end; - -{=============================================================================} - -function Bind(s: TSocket; const addr: TVarSin): Integer; -begin - if fpBind(s, @addr, SizeOfVarSin(addr)) = 0 then - Result := 0 - else - Result := SOCKET_ERROR; -end; - -function Connect(s: TSocket; const name: TVarSin): Integer; -begin - if fpConnect(s, @name, SizeOfVarSin(name)) = 0 then - Result := 0 - else - Result := SOCKET_ERROR; -end; - -function GetSockName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := fpGetSockName(s, @name, @Len); -end; - -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := fpGetPeerName(s, @name, @Len); -end; - -function GetHostName: string; -begin - Result := unix.GetHostName; -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := fpSend(s, pointer(Buf), len, flags); -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := fpRecv(s, pointer(Buf), len, flags); -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -begin - Result := fpSendTo(s, pointer(Buf), len, flags, @addrto, SizeOfVarSin(addrto)); -end; - -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -var - x: integer; -begin - x := SizeOf(from); - Result := fpRecvFrom(s, pointer(Buf), len, flags, @from, @x); -end; - -function Accept(s: TSocket; var addr: TVarSin): TSocket; -var - x: integer; -begin - x := SizeOf(addr); - Result := fpAccept(s, @addr, @x); -end; - -function Shutdown(s: TSocket; how: Integer): Integer; -begin - Result := fpShutdown(s, how); -end; - -function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - optlen: Integer): Integer; -begin - Result := fpsetsockopt(s, level, optname, pointer(optval), optlen); -end; - -function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - var optlen: Integer): Integer; -begin - Result := fpgetsockopt(s, level, optname, pointer(optval), @optlen); -end; - -function ntohs(netshort: word): word; -begin - Result := sockets.ntohs(NetShort); -end; - -function ntohl(netlong: longword): longword; -begin - Result := sockets.ntohl(NetLong); -end; - -function Listen(s: TSocket; backlog: Integer): Integer; -begin - if fpListen(s, backlog) = 0 then - Result := 0 - else - Result := SOCKET_ERROR; -end; - -function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer; -begin - Result := fpIoctl(s, cmd, @arg); -end; - -function htons(hostshort: word): word; -begin - Result := sockets.htons(Hostshort); -end; - -function htonl(hostlong: longword): longword; -begin - Result := sockets.htonl(HostLong); -end; - -function CloseSocket(s: TSocket): Integer; -begin - Result := sockets.CloseSocket(s); -end; - -function Socket(af, Struc, Protocol: Integer): TSocket; -{$IFDEF DARWIN} -var - on_off: integer; -{$ENDIF} -begin - Result := fpSocket(af, struc, protocol); -// ##### Patch for Mac OS to avoid "Project XXX raised exception class 'External: SIGPIPE'" error. -{$IFDEF DARWIN} - if Result <> INVALID_SOCKET then - begin - on_off := 1; - synsock.SetSockOpt(Result, integer(SOL_SOCKET), integer(SO_NOSIGPIPE), @on_off, SizeOf(integer)); - end; -{$ENDIF} -end; - -function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; -begin - Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout); -end; - -{=============================================================================} -function IsNewApi(Family: integer): Boolean; -begin - Result := SockEnhancedApi; - if not Result then - Result := (Family = AF_INET6) and SockWship6Api; -end; - -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -var - TwoPass: boolean; - f1, f2: integer; - - function GetAddr(f:integer): integer; - var - a4: array [1..1] of in_addr; - a6: array [1..1] of Tin6_addr; - he: THostEntry; - begin - Result := WSAEPROTONOSUPPORT; - case f of - AF_INET: - begin - if IP = cAnyHost then - begin - Sin.sin_family := AF_INET; - Result := 0; - end - else - begin - if lowercase(IP) = cLocalHostStr then - a4[1].s_addr := htonl(INADDR_LOOPBACK) - else - begin - a4[1].s_addr := 0; - Result := WSAHOST_NOT_FOUND; - a4[1] := StrTonetAddr(IP); - if a4[1].s_addr = INADDR_ANY then - if GetHostByName(ip, he) then - a4[1]:=HostToNet(he.Addr) - else - Resolvename(ip, a4); - end; - if a4[1].s_addr <> INADDR_ANY then - begin - Sin.sin_family := AF_INET; - sin.sin_addr := a4[1]; - Result := 0; - end; - end; - end; - AF_INET6: - begin - if IP = c6AnyHost then - begin - Sin.sin_family := AF_INET6; - Result := 0; - end - else - begin - if lowercase(IP) = cLocalHostStr then - SET_LOOPBACK_ADDR6(@a6[1]) - else - begin - Result := WSAHOST_NOT_FOUND; - SET_IN6_IF_ADDR_ANY(@a6[1]); - a6[1] := StrTonetAddr6(IP); - if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then - Resolvename6(ip, a6); - end; - if not IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then - begin - Sin.sin_family := AF_INET6; - sin.sin6_addr := a6[1]; - Result := 0; - end; - end; - end; - end; - end; -begin - Result := 0; - FillChar(Sin, Sizeof(Sin), 0); - Sin.sin_port := Resolveport(port, family, SockProtocol, SockType); - TwoPass := False; - if Family = AF_UNSPEC then - begin - if PreferIP4 then - begin - f1 := AF_INET; - f2 := AF_INET6; - TwoPass := True; - end - else - begin - f2 := AF_INET; - f1 := AF_INET6; - TwoPass := True; - end; - end - else - f1 := Family; - Result := GetAddr(f1); - if Result <> 0 then - if TwoPass then - Result := GetAddr(f2); -end; - -function GetSinIP(Sin: TVarSin): string; -begin - Result := ''; - case sin.AddressFamily of - AF_INET: - begin - result := NetAddrToStr(sin.sin_addr); - end; - AF_INET6: - begin - result := NetAddrToStr6(sin.sin6_addr); - end; - end; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - if (Sin.sin_family = AF_INET6) then - Result := synsock.ntohs(Sin.sin6_port) - else - Result := synsock.ntohs(Sin.sin_port); -end; - -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -var - x, n: integer; - a4: array [1..255] of in_addr; - a6: array [1..255] of Tin6_addr; - he: THostEntry; -begin - IPList.Clear; - if (family = AF_INET) or (family = AF_UNSPEC) then - begin - if lowercase(name) = cLocalHostStr then - IpList.Add(cLocalHost) - else - begin - a4[1] := StrTonetAddr(name); - if a4[1].s_addr = INADDR_ANY then - if GetHostByName(name, he) then - begin - a4[1]:=HostToNet(he.Addr); - x := 1; - end - else - x := Resolvename(name, a4) - else - x := 1; - for n := 1 to x do - IpList.Add(netaddrToStr(a4[n])); - end; - end; - - if (family = AF_INET6) or (family = AF_UNSPEC) then - begin - if lowercase(name) = cLocalHostStr then - IpList.Add(c6LocalHost) - else - begin - a6[1] := StrTonetAddr6(name); - if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then - x := Resolvename6(name, a6) - else - x := 1; - for n := 1 to x do - IpList.Add(netaddrToStr6(a6[n])); - end; - end; - - if IPList.Count = 0 then - IPList.Add(cLocalHost); -end; - -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; -var - ProtoEnt: TProtocolEntry; - ServEnt: TServiceEntry; -begin - Result := synsock.htons(StrToIntDef(Port, 0)); - if Result = 0 then - begin - ProtoEnt.Name := ''; - GetProtocolByNumber(SockProtocol, ProtoEnt); - ServEnt.port := 0; - GetServiceByName(Port, ProtoEnt.Name, ServEnt); - Result := ServEnt.port; - end; -end; - -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -var - n: integer; - a4: array [1..1] of in_addr; - a6: array [1..1] of Tin6_addr; - a: array [1..1] of string; -begin - Result := IP; - a4[1] := StrToNetAddr(IP); - if a4[1].s_addr <> INADDR_ANY then - begin -//why ResolveAddress need address in HOST order? :-O - n := ResolveAddress(nettohost(a4[1]), a); - if n > 0 then - Result := a[1]; - end - else - begin - a6[1] := StrToNetAddr6(IP); - n := ResolveAddress6(a6[1], a); - if n > 0 then - Result := a[1]; - end; -end; - -{=============================================================================} - -function InitSocketInterface(stack: string): Boolean; -begin - SockEnhancedApi := False; - SockWship6Api := False; -// Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN)); - Result := True; -end; - -function DestroySocketInterface: Boolean; -begin - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; - SET_IN6_IF_ADDR_ANY (@in6addr_any); - SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - SynSockCS.Free; -end; - -{$ENDIF} - diff --git a/3rd/synapse/source/ssl_cryptlib.pas b/3rd/synapse/source/ssl_cryptlib.pas deleted file mode 100644 index b9be4decd..000000000 --- a/3rd/synapse/source/ssl_cryptlib.pas +++ /dev/null @@ -1,677 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.000 | -|==============================================================================| -| Content: SSL/SSH support by Peter Gutmann's CryptLib | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2005-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(SSL/SSH plugin for CryptLib) - -This plugin requires cl32.dll at least version 3.2.0! It can be used on Win32 -and Linux. This library is staticly linked - when you compile your application -with this plugin, you MUST distribute it with Cryptib library, otherwise you -cannot run your application! - -It can work with keys and certificates stored as PKCS#15 only! It must be stored -as disk file only, you cannot load them from memory! Each file can hold multiple -keys and certificates. You must identify it by 'label' stored in -@link(TSSLCryptLib.PrivateKeyLabel). - -If you need to use secure connection and authorize self by certificate -(each SSL/TLS server or client with client authorization), then use -@link(TCustomSSL.PrivateKeyFile), @link(TSSLCryptLib.PrivateKeyLabel) and -@link(TCustomSSL.KeyPassword) properties. - -If you need to use server what verifying client certificates, then use -@link(TCustomSSL.CertCAFile) as PKCS#15 file with public keyas of allowed clients. Clients -with non-matching certificates will be rejected by cryptLib. - -This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS -server without explicitly assigned key and certificate, then this plugin create -Ad-Hoc key and certificate for each incomming connection by self. It slowdown -accepting of new connections! - -You can use this plugin for SSHv2 connections too! You must explicitly set -@link(TCustomSSL.SSLType) to value LT_SSHv2 and set @link(TCustomSSL.username) -and @link(TCustomSSL.password). You can use special SSH channels too, see -@link(TCustomSSL). -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -unit ssl_cryptlib; - -interface - -uses - Windows, - SysUtils, - blcksock, synsock, synautil, synacode, - cryptlib; - -type - {:@abstract(class implementing CryptLib SSL/SSH plugin.) - Instance of this class will be created for each @link(TTCPBlockSocket). - You not need to create instance of this class, all is done by Synapse itself!} - TSSLCryptLib = class(TCustomSSL) - protected - FCryptSession: CRYPT_SESSION; - FPrivateKeyLabel: string; - FDelCert: Boolean; - FReadBuffer: string; - FTrustedCAs: array of integer; - function SSLCheck(Value: integer): Boolean; - function Init(server:Boolean): Boolean; - function DeInit: Boolean; - function Prepare(server:Boolean): Boolean; - function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string; - function CreateSelfSignedCert(Host: string): Boolean; override; - function PopAll: string; - public - {:See @inherited} - constructor Create(const Value: TTCPBlockSocket); override; - destructor Destroy; override; - {:Load trusted CA's in PEM format} - procedure SetCertCAFile(const Value: string); override; - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - {:See @inherited} - procedure Assign(const Value: TCustomSSL); override; - {:See @inherited and @link(ssl_cryptlib) for more details.} - function Connect: boolean; override; - {:See @inherited and @link(ssl_cryptlib) for more details.} - function Accept: boolean; override; - {:See @inherited} - function Shutdown: boolean; override; - {:See @inherited} - function BiShutdown: boolean; override; - {:See @inherited} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function WaitingData: Integer; override; - {:See @inherited} - function GetSSLVersion: string; override; - {:See @inherited} - function GetPeerSubject: string; override; - {:See @inherited} - function GetPeerIssuer: string; override; - {:See @inherited} - function GetPeerName: string; override; - {:See @inherited} - function GetPeerFingerprint: string; override; - {:See @inherited} - function GetVerifyCert: integer; override; - published - {:name of certificate/key within PKCS#15 file. It can hold more then one - certificate/key and each certificate/key must have unique label within one file.} - property PrivateKeyLabel: string read FPrivateKeyLabel Write FPrivateKeyLabel; - end; - -implementation - -{==============================================================================} - -constructor TSSLCryptLib.Create(const Value: TTCPBlockSocket); -begin - inherited Create(Value); - FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE); - FPrivateKeyLabel := 'synapse'; - FDelCert := false; - FTrustedCAs := nil; -end; - -destructor TSSLCryptLib.Destroy; -begin - SetCertCAFile(''); // destroy certificates - DeInit; - inherited Destroy; -end; - -procedure TSSLCryptLib.Assign(const Value: TCustomSSL); -begin - inherited Assign(Value); - if Value is TSSLCryptLib then - begin - FPrivateKeyLabel := TSSLCryptLib(Value).privatekeyLabel; - end; -end; - -function TSSLCryptLib.GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string; -var - l: integer; -begin - l := 0; - cryptGetAttributeString(cryptHandle, attributeType, nil, l); - setlength(Result, l); - cryptGetAttributeString(cryptHandle, attributeType, pointer(Result), l); - setlength(Result, l); -end; - -function TSSLCryptLib.LibVersion: String; -var - x: integer; -begin - Result := GetString(CRYPT_UNUSED, CRYPT_OPTION_INFO_DESCRIPTION); - cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION, x); - Result := Result + ' v' + IntToStr(x); - cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION, x); - Result := Result + '.' + IntToStr(x); - cryptGetAttribute(CRYPT_UNUSED, CRYPT_OPTION_INFO_STEPPING, x); - Result := Result + '.' + IntToStr(x); -end; - -function TSSLCryptLib.LibName: String; -begin - Result := 'ssl_cryptlib'; -end; - -function TSSLCryptLib.SSLCheck(Value: integer): Boolean; -begin - Result := true; - FLastErrorDesc := ''; - if Value = CRYPT_ERROR_COMPLETE then - Value := 0; - FLastError := Value; - if FLastError <> 0 then - begin - Result := False; -{$IF CRYPTLIB_VERSION >= 3400} - FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_ERRORMESSAGE); -{$ELSE} - FLastErrorDesc := GetString(FCryptSession, CRYPT_ATTRIBUTE_INT_ERRORMESSAGE); -{$IFEND} - end; -end; - -function TSSLCryptLib.CreateSelfSignedCert(Host: string): Boolean; -var - privateKey: CRYPT_CONTEXT; - keyset: CRYPT_KEYSET; - cert: CRYPT_CERTIFICATE; - publicKey: CRYPT_CONTEXT; -begin - if FPrivatekeyFile = '' then - FPrivatekeyFile := GetTempFile('', 'key'); - cryptCreateContext(privateKey, CRYPT_UNUSED, CRYPT_ALGO_RSA); - cryptSetAttributeString(privateKey, CRYPT_CTXINFO_LABEL, Pointer(FPrivatekeyLabel), - Length(FPrivatekeyLabel)); - cryptSetAttribute(privateKey, CRYPT_CTXINFO_KEYSIZE, 1024); - cryptGenerateKey(privateKey); - cryptKeysetOpen(keyset, CRYPT_UNUSED, CRYPT_KEYSET_FILE, PChar(FPrivatekeyFile), CRYPT_KEYOPT_CREATE); - FDelCert := True; - cryptAddPrivateKey(keyset, privateKey, PChar(FKeyPassword)); - cryptCreateCert(cert, CRYPT_UNUSED, CRYPT_CERTTYPE_CERTIFICATE); - cryptSetAttribute(cert, CRYPT_CERTINFO_XYZZY, 1); - cryptGetPublicKey(keyset, publicKey, CRYPT_KEYID_NAME, PChar(FPrivatekeyLabel)); - cryptSetAttribute(cert, CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO, publicKey); - cryptSetAttributeString(cert, CRYPT_CERTINFO_COMMONNAME, Pointer(host), Length(host)); - cryptSignCert(cert, privateKey); - cryptAddPublicKey(keyset, cert); - cryptKeysetClose(keyset); - cryptDestroyCert(cert); - cryptDestroyContext(privateKey); - cryptDestroyContext(publicKey); - Result := True; -end; - -function TSSLCryptLib.PopAll: string; -const - BufferMaxSize = 32768; -var - Outbuffer: string; - WriteLen: integer; -begin - Result := ''; - repeat - setlength(outbuffer, BufferMaxSize); - Writelen := 0; - SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen)); - if FLastError <> 0 then - Break; - if WriteLen > 0 then - begin - setlength(outbuffer, WriteLen); - Result := Result + outbuffer; - end; - until WriteLen = 0; -end; - -function TSSLCryptLib.Init(server:Boolean): Boolean; -var - st: CRYPT_SESSION_TYPE; - keysetobj: CRYPT_KEYSET; - cryptContext: CRYPT_CONTEXT; - x: integer; -begin - Result := False; - FLastErrorDesc := ''; - FLastError := 0; - FDelCert := false; - FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE); - if server then - case FSSLType of - LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1: - st := CRYPT_SESSION_SSL_SERVER; - LT_SSHv2: - st := CRYPT_SESSION_SSH_SERVER; - else - Exit; - end - else - case FSSLType of - LT_all, LT_SSLv3, LT_TLSv1, LT_TLSv1_1: - st := CRYPT_SESSION_SSL; - LT_SSHv2: - st := CRYPT_SESSION_SSH; - else - Exit; - end; - if not SSLCheck(cryptCreateSession(FcryptSession, CRYPT_UNUSED, st)) then - Exit; - x := -1; - case FSSLType of - LT_SSLv3: - x := 0; - LT_TLSv1: - x := 1; - LT_TLSv1_1: - x := 2; - end; - if x >= 0 then - if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x)) then - Exit; - - if (FCertComplianceLevel <> -1) then - if not SSLCheck(cryptSetAttribute (CRYPT_UNUSED, CRYPT_OPTION_CERT_COMPLIANCELEVEL, - FCertComplianceLevel)) then - Exit; - - if FUsername <> '' then - begin - cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_USERNAME, - Pointer(FUsername), Length(FUsername)); - cryptSetAttributeString(FcryptSession, CRYPT_SESSINFO_PASSWORD, - Pointer(FPassword), Length(FPassword)); - end; - if FSSLType = LT_SSHv2 then - if FSSHChannelType <> '' then - begin - cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL, CRYPT_UNUSED); - cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_TYPE, - Pointer(FSSHChannelType), Length(FSSHChannelType)); - if FSSHChannelArg1 <> '' then - cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG1, - Pointer(FSSHChannelArg1), Length(FSSHChannelArg1)); - if FSSHChannelArg2 <> '' then - cryptSetAttributeString(FCryptSession, CRYPT_SESSINFO_SSH_CHANNEL_ARG2, - Pointer(FSSHChannelArg2), Length(FSSHChannelArg2)); - end; - - - if server and (FPrivatekeyFile = '') then - begin - if FPrivatekeyLabel = '' then - FPrivatekeyLabel := 'synapse'; - if FkeyPassword = '' then - FkeyPassword := 'synapse'; - CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP)); - end; - - if (FPrivatekeyLabel <> '') and (FPrivatekeyFile <> '') then - begin - if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE, - PChar(FPrivatekeyFile), CRYPT_KEYOPT_READONLY)) then - Exit; - try - if not SSLCheck(cryptGetPrivateKey(KeySetObj, cryptcontext, CRYPT_KEYID_NAME, - PChar(FPrivatekeyLabel), PChar(FKeyPassword))) then - Exit; - if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_PRIVATEKEY, - cryptcontext)) then - Exit; - finally - cryptKeysetClose(keySetObj); - cryptDestroyContext(cryptcontext); - end; - end; - if server and FVerifyCert then - begin - if not SSLCheck(cryptKeysetOpen(KeySetObj, CRYPT_UNUSED, CRYPT_KEYSET_FILE, - PChar(FCertCAFile), CRYPT_KEYOPT_READONLY)) then - Exit; - try - if not SSLCheck(cryptSetAttribute(FcryptSession, CRYPT_SESSINFO_KEYSET, - keySetObj)) then - Exit; - finally - cryptKeysetClose(keySetObj); - end; - end; - Result := true; -end; - -function TSSLCryptLib.DeInit: Boolean; -begin - Result := True; - if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then - CryptDestroySession(FcryptSession); - FcryptSession := CRYPT_SESSION(CRYPT_SESSION_NONE); - FSSLEnabled := False; - if FDelCert then - SysUtils.DeleteFile(FPrivatekeyFile); -end; - -function TSSLCryptLib.Prepare(server:Boolean): Boolean; -begin - Result := false; - DeInit; - if Init(server) then - Result := true - else - DeInit; -end; - -function TSSLCryptLib.Connect: boolean; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(false) then - begin - if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then - Exit; - if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then - Exit; - if FverifyCert then - if (GetVerifyCert <> 0) or (not DoVerifyCert) then - Exit; - FSSLEnabled := True; - Result := True; - FReadBuffer := ''; - end; -end; - -function TSSLCryptLib.Accept: boolean; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(true) then - begin - if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_NETWORKSOCKET, FSocket.Socket)) then - Exit; - if not SSLCheck(cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 1)) then - Exit; - FSSLEnabled := True; - Result := True; - FReadBuffer := ''; - end; -end; - -function TSSLCryptLib.Shutdown: boolean; -begin - Result := BiShutdown; -end; - -function TSSLCryptLib.BiShutdown: boolean; -begin - if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then - cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0); - DeInit; - FReadBuffer := ''; - Result := True; -end; - -function TSSLCryptLib.SendBuffer(Buffer: TMemory; Len: Integer): Integer; -var - l: integer; -begin - FLastError := 0; - FLastErrorDesc := ''; - SSLCheck(cryptPushData(FCryptSession, Buffer, Len, L)); - cryptFlushData(FcryptSession); - Result := l; -end; - -function TSSLCryptLib.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - FLastError := 0; - FLastErrorDesc := ''; - if Length(FReadBuffer) = 0 then - FReadBuffer := PopAll; - if Len > Length(FReadBuffer) then - Len := Length(FReadBuffer); - Move(Pointer(FReadBuffer)^, buffer^, Len); - Delete(FReadBuffer, 1, Len); - Result := Len; -end; - -function TSSLCryptLib.WaitingData: Integer; -begin - Result := Length(FReadBuffer); -end; - -function TSSLCryptLib.GetSSLVersion: string; -var - x: integer; -begin - Result := ''; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_VERSION, x); - if FSSLType in [LT_SSLv3, LT_TLSv1, LT_TLSv1_1, LT_all] then - case x of - 0: - Result := 'SSLv3'; - 1: - Result := 'TLSv1'; - 2: - Result := 'TLSv1.1'; - end; - if FSSLType in [LT_SSHv2] then - case x of - 0: - Result := 'SSHv1'; - 1: - Result := 'SSHv2'; - end; -end; - -function TSSLCryptLib.GetPeerSubject: string; -var - cert: CRYPT_CERTIFICATE; -begin - Result := ''; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); - Result := GetString(cert, CRYPT_CERTINFO_DN); - cryptDestroyCert(cert); -end; - -function TSSLCryptLib.GetPeerName: string; -var - cert: CRYPT_CERTIFICATE; -begin - Result := ''; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); - Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME); - cryptDestroyCert(cert); -end; - -function TSSLCryptLib.GetPeerIssuer: string; -var - cert: CRYPT_CERTIFICATE; -begin - Result := ''; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_ISSUERNAME); - Result := GetString(cert, CRYPT_CERTINFO_COMMONNAME); - cryptDestroyCert(cert); -end; - -function TSSLCryptLib.GetPeerFingerprint: string; -var - cert: CRYPT_CERTIFICATE; -begin - Result := ''; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - Result := GetString(cert, CRYPT_CERTINFO_FINGERPRINT); - cryptDestroyCert(cert); -end; - - -procedure TSSLCryptLib.SetCertCAFile(const Value: string); - -var F:textfile; - bInCert:boolean; - s,sCert:string; - cert: CRYPT_CERTIFICATE; - idx:integer; - -begin -if assigned(FTrustedCAs) then - begin - for idx := 0 to High(FTrustedCAs) do - cryptDestroyCert(FTrustedCAs[idx]); - FTrustedCAs:=nil; - end; -if Value<>'' then - begin - AssignFile(F,Value); - reset(F); - bInCert:=false; - idx:=0; - while not eof(F) do - begin - readln(F,s); - if pos('-----END CERTIFICATE-----',s)>0 then - begin - bInCert:=false; - cert:=0; - if (cryptImportCert(PAnsiChar(sCert),length(sCert)-2,CRYPT_UNUSED,cert)=CRYPT_OK) then - begin - cryptSetAttribute( cert, CRYPT_CERTINFO_TRUSTED_IMPLICIT, 1 ); - SetLength(FTrustedCAs,idx+1); - FTrustedCAs[idx]:=cert; - idx:=idx+1; - end; - end; - if bInCert then - sCert:=sCert+s+#13#10; - if pos('-----BEGIN CERTIFICATE-----',s)>0 then - begin - bInCert:=true; - sCert:=''; - end; - end; - CloseFile(F); - end; -end; - -function TSSLCryptLib.GetVerifyCert: integer; -var - cert: CRYPT_CERTIFICATE; - itype,ilocus:integer; -begin - Result := -1; - if FcryptSession = CRYPT_SESSION(CRYPT_SESSION_NONE) then - Exit; - cryptGetAttribute(FCryptSession, CRYPT_SESSINFO_RESPONSE, cert); - result:=cryptCheckCert(cert,CRYPT_UNUSED); - if result<>CRYPT_OK then - begin - //get extended error info if available - cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORtype,itype); - cryptGetAttribute(cert,CRYPT_ATTRIBUTE_ERRORLOCUS,ilocus); - cryptSetAttribute(cert, CRYPT_ATTRIBUTE_CURRENT, CRYPT_CERTINFO_SUBJECTNAME); - FLastError := Result; - FLastErrorDesc := format('SSL/TLS certificate verification failed for "%s"'#13#10'Status: %d. ERRORTYPE: %d. ERRORLOCUS: %d.', - [GetString(cert, CRYPT_CERTINFO_COMMONNAME),result,itype,ilocus]); - end; - cryptDestroyCert(cert); -end; - -{==============================================================================} - -var imajor,iminor,iver:integer; -// e: ESynapseError; - -initialization - if cryptInit = CRYPT_OK then - SSLImplementation := TSSLCryptLib; - cryptAddRandom(nil, CRYPT_RANDOM_SLOWPOLL); - cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MAJORVERSION,imajor); - cryptGetAttribute (CRYPT_UNUSED, CRYPT_OPTION_INFO_MINORVERSION,iminor); -// according to the documentation CRYPTLIB version has 3 digits. recent versions use 4 digits - if CRYPTLIB_VERSION >1000 then - iver:=CRYPTLIB_VERSION div 100 - else - iver:=CRYPTLIB_VERSION div 10; - if (iver <> imajor*10+iminor) then - begin - SSLImplementation :=TSSLNone; -// e := ESynapseError.Create(format('Error wrong cryptlib version (is %d.%d expected %d.%d). ', -// [imajor,iminor,iver div 10, iver mod 10])); -// e.ErrorCode := 0; -// e.ErrorMessage := format('Error wrong cryptlib version (%d.%d expected %d.%d)', -// [imajor,iminor,iver div 10, iver mod 10]); -// raise e; - end; -finalization - cryptEnd; -end. - - diff --git a/3rd/synapse/source/ssl_libssh2.pas b/3rd/synapse/source/ssl_libssh2.pas deleted file mode 100644 index e0154c068..000000000 --- a/3rd/synapse/source/ssl_libssh2.pas +++ /dev/null @@ -1,251 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.000.000 | -|==============================================================================| -| Content: SSH support by LibSSH2 | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Alexey Suhinin. | -| Portions created by Alexey Suhinin are Copyright (c)2012-2013. | -| Portions created by Lukas Gebauer are Copyright (c)2013-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -//requires LibSSH2 libraries! http://libssh2.org - -{:@abstract(SSH plugin for LibSSH2) - -Requires libssh2.dll or libssh2.so. -You can download binaries as part of the CURL project from -http://curl.haxx.se/download.html - -You need Pascal bindings for the library too! You can find one at: - http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465 - -This plugin implements the client part only. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -unit ssl_libssh2; - -interface - -uses - SysUtils, - blcksock, synsock, - libssh2; - -type - {:@abstract(class implementing LibSSH2 SSH plugin.) - Instance of this class will be created for each @link(TTCPBlockSocket). - You not need to create instance of this class, all is done by Synapse itself!} - TSSLLibSSH2 = class(TCustomSSL) - protected - FSession: PLIBSSH2_SESSION; - FChannel: PLIBSSH2_CHANNEL; - function SSHCheck(Value: integer): Boolean; - function DeInit: Boolean; - public - {:See @inherited} - constructor Create(const Value: TTCPBlockSocket); override; - destructor Destroy; override; - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - {:See @inherited} - function Connect: boolean; override; - {:See @inherited} - function Shutdown: boolean; override; - {:See @inherited} - function BiShutdown: boolean; override; - {:See @inherited} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function WaitingData: Integer; override; - {:See @inherited} - function GetSSLVersion: string; override; - published - end; - -implementation - -{==============================================================================} -function TSSLLibSSH2.SSHCheck(Value: integer): Boolean; -var - PLastError: PAnsiChar; - ErrMsgLen: Integer; -begin - Result := true; - FLastError := 0; - FLastErrorDesc := ''; - if Value<0 then - begin - FLastError := libssh2_session_last_error(FSession, PLastError, ErrMsglen, 0); - FLastErrorDesc := PLastError; - Result := false; - end; -end; - - -function TSSLLibSSH2.DeInit: Boolean; -begin - if Assigned(FChannel) then - begin - libssh2_channel_free(FChannel); - FChannel := nil; - end; - if Assigned(FSession) then - begin - libssh2_session_disconnect(FSession,'Goodbye'); - libssh2_session_free(FSession); - FSession := nil; - end; - FSSLEnabled := False; - Result := true; -end; - -constructor TSSLLibSSH2.Create(const Value: TTCPBlockSocket); -begin - inherited Create(Value); - FSession := nil; - FChannel := nil; -end; - -destructor TSSLLibSSH2.Destroy; -begin - DeInit; - inherited Destroy; -end; - -function TSSLLibSSH2.Connect: boolean; -begin - Result := False; - if SSLEnabled then DeInit; - if (FSocket.Socket <> INVALID_SOCKET) and (FSocket.SSL.SSLType = LT_SSHv2) then - begin - FSession := libssh2_session_init(); - if not Assigned(FSession) then - begin - FLastError := -999; - FLastErrorDesc := 'Cannot initialize SSH session'; - exit; - end; - if not SSHCheck(libssh2_session_startup(FSession, FSocket.Socket)) then - exit; - // Attempt private key authentication, then fall back to username/password but - // do not forget original private key auth error. This avoids giving spurious errors like - // Authentication failed (username/password) - // instead of e.g. - // Unable to extract public key from private key file: Method unimplemented in libgcrypt backend - if FSocket.SSL.PrivateKeyFile<>'' then - if (not SSHCheck(libssh2_userauth_publickey_fromfile(FSession, PChar(FSocket.SSL.Username), nil, PChar(FSocket.SSL.PrivateKeyFile), PChar(FSocket.SSL.KeyPassword)))) - and (libssh2_userauth_password(FSession, PChar(FSocket.SSL.Username), PChar(FSocket.SSL.Password))<0) then - exit; - FChannel := libssh2_channel_open_session(FSession); - if not assigned(FChannel) then - begin -// SSHCheck(-1); - FLastError:=-999; - FLastErrorDesc := 'Cannot open session'; - exit; - end; - if not SSHCheck(libssh2_channel_request_pty(FChannel, 'vanilla')) then - exit; - if not SSHCheck(libssh2_channel_shell(FChannel)) then - exit; - FSSLEnabled := True; - Result := True; - end; -end; - -function TSSLLibSSH2.LibName: String; -begin - Result := 'ssl_libssh2'; -end; - -function TSSLLibSSH2.Shutdown: boolean; -begin - Result := DeInit; -end; - - -function TSSLLibSSH2.BiShutdown: boolean; -begin - Result := DeInit; -end; - -function TSSLLibSSH2.SendBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - Result:=libssh2_channel_write(FChannel, PAnsiChar(Buffer), Len); - SSHCheck(Result); -end; - -function TSSLLibSSH2.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -begin - result:=libssh2_channel_read(FChannel, PAnsiChar(Buffer), Len); - SSHCheck(Result); -end; - -function TSSLLibSSH2.WaitingData: Integer; -begin - if libssh2_poll_channel_read(FChannel, Result) <> 1 then - Result := 0; -end; - -function TSSLLibSSH2.GetSSLVersion: string; -begin - Result := 'SSH2'; -end; - -function TSSLLibSSH2.LibVersion: String; -begin - Result := libssh2_version(0); -end; - -initialization - if libssh2_init(0)=0 then - SSLImplementation := TSSLLibSSH2; - -finalization - libssh2_exit; - -end. diff --git a/3rd/synapse/source/ssl_openssl.pas b/3rd/synapse/source/ssl_openssl.pas deleted file mode 100644 index 26c6a7492..000000000 --- a/3rd/synapse/source/ssl_openssl.pas +++ /dev/null @@ -1,922 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.002.001 | -|==============================================================================| -| Content: SSL support by OpenSSL | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2005-2012. | -| Portions created by Petr Fejfar are Copyright (c)2011-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -//requires OpenSSL libraries! - -{:@abstract(SSL plugin for OpenSSL) - -You need OpenSSL libraries version 0.9.7. It can work with 0.9.6 too, but -application mysteriously crashing when you are using freePascal on Linux. -Use Kylix on Linux is OK! If you have version 0.9.7 on Linux, then I not see -any problems with FreePascal. - -OpenSSL libraries are loaded dynamicly - you not need OpenSSl librares even you -compile your application with this unit. SSL just not working when you not have -OpenSSL libraries. - -This plugin have limited support for .NET too! Because is not possible to use -callbacks with CDECL calling convention under .NET, is not supported -key/certificate passwords and multithread locking. :-( - -For handling keys and certificates you can use this properties: - -@link(TCustomSSL.CertificateFile) for PEM or ASN1 DER (cer) format. @br -@link(TCustomSSL.Certificate) for ASN1 DER format only. @br -@link(TCustomSSL.PrivateKeyFile) for PEM or ASN1 DER (key) format. @br -@link(TCustomSSL.PrivateKey) for ASN1 DER format only. @br -@link(TCustomSSL.CertCAFile) for PEM CA certificate bundle. @br -@link(TCustomSSL.PFXFile) for PFX format. @br -@link(TCustomSSL.PFX) for PFX format from binary string. @br - -This plugin is capable to create Ad-Hoc certificates. When you start SSL/TLS -server without explicitly assigned key and certificate, then this plugin create -Ad-Hoc key and certificate for each incomming connection by self. It slowdown -accepting of new connections! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit ssl_openssl; - -interface - -uses - SysUtils, Classes, - blcksock, synsock, synautil, -{$IFDEF CIL} - System.Text, -{$ENDIF} - ssl_openssl_lib; - -type - {:@abstract(class implementing OpenSSL SSL plugin.) - Instance of this class will be created for each @link(TTCPBlockSocket). - You not need to create instance of this class, all is done by Synapse itself!} - TSSLOpenSSL = class(TCustomSSL) - protected - FSsl: PSSL; - Fctx: PSSL_CTX; - function SSLCheck: Boolean; - function SetSslKeys: boolean; - function Init(server:Boolean): Boolean; - function DeInit: Boolean; - function Prepare(server:Boolean): Boolean; - function LoadPFX(pfxdata: ansistring): Boolean; - function CreateSelfSignedCert(Host: string): Boolean; override; - public - {:See @inherited} - constructor Create(const Value: TTCPBlockSocket); override; - destructor Destroy; override; - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - {:See @inherited and @link(ssl_cryptlib) for more details.} - function Connect: boolean; override; - {:See @inherited and @link(ssl_cryptlib) for more details.} - function Accept: boolean; override; - {:See @inherited} - function Shutdown: boolean; override; - {:See @inherited} - function BiShutdown: boolean; override; - {:See @inherited} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function WaitingData: Integer; override; - {:See @inherited} - function GetSSLVersion: string; override; - {:See @inherited} - function GetPeerSubject: string; override; - {:See @inherited} - function GetPeerSerialNo: integer; override; {pf} - {:See @inherited} - function GetPeerIssuer: string; override; - {:See @inherited} - function GetPeerName: string; override; - {:See @inherited} - function GetPeerNameHash: cardinal; override; {pf} - {:See @inherited} - function GetPeerFingerprint: string; override; - {:See @inherited} - function GetCertInfo: string; override; - {:See @inherited} - function GetCipherName: string; override; - {:See @inherited} - function GetCipherBits: integer; override; - {:See @inherited} - function GetCipherAlgBits: integer; override; - {:See @inherited} - function GetVerifyCert: integer; override; - end; - -implementation - -{==============================================================================} - -{$IFNDEF CIL} -function PasswordCallback(buf:PAnsiChar; size:Integer; rwflag:Integer; userdata: Pointer):Integer; cdecl; -var - Password: AnsiString; -begin - Password := ''; - if TCustomSSL(userdata) is TCustomSSL then - Password := TCustomSSL(userdata).KeyPassword; - if Length(Password) > (Size - 1) then - SetLength(Password, Size - 1); - Result := Length(Password); - StrLCopy(buf, PAnsiChar(Password + #0), Result + 1); -end; -{$ENDIF} - -{==============================================================================} - -constructor TSSLOpenSSL.Create(const Value: TTCPBlockSocket); -begin - inherited Create(Value); - FCiphers := 'DEFAULT'; - FSsl := nil; - Fctx := nil; -end; - -destructor TSSLOpenSSL.Destroy; -begin - DeInit; - inherited Destroy; -end; - -function TSSLOpenSSL.LibVersion: String; -begin - Result := SSLeayversion(0); -end; - -function TSSLOpenSSL.LibName: String; -begin - Result := 'ssl_openssl'; -end; - -function TSSLOpenSSL.SSLCheck: Boolean; -var -{$IFDEF CIL} - sb: StringBuilder; -{$ENDIF} - s : AnsiString; -begin - Result := true; - FLastErrorDesc := ''; - FLastError := ErrGetError; - ErrClearError; - if FLastError <> 0 then - begin - Result := False; -{$IFDEF CIL} - sb := StringBuilder.Create(256); - ErrErrorString(FLastError, sb, 256); - FLastErrorDesc := Trim(sb.ToString); -{$ELSE} - s := StringOfChar(#0, 256); - ErrErrorString(FLastError, s, Length(s)); - FLastErrorDesc := s; -{$ENDIF} - end; -end; - -function TSSLOpenSSL.CreateSelfSignedCert(Host: string): Boolean; -var - pk: EVP_PKEY; - x: PX509; - rsa: PRSA; - t: PASN1_UTCTIME; - name: PX509_NAME; - b: PBIO; - xn, y: integer; - s: AnsiString; -{$IFDEF CIL} - sb: StringBuilder; -{$ENDIF} -begin - Result := True; - pk := EvpPkeynew; - x := X509New; - try - rsa := RsaGenerateKey(1024, $10001, nil, nil); - EvpPkeyAssign(pk, EVP_PKEY_RSA, rsa); - X509SetVersion(x, 2); - Asn1IntegerSet(X509getSerialNumber(x), 0); - t := Asn1UtctimeNew; - try - X509GmtimeAdj(t, -60 * 60 *24); - X509SetNotBefore(x, t); - X509GmtimeAdj(t, 60 * 60 * 60 *24); - X509SetNotAfter(x, t); - finally - Asn1UtctimeFree(t); - end; - X509SetPubkey(x, pk); - Name := X509GetSubjectName(x); - X509NameAddEntryByTxt(Name, 'C', $1001, 'CZ', -1, -1, 0); - X509NameAddEntryByTxt(Name, 'CN', $1001, host, -1, -1, 0); - x509SetIssuerName(x, Name); - x509Sign(x, pk, EvpGetDigestByName('SHA1')); - b := BioNew(BioSMem); - try - i2dX509Bio(b, x); - xn := bioctrlpending(b); -{$IFDEF CIL} - sb := StringBuilder.Create(xn); - y := bioread(b, sb, xn); - if y > 0 then - begin - sb.Length := y; - s := sb.ToString; - end; -{$ELSE} - setlength(s, xn); - y := bioread(b, s, xn); - if y > 0 then - setlength(s, y); -{$ENDIF} - finally - BioFreeAll(b); - end; - FCertificate := s; - b := BioNew(BioSMem); - try - i2dPrivatekeyBio(b, pk); - xn := bioctrlpending(b); -{$IFDEF CIL} - sb := StringBuilder.Create(xn); - y := bioread(b, sb, xn); - if y > 0 then - begin - sb.Length := y; - s := sb.ToString; - end; -{$ELSE} - setlength(s, xn); - y := bioread(b, s, xn); - if y > 0 then - setlength(s, y); -{$ENDIF} - finally - BioFreeAll(b); - end; - FPrivatekey := s; - finally - X509free(x); - EvpPkeyFree(pk); - end; -end; - -function TSSLOpenSSL.LoadPFX(pfxdata: Ansistring): Boolean; -var - cert, pkey, ca: SslPtr; - b: PBIO; - p12: SslPtr; -begin - Result := False; - b := BioNew(BioSMem); - try - BioWrite(b, pfxdata, Length(PfxData)); - p12 := d2iPKCS12bio(b, nil); - if not Assigned(p12) then - Exit; - try - cert := nil; - pkey := nil; - ca := nil; - try {pf} - if PKCS12parse(p12, FKeyPassword, pkey, cert, ca) > 0 then - if SSLCTXusecertificate(Fctx, cert) > 0 then - if SSLCTXusePrivateKey(Fctx, pkey) > 0 then - Result := True; - {pf} - finally - EvpPkeyFree(pkey); - X509free(cert); - SkX509PopFree(ca,_X509Free); // for ca=nil a new STACK was allocated... - end; - {/pf} - finally - PKCS12free(p12); - end; - finally - BioFreeAll(b); - end; -end; - -function TSSLOpenSSL.SetSslKeys: boolean; -var - st: TFileStream; - s: string; -begin - Result := False; - if not assigned(FCtx) then - Exit; - try - if FCertificateFile <> '' then - if SslCtxUseCertificateChainFile(FCtx, FCertificateFile) <> 1 then - if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_PEM) <> 1 then - if SslCtxUseCertificateFile(FCtx, FCertificateFile, SSL_FILETYPE_ASN1) <> 1 then - Exit; - if FCertificate <> '' then - if SslCtxUseCertificateASN1(FCtx, length(FCertificate), FCertificate) <> 1 then - Exit; - SSLCheck; - if FPrivateKeyFile <> '' then - if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_PEM) <> 1 then - if SslCtxUsePrivateKeyFile(FCtx, FPrivateKeyFile, SSL_FILETYPE_ASN1) <> 1 then - Exit; - if FPrivateKey <> '' then - if SslCtxUsePrivateKeyASN1(EVP_PKEY_RSA, FCtx, FPrivateKey, length(FPrivateKey)) <> 1 then - Exit; - SSLCheck; - if FCertCAFile <> '' then - if SslCtxLoadVerifyLocations(FCtx, FCertCAFile, '') <> 1 then - Exit; - if FPFXfile <> '' then - begin - try - st := TFileStream.Create(FPFXfile, fmOpenRead or fmShareDenyNone); - try - s := ReadStrFromStream(st, st.Size); - finally - st.Free; - end; - if not LoadPFX(s) then - Exit; - except - on Exception do - Exit; - end; - end; - if FPFX <> '' then - if not LoadPFX(FPfx) then - Exit; - SSLCheck; - Result := True; - finally - SSLCheck; - end; -end; - -function TSSLOpenSSL.Init(server:Boolean): Boolean; -var - s: AnsiString; -begin - Result := False; - FLastErrorDesc := ''; - FLastError := 0; - Fctx := nil; - case FSSLType of - LT_SSLv2: - Fctx := SslCtxNew(SslMethodV2); - LT_SSLv3: - Fctx := SslCtxNew(SslMethodV3); - LT_TLSv1: - Fctx := SslCtxNew(SslMethodTLSV1); - LT_all: - Fctx := SslCtxNew(SslMethodV23); - else - Exit; - end; - if Fctx = nil then - begin - SSLCheck; - Exit; - end - else - begin - s := FCiphers; - SslCtxSetCipherList(Fctx, s); - if FVerifyCert then - SslCtxSetVerify(FCtx, SSL_VERIFY_PEER, nil) - else - SslCtxSetVerify(FCtx, SSL_VERIFY_NONE, nil); -{$IFNDEF CIL} - SslCtxSetDefaultPasswdCb(FCtx, @PasswordCallback); - SslCtxSetDefaultPasswdCbUserdata(FCtx, self); -{$ENDIF} - - if server and (FCertificateFile = '') and (FCertificate = '') - and (FPFXfile = '') and (FPFX = '') then - begin - CreateSelfSignedcert(FSocket.ResolveIPToName(FSocket.GetRemoteSinIP)); - end; - - if not SetSSLKeys then - Exit - else - begin - Fssl := nil; - Fssl := SslNew(Fctx); - if Fssl = nil then - begin - SSLCheck; - exit; - end; - end; - end; - Result := true; -end; - -function TSSLOpenSSL.DeInit: Boolean; -begin - Result := True; - if assigned (Fssl) then - sslfree(Fssl); - Fssl := nil; - if assigned (Fctx) then - begin - SslCtxFree(Fctx); - Fctx := nil; - ErrRemoveState(0); - end; - FSSLEnabled := False; -end; - -function TSSLOpenSSL.Prepare(server:Boolean): Boolean; -begin - Result := false; - DeInit; - if Init(server) then - Result := true - else - DeInit; -end; - -function TSSLOpenSSL.Connect: boolean; -var - x: integer; - b: boolean; - err: integer; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(False) then - begin -{$IFDEF CIL} - if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then -{$ELSE} - if sslsetfd(FSsl, FSocket.Socket) < 1 then -{$ENDIF} - begin - SSLCheck; - Exit; - end; - if SNIHost<>'' then - SSLCtrl(Fssl, SSL_CTRL_SET_TLSEXT_HOSTNAME, TLSEXT_NAMETYPE_host_name, PAnsiChar(AnsiString(SNIHost))); - if FSocket.ConnectionTimeout <= 0 then //do blocking call of SSL_Connect - begin - x := sslconnect(FSsl); - if x < 1 then - begin - SSLcheck; - Exit; - end; - end - else //do non-blocking call of SSL_Connect - begin - b := Fsocket.NonBlockMode; - Fsocket.NonBlockMode := true; - repeat - x := sslconnect(FSsl); - err := SslGetError(FSsl, x); - if err = SSL_ERROR_WANT_READ then - if not FSocket.CanRead(FSocket.ConnectionTimeout) then - break; - if err = SSL_ERROR_WANT_WRITE then - if not FSocket.CanWrite(FSocket.ConnectionTimeout) then - break; - until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE); - Fsocket.NonBlockMode := b; - if err <> SSL_ERROR_NONE then - begin - SSLcheck; - Exit; - end; - end; - if FverifyCert then - if (GetVerifyCert <> 0) or (not DoVerifyCert) then - Exit; - FSSLEnabled := True; - Result := True; - end; -end; - -function TSSLOpenSSL.Accept: boolean; -var - x: integer; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(True) then - begin -{$IFDEF CIL} - if sslsetfd(FSsl, FSocket.Socket.Handle.ToInt32) < 1 then -{$ELSE} - if sslsetfd(FSsl, FSocket.Socket) < 1 then -{$ENDIF} - begin - SSLCheck; - Exit; - end; - x := sslAccept(FSsl); - if x < 1 then - begin - SSLcheck; - Exit; - end; - FSSLEnabled := True; - Result := True; - end; -end; - -function TSSLOpenSSL.Shutdown: boolean; -begin - if assigned(FSsl) then - sslshutdown(FSsl); - DeInit; - Result := True; -end; - -function TSSLOpenSSL.BiShutdown: boolean; -var - x: integer; -begin - if assigned(FSsl) then - begin - x := sslshutdown(FSsl); - if x = 0 then - begin - Synsock.Shutdown(FSocket.Socket, 1); - sslshutdown(FSsl); - end; - end; - DeInit; - Result := True; -end; - -function TSSLOpenSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer; -var - err: integer; -{$IFDEF CIL} - s: ansistring; -{$ENDIF} -begin - FLastError := 0; - FLastErrorDesc := ''; - repeat -{$IFDEF CIL} - s := StringOf(Buffer); - Result := SslWrite(FSsl, s, Len); -{$ELSE} - Result := SslWrite(FSsl, Buffer , Len); -{$ENDIF} - err := SslGetError(FSsl, Result); - until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE); - if err = SSL_ERROR_ZERO_RETURN then - Result := 0 - else - if (err <> 0) then - FLastError := err; -end; - -function TSSLOpenSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -var - err: integer; -{$IFDEF CIL} - sb: stringbuilder; - s: ansistring; -{$ENDIF} -begin - FLastError := 0; - FLastErrorDesc := ''; - repeat -{$IFDEF CIL} - sb := StringBuilder.Create(Len); - Result := SslRead(FSsl, sb, Len); - if Result > 0 then - begin - sb.Length := Result; - s := sb.ToString; - System.Array.Copy(BytesOf(s), Buffer, length(s)); - end; -{$ELSE} - Result := SslRead(FSsl, Buffer , Len); -{$ENDIF} - err := SslGetError(FSsl, Result); - until (err <> SSL_ERROR_WANT_READ) and (err <> SSL_ERROR_WANT_WRITE); - if err = SSL_ERROR_ZERO_RETURN then - Result := 0 - {pf}// Verze 1.1.0 byla s else tak jak to ted mam, - // ve verzi 1.1.1 bylo ELSE zruseno, ale pak je SSL_ERROR_ZERO_RETURN - // propagovano jako Chyba. - {pf} else {/pf} if (err <> 0) then - FLastError := err; -end; - -function TSSLOpenSSL.WaitingData: Integer; -begin - Result := sslpending(Fssl); -end; - -function TSSLOpenSSL.GetSSLVersion: string; -begin - if not assigned(FSsl) then - Result := '' - else - Result := SSlGetVersion(FSsl); -end; - -function TSSLOpenSSL.GetPeerSubject: string; -var - cert: PX509; - s: ansistring; -{$IFDEF CIL} - sb: StringBuilder; -{$ENDIF} -begin - if not assigned(FSsl) then - begin - Result := ''; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - if not assigned(cert) then - begin - Result := ''; - Exit; - end; -{$IFDEF CIL} - sb := StringBuilder.Create(4096); - Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096); -{$ELSE} - setlength(s, 4096); - Result := X509NameOneline(X509GetSubjectName(cert), s, Length(s)); -{$ENDIF} - X509Free(cert); -end; - - -function TSSLOpenSSL.GetPeerSerialNo: integer; {pf} -var - cert: PX509; - SN: PASN1_INTEGER; -begin - if not assigned(FSsl) then - begin - Result := -1; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - try - if not assigned(cert) then - begin - Result := -1; - Exit; - end; - SN := X509GetSerialNumber(cert); - Result := Asn1IntegerGet(SN); - finally - X509Free(cert); - end; -end; - -function TSSLOpenSSL.GetPeerName: string; -var - s: ansistring; -begin - s := GetPeerSubject; - s := SeparateRight(s, '/CN='); - Result := Trim(SeparateLeft(s, '/')); -end; - -function TSSLOpenSSL.GetPeerNameHash: cardinal; {pf} -var - cert: PX509; -begin - if not assigned(FSsl) then - begin - Result := 0; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - try - if not assigned(cert) then - begin - Result := 0; - Exit; - end; - Result := X509NameHash(X509GetSubjectName(cert)); - finally - X509Free(cert); - end; -end; - -function TSSLOpenSSL.GetPeerIssuer: string; -var - cert: PX509; - s: ansistring; -{$IFDEF CIL} - sb: StringBuilder; -{$ENDIF} -begin - if not assigned(FSsl) then - begin - Result := ''; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - if not assigned(cert) then - begin - Result := ''; - Exit; - end; -{$IFDEF CIL} - sb := StringBuilder.Create(4096); - Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096); -{$ELSE} - setlength(s, 4096); - Result := X509NameOneline(X509GetIssuerName(cert), s, Length(s)); -{$ENDIF} - X509Free(cert); -end; - -function TSSLOpenSSL.GetPeerFingerprint: string; -var - cert: PX509; - x: integer; -{$IFDEF CIL} - sb: StringBuilder; -{$ENDIF} -begin - if not assigned(FSsl) then - begin - Result := ''; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - if not assigned(cert) then - begin - Result := ''; - Exit; - end; -{$IFDEF CIL} - sb := StringBuilder.Create(EVP_MAX_MD_SIZE); - X509Digest(cert, EvpGetDigestByName('MD5'), sb, x); - sb.Length := x; - Result := sb.ToString; -{$ELSE} - setlength(Result, EVP_MAX_MD_SIZE); - X509Digest(cert, EvpGetDigestByName('MD5'), Result, x); - SetLength(Result, x); -{$ENDIF} - X509Free(cert); -end; - -function TSSLOpenSSL.GetCertInfo: string; -var - cert: PX509; - x, y: integer; - b: PBIO; - s: AnsiString; -{$IFDEF CIL} - sb: stringbuilder; -{$ENDIF} -begin - if not assigned(FSsl) then - begin - Result := ''; - Exit; - end; - cert := SSLGetPeerCertificate(Fssl); - if not assigned(cert) then - begin - Result := ''; - Exit; - end; - try {pf} - b := BioNew(BioSMem); - try - X509Print(b, cert); - x := bioctrlpending(b); - {$IFDEF CIL} - sb := StringBuilder.Create(x); - y := bioread(b, sb, x); - if y > 0 then - begin - sb.Length := y; - s := sb.ToString; - end; - {$ELSE} - setlength(s,x); - y := bioread(b,s,x); - if y > 0 then - setlength(s, y); - {$ENDIF} - Result := ReplaceString(s, LF, CRLF); - finally - BioFreeAll(b); - end; - {pf} - finally - X509Free(cert); - end; - {/pf} -end; - -function TSSLOpenSSL.GetCipherName: string; -begin - if not assigned(FSsl) then - Result := '' - else - Result := SslCipherGetName(SslGetCurrentCipher(FSsl)); -end; - -function TSSLOpenSSL.GetCipherBits: integer; -var - x: integer; -begin - if not assigned(FSsl) then - Result := 0 - else - Result := SSLCipherGetBits(SslGetCurrentCipher(FSsl), x); -end; - -function TSSLOpenSSL.GetCipherAlgBits: integer; -begin - if not assigned(FSsl) then - Result := 0 - else - SSLCipherGetBits(SslGetCurrentCipher(FSsl), Result); -end; - -function TSSLOpenSSL.GetVerifyCert: integer; -begin - if not assigned(FSsl) then - Result := 1 - else - Result := SslGetVerifyResult(FSsl); -end; - -{==============================================================================} - -initialization - if InitSSLInterface then - SSLImplementation := TSSLOpenSSL; - -end. diff --git a/3rd/synapse/source/ssl_openssl_lib.pas b/3rd/synapse/source/ssl_openssl_lib.pas deleted file mode 100644 index 9fa6e8cd7..000000000 --- a/3rd/synapse/source/ssl_openssl_lib.pas +++ /dev/null @@ -1,2160 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 003.007.002 | -|==============================================================================| -| Content: SSL support by OpenSSL | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2002-2013. | -| Portions created by Petr Fejfar are Copyright (c)2011-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Tomas Hajny (OS2 support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{ -Special thanks to Gregor Ibic - (Intelicom d.o.o., http://www.intelicom.si) - for good inspiration about begin with SSL programming. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$IFDEF VER125} - {$DEFINE BCB} -{$ENDIF} -{$IFDEF BCB} - {$ObjExportAll On} - (*$HPPEMIT 'namespace ssl_openssl_lib { using System::Shortint; }' *) -{$ENDIF} - -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{:@abstract(OpenSSL support) - -This unit is Pascal interface to OpenSSL library (used by @link(ssl_openssl) unit). -OpenSSL is loaded dynamicly on-demand. If this library is not found in system, -requested OpenSSL function just return errorcode. -} -unit ssl_openssl_lib; - -interface - -uses -{$IFDEF CIL} - System.Runtime.InteropServices, - System.Text, -{$ENDIF} - Classes, - synafpc, -{$IFNDEF MSWINDOWS} - {$IFDEF FPC} - {$IFDEF UNIX} - BaseUnix, - {$ENDIF UNIX} - {$ELSE} - Libc, - {$ENDIF} - SysUtils; -{$ELSE} - Windows; -{$ENDIF} - - -{$IFDEF CIL} -const - {$IFDEF LINUX} - DLLSSLName = 'libssl.so'; - DLLUtilName = 'libcrypto.so'; - {$ELSE} - DLLSSLName = 'ssleay32.dll'; - DLLUtilName = 'libeay32.dll'; - {$ENDIF} -{$ELSE} -var - {$IFNDEF MSWINDOWS} - {$IFDEF DARWIN} - DLLSSLName: string = 'libssl.dylib'; - DLLUtilName: string = 'libcrypto.dylib'; - {$ELSE} - {$IFDEF OS2} - {$IFDEF OS2GCC} - DLLSSLName: string = 'kssl.dll'; - DLLUtilName: string = 'kcrypto.dll'; - {$ELSE OS2GCC} - DLLSSLName: string = 'ssl.dll'; - DLLUtilName: string = 'crypto.dll'; - {$ENDIF OS2GCC} - {$ELSE OS2} - DLLSSLName: string = 'libssl.so'; - DLLUtilName: string = 'libcrypto.so'; - {$ENDIF OS2} - {$ENDIF} - {$ELSE} - DLLSSLName: string = 'ssleay32.dll'; - DLLSSLName2: string = 'libssl32.dll'; - DLLUtilName: string = 'libeay32.dll'; - {$ENDIF} -{$ENDIF} - -type -{$IFDEF CIL} - SslPtr = IntPtr; -{$ELSE} - SslPtr = Pointer; -{$ENDIF} - PSslPtr = ^SslPtr; - PSSL_CTX = SslPtr; - PSSL = SslPtr; - PSSL_METHOD = SslPtr; - PX509 = SslPtr; - PX509_NAME = SslPtr; - PEVP_MD = SslPtr; - PInteger = ^Integer; - PBIO_METHOD = SslPtr; - PBIO = SslPtr; - EVP_PKEY = SslPtr; - PRSA = SslPtr; - PASN1_UTCTIME = SslPtr; - PASN1_INTEGER = SslPtr; - PPasswdCb = SslPtr; - PFunction = procedure; - PSTACK = SslPtr; {pf} - TSkPopFreeFunc = procedure(p:SslPtr); cdecl; {pf} - TX509Free = procedure(x: PX509); cdecl; {pf} - - DES_cblock = array[0..7] of Byte; - PDES_cblock = ^DES_cblock; - des_ks_struct = packed record - ks: DES_cblock; - weak_key: Integer; - end; - des_key_schedule = array[1..16] of des_ks_struct; - -const - EVP_MAX_MD_SIZE = 16 + 20; - - SSL_ERROR_NONE = 0; - SSL_ERROR_SSL = 1; - SSL_ERROR_WANT_READ = 2; - SSL_ERROR_WANT_WRITE = 3; - SSL_ERROR_WANT_X509_LOOKUP = 4; - SSL_ERROR_SYSCALL = 5; //look at error stack/return value/errno - SSL_ERROR_ZERO_RETURN = 6; - SSL_ERROR_WANT_CONNECT = 7; - SSL_ERROR_WANT_ACCEPT = 8; - - SSL_OP_NO_SSLv2 = $01000000; - SSL_OP_NO_SSLv3 = $02000000; - SSL_OP_NO_TLSv1 = $04000000; - SSL_OP_ALL = $000FFFFF; - SSL_VERIFY_NONE = $00; - SSL_VERIFY_PEER = $01; - - OPENSSL_DES_DECRYPT = 0; - OPENSSL_DES_ENCRYPT = 1; - - X509_V_OK = 0; - X509_V_ILLEGAL = 1; - X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT = 2; - X509_V_ERR_UNABLE_TO_GET_CRL = 3; - X509_V_ERR_UNABLE_TO_DECRYPT_CERT_SIGNATURE = 4; - X509_V_ERR_UNABLE_TO_DECRYPT_CRL_SIGNATURE = 5; - X509_V_ERR_UNABLE_TO_DECODE_ISSUER_PUBLIC_KEY = 6; - X509_V_ERR_CERT_SIGNATURE_FAILURE = 7; - X509_V_ERR_CRL_SIGNATURE_FAILURE = 8; - X509_V_ERR_CERT_NOT_YET_VALID = 9; - X509_V_ERR_CERT_HAS_EXPIRED = 10; - X509_V_ERR_CRL_NOT_YET_VALID = 11; - X509_V_ERR_CRL_HAS_EXPIRED = 12; - X509_V_ERR_ERROR_IN_CERT_NOT_BEFORE_FIELD = 13; - X509_V_ERR_ERROR_IN_CERT_NOT_AFTER_FIELD = 14; - X509_V_ERR_ERROR_IN_CRL_LAST_UPDATE_FIELD = 15; - X509_V_ERR_ERROR_IN_CRL_NEXT_UPDATE_FIELD = 16; - X509_V_ERR_OUT_OF_MEM = 17; - X509_V_ERR_DEPTH_ZERO_SELF_SIGNED_CERT = 18; - X509_V_ERR_SELF_SIGNED_CERT_IN_CHAIN = 19; - X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT_LOCALLY = 20; - X509_V_ERR_UNABLE_TO_VERIFY_LEAF_SIGNATURE = 21; - X509_V_ERR_CERT_CHAIN_TOO_LONG = 22; - X509_V_ERR_CERT_REVOKED = 23; - X509_V_ERR_INVALID_CA = 24; - X509_V_ERR_PATH_LENGTH_EXCEEDED = 25; - X509_V_ERR_INVALID_PURPOSE = 26; - X509_V_ERR_CERT_UNTRUSTED = 27; - X509_V_ERR_CERT_REJECTED = 28; - //These are 'informational' when looking for issuer cert - X509_V_ERR_SUBJECT_ISSUER_MISMATCH = 29; - X509_V_ERR_AKID_SKID_MISMATCH = 30; - X509_V_ERR_AKID_ISSUER_SERIAL_MISMATCH = 31; - X509_V_ERR_KEYUSAGE_NO_CERTSIGN = 32; - X509_V_ERR_UNABLE_TO_GET_CRL_ISSUER = 33; - X509_V_ERR_UNHANDLED_CRITICAL_EXTENSION = 34; - //The application is not happy - X509_V_ERR_APPLICATION_VERIFICATION = 50; - - SSL_FILETYPE_ASN1 = 2; - SSL_FILETYPE_PEM = 1; - EVP_PKEY_RSA = 6; - - SSL_CTRL_SET_TLSEXT_HOSTNAME = 55; - TLSEXT_NAMETYPE_host_name = 0; - -var - SSLLibHandle: TLibHandle = 0; - SSLUtilHandle: TLibHandle = 0; - SSLLibFile: string = ''; - SSLUtilFile: string = ''; - -{$IFDEF CIL} - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_get_error')] - function SslGetError(s: PSSL; ret_code: Integer): Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_library_init')] - function SslLibraryInit: Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_load_error_strings')] - procedure SslLoadErrorStrings; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_set_cipher_list')] - function SslCtxSetCipherList(arg0: PSSL_CTX; var str: String): Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_new')] - function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_free')] - procedure SslCtxFree (arg0: PSSL_CTX); external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_set_fd')] - function SslSetFd(s: PSSL; fd: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSLv2_method')] - function SslMethodV2 : PSSL_METHOD; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSLv3_method')] - function SslMethodV3 : PSSL_METHOD; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'TLSv1_method')] - function SslMethodTLSV1:PSSL_METHOD; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSLv23_method')] - function SslMethodV23 : PSSL_METHOD; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_PrivateKey')] - function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_PrivateKey_ASN1')] - function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: String; len: integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_RSAPrivateKey_file')] - function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_certificate')] - function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_certificate_ASN1')] - function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: String):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_certificate_file')] - function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: String; _type: Integer):Integer;external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_use_certificate_chain_file')] - function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: String):Integer;external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_check_private_key')] - function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_set_default_passwd_cb')] - procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_set_default_passwd_cb_userdata')] - procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: IntPtr); external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_load_verify_locations')] - function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; CAfile: string; CApath: String):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_ctrl')] - function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: IntPtr): integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_new')] - function SslNew(ctx: PSSL_CTX):PSSL; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_free')] - procedure SslFree(ssl: PSSL); external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_accept')] - function SslAccept(ssl: PSSL):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_connect')] - function SslConnect(ssl: PSSL):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_shutdown')] - function SslShutdown(s: PSSL):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_read')] - function SslRead(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_peek')] - function SslPeek(ssl: PSSL; buf: StringBuilder; num: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_write')] - function SslWrite(ssl: PSSL; buf: String; num: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_pending')] - function SslPending(ssl: PSSL):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_get_version')] - function SslGetVersion(ssl: PSSL):String; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_get_peer_certificate')] - function SslGetPeerCertificate(s: PSSL):PX509; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CTX_set_verify')] - procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_get_current_cipher')] - function SSLGetCurrentCipher(s: PSSL): SslPtr; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CIPHER_get_name')] - function SSLCipherGetName(c: SslPtr):String; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_CIPHER_get_bits')] - function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer; external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_get_verify_result')] - function SSLGetVerifyResult(ssl: PSSL):Integer;external; - - [DllImport(DLLSSLName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSL_ctrl')] - function SslCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: IntPtr): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_new')] - function X509New: PX509; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_free')] - procedure X509Free(x: PX509); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_NAME_oneline')] - function X509NameOneline(a: PX509_NAME; buf: StringBuilder; size: Integer): String; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_get_subject_name')] - function X509GetSubjectName(a: PX509):PX509_NAME; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_get_issuer_name')] - function X509GetIssuerName(a: PX509):PX509_NAME; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_NAME_hash')] - function X509NameHash(x: PX509_NAME):Cardinal; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_digest')] - function X509Digest (data: PX509; _type: PEVP_MD; md: StringBuilder; var len: Integer):Integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_set_version')] - function X509SetVersion(x: PX509; version: integer): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_set_pubkey')] - function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_set_issuer_name')] - function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_NAME_add_entry_by_txt')] - function X509NameAddEntryByTxt(name: PX509_NAME; field: string; _type: integer; - bytes: string; len, loc, _set: integer): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_sign')] - function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_print')] - function X509print(b: PBIO; a: PX509): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_gmtime_adj')] - function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_set_notBefore')] - function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_set_notAfter')] - function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'X509_get_serialNumber')] - function X509GetSerialNumber(x: PX509): PASN1_INTEGER; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'EVP_PKEY_new')] - function EvpPkeyNew: EVP_PKEY; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'EVP_PKEY_free')] - procedure EvpPkeyFree(pk: EVP_PKEY); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'EVP_PKEY_assign')] - function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'EVP_get_digestbyname')] - function EvpGetDigestByName(Name: String): PEVP_MD; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'EVP_cleanup')] - procedure EVPcleanup; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'SSLeay_version')] - function SSLeayversion(t: integer): String; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ERR_error_string_n')] - procedure ErrErrorString(e: integer; buf: StringBuilder; len: integer); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ERR_get_error')] - function ErrGetError: integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ERR_clear_error')] - procedure ErrClearError; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ERR_free_strings')] - procedure ErrFreeStrings; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ERR_remove_state')] - procedure ErrRemoveState(pid: integer); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'OPENSSL_add_all_algorithms_noconf')] - procedure OPENSSLaddallalgorithms; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'CRYPTO_cleanup_all_ex_data')] - procedure CRYPTOcleanupAllExData; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'RAND_screen')] - procedure RandScreen; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_new')] - function BioNew(b: PBIO_METHOD): PBIO; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_free_all')] - procedure BioFreeAll(b: PBIO); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_s_mem')] - function BioSMem: PBIO_METHOD; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_ctrl_pending')] - function BioCtrlPending(b: PBIO): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_read')] - function BioRead(b: PBIO; Buf: StringBuilder; Len: integer): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'BIO_write')] - function BioWrite(b: PBIO; var Buf: String; Len: integer): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'd2i_PKCS12_bio')] - function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'PKCS12_parse')] - function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'PKCS12_free')] - procedure PKCS12free(p12: SslPtr); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'RSA_generate_key')] - function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ASN1_UTCTIME_new')] - function Asn1UtctimeNew: PASN1_UTCTIME; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ASN1_UTCTIME_free')] - procedure Asn1UtctimeFree(a: PASN1_UTCTIME); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'ASN1_INTEGER_set')] - function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'i2d_X509_bio')] - function i2dX509bio(b: PBIO; x: PX509): integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'i2d_PrivateKey_bio')] - function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; external; - - // 3DES functions - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'DES_set_odd_parity')] - procedure DESsetoddparity(Key: des_cblock); external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'DES_set_key_checked')] - function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; external; - - [DllImport(DLLUtilName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'DES_ecb_encrypt')] - procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); external; - -{$ELSE} -// libssl.dll - function SslGetError(s: PSSL; ret_code: Integer):Integer; - function SslLibraryInit:Integer; - procedure SslLoadErrorStrings; -// function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer; - function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer; - function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX; - procedure SslCtxFree(arg0: PSSL_CTX); - function SslSetFd(s: PSSL; fd: Integer):Integer; - function SslMethodV2:PSSL_METHOD; - function SslMethodV3:PSSL_METHOD; - function SslMethodTLSV1:PSSL_METHOD; - function SslMethodV23:PSSL_METHOD; - function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer; - function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer; -// function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; - function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer; - function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; - function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer; - function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer; -// function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer; - function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer; - function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; - procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); - procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr); -// function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer; - function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer; - function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; - function SslNew(ctx: PSSL_CTX):PSSL; - procedure SslFree(ssl: PSSL); - function SslAccept(ssl: PSSL):Integer; - function SslConnect(ssl: PSSL):Integer; - function SslShutdown(ssl: PSSL):Integer; - function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer; - function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer; - function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer; - function SslPending(ssl: PSSL):Integer; - function SslGetVersion(ssl: PSSL):AnsiString; - function SslGetPeerCertificate(ssl: PSSL):PX509; - procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); - function SSLGetCurrentCipher(s: PSSL):SslPtr; - function SSLCipherGetName(c: SslPtr): AnsiString; - function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer; - function SSLGetVerifyResult(ssl: PSSL):Integer; - function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; - -// libeay.dll - function X509New: PX509; - procedure X509Free(x: PX509); - function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString; - function X509GetSubjectName(a: PX509):PX509_NAME; - function X509GetIssuerName(a: PX509):PX509_NAME; - function X509NameHash(x: PX509_NAME):Cardinal; -// function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer; - function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer; - function X509print(b: PBIO; a: PX509): integer; - function X509SetVersion(x: PX509; version: integer): integer; - function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; - function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; - function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer; - bytes: Ansistring; len, loc, _set: integer): integer; - function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; - function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; - function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; - function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; - function X509GetSerialNumber(x: PX509): PASN1_INTEGER; - function EvpPkeyNew: EVP_PKEY; - procedure EvpPkeyFree(pk: EVP_PKEY); - function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; - function EvpGetDigestByName(Name: AnsiString): PEVP_MD; - procedure EVPcleanup; -// function ErrErrorString(e: integer; buf: PChar): PChar; - function SSLeayversion(t: integer): Ansistring; - procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer); - function ErrGetError: integer; - procedure ErrClearError; - procedure ErrFreeStrings; - procedure ErrRemoveState(pid: integer); - procedure OPENSSLaddallalgorithms; - procedure CRYPTOcleanupAllExData; - procedure RandScreen; - function BioNew(b: PBIO_METHOD): PBIO; - procedure BioFreeAll(b: PBIO); - function BioSMem: PBIO_METHOD; - function BioCtrlPending(b: PBIO): integer; - function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer; - function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer; - function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; - function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer; - procedure PKCS12free(p12: SslPtr); - function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; - function Asn1UtctimeNew: PASN1_UTCTIME; - procedure Asn1UtctimeFree(a: PASN1_UTCTIME); - function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; - function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf} - function i2dX509bio(b: PBIO; x: PX509): integer; - function d2iX509bio(b:PBIO; x:PX509): PX509; {pf} - function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr): PX509; {pf} - procedure SkX509PopFree(st: PSTACK; func: TSkPopFreeFunc); {pf} - - - function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; - - // 3DES functions - procedure DESsetoddparity(Key: des_cblock); - function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; - procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); - -{$ENDIF} - -function IsSSLloaded: Boolean; -function InitSSLInterface: Boolean; -function DestroySSLInterface: Boolean; - -var - _X509Free: TX509Free = nil; {pf} - -implementation - -uses -{$IFDEF OS2} - Sockets, -{$ENDIF OS2} - SyncObjs; - -{$IFNDEF CIL} -type -// libssl.dll - TSslGetError = function(s: PSSL; ret_code: Integer):Integer; cdecl; - TSslLibraryInit = function:Integer; cdecl; - TSslLoadErrorStrings = procedure; cdecl; - TSslCtxSetCipherList = function(arg0: PSSL_CTX; str: PAnsiChar):Integer; cdecl; - TSslCtxNew = function(meth: PSSL_METHOD):PSSL_CTX; cdecl; - TSslCtxFree = procedure(arg0: PSSL_CTX); cdecl; - TSslSetFd = function(s: PSSL; fd: Integer):Integer; cdecl; - TSslMethodV2 = function:PSSL_METHOD; cdecl; - TSslMethodV3 = function:PSSL_METHOD; cdecl; - TSslMethodTLSV1 = function:PSSL_METHOD; cdecl; - TSslMethodV23 = function:PSSL_METHOD; cdecl; - TSslCtxUsePrivateKey = function(ctx: PSSL_CTX; pkey: sslptr):Integer; cdecl; - TSslCtxUsePrivateKeyASN1 = function(pk: integer; ctx: PSSL_CTX; d: sslptr; len: integer):Integer; cdecl; - TSslCtxUsePrivateKeyFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl; - TSslCtxUseCertificate = function(ctx: PSSL_CTX; x: SslPtr):Integer; cdecl; - TSslCtxUseCertificateASN1 = function(ctx: PSSL_CTX; len: Integer; d: SslPtr):Integer; cdecl; - TSslCtxUseCertificateFile = function(ctx: PSSL_CTX; const _file: PAnsiChar; _type: Integer):Integer; cdecl; - TSslCtxUseCertificateChainFile = function(ctx: PSSL_CTX; const _file: PAnsiChar):Integer; cdecl; - TSslCtxCheckPrivateKeyFile = function(ctx: PSSL_CTX):Integer; cdecl; - TSslCtxSetDefaultPasswdCb = procedure(ctx: PSSL_CTX; cb: SslPtr); cdecl; - TSslCtxSetDefaultPasswdCbUserdata = procedure(ctx: PSSL_CTX; u: SslPtr); cdecl; - TSslCtxLoadVerifyLocations = function(ctx: PSSL_CTX; const CAfile: PAnsiChar; const CApath: PAnsiChar):Integer; cdecl; - TSslCtxCtrl = function(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; cdecl; - TSslNew = function(ctx: PSSL_CTX):PSSL; cdecl; - TSslFree = procedure(ssl: PSSL); cdecl; - TSslAccept = function(ssl: PSSL):Integer; cdecl; - TSslConnect = function(ssl: PSSL):Integer; cdecl; - TSslShutdown = function(ssl: PSSL):Integer; cdecl; - TSslRead = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl; - TSslPeek = function(ssl: PSSL; buf: PAnsiChar; num: Integer):Integer; cdecl; - TSslWrite = function(ssl: PSSL; const buf: PAnsiChar; num: Integer):Integer; cdecl; - TSslPending = function(ssl: PSSL):Integer; cdecl; - TSslGetVersion = function(ssl: PSSL):PAnsiChar; cdecl; - TSslGetPeerCertificate = function(ssl: PSSL):PX509; cdecl; - TSslCtxSetVerify = procedure(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); cdecl; - TSSLGetCurrentCipher = function(s: PSSL):SslPtr; cdecl; - TSSLCipherGetName = function(c: Sslptr):PAnsiChar; cdecl; - TSSLCipherGetBits = function(c: SslPtr; alg_bits: PInteger):Integer; cdecl; - TSSLGetVerifyResult = function(ssl: PSSL):Integer; cdecl; - TSSLCtrl = function(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; cdecl; - - TSSLSetTlsextHostName = function(ssl: PSSL; buf: PAnsiChar):Integer; cdecl; - -// libeay.dll - TX509New = function: PX509; cdecl; - TX509NameOneline = function(a: PX509_NAME; buf: PAnsiChar; size: Integer):PAnsiChar; cdecl; - TX509GetSubjectName = function(a: PX509):PX509_NAME; cdecl; - TX509GetIssuerName = function(a: PX509):PX509_NAME; cdecl; - TX509NameHash = function(x: PX509_NAME):Cardinal; cdecl; - TX509Digest = function(data: PX509; _type: PEVP_MD; md: PAnsiChar; len: PInteger):Integer; cdecl; - TX509print = function(b: PBIO; a: PX509): integer; cdecl; - TX509SetVersion = function(x: PX509; version: integer): integer; cdecl; - TX509SetPubkey = function(x: PX509; pkey: EVP_PKEY): integer; cdecl; - TX509SetIssuerName = function(x: PX509; name: PX509_NAME): integer; cdecl; - TX509NameAddEntryByTxt = function(name: PX509_NAME; field: PAnsiChar; _type: integer; - bytes: PAnsiChar; len, loc, _set: integer): integer; cdecl; - TX509Sign = function(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; cdecl; - TX509GmtimeAdj = function(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; cdecl; - TX509SetNotBefore = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl; - TX509SetNotAfter = function(x: PX509; tm: PASN1_UTCTIME): integer; cdecl; - TX509GetSerialNumber = function(x: PX509): PASN1_INTEGER; cdecl; - TEvpPkeyNew = function: EVP_PKEY; cdecl; - TEvpPkeyFree = procedure(pk: EVP_PKEY); cdecl; - TEvpPkeyAssign = function(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; cdecl; - TEvpGetDigestByName = function(Name: PAnsiChar): PEVP_MD; cdecl; - TEVPcleanup = procedure; cdecl; - TSSLeayversion = function(t: integer): PAnsiChar; cdecl; - TErrErrorString = procedure(e: integer; buf: PAnsiChar; len: integer); cdecl; - TErrGetError = function: integer; cdecl; - TErrClearError = procedure; cdecl; - TErrFreeStrings = procedure; cdecl; - TErrRemoveState = procedure(pid: integer); cdecl; - TOPENSSLaddallalgorithms = procedure; cdecl; - TCRYPTOcleanupAllExData = procedure; cdecl; - TRandScreen = procedure; cdecl; - TBioNew = function(b: PBIO_METHOD): PBIO; cdecl; - TBioFreeAll = procedure(b: PBIO); cdecl; - TBioSMem = function: PBIO_METHOD; cdecl; - TBioCtrlPending = function(b: PBIO): integer; cdecl; - TBioRead = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl; - TBioWrite = function(b: PBIO; Buf: PAnsiChar; Len: integer): integer; cdecl; - Td2iPKCS12bio = function(b:PBIO; Pkcs12: SslPtr): SslPtr; cdecl; - TPKCS12parse = function(p12: SslPtr; pass: PAnsiChar; var pkey, cert, ca: SslPtr): integer; cdecl; - TPKCS12free = procedure(p12: SslPtr); cdecl; - TRsaGenerateKey = function(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; cdecl; - TAsn1UtctimeNew = function: PASN1_UTCTIME; cdecl; - TAsn1UtctimeFree = procedure(a: PASN1_UTCTIME); cdecl; - TAsn1IntegerSet = function(a: PASN1_INTEGER; v: integer): integer; cdecl; - TAsn1IntegerGet = function(a: PASN1_INTEGER): integer; cdecl; {pf} - Ti2dX509bio = function(b: PBIO; x: PX509): integer; cdecl; - Td2iX509bio = function(b:PBIO; x:PX509): PX509; cdecl; {pf} - TPEMReadBioX509 = function(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg:SslPtr): PX509; cdecl; {pf} - TSkX509PopFree = procedure(st: PSTACK; func: TSkPopFreeFunc); cdecl; {pf} - Ti2dPrivateKeyBio= function(b: PBIO; pkey: EVP_PKEY): integer; cdecl; - - // 3DES functions - TDESsetoddparity = procedure(Key: des_cblock); cdecl; - TDESsetkeychecked = function(key: des_cblock; schedule: des_key_schedule): Integer; cdecl; - TDESecbencrypt = procedure(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); cdecl; - //thread lock functions - TCRYPTOnumlocks = function: integer; cdecl; - TCRYPTOSetLockingCallback = procedure(cb: Sslptr); cdecl; - -var -// libssl.dll - _SslGetError: TSslGetError = nil; - _SslLibraryInit: TSslLibraryInit = nil; - _SslLoadErrorStrings: TSslLoadErrorStrings = nil; - _SslCtxSetCipherList: TSslCtxSetCipherList = nil; - _SslCtxNew: TSslCtxNew = nil; - _SslCtxFree: TSslCtxFree = nil; - _SslSetFd: TSslSetFd = nil; - _SslMethodV2: TSslMethodV2 = nil; - _SslMethodV3: TSslMethodV3 = nil; - _SslMethodTLSV1: TSslMethodTLSV1 = nil; - _SslMethodV23: TSslMethodV23 = nil; - _SslCtxUsePrivateKey: TSslCtxUsePrivateKey = nil; - _SslCtxUsePrivateKeyASN1: TSslCtxUsePrivateKeyASN1 = nil; - _SslCtxUsePrivateKeyFile: TSslCtxUsePrivateKeyFile = nil; - _SslCtxUseCertificate: TSslCtxUseCertificate = nil; - _SslCtxUseCertificateASN1: TSslCtxUseCertificateASN1 = nil; - _SslCtxUseCertificateFile: TSslCtxUseCertificateFile = nil; - _SslCtxUseCertificateChainFile: TSslCtxUseCertificateChainFile = nil; - _SslCtxCheckPrivateKeyFile: TSslCtxCheckPrivateKeyFile = nil; - _SslCtxSetDefaultPasswdCb: TSslCtxSetDefaultPasswdCb = nil; - _SslCtxSetDefaultPasswdCbUserdata: TSslCtxSetDefaultPasswdCbUserdata = nil; - _SslCtxLoadVerifyLocations: TSslCtxLoadVerifyLocations = nil; - _SslCtxCtrl: TSslCtxCtrl = nil; - _SslNew: TSslNew = nil; - _SslFree: TSslFree = nil; - _SslAccept: TSslAccept = nil; - _SslConnect: TSslConnect = nil; - _SslShutdown: TSslShutdown = nil; - _SslRead: TSslRead = nil; - _SslPeek: TSslPeek = nil; - _SslWrite: TSslWrite = nil; - _SslPending: TSslPending = nil; - _SslGetVersion: TSslGetVersion = nil; - _SslGetPeerCertificate: TSslGetPeerCertificate = nil; - _SslCtxSetVerify: TSslCtxSetVerify = nil; - _SSLGetCurrentCipher: TSSLGetCurrentCipher = nil; - _SSLCipherGetName: TSSLCipherGetName = nil; - _SSLCipherGetBits: TSSLCipherGetBits = nil; - _SSLGetVerifyResult: TSSLGetVerifyResult = nil; - _SSLCtrl: TSSLCtrl = nil; - -// libeay.dll - _X509New: TX509New = nil; - _X509NameOneline: TX509NameOneline = nil; - _X509GetSubjectName: TX509GetSubjectName = nil; - _X509GetIssuerName: TX509GetIssuerName = nil; - _X509NameHash: TX509NameHash = nil; - _X509Digest: TX509Digest = nil; - _X509print: TX509print = nil; - _X509SetVersion: TX509SetVersion = nil; - _X509SetPubkey: TX509SetPubkey = nil; - _X509SetIssuerName: TX509SetIssuerName = nil; - _X509NameAddEntryByTxt: TX509NameAddEntryByTxt = nil; - _X509Sign: TX509Sign = nil; - _X509GmtimeAdj: TX509GmtimeAdj = nil; - _X509SetNotBefore: TX509SetNotBefore = nil; - _X509SetNotAfter: TX509SetNotAfter = nil; - _X509GetSerialNumber: TX509GetSerialNumber = nil; - _EvpPkeyNew: TEvpPkeyNew = nil; - _EvpPkeyFree: TEvpPkeyFree = nil; - _EvpPkeyAssign: TEvpPkeyAssign = nil; - _EvpGetDigestByName: TEvpGetDigestByName = nil; - _EVPcleanup: TEVPcleanup = nil; - _SSLeayversion: TSSLeayversion = nil; - _ErrErrorString: TErrErrorString = nil; - _ErrGetError: TErrGetError = nil; - _ErrClearError: TErrClearError = nil; - _ErrFreeStrings: TErrFreeStrings = nil; - _ErrRemoveState: TErrRemoveState = nil; - _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil; - _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil; - _RandScreen: TRandScreen = nil; - _BioNew: TBioNew = nil; - _BioFreeAll: TBioFreeAll = nil; - _BioSMem: TBioSMem = nil; - _BioCtrlPending: TBioCtrlPending = nil; - _BioRead: TBioRead = nil; - _BioWrite: TBioWrite = nil; - _d2iPKCS12bio: Td2iPKCS12bio = nil; - _PKCS12parse: TPKCS12parse = nil; - _PKCS12free: TPKCS12free = nil; - _RsaGenerateKey: TRsaGenerateKey = nil; - _Asn1UtctimeNew: TAsn1UtctimeNew = nil; - _Asn1UtctimeFree: TAsn1UtctimeFree = nil; - _Asn1IntegerSet: TAsn1IntegerSet = nil; - _Asn1IntegerGet: TAsn1IntegerGet = nil; {pf} - _i2dX509bio: Ti2dX509bio = nil; - _d2iX509bio: Td2iX509bio = nil; {pf} - _PEMReadBioX509: TPEMReadBioX509 = nil; {pf} - _SkX509PopFree: TSkX509PopFree = nil; {pf} - _i2dPrivateKeyBio: Ti2dPrivateKeyBio = nil; - - // 3DES functions - _DESsetoddparity: TDESsetoddparity = nil; - _DESsetkeychecked: TDESsetkeychecked = nil; - _DESecbencrypt: TDESecbencrypt = nil; - //thread lock functions - _CRYPTOnumlocks: TCRYPTOnumlocks = nil; - _CRYPTOSetLockingCallback: TCRYPTOSetLockingCallback = nil; -{$ENDIF} - -var - SSLCS: TCriticalSection; - SSLloaded: boolean = false; -{$IFNDEF CIL} - Locks: TList; -{$ENDIF} - -{$IFNDEF CIL} -// libssl.dll -function SslGetError(s: PSSL; ret_code: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslGetError) then - Result := _SslGetError(s, ret_code) - else - Result := SSL_ERROR_SSL; -end; - -function SslLibraryInit:Integer; -begin - if InitSSLInterface and Assigned(_SslLibraryInit) then - Result := _SslLibraryInit - else - Result := 1; -end; - -procedure SslLoadErrorStrings; -begin - if InitSSLInterface and Assigned(_SslLoadErrorStrings) then - _SslLoadErrorStrings; -end; - -//function SslCtxSetCipherList(arg0: PSSL_CTX; str: PChar):Integer; -function SslCtxSetCipherList(arg0: PSSL_CTX; var str: AnsiString):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxSetCipherList) then - Result := _SslCtxSetCipherList(arg0, PAnsiChar(str)) - else - Result := 0; -end; - -function SslCtxNew(meth: PSSL_METHOD):PSSL_CTX; -begin - if InitSSLInterface and Assigned(_SslCtxNew) then - Result := _SslCtxNew(meth) - else - Result := nil; -end; - -procedure SslCtxFree(arg0: PSSL_CTX); -begin - if InitSSLInterface and Assigned(_SslCtxFree) then - _SslCtxFree(arg0); -end; - -function SslSetFd(s: PSSL; fd: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslSetFd) then - Result := _SslSetFd(s, fd) - else - Result := 0; -end; - -function SslMethodV2:PSSL_METHOD; -begin - if InitSSLInterface and Assigned(_SslMethodV2) then - Result := _SslMethodV2 - else - Result := nil; -end; - -function SslMethodV3:PSSL_METHOD; -begin - if InitSSLInterface and Assigned(_SslMethodV3) then - Result := _SslMethodV3 - else - Result := nil; -end; - -function SslMethodTLSV1:PSSL_METHOD; -begin - if InitSSLInterface and Assigned(_SslMethodTLSV1) then - Result := _SslMethodTLSV1 - else - Result := nil; -end; - -function SslMethodV23:PSSL_METHOD; -begin - if InitSSLInterface and Assigned(_SslMethodV23) then - Result := _SslMethodV23 - else - Result := nil; -end; - -function SslCtxUsePrivateKey(ctx: PSSL_CTX; pkey: SslPtr):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUsePrivateKey) then - Result := _SslCtxUsePrivateKey(ctx, pkey) - else - Result := 0; -end; - -function SslCtxUsePrivateKeyASN1(pk: integer; ctx: PSSL_CTX; d: AnsiString; len: integer):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyASN1) then - Result := _SslCtxUsePrivateKeyASN1(pk, ctx, Sslptr(d), len) - else - Result := 0; -end; - -//function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: PChar; _type: Integer):Integer; -function SslCtxUsePrivateKeyFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUsePrivateKeyFile) then - Result := _SslCtxUsePrivateKeyFile(ctx, PAnsiChar(_file), _type) - else - Result := 0; -end; - -function SslCtxUseCertificate(ctx: PSSL_CTX; x: SslPtr):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUseCertificate) then - Result := _SslCtxUseCertificate(ctx, x) - else - Result := 0; -end; - -function SslCtxUseCertificateASN1(ctx: PSSL_CTX; len: integer; d: AnsiString):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUseCertificateASN1) then - Result := _SslCtxUseCertificateASN1(ctx, len, SslPtr(d)) - else - Result := 0; -end; - -function SslCtxUseCertificateFile(ctx: PSSL_CTX; const _file: AnsiString; _type: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUseCertificateFile) then - Result := _SslCtxUseCertificateFile(ctx, PAnsiChar(_file), _type) - else - Result := 0; -end; - -//function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: PChar):Integer; -function SslCtxUseCertificateChainFile(ctx: PSSL_CTX; const _file: AnsiString):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxUseCertificateChainFile) then - Result := _SslCtxUseCertificateChainFile(ctx, PAnsiChar(_file)) - else - Result := 0; -end; - -function SslCtxCheckPrivateKeyFile(ctx: PSSL_CTX):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxCheckPrivateKeyFile) then - Result := _SslCtxCheckPrivateKeyFile(ctx) - else - Result := 0; -end; - -procedure SslCtxSetDefaultPasswdCb(ctx: PSSL_CTX; cb: PPasswdCb); -begin - if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCb) then - _SslCtxSetDefaultPasswdCb(ctx, cb); -end; - -procedure SslCtxSetDefaultPasswdCbUserdata(ctx: PSSL_CTX; u: SslPtr); -begin - if InitSSLInterface and Assigned(_SslCtxSetDefaultPasswdCbUserdata) then - _SslCtxSetDefaultPasswdCbUserdata(ctx, u); -end; - -//function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: PChar; const CApath: PChar):Integer; -function SslCtxLoadVerifyLocations(ctx: PSSL_CTX; const CAfile: AnsiString; const CApath: AnsiString):Integer; -begin - if InitSSLInterface and Assigned(_SslCtxLoadVerifyLocations) then - Result := _SslCtxLoadVerifyLocations(ctx, SslPtr(CAfile), SslPtr(CApath)) - else - Result := 0; -end; - -function SslCtxCtrl(ctx: PSSL_CTX; cmd: integer; larg: integer; parg: SslPtr): integer; -begin - if InitSSLInterface and Assigned(_SslCtxCtrl) then - Result := _SslCtxCtrl(ctx, cmd, larg, parg) - else - Result := 0; -end; - -function SslNew(ctx: PSSL_CTX):PSSL; -begin - if InitSSLInterface and Assigned(_SslNew) then - Result := _SslNew(ctx) - else - Result := nil; -end; - -procedure SslFree(ssl: PSSL); -begin - if InitSSLInterface and Assigned(_SslFree) then - _SslFree(ssl); -end; - -function SslAccept(ssl: PSSL):Integer; -begin - if InitSSLInterface and Assigned(_SslAccept) then - Result := _SslAccept(ssl) - else - Result := -1; -end; - -function SslConnect(ssl: PSSL):Integer; -begin - if InitSSLInterface and Assigned(_SslConnect) then - Result := _SslConnect(ssl) - else - Result := -1; -end; - -function SslShutdown(ssl: PSSL):Integer; -begin - if InitSSLInterface and Assigned(_SslShutdown) then - Result := _SslShutdown(ssl) - else - Result := -1; -end; - -//function SslRead(ssl: PSSL; buf: PChar; num: Integer):Integer; -function SslRead(ssl: PSSL; buf: SslPtr; num: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslRead) then - Result := _SslRead(ssl, PAnsiChar(buf), num) - else - Result := -1; -end; - -//function SslPeek(ssl: PSSL; buf: PChar; num: Integer):Integer; -function SslPeek(ssl: PSSL; buf: SslPtr; num: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslPeek) then - Result := _SslPeek(ssl, PAnsiChar(buf), num) - else - Result := -1; -end; - -//function SslWrite(ssl: PSSL; const buf: PChar; num: Integer):Integer; -function SslWrite(ssl: PSSL; buf: SslPtr; num: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SslWrite) then - Result := _SslWrite(ssl, PAnsiChar(buf), num) - else - Result := -1; -end; - -function SslPending(ssl: PSSL):Integer; -begin - if InitSSLInterface and Assigned(_SslPending) then - Result := _SslPending(ssl) - else - Result := 0; -end; - -//function SslGetVersion(ssl: PSSL):PChar; -function SslGetVersion(ssl: PSSL):AnsiString; -begin - if InitSSLInterface and Assigned(_SslGetVersion) then - Result := _SslGetVersion(ssl) - else - Result := ''; -end; - -function SslGetPeerCertificate(ssl: PSSL):PX509; -begin - if InitSSLInterface and Assigned(_SslGetPeerCertificate) then - Result := _SslGetPeerCertificate(ssl) - else - Result := nil; -end; - -//procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: SslPtr); -procedure SslCtxSetVerify(ctx: PSSL_CTX; mode: Integer; arg2: PFunction); -begin - if InitSSLInterface and Assigned(_SslCtxSetVerify) then - _SslCtxSetVerify(ctx, mode, @arg2); -end; - -function SSLGetCurrentCipher(s: PSSL):SslPtr; -begin - if InitSSLInterface and Assigned(_SSLGetCurrentCipher) then -{$IFDEF CIL} -{$ELSE} - Result := _SSLGetCurrentCipher(s) -{$ENDIF} - else - Result := nil; -end; - -//function SSLCipherGetName(c: SslPtr):PChar; -function SSLCipherGetName(c: SslPtr):AnsiString; -begin - if InitSSLInterface and Assigned(_SSLCipherGetName) then - Result := _SSLCipherGetName(c) - else - Result := ''; -end; - -//function SSLCipherGetBits(c: SslPtr; alg_bits: PInteger):Integer; -function SSLCipherGetBits(c: SslPtr; var alg_bits: Integer):Integer; -begin - if InitSSLInterface and Assigned(_SSLCipherGetBits) then - Result := _SSLCipherGetBits(c, @alg_bits) - else - Result := 0; -end; - -function SSLGetVerifyResult(ssl: PSSL):Integer; -begin - if InitSSLInterface and Assigned(_SSLGetVerifyResult) then - Result := _SSLGetVerifyResult(ssl) - else - Result := X509_V_ERR_APPLICATION_VERIFICATION; -end; - - -function SSLCtrl(ssl: PSSL; cmd: integer; larg: integer; parg: SslPtr):Integer; -begin - if InitSSLInterface and Assigned(_SSLCtrl) then - Result := _SSLCtrl(ssl, cmd, larg, parg) - else - Result := X509_V_ERR_APPLICATION_VERIFICATION; -end; - -// libeay.dll -function X509New: PX509; -begin - if InitSSLInterface and Assigned(_X509New) then - Result := _X509New - else - Result := nil; -end; - -procedure X509Free(x: PX509); -begin - if InitSSLInterface and Assigned(_X509Free) then - _X509Free(x); -end; - -//function SslX509NameOneline(a: PX509_NAME; buf: PChar; size: Integer):PChar; -function X509NameOneline(a: PX509_NAME; var buf: AnsiString; size: Integer):AnsiString; -begin - if InitSSLInterface and Assigned(_X509NameOneline) then - Result := _X509NameOneline(a, PAnsiChar(buf),size) - else - Result := ''; -end; - -function X509GetSubjectName(a: PX509):PX509_NAME; -begin - if InitSSLInterface and Assigned(_X509GetSubjectName) then - Result := _X509GetSubjectName(a) - else - Result := nil; -end; - -function X509GetIssuerName(a: PX509):PX509_NAME; -begin - if InitSSLInterface and Assigned(_X509GetIssuerName) then - Result := _X509GetIssuerName(a) - else - Result := nil; -end; - -function X509NameHash(x: PX509_NAME):Cardinal; -begin - if InitSSLInterface and Assigned(_X509NameHash) then - Result := _X509NameHash(x) - else - Result := 0; -end; - -//function SslX509Digest(data: PX509; _type: PEVP_MD; md: PChar; len: PInteger):Integer; -function X509Digest(data: PX509; _type: PEVP_MD; md: AnsiString; var len: Integer):Integer; -begin - if InitSSLInterface and Assigned(_X509Digest) then - Result := _X509Digest(data, _type, PAnsiChar(md), @len) - else - Result := 0; -end; - -function EvpPkeyNew: EVP_PKEY; -begin - if InitSSLInterface and Assigned(_EvpPkeyNew) then - Result := _EvpPkeyNew - else - Result := nil; -end; - -procedure EvpPkeyFree(pk: EVP_PKEY); -begin - if InitSSLInterface and Assigned(_EvpPkeyFree) then - _EvpPkeyFree(pk); -end; - -function SSLeayversion(t: integer): Ansistring; -begin - if InitSSLInterface and Assigned(_SSLeayversion) then - Result := PAnsiChar(_SSLeayversion(t)) - else - Result := ''; -end; - -procedure ErrErrorString(e: integer; var buf: Ansistring; len: integer); -begin - if InitSSLInterface and Assigned(_ErrErrorString) then - _ErrErrorString(e, Pointer(buf), len); - buf := PAnsiChar(Buf); -end; - -function ErrGetError: integer; -begin - if InitSSLInterface and Assigned(_ErrGetError) then - Result := _ErrGetError - else - Result := SSL_ERROR_SSL; -end; - -procedure ErrClearError; -begin - if InitSSLInterface and Assigned(_ErrClearError) then - _ErrClearError; -end; - -procedure ErrFreeStrings; -begin - if InitSSLInterface and Assigned(_ErrFreeStrings) then - _ErrFreeStrings; -end; - -procedure ErrRemoveState(pid: integer); -begin - if InitSSLInterface and Assigned(_ErrRemoveState) then - _ErrRemoveState(pid); -end; - -procedure OPENSSLaddallalgorithms; -begin - if InitSSLInterface and Assigned(_OPENSSLaddallalgorithms) then - _OPENSSLaddallalgorithms; -end; - -procedure EVPcleanup; -begin - if InitSSLInterface and Assigned(_EVPcleanup) then - _EVPcleanup; -end; - -procedure CRYPTOcleanupAllExData; -begin - if InitSSLInterface and Assigned(_CRYPTOcleanupAllExData) then - _CRYPTOcleanupAllExData; -end; - -procedure RandScreen; -begin - if InitSSLInterface and Assigned(_RandScreen) then - _RandScreen; -end; - -function BioNew(b: PBIO_METHOD): PBIO; -begin - if InitSSLInterface and Assigned(_BioNew) then - Result := _BioNew(b) - else - Result := nil; -end; - -procedure BioFreeAll(b: PBIO); -begin - if InitSSLInterface and Assigned(_BioFreeAll) then - _BioFreeAll(b); -end; - -function BioSMem: PBIO_METHOD; -begin - if InitSSLInterface and Assigned(_BioSMem) then - Result := _BioSMem - else - Result := nil; -end; - -function BioCtrlPending(b: PBIO): integer; -begin - if InitSSLInterface and Assigned(_BioCtrlPending) then - Result := _BioCtrlPending(b) - else - Result := 0; -end; - -//function BioRead(b: PBIO; Buf: PChar; Len: integer): integer; -function BioRead(b: PBIO; var Buf: AnsiString; Len: integer): integer; -begin - if InitSSLInterface and Assigned(_BioRead) then - Result := _BioRead(b, PAnsiChar(Buf), Len) - else - Result := -2; -end; - -//function BioWrite(b: PBIO; Buf: PChar; Len: integer): integer; -function BioWrite(b: PBIO; Buf: AnsiString; Len: integer): integer; -begin - if InitSSLInterface and Assigned(_BioWrite) then - Result := _BioWrite(b, PAnsiChar(Buf), Len) - else - Result := -2; -end; - -function X509print(b: PBIO; a: PX509): integer; -begin - if InitSSLInterface and Assigned(_X509print) then - Result := _X509print(b, a) - else - Result := 0; -end; - -function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr; -begin - if InitSSLInterface and Assigned(_d2iPKCS12bio) then - Result := _d2iPKCS12bio(b, Pkcs12) - else - Result := nil; -end; - -function PKCS12parse(p12: SslPtr; pass: Ansistring; var pkey, cert, ca: SslPtr): integer; -begin - if InitSSLInterface and Assigned(_PKCS12parse) then - Result := _PKCS12parse(p12, SslPtr(pass), pkey, cert, ca) - else - Result := 0; -end; - -procedure PKCS12free(p12: SslPtr); -begin - if InitSSLInterface and Assigned(_PKCS12free) then - _PKCS12free(p12); -end; - -function RsaGenerateKey(bits, e: integer; callback: PFunction; cb_arg: SslPtr): PRSA; -begin - if InitSSLInterface and Assigned(_RsaGenerateKey) then - Result := _RsaGenerateKey(bits, e, callback, cb_arg) - else - Result := nil; -end; - -function EvpPkeyAssign(pkey: EVP_PKEY; _type: integer; key: Prsa): integer; -begin - if InitSSLInterface and Assigned(_EvpPkeyAssign) then - Result := _EvpPkeyAssign(pkey, _type, key) - else - Result := 0; -end; - -function X509SetVersion(x: PX509; version: integer): integer; -begin - if InitSSLInterface and Assigned(_X509SetVersion) then - Result := _X509SetVersion(x, version) - else - Result := 0; -end; - -function X509SetPubkey(x: PX509; pkey: EVP_PKEY): integer; -begin - if InitSSLInterface and Assigned(_X509SetPubkey) then - Result := _X509SetPubkey(x, pkey) - else - Result := 0; -end; - -function X509SetIssuerName(x: PX509; name: PX509_NAME): integer; -begin - if InitSSLInterface and Assigned(_X509SetIssuerName) then - Result := _X509SetIssuerName(x, name) - else - Result := 0; -end; - -function X509NameAddEntryByTxt(name: PX509_NAME; field: Ansistring; _type: integer; - bytes: Ansistring; len, loc, _set: integer): integer; -begin - if InitSSLInterface and Assigned(_X509NameAddEntryByTxt) then - Result := _X509NameAddEntryByTxt(name, PAnsiChar(field), _type, PAnsiChar(Bytes), len, loc, _set) - else - Result := 0; -end; - -function X509Sign(x: PX509; pkey: EVP_PKEY; const md: PEVP_MD): integer; -begin - if InitSSLInterface and Assigned(_X509Sign) then - Result := _X509Sign(x, pkey, md) - else - Result := 0; -end; - -function Asn1UtctimeNew: PASN1_UTCTIME; -begin - if InitSSLInterface and Assigned(_Asn1UtctimeNew) then - Result := _Asn1UtctimeNew - else - Result := nil; -end; - -procedure Asn1UtctimeFree(a: PASN1_UTCTIME); -begin - if InitSSLInterface and Assigned(_Asn1UtctimeFree) then - _Asn1UtctimeFree(a); -end; - -function X509GmtimeAdj(s: PASN1_UTCTIME; adj: integer): PASN1_UTCTIME; -begin - if InitSSLInterface and Assigned(_X509GmtimeAdj) then - Result := _X509GmtimeAdj(s, adj) - else - Result := nil; -end; - -function X509SetNotBefore(x: PX509; tm: PASN1_UTCTIME): integer; -begin - if InitSSLInterface and Assigned(_X509SetNotBefore) then - Result := _X509SetNotBefore(x, tm) - else - Result := 0; -end; - -function X509SetNotAfter(x: PX509; tm: PASN1_UTCTIME): integer; -begin - if InitSSLInterface and Assigned(_X509SetNotAfter) then - Result := _X509SetNotAfter(x, tm) - else - Result := 0; -end; - -function i2dX509bio(b: PBIO; x: PX509): integer; -begin - if InitSSLInterface and Assigned(_i2dX509bio) then - Result := _i2dX509bio(b, x) - else - Result := 0; -end; - -function d2iX509bio(b: PBIO; x: PX509): PX509; {pf} -begin - if InitSSLInterface and Assigned(_d2iX509bio) then - Result := _d2iX509bio(x,b) - else - Result := nil; -end; - -function PEMReadBioX509(b:PBIO; {var x:PX509;}x:PSslPtr; callback:PFunction; cb_arg: SslPtr): PX509; {pf} -begin - if InitSSLInterface and Assigned(_PEMReadBioX509) then - Result := _PEMReadBioX509(b,x,callback,cb_arg) - else - Result := nil; -end; - -procedure SkX509PopFree(st: PSTACK; func:TSkPopFreeFunc); {pf} -begin - if InitSSLInterface and Assigned(_SkX509PopFree) then - _SkX509PopFree(st,func); -end; - -function i2dPrivateKeyBio(b: PBIO; pkey: EVP_PKEY): integer; -begin - if InitSSLInterface and Assigned(_i2dPrivateKeyBio) then - Result := _i2dPrivateKeyBio(b, pkey) - else - Result := 0; -end; - -function EvpGetDigestByName(Name: AnsiString): PEVP_MD; -begin - if InitSSLInterface and Assigned(_EvpGetDigestByName) then - Result := _EvpGetDigestByName(PAnsiChar(Name)) - else - Result := nil; -end; - -function Asn1IntegerSet(a: PASN1_INTEGER; v: integer): integer; -begin - if InitSSLInterface and Assigned(_Asn1IntegerSet) then - Result := _Asn1IntegerSet(a, v) - else - Result := 0; -end; - -function Asn1IntegerGet(a: PASN1_INTEGER): integer; {pf} -begin - if InitSSLInterface and Assigned(_Asn1IntegerGet) then - Result := _Asn1IntegerGet(a) - else - Result := 0; -end; - -function X509GetSerialNumber(x: PX509): PASN1_INTEGER; -begin - if InitSSLInterface and Assigned(_X509GetSerialNumber) then - Result := _X509GetSerialNumber(x) - else - Result := nil; -end; - -// 3DES functions -procedure DESsetoddparity(Key: des_cblock); -begin - if InitSSLInterface and Assigned(_DESsetoddparity) then - _DESsetoddparity(Key); -end; - -function DESsetkeychecked(key: des_cblock; schedule: des_key_schedule): Integer; -begin - if InitSSLInterface and Assigned(_DESsetkeychecked) then - Result := _DESsetkeychecked(key, schedule) - else - Result := -1; -end; - -procedure DESecbencrypt(Input: des_cblock; output: des_cblock; ks: des_key_schedule; enc: Integer); -begin - if InitSSLInterface and Assigned(_DESecbencrypt) then - _DESecbencrypt(Input, output, ks, enc); -end; - -procedure locking_callback(mode, ltype: integer; lfile: PChar; line: integer); cdecl; -begin - if (mode and 1) > 0 then - TCriticalSection(Locks[ltype]).Enter - else - TCriticalSection(Locks[ltype]).Leave; -end; - -procedure InitLocks; -var - n: integer; - max: integer; -begin - Locks := TList.Create; - max := _CRYPTOnumlocks; - for n := 1 to max do - Locks.Add(TCriticalSection.Create); - _CRYPTOsetlockingcallback(@locking_callback); -end; - -procedure FreeLocks; -var - n: integer; -begin - _CRYPTOsetlockingcallback(nil); - for n := 0 to Locks.Count - 1 do - TCriticalSection(Locks[n]).Free; - Locks.Free; -end; - -{$ENDIF} - -function LoadLib(const Value: String): HModule; -begin -{$IFDEF CIL} - Result := LoadLibrary(Value); -{$ELSE} - Result := LoadLibrary(PChar(Value)); -{$ENDIF} -end; - -function GetProcAddr(module: HModule; const ProcName: string): SslPtr; -begin -{$IFDEF CIL} - Result := GetProcAddress(module, ProcName); -{$ELSE} - Result := GetProcAddress(module, PChar(ProcName)); -{$ENDIF} -end; - -function InitSSLInterface: Boolean; -var - s: string; - x: integer; -begin - {pf} - if SSLLoaded then - begin - Result := TRUE; - exit; - end; - {/pf} - SSLCS.Enter; - try - if not IsSSLloaded then - begin -{$IFDEF CIL} - SSLLibHandle := 1; - SSLUtilHandle := 1; -{$ELSE} - SSLUtilHandle := LoadLib(DLLUtilName); - SSLLibHandle := LoadLib(DLLSSLName); - {$IFDEF MSWINDOWS} - if (SSLLibHandle = 0) then - SSLLibHandle := LoadLib(DLLSSLName2); - {$ENDIF} -{$ENDIF} - if (SSLLibHandle <> 0) and (SSLUtilHandle <> 0) then - begin -{$IFNDEF CIL} - _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error'); - _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init'); - _SslLoadErrorStrings := GetProcAddr(SSLLibHandle, 'SSL_load_error_strings'); - _SslCtxSetCipherList := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_cipher_list'); - _SslCtxNew := GetProcAddr(SSLLibHandle, 'SSL_CTX_new'); - _SslCtxFree := GetProcAddr(SSLLibHandle, 'SSL_CTX_free'); - _SslSetFd := GetProcAddr(SSLLibHandle, 'SSL_set_fd'); - _SslMethodV2 := GetProcAddr(SSLLibHandle, 'SSLv2_method'); - _SslMethodV3 := GetProcAddr(SSLLibHandle, 'SSLv3_method'); - _SslMethodTLSV1 := GetProcAddr(SSLLibHandle, 'TLSv1_method'); - _SslMethodV23 := GetProcAddr(SSLLibHandle, 'SSLv23_method'); - _SslCtxUsePrivateKey := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey'); - _SslCtxUsePrivateKeyASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_PrivateKey_ASN1'); - //use SSL_CTX_use_RSAPrivateKey_file instead SSL_CTX_use_PrivateKey_file, - //because SSL_CTX_use_PrivateKey_file not support DER format. :-O - _SslCtxUsePrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_RSAPrivateKey_file'); - _SslCtxUseCertificate := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate'); - _SslCtxUseCertificateASN1 := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_ASN1'); - _SslCtxUseCertificateFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_file'); - _SslCtxUseCertificateChainFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_use_certificate_chain_file'); - _SslCtxCheckPrivateKeyFile := GetProcAddr(SSLLibHandle, 'SSL_CTX_check_private_key'); - _SslCtxSetDefaultPasswdCb := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb'); - _SslCtxSetDefaultPasswdCbUserdata := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_default_passwd_cb_userdata'); - _SslCtxLoadVerifyLocations := GetProcAddr(SSLLibHandle, 'SSL_CTX_load_verify_locations'); - _SslCtxCtrl := GetProcAddr(SSLLibHandle, 'SSL_CTX_ctrl'); - _SslNew := GetProcAddr(SSLLibHandle, 'SSL_new'); - _SslFree := GetProcAddr(SSLLibHandle, 'SSL_free'); - _SslAccept := GetProcAddr(SSLLibHandle, 'SSL_accept'); - _SslConnect := GetProcAddr(SSLLibHandle, 'SSL_connect'); - _SslShutdown := GetProcAddr(SSLLibHandle, 'SSL_shutdown'); - _SslRead := GetProcAddr(SSLLibHandle, 'SSL_read'); - _SslPeek := GetProcAddr(SSLLibHandle, 'SSL_peek'); - _SslWrite := GetProcAddr(SSLLibHandle, 'SSL_write'); - _SslPending := GetProcAddr(SSLLibHandle, 'SSL_pending'); - _SslGetPeerCertificate := GetProcAddr(SSLLibHandle, 'SSL_get_peer_certificate'); - _SslGetVersion := GetProcAddr(SSLLibHandle, 'SSL_get_version'); - _SslCtxSetVerify := GetProcAddr(SSLLibHandle, 'SSL_CTX_set_verify'); - _SslGetCurrentCipher := GetProcAddr(SSLLibHandle, 'SSL_get_current_cipher'); - _SslCipherGetName := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_name'); - _SslCipherGetBits := GetProcAddr(SSLLibHandle, 'SSL_CIPHER_get_bits'); - _SslGetVerifyResult := GetProcAddr(SSLLibHandle, 'SSL_get_verify_result'); - _SslCtrl := GetProcAddr(SSLLibHandle, 'SSL_ctrl'); - - _X509New := GetProcAddr(SSLUtilHandle, 'X509_new'); - _X509Free := GetProcAddr(SSLUtilHandle, 'X509_free'); - _X509NameOneline := GetProcAddr(SSLUtilHandle, 'X509_NAME_oneline'); - _X509GetSubjectName := GetProcAddr(SSLUtilHandle, 'X509_get_subject_name'); - _X509GetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_get_issuer_name'); - _X509NameHash := GetProcAddr(SSLUtilHandle, 'X509_NAME_hash'); - _X509Digest := GetProcAddr(SSLUtilHandle, 'X509_digest'); - _X509print := GetProcAddr(SSLUtilHandle, 'X509_print'); - _X509SetVersion := GetProcAddr(SSLUtilHandle, 'X509_set_version'); - _X509SetPubkey := GetProcAddr(SSLUtilHandle, 'X509_set_pubkey'); - _X509SetIssuerName := GetProcAddr(SSLUtilHandle, 'X509_set_issuer_name'); - _X509NameAddEntryByTxt := GetProcAddr(SSLUtilHandle, 'X509_NAME_add_entry_by_txt'); - _X509Sign := GetProcAddr(SSLUtilHandle, 'X509_sign'); - _X509GmtimeAdj := GetProcAddr(SSLUtilHandle, 'X509_gmtime_adj'); - _X509SetNotBefore := GetProcAddr(SSLUtilHandle, 'X509_set_notBefore'); - _X509SetNotAfter := GetProcAddr(SSLUtilHandle, 'X509_set_notAfter'); - _X509GetSerialNumber := GetProcAddr(SSLUtilHandle, 'X509_get_serialNumber'); - _EvpPkeyNew := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_new'); - _EvpPkeyFree := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_free'); - _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign'); - _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup'); - _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname'); - _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version'); - _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n'); - _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error'); - _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error'); - _ErrFreeStrings := GetProcAddr(SSLUtilHandle, 'ERR_free_strings'); - _ErrRemoveState := GetProcAddr(SSLUtilHandle, 'ERR_remove_state'); - _OPENSSLaddallalgorithms := GetProcAddr(SSLUtilHandle, 'OPENSSL_add_all_algorithms_noconf'); - _CRYPTOcleanupAllExData := GetProcAddr(SSLUtilHandle, 'CRYPTO_cleanup_all_ex_data'); - _RandScreen := GetProcAddr(SSLUtilHandle, 'RAND_screen'); - _BioNew := GetProcAddr(SSLUtilHandle, 'BIO_new'); - _BioFreeAll := GetProcAddr(SSLUtilHandle, 'BIO_free_all'); - _BioSMem := GetProcAddr(SSLUtilHandle, 'BIO_s_mem'); - _BioCtrlPending := GetProcAddr(SSLUtilHandle, 'BIO_ctrl_pending'); - _BioRead := GetProcAddr(SSLUtilHandle, 'BIO_read'); - _BioWrite := GetProcAddr(SSLUtilHandle, 'BIO_write'); - _d2iPKCS12bio := GetProcAddr(SSLUtilHandle, 'd2i_PKCS12_bio'); - _PKCS12parse := GetProcAddr(SSLUtilHandle, 'PKCS12_parse'); - _PKCS12free := GetProcAddr(SSLUtilHandle, 'PKCS12_free'); - _RsaGenerateKey := GetProcAddr(SSLUtilHandle, 'RSA_generate_key'); - _Asn1UtctimeNew := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_new'); - _Asn1UtctimeFree := GetProcAddr(SSLUtilHandle, 'ASN1_UTCTIME_free'); - _Asn1IntegerSet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_set'); - _Asn1IntegerGet := GetProcAddr(SSLUtilHandle, 'ASN1_INTEGER_get'); {pf} - _i2dX509bio := GetProcAddr(SSLUtilHandle, 'i2d_X509_bio'); - _d2iX509bio := GetProcAddr(SSLUtilHandle, 'd2i_X509_bio'); {pf} - _PEMReadBioX509 := GetProcAddr(SSLUtilHandle, 'PEM_read_bio_X509'); {pf} - _SkX509PopFree := GetProcAddr(SSLUtilHandle, 'SK_X509_POP_FREE'); {pf} - _i2dPrivateKeyBio := GetProcAddr(SSLUtilHandle, 'i2d_PrivateKey_bio'); - - // 3DES functions - _DESsetoddparity := GetProcAddr(SSLUtilHandle, 'DES_set_odd_parity'); - _DESsetkeychecked := GetProcAddr(SSLUtilHandle, 'DES_set_key_checked'); - _DESecbencrypt := GetProcAddr(SSLUtilHandle, 'DES_ecb_encrypt'); - // - _CRYPTOnumlocks := GetProcAddr(SSLUtilHandle, 'CRYPTO_num_locks'); - _CRYPTOsetlockingcallback := GetProcAddr(SSLUtilHandle, 'CRYPTO_set_locking_callback'); -{$ENDIF} -{$IFDEF CIL} - SslLibraryInit; - SslLoadErrorStrings; - OPENSSLaddallalgorithms; - RandScreen; -{$ELSE} - SetLength(s, 1024); - x := GetModuleFilename(SSLLibHandle,PChar(s),Length(s)); - SetLength(s, x); - SSLLibFile := s; - SetLength(s, 1024); - x := GetModuleFilename(SSLUtilHandle,PChar(s),Length(s)); - SetLength(s, x); - SSLUtilFile := s; - //init library - if assigned(_SslLibraryInit) then - _SslLibraryInit; - if assigned(_SslLoadErrorStrings) then - _SslLoadErrorStrings; - if assigned(_OPENSSLaddallalgorithms) then - _OPENSSLaddallalgorithms; - if assigned(_RandScreen) then - _RandScreen; - if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then - InitLocks; -{$ENDIF} - SSLloaded := True; -{$IFDEF OS2} - Result := InitEMXHandles; -{$ELSE OS2} - Result := True; -{$ENDIF OS2} - end - else - begin - //load failed! - if SSLLibHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(SSLLibHandle); -{$ENDIF} - SSLLibHandle := 0; - end; - if SSLUtilHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(SSLUtilHandle); -{$ENDIF} - SSLLibHandle := 0; - end; - Result := False; - end; - end - else - //loaded before... - Result := true; - finally - SSLCS.Leave; - end; -end; - -function DestroySSLInterface: Boolean; -begin - SSLCS.Enter; - try - if IsSSLLoaded then - begin - //deinit library -{$IFNDEF CIL} - if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then - FreeLocks; -{$ENDIF} - EVPCleanup; - CRYPTOcleanupAllExData; - ErrRemoveState(0); - end; - SSLloaded := false; - if SSLLibHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(SSLLibHandle); -{$ENDIF} - SSLLibHandle := 0; - end; - if SSLUtilHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(SSLUtilHandle); -{$ENDIF} - SSLLibHandle := 0; - end; - -{$IFNDEF CIL} - _SslGetError := nil; - _SslLibraryInit := nil; - _SslLoadErrorStrings := nil; - _SslCtxSetCipherList := nil; - _SslCtxNew := nil; - _SslCtxFree := nil; - _SslSetFd := nil; - _SslMethodV2 := nil; - _SslMethodV3 := nil; - _SslMethodTLSV1 := nil; - _SslMethodV23 := nil; - _SslCtxUsePrivateKey := nil; - _SslCtxUsePrivateKeyASN1 := nil; - _SslCtxUsePrivateKeyFile := nil; - _SslCtxUseCertificate := nil; - _SslCtxUseCertificateASN1 := nil; - _SslCtxUseCertificateFile := nil; - _SslCtxUseCertificateChainFile := nil; - _SslCtxCheckPrivateKeyFile := nil; - _SslCtxSetDefaultPasswdCb := nil; - _SslCtxSetDefaultPasswdCbUserdata := nil; - _SslCtxLoadVerifyLocations := nil; - _SslCtxCtrl := nil; - _SslNew := nil; - _SslFree := nil; - _SslAccept := nil; - _SslConnect := nil; - _SslShutdown := nil; - _SslRead := nil; - _SslPeek := nil; - _SslWrite := nil; - _SslPending := nil; - _SslGetPeerCertificate := nil; - _SslGetVersion := nil; - _SslCtxSetVerify := nil; - _SslGetCurrentCipher := nil; - _SslCipherGetName := nil; - _SslCipherGetBits := nil; - _SslGetVerifyResult := nil; - _SslCtrl := nil; - - _X509New := nil; - _X509Free := nil; - _X509NameOneline := nil; - _X509GetSubjectName := nil; - _X509GetIssuerName := nil; - _X509NameHash := nil; - _X509Digest := nil; - _X509print := nil; - _X509SetVersion := nil; - _X509SetPubkey := nil; - _X509SetIssuerName := nil; - _X509NameAddEntryByTxt := nil; - _X509Sign := nil; - _X509GmtimeAdj := nil; - _X509SetNotBefore := nil; - _X509SetNotAfter := nil; - _X509GetSerialNumber := nil; - _EvpPkeyNew := nil; - _EvpPkeyFree := nil; - _EvpPkeyAssign := nil; - _EVPCleanup := nil; - _EvpGetDigestByName := nil; - _SSLeayversion := nil; - _ErrErrorString := nil; - _ErrGetError := nil; - _ErrClearError := nil; - _ErrFreeStrings := nil; - _ErrRemoveState := nil; - _OPENSSLaddallalgorithms := nil; - _CRYPTOcleanupAllExData := nil; - _RandScreen := nil; - _BioNew := nil; - _BioFreeAll := nil; - _BioSMem := nil; - _BioCtrlPending := nil; - _BioRead := nil; - _BioWrite := nil; - _d2iPKCS12bio := nil; - _PKCS12parse := nil; - _PKCS12free := nil; - _RsaGenerateKey := nil; - _Asn1UtctimeNew := nil; - _Asn1UtctimeFree := nil; - _Asn1IntegerSet := nil; - _Asn1IntegerGet := nil; {pf} - _SkX509PopFree := nil; {pf} - _i2dX509bio := nil; - _i2dPrivateKeyBio := nil; - - // 3DES functions - _DESsetoddparity := nil; - _DESsetkeychecked := nil; - _DESecbencrypt := nil; - // - _CRYPTOnumlocks := nil; - _CRYPTOsetlockingcallback := nil; -{$ENDIF} - finally - SSLCS.Leave; - end; - Result := True; -end; - -function IsSSLloaded: Boolean; -begin - Result := SSLLoaded; -end; - -initialization -begin - SSLCS:= TCriticalSection.Create; -end; - -finalization -begin -{$IFNDEF CIL} - DestroySSLInterface; -{$ENDIF} - SSLCS.Free; -end; - -end. diff --git a/3rd/synapse/source/ssl_sbb.pas b/3rd/synapse/source/ssl_sbb.pas deleted file mode 100644 index c9380a481..000000000 --- a/3rd/synapse/source/ssl_sbb.pas +++ /dev/null @@ -1,697 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.000.003 | -|==============================================================================| -| Content: SSL support for SecureBlackBox | -|==============================================================================| -| Copyright (c)1999-2005, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2005. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Allen Drennan (adrennan@wiredred.com) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(SSL plugin for Eldos SecureBlackBox) - -For handling keys and certificates you can use this properties: -@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA), -@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate), -@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey), -@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate), -@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats -of keys and certificates refer to SecureBlackBox documentation. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -unit ssl_sbb; - -interface - -uses - SysUtils, Classes, Windows, blcksock, synsock, synautil, synacode, - SBClient, SBServer, SBX509, SBWinCertStorage, SBCustomCertStorage, - SBUtils, SBConstants, SBSessionPool; - -const - DEFAULT_RECV_BUFFER=32768; - -type - {:@abstract(class implementing SecureBlackbox SSL plugin.) - Instance of this class will be created for each @link(TTCPBlockSocket). - You not need to create instance of this class, all is done by Synapse itself!} - TSSLSBB=class(TCustomSSL) - protected - FServer: Boolean; - FElSecureClient:TElSecureClient; - FElSecureServer:TElSecureServer; - FElCertStorage:TElMemoryCertStorage; - FElX509Certificate:TElX509Certificate; - FElX509CACertificate:TElX509Certificate; - FCipherSuites:TBits; - private - FRecvBuffer:String; - FRecvBuffers:String; - FRecvBuffersLock:TRTLCriticalSection; - FRecvDecodedBuffers:String; - function GetCipherSuite:Integer; - procedure Reset; - function Prepare(Server:Boolean):Boolean; - procedure OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean); - procedure OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt); - procedure OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;var Written:LongInt); - procedure OnData(Sender:TObject;Buffer:Pointer;Size:LongInt); - public - constructor Create(const Value: TTCPBlockSocket); override; - destructor Destroy; override; - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - {:See @inherited and @link(ssl_sbb) for more details.} - function Connect: boolean; override; - {:See @inherited and @link(ssl_sbb) for more details.} - function Accept: boolean; override; - {:See @inherited} - function Shutdown: boolean; override; - {:See @inherited} - function BiShutdown: boolean; override; - {:See @inherited} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function WaitingData: Integer; override; - {:See @inherited} - function GetSSLVersion: string; override; - {:See @inherited} - function GetPeerSubject: string; override; - {:See @inherited} - function GetPeerIssuer: string; override; - {:See @inherited} - function GetPeerName: string; override; - {:See @inherited} - function GetPeerFingerprint: string; override; - {:See @inherited} - function GetCertInfo: string; override; - published - property ElSecureClient:TElSecureClient read FElSecureClient write FElSecureClient; - property ElSecureServer:TElSecureServer read FElSecureServer write FElSecureServer; - property CipherSuites:TBits read FCipherSuites write FCipherSuites; - property CipherSuite:Integer read GetCipherSuite; - end; - -implementation - -var - FAcceptThread:THandle=0; - -// on error -procedure TSSLSBB.OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean); - -begin - FLastErrorDesc:=''; - FLastError:=ErrorCode; -end; - -// on send -procedure TSSLSBB.OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt); - -var - lResult:Integer; - -begin - if FSocket.Socket=INVALID_SOCKET then - Exit; - lResult:=Send(FSocket.Socket,Buffer,Size,0); - if lResult=SOCKET_ERROR then - begin - FLastErrorDesc:=''; - FLastError:=WSAGetLastError; - end; -end; - -// on receive -procedure TSSLSBB.OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;var Written:LongInt); - -begin - if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock); - try - if Length(FRecvBuffers)<=MaxSize then - begin - Written:=Length(FRecvBuffers); - Move(FRecvBuffers[1],Buffer^,Written); - FRecvBuffers:=''; - end - else - begin - Written:=MaxSize; - Move(FRecvBuffers[1],Buffer^,Written); - Delete(FRecvBuffers,1,Written); - end; - finally - if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock); - end; -end; - -// on data -procedure TSSLSBB.OnData(Sender:TObject;Buffer:Pointer;Size:LongInt); - -var - lString:String; - -begin - SetLength(lString,Size); - Move(Buffer^,lString[1],Size); - FRecvDecodedBuffers:=FRecvDecodedBuffers+lString; -end; - -{ inherited } - -constructor TSSLSBB.Create(const Value: TTCPBlockSocket); - -var - loop1:Integer; - -begin - inherited Create(Value); - FServer:=FALSE; - FElSecureClient:=NIL; - FElSecureServer:=NIL; - FElCertStorage:=NIL; - FElX509Certificate:=NIL; - FElX509CACertificate:=NIL; - SetLength(FRecvBuffer,DEFAULT_RECV_BUFFER); - FRecvBuffers:=''; - InitializeCriticalSection(FRecvBuffersLock); - FRecvDecodedBuffers:=''; - FCipherSuites:=TBits.Create; - if FCipherSuites<>NIL then - begin - FCipherSuites.Size:=SB_SUITE_LAST+1; - for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do - FCipherSuites[loop1]:=TRUE; - end; -end; - -destructor TSSLSBB.Destroy; - -begin - Reset; - inherited Destroy; - if FCipherSuites<>NIL then - FreeAndNIL(FCipherSuites); - DeleteCriticalSection(FRecvBuffersLock); -end; - -function TSSLSBB.LibVersion: String; - -begin - Result:='SecureBlackBox'; -end; - -function TSSLSBB.LibName: String; - -begin - Result:='ssl_sbb'; -end; - -function FileToString(lFile:String):String; - -var - lStream:TMemoryStream; - -begin - Result:=''; - lStream:=TMemoryStream.Create; - if lStream<>NIL then - begin - lStream.LoadFromFile(lFile); - if lStream.Size>0 then - begin - lStream.Position:=0; - SetLength(Result,lStream.Size); - Move(lStream.Memory^,Result[1],lStream.Size); - end; - lStream.Free; - end; -end; - -function TSSLSBB.GetCipherSuite:Integer; - -begin - if FServer then - Result:=FElSecureServer.CipherSuite - else - Result:=FElSecureClient.CipherSuite; -end; - -procedure TSSLSBB.Reset; - -begin - if FElSecureServer<>NIL then - FreeAndNIL(FElSecureServer); - if FElSecureClient<>NIL then - FreeAndNIL(FElSecureClient); - if FElX509Certificate<>NIL then - FreeAndNIL(FElX509Certificate); - if FElX509CACertificate<>NIL then - FreeAndNIL(FElX509CACertificate); - if FElCertStorage<>NIL then - FreeAndNIL(FElCertStorage); - FSSLEnabled:=FALSE; -end; - -function TSSLSBB.Prepare(Server:Boolean): Boolean; - -var - loop1:Integer; - lStream:TMemoryStream; - lCertificate,lPrivateKey,lCertCA:String; - -begin - Result:=FALSE; - FServer:=Server; - - // reset, if necessary - Reset; - - // init, certificate - if FCertificateFile<>'' then - lCertificate:=FileToString(FCertificateFile) - else - lCertificate:=FCertificate; - if FPrivateKeyFile<>'' then - lPrivateKey:=FileToString(FPrivateKeyFile) - else - lPrivateKey:=FPrivateKey; - if FCertCAFile<>'' then - lCertCA:=FileToString(FCertCAFile) - else - lCertCA:=FCertCA; - if (lCertificate<>'') and (lPrivateKey<>'') then - begin - FElCertStorage:=TElMemoryCertStorage.Create(NIL); - if FElCertStorage<>NIL then - FElCertStorage.Clear; - - // apply ca certificate - if lCertCA<>'' then - begin - FElX509CACertificate:=TElX509Certificate.Create(NIL); - if FElX509CACertificate<>NIL then - begin - with FElX509CACertificate do - begin - lStream:=TMemoryStream.Create; - try - WriteStrToStream(lStream,lCertCA); - lStream.Seek(0,soFromBeginning); - LoadFromStream(lStream); - finally - lStream.Free; - end; - end; - if FElCertStorage<>NIL then - FElCertStorage.Add(FElX509CACertificate); - end; - end; - - // apply certificate - FElX509Certificate:=TElX509Certificate.Create(NIL); - if FElX509Certificate<>NIL then - begin - with FElX509Certificate do - begin - lStream:=TMemoryStream.Create; - try - WriteStrToStream(lStream,lCertificate); - lStream.Seek(0,soFromBeginning); - LoadFromStream(lStream); - finally - lStream.Free; - end; - lStream:=TMemoryStream.Create; - try - WriteStrToStream(lStream,lPrivateKey); - lStream.Seek(0,soFromBeginning); - LoadKeyFromStream(lStream); - finally - lStream.Free; - end; - if FElCertStorage<>NIL then - FElCertStorage.Add(FElX509Certificate); - end; - end; - end; - - // init, as server - if FServer then - begin - FElSecureServer:=TElSecureServer.Create(NIL); - if FElSecureServer<>NIL then - begin - // init, ciphers - for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do - FElSecureServer.CipherSuites[loop1]:=FCipherSuites[loop1]; - FElSecureServer.Versions:=[sbSSL2,sbSSL3,sbTLS1]; - FElSecureServer.ClientAuthentication:=FALSE; - FElSecureServer.OnError:=OnError; - FElSecureServer.OnSend:=OnSend; - FElSecureServer.OnReceive:=OnReceive; - FElSecureServer.OnData:=OnData; - FElSecureServer.CertStorage:=FElCertStorage; - Result:=TRUE; - end; - end - else - // init, as client - begin - FElSecureClient:=TElSecureClient.Create(NIL); - if FElSecureClient<>NIL then - begin - // init, ciphers - for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do - FElSecureClient.CipherSuites[loop1]:=FCipherSuites[loop1]; - FElSecureClient.Versions:=[sbSSL3,sbTLS1]; - FElSecureClient.OnError:=OnError; - FElSecureClient.OnSend:=OnSend; - FElSecureClient.OnReceive:=OnReceive; - FElSecureClient.OnData:=OnData; - FElSecureClient.CertStorage:=FElCertStorage; - Result:=TRUE; - end; - end; -end; - -function TSSLSBB.Connect:Boolean; - -var - lResult:Integer; - -begin - Result:=FALSE; - if FSocket.Socket=INVALID_SOCKET then - Exit; - if Prepare(FALSE) then - begin - FElSecureClient.Open; - - // reset - FRecvBuffers:=''; - FRecvDecodedBuffers:=''; - - // wait for open or error - while (not FElSecureClient.Active) and - (FLastError=0) do - begin - // data available? - if FRecvBuffers<>'' then - FElSecureClient.DataAvailable - else - begin - // socket recv - lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0); - if lResult=SOCKET_ERROR then - begin - FLastErrorDesc:=''; - FLastError:=WSAGetLastError; - end - else - begin - if lResult>0 then - FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult) - else - Break; - end; - end; - end; - if FLastError<>0 then - Exit; - FSSLEnabled:=FElSecureClient.Active; - Result:=FSSLEnabled; - end; -end; - -function TSSLSBB.Accept:Boolean; - -var - lResult:Integer; - -begin - Result:=FALSE; - if FSocket.Socket=INVALID_SOCKET then - Exit; - if Prepare(TRUE) then - begin - FAcceptThread:=GetCurrentThreadId; - FElSecureServer.Open; - - // reset - FRecvBuffers:=''; - FRecvDecodedBuffers:=''; - - // wait for open or error - while (not FElSecureServer.Active) and - (FLastError=0) do - begin - // data available? - if FRecvBuffers<>'' then - FElSecureServer.DataAvailable - else - begin - // socket recv - lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0); - if lResult=SOCKET_ERROR then - begin - FLastErrorDesc:=''; - FLastError:=WSAGetLastError; - end - else - begin - if lResult>0 then - FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult) - else - Break; - end; - end; - end; - if FLastError<>0 then - Exit; - FSSLEnabled:=FElSecureServer.Active; - Result:=FSSLEnabled; - end; -end; - -function TSSLSBB.Shutdown:Boolean; - -begin - Result:=BiShutdown; -end; - -function TSSLSBB.BiShutdown: boolean; - -begin - Reset; - Result:=TRUE; -end; - -function TSSLSBB.SendBuffer(Buffer: TMemory; Len: Integer): Integer; - -begin - if FServer then - FElSecureServer.SendData(Buffer,Len) - else - FElSecureClient.SendData(Buffer,Len); - Result:=Len; -end; - -function TSSLSBB.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; - -begin - Result:=0; - try - // recv waiting, if necessary - if FRecvDecodedBuffers='' then - WaitingData; - - // received - if Length(FRecvDecodedBuffers)FAcceptThread then EnterCriticalSection(FRecvBuffersLock); - try - lRecvBuffers:=FRecvBuffers<>''; - finally - if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock); - end; - if lRecvBuffers then - begin - if FServer then - FElSecureServer.DataAvailable - else - FElSecureClient.DataAvailable; - end - else - begin - // socket recv - lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0); - if lResult=SOCKET_ERROR then - begin - FLastErrorDesc:=''; - FLastError:=WSAGetLastError; - end - else - begin - if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock); - try - FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult); - finally - if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock); - end; - - // data available? - if GetCurrentThreadId<>FAcceptThread then EnterCriticalSection(FRecvBuffersLock); - try - lRecvBuffers:=FRecvBuffers<>''; - finally - if GetCurrentThreadId<>FAcceptThread then LeaveCriticalSection(FRecvBuffersLock); - end; - if lRecvBuffers then - begin - if FServer then - FElSecureServer.DataAvailable - else - FElSecureClient.DataAvailable; - end; - end; - end; - - // decoded buffers result - Result:=Length(FRecvDecodedBuffers); -end; - -function TSSLSBB.GetSSLVersion: string; - -begin - Result:='SSLv3 or TLSv1'; -end; - -function TSSLSBB.GetPeerSubject: string; - -begin - Result := ''; -// if FServer then - // must return subject of the client certificate -// else - // must return subject of the server certificate -end; - -function TSSLSBB.GetPeerName: string; - -begin - Result := ''; -// if FServer then - // must return commonname of the client certificate -// else - // must return commonname of the server certificate -end; - -function TSSLSBB.GetPeerIssuer: string; - -begin - Result := ''; -// if FServer then - // must return issuer of the client certificate -// else - // must return issuer of the server certificate -end; - -function TSSLSBB.GetPeerFingerprint: string; - -begin - Result := ''; -// if FServer then - // must return a unique hash string of the client certificate -// else - // must return a unique hash string of the server certificate -end; - -function TSSLSBB.GetCertInfo: string; - -begin - Result := ''; -// if FServer then - // must return a text representation of the ASN of the client certificate -// else - // must return a text representation of the ASN of the server certificate -end; - -{==============================================================================} - -initialization - SSLImplementation := TSSLSBB; - -finalization - -end. diff --git a/3rd/synapse/source/ssl_streamsec.pas b/3rd/synapse/source/ssl_streamsec.pas deleted file mode 100644 index 8c36ac8ca..000000000 --- a/3rd/synapse/source/ssl_streamsec.pas +++ /dev/null @@ -1,539 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.000.006 | -|==============================================================================| -| Content: SSL support by StreamSecII | -|==============================================================================| -| Copyright (c)1999-2005, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2005. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Henrick Hellstr�m | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(SSL plugin for StreamSecII or OpenStreamSecII) - -StreamSecII is native pascal library, you not need any external libraries! - -You can tune lot of StreamSecII properties by using your GlobalServer. If you not -using your GlobalServer, then this plugin create own TSimpleTLSInternalServer -instance for each TCP connection. Formore information about GlobalServer usage -refer StreamSecII documentation. - -If you are not using key and certificate by GlobalServer, then you can use -properties of this plugin instead, but this have limited features and -@link(TCustomSSL.KeyPassword) not working properly yet! - -For handling keys and certificates you can use this properties: -@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA), -@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate), -@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey), -@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate), -@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats -of keys and certificates refer to StreamSecII documentation. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -unit ssl_streamsec; - -interface - -uses - SysUtils, Classes, - blcksock, synsock, synautil, synacode, - TlsInternalServer, TlsSynaSock, TlsConst, StreamSecII, Asn1, X509Base, - SecUtils; - -type - {:@exclude} - TMyTLSSynSockSlave = class(TTLSSynSockSlave) - protected - procedure SetMyTLSServer(const Value: TCustomTLSInternalServer); - function GetMyTLSServer: TCustomTLSInternalServer; - published - property MyTLSServer: TCustomTLSInternalServer read GetMyTLSServer write SetMyTLSServer; - end; - - {:@abstract(class implementing StreamSecII SSL plugin.) - Instance of this class will be created for each @link(TTCPBlockSocket). - You not need to create instance of this class, all is done by Synapse itself!} - TSSLStreamSec = class(TCustomSSL) - protected - FSlave: TMyTLSSynSockSlave; - FIsServer: Boolean; - FTLSServer: TCustomTLSInternalServer; - FServerCreated: Boolean; - function SSLCheck: Boolean; - function Init(server:Boolean): Boolean; - function DeInit: Boolean; - function Prepare(server:Boolean): Boolean; - procedure NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean); - function X500StrToStr(const Prefix: string; const Value: TX500String): string; - function X501NameToStr(const Value: TX501Name): string; - function GetCert: PASN1Struct; - public - constructor Create(const Value: TTCPBlockSocket); override; - destructor Destroy; override; - {:See @inherited} - function LibVersion: String; override; - {:See @inherited} - function LibName: String; override; - {:See @inherited and @link(ssl_streamsec) for more details.} - function Connect: boolean; override; - {:See @inherited and @link(ssl_streamsec) for more details.} - function Accept: boolean; override; - {:See @inherited} - function Shutdown: boolean; override; - {:See @inherited} - function BiShutdown: boolean; override; - {:See @inherited} - function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override; - {:See @inherited} - function WaitingData: Integer; override; - {:See @inherited} - function GetSSLVersion: string; override; - {:See @inherited} - function GetPeerSubject: string; override; - {:See @inherited} - function GetPeerIssuer: string; override; - {:See @inherited} - function GetPeerName: string; override; - {:See @inherited} - function GetPeerFingerprint: string; override; - {:See @inherited} - function GetCertInfo: string; override; - published - {:TLS server for tuning of StreamSecII.} - property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; - end; - -implementation - -{==============================================================================} -procedure TMyTLSSynSockSlave.SetMyTLSServer(const Value: TCustomTLSInternalServer); -begin - TLSServer := Value; -end; - -function TMyTLSSynSockSlave.GetMyTLSServer: TCustomTLSInternalServer; -begin - Result := TLSServer; -end; - -{==============================================================================} - -constructor TSSLStreamSec.Create(const Value: TTCPBlockSocket); -begin - inherited Create(Value); - FSlave := nil; - FIsServer := False; - FTLSServer := nil; -end; - -destructor TSSLStreamSec.Destroy; -begin - DeInit; - inherited Destroy; -end; - -function TSSLStreamSec.LibVersion: String; -begin - Result := 'StreamSecII'; -end; - -function TSSLStreamSec.LibName: String; -begin - Result := 'ssl_streamsec'; -end; - -function TSSLStreamSec.SSLCheck: Boolean; -begin - Result := true; - FLastErrorDesc := ''; - if not Assigned(FSlave) then - Exit; - FLastError := FSlave.ErrorCode; - if FLastError <> 0 then - begin - FLastErrorDesc := TlsConst.AlertMsg(FLastError); - end; -end; - -procedure TSSLStreamSec.NotTrustEvent(Sender: TObject; Cert: TASN1Struct; var ExplicitTrust: Boolean); -begin - ExplicitTrust := true; -end; - -function TSSLStreamSec.Init(server:Boolean): Boolean; -var - st: TMemoryStream; - pass: ISecretKey; - ws: WideString; -begin - Result := False; - ws := FKeyPassword; - pass := TSecretKey.CreateBmpStr(PWideChar(ws), length(ws)); - try - FIsServer := Server; - FSlave := TMyTLSSynSockSlave.CreateSocket(FSocket.Socket); - if Assigned(FTLSServer) then - FSlave.MyTLSServer := FTLSServer - else - if Assigned(TLSInternalServer.GlobalServer) then - FSlave.MyTLSServer := TLSInternalServer.GlobalServer - else begin - FSlave.MyTLSServer := TSimpleTLSInternalServer.Create(nil); - FServerCreated := True; - end; - if server then - FSlave.MyTLSServer.ClientOrServer := cosServerSide - else - FSlave.MyTLSServer.ClientOrServer := cosClientSide; - if not FVerifyCert then - begin - FSlave.MyTLSServer.OnCertNotTrusted := NotTrustEvent; - end; - FSlave.MyTLSServer.Options.VerifyServerName := []; - FSlave.MyTLSServer.Options.Export40Bit := prAllowed; - FSlave.MyTLSServer.Options.Export56Bit := prAllowed; - FSlave.MyTLSServer.Options.RequestClientCertificate := False; - FSlave.MyTLSServer.Options.RequireClientCertificate := False; - if server and FVerifyCert then - begin - FSlave.MyTLSServer.Options.RequestClientCertificate := True; - FSlave.MyTLSServer.Options.RequireClientCertificate := True; - end; - if FCertCAFile <> '' then - FSlave.MyTLSServer.LoadRootCertsFromFile(CertCAFile); - if FCertCA <> '' then - begin - st := TMemoryStream.Create; - try - WriteStrToStream(st, FCertCA); - st.Seek(0, soFromBeginning); - FSlave.MyTLSServer.LoadRootCertsFromStream(st); - finally - st.free; - end; - end; - if FTrustCertificateFile <> '' then - FSlave.MyTLSServer.LoadTrustedCertsFromFile(FTrustCertificateFile); - if FTrustCertificate <> '' then - begin - st := TMemoryStream.Create; - try - WriteStrToStream(st, FTrustCertificate); - st.Seek(0, soFromBeginning); - FSlave.MyTLSServer.LoadTrustedCertsFromStream(st); - finally - st.free; - end; - end; - if FPrivateKeyFile <> '' then - FSlave.MyTLSServer.LoadPrivateKeyRingFromFile(FPrivateKeyFile, pass); -// FSlave.MyTLSServer.PrivateKeyRing.LoadPrivateKeyFromFile(FPrivateKeyFile, pass); - if FPrivateKey <> '' then - begin - st := TMemoryStream.Create; - try - WriteStrToStream(st, FPrivateKey); - st.Seek(0, soFromBeginning); - FSlave.MyTLSServer.LoadPrivateKeyRingFromStream(st, pass); - finally - st.free; - end; - end; - if FCertificateFile <> '' then - FSlave.MyTLSServer.LoadMyCertsFromFile(FCertificateFile); - if FCertificate <> '' then - begin - st := TMemoryStream.Create; - try - WriteStrToStream(st, FCertificate); - st.Seek(0, soFromBeginning); - FSlave.MyTLSServer.LoadMyCertsFromStream(st); - finally - st.free; - end; - end; - if FPFXfile <> '' then - FSlave.MyTLSServer.ImportFromPFX(FPFXfile, pass); - if server and FServerCreated then - begin - FSlave.MyTLSServer.Options.BulkCipherAES128 := prPrefer; - FSlave.MyTLSServer.Options.BulkCipherAES256 := prAllowed; - FSlave.MyTLSServer.Options.EphemeralECDHKeySize := ecs256; - FSlave.MyTLSServer.Options.SignatureRSA := prPrefer; - FSlave.MyTLSServer.Options.KeyAgreementRSA := prAllowed; - FSlave.MyTLSServer.Options.KeyAgreementECDHE := prAllowed; - FSlave.MyTLSServer.Options.KeyAgreementDHE := prPrefer; - FSlave.MyTLSServer.TLSSetupServer; - end; - Result := true; - finally - pass := nil; - end; -end; - -function TSSLStreamSec.DeInit: Boolean; -var - obj: TObject; -begin - Result := True; - if assigned(FSlave) then - begin - FSlave.Close; - if FServerCreated then - obj := FSlave.TLSServer - else - obj := nil; - FSlave.Free; - obj.Free; - FSlave := nil; - end; - FSSLEnabled := false; -end; - -function TSSLStreamSec.Prepare(server:Boolean): Boolean; -begin - Result := false; - DeInit; - if Init(server) then - Result := true - else - DeInit; -end; - -function TSSLStreamSec.Connect: boolean; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(false) then - begin - FSlave.Open; - SSLCheck; - if FLastError <> 0 then - Exit; - FSSLEnabled := True; - Result := True; - end; -end; - -function TSSLStreamSec.Accept: boolean; -begin - Result := False; - if FSocket.Socket = INVALID_SOCKET then - Exit; - if Prepare(true) then - begin - FSlave.DoConnect; - SSLCheck; - if FLastError <> 0 then - Exit; - FSSLEnabled := True; - Result := True; - end; -end; - -function TSSLStreamSec.Shutdown: boolean; -begin - Result := BiShutdown; -end; - -function TSSLStreamSec.BiShutdown: boolean; -begin - DeInit; - Result := True; -end; - -function TSSLStreamSec.SendBuffer(Buffer: TMemory; Len: Integer): Integer; -var - l: integer; -begin - l := len; - FSlave.SendBuf(Buffer^, l, true); - Result := l; - SSLCheck; -end; - -function TSSLStreamSec.RecvBuffer(Buffer: TMemory; Len: Integer): Integer; -var - l: integer; -begin - l := Len; - Result := FSlave.ReceiveBuf(Buffer^, l); - SSLCheck; -end; - -function TSSLStreamSec.WaitingData: Integer; -begin - Result := 0; - while FSlave.Connected do begin - Result := FSlave.ReceiveLength; - if Result > 0 then - Break; - Sleep(1); - end; -end; - -function TSSLStreamSec.GetSSLVersion: string; -begin - Result := 'SSLv3 or TLSv1'; -end; - -function TSSLStreamSec.GetCert: PASN1Struct; -begin - if FIsServer then - Result := FSlave.GetClientCert - else - Result := FSlave.GetServerCert; -end; - -function TSSLStreamSec.GetPeerSubject: string; -var - XName: TX501Name; - Cert: PASN1Struct; -begin - Result := ''; - Cert := GetCert; - if Assigned(cert) then - begin - ExtractSubject(Cert^,XName, false); - Result := X501NameToStr(XName); - end; -end; - -function TSSLStreamSec.GetPeerName: string; -var - XName: TX501Name; - Cert: PASN1Struct; -begin - Result := ''; - Cert := GetCert; - if Assigned(cert) then - begin - ExtractSubject(Cert^,XName, false); - Result := XName.commonName.Str; - end; -end; - -function TSSLStreamSec.GetPeerIssuer: string; -var - XName: TX501Name; - Cert: PASN1Struct; -begin - Result := ''; - Cert := GetCert; - if Assigned(cert) then - begin - ExtractIssuer(Cert^, XName, false); - Result := X501NameToStr(XName); - end; -end; - -function TSSLStreamSec.GetPeerFingerprint: string; -var - Cert: PASN1Struct; -begin - Result := ''; - Cert := GetCert; - if Assigned(cert) then - Result := MD5(Cert.ContentAsOctetString); -end; - -function TSSLStreamSec.GetCertInfo: string; -var - Cert: PASN1Struct; - l: Tstringlist; -begin - Result := ''; - Cert := GetCert; - if Assigned(cert) then - begin - l := TStringList.Create; - try - Asn1.RenderAsText(cert^, l, true, true, true, 2); - Result := l.Text; - finally - l.free; - end; - end; -end; - -function TSSLStreamSec.X500StrToStr(const Prefix: string; - const Value: TX500String): string; -begin - if Value.Str = '' then - Result := '' - else - Result := '/' + Prefix + '=' + Value.Str; -end; - -function TSSLStreamSec.X501NameToStr(const Value: TX501Name): string; -begin - Result := X500StrToStr('CN',Value.commonName) + - X500StrToStr('C',Value.countryName) + - X500StrToStr('L',Value.localityName) + - X500StrToStr('ST',Value.stateOrProvinceName) + - X500StrToStr('O',Value.organizationName) + - X500StrToStr('OU',Value.organizationalUnitName) + - X500StrToStr('T',Value.title) + - X500StrToStr('N',Value.name) + - X500StrToStr('G',Value.givenName) + - X500StrToStr('I',Value.initials) + - X500StrToStr('SN',Value.surname) + - X500StrToStr('GQ',Value.generationQualifier) + - X500StrToStr('DNQ',Value.dnQualifier) + - X500StrToStr('E',Value.emailAddress); -end; - - -{==============================================================================} - -initialization - SSLImplementation := TSSLStreamSec; - -finalization - -end. - - diff --git a/3rd/synapse/source/sslinux.inc b/3rd/synapse/source/sslinux.inc deleted file mode 100644 index 54236b6a2..000000000 --- a/3rd/synapse/source/sslinux.inc +++ /dev/null @@ -1,1313 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.000.009 | -|==============================================================================| -| Content: Socket Independent Platform Layer - Linux definition include | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$IFDEF LINUX} - -//{$DEFINE FORCEOLDAPI} -{Note about define FORCEOLDAPI: -If you activate this compiler directive, then is allways used old socket API -for name resolution. If you leave this directive inactive, then the new API -is used, when running system allows it. - -For IPv6 support you must have new API! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -interface - -uses - SyncObjs, SysUtils, Classes, - synafpc, - Libc; - -function InitSocketInterface(stack: string): Boolean; -function DestroySocketInterface: Boolean; - -const - WinsockLevel = $0202; - -type - u_char = Char; - u_short = Word; - u_int = Integer; - u_long = Longint; - pu_long = ^u_long; - pu_short = ^u_short; - TSocket = u_int; - TAddrFamily = integer; - - TMemory = pointer; - - -const - DLLStackName = 'libc.so.6'; - - cLocalhost = '127.0.0.1'; - cAnyHost = '0.0.0.0'; - cBroadcast = '255.255.255.255'; - c6Localhost = '::1'; - c6AnyHost = '::0'; - c6Broadcast = 'ffff::1'; - cAnyPort = '0'; - -type - DWORD = Integer; - __fd_mask = LongWord; -const - __FD_SETSIZE = 1024; - __NFDBITS = 8 * sizeof(__fd_mask); -type - __fd_set = {packed} record - fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask; - end; - TFDSet = __fd_set; - PFDSet = ^TFDSet; - -const - FIONREAD = $541B; - FIONBIO = $5421; - FIOASYNC = $5452; - -type - PTimeVal = ^TTimeVal; - TTimeVal = packed record - tv_sec: Longint; - tv_usec: Longint; - end; - -const - IPPROTO_IP = 0; { Dummy } - IPPROTO_ICMP = 1; { Internet Control Message Protocol } - IPPROTO_IGMP = 2; { Internet Group Management Protocol} - IPPROTO_TCP = 6; { TCP } - IPPROTO_UDP = 17; { User Datagram Protocol } - IPPROTO_IPV6 = 41; - IPPROTO_ICMPV6 = 58; - IPPROTO_RM = 113; - - IPPROTO_RAW = 255; - IPPROTO_MAX = 256; - -type - PInAddr = ^TInAddr; - TInAddr = packed record - case integer of - 0: (S_bytes: packed array [0..3] of byte); - 1: (S_addr: u_long); - end; - - PSockAddrIn = ^TSockAddrIn; - TSockAddrIn = packed record - case Integer of - 0: (sin_family: u_short; - sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of Char); - 1: (sa_family: u_short; - sa_data: array[0..13] of Char) - end; - - TIP_mreq = record - imr_multiaddr: TInAddr; { IP multicast address of group } - imr_interface: TInAddr; { local IP address of interface } - end; - - PInAddr6 = ^TInAddr6; - TInAddr6 = packed record - case integer of - 0: (S6_addr: packed array [0..15] of byte); - 1: (u6_addr8: packed array [0..15] of byte); - 2: (u6_addr16: packed array [0..7] of word); - 3: (u6_addr32: packed array [0..3] of integer); - end; - - PSockAddrIn6 = ^TSockAddrIn6; - TSockAddrIn6 = packed record - sin6_family: u_short; // AF_INET6 - sin6_port: u_short; // Transport level port number - sin6_flowinfo: u_long; // IPv6 flow information - sin6_addr: TInAddr6; // IPv6 address - sin6_scope_id: u_long; // Scope Id: IF number for link-local - // SITE id for site-local - end; - - TIPv6_mreq = record - ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. - ipv6mr_interface: integer; // Interface index. - padding: u_long; - end; - - PHostEnt = ^THostEnt; - THostent = record - h_name: PChar; - h_aliases: PPChar; - h_addrtype: Integer; - h_length: Cardinal; - case Byte of - 0: (h_addr_list: PPChar); - 1: (h_addr: PPChar); - end; - - PNetEnt = ^TNetEnt; - TNetEnt = record - n_name: PChar; - n_aliases: PPChar; - n_addrtype: Integer; - n_net: uint32_t; - end; - - PServEnt = ^TServEnt; - TServEnt = record - s_name: PChar; - s_aliases: PPChar; - s_port: Integer; - s_proto: PChar; - end; - - PProtoEnt = ^TProtoEnt; - TProtoEnt = record - p_name: PChar; - p_aliases: ^PChar; - p_proto: u_short; - end; - -const - INADDR_ANY = $00000000; - INADDR_LOOPBACK = $7F000001; - INADDR_BROADCAST = $FFFFFFFF; - INADDR_NONE = $FFFFFFFF; - ADDR_ANY = INADDR_ANY; - INVALID_SOCKET = TSocket(NOT(0)); - SOCKET_ERROR = -1; - -Const - IP_TOS = 1; { int; IP type of service and precedence. } - IP_TTL = 2; { int; IP time to live. } - IP_HDRINCL = 3; { int; Header is included with data. } - IP_OPTIONS = 4; { ip_opts; IP per-packet options. } - IP_ROUTER_ALERT = 5; { bool } - IP_RECVOPTS = 6; { bool } - IP_RETOPTS = 7; { bool } - IP_PKTINFO = 8; { bool } - IP_PKTOPTIONS = 9; - IP_PMTUDISC = 10; { obsolete name? } - IP_MTU_DISCOVER = 10; { int; see below } - IP_RECVERR = 11; { bool } - IP_RECVTTL = 12; { bool } - IP_RECVTOS = 13; { bool } - IP_MULTICAST_IF = 32; { in_addr; set/get IP multicast i/f } - IP_MULTICAST_TTL = 33; { u_char; set/get IP multicast ttl } - IP_MULTICAST_LOOP = 34; { i_char; set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = 35; { ip_mreq; add an IP group membership } - IP_DROP_MEMBERSHIP = 36; { ip_mreq; drop an IP group membership } - - SOL_SOCKET = 1; - - SO_DEBUG = 1; - SO_REUSEADDR = 2; - SO_TYPE = 3; - SO_ERROR = 4; - SO_DONTROUTE = 5; - SO_BROADCAST = 6; - SO_SNDBUF = 7; - SO_RCVBUF = 8; - SO_KEEPALIVE = 9; - SO_OOBINLINE = 10; - SO_NO_CHECK = 11; - SO_PRIORITY = 12; - SO_LINGER = 13; - SO_BSDCOMPAT = 14; - SO_REUSEPORT = 15; - SO_PASSCRED = 16; - SO_PEERCRED = 17; - SO_RCVLOWAT = 18; - SO_SNDLOWAT = 19; - SO_RCVTIMEO = 20; - SO_SNDTIMEO = 21; -{ Security levels - as per NRL IPv6 - don't actually do anything } - SO_SECURITY_AUTHENTICATION = 22; - SO_SECURITY_ENCRYPTION_TRANSPORT = 23; - SO_SECURITY_ENCRYPTION_NETWORK = 24; - SO_BINDTODEVICE = 25; -{ Socket filtering } - SO_ATTACH_FILTER = 26; - SO_DETACH_FILTER = 27; - - SOMAXCONN = 128; - - IPV6_UNICAST_HOPS = 16; - IPV6_MULTICAST_IF = 17; - IPV6_MULTICAST_HOPS = 18; - IPV6_MULTICAST_LOOP = 19; - IPV6_JOIN_GROUP = 20; - IPV6_LEAVE_GROUP = 21; - - MSG_NOSIGNAL = $4000; // Do not generate SIGPIPE. - - // getnameinfo constants - NI_MAXHOST = 1025; - NI_MAXSERV = 32; - NI_NOFQDN = $4; - NI_NUMERICHOST = $1; - NI_NAMEREQD = $8; - NI_NUMERICSERV = $2; - NI_DGRAM = $10; - -const - SOCK_STREAM = 1; { stream socket } - SOCK_DGRAM = 2; { datagram socket } - SOCK_RAW = 3; { raw-protocol interface } - SOCK_RDM = 4; { reliably-delivered message } - SOCK_SEQPACKET = 5; { sequenced packet stream } - -{ TCP options. } - TCP_NODELAY = $0001; - -{ Address families. } - - AF_UNSPEC = 0; { unspecified } - AF_INET = 2; { internetwork: UDP, TCP, etc. } - AF_INET6 = 10; { Internetwork Version 6 } - AF_MAX = 24; - -{ Protocol families, same as address families for now. } - PF_UNSPEC = AF_UNSPEC; - PF_INET = AF_INET; - PF_INET6 = AF_INET6; - PF_MAX = AF_MAX; - -type - { Structure used by kernel to store most addresses. } - PSockAddr = ^TSockAddr; - TSockAddr = TSockAddrIn; - - { Structure used by kernel to pass protocol information in raw sockets. } - PSockProto = ^TSockProto; - TSockProto = packed record - sp_family: u_short; - sp_protocol: u_short; - end; - -type - PAddrInfo = ^TAddrInfo; - TAddrInfo = record - ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST. - ai_family: integer; // PF_xxx. - ai_socktype: integer; // SOCK_xxx. - ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6. - ai_addrlen: u_int; // Length of ai_addr. - ai_addr: PSockAddr; // Binary address. - ai_canonname: PChar; // Canonical name for nodename. - ai_next: PAddrInfo; // Next structure in linked list. - end; - -const - // Flags used in "hints" argument to getaddrinfo(). - AI_PASSIVE = $1; // Socket address will be used in bind() call. - AI_CANONNAME = $2; // Return canonical name in first ai_canonname. - AI_NUMERICHOST = $4; // Nodename must be a numeric address string. - -type -{ Structure used for manipulating linger option. } - PLinger = ^TLinger; - TLinger = packed record - l_onoff: integer; - l_linger: integer; - end; - -const - - MSG_OOB = $01; // Process out-of-band data. - MSG_PEEK = $02; // Peek at incoming messages. - -const - WSAEINTR = EINTR; - WSAEBADF = EBADF; - WSAEACCES = EACCES; - WSAEFAULT = EFAULT; - WSAEINVAL = EINVAL; - WSAEMFILE = EMFILE; - WSAEWOULDBLOCK = EWOULDBLOCK; - WSAEINPROGRESS = EINPROGRESS; - WSAEALREADY = EALREADY; - WSAENOTSOCK = ENOTSOCK; - WSAEDESTADDRREQ = EDESTADDRREQ; - WSAEMSGSIZE = EMSGSIZE; - WSAEPROTOTYPE = EPROTOTYPE; - WSAENOPROTOOPT = ENOPROTOOPT; - WSAEPROTONOSUPPORT = EPROTONOSUPPORT; - WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT; - WSAEOPNOTSUPP = EOPNOTSUPP; - WSAEPFNOSUPPORT = EPFNOSUPPORT; - WSAEAFNOSUPPORT = EAFNOSUPPORT; - WSAEADDRINUSE = EADDRINUSE; - WSAEADDRNOTAVAIL = EADDRNOTAVAIL; - WSAENETDOWN = ENETDOWN; - WSAENETUNREACH = ENETUNREACH; - WSAENETRESET = ENETRESET; - WSAECONNABORTED = ECONNABORTED; - WSAECONNRESET = ECONNRESET; - WSAENOBUFS = ENOBUFS; - WSAEISCONN = EISCONN; - WSAENOTCONN = ENOTCONN; - WSAESHUTDOWN = ESHUTDOWN; - WSAETOOMANYREFS = ETOOMANYREFS; - WSAETIMEDOUT = ETIMEDOUT; - WSAECONNREFUSED = ECONNREFUSED; - WSAELOOP = ELOOP; - WSAENAMETOOLONG = ENAMETOOLONG; - WSAEHOSTDOWN = EHOSTDOWN; - WSAEHOSTUNREACH = EHOSTUNREACH; - WSAENOTEMPTY = ENOTEMPTY; - WSAEPROCLIM = -1; - WSAEUSERS = EUSERS; - WSAEDQUOT = EDQUOT; - WSAESTALE = ESTALE; - WSAEREMOTE = EREMOTE; - WSASYSNOTREADY = -2; - WSAVERNOTSUPPORTED = -3; - WSANOTINITIALISED = -4; - WSAEDISCON = -5; - WSAHOST_NOT_FOUND = HOST_NOT_FOUND; - WSATRY_AGAIN = TRY_AGAIN; - WSANO_RECOVERY = NO_RECOVERY; - WSANO_DATA = -6; - - EAI_BADFLAGS = -1; { Invalid value for `ai_flags' field. } - EAI_NONAME = -2; { NAME or SERVICE is unknown. } - EAI_AGAIN = -3; { Temporary failure in name resolution. } - EAI_FAIL = -4; { Non-recoverable failure in name res. } - EAI_NODATA = -5; { No address associated with NAME. } - EAI_FAMILY = -6; { `ai_family' not supported. } - EAI_SOCKTYPE = -7; { `ai_socktype' not supported. } - EAI_SERVICE = -8; { SERVICE not supported for `ai_socktype'. } - EAI_ADDRFAMILY = -9; { Address family for NAME not supported. } - EAI_MEMORY = -10; { Memory allocation failure. } - EAI_SYSTEM = -11; { System error returned in `errno'. } - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = packed record - wVersion: Word; - wHighVersion: Word; - szDescription: array[0..WSADESCRIPTION_LEN] of Char; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; - iMaxSockets: Word; - iMaxUdpDg: Word; - lpVendorInfo: PChar; - end; - - function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -var - in6addr_any, in6addr_loopback : TInAddr6; - -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); - -{=============================================================================} - -type - TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer; - cdecl; - TWSACleanup = function: Integer; - cdecl; - TWSAGetLastError = function: Integer; - cdecl; - TGetServByName = function(name, proto: PChar): PServEnt; - cdecl; - TGetServByPort = function(port: Integer; proto: PChar): PServEnt; - cdecl; - TGetProtoByName = function(name: PChar): PProtoEnt; - cdecl; - TGetProtoByNumber = function(proto: Integer): PProtoEnt; - cdecl; - TGetHostByName = function(name: PChar): PHostEnt; - cdecl; - TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; - cdecl; - TGetHostName = function(name: PChar; len: Integer): Integer; - cdecl; - TShutdown = function(s: TSocket; how: Integer): Integer; - cdecl; - TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar; - optlen: Integer): Integer; - cdecl; - TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PChar; - var optlen: Integer): Integer; - cdecl; - TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr; - tolen: Integer): Integer; - cdecl; - TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer; - cdecl; - TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer; - cdecl; - TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; - var fromlen: Integer): Integer; - cdecl; - Tntohs = function(netshort: u_short): u_short; - cdecl; - Tntohl = function(netlong: u_long): u_long; - cdecl; - TListen = function(s: TSocket; backlog: Integer): Integer; - cdecl; - TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer; - cdecl; - TInet_ntoa = function(inaddr: TInAddr): PChar; - cdecl; - TInet_addr = function(cp: PChar): u_long; - cdecl; - Thtons = function(hostshort: u_short): u_short; - cdecl; - Thtonl = function(hostlong: u_long): u_long; - cdecl; - TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - cdecl; - TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - cdecl; - TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer; - cdecl; - TCloseSocket = function(s: TSocket): Integer; - cdecl; - TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer; - cdecl; - TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; - cdecl; - TTSocket = function(af, Struc, Protocol: Integer): TSocket; - cdecl; - TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; - cdecl; - - TGetAddrInfo = function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo; - var Addrinfo: PAddrInfo): integer; - cdecl; - TFreeAddrInfo = procedure(ai: PAddrInfo); - cdecl; - TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PChar; - hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer; - cdecl; - -var - WSAStartup: TWSAStartup = nil; - WSACleanup: TWSACleanup = nil; - WSAGetLastError: TWSAGetLastError = nil; - GetServByName: TGetServByName = nil; - GetServByPort: TGetServByPort = nil; - GetProtoByName: TGetProtoByName = nil; - GetProtoByNumber: TGetProtoByNumber = nil; - GetHostByName: TGetHostByName = nil; - GetHostByAddr: TGetHostByAddr = nil; - ssGetHostName: TGetHostName = nil; - Shutdown: TShutdown = nil; - SetSockOpt: TSetSockOpt = nil; - GetSockOpt: TGetSockOpt = nil; - ssSendTo: TSendTo = nil; - ssSend: TSend = nil; - ssRecv: TRecv = nil; - ssRecvFrom: TRecvFrom = nil; - ntohs: Tntohs = nil; - ntohl: Tntohl = nil; - Listen: TListen = nil; - IoctlSocket: TIoctlSocket = nil; - Inet_ntoa: TInet_ntoa = nil; - Inet_addr: TInet_addr = nil; - htons: Thtons = nil; - htonl: Thtonl = nil; - ssGetSockName: TGetSockName = nil; - ssGetPeerName: TGetPeerName = nil; - ssConnect: TConnect = nil; - CloseSocket: TCloseSocket = nil; - ssBind: TBind = nil; - ssAccept: TAccept = nil; - Socket: TTSocket = nil; - Select: TSelect = nil; - - GetAddrInfo: TGetAddrInfo = nil; - FreeAddrInfo: TFreeAddrInfo = nil; - GetNameInfo: TGetNameInfo = nil; - -function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; cdecl; -function LSWSACleanup: Integer; cdecl; -function LSWSAGetLastError: Integer; cdecl; - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - -type - TVarSin = packed record - case integer of - 0: (AddressFamily: u_short); - 1: ( - case sin_family: u_short of - AF_INET: (sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of Char); - AF_INET6: (sin6_port: u_short; - sin6_flowinfo: u_long; - sin6_addr: TInAddr6; - sin6_scope_id: u_long); - ); - end; - -function SizeOfVarSin(sin: TVarSin): integer; - -function Bind(s: TSocket; const addr: TVarSin): Integer; -function Connect(s: TSocket; const name: TVarSin): Integer; -function GetSockName(s: TSocket; var name: TVarSin): Integer; -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -function GetHostName: string; -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -function Accept(s: TSocket; var addr: TVarSin): TSocket; - -function IsNewApi(Family: integer): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): string; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; - -{==============================================================================} -implementation - -var - SynSockCount: Integer = 0; - LibHandle: TLibHandle = 0; - Libwship6Handle: TLibHandle = 0; - -function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0)); -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and - (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and - (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1)); -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80)); -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0)); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := (a^.u6_addr8[0] = $FF); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.u6_addr8[15] := 1; -end; - -{=============================================================================} -var -{$IFNDEF VER1_0} //FTP version 1.0.x - errno_loc: function: PInteger cdecl = nil; -{$ELSE} - errno_loc: function: PInteger = nil; cdecl; -{$ENDIF} - -function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; -begin - with WSData do - begin - wVersion := wVersionRequired; - wHighVersion := $202; - szDescription := 'Synsock - Synapse Platform Independent Socket Layer'; - szSystemStatus := 'Running on Linux'; - iMaxSockets := 32768; - iMaxUdpDg := 8192; - end; - Result := 0; -end; - -function LSWSACleanup: Integer; -begin - Result := 0; -end; - -function LSWSAGetLastError: Integer; -var - p: PInteger; -begin - p := errno_loc; - Result := p^; -end; - -function __FDELT(Socket: TSocket): Integer; -begin - Result := Socket div __NFDBITS; -end; - -function __FDMASK(Socket: TSocket): __fd_mask; -begin - Result := LongWord(1) shl (Socket mod __NFDBITS); -end; - -function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean; -begin - Result := (fdset.fds_bits[__FDELT(Socket)] and __FDMASK(Socket)) <> 0; -end; - -procedure FD_SET(Socket: TSocket; var fdset: TFDSet); -begin - fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] or __FDMASK(Socket); -end; - -procedure FD_CLR(Socket: TSocket; var fdset: TFDSet); -begin - fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] and (not __FDMASK(Socket)); -end; - -procedure FD_ZERO(var fdset: TFDSet); -var - I: Integer; -begin - with fdset do - for I := Low(fds_bits) to High(fds_bits) do - fds_bits[I] := 0; -end; - -{=============================================================================} - -function SizeOfVarSin(sin: TVarSin): integer; -begin - case sin.sin_family of - AF_INET: - Result := SizeOf(TSockAddrIn); - AF_INET6: - Result := SizeOf(TSockAddrIn6); - else - Result := 0; - end; -end; - -{=============================================================================} - -function Bind(s: TSocket; const addr: TVarSin): Integer; -begin - Result := ssBind(s, @addr, SizeOfVarSin(addr)); -end; - -function Connect(s: TSocket; const name: TVarSin): Integer; -begin - Result := ssConnect(s, @name, SizeOfVarSin(name)); -end; - -function GetSockName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetSockName(s, @name, Len); -end; - -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetPeerName(s, @name, Len); -end; - -function GetHostName: string; -var - s: string; -begin - Result := ''; - setlength(s, 255); - ssGetHostName(pchar(s), Length(s) - 1); - Result := Pchar(s); -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := ssSend(s, Buf^, len, flags); -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := ssRecv(s, Buf^, len, flags); -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -begin - Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto)); -end; - -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -var - x: integer; -begin - x := SizeOf(from); - Result := ssRecvFrom(s, Buf^, len, flags, @from, x); -end; - -function Accept(s: TSocket; var addr: TVarSin): TSocket; -var - x: integer; -begin - x := SizeOf(addr); - Result := ssAccept(s, @addr, x); -end; - -{=============================================================================} -function IsNewApi(Family: integer): Boolean; -begin - Result := SockEnhancedApi; - if not Result then - Result := (Family = AF_INET6) and SockWship6Api; -end; - -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -type - pu_long = ^u_long; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - HostEnt: PHostEnt; - r: integer; - Hints1, Hints2: TAddrInfo; - Sin1, Sin2: TVarSin; - TwoPass: boolean; - - function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer; - var - Addr: PAddrInfo; - begin - Addr := nil; - try - FillChar(Sin, Sizeof(Sin), 0); - if Hints.ai_socktype = SOCK_RAW then - begin - Hints.ai_socktype := 0; - Hints.ai_protocol := 0; - Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr); - end - else - begin - if (IP = cAnyHost) or (IP = c6AnyHost) then - begin - Hints.ai_flags := AI_PASSIVE; - Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); - end - else - if (IP = cLocalhost) or (IP = c6Localhost) then - begin - Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); - end - else - begin - Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr); - end; - end; - if Result = 0 then - if (Addr <> nil) then - Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen); - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - -begin - Result := 0; - FillChar(Sin, Sizeof(Sin), 0); - if not IsNewApi(family) then - begin - SynSockCS.Enter; - try - Sin.sin_family := AF_INET; - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Sin.sin_port := synsock.htons(StrToIntDef(Port, 0)) - else - Sin.sin_port := ServEnt^.s_port; - if IP = cBroadcast then - Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST) - else - begin - Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP)); - if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then - begin - HostEnt := synsock.GetHostByName(PChar(IP)); - Result := synsock.WSAGetLastError; - if HostEnt <> nil then - Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - begin - FillChar(Hints1, Sizeof(Hints1), 0); - FillChar(Hints2, Sizeof(Hints2), 0); - TwoPass := False; - if Family = AF_UNSPEC then - begin - if PreferIP4 then - begin - Hints1.ai_family := AF_INET; - Hints2.ai_family := AF_INET6; - TwoPass := True; - end - else - begin - Hints2.ai_family := AF_INET; - Hints1.ai_family := AF_INET6; - TwoPass := True; - end; - end - else - Hints1.ai_family := Family; - - Hints1.ai_socktype := SockType; - Hints1.ai_protocol := SockProtocol; - Hints2.ai_socktype := Hints1.ai_socktype; - Hints2.ai_protocol := Hints1.ai_protocol; - - r := GetAddr(IP, Port, Hints1, Sin1); - Result := r; - sin := sin1; - if r <> 0 then - if TwoPass then - begin - r := GetAddr(IP, Port, Hints2, Sin2); - Result := r; - if r = 0 then - sin := sin2; - end; - end; -end; - -function GetSinIP(Sin: TVarSin): string; -var - p: PChar; - host, serv: string; - hostlen, servlen: integer; - r: integer; -begin - Result := ''; - if not IsNewApi(Sin.AddressFamily) then - begin - p := synsock.inet_ntoa(Sin.sin_addr); - if p <> nil then - Result := p; - end - else - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen, - PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - Result := PChar(host); - end; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - if (Sin.sin_family = AF_INET6) then - Result := synsock.ntohs(Sin.sin6_port) - else - Result := synsock.ntohs(Sin.sin_port); -end; - -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -type - TaPInAddr = array[0..250] of PInAddr; - PaPInAddr = ^TaPInAddr; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - AddrNext: PAddrInfo; - r: integer; - host, serv: string; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IP: u_long; - PAdrPtr: PaPInAddr; - i: Integer; - s: string; - InAddr: TInAddr; -begin - IPList.Clear; - if not IsNewApi(Family) then - begin - IP := synsock.inet_addr(PChar(Name)); - if IP = u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := synsock.GetHostByName(PChar(Name)); - if RemoteHost <> nil then - begin - PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); - i := 0; - while PAdrPtr^[i] <> nil do - begin - InAddr := PAdrPtr^[i]^; - s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1], - InAddr.S_bytes[2], InAddr.S_bytes[3]]); - IPList.Add(s); - Inc(i); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - IPList.Add(Name); - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr); - if r = 0 then - begin - AddrNext := Addr; - while not(AddrNext = nil) do - begin - if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET)) - or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen, - PChar(host), hostlen, PChar(serv), servlen, - NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - begin - host := PChar(host); - IPList.Add(host); - end; - end; - AddrNext := AddrNext^.ai_next; - end; - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - if IPList.Count = 0 then - IPList.Add(cAnyHost); -end; - -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; -begin - Result := 0; - if not IsNewApi(Family) then - begin - SynSockCS.Enter; - try - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Result := StrToIntDef(Port, 0) - else - Result := synsock.htons(ServEnt^.s_port); - finally - SynSockCS.Leave; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := Sockprotocol; - Hints.ai_flags := AI_PASSIVE; - r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); - if (r = 0) and Assigned(Addr) then - begin - if Addr^.ai_family = AF_INET then - Result := synsock.htons(Addr^.ai_addr^.sin_port); - if Addr^.ai_family = AF_INET6 then - Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; - host, serv: string; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IPn: u_long; -begin - Result := IP; - if not IsNewApi(Family) then - begin - IPn := synsock.inet_addr(PChar(IP)); - if IPn <> u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET); - if RemoteHost <> nil then - Result := RemoteHost^.h_name; - finally - SynSockCS.Leave; - end; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr); - if (r = 0) and Assigned(Addr)then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen, - PChar(host), hostlen, PChar(serv), servlen, - NI_NUMERICSERV); - if r = 0 then - Result := PChar(host); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -{=============================================================================} - -function InitSocketInterface(stack: string): Boolean; -begin - Result := False; - if stack = '' then - stack := DLLStackName; - SynSockCS.Enter; - try - if SynSockCount = 0 then - begin - SockEnhancedApi := False; - SockWship6Api := False; - Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN)); - LibHandle := LoadLibrary(PChar(Stack)); - if LibHandle <> 0 then - begin - errno_loc := GetProcAddress(LibHandle, PChar('__errno_location')); - CloseSocket := GetProcAddress(LibHandle, PChar('close')); - IoctlSocket := GetProcAddress(LibHandle, PChar('ioctl')); - WSAGetLastError := LSWSAGetLastError; - WSAStartup := LSWSAStartup; - WSACleanup := LSWSACleanup; - ssAccept := GetProcAddress(LibHandle, PChar('accept')); - ssBind := GetProcAddress(LibHandle, PChar('bind')); - ssConnect := GetProcAddress(LibHandle, PChar('connect')); - ssGetPeerName := GetProcAddress(LibHandle, PChar('getpeername')); - ssGetSockName := GetProcAddress(LibHandle, PChar('getsockname')); - GetSockOpt := GetProcAddress(LibHandle, PChar('getsockopt')); - Htonl := GetProcAddress(LibHandle, PChar('htonl')); - Htons := GetProcAddress(LibHandle, PChar('htons')); - Inet_Addr := GetProcAddress(LibHandle, PChar('inet_addr')); - Inet_Ntoa := GetProcAddress(LibHandle, PChar('inet_ntoa')); - Listen := GetProcAddress(LibHandle, PChar('listen')); - Ntohl := GetProcAddress(LibHandle, PChar('ntohl')); - Ntohs := GetProcAddress(LibHandle, PChar('ntohs')); - ssRecv := GetProcAddress(LibHandle, PChar('recv')); - ssRecvFrom := GetProcAddress(LibHandle, PChar('recvfrom')); - Select := GetProcAddress(LibHandle, PChar('select')); - ssSend := GetProcAddress(LibHandle, PChar('send')); - ssSendTo := GetProcAddress(LibHandle, PChar('sendto')); - SetSockOpt := GetProcAddress(LibHandle, PChar('setsockopt')); - ShutDown := GetProcAddress(LibHandle, PChar('shutdown')); - Socket := GetProcAddress(LibHandle, PChar('socket')); - GetHostByAddr := GetProcAddress(LibHandle, PChar('gethostbyaddr')); - GetHostByName := GetProcAddress(LibHandle, PChar('gethostbyname')); - GetProtoByName := GetProcAddress(LibHandle, PChar('getprotobyname')); - GetProtoByNumber := GetProcAddress(LibHandle, PChar('getprotobynumber')); - GetServByName := GetProcAddress(LibHandle, PChar('getservbyname')); - GetServByPort := GetProcAddress(LibHandle, PChar('getservbyport')); - ssGetHostName := GetProcAddress(LibHandle, PChar('gethostname')); - -{$IFNDEF FORCEOLDAPI} - GetAddrInfo := GetProcAddress(LibHandle, PChar('getaddrinfo')); - FreeAddrInfo := GetProcAddress(LibHandle, PChar('freeaddrinfo')); - GetNameInfo := GetProcAddress(LibHandle, PChar('getnameinfo')); - SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) - and Assigned(GetNameInfo); -{$ENDIF} - Result := True; - end; - end - else Result := True; - if Result then - Inc(SynSockCount); - finally - SynSockCS.Leave; - end; -end; - -function DestroySocketInterface: Boolean; -begin - SynSockCS.Enter; - try - Dec(SynSockCount); - if SynSockCount < 0 then - SynSockCount := 0; - if SynSockCount = 0 then - begin - if LibHandle <> 0 then - begin - FreeLibrary(libHandle); - LibHandle := 0; - end; - if LibWship6Handle <> 0 then - begin - FreeLibrary(LibWship6Handle); - LibWship6Handle := 0; - end; - end; - finally - SynSockCS.Leave; - end; - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; - SET_IN6_IF_ADDR_ANY (@in6addr_any); - SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - SynSockCS.Free; -end; - -{$ENDIF} - diff --git a/3rd/synapse/source/ssos2ws1.inc b/3rd/synapse/source/ssos2ws1.inc deleted file mode 100644 index 1a52b7039..000000000 --- a/3rd/synapse/source/ssos2ws1.inc +++ /dev/null @@ -1,1843 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.000.000 | -|==============================================================================| -| Content: Socket Independent Platform Layer - OS/2 winsock1 | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Tomas Hajny (OS2 support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$MACRO ON} - -{$IFNDEF ODIN} - {$DEFINE WINSOCK1} - {$DEFINE PMWSOCK} -{$ENDIF ODIN} - -{$IFDEF PMWSOCK} - {$DEFINE extdecl := cdecl} -{$ELSE PMWSOCK} - {$DEFINE extdecl := stdcall} -{$ENDIF PMWSOCK} - -//{$DEFINE WINSOCK1} -{Note about define WINSOCK1: -If you activate this compiler directive, then socket interface level 1.1 is -used instead default level 2.2. Level 2.2 is not available on old W95, however -you can install update. -} - -//{$DEFINE FORCEOLDAPI} -{Note about define FORCEOLDAPI: -If you activate this compiler directive, then is allways used old socket API -for name resolution. If you leave this directive inactive, then the new API -is used, when running system allows it. - -For IPv6 support you must have new API! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$IFDEF VER125} - {$DEFINE BCB} -{$ENDIF} -{$IFDEF BCB} - {$ObjExportAll On} - (*$HPPEMIT '/* EDE 2003-02-19 */' *) - (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *) - (*$HPPEMIT '#undef h_addr' *) - (*$HPPEMIT '#undef IOCPARM_MASK' *) - (*$HPPEMIT '#undef FD_SETSIZE' *) - (*$HPPEMIT '#undef IOC_VOID' *) - (*$HPPEMIT '#undef IOC_OUT' *) - (*$HPPEMIT '#undef IOC_IN' *) - (*$HPPEMIT '#undef IOC_INOUT' *) - (*$HPPEMIT '#undef FIONREAD' *) - (*$HPPEMIT '#undef FIONBIO' *) - (*$HPPEMIT '#undef FIOASYNC' *) - (*$HPPEMIT '#undef IPPROTO_IP' *) - (*$HPPEMIT '#undef IPPROTO_ICMP' *) - (*$HPPEMIT '#undef IPPROTO_IGMP' *) - (*$HPPEMIT '#undef IPPROTO_TCP' *) - (*$HPPEMIT '#undef IPPROTO_UDP' *) - (*$HPPEMIT '#undef IPPROTO_RAW' *) - (*$HPPEMIT '#undef IPPROTO_MAX' *) - (*$HPPEMIT '#undef INADDR_ANY' *) - (*$HPPEMIT '#undef INADDR_LOOPBACK' *) - (*$HPPEMIT '#undef INADDR_BROADCAST' *) - (*$HPPEMIT '#undef INADDR_NONE' *) - (*$HPPEMIT '#undef INVALID_SOCKET' *) - (*$HPPEMIT '#undef SOCKET_ERROR' *) - (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *) - (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *) - (*$HPPEMIT '#undef IP_OPTIONS' *) - (*$HPPEMIT '#undef IP_TOS' *) - (*$HPPEMIT '#undef IP_TTL' *) - (*$HPPEMIT '#undef IP_MULTICAST_IF' *) - (*$HPPEMIT '#undef IP_MULTICAST_TTL' *) - (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *) - (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *) - (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *) - (*$HPPEMIT '#undef IP_DONTFRAGMENT' *) - (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *) - (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *) - (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *) - (*$HPPEMIT '#undef SOL_SOCKET' *) - (*$HPPEMIT '#undef SO_DEBUG' *) - (*$HPPEMIT '#undef SO_ACCEPTCONN' *) - (*$HPPEMIT '#undef SO_REUSEADDR' *) - (*$HPPEMIT '#undef SO_KEEPALIVE' *) - (*$HPPEMIT '#undef SO_DONTROUTE' *) - (*$HPPEMIT '#undef SO_BROADCAST' *) - (*$HPPEMIT '#undef SO_USELOOPBACK' *) - (*$HPPEMIT '#undef SO_LINGER' *) - (*$HPPEMIT '#undef SO_OOBINLINE' *) - (*$HPPEMIT '#undef SO_DONTLINGER' *) - (*$HPPEMIT '#undef SO_SNDBUF' *) - (*$HPPEMIT '#undef SO_RCVBUF' *) - (*$HPPEMIT '#undef SO_SNDLOWAT' *) - (*$HPPEMIT '#undef SO_RCVLOWAT' *) - (*$HPPEMIT '#undef SO_SNDTIMEO' *) - (*$HPPEMIT '#undef SO_RCVTIMEO' *) - (*$HPPEMIT '#undef SO_ERROR' *) - (*$HPPEMIT '#undef SO_OPENTYPE' *) - (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *) - (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *) - (*$HPPEMIT '#undef SO_MAXDG' *) - (*$HPPEMIT '#undef SO_MAXPATHDG' *) - (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *) - (*$HPPEMIT '#undef SO_CONNECT_TIME' *) - (*$HPPEMIT '#undef SO_TYPE' *) - (*$HPPEMIT '#undef SOCK_STREAM' *) - (*$HPPEMIT '#undef SOCK_DGRAM' *) - (*$HPPEMIT '#undef SOCK_RAW' *) - (*$HPPEMIT '#undef SOCK_RDM' *) - (*$HPPEMIT '#undef SOCK_SEQPACKET' *) - (*$HPPEMIT '#undef TCP_NODELAY' *) - (*$HPPEMIT '#undef AF_UNSPEC' *) - (*$HPPEMIT '#undef SOMAXCONN' *) - (*$HPPEMIT '#undef AF_INET' *) - (*$HPPEMIT '#undef AF_MAX' *) - (*$HPPEMIT '#undef PF_UNSPEC' *) - (*$HPPEMIT '#undef PF_INET' *) - (*$HPPEMIT '#undef PF_MAX' *) - (*$HPPEMIT '#undef MSG_OOB' *) - (*$HPPEMIT '#undef MSG_PEEK' *) - (*$HPPEMIT '#undef WSABASEERR' *) - (*$HPPEMIT '#undef WSAEINTR' *) - (*$HPPEMIT '#undef WSAEBADF' *) - (*$HPPEMIT '#undef WSAEACCES' *) - (*$HPPEMIT '#undef WSAEFAULT' *) - (*$HPPEMIT '#undef WSAEINVAL' *) - (*$HPPEMIT '#undef WSAEMFILE' *) - (*$HPPEMIT '#undef WSAEWOULDBLOCK' *) - (*$HPPEMIT '#undef WSAEINPROGRESS' *) - (*$HPPEMIT '#undef WSAEALREADY' *) - (*$HPPEMIT '#undef WSAENOTSOCK' *) - (*$HPPEMIT '#undef WSAEDESTADDRREQ' *) - (*$HPPEMIT '#undef WSAEMSGSIZE' *) - (*$HPPEMIT '#undef WSAEPROTOTYPE' *) - (*$HPPEMIT '#undef WSAENOPROTOOPT' *) - (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *) - (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEOPNOTSUPP' *) - (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEADDRINUSE' *) - (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *) - (*$HPPEMIT '#undef WSAENETDOWN' *) - (*$HPPEMIT '#undef WSAENETUNREACH' *) - (*$HPPEMIT '#undef WSAENETRESET' *) - (*$HPPEMIT '#undef WSAECONNABORTED' *) - (*$HPPEMIT '#undef WSAECONNRESET' *) - (*$HPPEMIT '#undef WSAENOBUFS' *) - (*$HPPEMIT '#undef WSAEISCONN' *) - (*$HPPEMIT '#undef WSAENOTCONN' *) - (*$HPPEMIT '#undef WSAESHUTDOWN' *) - (*$HPPEMIT '#undef WSAETOOMANYREFS' *) - (*$HPPEMIT '#undef WSAETIMEDOUT' *) - (*$HPPEMIT '#undef WSAECONNREFUSED' *) - (*$HPPEMIT '#undef WSAELOOP' *) - (*$HPPEMIT '#undef WSAENAMETOOLONG' *) - (*$HPPEMIT '#undef WSAEHOSTDOWN' *) - (*$HPPEMIT '#undef WSAEHOSTUNREACH' *) - (*$HPPEMIT '#undef WSAENOTEMPTY' *) - (*$HPPEMIT '#undef WSAEPROCLIM' *) - (*$HPPEMIT '#undef WSAEUSERS' *) - (*$HPPEMIT '#undef WSAEDQUOT' *) - (*$HPPEMIT '#undef WSAESTALE' *) - (*$HPPEMIT '#undef WSAEREMOTE' *) - (*$HPPEMIT '#undef WSASYSNOTREADY' *) - (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *) - (*$HPPEMIT '#undef WSANOTINITIALISED' *) - (*$HPPEMIT '#undef WSAEDISCON' *) - (*$HPPEMIT '#undef WSAENOMORE' *) - (*$HPPEMIT '#undef WSAECANCELLED' *) - (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *) - (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *) - (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *) - (*$HPPEMIT '#undef WSASYSCALLFAILURE' *) - (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *) - (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *) - (*$HPPEMIT '#undef WSA_E_NO_MORE' *) - (*$HPPEMIT '#undef WSA_E_CANCELLED' *) - (*$HPPEMIT '#undef WSAEREFUSED' *) - (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *) - (*$HPPEMIT '#undef HOST_NOT_FOUND' *) - (*$HPPEMIT '#undef WSATRY_AGAIN' *) - (*$HPPEMIT '#undef TRY_AGAIN' *) - (*$HPPEMIT '#undef WSANO_RECOVERY' *) - (*$HPPEMIT '#undef NO_RECOVERY' *) - (*$HPPEMIT '#undef WSANO_DATA' *) - (*$HPPEMIT '#undef NO_DATA' *) - (*$HPPEMIT '#undef WSANO_ADDRESS' *) - (*$HPPEMIT '#undef ENAMETOOLONG' *) - (*$HPPEMIT '#undef ENOTEMPTY' *) - (*$HPPEMIT '#undef FD_CLR' *) - (*$HPPEMIT '#undef FD_ISSET' *) - (*$HPPEMIT '#undef FD_SET' *) - (*$HPPEMIT '#undef FD_ZERO' *) - (*$HPPEMIT '#undef NO_ADDRESS' *) - (*$HPPEMIT '#undef ADDR_ANY' *) - (*$HPPEMIT '#undef SO_GROUP_ID' *) - (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *) - (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *) - (*$HPPEMIT '#undef PVD_CONFIG' *) - (*$HPPEMIT '#undef AF_INET6' *) - (*$HPPEMIT '#undef PF_INET6' *) -{$ENDIF} - -{$IFDEF FPC} - {$IFDEF WIN32} - {$ALIGN OFF} - {$ELSE} - {$PACKRECORDS C} - {$ENDIF} -{$ELSE} - {$IFDEF WIN64} - {$ALIGN ON} - {$MINENUMSIZE 4} - {$ELSE} - {$MINENUMSIZE 4} - {$ALIGN OFF} - {$ENDIF} -{$ENDIF} - -interface - -uses - SyncObjs, SysUtils, Classes, -{$IFDEF OS2} - Sockets, Dynlibs -{$ELSE OS2} - Windows -{$ENDIF OS2} -; - -function InitSocketInterface(stack: String): Boolean; -function DestroySocketInterface: Boolean; - -const -{$IFDEF WINSOCK1} - WinsockLevel = $0101; -{$ELSE} - WinsockLevel = $0202; -{$ENDIF} - -type -{$IFDEF OS2} - Bool = longint; -{$ENDIF OS2} - u_short = Word; - u_int = Integer; - u_long = Longint; - pu_long = ^u_long; - pu_short = ^u_short; -{$IFDEF FPC} - TSocket = ptruint; -{$ELSE} - {$IFDEF WIN64} - TSocket = UINT_PTR; - {$ELSE} - TSocket = u_int; - {$ENDIF} -{$ENDIF} - TAddrFamily = integer; - - TMemory = pointer; - -const - {$IFDEF WINCE} - DLLStackName = 'ws2.dll'; - {$ELSE} - {$IFDEF WINSOCK1} - {$IFDEF OS2} - {$IFDEF DAPWSOCK} - DLLStackName = 'dapwsock.dll'; - {$ELSE DAPWSOCK} - DLLStackName = 'pmwsock.dll'; - {$ENDIF DAPWSOCK} - {$ELSE OS2} - DLLStackName = 'wsock32.dll'; - {$ENDIF OS2} - {$ELSE} - DLLStackName = 'ws2_32.dll'; - {$ENDIF} - {$ENDIF} - DLLwship6 = 'wship6.dll'; - - cLocalhost = '127.0.0.1'; - cAnyHost = '0.0.0.0'; - cBroadcast = '255.255.255.255'; - c6Localhost = '::1'; - c6AnyHost = '::0'; - c6Broadcast = 'ffff::1'; - cAnyPort = '0'; - - -const - FD_SETSIZE = 64; -type - PFDSet = ^TFDSet; - TFDSet = record - fd_count: u_int; - fd_array: array[0..FD_SETSIZE-1] of TSocket; - end; - -const - FIONREAD = $4004667f; - FIONBIO = $8004667e; - FIOASYNC = $8004667d; - -type - PTimeVal = ^TTimeVal; - TTimeVal = record - tv_sec: Longint; - tv_usec: Longint; - end; - -const - IPPROTO_IP = 0; { Dummy } - IPPROTO_ICMP = 1; { Internet Control Message Protocol } - IPPROTO_IGMP = 2; { Internet Group Management Protocol} - IPPROTO_TCP = 6; { TCP } - IPPROTO_UDP = 17; { User Datagram Protocol } - IPPROTO_IPV6 = 41; - IPPROTO_ICMPV6 = 58; - IPPROTO_RM = 113; - - IPPROTO_RAW = 255; - IPPROTO_MAX = 256; - -type - - PInAddr = ^TInAddr; - TInAddr = record - case integer of - 0: (S_bytes: packed array [0..3] of byte); - 1: (S_addr: u_long); - end; - - PSockAddrIn = ^TSockAddrIn; - TSockAddrIn = record - case Integer of - 0: (sin_family: u_short; - sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of byte); - 1: (sa_family: u_short; - sa_data: array[0..13] of byte) - end; - - TIP_mreq = record - imr_multiaddr: TInAddr; { IP multicast address of group } - imr_interface: TInAddr; { local IP address of interface } - end; - - PInAddr6 = ^TInAddr6; - TInAddr6 = record - case integer of - 0: (S6_addr: packed array [0..15] of byte); - 1: (u6_addr8: packed array [0..15] of byte); - 2: (u6_addr16: packed array [0..7] of word); - 3: (u6_addr32: packed array [0..3] of integer); - end; - - PSockAddrIn6 = ^TSockAddrIn6; - TSockAddrIn6 = record - sin6_family: u_short; // AF_INET6 - sin6_port: u_short; // Transport level port number - sin6_flowinfo: u_long; // IPv6 flow information - sin6_addr: TInAddr6; // IPv6 address - sin6_scope_id: u_long; // Scope Id: IF number for link-local - // SITE id for site-local - end; - - TIPv6_mreq = record - ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. - ipv6mr_interface: integer; // Interface index. - padding: integer; - end; - - PHostEnt = ^THostEnt; - THostEnt = record - h_name: PAnsiChar; - h_aliases: ^PAnsiChar; -{$IFDEF PMWSOCK} - h_addrtype: longint; - h_length: longint; -{$ELSE PMWSOCK} - h_addrtype: Smallint; - h_length: Smallint; -{$ENDIF PMWSOCK} - case integer of - 0: (h_addr_list: ^PAnsiChar); - 1: (h_addr: ^PInAddr); - end; - - PNetEnt = ^TNetEnt; - TNetEnt = record - n_name: PAnsiChar; - n_aliases: ^PAnsiChar; -{$IFDEF PMWSOCK} - n_addrtype: longint; -{$ELSE PMWSOCK} - n_addrtype: Smallint; -{$ENDIF PMWSOCK} - n_net: u_long; - end; - - PServEnt = ^TServEnt; - TServEnt = record - s_name: PAnsiChar; - s_aliases: ^PAnsiChar; -{$ifdef WIN64} - s_proto: PAnsiChar; - s_port: Smallint; -{$else} -{$IFDEF PMWSOCK} - s_port: longint; -{$ELSE PMWSOCK} - s_port: Smallint; -{$ENDIF PMWSOCK} - s_proto: PAnsiChar; -{$endif} - end; - - PProtoEnt = ^TProtoEnt; - TProtoEnt = record - p_name: PAnsiChar; - p_aliases: ^PAnsichar; -{$IFDEF PMWSOCK} - p_proto: longint; -{$ELSE PMWSOCK} - p_proto: Smallint; -{$ENDIF PMWSOCK} - end; - -const - INADDR_ANY = $00000000; - INADDR_LOOPBACK = $7F000001; - INADDR_BROADCAST = $FFFFFFFF; - INADDR_NONE = $FFFFFFFF; - ADDR_ANY = INADDR_ANY; - INVALID_SOCKET = TSocket(NOT(0)); - SOCKET_ERROR = -1; - -Const - {$IFDEF WINSOCK1} - IP_OPTIONS = 1; - IP_MULTICAST_IF = 2; { set/get IP multicast interface } - IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive } - IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = 5; { add an IP group membership } - IP_DROP_MEMBERSHIP = 6; { drop an IP group membership } - IP_TTL = 7; { set/get IP Time To Live } - IP_TOS = 8; { set/get IP Type Of Service } - IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag } - {$ELSE} - IP_OPTIONS = 1; - IP_HDRINCL = 2; - IP_TOS = 3; { set/get IP Type Of Service } - IP_TTL = 4; { set/get IP Time To Live } - IP_MULTICAST_IF = 9; { set/get IP multicast interface } - IP_MULTICAST_TTL = 10; { set/get IP multicast timetolive } - IP_MULTICAST_LOOP = 11; { set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = 12; { add an IP group membership } - IP_DROP_MEMBERSHIP = 13; { drop an IP group membership } - IP_DONTFRAGMENT = 14; { set/get IP Don't Fragment flag } - {$ENDIF} - - IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop } - IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member } - IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf } - - SOL_SOCKET = $ffff; {options for socket level } -{ Option flags per-socket. } - SO_DEBUG = $0001; { turn on debugging info recording } - SO_ACCEPTCONN = $0002; { socket has had listen() } - SO_REUSEADDR = $0004; { allow local address reuse } - SO_KEEPALIVE = $0008; { keep connections alive } - SO_DONTROUTE = $0010; { just use interface addresses } - SO_BROADCAST = $0020; { permit sending of broadcast msgs } - SO_USELOOPBACK = $0040; { bypass hardware when possible } - SO_LINGER = $0080; { linger on close if data present } - SO_OOBINLINE = $0100; { leave received OOB data in line } - SO_DONTLINGER = $ff7f; -{ Additional options. } - SO_SNDBUF = $1001; { send buffer size } - SO_RCVBUF = $1002; { receive buffer size } - SO_SNDLOWAT = $1003; { send low-water mark } - SO_RCVLOWAT = $1004; { receive low-water mark } - SO_SNDTIMEO = $1005; { send timeout } - SO_RCVTIMEO = $1006; { receive timeout } - SO_ERROR = $1007; { get error status and clear } - SO_TYPE = $1008; { get socket type } -{ WinSock 2 extension -- new options } - SO_GROUP_ID = $2001; { ID of a socket group} - SO_GROUP_PRIORITY = $2002; { the relative priority within a group} - SO_MAX_MSG_SIZE = $2003; { maximum message size } - SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure } - SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure } - SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA; - PVD_CONFIG = $3001; {configuration info for service provider } -{ Option for opening sockets for synchronous access. } - SO_OPENTYPE = $7008; - SO_SYNCHRONOUS_ALERT = $10; - SO_SYNCHRONOUS_NONALERT = $20; -{ Other NT-specific options. } - SO_MAXDG = $7009; - SO_MAXPATHDG = $700A; - SO_UPDATE_ACCEPT_CONTEXT = $700B; - SO_CONNECT_TIME = $700C; - - SOMAXCONN = $7fffffff; - - IPV6_UNICAST_HOPS = 8; // ??? - IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f - IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl - IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback - IPV6_JOIN_GROUP = 12; // add an IP group membership - IPV6_LEAVE_GROUP = 13; // drop an IP group membership - - MSG_NOSIGNAL = 0; - - // getnameinfo constants - NI_MAXHOST = 1025; - NI_MAXSERV = 32; - NI_NOFQDN = $1; - NI_NUMERICHOST = $2; - NI_NAMEREQD = $4; - NI_NUMERICSERV = $8; - NI_DGRAM = $10; - - -const - SOCK_STREAM = 1; { stream socket } - SOCK_DGRAM = 2; { datagram socket } - SOCK_RAW = 3; { raw-protocol interface } - SOCK_RDM = 4; { reliably-delivered message } - SOCK_SEQPACKET = 5; { sequenced packet stream } - -{ TCP options. } - TCP_NODELAY = $0001; - -{ Address families. } - - AF_UNSPEC = 0; { unspecified } - AF_INET = 2; { internetwork: UDP, TCP, etc. } - AF_INET6 = 23; { Internetwork Version 6 } - AF_MAX = 24; - -{ Protocol families, same as address families for now. } - PF_UNSPEC = AF_UNSPEC; - PF_INET = AF_INET; - PF_INET6 = AF_INET6; - PF_MAX = AF_MAX; - -type - { Structure used by kernel to store most addresses. } - PSockAddr = ^TSockAddr; - TSockAddr = TSockAddrIn; - - { Structure used by kernel to pass protocol information in raw sockets. } - PSockProto = ^TSockProto; - TSockProto = record - sp_family: u_short; - sp_protocol: u_short; - end; - -type - PAddrInfo = ^TAddrInfo; - TAddrInfo = record - ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST. - ai_family: integer; // PF_xxx. - ai_socktype: integer; // SOCK_xxx. - ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6. - ai_addrlen: u_int; // Length of ai_addr. - ai_canonname: PAnsiChar; // Canonical name for nodename. - ai_addr: PSockAddr; // Binary address. - ai_next: PAddrInfo; // Next structure in linked list. - end; - -const - // Flags used in "hints" argument to getaddrinfo(). - AI_PASSIVE = $1; // Socket address will be used in bind() call. - AI_CANONNAME = $2; // Return canonical name in first ai_canonname. - AI_NUMERICHOST = $4; // Nodename must be a numeric address string. - -type -{ Structure used for manipulating linger option. } - PLinger = ^TLinger; - TLinger = record -{$IFDEF PMWSOCK} - l_onoff: longint; - l_linger: longint; -{$ELSE PMWSOCK} - l_onoff: u_short; - l_linger: u_short; -{$ENDIF PMWSOCK} - end; - -const - - MSG_OOB = $01; // Process out-of-band data. - MSG_PEEK = $02; // Peek at incoming messages. - -const - -{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" } - WSABASEERR = 10000; - -{ Windows Sockets definitions of regular Microsoft C error constants } - - WSAEINTR = (WSABASEERR+4); - WSAEBADF = (WSABASEERR+9); - WSAEACCES = (WSABASEERR+13); - WSAEFAULT = (WSABASEERR+14); - WSAEINVAL = (WSABASEERR+22); - WSAEMFILE = (WSABASEERR+24); - -{ Windows Sockets definitions of regular Berkeley error constants } - - WSAEWOULDBLOCK = (WSABASEERR+35); - WSAEINPROGRESS = (WSABASEERR+36); - WSAEALREADY = (WSABASEERR+37); - WSAENOTSOCK = (WSABASEERR+38); - WSAEDESTADDRREQ = (WSABASEERR+39); - WSAEMSGSIZE = (WSABASEERR+40); - WSAEPROTOTYPE = (WSABASEERR+41); - WSAENOPROTOOPT = (WSABASEERR+42); - WSAEPROTONOSUPPORT = (WSABASEERR+43); - WSAESOCKTNOSUPPORT = (WSABASEERR+44); - WSAEOPNOTSUPP = (WSABASEERR+45); - WSAEPFNOSUPPORT = (WSABASEERR+46); - WSAEAFNOSUPPORT = (WSABASEERR+47); - WSAEADDRINUSE = (WSABASEERR+48); - WSAEADDRNOTAVAIL = (WSABASEERR+49); - WSAENETDOWN = (WSABASEERR+50); - WSAENETUNREACH = (WSABASEERR+51); - WSAENETRESET = (WSABASEERR+52); - WSAECONNABORTED = (WSABASEERR+53); - WSAECONNRESET = (WSABASEERR+54); - WSAENOBUFS = (WSABASEERR+55); - WSAEISCONN = (WSABASEERR+56); - WSAENOTCONN = (WSABASEERR+57); - WSAESHUTDOWN = (WSABASEERR+58); - WSAETOOMANYREFS = (WSABASEERR+59); - WSAETIMEDOUT = (WSABASEERR+60); - WSAECONNREFUSED = (WSABASEERR+61); - WSAELOOP = (WSABASEERR+62); - WSAENAMETOOLONG = (WSABASEERR+63); - WSAEHOSTDOWN = (WSABASEERR+64); - WSAEHOSTUNREACH = (WSABASEERR+65); - WSAENOTEMPTY = (WSABASEERR+66); - WSAEPROCLIM = (WSABASEERR+67); - WSAEUSERS = (WSABASEERR+68); - WSAEDQUOT = (WSABASEERR+69); - WSAESTALE = (WSABASEERR+70); - WSAEREMOTE = (WSABASEERR+71); - -{ Extended Windows Sockets error constant definitions } - - WSASYSNOTREADY = (WSABASEERR+91); - WSAVERNOTSUPPORTED = (WSABASEERR+92); - WSANOTINITIALISED = (WSABASEERR+93); - WSAEDISCON = (WSABASEERR+101); - WSAENOMORE = (WSABASEERR+102); - WSAECANCELLED = (WSABASEERR+103); - WSAEEINVALIDPROCTABLE = (WSABASEERR+104); - WSAEINVALIDPROVIDER = (WSABASEERR+105); - WSAEPROVIDERFAILEDINIT = (WSABASEERR+106); - WSASYSCALLFAILURE = (WSABASEERR+107); - WSASERVICE_NOT_FOUND = (WSABASEERR+108); - WSATYPE_NOT_FOUND = (WSABASEERR+109); - WSA_E_NO_MORE = (WSABASEERR+110); - WSA_E_CANCELLED = (WSABASEERR+111); - WSAEREFUSED = (WSABASEERR+112); - -{ Error return codes from gethostbyname() and gethostbyaddr() - (when using the resolver). Note that these errors are - retrieved via WSAGetLastError() and must therefore follow - the rules for avoiding clashes with error numbers from - specific implementations or language run-time systems. - For this reason the codes are based at WSABASEERR+1001. - Note also that [WSA]NO_ADDRESS is defined only for - compatibility purposes. } - -{ Authoritative Answer: Host not found } - WSAHOST_NOT_FOUND = (WSABASEERR+1001); - HOST_NOT_FOUND = WSAHOST_NOT_FOUND; -{ Non-Authoritative: Host not found, or SERVERFAIL } - WSATRY_AGAIN = (WSABASEERR+1002); - TRY_AGAIN = WSATRY_AGAIN; -{ Non recoverable errors, FORMERR, REFUSED, NOTIMP } - WSANO_RECOVERY = (WSABASEERR+1003); - NO_RECOVERY = WSANO_RECOVERY; -{ Valid name, no data record of requested type } - WSANO_DATA = (WSABASEERR+1004); - NO_DATA = WSANO_DATA; -{ no address, look for MX record } - WSANO_ADDRESS = WSANO_DATA; - NO_ADDRESS = WSANO_ADDRESS; - - EWOULDBLOCK = WSAEWOULDBLOCK; - EINPROGRESS = WSAEINPROGRESS; - EALREADY = WSAEALREADY; - ENOTSOCK = WSAENOTSOCK; - EDESTADDRREQ = WSAEDESTADDRREQ; - EMSGSIZE = WSAEMSGSIZE; - EPROTOTYPE = WSAEPROTOTYPE; - ENOPROTOOPT = WSAENOPROTOOPT; - EPROTONOSUPPORT = WSAEPROTONOSUPPORT; - ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; - EOPNOTSUPP = WSAEOPNOTSUPP; - EPFNOSUPPORT = WSAEPFNOSUPPORT; - EAFNOSUPPORT = WSAEAFNOSUPPORT; - EADDRINUSE = WSAEADDRINUSE; - EADDRNOTAVAIL = WSAEADDRNOTAVAIL; - ENETDOWN = WSAENETDOWN; - ENETUNREACH = WSAENETUNREACH; - ENETRESET = WSAENETRESET; - ECONNABORTED = WSAECONNABORTED; - ECONNRESET = WSAECONNRESET; - ENOBUFS = WSAENOBUFS; - EISCONN = WSAEISCONN; - ENOTCONN = WSAENOTCONN; - ESHUTDOWN = WSAESHUTDOWN; - ETOOMANYREFS = WSAETOOMANYREFS; - ETIMEDOUT = WSAETIMEDOUT; - ECONNREFUSED = WSAECONNREFUSED; - ELOOP = WSAELOOP; - ENAMETOOLONG = WSAENAMETOOLONG; - EHOSTDOWN = WSAEHOSTDOWN; - EHOSTUNREACH = WSAEHOSTUNREACH; - ENOTEMPTY = WSAENOTEMPTY; - EPROCLIM = WSAEPROCLIM; - EUSERS = WSAEUSERS; - EDQUOT = WSAEDQUOT; - ESTALE = WSAESTALE; - EREMOTE = WSAEREMOTE; - - EAI_ADDRFAMILY = 1; // Address family for nodename not supported. - EAI_AGAIN = 2; // Temporary failure in name resolution. - EAI_BADFLAGS = 3; // Invalid value for ai_flags. - EAI_FAIL = 4; // Non-recoverable failure in name resolution. - EAI_FAMILY = 5; // Address family ai_family not supported. - EAI_MEMORY = 6; // Memory allocation failure. - EAI_NODATA = 7; // No address associated with nodename. - EAI_NONAME = 8; // Nodename nor servname provided, or not known. - EAI_SERVICE = 9; // Servname not supported for ai_socktype. - EAI_SOCKTYPE = 10; // Socket type ai_socktype not supported. - EAI_SYSTEM = 11; // System error returned in errno. - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = record - wVersion: Word; - wHighVersion: Word; -{$ifdef win64} - iMaxSockets : Word; - iMaxUdpDg : Word; - lpVendorInfo : PAnsiChar; - szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar; - szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar; -{$else} - szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar; - iMaxSockets: Word; - iMaxUdpDg: Word; - lpVendorInfo: PAnsiChar; -{$endif} - end; - - function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -var - in6addr_any, in6addr_loopback : TInAddr6; - -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); - -{=============================================================================} - -type - TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer; - extdecl; - TWSACleanup = function: Integer; - extdecl; - TWSAGetLastError = function: Integer; - extdecl; - TGetServByName = function(name, proto: PAnsiChar): PServEnt; - extdecl; - TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt; - extdecl; - TGetProtoByName = function(name: PAnsiChar): PProtoEnt; - extdecl; - TGetProtoByNumber = function(proto: Integer): PProtoEnt; - extdecl; - TGetHostByName = function(name: PAnsiChar): PHostEnt; - extdecl; - TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; - extdecl; - TGetHostName = function(name: PAnsiChar; len: Integer): Integer; - extdecl; - TShutdown = function(s: TSocket; how: Integer): Integer; - extdecl; - TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar; - optlen: Integer): Integer; - extdecl; - TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar; - var optlen: Integer): Integer; - extdecl; - TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr; - tolen: Integer): Integer; - extdecl; - TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer; - extdecl; - TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer; - extdecl; - TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; - var fromlen: Integer): Integer; - extdecl; - Tntohs = function(netshort: u_short): u_short; - extdecl; - Tntohl = function(netlong: u_long): u_long; - extdecl; - TListen = function(s: TSocket; backlog: Integer): Integer; - extdecl; - TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer; - extdecl; - TInet_ntoa = function(inaddr: TInAddr): PAnsiChar; - extdecl; - TInet_addr = function(cp: PAnsiChar): u_long; - extdecl; - Thtons = function(hostshort: u_short): u_short; - extdecl; - Thtonl = function(hostlong: u_long): u_long; - extdecl; - TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - extdecl; - TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - extdecl; - TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer; - extdecl; - TCloseSocket = function(s: TSocket): Integer; - extdecl; - TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer; - extdecl; - TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; - extdecl; - TTSocket = function(af, Struc, Protocol: Integer): TSocket; - extdecl; - TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; - extdecl; - - TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo; - var Addrinfo: PAddrInfo): integer; - extdecl; - TFreeAddrInfo = procedure(ai: PAddrInfo); - extdecl; - TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar; - hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer; - extdecl; - - T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool; - extdecl; - - TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; - cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; - lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; - lpCompletionRoutine: pointer): u_int; - extdecl; - -var - WSAStartup: TWSAStartup = nil; - WSACleanup: TWSACleanup = nil; - WSAGetLastError: TWSAGetLastError = nil; - GetServByName: TGetServByName = nil; - GetServByPort: TGetServByPort = nil; - GetProtoByName: TGetProtoByName = nil; - GetProtoByNumber: TGetProtoByNumber = nil; - GetHostByName: TGetHostByName = nil; - GetHostByAddr: TGetHostByAddr = nil; - ssGetHostName: TGetHostName = nil; -{$IFDEF OS2} - ssShutdown: TShutdown = nil; - ssSetSockOpt: TSetSockOpt = nil; - ssGetSockOpt: TGetSockOpt = nil; -{$ELSE OS2} - Shutdown: TShutdown = nil; - SetSockOpt: TSetSockOpt = nil; - GetSockOpt: TGetSockOpt = nil; -{$ENDIF OS2} - ssSendTo: TSendTo = nil; - ssSend: TSend = nil; - ssRecv: TRecv = nil; - ssRecvFrom: TRecvFrom = nil; - ntohs: Tntohs = nil; - ntohl: Tntohl = nil; -{$IFDEF OS2} - ssListen: TListen = nil; - ssIoctlSocket: TIoctlSocket = nil; -{$ELSE OS2} - Listen: TListen = nil; - IoctlSocket: TIoctlSocket = nil; -{$ENDIF OS2} - Inet_ntoa: TInet_ntoa = nil; - Inet_addr: TInet_addr = nil; - htons: Thtons = nil; - htonl: Thtonl = nil; - ssGetSockName: TGetSockName = nil; - ssGetPeerName: TGetPeerName = nil; - ssConnect: TConnect = nil; -{$IFDEF OS2} - ssCloseSocket: TCloseSocket = nil; -{$ELSE OS2} - CloseSocket: TCloseSocket = nil; -{$ENDIF OS2} - ssBind: TBind = nil; - ssAccept: TAccept = nil; -{$IFDEF OS2} - ssSocket: TTSocket = nil; -{$ELSE OS2} - Socket: TTSocket = nil; -{$ENDIF OS2} - Select: TSelect = nil; - - GetAddrInfo: TGetAddrInfo = nil; - FreeAddrInfo: TFreeAddrInfo = nil; - GetNameInfo: TGetNameInfo = nil; - -{$IFDEF OS2} - ss__WSAFDIsSet: T__WSAFDIsSet = nil; - - ssWSAIoctl: TWSAIoctl = nil; -{$ELSE OS2} - __WSAFDIsSet: T__WSAFDIsSet = nil; - - WSAIoctl: TWSAIoctl = nil; -{$ENDIF OS2} - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - -type - TVarSin = packed record - case integer of - 0: (AddressFamily: u_short); - 1: ( - case sin_family: u_short of - AF_INET: (sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of byte); - AF_INET6: (sin6_port: u_short; - sin6_flowinfo: u_long; - sin6_addr: TInAddr6; - sin6_scope_id: u_long); - ); - end; - -function SizeOfVarSin(sin: TVarSin): integer; - -function Bind(s: TSocket; const addr: TVarSin): Integer; -function Connect(s: TSocket; const name: TVarSin): Integer; -function GetSockName(s: TSocket; var name: TVarSin): Integer; -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -function GetHostName: AnsiString; -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -function Accept(s: TSocket; var addr: TVarSin): TSocket; - -function IsNewApi(Family: integer): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): AnsiString; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString; -function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word; -{$IFDEF OS2} -function Socket (af, Struc, Protocol: Integer): TSocket; -function Shutdown (s: TSocket; how: Integer): Integer; -function SetSockOpt (s: TSocket; level, optname: Integer; optval: PAnsiChar; - optlen: Integer): Integer; -function GetSockOpt (s: TSocket; level, optname: Integer; optval: PAnsiChar; - var optlen: Integer): Integer; -function Listen (s: TSocket; backlog: Integer): Integer; -function IoctlSocket (s: TSocket; cmd: DWORD; var arg: Integer): Integer; -function CloseSocket (s: TSocket): Integer; - -function __WSAFDIsSet (s: TSocket; var FDSet: TFDSet): Bool; - -function WSAIoctl (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; - cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; - lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; - lpCompletionRoutine: pointer): u_int; -{$ENDIF OS2} - -{==============================================================================} -implementation - -var - SynSockCount: Integer = 0; - LibHandle: THandle = 0; - Libwship6Handle: THandle = 0; - -function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0)); -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and - (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and - (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1)); -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80)); -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0)); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := (a^.u6_addr8[0] = $FF); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.u6_addr8[15] := 1; -end; - -{=============================================================================} -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -var - I: Integer; -begin -{$IFDEF OS2} - Socket := TSocket (NativeSocket (cInt (Socket))); -{$ENDIF OS2} - I := 0; - while I < FDSet.fd_count do - begin - if FDSet.fd_array[I] = Socket then - begin - while I < FDSet.fd_count - 1 do - begin - FDSet.fd_array[I] := FDSet.fd_array[I + 1]; - Inc(I); - end; - Dec(FDSet.fd_count); - Break; - end; - Inc(I); - end; -end; - -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -begin -{$IFDEF OS2} - Socket := TSocket (NativeSocket (cInt (Socket))); -{$ENDIF OS2} - Result := __WSAFDIsSet(Socket, FDSet) -{$IFDEF OS2} - <> 0 -{$ENDIF OS2} ; -end; - -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -begin -{$IFDEF OS2} - Socket := TSocket (NativeSocket (cInt (Socket))); -{$ENDIF OS2} - if FDSet.fd_count < FD_SETSIZE then - begin - FDSet.fd_array[FDSet.fd_count] := Socket; - Inc(FDSet.fd_count); - end; -end; - -procedure FD_ZERO(var FDSet: TFDSet); -begin - FDSet.fd_count := 0; -end; - -{=============================================================================} - -function SizeOfVarSin(sin: TVarSin): integer; -begin - case sin.sin_family of - AF_INET: - Result := SizeOf(TSockAddrIn); - AF_INET6: - Result := SizeOf(TSockAddrIn6); - else - Result := 0; - end; -end; - -{=============================================================================} - -function Bind(s: TSocket; const addr: TVarSin): Integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - Result := ssBind(s, @addr, SizeOfVarSin(addr)); -end; - -function Connect(s: TSocket; const name: TVarSin): Integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - Result := ssConnect(s, @name, SizeOfVarSin(name)); -end; - -function GetSockName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetSockName(s, @name, Len); -end; - -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetPeerName(s, @name, Len); -end; - -function GetHostName: AnsiString; -var - s: AnsiString; -begin - Result := ''; - setlength(s, 255); - ssGetHostName(pAnsichar(s), Length(s) - 1); - Result := PAnsichar(s); -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - Result := ssSend(s, Buf^, len, flags); -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - Result := ssRecv(s, Buf^, len, flags); -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto)); -end; - -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -var - x: integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - x := SizeOf(from); - Result := ssRecvFrom(s, Buf^, len, flags, @from, x); -end; - -function Accept(s: TSocket; var addr: TVarSin): TSocket; -var - x: integer; -begin -{$IFDEF OS2} - S := TSocket (NativeSocket (cInt (S))); -{$ENDIF OS2} - x := SizeOf(addr); -{$IFDEF OS2} - Result := TSocket (EMXSocket (cInt (ssAccept (S, @Addr, X)))); -{$ELSE OS2} - Result := ssAccept(s, @addr, x); -{$ENDIF OS2} -end; - -{$IFDEF OS2} -function Shutdown (s: TSocket; how: Integer): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - Shutdown := ssShutdown (s, how); -end; - -function Socket (af, Struc, Protocol: Integer): TSocket; -begin - Socket := TSocket (EMXSocket (cInt (ssSocket (af, Struc, Protocol)))); -end; - -function SetSockOpt (s: TSocket; level, optname: Integer; optval: PAnsiChar; - optlen: Integer): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - SetSockOpt := ssSetSockOpt (S, Level, OptName, OptVal, OptLen); -end; - -function GetSockOpt (s: TSocket; level, optname: Integer; optval: PAnsiChar; - var optlen: Integer): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - GetSockOpt := ssGetSockOpt (S, Level, OptName, OptVal, OptLen); -end; - -function Listen (s: TSocket; backlog: Integer): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - Listen := ssListen (S, BackLog); -end; - -function IoctlSocket (s: TSocket; cmd: DWORD; var arg: Integer): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - IOCtlSocket := ssIOCtlSocket (S, Cmd, Arg); -end; - -function CloseSocket (s: TSocket): Integer; -begin - S := TSocket (NativeSocket (cInt (S))); - CloseSocket := ssCloseSocket (S); -end; - -function __WSAFDIsSet (s: TSocket; var FDSet: TFDSet): Bool; -begin - S := TSocket (NativeSocket (cInt (S))); - __WSAFDIsSet := ss__WSAFDIsSet (S, FDSet); -end; - -function WSAIoctl (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; - cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; - lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; - lpCompletionRoutine: pointer): u_int; -begin - S := TSocket (NativeSocket (cInt (S))); - WSAIOCtl := ssWSAIOCtl (S, dwIoControlCode, lpvInBuffer, cbInBuffer, - lpvOutBuffer, cbOutBuffer, lpcbBytesReturned, lpOverlapped, - lpCompletionRoutine); -end; -{$ENDIF OS2} - -{=============================================================================} -function IsNewApi(Family: integer): Boolean; -begin - Result := SockEnhancedApi; - if not Result then - Result := (Family = AF_INET6) and SockWship6Api; -end; - -function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -type - pu_long = ^u_long; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - HostEnt: PHostEnt; - r: integer; - Hints1, Hints2: TAddrInfo; - Sin1, Sin2: TVarSin; - TwoPass: boolean; - - function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer; - var - Addr: PAddrInfo; - begin - Addr := nil; - try - FillChar(Sin, Sizeof(Sin), 0); - if Hints.ai_socktype = SOCK_RAW then - begin - Hints.ai_socktype := 0; - Hints.ai_protocol := 0; - Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr); - end - else - begin - if (IP = cAnyHost) or (IP = c6AnyHost) then - begin - Hints.ai_flags := AI_PASSIVE; - Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - end - else - if (IP = cLocalhost) or (IP = c6Localhost) then - begin - Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - end - else - begin - Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr); - end; - end; - if Result = 0 then - if (Addr <> nil) then - Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen); - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - -begin - Result := 0; - FillChar(Sin, Sizeof(Sin), 0); - if not IsNewApi(family) then - begin - SynSockCS.Enter; - try - Sin.sin_family := AF_INET; - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then - ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0)) - else - Sin.sin_port := ServEnt^.s_port; - if IP = cBroadcast then - Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST) - else - begin - Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP)); - if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then - begin - HostEnt := synsock.GetHostByName(PAnsiChar(IP)); - Result := synsock.WSAGetLastError; - if HostEnt <> nil then - Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - begin - FillChar(Hints1, Sizeof(Hints1), 0); - FillChar(Hints2, Sizeof(Hints2), 0); - TwoPass := False; - if Family = AF_UNSPEC then - begin - if PreferIP4 then - begin - Hints1.ai_family := AF_INET; - Hints2.ai_family := AF_INET6; - TwoPass := True; - end - else - begin - Hints2.ai_family := AF_INET; - Hints1.ai_family := AF_INET6; - TwoPass := True; - end; - end - else - Hints1.ai_family := Family; - - Hints1.ai_socktype := SockType; - Hints1.ai_protocol := SockProtocol; - Hints2.ai_socktype := Hints1.ai_socktype; - Hints2.ai_protocol := Hints1.ai_protocol; - - r := GetAddr(IP, Port, Hints1, Sin1); - Result := r; - sin := sin1; - if r <> 0 then - if TwoPass then - begin - r := GetAddr(IP, Port, Hints2, Sin2); - Result := r; - if r = 0 then - sin := sin2; - end; - end; -end; - -function GetSinIP(Sin: TVarSin): AnsiString; -var - p: PAnsiChar; - host, serv: AnsiString; - hostlen, servlen: integer; - r: integer; -begin - Result := ''; - if not IsNewApi(Sin.AddressFamily) then - begin - p := synsock.inet_ntoa(Sin.sin_addr); - if p <> nil then - Result := p; - end - else - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen, - PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - Result := PAnsiChar(host); - end; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - if (Sin.sin_family = AF_INET6) then - Result := synsock.ntohs(Sin.sin6_port) - else - Result := synsock.ntohs(Sin.sin_port); -end; - -procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings); -type - TaPInAddr = array[0..250] of PInAddr; - PaPInAddr = ^TaPInAddr; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - AddrNext: PAddrInfo; - r: integer; - host, serv: AnsiString; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IP: u_long; - PAdrPtr: PaPInAddr; - i: Integer; - s: String; - InAddr: TInAddr; -begin - IPList.Clear; - if not IsNewApi(Family) then - begin - IP := synsock.inet_addr(PAnsiChar(Name)); - if IP = u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := synsock.GetHostByName(PAnsiChar(Name)); - if RemoteHost <> nil then - begin - PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); - i := 0; - while PAdrPtr^[i] <> nil do - begin - InAddr := PAdrPtr^[i]^; - s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1], - InAddr.S_bytes[2], InAddr.S_bytes[3]]); - IPList.Add(s); - Inc(i); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - IPList.Add(string(Name)); - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr); - if r = 0 then - begin - AddrNext := Addr; - while not(AddrNext = nil) do - begin - if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET)) - or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen, - PAnsiChar(host), hostlen, PAnsiChar(serv), servlen, - NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - begin - host := PAnsiChar(host); - IPList.Add(string(host)); - end; - end; - AddrNext := AddrNext^.ai_next; - end; - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - if IPList.Count = 0 then - IPList.Add(cAnyHost); -end; - -function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; -begin - Result := 0; - if not IsNewApi(Family) then - begin - SynSockCS.Enter; - try - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Result := StrToIntDef(string(Port), 0) - else - Result := synsock.htons(ServEnt^.s_port); - finally - SynSockCS.Leave; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := Sockprotocol; - Hints.ai_flags := AI_PASSIVE; - r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - if (r = 0) and Assigned(Addr) then - begin - if Addr^.ai_family = AF_INET then - Result := synsock.htons(Addr^.ai_addr^.sin_port); - if Addr^.ai_family = AF_INET6 then - Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; - host, serv: AnsiString; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IPn: u_long; -begin - Result := IP; - if not IsNewApi(Family) then - begin - IPn := synsock.inet_addr(PAnsiChar(IP)); - if IPn <> u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET); - if RemoteHost <> nil then - Result := RemoteHost^.h_name; - finally - SynSockCS.Leave; - end; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr); - if (r = 0) and Assigned(Addr)then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen, - PAnsiChar(host), hostlen, PAnsiChar(serv), servlen, - NI_NUMERICSERV); - if r = 0 then - Result := PAnsiChar(host); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -{=============================================================================} - -function InitSocketInterface(stack: String): Boolean; -begin - Result := False; - if stack = '' then - stack := DLLStackName; - SynSockCS.Enter; - try - if SynSockCount = 0 then - begin - SockEnhancedApi := False; - SockWship6Api := False; - LibHandle := LoadLibrary(PChar(Stack)); - if LibHandle <> 0 then - begin -{$IFDEF OS2} - ssWSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl'))); - ss__WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet'))); - ssCloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket'))); - ssIoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket'))); -{$ELSE OS2} - WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl'))); - __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet'))); - CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket'))); - IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket'))); -{$ENDIF OS2} - WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError'))); - WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup'))); - WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup'))); - ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept'))); - ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind'))); - ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect'))); - ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername'))); - ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname'))); -{$IFDEF OS2} - ssGetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt'))); -{$ELSE OS2} - GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt'))); -{$ENDIF OS2} - Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl'))); - Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons'))); - Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr'))); - Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa'))); -{$IFDEF OS2} - ssListen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen'))); -{$ELSE OS2} - Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen'))); -{$ENDIF OS2} - Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl'))); - Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs'))); - ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv'))); - ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom'))); - Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select'))); - ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send'))); - ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto'))); -{$IFDEF OS2} - ssSetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt'))); - ssShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown'))); - ssSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket'))); -{$ELSE OS2} - SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt'))); - ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown'))); - Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket'))); -{$ENDIF OS2} - GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr'))); - GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname'))); - GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname'))); - GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber'))); - GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname'))); - GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport'))); - ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname'))); - -{$IFNDEF FORCEOLDAPI} - GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo'))); - FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo'))); - GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo'))); - SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) - and Assigned(GetNameInfo); - if not SockEnhancedApi then - begin - LibWship6Handle := LoadLibrary(PChar(DLLWship6)); - if LibWship6Handle <> 0 then - begin - GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo'))); - FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo'))); - GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo'))); - SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) - and Assigned(GetNameInfo); - end; - end; -{$ENDIF} - Result := True; - end; - end - else Result := True; - if Result then - Inc(SynSockCount); - finally - SynSockCS.Leave; - end; -end; - -function DestroySocketInterface: Boolean; -begin - SynSockCS.Enter; - try - Dec(SynSockCount); - if SynSockCount < 0 then - SynSockCount := 0; - if SynSockCount = 0 then - begin - if LibHandle <> 0 then - begin - FreeLibrary(libHandle); - LibHandle := 0; - end; - if LibWship6Handle <> 0 then - begin - FreeLibrary(LibWship6Handle); - LibWship6Handle := 0; - end; - end; - finally - SynSockCS.Leave; - end; - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; - SET_IN6_IF_ADDR_ANY (@in6addr_any); - SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - SynSockCS.Free; -end; \ No newline at end of file diff --git a/3rd/synapse/source/ssposix.inc b/3rd/synapse/source/ssposix.inc deleted file mode 100644 index 977462d75..000000000 --- a/3rd/synapse/source/ssposix.inc +++ /dev/null @@ -1,1144 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.004 | -|==============================================================================| -| Content: Socket Independent Platform Layer - Delphi Posix definition include | -|==============================================================================| -| Copyright (c)2006-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2006-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Radek Cervinka | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$IFDEF POSIX} -{for delphi XE2+} - -//{$DEFINE FORCEOLDAPI} -{Note about define FORCEOLDAPI: -If you activate this compiler directive, then is allways used old socket API -for name resolution. If you leave this directive inactive, then the new API -is used, when running system allows it. - -For IPv6 support you must have new API! -} - -{ -note RC: -partially compatible with NextGen Delphi compiler - iOS - - -} - - -interface - -uses - SyncObjs, SysUtils, Classes, - Posix.SysSocket, Posix.SysSelect, Posix.SysTime, Posix.NetinetIn, - Posix.StrOpts, Posix.Errno; - -function InitSocketInterface(stack: string): Boolean; -function DestroySocketInterface: Boolean; - -const - DLLStackName = ''; - WinsockLevel = $0202; - - cLocalHost = '127.0.0.1'; - cBroadcast = '255.255.255.255'; - cAnyHost = '0.0.0.0'; - c6AnyHost = '::0'; - c6Localhost = '::1'; - cLocalHostStr = 'localhost'; - -type - TSocket = longint; - TAddrFamily = integer; - - TMemory = pointer; - - -type - TFDSet = fd_set; - PFDSet = Pfd_set; - Ptimeval = Posix.SysTime.ptimeval; - Ttimeval = Posix.SysTime.timeval; - -const - // - FIONREAD = $4004667F; // oSX FIONREAD = Posix.StrOpts.FIONREAD; - - FIONBIO = $8004667E; //OSX FIONBIO = Posix.StrOpts.FIONBIO; - FIOASYNC = $8004667D; //OSX FIOASYNC = Posix.StrOpts.FIOASYNC; // not defined in XE2 - - { FIONREAD = $541B; // LINUX? - FIONBIO = $5421; - FIOASYNC = $5452; } - -const - IPPROTO_IP = Posix.NetinetIn.IPPROTO_IP; { Dummy } - IPPROTO_ICMP = Posix.NetinetIn.IPPROTO_ICMP; { Internet Control Message Protocol } - IPPROTO_IGMP = Posix.NetinetIn.IPPROTO_IGMP; { Internet Group Management Protocol} - IPPROTO_TCP = Posix.NetinetIn.IPPROTO_TCP; { TCP } - IPPROTO_UDP = Posix.NetinetIn.IPPROTO_UDP; { User Datagram Protocol } - IPPROTO_IPV6 = Posix.NetinetIn.IPPROTO_IPV6; - IPPROTO_ICMPV6 = 58; - IPPROTO_RM = 113; - - IPPROTO_RAW = Posix.NetinetIn.IPPROTO_RAW; - IPPROTO_MAX = Posix.NetinetIn.IPPROTO_MAX; - -type - PInAddr = ^TInAddr; - TInAddr = Posix.NetinetIn.in_addr; - - PSockAddrIn = ^TSockAddrIn; - TSockAddrIn = Posix.NetinetIn.sockaddr_in; - - - TIP_mreq = record - imr_multiaddr: TInAddr; // IP multicast address of group - imr_interface: TInAddr; // local IP address of interface - end; - - - PInAddr6 = ^TInAddr6; - TInAddr6 = Posix.NetinetIn.in6_addr; - - PSockAddrIn6 = ^TSockAddrIn6; - TSockAddrIn6 = Posix.NetinetIn.sockaddr_in6; - - - TIPv6_mreq = record - ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. - ipv6mr_interface: integer; // Interface index. - end; - -const - INADDR_ANY = $00000000; - INADDR_LOOPBACK = $7F000001; - INADDR_BROADCAST = $FFFFFFFF; - INADDR_NONE = $FFFFFFFF; - ADDR_ANY = INADDR_ANY; - INVALID_SOCKET = TSocket(NOT(0)); - SOCKET_ERROR = -1; - -Const - IP_TOS = Posix.NetinetIn.IP_TOS; { int; IP type of service and precedence. } - IP_TTL = Posix.NetinetIn.IP_TTL; { int; IP time to live. } - IP_HDRINCL = Posix.NetinetIn.IP_HDRINCL; { int; Header is included with data. } - IP_OPTIONS = Posix.NetinetIn.IP_OPTIONS; { ip_opts; IP per-packet options. } -// IP_ROUTER_ALERT = sockets.IP_ROUTER_ALERT; { bool } - IP_RECVOPTS = Posix.NetinetIn.IP_RECVOPTS; { bool } - IP_RETOPTS = Posix.NetinetIn.IP_RETOPTS; { bool } -// IP_PKTINFO = sockets.IP_PKTINFO; { bool } -// IP_PKTOPTIONS = sockets.IP_PKTOPTIONS; -// IP_PMTUDISC = sockets.IP_PMTUDISC; { obsolete name? } -// IP_MTU_DISCOVER = sockets.IP_MTU_DISCOVER; { int; see below } -// IP_RECVERR = sockets.IP_RECVERR; { bool } -// IP_RECVTTL = sockets.IP_RECVTTL; { bool } -// IP_RECVTOS = sockets.IP_RECVTOS; { bool } - IP_MULTICAST_IF = Posix.NetinetIn.IP_MULTICAST_IF; { in_addr; set/get IP multicast i/f } - IP_MULTICAST_TTL = Posix.NetinetIn.IP_MULTICAST_TTL; { u_char; set/get IP multicast ttl } - IP_MULTICAST_LOOP = Posix.NetinetIn.IP_MULTICAST_LOOP; { i_char; set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = Posix.NetinetIn.IP_ADD_MEMBERSHIP; { ip_mreq; add an IP group membership } - IP_DROP_MEMBERSHIP = Posix.NetinetIn.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership } - - SOL_SOCKET = Posix.SysSocket.SOL_SOCKET; - - SO_DEBUG = Posix.SysSocket.SO_DEBUG; - SO_REUSEADDR = Posix.SysSocket.SO_REUSEADDR; - SO_TYPE = Posix.SysSocket.SO_TYPE; - SO_ERROR = Posix.SysSocket.SO_ERROR; - SO_DONTROUTE = Posix.SysSocket.SO_DONTROUTE; - SO_BROADCAST = Posix.SysSocket.SO_BROADCAST; - SO_SNDBUF = Posix.SysSocket.SO_SNDBUF; - SO_RCVBUF = Posix.SysSocket.SO_RCVBUF; - SO_KEEPALIVE = Posix.SysSocket.SO_KEEPALIVE; - SO_OOBINLINE = Posix.SysSocket.SO_OOBINLINE; -// SO_NO_CHECK = SysSocket.SO_NO_CHECK; -// SO_PRIORITY = SysSocket.SO_PRIORITY; - SO_LINGER = Posix.SysSocket.SO_LINGER; -// SO_BSDCOMPAT = SysSocket.SO_BSDCOMPAT; -// SO_REUSEPORT = SysSocket.SO_REUSEPORT; -// SO_PASSCRED = SysSocket.SO_PASSCRED; -// SO_PEERCRED = SysSocket.SO_PEERCRED; - SO_RCVLOWAT = Posix.SysSocket.SO_RCVLOWAT; - SO_SNDLOWAT = Posix.SysSocket.SO_SNDLOWAT; - SO_RCVTIMEO = Posix.SysSocket.SO_RCVTIMEO; - SO_SNDTIMEO = Posix.SysSocket.SO_SNDTIMEO; -{ Security levels - as per NRL IPv6 - don't actually do anything } -// SO_SECURITY_AUTHENTICATION = SysSocket.SO_SECURITY_AUTHENTICATION; -// SO_SECURITY_ENCRYPTION_TRANSPORT = SysSocket.SO_SECURITY_ENCRYPTION_TRANSPORT; -// SO_SECURITY_ENCRYPTION_NETWORK = SysSocket.SO_SECURITY_ENCRYPTION_NETWORK; -// SO_BINDTODEVICE = SysSocket.SO_BINDTODEVICE; -{ Socket filtering } -// SO_ATTACH_FILTER = SysSocket.SO_ATTACH_FILTER; -// SO_DETACH_FILTER = SysSocket.SO_DETACH_FILTER; - - SOMAXCONN = 1024; - - IPV6_UNICAST_HOPS = Posix.NetinetIn.IPV6_UNICAST_HOPS; - IPV6_MULTICAST_IF = Posix.NetinetIn.IPV6_MULTICAST_IF; - IPV6_MULTICAST_HOPS = Posix.NetinetIn.IPV6_MULTICAST_HOPS; - IPV6_MULTICAST_LOOP = Posix.NetinetIn.IPV6_MULTICAST_LOOP; - IPV6_JOIN_GROUP = Posix.NetinetIn.IPV6_JOIN_GROUP; - IPV6_LEAVE_GROUP = Posix.NetinetIn.IPV6_LEAVE_GROUP; - -const - SOCK_STREAM = Posix.SysSocket.SOCK_STREAM;// 1; { stream socket } - SOCK_DGRAM = Posix.SysSocket.SOCK_DGRAM;// 2; { datagram socket } - SOCK_RAW = Posix.SysSocket.SOCK_RAW;// 3; { raw-protocol interface } - SOCK_RDM = Posix.SysSocket.SOCK_RDM;// 4; { reliably-delivered message } - SOCK_SEQPACKET = Posix.SysSocket.SOCK_SEQPACKET;// 5; { sequenced packet stream } - -{ TCP options. } - TCP_NODELAY = $0001; //netinettcp.pas - -{ Address families. } - - AF_UNSPEC = Posix.SysSocket.AF_UNSPEC;// 0; { unspecified } - AF_INET = Posix.SysSocket.AF_INET; // 2; { internetwork: UDP, TCP, etc. } - AF_INET6 = Posix.SysSocket.AF_INET6; // !! 30 { Internetwork Version 6 } - AF_MAX = Posix.SysSocket.AF_MAX; // !! - variable by OS - -{ Protocol families, same as address families for now. } - PF_UNSPEC = AF_UNSPEC; - PF_INET = AF_INET; - PF_INET6 = AF_INET6; - PF_MAX = AF_MAX; - -type -{ Structure used for manipulating linger option. } - PLinger = ^TLinger; - TLinger = Posix.SysSocket.linger; - -const - - MSG_OOB = Posix.SysSocket.MSG_OOB; // Process out-of-band data. - MSG_PEEK = Posix.SysSocket.MSG_PEEK; // Peek at incoming messages. - {$IFDEF MACOS} - MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE. - // Works under MAC OS X, but is undocumented, - // So FPC doesn't include it - {$ELSE} - MSG_NOSIGNAL = $4000; // Do not generate SIGPIPE. - {$ENDIF} - -const - WSAEINTR = EINTR; - WSAEBADF = EBADF; - WSAEACCES = EACCES; - WSAEFAULT = EFAULT; - WSAEINVAL = EINVAL; - WSAEMFILE = EMFILE; - WSAEWOULDBLOCK = EWOULDBLOCK; - WSAEINPROGRESS = EINPROGRESS; - WSAEALREADY = EALREADY; - WSAENOTSOCK = ENOTSOCK; - WSAEDESTADDRREQ = EDESTADDRREQ; - WSAEMSGSIZE = EMSGSIZE; - WSAEPROTOTYPE = EPROTOTYPE; - WSAENOPROTOOPT = ENOPROTOOPT; - WSAEPROTONOSUPPORT = EPROTONOSUPPORT; - WSAESOCKTNOSUPPORT = ESOCKTNOSUPPORT; - WSAEOPNOTSUPP = EOPNOTSUPP; - WSAEPFNOSUPPORT = EPFNOSUPPORT; - WSAEAFNOSUPPORT = EAFNOSUPPORT; - WSAEADDRINUSE = EADDRINUSE; - WSAEADDRNOTAVAIL = EADDRNOTAVAIL; - WSAENETDOWN = ENETDOWN; - WSAENETUNREACH = ENETUNREACH; - WSAENETRESET = ENETRESET; - WSAECONNABORTED = ECONNABORTED; - WSAECONNRESET = ECONNRESET; - WSAENOBUFS = ENOBUFS; - WSAEISCONN = EISCONN; - WSAENOTCONN = ENOTCONN; - WSAESHUTDOWN = ESHUTDOWN; - WSAETOOMANYREFS = ETOOMANYREFS; - WSAETIMEDOUT = ETIMEDOUT; - WSAECONNREFUSED = ECONNREFUSED; - WSAELOOP = ELOOP; - WSAENAMETOOLONG = ENAMETOOLONG; - WSAEHOSTDOWN = EHOSTDOWN; - WSAEHOSTUNREACH = EHOSTUNREACH; - WSAENOTEMPTY = ENOTEMPTY; - WSAEPROCLIM = -1; - WSAEUSERS = EUSERS; - WSAEDQUOT = EDQUOT; - WSAESTALE = ESTALE; - WSAEREMOTE = EREMOTE; - WSASYSNOTREADY = -2; - WSAVERNOTSUPPORTED = -3; - WSANOTINITIALISED = -4; - WSAEDISCON = -5; - WSAHOST_NOT_FOUND = 1; - WSATRY_AGAIN = 2; - WSANO_RECOVERY = 3; - WSANO_DATA = -6; - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = packed record - wVersion: Word; - wHighVersion: Word; - szDescription: array[0..WSADESCRIPTION_LEN] of Char; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char; - iMaxSockets: Word; - iMaxUdpDg: Word; - lpVendorInfo: PChar; - end; - - function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); - -var - in6addr_any, in6addr_loopback : TInAddr6; - -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); - -{=============================================================================} - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - - {$DEFINE SOCK_HAS_SINLEN} // OSX - -type - TVarSin = packed record - {$ifdef SOCK_HAS_SINLEN} - sin_len : UInt8; - {$endif} - - case integer of - 0: (AddressFamily: sa_family_t); - 1: ( - case sin_family: sa_family_t of - AF_INET: (sin_port: word; - sin_addr: TInAddr; - sin_zero: array[0..7] of Char); - AF_INET6: (sin6_port: word; - sin6_flowinfo: longword; - sin6_addr: TInAddr6; - sin6_scope_id: longword); - ); - end; - -function SizeOfVarSin(sin: TVarSin): integer; - - function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; - function WSACleanup: Integer; - function WSAGetLastError: Integer; - function GetHostName: string; - function Shutdown(s: TSocket; how: Integer): Integer; - function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - optlen: Integer): Integer; - function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory; - var optlen: Integer): Integer; - function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; - function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; - function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; - function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; - function ntohs(netshort: word): word; - function ntohl(netlong: longword): longword; - function Listen(s: TSocket; backlog: Integer): Integer; - function IoctlSocket(s: TSocket; cmd: Integer; var arg: integer): Integer; - function htons(hostshort: word): word; - function htonl(hostlong: longword): longword; - function GetSockName(s: TSocket; var name: TVarSin): Integer; - function GetPeerName(s: TSocket; var name: TVarSin): Integer; - function Connect(s: TSocket; const name: TVarSin): Integer; - function CloseSocket(s: TSocket): Integer; - function Bind(s: TSocket; const addr: TVarSin): Integer; - function Accept(s: TSocket; var addr: TVarSin): TSocket; - function Socket(af, Struc, Protocol: Integer): TSocket; - function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; - -function IsNewApi(Family: integer): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): string; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; - - -{==============================================================================} -implementation -uses - Posix.Base, Posix.Unistd, Posix.ArpaInet, Posix.NetDB; - -function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := Posix.NetinetIn.IN6_IS_ADDR_UNSPECIFIED(a^); -{ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));} -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := Posix.NetinetIn.IN6_IS_ADDR_LOOPBACK(a^); -{ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and - (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and - (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));} -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := Posix.NetinetIn.IN6_IS_ADDR_LINKLOCAL(a^); -{ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));} -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := Posix.NetinetIn.IN6_IS_ADDR_SITELOCAL(a^); -// Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0)); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := Posix.NetinetIn.IN6_IS_ADDR_MULTICAST(a^); -// Result := (a^.u6_addr8[0] = $FF); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.__s6_addr8[15] := 1; -end; - -{$IFDEF NEXTGEN} -function GetHostByName(const name: string):Phostent; -var - h: Phostent; -begin - h := Posix.NetDB.gethostbyname(MarshaledAString(TMarshal.AsAnsi(name))); -end; -{$ENDIF} -{=============================================================================} - -function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; -begin - with WSData do - begin - wVersion := wVersionRequired; - wHighVersion := $202; - szDescription := 'Synsock - Synapse Platform Independent Socket Layer'; - szSystemStatus := 'Running on Posix by Delphi'; - iMaxSockets := 32768; - iMaxUdpDg := 8192; - end; - Result := 0; -end; - -function WSACleanup: Integer; -begin - Result := 0; -end; - -function WSAGetLastError: Integer; -begin - Result := Posix.Errno.errno; -end; - -function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean; -begin - Result := __FD_ISSET(socket, fdset); -end; - -procedure FD_SET(Socket: TSocket; var fdset: TFDSet); -begin - __FD_SET(Socket, fdset); -end; - -procedure FD_CLR(Socket: TSocket; var fdset: TFDSet); -begin - __FD_CLR(Socket, fdset); -end; - -procedure FD_ZERO(var fdset: TFDSet); -begin - __FD_ZERO(fdset); -end; - -{=============================================================================} - -function SizeOfVarSin(sin: TVarSin): integer; -begin - case sin.sin_family of - AF_INET: - Result := SizeOf(TSockAddrIn); - AF_INET6: - Result := SizeOf(TSockAddrIn6); - else - Result := 0; - end; -end; - -{=============================================================================} - -function Bind(s: TSocket; const addr: TVarSin): Integer; -var - sa: sockaddr absolute addr; -begin - Result := Posix.SysSocket.Bind(s, sa, SizeOfVarSin(addr)); -end; - -function Connect(s: TSocket; const name: TVarSin): Integer; -var - sa: sockaddr absolute name; -begin - Result := Posix.SysSocket.Connect(s, sa, SizeOfVarSin(name)); -end; - -function GetSockName(s: TSocket; var name: TVarSin): Integer; -var - len: socklen_t; - address : sockaddr absolute name; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := Posix.SysSocket.GetSockName(s, address, Len); -end; - -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -var - len: socklen_t; - address : sockaddr absolute name; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := Posix.SysSocket.GetPeerName(s, address, Len); -end; - -function GetHostName: string; -{$IFDEF NEXTGEN} -var - name: TArray; -const - cMaxHostLength = 255; -begin - SetLength(name, cMaxHostLength); - if Posix.Unistd.GetHostName(MarshaledAString(name), cMaxHostLength) = 0 then - Result := TEncoding.UTF8.GetString(name).ToUpper; -{$ELSE} -var - s: AnsiString; -begin - Result := ''; - setlength(s, 255); - Posix.Unistd.GetHostName(PAnsiChar(s), Length(s) - 1); - Result := PChar(string(s)); -{$ENDIF} -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := Posix.SysSocket.Send(s, Buf^, len, flags); -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := Posix.SysSocket.Recv(s, Buf^, len, flags); -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -var - sa: sockaddr absolute addrto; -begin - Result := Posix.SysSocket.SendTo(s, Buf^, len, flags, sa, SizeOfVarSin(addrto)); -end; - -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -var - x: socklen_t; - address : sockaddr absolute from; -begin - x := SizeOf(from); - Result := Posix.SysSocket.RecvFrom(s, Buf^, len, flags, address, x); -end; - -function Accept(s: TSocket; var addr: TVarSin): TSocket; -var - x: socklen_t; - address : sockaddr absolute addr; -begin - x := SizeOf(addr); - Result := Posix.SysSocket.Accept(s, address, x); -end; - -function Shutdown(s: TSocket; how: Integer): Integer; -begin - Result := Posix.SysSocket.Shutdown(s, how); -end; - -function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - optlen: Integer): Integer; -begin - Result := Posix.SysSocket.setsockopt(s, level, optname, pointer(optval), optlen); -end; - -function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory; - var optlen: Integer): Integer; -var - x: socklen_t; -begin - x := optlen; - Result := Posix.SysSocket.getsockopt(s, level, optname, pointer(optval), x); - optlen := x; -end; - -function ntohs(netshort: word): word; -begin - Result := Posix.ArpaInet.ntohs(NetShort); -end; - -function ntohl(netlong: longword): longword; -begin - Result := Posix.ArpaInet.ntohl(NetLong); -end; - -function Listen(s: TSocket; backlog: Integer): Integer; -begin - if Posix.SysSocket.Listen(s, backlog) = 0 then - Result := 0 - else - Result := SOCKET_ERROR; -end; - -function IoctlSocket(s: TSocket; cmd: Integer; var arg: integer): Integer; -begin - Result := Posix.StrOpts.Ioctl(s, cmd, @arg); -end; - -function htons(hostshort: word): word; -begin - Result := Posix.ArpaInet.htons(Hostshort); -end; - -function htonl(hostlong: longword): longword; -begin - Result := Posix.ArpaInet.htonl(HostLong); -end; - -function CloseSocket(s: TSocket): Integer; -begin - Result := Posix.Unistd.__close(s); -end; - -function Socket(af, Struc, Protocol: Integer): TSocket; -begin - Result := Posix.SysSocket.Socket(af, struc, protocol); -end; - -function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; -begin - Result := Posix.SysSelect.Select(nfds, readfds, writefds, exceptfds, timeout); -end; - -{=============================================================================} -function IsNewApi(Family: integer): Boolean; -begin - Result := SockEnhancedApi; - if not Result then - Result := (Family = AF_INET6) and SockWship6Api; -end; - -{$IFDEF NEXTGEN} -function GetAddrInfo(hostname, servname: string; - const hints: addrinfo; out res: Paddrinfo): Integer; -begin - -end; -{$ENDIF} - -function gethostbyname(const name: PAnsiChar): PHostEnt; cdecl; - external libc name _PU + 'gethostbyname'; -function gethostbyaddr(var addr; len: socklen_t; atype: integer): PHostEnt; cdecl; - external libc name _PU + 'gethostbyaddr'; - -function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - HostEnt: PHostEnt; - r: integer; - Hints1, Hints2: AddrInfo; - Sin1, Sin2: TVarSin; - TwoPass: boolean; - - function GetAddr(const IP, port: string; Hints: AddrInfo; var Sin: TVarSin): integer; - var - Addr: PAddrInfo; - begin - Addr := nil; - try - FillChar(Sin, Sizeof(Sin), 0); - if Hints.ai_socktype = SOCK_RAW then - begin - Hints.ai_socktype := 0; - Hints.ai_protocol := 0; - Result := GetAddrInfo(PAnsiChar(AnsiString(IP)), nil, Hints, Addr); - end - else - begin - if (IP = cAnyHost) or (IP = c6AnyHost) then - begin - Hints.ai_flags := AI_PASSIVE; - Result := GetAddrInfo(nil, PAnsiChar(AnsiString(Port)), Hints, Addr); - end - else - if (IP = cLocalhost) or (IP = c6Localhost) then - begin - Result := GetAddrInfo(nil, PAnsiChar(AnsiString(Port)), Hints, Addr); - end - else - begin - Result := GetAddrInfo(PAnsiChar(AnsiString(IP)), PAnsiChar(AnsiString(Port)), Hints, Addr); - end; - end; - if Result = 0 then - if (Addr <> nil) then - Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen); - finally - if Assigned(Addr) then - FreeAddrInfo(Addr^); - end; - end; - -begin - Result := 0; - FillChar(Sin, Sizeof(Sin), 0); - if not IsNewApi(family) then - begin - SynSockCS.Enter; - try - Sin.sin_family := AF_INET; - ProtoEnt := GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - {$IFDEF NEXTGEN} - ServEnt := GetServByName(MarshaledAString(TMarshal.AsAnsi(Port)), ProtoEnt^.p_name); - {$ELSE} - ServEnt := GetServByName(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name); - {$ENDIF} - if ServEnt = nil then - Sin.sin_port := htons(StrToIntDef(Port, 0)) - else - Sin.sin_port := ServEnt^.s_port; - if IP = cBroadcast then - Sin.sin_addr.s_addr := UInt32(INADDR_BROADCAST) - else - begin - {$IFDEF NEXTGEN} - Sin.sin_addr.s_addr := inet_addr(MarshaledAString(TMarshal.AsAnsi(IP))); - {$ELSE} - Sin.sin_addr.s_addr := inet_addr(PAnsiChar(AnsiString(IP))); - {$ENDIF} - if Sin.sin_addr.s_addr = UInt32(INADDR_NONE) then - begin - {$IFDEF NEXTGEN} - HostEnt := GetHostByName(MarshaledAString(TMarshal.AsAnsi(IP))); - {$ELSE} - HostEnt := GetHostByName(PAnsiChar(AnsiString(IP))); - {$ENDIF} - Result := WSAGetLastError; - if HostEnt <> nil then - Sin.sin_addr.S_addr := UInt32(HostEnt.h_addr_list); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - begin - FillChar(Hints1, Sizeof(Hints1), 0); - FillChar(Hints2, Sizeof(Hints2), 0); - TwoPass := False; - if Family = AF_UNSPEC then - begin - if PreferIP4 then - begin - Hints1.ai_family := AF_INET; - Hints2.ai_family := AF_INET6; - TwoPass := True; - end - else - begin - Hints2.ai_family := AF_INET; - Hints1.ai_family := AF_INET6; - TwoPass := True; - end; - end - else - Hints1.ai_family := Family; - - Hints1.ai_socktype := SockType; - Hints1.ai_protocol := SockProtocol; - Hints2.ai_socktype := Hints1.ai_socktype; - Hints2.ai_protocol := Hints1.ai_protocol; - - r := GetAddr(IP, Port, Hints1, Sin1); - Result := r; - sin := sin1; - if r <> 0 then - if TwoPass then - begin - r := GetAddr(IP, Port, Hints2, Sin2); - Result := r; - if r = 0 then - sin := sin2; - end; - end; -end; - -function GetSinIP(Sin: TVarSin): string; -var - p: PAnsiChar; - hostlen, servlen: integer; - r: integer; - sa:sockaddr absolute Sin; - byHost, byServ: TBytes; - HostWrapper, ServWrapper: TPtrWrapper; -begin - Result := ''; - if not IsNewApi(Sin.AddressFamily) then - begin - p := inet_ntoa(Sin.sin_addr); - if p <> nil then - Result := string(p); - end - else - begin - // NEXTGEN compatible - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - Setlength(byHost, hostLen); - Setlength(byServ, hostLen); - HostWrapper := TPtrWrapper.Create(@byHost[0]); - ServWrapper := TPtrWrapper.Create(@byServ[0]); - r := getnameinfo(sa, SizeOfVarSin(sin), HostWrapper.ToPointer, hostlen, - ServWrapper.ToPointer, servlen, NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - Result := TMarshal.ReadStringAsAnsi(HostWrapper{, NI_MAXHOST}); - end; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - if (Sin.sin_family = AF_INET6) then - Result := synsock.ntohs(Sin.sin6_port) - else - Result := synsock.ntohs(Sin.sin_port); -end; - -procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings); -type - TaPInAddr = array[0..250] of PInAddr; - PaPInAddr = ^TaPInAddr; -var - Hints: AddrInfo; - Addr: PAddrInfo; - AddrNext: PAddrInfo; - r: integer; - host, serv: string; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IP: UINT32; - PAdrPtr: PaPInAddr; - i: Integer; - s: string; - InAddr: TInAddr; - aby:TArray; -begin - IPList.Clear; - if not IsNewApi(Family) then - begin - {$IFDEF NEXTGEN} - IP := inet_addr(MarshaledAString(TMarshal.AsAnsi(Name))); - {$ELSE} - IP := inet_addr(PAnsiChar(AnsiString(Name))); - {$ENDIF} - if IP = UINT32(INADDR_NONE) then - begin - SynSockCS.Enter; - try - {$IFDEF NEXTGEN} - RemoteHost := GetHostByName(MarshaledAString(TMarshal.AsAnsi(Name))); - {$ELSE} - RemoteHost := GetHostByName(PAnsiChar(AnsiString(Name))); - {$ENDIF} - if RemoteHost <> nil then - begin - PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); - i := 0; - while PAdrPtr^[i] <> nil do - begin - InAddr := PAdrPtr^[i]^; - aby := TArray(InAddr); - s := Format('%d.%d.%d.%d', [aby[0], aby[1], - aby[2], aby[3]]); - IPList.Add(s); - Inc(i); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - IPList.Add(Name); - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := GetAddrInfo(PAnsiChar(AnsiString(Name)), nil, Hints, Addr); - if r = 0 then - begin - AddrNext := Addr; - while not(AddrNext = nil) do - begin - if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET)) - or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); -{$IFDEF NEXTGEN} - r := getnameinfo(AddrNext^.ai_addr^, AddrNext^.ai_addrlen, - MarshaledAString(TMarshal.AsAnsi(host)), hostlen, MarshaledAString(TMarshal.AsAnsi(serv)), servlen, - NI_NUMERICHOST + NI_NUMERICSERV); -{$ELSE} - r := getnameinfo(AddrNext^.ai_addr^, AddrNext^.ai_addrlen, - PAnsiChar(AnsiString(host)), hostlen, PAnsiChar(AnsiString(serv)), servlen, - NI_NUMERICHOST + NI_NUMERICSERV); -{$ENDIF} - if r = 0 then - begin - host := PChar(host); - IPList.Add(host); - end; - end; - AddrNext := AddrNext^.ai_next; - end; - end; - finally - if Assigned(Addr) then - FreeAddrInfo(Addr^); - end; - end; - if IPList.Count = 0 then - IPList.Add(cAnyHost); -end; - -function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - Hints: AddrInfo; - Addr: PAddrInfo; - _Addr: AddrInfo; - r: integer; -begin - Result := 0; - if not IsNewApi(Family) then - begin - SynSockCS.Enter; - try - ProtoEnt := GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := GetServByName(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name); - if ServEnt = nil then - Result := StrToIntDef(Port, 0) - else - Result := htons(ServEnt^.s_port); - finally - SynSockCS.Leave; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := Sockprotocol; - Hints.ai_flags := AI_PASSIVE; - r := GetAddrInfo(nil, PAnsiChar(AnsiString(Port)), Hints, Addr); - if (r = 0) and Assigned(Addr) then - begin - if Addr^.ai_family = AF_INET then - Result := htons(Addr^.ai_addr^.sa_data[0]); // port - if Addr^.ai_family = AF_INET6 then - Result := htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port); - end; - finally - if Assigned(Addr) then - begin - _Addr := Addr^; - FreeAddrInfo(_Addr); - end; - end; - end; -end; - -function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string; -var - Hints: AddrInfo; - Addr: PAddrInfo; - _Addr: AddrInfo; - r: integer; - host, serv: string; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IPn: UINT32; -begin - Result := IP; - if not IsNewApi(Family) then - begin - IPn := inet_addr(PAnsiChar(AnsiString(IP))); - if IPn <> UINT32(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := GetHostByAddr(IPn, SizeOf(IPn), AF_INET); - if RemoteHost <> nil then - Result := string(RemoteHost^.hname); - finally - SynSockCS.Leave; - end; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := GetAddrInfo(PAnsiChar(AnsiString(IP)), nil, Hints, Addr); - if (r = 0) and Assigned(Addr)then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(Addr^.ai_addr^, Addr^.ai_addrlen, - PAnsiChar(AnsiString(host)), hostlen, PAnsiChar(AnsiString(serv)), servlen, - NI_NUMERICSERV); - if r = 0 then - Result := PChar(host); - end; - finally - if Assigned(Addr) then - begin - _Addr := Addr^; - FreeAddrInfo(_Addr); - end; - end; - end; -end; - -{=============================================================================} - -function InitSocketInterface(stack: string): Boolean; -begin - SockEnhancedApi := True; - SockWship6Api := False; -// Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN)); - Result := True; -end; - -function DestroySocketInterface: Boolean; -begin - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; - SET_IN6_IF_ADDR_ANY (@in6addr_any); - SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - SynSockCS.Free; -end; - -{$ENDIF} diff --git a/3rd/synapse/source/sswin32.inc b/3rd/synapse/source/sswin32.inc deleted file mode 100644 index b234db847..000000000 --- a/3rd/synapse/source/sswin32.inc +++ /dev/null @@ -1,1622 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.003.001 | -|==============================================================================| -| Content: Socket Independent Platform Layer - Win32/64 definition include | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -//{$DEFINE WINSOCK1} -{Note about define WINSOCK1: -If you activate this compiler directive, then socket interface level 1.1 is -used instead default level 2.2. Level 2.2 is not available on old W95, however -you can install update. -} - -//{$DEFINE FORCEOLDAPI} -{Note about define FORCEOLDAPI: -If you activate this compiler directive, then is allways used old socket API -for name resolution. If you leave this directive inactive, then the new API -is used, when running system allows it. - -For IPv6 support you must have new API! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -{$IFDEF VER125} - {$DEFINE BCB} -{$ENDIF} -{$IFDEF BCB} - {$ObjExportAll On} - (*$HPPEMIT '/* EDE 2003-02-19 */' *) - (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *) - (*$HPPEMIT '#undef h_addr' *) - (*$HPPEMIT '#undef IOCPARM_MASK' *) - (*$HPPEMIT '#undef FD_SETSIZE' *) - (*$HPPEMIT '#undef IOC_VOID' *) - (*$HPPEMIT '#undef IOC_OUT' *) - (*$HPPEMIT '#undef IOC_IN' *) - (*$HPPEMIT '#undef IOC_INOUT' *) - (*$HPPEMIT '#undef FIONREAD' *) - (*$HPPEMIT '#undef FIONBIO' *) - (*$HPPEMIT '#undef FIOASYNC' *) - (*$HPPEMIT '#undef IPPROTO_IP' *) - (*$HPPEMIT '#undef IPPROTO_ICMP' *) - (*$HPPEMIT '#undef IPPROTO_IGMP' *) - (*$HPPEMIT '#undef IPPROTO_TCP' *) - (*$HPPEMIT '#undef IPPROTO_UDP' *) - (*$HPPEMIT '#undef IPPROTO_RAW' *) - (*$HPPEMIT '#undef IPPROTO_MAX' *) - (*$HPPEMIT '#undef INADDR_ANY' *) - (*$HPPEMIT '#undef INADDR_LOOPBACK' *) - (*$HPPEMIT '#undef INADDR_BROADCAST' *) - (*$HPPEMIT '#undef INADDR_NONE' *) - (*$HPPEMIT '#undef INVALID_SOCKET' *) - (*$HPPEMIT '#undef SOCKET_ERROR' *) - (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *) - (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *) - (*$HPPEMIT '#undef IP_OPTIONS' *) - (*$HPPEMIT '#undef IP_TOS' *) - (*$HPPEMIT '#undef IP_TTL' *) - (*$HPPEMIT '#undef IP_MULTICAST_IF' *) - (*$HPPEMIT '#undef IP_MULTICAST_TTL' *) - (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *) - (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *) - (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *) - (*$HPPEMIT '#undef IP_DONTFRAGMENT' *) - (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *) - (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *) - (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *) - (*$HPPEMIT '#undef SOL_SOCKET' *) - (*$HPPEMIT '#undef SO_DEBUG' *) - (*$HPPEMIT '#undef SO_ACCEPTCONN' *) - (*$HPPEMIT '#undef SO_REUSEADDR' *) - (*$HPPEMIT '#undef SO_KEEPALIVE' *) - (*$HPPEMIT '#undef SO_DONTROUTE' *) - (*$HPPEMIT '#undef SO_BROADCAST' *) - (*$HPPEMIT '#undef SO_USELOOPBACK' *) - (*$HPPEMIT '#undef SO_LINGER' *) - (*$HPPEMIT '#undef SO_OOBINLINE' *) - (*$HPPEMIT '#undef SO_DONTLINGER' *) - (*$HPPEMIT '#undef SO_SNDBUF' *) - (*$HPPEMIT '#undef SO_RCVBUF' *) - (*$HPPEMIT '#undef SO_SNDLOWAT' *) - (*$HPPEMIT '#undef SO_RCVLOWAT' *) - (*$HPPEMIT '#undef SO_SNDTIMEO' *) - (*$HPPEMIT '#undef SO_RCVTIMEO' *) - (*$HPPEMIT '#undef SO_ERROR' *) - (*$HPPEMIT '#undef SO_OPENTYPE' *) - (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *) - (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *) - (*$HPPEMIT '#undef SO_MAXDG' *) - (*$HPPEMIT '#undef SO_MAXPATHDG' *) - (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *) - (*$HPPEMIT '#undef SO_CONNECT_TIME' *) - (*$HPPEMIT '#undef SO_TYPE' *) - (*$HPPEMIT '#undef SOCK_STREAM' *) - (*$HPPEMIT '#undef SOCK_DGRAM' *) - (*$HPPEMIT '#undef SOCK_RAW' *) - (*$HPPEMIT '#undef SOCK_RDM' *) - (*$HPPEMIT '#undef SOCK_SEQPACKET' *) - (*$HPPEMIT '#undef TCP_NODELAY' *) - (*$HPPEMIT '#undef AF_UNSPEC' *) - (*$HPPEMIT '#undef SOMAXCONN' *) - (*$HPPEMIT '#undef AF_INET' *) - (*$HPPEMIT '#undef AF_MAX' *) - (*$HPPEMIT '#undef PF_UNSPEC' *) - (*$HPPEMIT '#undef PF_INET' *) - (*$HPPEMIT '#undef PF_MAX' *) - (*$HPPEMIT '#undef MSG_OOB' *) - (*$HPPEMIT '#undef MSG_PEEK' *) - (*$HPPEMIT '#undef WSABASEERR' *) - (*$HPPEMIT '#undef WSAEINTR' *) - (*$HPPEMIT '#undef WSAEBADF' *) - (*$HPPEMIT '#undef WSAEACCES' *) - (*$HPPEMIT '#undef WSAEFAULT' *) - (*$HPPEMIT '#undef WSAEINVAL' *) - (*$HPPEMIT '#undef WSAEMFILE' *) - (*$HPPEMIT '#undef WSAEWOULDBLOCK' *) - (*$HPPEMIT '#undef WSAEINPROGRESS' *) - (*$HPPEMIT '#undef WSAEALREADY' *) - (*$HPPEMIT '#undef WSAENOTSOCK' *) - (*$HPPEMIT '#undef WSAEDESTADDRREQ' *) - (*$HPPEMIT '#undef WSAEMSGSIZE' *) - (*$HPPEMIT '#undef WSAEPROTOTYPE' *) - (*$HPPEMIT '#undef WSAENOPROTOOPT' *) - (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *) - (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEOPNOTSUPP' *) - (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *) - (*$HPPEMIT '#undef WSAEADDRINUSE' *) - (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *) - (*$HPPEMIT '#undef WSAENETDOWN' *) - (*$HPPEMIT '#undef WSAENETUNREACH' *) - (*$HPPEMIT '#undef WSAENETRESET' *) - (*$HPPEMIT '#undef WSAECONNABORTED' *) - (*$HPPEMIT '#undef WSAECONNRESET' *) - (*$HPPEMIT '#undef WSAENOBUFS' *) - (*$HPPEMIT '#undef WSAEISCONN' *) - (*$HPPEMIT '#undef WSAENOTCONN' *) - (*$HPPEMIT '#undef WSAESHUTDOWN' *) - (*$HPPEMIT '#undef WSAETOOMANYREFS' *) - (*$HPPEMIT '#undef WSAETIMEDOUT' *) - (*$HPPEMIT '#undef WSAECONNREFUSED' *) - (*$HPPEMIT '#undef WSAELOOP' *) - (*$HPPEMIT '#undef WSAENAMETOOLONG' *) - (*$HPPEMIT '#undef WSAEHOSTDOWN' *) - (*$HPPEMIT '#undef WSAEHOSTUNREACH' *) - (*$HPPEMIT '#undef WSAENOTEMPTY' *) - (*$HPPEMIT '#undef WSAEPROCLIM' *) - (*$HPPEMIT '#undef WSAEUSERS' *) - (*$HPPEMIT '#undef WSAEDQUOT' *) - (*$HPPEMIT '#undef WSAESTALE' *) - (*$HPPEMIT '#undef WSAEREMOTE' *) - (*$HPPEMIT '#undef WSASYSNOTREADY' *) - (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *) - (*$HPPEMIT '#undef WSANOTINITIALISED' *) - (*$HPPEMIT '#undef WSAEDISCON' *) - (*$HPPEMIT '#undef WSAENOMORE' *) - (*$HPPEMIT '#undef WSAECANCELLED' *) - (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *) - (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *) - (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *) - (*$HPPEMIT '#undef WSASYSCALLFAILURE' *) - (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *) - (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *) - (*$HPPEMIT '#undef WSA_E_NO_MORE' *) - (*$HPPEMIT '#undef WSA_E_CANCELLED' *) - (*$HPPEMIT '#undef WSAEREFUSED' *) - (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *) - (*$HPPEMIT '#undef HOST_NOT_FOUND' *) - (*$HPPEMIT '#undef WSATRY_AGAIN' *) - (*$HPPEMIT '#undef TRY_AGAIN' *) - (*$HPPEMIT '#undef WSANO_RECOVERY' *) - (*$HPPEMIT '#undef NO_RECOVERY' *) - (*$HPPEMIT '#undef WSANO_DATA' *) - (*$HPPEMIT '#undef NO_DATA' *) - (*$HPPEMIT '#undef WSANO_ADDRESS' *) - (*$HPPEMIT '#undef ENAMETOOLONG' *) - (*$HPPEMIT '#undef ENOTEMPTY' *) - (*$HPPEMIT '#undef FD_CLR' *) - (*$HPPEMIT '#undef FD_ISSET' *) - (*$HPPEMIT '#undef FD_SET' *) - (*$HPPEMIT '#undef FD_ZERO' *) - (*$HPPEMIT '#undef NO_ADDRESS' *) - (*$HPPEMIT '#undef ADDR_ANY' *) - (*$HPPEMIT '#undef SO_GROUP_ID' *) - (*$HPPEMIT '#undef SO_GROUP_PRIORITY' *) - (*$HPPEMIT '#undef SO_MAX_MSG_SIZE' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFOA' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFOW' *) - (*$HPPEMIT '#undef SO_PROTOCOL_INFO' *) - (*$HPPEMIT '#undef PVD_CONFIG' *) - (*$HPPEMIT '#undef AF_INET6' *) - (*$HPPEMIT '#undef PF_INET6' *) -{$ENDIF} - -{$IFDEF FPC} - {$IFDEF WIN32} - {$ALIGN OFF} - {$ELSE} - {$PACKRECORDS C} - {$ENDIF} -{$ELSE} - {$IFDEF WIN64} - {$ALIGN ON} - {$MINENUMSIZE 4} - {$ELSE} - {$MINENUMSIZE 4} - {$ALIGN OFF} - {$ENDIF} -{$ENDIF} - -interface - -uses - SyncObjs, SysUtils, Classes, - Windows; - -function InitSocketInterface(stack: String): Boolean; -function DestroySocketInterface: Boolean; - -const -{$IFDEF WINSOCK1} - WinsockLevel = $0101; -{$ELSE} - WinsockLevel = $0202; -{$ENDIF} - -type - u_short = Word; - u_int = Integer; - u_long = Longint; - pu_long = ^u_long; - pu_short = ^u_short; -{$IFDEF FPC} - TSocket = ptruint; -{$ELSE} - {$IFDEF WIN64} - TSocket = UINT_PTR; - {$ELSE} - TSocket = u_int; - {$ENDIF} -{$ENDIF} - TAddrFamily = integer; - - TMemory = pointer; - -const - {$IFDEF WINCE} - DLLStackName = 'ws2.dll'; - {$ELSE} - {$IFDEF WINSOCK1} - DLLStackName = 'wsock32.dll'; - {$ELSE} - DLLStackName = 'ws2_32.dll'; - {$ENDIF} - {$ENDIF} - DLLwship6 = 'wship6.dll'; - - cLocalhost = '127.0.0.1'; - cAnyHost = '0.0.0.0'; - cBroadcast = '255.255.255.255'; - c6Localhost = '::1'; - c6AnyHost = '::0'; - c6Broadcast = 'ffff::1'; - cAnyPort = '0'; - - -const - FD_SETSIZE = 64; -type - PFDSet = ^TFDSet; - TFDSet = record - fd_count: u_int; - fd_array: array[0..FD_SETSIZE-1] of TSocket; - end; - -const - FIONREAD = $4004667f; - FIONBIO = $8004667e; - FIOASYNC = $8004667d; - -type - PTimeVal = ^TTimeVal; - TTimeVal = record - tv_sec: Longint; - tv_usec: Longint; - end; - -const - IPPROTO_IP = 0; { Dummy } - IPPROTO_ICMP = 1; { Internet Control Message Protocol } - IPPROTO_IGMP = 2; { Internet Group Management Protocol} - IPPROTO_TCP = 6; { TCP } - IPPROTO_UDP = 17; { User Datagram Protocol } - IPPROTO_IPV6 = 41; - IPPROTO_ICMPV6 = 58; - IPPROTO_RM = 113; - - IPPROTO_RAW = 255; - IPPROTO_MAX = 256; - -type - - PInAddr = ^TInAddr; - TInAddr = record - case integer of - 0: (S_bytes: packed array [0..3] of byte); - 1: (S_addr: u_long); - end; - - PSockAddrIn = ^TSockAddrIn; - TSockAddrIn = record - case Integer of - 0: (sin_family: u_short; - sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of byte); - 1: (sa_family: u_short; - sa_data: array[0..13] of byte) - end; - - TIP_mreq = record - imr_multiaddr: TInAddr; { IP multicast address of group } - imr_interface: TInAddr; { local IP address of interface } - end; - - PInAddr6 = ^TInAddr6; - TInAddr6 = record - case integer of - 0: (S6_addr: packed array [0..15] of byte); - 1: (u6_addr8: packed array [0..15] of byte); - 2: (u6_addr16: packed array [0..7] of word); - 3: (u6_addr32: packed array [0..3] of integer); - end; - - PSockAddrIn6 = ^TSockAddrIn6; - TSockAddrIn6 = record - sin6_family: u_short; // AF_INET6 - sin6_port: u_short; // Transport level port number - sin6_flowinfo: u_long; // IPv6 flow information - sin6_addr: TInAddr6; // IPv6 address - sin6_scope_id: u_long; // Scope Id: IF number for link-local - // SITE id for site-local - end; - - TIPv6_mreq = record - ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. - ipv6mr_interface: integer; // Interface index. - padding: integer; - end; - - PHostEnt = ^THostEnt; - THostEnt = record - h_name: PAnsiChar; - h_aliases: ^PAnsiChar; - h_addrtype: Smallint; - h_length: Smallint; - case integer of - 0: (h_addr_list: ^PAnsiChar); - 1: (h_addr: ^PInAddr); - end; - - PNetEnt = ^TNetEnt; - TNetEnt = record - n_name: PAnsiChar; - n_aliases: ^PAnsiChar; - n_addrtype: Smallint; - n_net: u_long; - end; - - PServEnt = ^TServEnt; - TServEnt = record - s_name: PAnsiChar; - s_aliases: ^PAnsiChar; -{$ifdef WIN64} - s_proto: PAnsiChar; - s_port: Smallint; -{$else} - s_port: Smallint; - s_proto: PAnsiChar; -{$endif} - end; - - PProtoEnt = ^TProtoEnt; - TProtoEnt = record - p_name: PAnsiChar; - p_aliases: ^PAnsichar; - p_proto: Smallint; - end; - -const - INADDR_ANY = $00000000; - INADDR_LOOPBACK = $7F000001; - INADDR_BROADCAST = $FFFFFFFF; - INADDR_NONE = $FFFFFFFF; - ADDR_ANY = INADDR_ANY; - INVALID_SOCKET = TSocket(NOT(0)); - SOCKET_ERROR = -1; - -Const - {$IFDEF WINSOCK1} - IP_OPTIONS = 1; - IP_MULTICAST_IF = 2; { set/get IP multicast interface } - IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive } - IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = 5; { add an IP group membership } - IP_DROP_MEMBERSHIP = 6; { drop an IP group membership } - IP_TTL = 7; { set/get IP Time To Live } - IP_TOS = 8; { set/get IP Type Of Service } - IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag } - {$ELSE} - IP_OPTIONS = 1; - IP_HDRINCL = 2; - IP_TOS = 3; { set/get IP Type Of Service } - IP_TTL = 4; { set/get IP Time To Live } - IP_MULTICAST_IF = 9; { set/get IP multicast interface } - IP_MULTICAST_TTL = 10; { set/get IP multicast timetolive } - IP_MULTICAST_LOOP = 11; { set/get IP multicast loopback } - IP_ADD_MEMBERSHIP = 12; { add an IP group membership } - IP_DROP_MEMBERSHIP = 13; { drop an IP group membership } - IP_DONTFRAGMENT = 14; { set/get IP Don't Fragment flag } - {$ENDIF} - - IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop } - IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member } - IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf } - - SOL_SOCKET = $ffff; {options for socket level } -{ Option flags per-socket. } - SO_DEBUG = $0001; { turn on debugging info recording } - SO_ACCEPTCONN = $0002; { socket has had listen() } - SO_REUSEADDR = $0004; { allow local address reuse } - SO_KEEPALIVE = $0008; { keep connections alive } - SO_DONTROUTE = $0010; { just use interface addresses } - SO_BROADCAST = $0020; { permit sending of broadcast msgs } - SO_USELOOPBACK = $0040; { bypass hardware when possible } - SO_LINGER = $0080; { linger on close if data present } - SO_OOBINLINE = $0100; { leave received OOB data in line } - SO_DONTLINGER = $ff7f; -{ Additional options. } - SO_SNDBUF = $1001; { send buffer size } - SO_RCVBUF = $1002; { receive buffer size } - SO_SNDLOWAT = $1003; { send low-water mark } - SO_RCVLOWAT = $1004; { receive low-water mark } - SO_SNDTIMEO = $1005; { send timeout } - SO_RCVTIMEO = $1006; { receive timeout } - SO_ERROR = $1007; { get error status and clear } - SO_TYPE = $1008; { get socket type } -{ WinSock 2 extension -- new options } - SO_GROUP_ID = $2001; { ID of a socket group} - SO_GROUP_PRIORITY = $2002; { the relative priority within a group} - SO_MAX_MSG_SIZE = $2003; { maximum message size } - SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure } - SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure } - SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA; - PVD_CONFIG = $3001; {configuration info for service provider } -{ Option for opening sockets for synchronous access. } - SO_OPENTYPE = $7008; - SO_SYNCHRONOUS_ALERT = $10; - SO_SYNCHRONOUS_NONALERT = $20; -{ Other NT-specific options. } - SO_MAXDG = $7009; - SO_MAXPATHDG = $700A; - SO_UPDATE_ACCEPT_CONTEXT = $700B; - SO_CONNECT_TIME = $700C; - - SOMAXCONN = $7fffffff; - - IPV6_UNICAST_HOPS = 8; // ??? - IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f - IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl - IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback - IPV6_JOIN_GROUP = 12; // add an IP group membership - IPV6_LEAVE_GROUP = 13; // drop an IP group membership - - MSG_NOSIGNAL = 0; - - // getnameinfo constants - NI_MAXHOST = 1025; - NI_MAXSERV = 32; - NI_NOFQDN = $1; - NI_NUMERICHOST = $2; - NI_NAMEREQD = $4; - NI_NUMERICSERV = $8; - NI_DGRAM = $10; - - -const - SOCK_STREAM = 1; { stream socket } - SOCK_DGRAM = 2; { datagram socket } - SOCK_RAW = 3; { raw-protocol interface } - SOCK_RDM = 4; { reliably-delivered message } - SOCK_SEQPACKET = 5; { sequenced packet stream } - -{ TCP options. } - TCP_NODELAY = $0001; - -{ Address families. } - - AF_UNSPEC = 0; { unspecified } - AF_INET = 2; { internetwork: UDP, TCP, etc. } - AF_INET6 = 23; { Internetwork Version 6 } - AF_MAX = 24; - -{ Protocol families, same as address families for now. } - PF_UNSPEC = AF_UNSPEC; - PF_INET = AF_INET; - PF_INET6 = AF_INET6; - PF_MAX = AF_MAX; - -type - { Structure used by kernel to store most addresses. } - PSockAddr = ^TSockAddr; - TSockAddr = TSockAddrIn; - - { Structure used by kernel to pass protocol information in raw sockets. } - PSockProto = ^TSockProto; - TSockProto = record - sp_family: u_short; - sp_protocol: u_short; - end; - -type - PAddrInfo = ^TAddrInfo; - TAddrInfo = record - ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST. - ai_family: integer; // PF_xxx. - ai_socktype: integer; // SOCK_xxx. - ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6. - ai_addrlen: u_int; // Length of ai_addr. - ai_canonname: PAnsiChar; // Canonical name for nodename. - ai_addr: PSockAddr; // Binary address. - ai_next: PAddrInfo; // Next structure in linked list. - end; - -const - // Flags used in "hints" argument to getaddrinfo(). - AI_PASSIVE = $1; // Socket address will be used in bind() call. - AI_CANONNAME = $2; // Return canonical name in first ai_canonname. - AI_NUMERICHOST = $4; // Nodename must be a numeric address string. - -type -{ Structure used for manipulating linger option. } - PLinger = ^TLinger; - TLinger = record - l_onoff: u_short; - l_linger: u_short; - end; - -const - - MSG_OOB = $01; // Process out-of-band data. - MSG_PEEK = $02; // Peek at incoming messages. - -const - -{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" } - WSABASEERR = 10000; - -{ Windows Sockets definitions of regular Microsoft C error constants } - - WSAEINTR = (WSABASEERR+4); - WSAEBADF = (WSABASEERR+9); - WSAEACCES = (WSABASEERR+13); - WSAEFAULT = (WSABASEERR+14); - WSAEINVAL = (WSABASEERR+22); - WSAEMFILE = (WSABASEERR+24); - -{ Windows Sockets definitions of regular Berkeley error constants } - - WSAEWOULDBLOCK = (WSABASEERR+35); - WSAEINPROGRESS = (WSABASEERR+36); - WSAEALREADY = (WSABASEERR+37); - WSAENOTSOCK = (WSABASEERR+38); - WSAEDESTADDRREQ = (WSABASEERR+39); - WSAEMSGSIZE = (WSABASEERR+40); - WSAEPROTOTYPE = (WSABASEERR+41); - WSAENOPROTOOPT = (WSABASEERR+42); - WSAEPROTONOSUPPORT = (WSABASEERR+43); - WSAESOCKTNOSUPPORT = (WSABASEERR+44); - WSAEOPNOTSUPP = (WSABASEERR+45); - WSAEPFNOSUPPORT = (WSABASEERR+46); - WSAEAFNOSUPPORT = (WSABASEERR+47); - WSAEADDRINUSE = (WSABASEERR+48); - WSAEADDRNOTAVAIL = (WSABASEERR+49); - WSAENETDOWN = (WSABASEERR+50); - WSAENETUNREACH = (WSABASEERR+51); - WSAENETRESET = (WSABASEERR+52); - WSAECONNABORTED = (WSABASEERR+53); - WSAECONNRESET = (WSABASEERR+54); - WSAENOBUFS = (WSABASEERR+55); - WSAEISCONN = (WSABASEERR+56); - WSAENOTCONN = (WSABASEERR+57); - WSAESHUTDOWN = (WSABASEERR+58); - WSAETOOMANYREFS = (WSABASEERR+59); - WSAETIMEDOUT = (WSABASEERR+60); - WSAECONNREFUSED = (WSABASEERR+61); - WSAELOOP = (WSABASEERR+62); - WSAENAMETOOLONG = (WSABASEERR+63); - WSAEHOSTDOWN = (WSABASEERR+64); - WSAEHOSTUNREACH = (WSABASEERR+65); - WSAENOTEMPTY = (WSABASEERR+66); - WSAEPROCLIM = (WSABASEERR+67); - WSAEUSERS = (WSABASEERR+68); - WSAEDQUOT = (WSABASEERR+69); - WSAESTALE = (WSABASEERR+70); - WSAEREMOTE = (WSABASEERR+71); - -{ Extended Windows Sockets error constant definitions } - - WSASYSNOTREADY = (WSABASEERR+91); - WSAVERNOTSUPPORTED = (WSABASEERR+92); - WSANOTINITIALISED = (WSABASEERR+93); - WSAEDISCON = (WSABASEERR+101); - WSAENOMORE = (WSABASEERR+102); - WSAECANCELLED = (WSABASEERR+103); - WSAEEINVALIDPROCTABLE = (WSABASEERR+104); - WSAEINVALIDPROVIDER = (WSABASEERR+105); - WSAEPROVIDERFAILEDINIT = (WSABASEERR+106); - WSASYSCALLFAILURE = (WSABASEERR+107); - WSASERVICE_NOT_FOUND = (WSABASEERR+108); - WSATYPE_NOT_FOUND = (WSABASEERR+109); - WSA_E_NO_MORE = (WSABASEERR+110); - WSA_E_CANCELLED = (WSABASEERR+111); - WSAEREFUSED = (WSABASEERR+112); - -{ Error return codes from gethostbyname() and gethostbyaddr() - (when using the resolver). Note that these errors are - retrieved via WSAGetLastError() and must therefore follow - the rules for avoiding clashes with error numbers from - specific implementations or language run-time systems. - For this reason the codes are based at WSABASEERR+1001. - Note also that [WSA]NO_ADDRESS is defined only for - compatibility purposes. } - -{ Authoritative Answer: Host not found } - WSAHOST_NOT_FOUND = (WSABASEERR+1001); - HOST_NOT_FOUND = WSAHOST_NOT_FOUND; -{ Non-Authoritative: Host not found, or SERVERFAIL } - WSATRY_AGAIN = (WSABASEERR+1002); - TRY_AGAIN = WSATRY_AGAIN; -{ Non recoverable errors, FORMERR, REFUSED, NOTIMP } - WSANO_RECOVERY = (WSABASEERR+1003); - NO_RECOVERY = WSANO_RECOVERY; -{ Valid name, no data record of requested type } - WSANO_DATA = (WSABASEERR+1004); - NO_DATA = WSANO_DATA; -{ no address, look for MX record } - WSANO_ADDRESS = WSANO_DATA; - NO_ADDRESS = WSANO_ADDRESS; - - EWOULDBLOCK = WSAEWOULDBLOCK; - EINPROGRESS = WSAEINPROGRESS; - EALREADY = WSAEALREADY; - ENOTSOCK = WSAENOTSOCK; - EDESTADDRREQ = WSAEDESTADDRREQ; - EMSGSIZE = WSAEMSGSIZE; - EPROTOTYPE = WSAEPROTOTYPE; - ENOPROTOOPT = WSAENOPROTOOPT; - EPROTONOSUPPORT = WSAEPROTONOSUPPORT; - ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; - EOPNOTSUPP = WSAEOPNOTSUPP; - EPFNOSUPPORT = WSAEPFNOSUPPORT; - EAFNOSUPPORT = WSAEAFNOSUPPORT; - EADDRINUSE = WSAEADDRINUSE; - EADDRNOTAVAIL = WSAEADDRNOTAVAIL; - ENETDOWN = WSAENETDOWN; - ENETUNREACH = WSAENETUNREACH; - ENETRESET = WSAENETRESET; - ECONNABORTED = WSAECONNABORTED; - ECONNRESET = WSAECONNRESET; - ENOBUFS = WSAENOBUFS; - EISCONN = WSAEISCONN; - ENOTCONN = WSAENOTCONN; - ESHUTDOWN = WSAESHUTDOWN; - ETOOMANYREFS = WSAETOOMANYREFS; - ETIMEDOUT = WSAETIMEDOUT; - ECONNREFUSED = WSAECONNREFUSED; - ELOOP = WSAELOOP; - ENAMETOOLONG = WSAENAMETOOLONG; - EHOSTDOWN = WSAEHOSTDOWN; - EHOSTUNREACH = WSAEHOSTUNREACH; - ENOTEMPTY = WSAENOTEMPTY; - EPROCLIM = WSAEPROCLIM; - EUSERS = WSAEUSERS; - EDQUOT = WSAEDQUOT; - ESTALE = WSAESTALE; - EREMOTE = WSAEREMOTE; - - EAI_ADDRFAMILY = 1; // Address family for nodename not supported. - EAI_AGAIN = 2; // Temporary failure in name resolution. - EAI_BADFLAGS = 3; // Invalid value for ai_flags. - EAI_FAIL = 4; // Non-recoverable failure in name resolution. - EAI_FAMILY = 5; // Address family ai_family not supported. - EAI_MEMORY = 6; // Memory allocation failure. - EAI_NODATA = 7; // No address associated with nodename. - EAI_NONAME = 8; // Nodename nor servname provided, or not known. - EAI_SERVICE = 9; // Servname not supported for ai_socktype. - EAI_SOCKTYPE = 10; // Socket type ai_socktype not supported. - EAI_SYSTEM = 11; // System error returned in errno. - -const - WSADESCRIPTION_LEN = 256; - WSASYS_STATUS_LEN = 128; -type - PWSAData = ^TWSAData; - TWSAData = record - wVersion: Word; - wHighVersion: Word; -{$ifdef win64} - iMaxSockets : Word; - iMaxUdpDg : Word; - lpVendorInfo : PAnsiChar; - szDescription : array[0..WSADESCRIPTION_LEN] of AnsiChar; - szSystemStatus : array[0..WSASYS_STATUS_LEN] of AnsiChar; -{$else} - szDescription: array[0..WSADESCRIPTION_LEN] of AnsiChar; - szSystemStatus: array[0..WSASYS_STATUS_LEN] of AnsiChar; - iMaxSockets: Word; - iMaxUdpDg: Word; - lpVendorInfo: PAnsiChar; -{$endif} - end; - - function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; - function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; - function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; - function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean; - procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); - procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -var - in6addr_any, in6addr_loopback : TInAddr6; - -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -procedure FD_ZERO(var FDSet: TFDSet); - -{=============================================================================} - -type - TWSAStartup = function(wVersionRequired: Word; var WSData: TWSAData): Integer; - stdcall; - TWSACleanup = function: Integer; - stdcall; - TWSAGetLastError = function: Integer; - stdcall; - TGetServByName = function(name, proto: PAnsiChar): PServEnt; - stdcall; - TGetServByPort = function(port: Integer; proto: PAnsiChar): PServEnt; - stdcall; - TGetProtoByName = function(name: PAnsiChar): PProtoEnt; - stdcall; - TGetProtoByNumber = function(proto: Integer): PProtoEnt; - stdcall; - TGetHostByName = function(name: PAnsiChar): PHostEnt; - stdcall; - TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; - stdcall; - TGetHostName = function(name: PAnsiChar; len: Integer): Integer; - stdcall; - TShutdown = function(s: TSocket; how: Integer): Integer; - stdcall; - TSetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar; - optlen: Integer): Integer; - stdcall; - TGetSockOpt = function(s: TSocket; level, optname: Integer; optval: PAnsiChar; - var optlen: Integer): Integer; - stdcall; - TSendTo = function(s: TSocket; const Buf; len, flags: Integer; addrto: PSockAddr; - tolen: Integer): Integer; - stdcall; - TSend = function(s: TSocket; const Buf; len, flags: Integer): Integer; - stdcall; - TRecv = function(s: TSocket; var Buf; len, flags: Integer): Integer; - stdcall; - TRecvFrom = function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; - var fromlen: Integer): Integer; - stdcall; - Tntohs = function(netshort: u_short): u_short; - stdcall; - Tntohl = function(netlong: u_long): u_long; - stdcall; - TListen = function(s: TSocket; backlog: Integer): Integer; - stdcall; - TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer; - stdcall; - TInet_ntoa = function(inaddr: TInAddr): PAnsiChar; - stdcall; - TInet_addr = function(cp: PAnsiChar): u_long; - stdcall; - Thtons = function(hostshort: u_short): u_short; - stdcall; - Thtonl = function(hostlong: u_long): u_long; - stdcall; - TGetSockName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - stdcall; - TGetPeerName = function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer; - stdcall; - TConnect = function(s: TSocket; name: PSockAddr; namelen: Integer): Integer; - stdcall; - TCloseSocket = function(s: TSocket): Integer; - stdcall; - TBind = function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer; - stdcall; - TAccept = function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket; - stdcall; - TTSocket = function(af, Struc, Protocol: Integer): TSocket; - stdcall; - TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; - stdcall; - - TGetAddrInfo = function(NodeName: PAnsiChar; ServName: PAnsiChar; Hints: PAddrInfo; - var Addrinfo: PAddrInfo): integer; - stdcall; - TFreeAddrInfo = procedure(ai: PAddrInfo); - stdcall; - TGetNameInfo = function( addr: PSockAddr; namelen: Integer; host: PAnsiChar; - hostlen: DWORD; serv: PAnsiChar; servlen: DWORD; flags: integer): integer; - stdcall; - - T__WSAFDIsSet = function (s: TSocket; var FDSet: TFDSet): Bool; - stdcall; - - TWSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; - cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; - lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; - lpCompletionRoutine: pointer): u_int; - stdcall; - -var - WSAStartup: TWSAStartup = nil; - WSACleanup: TWSACleanup = nil; - WSAGetLastError: TWSAGetLastError = nil; - GetServByName: TGetServByName = nil; - GetServByPort: TGetServByPort = nil; - GetProtoByName: TGetProtoByName = nil; - GetProtoByNumber: TGetProtoByNumber = nil; - GetHostByName: TGetHostByName = nil; - GetHostByAddr: TGetHostByAddr = nil; - ssGetHostName: TGetHostName = nil; - Shutdown: TShutdown = nil; - SetSockOpt: TSetSockOpt = nil; - GetSockOpt: TGetSockOpt = nil; - ssSendTo: TSendTo = nil; - ssSend: TSend = nil; - ssRecv: TRecv = nil; - ssRecvFrom: TRecvFrom = nil; - ntohs: Tntohs = nil; - ntohl: Tntohl = nil; - Listen: TListen = nil; - IoctlSocket: TIoctlSocket = nil; - Inet_ntoa: TInet_ntoa = nil; - Inet_addr: TInet_addr = nil; - htons: Thtons = nil; - htonl: Thtonl = nil; - ssGetSockName: TGetSockName = nil; - ssGetPeerName: TGetPeerName = nil; - ssConnect: TConnect = nil; - CloseSocket: TCloseSocket = nil; - ssBind: TBind = nil; - ssAccept: TAccept = nil; - Socket: TTSocket = nil; - Select: TSelect = nil; - - GetAddrInfo: TGetAddrInfo = nil; - FreeAddrInfo: TFreeAddrInfo = nil; - GetNameInfo: TGetNameInfo = nil; - - __WSAFDIsSet: T__WSAFDIsSet = nil; - - WSAIoctl: TWSAIoctl = nil; - -var - SynSockCS: SyncObjs.TCriticalSection; - SockEnhancedApi: Boolean; - SockWship6Api: Boolean; - -type - TVarSin = packed record - case integer of - 0: (AddressFamily: u_short); - 1: ( - case sin_family: u_short of - AF_INET: (sin_port: u_short; - sin_addr: TInAddr; - sin_zero: array[0..7] of byte); - AF_INET6: (sin6_port: u_short; - sin6_flowinfo: u_long; - sin6_addr: TInAddr6; - sin6_scope_id: u_long); - ); - end; - -function SizeOfVarSin(sin: TVarSin): integer; - -function Bind(s: TSocket; const addr: TVarSin): Integer; -function Connect(s: TSocket; const name: TVarSin): Integer; -function GetSockName(s: TSocket; var name: TVarSin): Integer; -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -function GetHostName: AnsiString; -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -function Accept(s: TSocket; var addr: TVarSin): TSocket; - -function IsNewApi(Family: integer): Boolean; -function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -function GetSinIP(Sin: TVarSin): AnsiString; -function GetSinPort(Sin: TVarSin): Integer; -procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings); -function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString; -function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word; - -{==============================================================================} -implementation - -var - SynSockCount: Integer = 0; - LibHandle: THandle = 0; - Libwship6Handle: THandle = 0; - -function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0)); -end; - -function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and - (a^.u6_addr32[2] = 0) and - (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and - (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1)); -end; - -function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80)); -end; - -function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; -begin - Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0)); -end; - -function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; -begin - Result := (a^.u6_addr8[0] = $FF); -end; - -function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean; -begin - Result := (CompareMem( a, b, sizeof(TInAddr6))); -end; - -procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); -end; - -procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6); -begin - FillChar(a^, sizeof(TInAddr6), 0); - a^.u6_addr8[15] := 1; -end; - -{=============================================================================} -procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); -var - I: Integer; -begin - I := 0; - while I < FDSet.fd_count do - begin - if FDSet.fd_array[I] = Socket then - begin - while I < FDSet.fd_count - 1 do - begin - FDSet.fd_array[I] := FDSet.fd_array[I + 1]; - Inc(I); - end; - Dec(FDSet.fd_count); - Break; - end; - Inc(I); - end; -end; - -function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; -begin - Result := __WSAFDIsSet(Socket, FDSet); -end; - -procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); -begin - if FDSet.fd_count < FD_SETSIZE then - begin - FDSet.fd_array[FDSet.fd_count] := Socket; - Inc(FDSet.fd_count); - end; -end; - -procedure FD_ZERO(var FDSet: TFDSet); -begin - FDSet.fd_count := 0; -end; - -{=============================================================================} - -function SizeOfVarSin(sin: TVarSin): integer; -begin - case sin.sin_family of - AF_INET: - Result := SizeOf(TSockAddrIn); - AF_INET6: - Result := SizeOf(TSockAddrIn6); - else - Result := 0; - end; -end; - -{=============================================================================} - -function Bind(s: TSocket; const addr: TVarSin): Integer; -begin - Result := ssBind(s, @addr, SizeOfVarSin(addr)); -end; - -function Connect(s: TSocket; const name: TVarSin): Integer; -begin - Result := ssConnect(s, @name, SizeOfVarSin(name)); -end; - -function GetSockName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetSockName(s, @name, Len); -end; - -function GetPeerName(s: TSocket; var name: TVarSin): Integer; -var - len: integer; -begin - len := SizeOf(name); - FillChar(name, len, 0); - Result := ssGetPeerName(s, @name, Len); -end; - -function GetHostName: AnsiString; -var - s: AnsiString; -begin - Result := ''; - setlength(s, 255); - ssGetHostName(pAnsichar(s), Length(s) - 1); - Result := PAnsichar(s); -end; - -function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := ssSend(s, Buf^, len, flags); -end; - -function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer; -begin - Result := ssRecv(s, Buf^, len, flags); -end; - -function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer; -begin - Result := ssSendTo(s, Buf^, len, flags, @addrto, SizeOfVarSin(addrto)); -end; - -function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer; -var - x: integer; -begin - x := SizeOf(from); - Result := ssRecvFrom(s, Buf^, len, flags, @from, x); -end; - -function Accept(s: TSocket; var addr: TVarSin): TSocket; -var - x: integer; -begin - x := SizeOf(addr); - Result := ssAccept(s, @addr, x); -end; - -{=============================================================================} -function IsNewApi(Family: integer): Boolean; -begin - Result := SockEnhancedApi; - if not Result then - Result := (Family = AF_INET6) and SockWship6Api; -end; - -function SetVarSin(var Sin: TVarSin; IP, Port: AnsiString; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer; -type - pu_long = ^u_long; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - HostEnt: PHostEnt; - r: integer; - Hints1, Hints2: TAddrInfo; - Sin1, Sin2: TVarSin; - TwoPass: boolean; - - function GetAddr(const IP, port: AnsiString; Hints: TAddrInfo; var Sin: TVarSin): integer; - var - Addr: PAddrInfo; - begin - Addr := nil; - try - FillChar(Sin, Sizeof(Sin), 0); - if Hints.ai_socktype = SOCK_RAW then - begin - Hints.ai_socktype := 0; - Hints.ai_protocol := 0; - Result := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr); - end - else - begin - if (IP = cAnyHost) or (IP = c6AnyHost) then - begin - Hints.ai_flags := AI_PASSIVE; - Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - end - else - if (IP = cLocalhost) or (IP = c6Localhost) then - begin - Result := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - end - else - begin - Result := synsock.GetAddrInfo(PAnsiChar(IP), PAnsiChar(Port), @Hints, Addr); - end; - end; - if Result = 0 then - if (Addr <> nil) then - Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen); - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - -begin - Result := 0; - FillChar(Sin, Sizeof(Sin), 0); - if not IsNewApi(family) then - begin - SynSockCS.Enter; - try - Sin.sin_family := AF_INET; - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if (ProtoEnt <> nil) and (StrToIntDef(string(Port),-1) =-1) then - ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Sin.sin_port := synsock.htons(StrToIntDef(string(Port), 0)) - else - Sin.sin_port := ServEnt^.s_port; - if IP = cBroadcast then - Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST) - else - begin - Sin.sin_addr.s_addr := synsock.inet_addr(PAnsiChar(IP)); - if Sin.sin_addr.s_addr = u_long(INADDR_NONE) then - begin - HostEnt := synsock.GetHostByName(PAnsiChar(IP)); - Result := synsock.WSAGetLastError; - if HostEnt <> nil then - Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - begin - FillChar(Hints1, Sizeof(Hints1), 0); - FillChar(Hints2, Sizeof(Hints2), 0); - TwoPass := False; - if Family = AF_UNSPEC then - begin - if PreferIP4 then - begin - Hints1.ai_family := AF_INET; - Hints2.ai_family := AF_INET6; - TwoPass := True; - end - else - begin - Hints2.ai_family := AF_INET; - Hints1.ai_family := AF_INET6; - TwoPass := True; - end; - end - else - Hints1.ai_family := Family; - - Hints1.ai_socktype := SockType; - Hints1.ai_protocol := SockProtocol; - Hints2.ai_socktype := Hints1.ai_socktype; - Hints2.ai_protocol := Hints1.ai_protocol; - - r := GetAddr(IP, Port, Hints1, Sin1); - Result := r; - sin := sin1; - if r <> 0 then - if TwoPass then - begin - r := GetAddr(IP, Port, Hints2, Sin2); - Result := r; - if r = 0 then - sin := sin2; - end; - end; -end; - -function GetSinIP(Sin: TVarSin): AnsiString; -var - p: PAnsiChar; - host, serv: AnsiString; - hostlen, servlen: integer; - r: integer; -begin - Result := ''; - if not IsNewApi(Sin.AddressFamily) then - begin - p := synsock.inet_ntoa(Sin.sin_addr); - if p <> nil then - Result := p; - end - else - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(@sin, SizeOfVarSin(sin), PAnsiChar(host), hostlen, - PAnsiChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - Result := PAnsiChar(host); - end; -end; - -function GetSinPort(Sin: TVarSin): Integer; -begin - if (Sin.sin_family = AF_INET6) then - Result := synsock.ntohs(Sin.sin6_port) - else - Result := synsock.ntohs(Sin.sin_port); -end; - -procedure ResolveNameToIP(Name: AnsiString; Family, SockProtocol, SockType: integer; const IPList: TStrings); -type - TaPInAddr = array[0..250] of PInAddr; - PaPInAddr = ^TaPInAddr; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - AddrNext: PAddrInfo; - r: integer; - host, serv: AnsiString; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IP: u_long; - PAdrPtr: PaPInAddr; - i: Integer; - s: String; - InAddr: TInAddr; -begin - IPList.Clear; - if not IsNewApi(Family) then - begin - IP := synsock.inet_addr(PAnsiChar(Name)); - if IP = u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := synsock.GetHostByName(PAnsiChar(Name)); - if RemoteHost <> nil then - begin - PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); - i := 0; - while PAdrPtr^[i] <> nil do - begin - InAddr := PAdrPtr^[i]^; - s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1], - InAddr.S_bytes[2], InAddr.S_bytes[3]]); - IPList.Add(s); - Inc(i); - end; - end; - finally - SynSockCS.Leave; - end; - end - else - IPList.Add(string(Name)); - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PAnsiChar(Name), nil, @Hints, Addr); - if r = 0 then - begin - AddrNext := Addr; - while not(AddrNext = nil) do - begin - if not(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET)) - or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(AddrNext^.ai_addr, AddrNext^.ai_addrlen, - PAnsiChar(host), hostlen, PAnsiChar(serv), servlen, - NI_NUMERICHOST + NI_NUMERICSERV); - if r = 0 then - begin - host := PAnsiChar(host); - IPList.Add(string(host)); - end; - end; - AddrNext := AddrNext^.ai_next; - end; - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; - if IPList.Count = 0 then - IPList.Add(cAnyHost); -end; - -function ResolvePort(Port: AnsiString; Family, SockProtocol, SockType: integer): Word; -var - ProtoEnt: PProtoEnt; - ServEnt: PServEnt; - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; -begin - Result := 0; - if not IsNewApi(Family) then - begin - SynSockCS.Enter; - try - ProtoEnt := synsock.GetProtoByNumber(SockProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PAnsiChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Result := StrToIntDef(string(Port), 0) - else - Result := synsock.htons(ServEnt^.s_port); - finally - SynSockCS.Leave; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := Sockprotocol; - Hints.ai_flags := AI_PASSIVE; - r := synsock.GetAddrInfo(nil, PAnsiChar(Port), @Hints, Addr); - if (r = 0) and Assigned(Addr) then - begin - if Addr^.ai_family = AF_INET then - Result := synsock.htons(Addr^.ai_addr^.sin_port); - if Addr^.ai_family = AF_INET6 then - Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -function ResolveIPToName(IP: AnsiString; Family, SockProtocol, SockType: integer): AnsiString; -var - Hints: TAddrInfo; - Addr: PAddrInfo; - r: integer; - host, serv: AnsiString; - hostlen, servlen: integer; - RemoteHost: PHostEnt; - IPn: u_long; -begin - Result := IP; - if not IsNewApi(Family) then - begin - IPn := synsock.inet_addr(PAnsiChar(IP)); - if IPn <> u_long(INADDR_NONE) then - begin - SynSockCS.Enter; - try - RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET); - if RemoteHost <> nil then - Result := RemoteHost^.h_name; - finally - SynSockCS.Leave; - end; - end; - end - else - begin - Addr := nil; - try - FillChar(Hints, Sizeof(Hints), 0); - Hints.ai_family := AF_UNSPEC; - Hints.ai_socktype := SockType; - Hints.ai_protocol := SockProtocol; - Hints.ai_flags := 0; - r := synsock.GetAddrInfo(PAnsiChar(IP), nil, @Hints, Addr); - if (r = 0) and Assigned(Addr)then - begin - hostlen := NI_MAXHOST; - servlen := NI_MAXSERV; - setlength(host, hostlen); - setlength(serv, servlen); - r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen, - PAnsiChar(host), hostlen, PAnsiChar(serv), servlen, - NI_NUMERICSERV); - if r = 0 then - Result := PAnsiChar(host); - end; - finally - if Assigned(Addr) then - synsock.FreeAddrInfo(Addr); - end; - end; -end; - -{=============================================================================} - -function InitSocketInterface(stack: String): Boolean; -begin - Result := False; - if stack = '' then - stack := DLLStackName; - SynSockCS.Enter; - try - if SynSockCount = 0 then - begin - SockEnhancedApi := False; - SockWship6Api := False; - LibHandle := LoadLibrary(PChar(Stack)); - if LibHandle <> 0 then - begin - WSAIoctl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAIoctl'))); - __WSAFDIsSet := GetProcAddress(LibHandle, PAnsiChar(AnsiString('__WSAFDIsSet'))); - CloseSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('closesocket'))); - IoctlSocket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ioctlsocket'))); - WSAGetLastError := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAGetLastError'))); - WSAStartup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSAStartup'))); - WSACleanup := GetProcAddress(LibHandle, PAnsiChar(AnsiString('WSACleanup'))); - ssAccept := GetProcAddress(LibHandle, PAnsiChar(AnsiString('accept'))); - ssBind := GetProcAddress(LibHandle, PAnsiChar(AnsiString('bind'))); - ssConnect := GetProcAddress(LibHandle, PAnsiChar(AnsiString('connect'))); - ssGetPeerName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getpeername'))); - ssGetSockName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockname'))); - GetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getsockopt'))); - Htonl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htonl'))); - Htons := GetProcAddress(LibHandle, PAnsiChar(AnsiString('htons'))); - Inet_Addr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_addr'))); - Inet_Ntoa := GetProcAddress(LibHandle, PAnsiChar(AnsiString('inet_ntoa'))); - Listen := GetProcAddress(LibHandle, PAnsiChar(AnsiString('listen'))); - Ntohl := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohl'))); - Ntohs := GetProcAddress(LibHandle, PAnsiChar(AnsiString('ntohs'))); - ssRecv := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recv'))); - ssRecvFrom := GetProcAddress(LibHandle, PAnsiChar(AnsiString('recvfrom'))); - Select := GetProcAddress(LibHandle, PAnsiChar(AnsiString('select'))); - ssSend := GetProcAddress(LibHandle, PAnsiChar(AnsiString('send'))); - ssSendTo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('sendto'))); - SetSockOpt := GetProcAddress(LibHandle, PAnsiChar(AnsiString('setsockopt'))); - ShutDown := GetProcAddress(LibHandle, PAnsiChar(AnsiString('shutdown'))); - Socket := GetProcAddress(LibHandle, PAnsiChar(AnsiString('socket'))); - GetHostByAddr := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyaddr'))); - GetHostByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostbyname'))); - GetProtoByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobyname'))); - GetProtoByNumber := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getprotobynumber'))); - GetServByName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyname'))); - GetServByPort := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getservbyport'))); - ssGetHostName := GetProcAddress(LibHandle, PAnsiChar(AnsiString('gethostname'))); - -{$IFNDEF FORCEOLDAPI} - GetAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getaddrinfo'))); - FreeAddrInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('freeaddrinfo'))); - GetNameInfo := GetProcAddress(LibHandle, PAnsiChar(AnsiString('getnameinfo'))); - SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) - and Assigned(GetNameInfo); - if not SockEnhancedApi then - begin - LibWship6Handle := LoadLibrary(PChar(DLLWship6)); - if LibWship6Handle <> 0 then - begin - GetAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getaddrinfo'))); - FreeAddrInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('freeaddrinfo'))); - GetNameInfo := GetProcAddress(LibWship6Handle, PAnsiChar(AnsiString('getnameinfo'))); - SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) - and Assigned(GetNameInfo); - end; - end; -{$ENDIF} - Result := True; - end; - end - else Result := True; - if Result then - Inc(SynSockCount); - finally - SynSockCS.Leave; - end; -end; - -function DestroySocketInterface: Boolean; -begin - SynSockCS.Enter; - try - Dec(SynSockCount); - if SynSockCount < 0 then - SynSockCount := 0; - if SynSockCount = 0 then - begin - if LibHandle <> 0 then - begin - FreeLibrary(libHandle); - LibHandle := 0; - end; - if LibWship6Handle <> 0 then - begin - FreeLibrary(LibWship6Handle); - LibWship6Handle := 0; - end; - end; - finally - SynSockCS.Leave; - end; - Result := True; -end; - -initialization -begin - SynSockCS := SyncObjs.TCriticalSection.Create; - SET_IN6_IF_ADDR_ANY (@in6addr_any); - SET_LOOPBACK_ADDR6 (@in6addr_loopback); -end; - -finalization -begin - SynSockCS.Free; -end; \ No newline at end of file diff --git a/3rd/synapse/source/synachar.pas b/3rd/synapse/source/synachar.pas deleted file mode 100644 index 5d39b2960..000000000 --- a/3rd/synapse/source/synachar.pas +++ /dev/null @@ -1,2038 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 005.002.003 | -|==============================================================================| -| Content: Charset conversion support | -|==============================================================================| -| Copyright (c)1999-2012, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{: @abstract(Charset conversion support) -This unit contains a routines for lot of charset conversions. - -It using built-in conversion tables or external Iconv library. Iconv is used - when needed conversion is known by Iconv library. When Iconv library is not - found or Iconv not know requested conversion, then are internal routines used - for conversion. (You can disable Iconv support from your program too!) - -Internal routines knows all major charsets for Europe or America. For East-Asian - charsets you must use Iconv library! -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit synachar; - -interface - -uses -{$IFNDEF MSWINDOWS} - {$IFNDEF FPC} - Libc, - {$ENDIF} -{$ELSE} - Windows, -{$ENDIF} - SysUtils, - synautil, synacode, synaicnv; - -type - {:Type with all supported charsets.} - TMimeChar = (ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5, - ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10, ISO_8859_13, - ISO_8859_14, ISO_8859_15, CP1250, CP1251, CP1252, CP1253, CP1254, CP1255, - CP1256, CP1257, CP1258, KOI8_R, CP895, CP852, UCS_2, UCS_4, UTF_8, UTF_7, - UTF_7mod, UCS_2LE, UCS_4LE, - //next is supported by Iconv only... - UTF_16, UTF_16LE, UTF_32, UTF_32LE, C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, - CP862, CP866, MAC, MACCE, MACICE, MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, - MACHEB, MACAR, MACTH, ROMAN8, NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, - KOI8_T, MULELAO, CP1133, TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, - JIS_X0208, JIS_X0212, GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, - SHIFT_JIS, CP932, ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, - GB18030, ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, - EUC_KR, CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, - CP858, CP860, CP861, CP863, CP864, CP865, CP869, CP1125); - - {:Set of any charsets.} - TMimeSetChar = set of TMimeChar; - -const - {:Set of charsets supported by Iconv library only.} - IconvOnlyChars: set of TMimeChar = [UTF_16, UTF_16LE, UTF_32, UTF_32LE, - C99, JAVA, ISO_8859_16, KOI8_U, KOI8_RU, CP862, CP866, MAC, MACCE, MACICE, - MACCRO, MACRO, MACCYR, MACUK, MACGR, MACTU, MACHEB, MACAR, MACTH, ROMAN8, - NEXTSTEP, ARMASCII, GEORGIAN_AC, GEORGIAN_PS, KOI8_T, MULELAO, CP1133, - TIS620, CP874, VISCII, TCVN, ISO_IR_14, JIS_X0201, JIS_X0208, JIS_X0212, - GB1988_80, GB2312_80, ISO_IR_165, ISO_IR_149, EUC_JP, SHIFT_JIS, CP932, - ISO_2022_JP, ISO_2022_JP1, ISO_2022_JP2, GB2312, CP936, GB18030, - ISO_2022_CN, ISO_2022_CNE, HZ, EUC_TW, BIG5, CP950, BIG5_HKSCS, EUC_KR, - CP949, CP1361, ISO_2022_KR, CP737, CP775, CP853, CP855, CP857, CP858, - CP860, CP861, CP863, CP864, CP865, CP869, CP1125]; - - {:Set of charsets supported by internal routines only.} - NoIconvChars: set of TMimeChar = [CP895, UTF_7mod]; - - {:null character replace table. (Usable for disable charater replacing.)} - Replace_None: array[0..0] of Word = - (0); - - {:Character replace table for remove Czech diakritics.} - Replace_Czech: array[0..59] of Word = - ( - $00E1, $0061, - $010D, $0063, - $010F, $0064, - $010E, $0044, - $00E9, $0065, - $011B, $0065, - $00ED, $0069, - $0148, $006E, - $00F3, $006F, - $0159, $0072, - $0161, $0073, - $0165, $0074, - $00FA, $0075, - $016F, $0075, - $00FD, $0079, - $017E, $007A, - $00C1, $0041, - $010C, $0043, - $00C9, $0045, - $011A, $0045, - $00CD, $0049, - $0147, $004E, - $00D3, $004F, - $0158, $0052, - $0160, $0053, - $0164, $0054, - $00DA, $0055, - $016E, $0055, - $00DD, $0059, - $017D, $005A - ); - -var - {:By this you can generally disable/enable Iconv support.} - DisableIconv: Boolean = False; - - {:Default set of charsets for @link(IdealCharsetCoding) function.} - IdealCharsets: TMimeSetChar = - [ISO_8859_1, ISO_8859_2, ISO_8859_3, ISO_8859_4, ISO_8859_5, - ISO_8859_6, ISO_8859_7, ISO_8859_8, ISO_8859_9, ISO_8859_10, - KOI8_R, KOI8_U - {$IFNDEF CIL} //error URW778 ??? :-O - , GB2312, EUC_KR, ISO_2022_JP, EUC_TW - {$ENDIF} - ]; - -{==============================================================================} -{:Convert Value from one charset to another. See: @link(CharsetConversionEx)} -function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar): AnsiString; - -{:Convert Value from one charset to another with additional character conversion. -see: @link(Replace_None) and @link(Replace_Czech)} -function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar; const TransformTable: array of Word): AnsiString; - -{:Convert Value from one charset to another with additional character conversion. - This funtion is similar to @link(CharsetConversionEx), but you can disable - transliteration of unconvertible characters.} -function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString; - -{:Returns charset used by operating system.} -function GetCurCP: TMimeChar; - -{:Returns charset used by operating system as OEM charset. (in Windows DOS box, - for example)} -function GetCurOEMCP: TMimeChar; - -{:Converting string with charset name to TMimeChar.} -function GetCPFromID(Value: AnsiString): TMimeChar; - -{:Converting TMimeChar to string with name of charset.} -function GetIDFromCP(Value: TMimeChar): AnsiString; - -{:return @true when value need to be converted. (It is not 7-bit ASCII)} -function NeedCharsetConversion(const Value: AnsiString): Boolean; - -{:Finding best target charset from set of TMimeChars with minimal count of - unconvertible characters.} -function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeSetChar): TMimeChar; - -{:Return BOM (Byte Order Mark) for given unicode charset.} -function GetBOM(Value: TMimeChar): AnsiString; - -{:Convert binary string with unicode content to WideString.} -function StringToWide(const Value: AnsiString): WideString; - -{:Convert WideString to binary string with unicode content.} -function WideToString(const Value: WideString): AnsiString; - -function GetIconvIDFromCP(Value: TMimeChar): AnsiString; -function GetCPFromIconvID(Value: AnsiString): TMimeChar; - -{==============================================================================} -implementation - -//character transcoding tables X to UCS-2 -{ -//dummy table -$0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, -$0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, -$0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, -$0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, -$00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, -$00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, -$00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, -$00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF, -$00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, -$00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, -$00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, -$00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, -$00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, -$00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, -$00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, -$00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF -} - -const - -{Latin-1 - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish and Swedish. -} - CharISO_8859_1: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF, - $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF - ); - -{Latin-2 - Albanian, Czech, English, German, Hungarian, Polish, Rumanian, - Serbo-Croatian, Slovak, Slovene and Swedish. -} - CharISO_8859_2: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7, - $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B, - $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7, - $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C, - $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7, - $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E, - $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7, - $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF, - $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7, - $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F, - $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7, - $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9 - ); - -{Latin-3 - Afrikaans, Catalan, English, Esperanto, French, Galician, - German, Italian, Maltese and Turkish. -} - CharISO_8859_3: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0126, $02D8, $00A3, $00A4, $FFFD, $0124, $00A7, - $00A8, $0130, $015E, $011E, $0134, $00AD, $FFFD, $017B, - $00B0, $0127, $00B2, $00B3, $00B4, $00B5, $0125, $00B7, - $00B8, $0131, $015F, $011F, $0135, $00BD, $FFFD, $017C, - $00C0, $00C1, $00C2, $FFFD, $00C4, $010A, $0108, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $FFFD, $00D1, $00D2, $00D3, $00D4, $0120, $00D6, $00D7, - $011C, $00D9, $00DA, $00DB, $00DC, $016C, $015C, $00DF, - $00E0, $00E1, $00E2, $FFFD, $00E4, $010B, $0109, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $FFFD, $00F1, $00F2, $00F3, $00F4, $0121, $00F6, $00F7, - $011D, $00F9, $00FA, $00FB, $00FC, $016D, $015D, $02D9 - ); - -{Latin-4 - Danish, English, Estonian, Finnish, German, Greenlandic, - Lappish, Latvian, Lithuanian, Norwegian and Swedish. -} - CharISO_8859_4: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0104, $0138, $0156, $00A4, $0128, $013B, $00A7, - $00A8, $0160, $0112, $0122, $0166, $00AD, $017D, $00AF, - $00B0, $0105, $02DB, $0157, $00B4, $0129, $013C, $02C7, - $00B8, $0161, $0113, $0123, $0167, $014A, $017E, $014B, - $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E, - $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $012A, - $0110, $0145, $014C, $0136, $00D4, $00D5, $00D6, $00D7, - $00D8, $0172, $00DA, $00DB, $00DC, $0168, $016A, $00DF, - $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F, - $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $012B, - $0111, $0146, $014D, $0137, $00F4, $00F5, $00F6, $00F7, - $00F8, $0173, $00FA, $00FB, $00FC, $0169, $016B, $02D9 - ); - -{CYRILLIC - Bulgarian, Bielorussian, English, Macedonian, Russian, - Serbo-Croatian and Ukrainian. -} - CharISO_8859_5: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0401, $0402, $0403, $0404, $0405, $0406, $0407, - $0408, $0409, $040A, $040B, $040C, $00AD, $040E, $040F, - $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, - $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F, - $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427, - $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F, - $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437, - $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F, - $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447, - $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F, - $2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457, - $0458, $0459, $045A, $045B, $045C, $00A7, $045E, $045F - ); - -{ARABIC -} - CharISO_8859_6: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $FFFD, $FFFD, $FFFD, $00A4, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $060C, $00AD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $061B, $FFFD, $FFFD, $FFFD, $061F, - $FFFD, $0621, $0622, $0623, $0624, $0625, $0626, $0627, - $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F, - $0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637, - $0638, $0639, $063A, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647, - $0648, $0649, $064A, $064B, $064C, $064D, $064E, $064F, - $0650, $0651, $0652, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD - ); - -{GREEK -} - CharISO_8859_7: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $2018, $2019, $00A3, $FFFD, $FFFD, $00A6, $00A7, - $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $FFFD, $2015, - $00B0, $00B1, $00B2, $00B3, $0384, $0385, $0386, $00B7, - $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F, - $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397, - $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F, - $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7, - $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF, - $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, - $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF, - $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7, - $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD - ); - -{HEBREW -} - CharISO_8859_8: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $FFFD, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $2017, - $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7, - $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF, - $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7, - $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD - ); - -{Latin-5 - English, Finnish, French, German, Irish, Italian, Norwegian, - Portuguese, Spanish, Swedish and Turkish. -} - CharISO_8859_9: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7, - $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B, - $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7, - $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C, - $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7, - $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E, - $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF - ); - -{Latin-6 - Danish, English, Estonian, Faeroese, Finnish, German, Greenlandic, - Icelandic, Lappish, Latvian, Lithuanian, Norwegian and Swedish. -} - CharISO_8859_10: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $0104, $0112, $0122, $012A, $0128, $0136, $00A7, - $013B, $0110, $0160, $0166, $017D, $00AD, $016A, $014A, - $00B0, $0105, $0113, $0123, $012B, $0129, $0137, $00B7, - $013C, $0111, $0161, $0167, $017E, $2015, $016B, $014B, - $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E, - $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $00CF, - $00D0, $0145, $014C, $00D3, $00D4, $00D5, $00D6, $0168, - $00D8, $0172, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, - $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F, - $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $00EF, - $00F0, $0146, $014D, $00F3, $00F4, $00F5, $00F6, $0169, - $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138 - ); - - CharISO_8859_13: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7, - $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6, - $00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7, - $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6, - $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112, - $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B, - $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7, - $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF, - $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113, - $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C, - $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7, - $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019 - ); - - CharISO_8859_14: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7, - $1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178, - $1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56, - $1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61, - $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A, - $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B, - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF - ); - - CharISO_8859_15: array[128..255] of Word = - ( - $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, - $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F, - $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, - $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F, - $00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7, - $0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7, - $017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF, - $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF - ); - -{Eastern European -} - CharCP_1250: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021, - $FFFD, $2030, $0160, $2039, $015A, $0164, $017D, $0179, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $FFFD, $2122, $0161, $203A, $015B, $0165, $017E, $017A, - $00A0, $02C7, $02D8, $0141, $00A4, $0104, $00A6, $00A7, - $00A8, $00A9, $015E, $00AB, $00AC, $00AD, $00AE, $017B, - $00B0, $00B1, $02DB, $0142, $00B4, $00B5, $00B6, $00B7, - $00B8, $0105, $015F, $00BB, $013D, $02DD, $013E, $017C, - $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7, - $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E, - $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7, - $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF, - $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7, - $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F, - $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7, - $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9 - ); - -{Cyrillic -} - CharCP_1251: array[128..255] of Word = - ( - $0402, $0403, $201A, $0453, $201E, $2026, $2020, $2021, - $20AC, $2030, $0409, $2039, $040A, $040C, $040B, $040F, - $0452, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $FFFD, $2122, $0459, $203A, $045A, $045C, $045B, $045F, - $00A0, $040E, $045E, $0408, $00A4, $0490, $00A6, $00A7, - $0401, $00A9, $0404, $00AB, $00AC, $00AD, $00AE, $0407, - $00B0, $00B1, $0406, $0456, $0491, $00B5, $00B6, $00B7, - $0451, $2116, $0454, $00BB, $0458, $0405, $0455, $0457, - $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, - $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F, - $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427, - $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F, - $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437, - $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F, - $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447, - $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F - ); - -{Latin-1 (US, Western Europe) -} - CharCP_1252: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021, - $02C6, $2030, $0160, $2039, $0152, $FFFD, $017D, $FFFD, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $02DC, $2122, $0161, $203A, $0153, $FFFD, $017E, $0178, - $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF, - $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF - ); - -{Greek -} - CharCP_1253: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021, - $FFFD, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $FFFD, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD, - $00A0, $0385, $0386, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $FFFD, $00AB, $00AC, $00AD, $00AE, $2015, - $00B0, $00B1, $00B2, $00B3, $0384, $00B5, $00B6, $00B7, - $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F, - $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397, - $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F, - $03A0, $03A1, $FFFD, $03A3, $03A4, $03A5, $03A6, $03A7, - $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF, - $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, - $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF, - $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7, - $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $FFFD - ); - -{Turkish -} - CharCP_1254: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021, - $02C6, $2030, $0160, $2039, $0152, $FFFD, $FFFD, $FFFD, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $02DC, $2122, $0161, $203A, $0153, $FFFD, $FFFD, $0178, - $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF, - $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF, - $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF, - $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF - ); - -{Hebrew -} - CharCP_1255: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021, - $02C6, $2030, $FFFD, $2039, $FFFD, $FFFD, $FFFD, $FFFD, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $02DC, $2122, $FFFD, $203A, $FFFD, $FFFD, $FFFD, $FFFD, - $00A0, $00A1, $00A2, $00A3, $20AA, $00A5, $00A6, $00A7, - $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $00BF, - $05B0, $05B1, $05B2, $05B3, $05B4, $05B5, $05B6, $05B7, - $05B8, $05B9, $FFFD, $05BB, $05BC, $05BD, $05BE, $05BF, - $05C0, $05C1, $05C2, $05C3, $05F0, $05F1, $05F2, $05F3, - $05F4, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, $FFFD, - $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7, - $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF, - $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7, - $05E8, $05E9, $05EA, $FFFD, $FFFD, $200E, $200F, $FFFD - ); - -{Arabic -} - CharCP_1256: array[128..255] of Word = - ( - $20AC, $067E, $201A, $0192, $201E, $2026, $2020, $2021, - $02C6, $2030, $0679, $2039, $0152, $0686, $0698, $0688, - $06AF, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $06A9, $2122, $0691, $203A, $0153, $200C, $200D, $06BA, - $00A0, $060C, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $06BE, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $061B, $00BB, $00BC, $00BD, $00BE, $061F, - $06C1, $0621, $0622, $0623, $0624, $0625, $0626, $0627, - $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F, - $0630, $0631, $0632, $0633, $0634, $0635, $0636, $00D7, - $0637, $0638, $0639, $063A, $0640, $0641, $0642, $0643, - $00E0, $0644, $00E2, $0645, $0646, $0647, $0648, $00E7, - $00E8, $00E9, $00EA, $00EB, $0649, $064A, $00EE, $00EF, - $064B, $064C, $064D, $064E, $00F4, $064F, $0650, $00F7, - $0651, $00F9, $0652, $00FB, $00FC, $200E, $200F, $06D2 - ); - -{Baltic -} - CharCP_1257: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $FFFD, $201E, $2026, $2020, $2021, - $FFFD, $2030, $FFFD, $2039, $FFFD, $00A8, $02C7, $00B8, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $FFFD, $2122, $FFFD, $203A, $FFFD, $00AF, $02DB, $FFFD, - $00A0, $FFFD, $00A2, $00A3, $00A4, $FFFD, $00A6, $00A7, - $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6, - $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112, - $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B, - $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7, - $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF, - $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113, - $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C, - $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7, - $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $02D9 - ); - -{Vietnamese -} - CharCP_1258: array[128..255] of Word = - ( - $20AC, $FFFD, $201A, $0192, $201E, $2026, $2020, $2021, - $02C6, $2030, $FFFD, $2039, $0152, $FFFD, $FFFD, $FFFD, - $FFFD, $2018, $2019, $201C, $201D, $2022, $2013, $2014, - $02DC, $2122, $FFFD, $203A, $0153, $FFFD, $FFFD, $0178, - $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, - $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, - $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF, - $00C0, $00C1, $00C2, $0102, $00C4, $00C5, $00C6, $00C7, - $00C8, $00C9, $00CA, $00CB, $0300, $00CD, $00CE, $00CF, - $0110, $00D1, $0309, $00D3, $00D4, $01A0, $00D6, $00D7, - $00D8, $00D9, $00DA, $00DB, $00DC, $01AF, $0303, $00DF, - $00E0, $00E1, $00E2, $0103, $00E4, $00E5, $00E6, $00E7, - $00E8, $00E9, $00EA, $00EB, $0301, $00ED, $00EE, $00EF, - $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF - ); - -{Cyrillic -} - CharKOI8_R: array[128..255] of Word = - ( - $2500, $2502, $250C, $2510, $2514, $2518, $251C, $2524, - $252C, $2534, $253C, $2580, $2584, $2588, $258C, $2590, - $2591, $2592, $2593, $2320, $25A0, $2219, $221A, $2248, - $2264, $2265, $00A0, $2321, $00B0, $00B2, $00B7, $00F7, - $2550, $2551, $2552, $0451, $2553, $2554, $2555, $2556, - $2557, $2558, $2559, $255A, $255B, $255C, $255D, $255E, - $255F, $2560, $2561, $0401, $2562, $2563, $2564, $2565, - $2566, $2567, $2568, $2569, $256A, $256B, $256C, $00A9, - $044E, $0430, $0431, $0446, $0434, $0435, $0444, $0433, - $0445, $0438, $0439, $043A, $043B, $043C, $043D, $043E, - $043F, $044F, $0440, $0441, $0442, $0443, $0436, $0432, - $044C, $044B, $0437, $0448, $044D, $0449, $0447, $044A, - $042E, $0410, $0411, $0426, $0414, $0415, $0424, $0413, - $0425, $0418, $0419, $041A, $041B, $041C, $041D, $041E, - $041F, $042F, $0420, $0421, $0422, $0423, $0416, $0412, - $042C, $042B, $0417, $0428, $042D, $0429, $0427, $042A - ); - -{Czech (Kamenicky) -} - CharCP_895: array[128..255] of Word = - ( - $010C, $00FC, $00E9, $010F, $00E4, $010E, $0164, $010D, - $011B, $011A, $0139, $00CD, $013E, $013A, $00C4, $00C1, - $00C9, $017E, $017D, $00F4, $00F6, $00D3, $016F, $00DA, - $00FD, $00D6, $00DC, $0160, $013D, $00DD, $0158, $0165, - $00E1, $00ED, $00F3, $00FA, $0148, $0147, $016E, $00D4, - $0161, $0159, $0155, $0154, $00BC, $00A7, $00AB, $00BB, - $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, - $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510, - $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, - $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567, - $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, - $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580, - $03B1, $03B2, $0393, $03C0, $03A3, $03C3, $03BC, $03C4, - $03A6, $0398, $03A9, $03B4, $221E, $2205, $03B5, $2229, - $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, - $2218, $00B7, $2219, $221A, $207F, $00B2, $25A0, $00A0 - ); - -{Eastern European -} - CharCP_852: array[128..255] of Word = - ( - $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7, - $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106, - $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A, - $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D, - $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E, - $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB, - $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A, - $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510, - $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103, - $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4, - $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE, - $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580, - $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161, - $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4, - $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8, - $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0 - ); - -{==============================================================================} -type - TIconvChar = record - Charset: TMimeChar; - CharName: string; - end; - TIconvArr = array [0..112] of TIconvChar; - -const - NotFoundChar = '_'; - -var - SetTwo: set of TMimeChar = [UCS_2, UCS_2LE, UTF_7, UTF_7mod]; - SetFour: set of TMimeChar = [UCS_4, UCS_4LE, UTF_8]; - SetLE: set of TMimeChar = [UCS_2LE, UCS_4LE]; - - IconvArr: TIconvArr; - -{==============================================================================} -function FindIconvID(const Value, Charname: string): Boolean; -var - s: string; -begin - Result := True; - //exact match - if Value = Charname then - Exit; - //Value is on begin of charname - s := Value + ' '; - if s = Copy(Charname, 1, Length(s)) then - Exit; - //Value is on end of charname - s := ' ' + Value; - if s = Copy(Charname, Length(Charname) - Length(s) + 1, Length(s)) then - Exit; - //value is somewhere inside charname - if Pos( s + ' ', Charname) > 0 then - Exit; - Result := False; -end; - -function GetCPFromIconvID(Value: AnsiString): TMimeChar; -var - n: integer; -begin - Result := ISO_8859_1; - Value := UpperCase(Value); - for n := 0 to High(IconvArr) do - if FindIconvID(Value, IconvArr[n].Charname) then - begin - Result := IconvArr[n].Charset; - Break; - end; -end; - -{==============================================================================} -function GetIconvIDFromCP(Value: TMimeChar): AnsiString; -var - n: integer; -begin - Result := 'ISO-8859-1'; - for n := 0 to High(IconvArr) do - if IconvArr[n].Charset = Value then - begin - Result := Separateleft(IconvArr[n].Charname, ' '); - Break; - end; -end; - -{==============================================================================} -function ReplaceUnicode(Value: Word; const TransformTable: array of Word): Word; -var - n: integer; -begin - if High(TransformTable) <> 0 then - for n := 0 to High(TransformTable) do - if not odd(n) then - if TransformTable[n] = Value then - begin - Value := TransformTable[n+1]; - break; - end; - Result := Value; -end; - -{==============================================================================} -procedure CopyArray(const SourceTable: array of Word; - var TargetTable: array of Word); -var - n: Integer; -begin - for n := 0 to 127 do - TargetTable[n] := SourceTable[n]; -end; - -{==============================================================================} -procedure GetArray(CharSet: TMimeChar; var Result: array of Word); -begin - case CharSet of - ISO_8859_2: - CopyArray(CharISO_8859_2, Result); - ISO_8859_3: - CopyArray(CharISO_8859_3, Result); - ISO_8859_4: - CopyArray(CharISO_8859_4, Result); - ISO_8859_5: - CopyArray(CharISO_8859_5, Result); - ISO_8859_6: - CopyArray(CharISO_8859_6, Result); - ISO_8859_7: - CopyArray(CharISO_8859_7, Result); - ISO_8859_8: - CopyArray(CharISO_8859_8, Result); - ISO_8859_9: - CopyArray(CharISO_8859_9, Result); - ISO_8859_10: - CopyArray(CharISO_8859_10, Result); - ISO_8859_13: - CopyArray(CharISO_8859_13, Result); - ISO_8859_14: - CopyArray(CharISO_8859_14, Result); - ISO_8859_15: - CopyArray(CharISO_8859_15, Result); - CP1250: - CopyArray(CharCP_1250, Result); - CP1251: - CopyArray(CharCP_1251, Result); - CP1252: - CopyArray(CharCP_1252, Result); - CP1253: - CopyArray(CharCP_1253, Result); - CP1254: - CopyArray(CharCP_1254, Result); - CP1255: - CopyArray(CharCP_1255, Result); - CP1256: - CopyArray(CharCP_1256, Result); - CP1257: - CopyArray(CharCP_1257, Result); - CP1258: - CopyArray(CharCP_1258, Result); - KOI8_R: - CopyArray(CharKOI8_R, Result); - CP895: - CopyArray(CharCP_895, Result); - CP852: - CopyArray(CharCP_852, Result); - else - CopyArray(CharISO_8859_1, Result); - end; -end; - -{==============================================================================} -procedure ReadMulti(const Value: AnsiString; var Index: Integer; mb: Byte; - var b1, b2, b3, b4: Byte; le: boolean); -Begin - b1 := 0; - b2 := 0; - b3 := 0; - b4 := 0; - if Index < 0 then - Index := 1; - if mb > 4 then - mb := 1; - if (Index + mb - 1) <= Length(Value) then - begin - if le then - Case mb Of - 1: - b1 := Ord(Value[Index]); - 2: - Begin - b1 := Ord(Value[Index]); - b2 := Ord(Value[Index + 1]); - End; - 3: - Begin - b1 := Ord(Value[Index]); - b2 := Ord(Value[Index + 1]); - b3 := Ord(Value[Index + 2]); - End; - 4: - Begin - b1 := Ord(Value[Index]); - b2 := Ord(Value[Index + 1]); - b3 := Ord(Value[Index + 2]); - b4 := Ord(Value[Index + 3]); - End; - end - else - Case mb Of - 1: - b1 := Ord(Value[Index]); - 2: - Begin - b2 := Ord(Value[Index]); - b1 := Ord(Value[Index + 1]); - End; - 3: - Begin - b3 := Ord(Value[Index]); - b2 := Ord(Value[Index + 1]); - b1 := Ord(Value[Index + 2]); - End; - 4: - Begin - b4 := Ord(Value[Index]); - b3 := Ord(Value[Index + 1]); - b2 := Ord(Value[Index + 2]); - b1 := Ord(Value[Index + 3]); - End; - end; - end; - Inc(Index, mb); -end; - -{==============================================================================} -function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte; le: boolean): AnsiString; -begin - if mb > 4 then - mb := 1; - SetLength(Result, mb); - if le then - case mb Of - 1: - Result[1] := AnsiChar(b1); - 2: - begin - Result[1] := AnsiChar(b1); - Result[2] := AnsiChar(b2); - end; - 3: - begin - Result[1] := AnsiChar(b1); - Result[2] := AnsiChar(b2); - Result[3] := AnsiChar(b3); - end; - 4: - begin - Result[1] := AnsiChar(b1); - Result[2] := AnsiChar(b2); - Result[3] := AnsiChar(b3); - Result[4] := AnsiChar(b4); - end; - end - else - case mb Of - 1: - Result[1] := AnsiChar(b1); - 2: - begin - Result[2] := AnsiChar(b1); - Result[1] := AnsiChar(b2); - end; - 3: - begin - Result[3] := AnsiChar(b1); - Result[2] := AnsiChar(b2); - Result[1] := AnsiChar(b3); - end; - 4: - begin - Result[4] := AnsiChar(b1); - Result[3] := AnsiChar(b2); - Result[2] := AnsiChar(b3); - Result[1] := AnsiChar(b4); - end; - end; -end; - -{==============================================================================} -function UTF8toUCS4(const Value: AnsiString): AnsiString; -var - n, x, ul, m: Integer; - s: AnsiString; - w1, w2: Word; -begin - Result := ''; - n := 1; - while Length(Value) >= n do - begin - x := Ord(Value[n]); - Inc(n); - if x < 128 then - Result := Result + WriteMulti(x, 0, 0, 0, 4, false) - else - begin - m := 0; - if (x and $E0) = $C0 then - m := $1F; - if (x and $F0) = $E0 then - m := $0F; - if (x and $F8) = $F0 then - m := $07; - if (x and $FC) = $F8 then - m := $03; - if (x and $FE) = $FC then - m := $01; - ul := x and m; - s := IntToBin(ul, 0); - while Length(Value) >= n do - begin - x := Ord(Value[n]); - Inc(n); - if (x and $C0) = $80 then - s := s + IntToBin(x and $3F, 6) - else - begin - Dec(n); - Break; - end; - end; - ul := BinToInt(s); - w1 := ul div 65536; - w2 := ul mod 65536; - Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false); - end; - end; -end; - -{==============================================================================} -function UCS4toUTF8(const Value: AnsiString): AnsiString; -var - s, l, k: AnsiString; - b1, b2, b3, b4: Byte; - n, m, x, y: Integer; - b: Byte; -begin - Result := ''; - n := 1; - while Length(Value) >= n do - begin - ReadMulti(Value, n, 4, b1, b2, b3, b4, false); - if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then - Result := Result + AnsiChar(b1) - else - begin - x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536; - l := IntToBin(x, 0); - y := Length(l) div 6; - s := ''; - for m := 1 to y do - begin - k := Copy(l, Length(l) - 5, 6); - l := Copy(l, 1, Length(l) - 6); - b := BinToInt(k) or $80; - s := AnsiChar(b) + s; - end; - b := BinToInt(l); - case y of - 5: - b := b or $FC; - 4: - b := b or $F8; - 3: - b := b or $F0; - 2: - b := b or $E0; - 1: - b := b or $C0; - end; - s := AnsiChar(b) + s; - Result := Result + s; - end; - end; -end; - -{==============================================================================} -function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString; -var - n, i: Integer; - c: AnsiChar; - s, t: AnsiString; - shift: AnsiChar; - table: String; -begin - Result := ''; - n := 1; - if modified then - begin - shift := '&'; - table := TableBase64mod; - end - else - begin - shift := '+'; - table := TableBase64; - end; - while Length(Value) >= n do - begin - c := Value[n]; - Inc(n); - if c <> shift then - Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false) - else - begin - s := ''; - while Length(Value) >= n do - begin - c := Value[n]; - Inc(n); - if c = '-' then - Break; - if (c = '=') or (Pos(c, table) < 1) then - begin - Dec(n); - Break; - end; - s := s + c; - end; - if s = '' then - s := WriteMulti(Ord(shift), 0, 0, 0, 2, false) - else - begin - if modified then - t := DecodeBase64mod(s) - else - t := DecodeBase64(s); - if not odd(length(t)) then - s := t - else - begin //ill-formed sequence - t := s; - s := WriteMulti(Ord(shift), 0, 0, 0, 2, false); - for i := 1 to length(t) do - s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false); - end; - end; - Result := Result + s; - end; - end; -end; - -{==============================================================================} -function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString; -var - s: AnsiString; - b1, b2, b3, b4: Byte; - n, m: Integer; - shift: AnsiChar; -begin - Result := ''; - n := 1; - if modified then - shift := '&' - else - shift := '+'; - while Length(Value) >= n do - begin - ReadMulti(Value, n, 2, b1, b2, b3, b4, false); - if (b2 = 0) and (b1 < 128) then - if AnsiChar(b1) = shift then - Result := Result + shift + '-' - else - Result := Result + AnsiChar(b1) - else - begin - s := AnsiChar(b2) + AnsiChar(b1); - while Length(Value) >= n do - begin - ReadMulti(Value, n, 2, b1, b2, b3, b4, false); - if (b2 = 0) and (b1 < 128) then - begin - Dec(n, 2); - Break; - end; - s := s + AnsiChar(b2) + AnsiChar(b1); - end; - if modified then - s := EncodeBase64mod(s) - else - s := EncodeBase64(s); - m := Pos('=', s); - if m > 0 then - s := Copy(s, 1, m - 1); - Result := Result + shift + s + '-'; - end; - end; -end; - -{==============================================================================} -function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar): AnsiString; -begin - Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None); -end; - -{==============================================================================} -function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar; const TransformTable: array of Word): AnsiString; -begin - Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True); -end; - -{==============================================================================} - -function InternalToUcs(const Value: AnsiString; Charfrom: TMimeChar): AnsiString; -var - uni: Word; - n: Integer; - b1, b2, b3, b4: Byte; - SourceTable: array[128..255] of Word; - mbf: Byte; - lef: Boolean; - s: AnsiString; -begin - if CharFrom = UTF_8 then - s := UTF8toUCS4(Value) - else - if CharFrom = UTF_7 then - s := UTF7toUCS2(Value, False) - else - if CharFrom = UTF_7mod then - s := UTF7toUCS2(Value, True) - else - s := Value; - GetArray(CharFrom, SourceTable); - mbf := 1; - if CharFrom in SetTwo then - mbf := 2; - if CharFrom in SetFour then - mbf := 4; - lef := CharFrom in SetLe; - Result := ''; - n := 1; - while Length(s) >= n do - begin - ReadMulti(s, n, mbf, b1, b2, b3, b4, lef); - //handle BOM - if (b3 = 0) and (b4 = 0) then - begin - if (b1 = $FE) and (b2 = $FF) then - begin - lef := not lef; - continue; - end; - if (b1 = $FF) and (b2 = $FE) then - continue; - end; - if mbf = 1 then - if b1 > 127 then - begin - uni := SourceTable[b1]; - b1 := Lo(uni); - b2 := Hi(uni); - end; - Result := Result + WriteMulti(b1, b2, b3, b4, 2, False); - end; -end; - -function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString; -var - uni: Word; - n, m: Integer; - b: Byte; - b1, b2, b3, b4: Byte; - TargetTable: array[128..255] of Word; - mbt: Byte; - let: Boolean; - ucsstring, s, t: AnsiString; - cd: iconv_t; - f: Boolean; - NotNeedTransform: Boolean; - FromID, ToID: string; -begin - NotNeedTransform := (High(TransformTable) = 0); - if (CharFrom = CharTo) and NotNeedTransform then - begin - Result := Value; - Exit; - end; - FromID := GetIDFromCP(CharFrom); - ToID := GetIDFromCP(CharTo); - cd := Iconv_t(-1); - //do two-pass conversion. Transform to UCS-2 first. - if not DisableIconv then - cd := SynaIconvOpenIgnore('UCS-2BE', FromID); - try - if cd <> iconv_t(-1) then - SynaIconv(cd, Value, ucsstring) - else - ucsstring := InternalToUcs(Value, CharFrom); - finally - SynaIconvClose(cd); - end; - //here we allways have ucstring with UCS-2 encoding - //second pass... from UCS-2 to target encoding. - if not DisableIconv then - if translit then - cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE') - else - cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE'); - try - if (cd <> iconv_t(-1)) and NotNeedTransform then - begin - if CharTo = UTF_7 then - ucsstring := ucsstring + #0 + '-'; - //when transformtable is not needed and Iconv know target charset, - //do it fast by one call. - SynaIconv(cd, ucsstring, Result); - if CharTo = UTF_7 then - Delete(Result, Length(Result), 1); - end - else - begin - GetArray(CharTo, TargetTable); - mbt := 1; - if CharTo in SetTwo then - mbt := 2; - if CharTo in SetFour then - mbt := 4; - let := CharTo in SetLe; - b3 := 0; - b4 := 0; - Result := ''; - for n:= 0 to (Length(ucsstring) div 2) - 1 do - begin - s := Copy(ucsstring, n * 2 + 1, 2); - b2 := Ord(s[1]); - b1 := Ord(s[2]); - uni := b2 * 256 + b1; - if not NotNeedTransform then - begin - uni := ReplaceUnicode(uni, TransformTable); - b1 := Lo(uni); - b2 := Hi(uni); - s[1] := AnsiChar(b2); - s[2] := AnsiChar(b1); - end; - if cd <> iconv_t(-1) then - begin - if CharTo = UTF_7 then - s := s + #0 + '-'; - SynaIconv(cd, s, t); - if CharTo = UTF_7 then - Delete(t, Length(t), 1); - Result := Result + t; - end - else - begin - f := True; - if mbt = 1 then - if uni > 127 then - begin - f := False; - b := 0; - for m := 128 to 255 do - if TargetTable[m] = uni then - begin - b := m; - f := True; - Break; - end; - b1 := b; - b2 := 0; - end - else - b1 := Lo(uni); - if not f then - if translit then - begin - b1 := Ord(NotFoundChar); - b2 := 0; - f := True; - end; - if f then - Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let) - end; - end; - if cd = iconv_t(-1) then - begin - if CharTo = UTF_7 then - Result := UCS2toUTF7(Result, false); - if CharTo = UTF_7mod then - Result := UCS2toUTF7(Result, true); - if CharTo = UTF_8 then - Result := UCS4toUTF8(Result); - end; - end; - finally - SynaIconvClose(cd); - end; -end; - -{==============================================================================} -{$IFNDEF MSWINDOWS} - -function GetCurCP: TMimeChar; -begin - {$IFNDEF FPC} - Result := GetCPFromID(nl_langinfo(_NL_CTYPE_CODESET_NAME)); - {$ELSE} - //How to get system codepage without LIBC? - Result := UTF_8; -{ TODO : Waiting for FPC 2.8 solution } - {$ENDIF} -end; - -function GetCurOEMCP: TMimeChar; -begin - Result := GetCurCP; -end; - -{$ELSE} - -function CPToMimeChar(Value: Integer): TMimeChar; -begin - case Value of - 437, 850, 20127: - Result := ISO_8859_1; //I know, it is not ideal! - 737: - Result := CP737; - 775: - Result := CP775; - 852: - Result := CP852; - 855: - Result := CP855; - 857: - Result := CP857; - 858: - Result := CP858; - 860: - Result := CP860; - 861: - Result := CP861; - 862: - Result := CP862; - 863: - Result := CP863; - 864: - Result := CP864; - 865: - Result := CP865; - 866: - Result := CP866; - 869: - Result := CP869; - 874: - Result := ISO_8859_15; - 895: - Result := CP895; - 932: - Result := CP932; - 936: - Result := CP936; - 949: - Result := CP949; - 950: - Result := CP950; - 1200: - Result := UCS_2LE; - 1201: - Result := UCS_2; - 1250: - Result := CP1250; - 1251: - Result := CP1251; - 1253: - Result := CP1253; - 1254: - Result := CP1254; - 1255: - Result := CP1255; - 1256: - Result := CP1256; - 1257: - Result := CP1257; - 1258: - Result := CP1258; - 1361: - Result := CP1361; - 10000: - Result := MAC; - 10004: - Result := MACAR; - 10005: - Result := MACHEB; - 10006: - Result := MACGR; - 10007: - Result := MACCYR; - 10010: - Result := MACRO; - 10017: - Result := MACUK; - 10021: - Result := MACTH; - 10029: - Result := MACCE; - 10079: - Result := MACICE; - 10081: - Result := MACTU; - 10082: - Result := MACCRO; - 12000: - Result := UCS_4LE; - 12001: - Result := UCS_4; - 20866: - Result := KOI8_R; - 20932: - Result := JIS_X0208; - 20936: - Result := GB2312; - 21866: - Result := KOI8_U; - 28591: - Result := ISO_8859_1; - 28592: - Result := ISO_8859_2; - 28593: - Result := ISO_8859_3; - 28594: - Result := ISO_8859_4; - 28595: - Result := ISO_8859_5; - 28596, 708: - Result := ISO_8859_6; - 28597: - Result := ISO_8859_7; - 28598, 38598: - Result := ISO_8859_8; - 28599: - Result := ISO_8859_9; - 28605: - Result := ISO_8859_15; - 50220: - Result := ISO_2022_JP; //? ISO 2022 Japanese with no halfwidth Katakana - 50221: - Result := ISO_2022_JP1;//? Japanese with halfwidth Katakana - 50222: - Result := ISO_2022_JP2;//? Japanese JIS X 0201-1989 - 50225: - Result := ISO_2022_KR; - 50227: - Result := ISO_2022_CN;//? ISO 2022 Simplified Chinese - 50229: - Result := ISO_2022_CNE;//? ISO 2022 Traditional Chinese - 51932: - Result := EUC_JP; - 51936: - Result := GB2312; - 51949: - Result := EUC_KR; - 52936: - Result := HZ; - 54936: - Result := GB18030; - 65000: - Result := UTF_7; - 65001: - Result := UTF_8; - 0: - Result := UCS_2LE; - else - Result := CP1252; - end; -end; - -function GetCurCP: TMimeChar; -begin - Result := CPToMimeChar(GetACP); -end; - -function GetCurOEMCP: TMimeChar; -begin - Result := CPToMimeChar(GetOEMCP); -end; -{$ENDIF} - -{==============================================================================} -function NeedCharsetConversion(const Value: AnsiString): Boolean; -var - n: Integer; -begin - Result := False; - for n := 1 to Length(Value) do - if (Ord(Value[n]) > 127) or (Ord(Value[n]) = 0) then - begin - Result := True; - Break; - end; -end; - -{==============================================================================} -function IdealCharsetCoding(const Value: AnsiString; CharFrom: TMimeChar; - CharTo: TMimeSetChar): TMimeChar; -var - n: Integer; - max: Integer; - s, t, u: AnsiString; - CharSet: TMimeChar; -begin - Result := ISO_8859_1; - s := Copy(Value, 1, 1024); //max first 1KB for next procedure - max := 0; - for n := Ord(Low(TMimeChar)) to Ord(High(TMimeChar)) do - begin - CharSet := TMimeChar(n); - if CharSet in CharTo then - begin - t := CharsetConversionTrans(s, CharFrom, CharSet, Replace_None, False); - u := CharsetConversionTrans(t, CharSet, CharFrom, Replace_None, False); - if s = u then - begin - Result := CharSet; - Exit; - end; - if Length(u) > max then - begin - Result := CharSet; - max := Length(u); - end; - end; - end; -end; - -{==============================================================================} -function GetBOM(Value: TMimeChar): AnsiString; -begin - Result := ''; - case Value of - UCS_2: - Result := #$fe + #$ff; - UCS_4: - Result := #$00 + #$00 + #$fe + #$ff; - UCS_2LE: - Result := #$ff + #$fe; - UCS_4LE: - Result := #$ff + #$fe + #$00 + #$00; - UTF_8: - Result := #$ef + #$bb + #$bf; - end; -end; - -{==============================================================================} -function GetCPFromID(Value: AnsiString): TMimeChar; -begin - Value := UpperCase(Value); - if (Pos('KAMENICKY', Value) > 0) or (Pos('895', Value) > 0) then - Result := CP895 - else - if Pos('MUTF-7', Value) > 0 then - Result := UTF_7mod - else - Result := GetCPFromIconvID(Value); -end; - -{==============================================================================} -function GetIDFromCP(Value: TMimeChar): AnsiString; -begin - case Value of - CP895: - Result := 'CP-895'; - UTF_7mod: - Result := 'mUTF-7'; - else - Result := GetIconvIDFromCP(Value); - end; -end; - -{==============================================================================} -function StringToWide(const Value: AnsiString): WideString; -var - n: integer; - x, y: integer; -begin - SetLength(Result, Length(Value) div 2); - for n := 1 to Length(Value) div 2 do - begin - x := Ord(Value[((n-1) * 2) + 1]); - y := Ord(Value[((n-1) * 2) + 2]); - Result[n] := WideChar(x * 256 + y); - end; -end; - -{==============================================================================} -function WideToString(const Value: WideString): AnsiString; -var - n: integer; - x: integer; -begin - SetLength(Result, Length(Value) * 2); - for n := 1 to Length(Value) do - begin - x := Ord(Value[n]); - Result[((n-1) * 2) + 1] := AnsiChar(x div 256); - Result[((n-1) * 2) + 2] := AnsiChar(x mod 256); - end; -end; - -{==============================================================================} -initialization -begin - IconvArr[0].Charset := ISO_8859_1; - IconvArr[0].Charname := 'ISO-8859-1 CP819 IBM819 ISO-IR-100 ISO8859-1 ISO_8859-1 ISO_8859-1:1987 L1 LATIN1 CSISOLATIN1'; - IconvArr[1].Charset := UTF_8; - IconvArr[1].Charname := 'UTF-8'; - IconvArr[2].Charset := UCS_2; - IconvArr[2].Charname := 'ISO-10646-UCS-2 UCS-2 CSUNICODE'; - IconvArr[3].Charset := UCS_2; - IconvArr[3].Charname := 'UCS-2BE UNICODE-1-1 UNICODEBIG CSUNICODE11'; - IconvArr[4].Charset := UCS_2LE; - IconvArr[4].Charname := 'UCS-2LE UNICODELITTLE'; - IconvArr[5].Charset := UCS_4; - IconvArr[5].Charname := 'ISO-10646-UCS-4 UCS-4 CSUCS4'; - IconvArr[6].Charset := UCS_4; - IconvArr[6].Charname := 'UCS-4BE'; - IconvArr[7].Charset := UCS_2LE; - IconvArr[7].Charname := 'UCS-4LE'; - IconvArr[8].Charset := UTF_16; - IconvArr[8].Charname := 'UTF-16'; - IconvArr[9].Charset := UTF_16; - IconvArr[9].Charname := 'UTF-16BE'; - IconvArr[10].Charset := UTF_16LE; - IconvArr[10].Charname := 'UTF-16LE'; - IconvArr[11].Charset := UTF_32; - IconvArr[11].Charname := 'UTF-32'; - IconvArr[12].Charset := UTF_32; - IconvArr[12].Charname := 'UTF-32BE'; - IconvArr[13].Charset := UTF_32; - IconvArr[13].Charname := 'UTF-32LE'; - IconvArr[14].Charset := UTF_7; - IconvArr[14].Charname := 'UNICODE-1-1-UTF-7 UTF-7 CSUNICODE11UTF7'; - IconvArr[15].Charset := C99; - IconvArr[15].Charname := 'C99'; - IconvArr[16].Charset := JAVA; - IconvArr[16].Charname := 'JAVA'; - IconvArr[17].Charset := ISO_8859_1; - IconvArr[17].Charname := 'US-ASCII ANSI_X3.4-1968 ANSI_X3.4-1986 ASCII CP367 IBM367 ISO-IR-6 ISO646-US ISO_646.IRV:1991 US CSASCII'; - IconvArr[18].Charset := ISO_8859_2; - IconvArr[18].Charname := 'ISO-8859-2 ISO-IR-101 ISO8859-2 ISO_8859-2 ISO_8859-2:1987 L2 LATIN2 CSISOLATIN2'; - IconvArr[19].Charset := ISO_8859_3; - IconvArr[19].Charname := 'ISO-8859-3 ISO-IR-109 ISO8859-3 ISO_8859-3 ISO_8859-3:1988 L3 LATIN3 CSISOLATIN3'; - IconvArr[20].Charset := ISO_8859_4; - IconvArr[20].Charname := 'ISO-8859-4 ISO-IR-110 ISO8859-4 ISO_8859-4 ISO_8859-4:1988 L4 LATIN4 CSISOLATIN4'; - IconvArr[21].Charset := ISO_8859_5; - IconvArr[21].Charname := 'ISO-8859-5 CYRILLIC ISO-IR-144 ISO8859-5 ISO_8859-5 ISO_8859-5:1988 CSISOLATINCYRILLIC'; - IconvArr[22].Charset := ISO_8859_6; - IconvArr[22].Charname := 'ISO-8859-6 ARABIC ASMO-708 ECMA-114 ISO-IR-127 ISO8859-6 ISO_8859-6 ISO_8859-6:1987 CSISOLATINARABIC'; - IconvArr[23].Charset := ISO_8859_7; - IconvArr[23].Charname := 'ISO-8859-7 ECMA-118 ELOT_928 GREEK GREEK8 ISO-IR-126 ISO8859-7 ISO_8859-7 ISO_8859-7:1987 CSISOLATINGREEK'; - IconvArr[24].Charset := ISO_8859_8; - IconvArr[24].Charname := 'ISO-8859-8 HEBREW ISO_8859-8 ISO-IR-138 ISO8859-8 ISO_8859-8:1988 CSISOLATINHEBREW ISO-8859-8-I'; - IconvArr[25].Charset := ISO_8859_9; - IconvArr[25].Charname := 'ISO-8859-9 ISO-IR-148 ISO8859-9 ISO_8859-9 ISO_8859-9:1989 L5 LATIN5 CSISOLATIN5'; - IconvArr[26].Charset := ISO_8859_10; - IconvArr[26].Charname := 'ISO-8859-10 ISO-IR-157 ISO8859-10 ISO_8859-10 ISO_8859-10:1992 L6 LATIN6 CSISOLATIN6'; - IconvArr[27].Charset := ISO_8859_13; - IconvArr[27].Charname := 'ISO-8859-13 ISO-IR-179 ISO8859-13 ISO_8859-13 L7 LATIN7'; - IconvArr[28].Charset := ISO_8859_14; - IconvArr[28].Charname := 'ISO-8859-14 ISO-CELTIC ISO-IR-199 ISO8859-14 ISO_8859-14 ISO_8859-14:1998 L8 LATIN8'; - IconvArr[29].Charset := ISO_8859_15; - IconvArr[29].Charname := 'ISO-8859-15 ISO-IR-203 ISO8859-15 ISO_8859-15 ISO_8859-15:1998'; - IconvArr[30].Charset := ISO_8859_16; - IconvArr[30].Charname := 'ISO-8859-16 ISO-IR-226 ISO8859-16 ISO_8859-16 ISO_8859-16:2000'; - IconvArr[31].Charset := KOI8_R; - IconvArr[31].Charname := 'KOI8-R CSKOI8R'; - IconvArr[32].Charset := KOI8_U; - IconvArr[32].Charname := 'KOI8-U'; - IconvArr[33].Charset := KOI8_RU; - IconvArr[33].Charname := 'KOI8-RU'; - IconvArr[34].Charset := CP1250; - IconvArr[34].Charname := 'WINDOWS-1250 CP1250 MS-EE'; - IconvArr[35].Charset := CP1251; - IconvArr[35].Charname := 'WINDOWS-1251 CP1251 MS-CYRL'; - IconvArr[36].Charset := CP1252; - IconvArr[36].Charname := 'WINDOWS-1252 CP1252 MS-ANSI'; - IconvArr[37].Charset := CP1253; - IconvArr[37].Charname := 'WINDOWS-1253 CP1253 MS-GREEK'; - IconvArr[38].Charset := CP1254; - IconvArr[38].Charname := 'WINDOWS-1254 CP1254 MS-TURK'; - IconvArr[39].Charset := CP1255; - IconvArr[39].Charname := 'WINDOWS-1255 CP1255 MS-HEBR'; - IconvArr[40].Charset := CP1256; - IconvArr[40].Charname := 'WINDOWS-1256 CP1256 MS-ARAB'; - IconvArr[41].Charset := CP1257; - IconvArr[41].Charname := 'WINDOWS-1257 CP1257 WINBALTRIM'; - IconvArr[42].Charset := CP1258; - IconvArr[42].Charname := 'WINDOWS-1258 CP1258'; - IconvArr[43].Charset := ISO_8859_1; - IconvArr[43].Charname := '850 CP850 IBM850 CSPC850MULTILINGUAL'; - IconvArr[44].Charset := CP862; - IconvArr[44].Charname := '862 CP862 IBM862 CSPC862LATINHEBREW'; - IconvArr[45].Charset := CP866; - IconvArr[45].Charname := '866 CP866 IBM866 CSIBM866'; - IconvArr[46].Charset := MAC; - IconvArr[46].Charname := 'MAC MACINTOSH MACROMAN CSMACINTOSH'; - IconvArr[47].Charset := MACCE; - IconvArr[47].Charname := 'MACCENTRALEUROPE'; - IconvArr[48].Charset := MACICE; - IconvArr[48].Charname := 'MACICELAND'; - IconvArr[49].Charset := MACCRO; - IconvArr[49].Charname := 'MACCROATIAN'; - IconvArr[50].Charset := MACRO; - IconvArr[50].Charname := 'MACROMANIA'; - IconvArr[51].Charset := MACCYR; - IconvArr[51].Charname := 'MACCYRILLIC'; - IconvArr[52].Charset := MACUK; - IconvArr[52].Charname := 'MACUKRAINE'; - IconvArr[53].Charset := MACGR; - IconvArr[53].Charname := 'MACGREEK'; - IconvArr[54].Charset := MACTU; - IconvArr[54].Charname := 'MACTURKISH'; - IconvArr[55].Charset := MACHEB; - IconvArr[55].Charname := 'MACHEBREW'; - IconvArr[56].Charset := MACAR; - IconvArr[56].Charname := 'MACARABIC'; - IconvArr[57].Charset := MACTH; - IconvArr[57].Charname := 'MACTHAI'; - IconvArr[58].Charset := ROMAN8; - IconvArr[58].Charname := 'HP-ROMAN8 R8 ROMAN8 CSHPROMAN8'; - IconvArr[59].Charset := NEXTSTEP; - IconvArr[59].Charname := 'NEXTSTEP'; - IconvArr[60].Charset := ARMASCII; - IconvArr[60].Charname := 'ARMSCII-8'; - IconvArr[61].Charset := GEORGIAN_AC; - IconvArr[61].Charname := 'GEORGIAN-ACADEMY'; - IconvArr[62].Charset := GEORGIAN_PS; - IconvArr[62].Charname := 'GEORGIAN-PS'; - IconvArr[63].Charset := KOI8_T; - IconvArr[63].Charname := 'KOI8-T'; - IconvArr[64].Charset := MULELAO; - IconvArr[64].Charname := 'MULELAO-1'; - IconvArr[65].Charset := CP1133; - IconvArr[65].Charname := 'CP1133 IBM-CP1133'; - IconvArr[66].Charset := TIS620; - IconvArr[66].Charname := 'TIS-620 ISO-IR-166 TIS620 TIS620-0 TIS620.2529-1 TIS620.2533-0 TIS620.2533-1'; - IconvArr[67].Charset := CP874; - IconvArr[67].Charname := 'CP874 WINDOWS-874'; - IconvArr[68].Charset := VISCII; - IconvArr[68].Charname := 'VISCII VISCII1.1-1 CSVISCII'; - IconvArr[69].Charset := TCVN; - IconvArr[69].Charname := 'TCVN TCVN-5712 TCVN5712-1 TCVN5712-1:1993'; - IconvArr[70].Charset := ISO_IR_14; - IconvArr[70].Charname := 'ISO-IR-14 ISO646-JP JIS_C6220-1969-RO JP CSISO14JISC6220RO'; - IconvArr[71].Charset := JIS_X0201; - IconvArr[71].Charname := 'JISX0201-1976 JIS_X0201 X0201 CSHALFWIDTHKATAKANA'; - IconvArr[72].Charset := JIS_X0208; - IconvArr[72].Charname := 'ISO-IR-87 JIS0208 JIS_C6226-1983 JIS_X0208 JIS_X0208-1983 JIS_X0208-1990 X0208 CSISO87JISX0208'; - IconvArr[73].Charset := JIS_X0212; - IconvArr[73].Charname := 'ISO-IR-159 JIS_X0212 JIS_X0212-1990 JIS_X0212.1990-0 X0212 CSISO159JISX02121990'; - IconvArr[74].Charset := GB1988_80; - IconvArr[74].Charname := 'CN GB_1988-80 ISO-IR-57 ISO646-CN CSISO57GB1988'; - IconvArr[75].Charset := GB2312_80; - IconvArr[75].Charname := 'CHINESE GB_2312-80 ISO-IR-58 CSISO58GB231280'; - IconvArr[76].Charset := ISO_IR_165; - IconvArr[76].Charname := 'CN-GB-ISOIR165 ISO-IR-165'; - IconvArr[77].Charset := ISO_IR_149; - IconvArr[77].Charname := 'ISO-IR-149 KOREAN KSC_5601 KS_C_5601-1987 KS_C_5601-1989 CSKSC56011987'; - IconvArr[78].Charset := EUC_JP; - IconvArr[78].Charname := 'EUC-JP EUCJP EXTENDED_UNIX_CODE_PACKED_FORMAT_FOR_JAPANESE CSEUCPKDFMTJAPANESE'; - IconvArr[79].Charset := SHIFT_JIS; - IconvArr[79].Charname := 'SHIFT-JIS MS_KANJI SHIFT_JIS SJIS CSSHIFTJIS'; - IconvArr[80].Charset := CP932; - IconvArr[80].Charname := 'CP932'; - IconvArr[81].Charset := ISO_2022_JP; - IconvArr[81].Charname := 'ISO-2022-JP CSISO2022JP'; - IconvArr[82].Charset := ISO_2022_JP1; - IconvArr[82].Charname := 'ISO-2022-JP-1'; - IconvArr[83].Charset := ISO_2022_JP2; - IconvArr[83].Charname := 'ISO-2022-JP-2 CSISO2022JP2'; - IconvArr[84].Charset := GB2312; - IconvArr[84].Charname := 'CN-GB EUC-CN EUCCN GB2312 CSGB2312'; - IconvArr[85].Charset := CP936; - IconvArr[85].Charname := 'CP936 GBK'; - IconvArr[86].Charset := GB18030; - IconvArr[86].Charname := 'GB18030'; - IconvArr[87].Charset := ISO_2022_CN; - IconvArr[87].Charname := 'ISO-2022-CN CSISO2022CN'; - IconvArr[88].Charset := ISO_2022_CNE; - IconvArr[88].Charname := 'ISO-2022-CN-EXT'; - IconvArr[89].Charset := HZ; - IconvArr[89].Charname := 'HZ HZ-GB-2312'; - IconvArr[90].Charset := EUC_TW; - IconvArr[90].Charname := 'EUC-TW EUCTW CSEUCTW'; - IconvArr[91].Charset := BIG5; - IconvArr[91].Charname := 'BIG5 BIG-5 BIG-FIVE BIGFIVE CN-BIG5 CSBIG5'; - IconvArr[92].Charset := CP950; - IconvArr[92].Charname := 'CP950'; - IconvArr[93].Charset := BIG5_HKSCS; - IconvArr[93].Charname := 'BIG5-HKSCS BIG5HKSCS'; - IconvArr[94].Charset := EUC_KR; - IconvArr[94].Charname := 'EUC-KR EUCKR CSEUCKR'; - IconvArr[95].Charset := CP949; - IconvArr[95].Charname := 'CP949 UHC'; - IconvArr[96].Charset := CP1361; - IconvArr[96].Charname := 'CP1361 JOHAB'; - IconvArr[97].Charset := ISO_2022_KR; - IconvArr[97].Charname := 'ISO-2022-KR CSISO2022KR'; - IconvArr[98].Charset := ISO_8859_1; - IconvArr[98].Charname := '437 CP437 IBM437 CSPC8CODEPAGE437'; - IconvArr[99].Charset := CP737; - IconvArr[99].Charname := 'CP737'; - IconvArr[100].Charset := CP775; - IconvArr[100].Charname := 'CP775 IBM775 CSPC775BALTIC'; - IconvArr[101].Charset := CP852; - IconvArr[101].Charname := '852 CP852 IBM852 CSPCP852'; - IconvArr[102].Charset := CP853; - IconvArr[102].Charname := 'CP853'; - IconvArr[103].Charset := CP855; - IconvArr[103].Charname := '855 CP855 IBM855 CSIBM855'; - IconvArr[104].Charset := CP857; - IconvArr[104].Charname := '857 CP857 IBM857 CSIBM857'; - IconvArr[105].Charset := CP858; - IconvArr[105].Charname := 'CP858'; - IconvArr[106].Charset := CP860; - IconvArr[106].Charname := '860 CP860 IBM860 CSIBM860'; - IconvArr[107].Charset := CP861; - IconvArr[107].Charname := '861 CP-IS CP861 IBM861 CSIBM861'; - IconvArr[108].Charset := CP863; - IconvArr[108].Charname := '863 CP863 IBM863 CSIBM863'; - IconvArr[109].Charset := CP864; - IconvArr[109].Charname := 'CP864 IBM864 CSIBM864'; - IconvArr[110].Charset := CP865; - IconvArr[110].Charname := '865 CP865 IBM865 CSIBM865'; - IconvArr[111].Charset := CP869; - IconvArr[111].Charname := '869 CP-GR CP869 IBM869 CSIBM869'; - IconvArr[112].Charset := CP1125; - IconvArr[112].Charname := 'CP1125'; -end; - -end. diff --git a/3rd/synapse/source/synacode.pas b/3rd/synapse/source/synacode.pas deleted file mode 100644 index 52c9dfed9..000000000 --- a/3rd/synapse/source/synacode.pas +++ /dev/null @@ -1,1467 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 002.002.003 | -|==============================================================================| -| Content: Coding and decoding support | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2000-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Various encoding and decoding support)} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$R-} -{$H+} -{$TYPEDADDRESS OFF} - -{$IFDEF CIL} - {$DEFINE SYNACODE_NATIVE} -{$ENDIF} -{$IFDEF FPC_BIG_ENDIAN} - {$DEFINE SYNACODE_NATIVE} -{$ENDIF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} - {$WARN SUSPICIOUS_TYPECAST OFF} -{$ENDIF} - -unit synacode; - -interface - -uses - SysUtils; - -type - TSpecials = set of AnsiChar; - -const - - SpecialChar: TSpecials = - ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\', - '"', '_']; - NonAsciiChar: TSpecials = - [#0..#31, #127..#255]; - URLFullSpecialChar: TSpecials = - [';', '/', '?', ':', '@', '=', '&', '#', '+']; - URLSpecialChar: TSpecials = - [#$00..#$20, '<', '>', '"', '%', '{', '}', '|', '\', '^', '[', ']', '`', #$7F..#$FF]; - TableBase64 = - 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/='; - TableBase64mod = - 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,='; - TableUU = - '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'; - TableXX = - '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; - ReTablebase64 = - #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40 - +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C - +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03 - +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F - +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40 - +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 - +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D - +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40; - ReTableUU = - #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C - +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 - +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 - +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30 - +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C - +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 - +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 - +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40; - ReTableXX = - #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40 - +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A - +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F - +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B - +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40 - +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D - +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 - +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40; - -{:Decodes triplet encoding with a given character delimiter. It is used for - decoding quoted-printable or URL encoding.} -function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString; - -{:Decodes a string from quoted printable form. (also decodes triplet sequences - like '=7F')} -function DecodeQuotedPrintable(const Value: AnsiString): AnsiString; - -{:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')} -function DecodeURL(const Value: AnsiString): AnsiString; - -{:Performs triplet encoding with a given character delimiter. Used for encoding - quoted-printable or URL encoding.} -function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar; - Specials: TSpecials): AnsiString; - -{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) - are encoded.} -function EncodeQuotedPrintable(const Value: AnsiString): AnsiString; - -{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and - @link(SpecialChar) are encoded.} -function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString; - -{:Encodes a string to URL format. Used for encoding data from a form field in - HTTP, etc. (Encodes all critical characters including characters used as URL - delimiters ('/',':', etc.)} -function EncodeURLElement(const Value: AnsiString): AnsiString; - -{:Encodes a string to URL format. Used to encode critical characters in all - URLs.} -function EncodeURL(const Value: AnsiString): AnsiString; - -{:Decode 4to3 encoding with given table. If some element is not found in table, - first item from table is used. This is good for buggy coded items by Microsoft - Outlook. This software sometimes using wrong table for UUcode, where is used - ' ' instead '`'.} -function Decode4to3(const Value, Table: AnsiString): AnsiString; - -{:Decode 4to3 encoding with given REVERSE table. Using this function with -reverse table is much faster then @link(Decode4to3). This function is used -internally for Base64, UU or XX decoding.} -function Decode4to3Ex(const Value, Table: AnsiString): AnsiString; - -{:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.} -function Encode3to4(const Value, Table: AnsiString): AnsiString; - -{:Decode string from base64 format.} -function DecodeBase64(const Value: AnsiString): AnsiString; - -{:Encodes a string to base64 format.} -function EncodeBase64(const Value: AnsiString): AnsiString; - -{:Decode string from modified base64 format. (used in IMAP, for example.)} -function DecodeBase64mod(const Value: AnsiString): AnsiString; - -{:Encodes a string to modified base64 format. (used in IMAP, for example.)} -function EncodeBase64mod(const Value: AnsiString): AnsiString; - -{:Decodes a string from UUcode format.} -function DecodeUU(const Value: AnsiString): AnsiString; - -{:encode UUcode. it encode only datas, you must also add header and footer for - proper encode.} -function EncodeUU(const Value: AnsiString): AnsiString; - -{:Decodes a string from XXcode format.} -function DecodeXX(const Value: AnsiString): AnsiString; - -{:decode line with Yenc code. This code is sometimes used in newsgroups.} -function DecodeYEnc(const Value: AnsiString): AnsiString; - -{:Returns a new CRC32 value after adding a new byte of data.} -function UpdateCrc32(Value: Byte; Crc32: Integer): Integer; - -{:return CRC32 from a value string.} -function Crc32(const Value: AnsiString): Integer; - -{:Returns a new CRC16 value after adding a new byte of data.} -function UpdateCrc16(Value: Byte; Crc16: Word): Word; - -{:return CRC16 from a value string.} -function Crc16(const Value: AnsiString): Word; - -{:Returns a binary string with a RSA-MD5 hashing of "Value" string.} -function MD5(const Value: AnsiString): AnsiString; - -{:Returns a binary string with HMAC-MD5 hash.} -function HMAC_MD5(Text, Key: AnsiString): AnsiString; - -{:Returns a binary string with a RSA-MD5 hashing of string what is constructed - by repeating "value" until length is "Len".} -function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString; - -{:Returns a binary string with a SHA-1 hashing of "Value" string.} -function SHA1(const Value: AnsiString): AnsiString; - -{:Returns a binary string with HMAC-SHA1 hash.} -function HMAC_SHA1(Text, Key: AnsiString): AnsiString; - -{:Returns a binary string with a SHA-1 hashing of string what is constructed - by repeating "value" until length is "Len".} -function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString; - -{:Returns a binary string with a RSA-MD4 hashing of "Value" string.} -function MD4(const Value: AnsiString): AnsiString; - -implementation - -const - - Crc32Tab: array[0..255] of Integer = ( - Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA), - Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3), - Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988), - Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91), - Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE), - Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7), - Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC), - Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5), - Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172), - Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B), - Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940), - Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59), - Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116), - Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F), - Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924), - Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D), - Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A), - Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433), - Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818), - Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01), - Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E), - Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457), - Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C), - Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65), - Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2), - Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB), - Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0), - Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9), - Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086), - Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F), - Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4), - Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD), - Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A), - Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683), - Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8), - Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1), - Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE), - Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7), - Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC), - Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5), - Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252), - Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B), - Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60), - Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79), - Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236), - Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F), - Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04), - Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D), - Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A), - Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713), - Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38), - Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21), - Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E), - Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777), - Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C), - Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45), - Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2), - Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB), - Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0), - Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9), - Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6), - Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF), - Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94), - Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D) - ); - - Crc16Tab: array[0..255] of Word = ( - $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF, - $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7, - $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E, - $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876, - $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD, - $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5, - $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C, - $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974, - $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB, - $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3, - $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A, - $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72, - $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9, - $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1, - $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738, - $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70, - $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7, - $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF, - $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036, - $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E, - $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5, - $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD, - $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134, - $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C, - $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3, - $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB, - $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232, - $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A, - $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1, - $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9, - $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330, - $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78 - ); - -procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer); -{$IFDEF SYNACODE_NATIVE} -var - n: integer; -{$ENDIF} -begin - if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then - Exit; - {$IFDEF SYNACODE_NATIVE} - for n := 0 to ((high(ArByte) + 1) div 4) - 1 do - ArLong[n] := ArByte[n * 4 + 0] - + (ArByte[n * 4 + 1] shl 8) - + (ArByte[n * 4 + 2] shl 16) - + (ArByte[n * 4 + 3] shl 24); - {$ELSE} - Move(ArByte[0], ArLong[0], High(ArByte) + 1); - {$ENDIF} -end; - -procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte); -{$IFDEF SYNACODE_NATIVE} -var - n: integer; -{$ENDIF} -begin - if (High(ArByte) + 1) < ((High(ArLong) + 1) * 4) then - Exit; - {$IFDEF SYNACODE_NATIVE} - for n := 0 to high(ArLong) do - begin - ArByte[n * 4 + 0] := ArLong[n] and $000000FF; - ArByte[n * 4 + 1] := (ArLong[n] shr 8) and $000000FF; - ArByte[n * 4 + 2] := (ArLong[n] shr 16) and $000000FF; - ArByte[n * 4 + 3] := (ArLong[n] shr 24) and $000000FF; - end; - {$ELSE} - Move(ArLong[0], ArByte[0], High(ArByte) + 1); - {$ENDIF} -end; - -type - TMDCtx = record - State: array[0..3] of Integer; - Count: array[0..1] of Integer; - BufAnsiChar: array[0..63] of Byte; - BufLong: array[0..15] of Integer; - end; - TSHA1Ctx= record - Hi, Lo: integer; - Buffer: array[0..63] of byte; - Index: integer; - Hash: array[0..4] of Integer; - HashByte: array[0..19] of byte; - end; - - TMDTransform = procedure(var Buf: array of LongInt; const Data: array of LongInt); - -{==============================================================================} - -function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString; -var - x, l, lv: Integer; - c: AnsiChar; - b: Byte; - bad: Boolean; -begin - lv := Length(Value); - SetLength(Result, lv); - x := 1; - l := 1; - while x <= lv do - begin - c := Value[x]; - Inc(x); - if c <> Delimiter then - begin - Result[l] := c; - Inc(l); - end - else - if x < lv then - begin - Case Value[x] Of - #13: - if (Value[x + 1] = #10) then - Inc(x, 2) - else - Inc(x); - #10: - if (Value[x + 1] = #13) then - Inc(x, 2) - else - Inc(x); - else - begin - bad := False; - Case Value[x] Of - '0'..'9': b := (Byte(Value[x]) - 48) Shl 4; - 'a'..'f', 'A'..'F': b := ((Byte(Value[x]) And 7) + 9) shl 4; - else - begin - b := 0; - bad := True; - end; - end; - Case Value[x + 1] Of - '0'..'9': b := b Or (Byte(Value[x + 1]) - 48); - 'a'..'f', 'A'..'F': b := b Or ((Byte(Value[x + 1]) And 7) + 9); - else - bad := True; - end; - if bad then - begin - Result[l] := c; - Inc(l); - end - else - begin - Inc(x, 2); - Result[l] := AnsiChar(b); - Inc(l); - end; - end; - end; - end - else - break; - end; - Dec(l); - SetLength(Result, l); -end; - -{==============================================================================} - -function DecodeQuotedPrintable(const Value: AnsiString): AnsiString; -begin - Result := DecodeTriplet(Value, '='); -end; - -{==============================================================================} - -function DecodeURL(const Value: AnsiString): AnsiString; -begin - Result := DecodeTriplet(Value, '%'); -end; - -{==============================================================================} - -function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar; - Specials: TSpecials): AnsiString; -var - n, l: Integer; - s: AnsiString; - c: AnsiChar; -begin - SetLength(Result, Length(Value) * 3); - l := 1; - for n := 1 to Length(Value) do - begin - c := Value[n]; - if c in Specials then - begin - Result[l] := Delimiter; - Inc(l); - s := IntToHex(Ord(c), 2); - Result[l] := s[1]; - Inc(l); - Result[l] := s[2]; - Inc(l); - end - else - begin - Result[l] := c; - Inc(l); - end; - end; - Dec(l); - SetLength(Result, l); -end; - -{==============================================================================} - -function EncodeQuotedPrintable(const Value: AnsiString): AnsiString; -begin - Result := EncodeTriplet(Value, '=', ['='] + NonAsciiChar); -end; - -{==============================================================================} - -function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString; -begin - Result := EncodeTriplet(Value, '=', SpecialChar + NonAsciiChar); -end; - -{==============================================================================} - -function EncodeURLElement(const Value: AnsiString): AnsiString; -begin - Result := EncodeTriplet(Value, '%', URLSpecialChar + URLFullSpecialChar); -end; - -{==============================================================================} - -function EncodeURL(const Value: AnsiString): AnsiString; -begin - Result := EncodeTriplet(Value, '%', URLSpecialChar); -end; - -{==============================================================================} - -function Decode4to3(const Value, Table: AnsiString): AnsiString; -var - x, y, n, l: Integer; - d: array[0..3] of Byte; -begin - SetLength(Result, Length(Value)); - x := 1; - l := 1; - while x <= Length(Value) do - begin - for n := 0 to 3 do - begin - if x > Length(Value) then - d[n] := 64 - else - begin - y := Pos(Value[x], Table); - if y < 1 then - y := 1; - d[n] := y - 1; - end; - Inc(x); - end; - Result[l] := AnsiChar((D[0] and $3F) shl 2 + (D[1] and $30) shr 4); - Inc(l); - if d[2] <> 64 then - begin - Result[l] := AnsiChar((D[1] and $0F) shl 4 + (D[2] and $3C) shr 2); - Inc(l); - if d[3] <> 64 then - begin - Result[l] := AnsiChar((D[2] and $03) shl 6 + (D[3] and $3F)); - Inc(l); - end; - end; - end; - Dec(l); - SetLength(Result, l); -end; - -{==============================================================================} -function Decode4to3Ex(const Value, Table: AnsiString): AnsiString; -var - x, y, lv: Integer; - d: integer; - dl: integer; - c: byte; - p: integer; -begin - lv := Length(Value); - SetLength(Result, lv); - x := 1; - dl := 4; - d := 0; - p := 1; - while x <= lv do - begin - y := Ord(Value[x]); - if y in [33..127] then - c := Ord(Table[y - 32]) - else - c := 64; - Inc(x); - if c > 63 then - continue; - d := (d shl 6) or c; - dec(dl); - if dl <> 0 then - continue; - Result[p] := AnsiChar((d shr 16) and $ff); - inc(p); - Result[p] := AnsiChar((d shr 8) and $ff); - inc(p); - Result[p] := AnsiChar(d and $ff); - inc(p); - d := 0; - dl := 4; - end; - case dl of - 1: - begin - d := d shr 2; - Result[p] := AnsiChar((d shr 8) and $ff); - inc(p); - Result[p] := AnsiChar(d and $ff); - inc(p); - end; - 2: - begin - d := d shr 4; - Result[p] := AnsiChar(d and $ff); - inc(p); - end; - end; - SetLength(Result, p - 1); -end; - -{==============================================================================} - -function Encode3to4(const Value, Table: AnsiString): AnsiString; -var - c: Byte; - n, l: Integer; - Count: Integer; - DOut: array[0..3] of Byte; -begin - setlength(Result, ((Length(Value) + 2) div 3) * 4); - l := 1; - Count := 1; - while Count <= Length(Value) do - begin - c := Ord(Value[Count]); - Inc(Count); - DOut[0] := (c and $FC) shr 2; - DOut[1] := (c and $03) shl 4; - if Count <= Length(Value) then - begin - c := Ord(Value[Count]); - Inc(Count); - DOut[1] := DOut[1] + (c and $F0) shr 4; - DOut[2] := (c and $0F) shl 2; - if Count <= Length(Value) then - begin - c := Ord(Value[Count]); - Inc(Count); - DOut[2] := DOut[2] + (c and $C0) shr 6; - DOut[3] := (c and $3F); - end - else - begin - DOut[3] := $40; - end; - end - else - begin - DOut[2] := $40; - DOut[3] := $40; - end; - for n := 0 to 3 do - begin - if (DOut[n] + 1) <= Length(Table) then - begin - Result[l] := Table[DOut[n] + 1]; - Inc(l); - end; - end; - end; - SetLength(Result, l - 1); -end; - -{==============================================================================} - -function DecodeBase64(const Value: AnsiString): AnsiString; -begin - Result := Decode4to3Ex(Value, ReTableBase64); -end; - -{==============================================================================} - -function EncodeBase64(const Value: AnsiString): AnsiString; -begin - Result := Encode3to4(Value, TableBase64); -end; - -{==============================================================================} - -function DecodeBase64mod(const Value: AnsiString): AnsiString; -begin - Result := Decode4to3(Value, TableBase64mod); -end; - -{==============================================================================} - -function EncodeBase64mod(const Value: AnsiString): AnsiString; -begin - Result := Encode3to4(Value, TableBase64mod); -end; - -{==============================================================================} - -function DecodeUU(const Value: AnsiString): AnsiString; -var - s: AnsiString; - uut: AnsiString; - x: Integer; -begin - Result := ''; - uut := TableUU; - s := trim(UpperCase(Value)); - if s = '' then Exit; - if Pos('BEGIN', s) = 1 then - Exit; - if Pos('END', s) = 1 then - Exit; - if Pos('TABLE', s) = 1 then - Exit; //ignore Table yet (set custom UUT) - //begin decoding - x := Pos(Value[1], uut) - 1; - case (x mod 3) of - 0: x :=(x div 3)* 4; - 1: x :=((x div 3) * 4) + 2; - 2: x :=((x div 3) * 4) + 3; - end; - //x - lenght UU line - s := Copy(Value, 2, x); - if s = '' then - Exit; - s := s + StringOfChar(' ', x - length(s)); - Result := Decode4to3(s, uut); -end; - -{==============================================================================} - -function EncodeUU(const Value: AnsiString): AnsiString; -begin - Result := ''; - if Length(Value) < Length(TableUU) then - Result := TableUU[Length(Value) + 1] + Encode3to4(Value, TableUU); -end; - -{==============================================================================} - -function DecodeXX(const Value: AnsiString): AnsiString; -var - s: AnsiString; - x: Integer; -begin - Result := ''; - s := trim(UpperCase(Value)); - if s = '' then - Exit; - if Pos('BEGIN', s) = 1 then - Exit; - if Pos('END', s) = 1 then - Exit; - //begin decoding - x := Pos(Value[1], TableXX) - 1; - case (x mod 3) of - 0: x :=(x div 3)* 4; - 1: x :=((x div 3) * 4) + 2; - 2: x :=((x div 3) * 4) + 3; - end; - //x - lenght XX line - s := Copy(Value, 2, x); - if s = '' then - Exit; - s := s + StringOfChar(' ', x - length(s)); - Result := Decode4to3(s, TableXX); -end; - -{==============================================================================} - -function DecodeYEnc(const Value: AnsiString): AnsiString; -var - C : Byte; - i: integer; -begin - Result := ''; - i := 1; - while i <= Length(Value) do - begin - c := Ord(Value[i]); - Inc(i); - if c = Ord('=') then - begin - c := Ord(Value[i]); - Inc(i); - Dec(c, 64); - end; - Dec(C, 42); - Result := Result + AnsiChar(C); - end; -end; - -{==============================================================================} - -function UpdateCrc32(Value: Byte; Crc32: Integer): Integer; -begin - Result := (Crc32 shr 8) - xor crc32tab[Byte(Value xor (Crc32 and Integer($000000FF)))]; -end; - -{==============================================================================} - -function Crc32(const Value: AnsiString): Integer; -var - n: Integer; -begin - Result := Integer($FFFFFFFF); - for n := 1 to Length(Value) do - Result := UpdateCrc32(Ord(Value[n]), Result); - Result := not Result; -end; - -{==============================================================================} - -function UpdateCrc16(Value: Byte; Crc16: Word): Word; -begin - Result := ((Crc16 shr 8) and $00FF) xor - crc16tab[Byte(Crc16 xor (Word(Value)) and $00FF)]; -end; - -{==============================================================================} - -function Crc16(const Value: AnsiString): Word; -var - n: Integer; -begin - Result := $FFFF; - for n := 1 to Length(Value) do - Result := UpdateCrc16(Ord(Value[n]), Result); -end; - -{==============================================================================} - -procedure MDInit(var MDContext: TMDCtx); -var - n: integer; -begin - MDContext.Count[0] := 0; - MDContext.Count[1] := 0; - for n := 0 to high(MDContext.BufAnsiChar) do - MDContext.BufAnsiChar[n] := 0; - for n := 0 to high(MDContext.BufLong) do - MDContext.BufLong[n] := 0; - MDContext.State[0] := Integer($67452301); - MDContext.State[1] := Integer($EFCDAB89); - MDContext.State[2] := Integer($98BADCFE); - MDContext.State[3] := Integer($10325476); -end; - -procedure MD5Transform(var Buf: array of LongInt; const Data: array of LongInt); -var - A, B, C, D: LongInt; - - procedure Round1(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte); - begin - Inc(W, (Z xor (X and (Y xor Z))) + Data); - W := (W shl S) or (W shr (32 - S)); - Inc(W, X); - end; - - procedure Round2(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte); - begin - Inc(W, (Y xor (Z and (X xor Y))) + Data); - W := (W shl S) or (W shr (32 - S)); - Inc(W, X); - end; - - procedure Round3(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte); - begin - Inc(W, (X xor Y xor Z) + Data); - W := (W shl S) or (W shr (32 - S)); - Inc(W, X); - end; - - procedure Round4(var W: LongInt; X, Y, Z, Data: LongInt; S: Byte); - begin - Inc(W, (Y xor (X or not Z)) + Data); - W := (W shl S) or (W shr (32 - S)); - Inc(W, X); - end; -begin - A := Buf[0]; - B := Buf[1]; - C := Buf[2]; - D := Buf[3]; - - Round1(A, B, C, D, Data[0] + Longint($D76AA478), 7); - Round1(D, A, B, C, Data[1] + Longint($E8C7B756), 12); - Round1(C, D, A, B, Data[2] + Longint($242070DB), 17); - Round1(B, C, D, A, Data[3] + Longint($C1BDCEEE), 22); - Round1(A, B, C, D, Data[4] + Longint($F57C0FAF), 7); - Round1(D, A, B, C, Data[5] + Longint($4787C62A), 12); - Round1(C, D, A, B, Data[6] + Longint($A8304613), 17); - Round1(B, C, D, A, Data[7] + Longint($FD469501), 22); - Round1(A, B, C, D, Data[8] + Longint($698098D8), 7); - Round1(D, A, B, C, Data[9] + Longint($8B44F7AF), 12); - Round1(C, D, A, B, Data[10] + Longint($FFFF5BB1), 17); - Round1(B, C, D, A, Data[11] + Longint($895CD7BE), 22); - Round1(A, B, C, D, Data[12] + Longint($6B901122), 7); - Round1(D, A, B, C, Data[13] + Longint($FD987193), 12); - Round1(C, D, A, B, Data[14] + Longint($A679438E), 17); - Round1(B, C, D, A, Data[15] + Longint($49B40821), 22); - - Round2(A, B, C, D, Data[1] + Longint($F61E2562), 5); - Round2(D, A, B, C, Data[6] + Longint($C040B340), 9); - Round2(C, D, A, B, Data[11] + Longint($265E5A51), 14); - Round2(B, C, D, A, Data[0] + Longint($E9B6C7AA), 20); - Round2(A, B, C, D, Data[5] + Longint($D62F105D), 5); - Round2(D, A, B, C, Data[10] + Longint($02441453), 9); - Round2(C, D, A, B, Data[15] + Longint($D8A1E681), 14); - Round2(B, C, D, A, Data[4] + Longint($E7D3FBC8), 20); - Round2(A, B, C, D, Data[9] + Longint($21E1CDE6), 5); - Round2(D, A, B, C, Data[14] + Longint($C33707D6), 9); - Round2(C, D, A, B, Data[3] + Longint($F4D50D87), 14); - Round2(B, C, D, A, Data[8] + Longint($455A14ED), 20); - Round2(A, B, C, D, Data[13] + Longint($A9E3E905), 5); - Round2(D, A, B, C, Data[2] + Longint($FCEFA3F8), 9); - Round2(C, D, A, B, Data[7] + Longint($676F02D9), 14); - Round2(B, C, D, A, Data[12] + Longint($8D2A4C8A), 20); - - Round3(A, B, C, D, Data[5] + Longint($FFFA3942), 4); - Round3(D, A, B, C, Data[8] + Longint($8771F681), 11); - Round3(C, D, A, B, Data[11] + Longint($6D9D6122), 16); - Round3(B, C, D, A, Data[14] + Longint($FDE5380C), 23); - Round3(A, B, C, D, Data[1] + Longint($A4BEEA44), 4); - Round3(D, A, B, C, Data[4] + Longint($4BDECFA9), 11); - Round3(C, D, A, B, Data[7] + Longint($F6BB4B60), 16); - Round3(B, C, D, A, Data[10] + Longint($BEBFBC70), 23); - Round3(A, B, C, D, Data[13] + Longint($289B7EC6), 4); - Round3(D, A, B, C, Data[0] + Longint($EAA127FA), 11); - Round3(C, D, A, B, Data[3] + Longint($D4EF3085), 16); - Round3(B, C, D, A, Data[6] + Longint($04881D05), 23); - Round3(A, B, C, D, Data[9] + Longint($D9D4D039), 4); - Round3(D, A, B, C, Data[12] + Longint($E6DB99E5), 11); - Round3(C, D, A, B, Data[15] + Longint($1FA27CF8), 16); - Round3(B, C, D, A, Data[2] + Longint($C4AC5665), 23); - - Round4(A, B, C, D, Data[0] + Longint($F4292244), 6); - Round4(D, A, B, C, Data[7] + Longint($432AFF97), 10); - Round4(C, D, A, B, Data[14] + Longint($AB9423A7), 15); - Round4(B, C, D, A, Data[5] + Longint($FC93A039), 21); - Round4(A, B, C, D, Data[12] + Longint($655B59C3), 6); - Round4(D, A, B, C, Data[3] + Longint($8F0CCC92), 10); - Round4(C, D, A, B, Data[10] + Longint($FFEFF47D), 15); - Round4(B, C, D, A, Data[1] + Longint($85845DD1), 21); - Round4(A, B, C, D, Data[8] + Longint($6FA87E4F), 6); - Round4(D, A, B, C, Data[15] + Longint($FE2CE6E0), 10); - Round4(C, D, A, B, Data[6] + Longint($A3014314), 15); - Round4(B, C, D, A, Data[13] + Longint($4E0811A1), 21); - Round4(A, B, C, D, Data[4] + Longint($F7537E82), 6); - Round4(D, A, B, C, Data[11] + Longint($BD3AF235), 10); - Round4(C, D, A, B, Data[2] + Longint($2AD7D2BB), 15); - Round4(B, C, D, A, Data[9] + Longint($EB86D391), 21); - - Inc(Buf[0], A); - Inc(Buf[1], B); - Inc(Buf[2], C); - Inc(Buf[3], D); -end; - -//fixed by James McAdams -procedure MDUpdate(var MDContext: TMDCtx; const Data: AnsiString; transform: TMDTransform); -var - Index, partLen, InputLen, I: integer; -{$IFDEF SYNACODE_NATIVE} - n: integer; -{$ENDIF} -begin - InputLen := Length(Data); - with MDContext do - begin - Index := (Count[0] shr 3) and $3F; - Inc(Count[0], InputLen shl 3); - if Count[0] < (InputLen shl 3) then - Inc(Count[1]); - Inc(Count[1], InputLen shr 29); - partLen := 64 - Index; - if InputLen >= partLen then - begin - ArrLongToByte(BufLong, BufAnsiChar); - {$IFDEF SYNACODE_NATIVE} - for n := 1 to partLen do - BufAnsiChar[index - 1 + n] := Ord(Data[n]); - {$ELSE} - Move(Data[1], BufAnsiChar[Index], partLen); - {$ENDIF} - ArrByteToLong(BufAnsiChar, BufLong); - Transform(State, Buflong); - I := partLen; - while I + 63 < InputLen do - begin - ArrLongToByte(BufLong, BufAnsiChar); - {$IFDEF SYNACODE_NATIVE} - for n := 1 to 64 do - BufAnsiChar[n - 1] := Ord(Data[i + n]); - {$ELSE} - Move(Data[I+1], BufAnsiChar, 64); - {$ENDIF} - ArrByteToLong(BufAnsiChar, BufLong); - Transform(State, Buflong); - inc(I, 64); - end; - Index := 0; - end - else - I := 0; - ArrLongToByte(BufLong, BufAnsiChar); - {$IFDEF SYNACODE_NATIVE} - for n := 1 to InputLen-I do - BufAnsiChar[Index + n - 1] := Ord(Data[i + n]); - {$ELSE} - Move(Data[I+1], BufAnsiChar[Index], InputLen-I); - {$ENDIF} - ArrByteToLong(BufAnsiChar, BufLong); - end -end; - -function MDFinal(var MDContext: TMDCtx; transform: TMDTransform): AnsiString; -var - Cnt: Word; - P: Byte; - digest: array[0..15] of Byte; - i: Integer; - n: integer; -begin - for I := 0 to 15 do - Digest[I] := I + 1; - with MDContext do - begin - Cnt := (Count[0] shr 3) and $3F; - P := Cnt; - BufAnsiChar[P] := $80; - Inc(P); - Cnt := 64 - 1 - Cnt; - if Cnt < 8 then - begin - for n := 0 to cnt - 1 do - BufAnsiChar[P + n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar[P], Cnt, #0); - Transform(State, BufLong); - ArrLongToByte(BufLong, BufAnsiChar); - for n := 0 to 55 do - BufAnsiChar[n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar, 56, #0); - end - else - begin - for n := 0 to Cnt - 8 - 1 do - BufAnsiChar[p + n] := 0; - ArrByteToLong(BufAnsiChar, BufLong); -// FillChar(BufAnsiChar[P], Cnt - 8, #0); - end; - BufLong[14] := Count[0]; - BufLong[15] := Count[1]; - Transform(State, BufLong); - ArrLongToByte(State, Digest); -// Move(State, Digest, 16); - Result := ''; - for i := 0 to 15 do - Result := Result + AnsiChar(digest[i]); - end; -// FillChar(MD5Context, SizeOf(TMD5Ctx), #0) -end; - -{==============================================================================} - -function MD5(const Value: AnsiString): AnsiString; -var - MDContext: TMDCtx; -begin - MDInit(MDContext); - MDUpdate(MDContext, Value, @MD5Transform); - Result := MDFinal(MDContext, @MD5Transform); -end; - -{==============================================================================} - -function HMAC_MD5(Text, Key: AnsiString): AnsiString; -var - ipad, opad, s: AnsiString; - n: Integer; - MDContext: TMDCtx; -begin - if Length(Key) > 64 then - Key := md5(Key); - ipad := StringOfChar(#$36, 64); - opad := StringOfChar(#$5C, 64); - for n := 1 to Length(Key) do - begin - ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n])); - opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n])); - end; - MDInit(MDContext); - MDUpdate(MDContext, ipad, @MD5Transform); - MDUpdate(MDContext, Text, @MD5Transform); - s := MDFinal(MDContext, @MD5Transform); - MDInit(MDContext); - MDUpdate(MDContext, opad, @MD5Transform); - MDUpdate(MDContext, s, @MD5Transform); - Result := MDFinal(MDContext, @MD5Transform); -end; - -{==============================================================================} - -function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString; -var - cnt, rest: integer; - l: integer; - n: integer; - MDContext: TMDCtx; -begin - l := length(Value); - cnt := Len div l; - rest := Len mod l; - MDInit(MDContext); - for n := 1 to cnt do - MDUpdate(MDContext, Value, @MD5Transform); - if rest > 0 then - MDUpdate(MDContext, Copy(Value, 1, rest), @MD5Transform); - Result := MDFinal(MDContext, @MD5Transform); -end; - -{==============================================================================} -// SHA1 is based on sources by Dave Barton (davebarton@bigfoot.com) - -procedure SHA1init( var SHA1Context: TSHA1Ctx ); -var - n: integer; -begin - SHA1Context.Hi := 0; - SHA1Context.Lo := 0; - SHA1Context.Index := 0; - for n := 0 to High(SHA1Context.Buffer) do - SHA1Context.Buffer[n] := 0; - for n := 0 to High(SHA1Context.HashByte) do - SHA1Context.HashByte[n] := 0; -// FillChar(SHA1Context, SizeOf(TSHA1Ctx), #0); - SHA1Context.Hash[0] := integer($67452301); - SHA1Context.Hash[1] := integer($EFCDAB89); - SHA1Context.Hash[2] := integer($98BADCFE); - SHA1Context.Hash[3] := integer($10325476); - SHA1Context.Hash[4] := integer($C3D2E1F0); -end; - -//****************************************************************************** -function RB(A: integer): integer; -begin - Result := (A shr 24) or ((A shr 8) and $FF00) or ((A shl 8) and $FF0000) or (A shl 24); -end; - -procedure SHA1Compress(var Data: TSHA1Ctx); -var - A, B, C, D, E, T: integer; - W: array[0..79] of integer; - i: integer; - n: integer; - - function F1(x, y, z: integer): integer; - begin - Result := z xor (x and (y xor z)); - end; - function F2(x, y, z: integer): integer; - begin - Result := x xor y xor z; - end; - function F3(x, y, z: integer): integer; - begin - Result := (x and y) or (z and (x or y)); - end; - function LRot32(X: integer; c: integer): integer; - begin - result := (x shl c) or (x shr (32 - c)); - end; -begin - ArrByteToLong(Data.Buffer, W); -// Move(Data.Buffer, W, Sizeof(Data.Buffer)); - for i := 0 to 15 do - W[i] := RB(W[i]); - for i := 16 to 79 do - W[i] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1); - A := Data.Hash[0]; - B := Data.Hash[1]; - C := Data.Hash[2]; - D := Data.Hash[3]; - E := Data.Hash[4]; - for i := 0 to 19 do - begin - T := LRot32(A, 5) + F1(B, C, D) + E + W[i] + integer($5A827999); - E := D; - D := C; - C := LRot32(B, 30); - B := A; - A := T; - end; - for i := 20 to 39 do - begin - T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($6ED9EBA1); - E := D; - D := C; - C := LRot32(B, 30); - B := A; - A := T; - end; - for i := 40 to 59 do - begin - T := LRot32(A, 5) + F3(B, C, D) + E + W[i] + integer($8F1BBCDC); - E := D; - D := C; - C := LRot32(B, 30); - B := A; - A := T; - end; - for i := 60 to 79 do - begin - T := LRot32(A, 5) + F2(B, C, D) + E + W[i] + integer($CA62C1D6); - E := D; - D := C; - C := LRot32(B, 30); - B := A; - A := T; - end; - Data.Hash[0] := Data.Hash[0] + A; - Data.Hash[1] := Data.Hash[1] + B; - Data.Hash[2] := Data.Hash[2] + C; - Data.Hash[3] := Data.Hash[3] + D; - Data.Hash[4] := Data.Hash[4] + E; - for n := 0 to high(w) do - w[n] := 0; -// FillChar(W, Sizeof(W), 0); - for n := 0 to high(Data.Buffer) do - Data.Buffer[n] := 0; -// FillChar(Data.Buffer, Sizeof(Data.Buffer), 0); -end; - -//****************************************************************************** -procedure SHA1Update(var Context: TSHA1Ctx; const Data: AnsiString); -var - Len: integer; - n: integer; - i, k: integer; -begin - Len := Length(data); - for k := 0 to 7 do - begin - i := Context.Lo; - Inc(Context.Lo, Len); - if Context.Lo < i then - Inc(Context.Hi); - end; - for n := 1 to len do - begin - Context.Buffer[Context.Index] := byte(Data[n]); - Inc(Context.Index); - if Context.Index = 64 then - begin - Context.Index := 0; - SHA1Compress(Context); - end; - end; -end; - -//****************************************************************************** -function SHA1Final(var Context: TSHA1Ctx): AnsiString; -type - Pinteger = ^integer; -var - i: integer; - procedure ItoArr(var Ar: Array of byte; I, value: Integer); - begin - Ar[i + 0] := Value and $000000FF; - Ar[i + 1] := (Value shr 8) and $000000FF; - Ar[i + 2] := (Value shr 16) and $000000FF; - Ar[i + 3] := (Value shr 24) and $000000FF; - end; -begin - Context.Buffer[Context.Index] := $80; - if Context.Index >= 56 then - SHA1Compress(Context); - ItoArr(Context.Buffer, 56, RB(Context.Hi)); - ItoArr(Context.Buffer, 60, RB(Context.Lo)); -// Pinteger(@Context.Buffer[56])^ := RB(Context.Hi); -// Pinteger(@Context.Buffer[60])^ := RB(Context.Lo); - SHA1Compress(Context); - Context.Hash[0] := RB(Context.Hash[0]); - Context.Hash[1] := RB(Context.Hash[1]); - Context.Hash[2] := RB(Context.Hash[2]); - Context.Hash[3] := RB(Context.Hash[3]); - Context.Hash[4] := RB(Context.Hash[4]); - ArrLongToByte(Context.Hash, Context.HashByte); - Result := ''; - for i := 0 to 19 do - Result := Result + AnsiChar(Context.HashByte[i]); -end; - -function SHA1(const Value: AnsiString): AnsiString; -var - SHA1Context: TSHA1Ctx; -begin - SHA1Init(SHA1Context); - SHA1Update(SHA1Context, Value); - Result := SHA1Final(SHA1Context); -end; - -{==============================================================================} - -function HMAC_SHA1(Text, Key: AnsiString): AnsiString; -var - ipad, opad, s: AnsiString; - n: Integer; - SHA1Context: TSHA1Ctx; -begin - if Length(Key) > 64 then - Key := SHA1(Key); - ipad := StringOfChar(#$36, 64); - opad := StringOfChar(#$5C, 64); - for n := 1 to Length(Key) do - begin - ipad[n] := AnsiChar(Byte(ipad[n]) xor Byte(Key[n])); - opad[n] := AnsiChar(Byte(opad[n]) xor Byte(Key[n])); - end; - SHA1Init(SHA1Context); - SHA1Update(SHA1Context, ipad); - SHA1Update(SHA1Context, Text); - s := SHA1Final(SHA1Context); - SHA1Init(SHA1Context); - SHA1Update(SHA1Context, opad); - SHA1Update(SHA1Context, s); - Result := SHA1Final(SHA1Context); -end; - -{==============================================================================} - -function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString; -var - cnt, rest: integer; - l: integer; - n: integer; - SHA1Context: TSHA1Ctx; -begin - l := length(Value); - cnt := Len div l; - rest := Len mod l; - SHA1Init(SHA1Context); - for n := 1 to cnt do - SHA1Update(SHA1Context, Value); - if rest > 0 then - SHA1Update(SHA1Context, Copy(Value, 1, rest)); - Result := SHA1Final(SHA1Context); -end; - -{==============================================================================} - -procedure MD4Transform(var Buf: array of LongInt; const Data: array of LongInt); -var - A, B, C, D: LongInt; - function LRot32(a, b: longint): longint; - begin - Result:= (a shl b) or (a shr (32 - b)); - end; -begin - A := Buf[0]; - B := Buf[1]; - C := Buf[2]; - D := Buf[3]; - - A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 0], 3); - D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 1], 7); - C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 2], 11); - B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 3], 19); - A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 4], 3); - D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 5], 7); - C:= LRot32(C + (B xor (D and (A xor B))) + Data[ 6], 11); - B:= LRot32(B + (A xor (C and (D xor A))) + Data[ 7], 19); - A:= LRot32(A + (D xor (B and (C xor D))) + Data[ 8], 3); - D:= LRot32(D + (C xor (A and (B xor C))) + Data[ 9], 7); - C:= LRot32(C + (B xor (D and (A xor B))) + Data[10], 11); - B:= LRot32(B + (A xor (C and (D xor A))) + Data[11], 19); - A:= LRot32(A + (D xor (B and (C xor D))) + Data[12], 3); - D:= LRot32(D + (C xor (A and (B xor C))) + Data[13], 7); - C:= LRot32(C + (B xor (D and (A xor B))) + Data[14], 11); - B:= LRot32(B + (A xor (C and (D xor A))) + Data[15], 19); - - A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 0] + longint($5a827999), 3); - D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 4] + longint($5a827999), 5); - C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 8] + longint($5a827999), 9); - B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[12] + longint($5a827999), 13); - A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 1] + longint($5a827999), 3); - D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 5] + longint($5a827999), 5); - C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[ 9] + longint($5a827999), 9); - B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[13] + longint($5a827999), 13); - A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 2] + longint($5a827999), 3); - D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 6] + longint($5a827999), 5); - C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[10] + longint($5a827999), 9); - B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[14] + longint($5a827999), 13); - A:= LRot32(A + ((B and C) or (B and D) or (C and D)) + Data[ 3] + longint($5a827999), 3); - D:= LRot32(D + ((A and B) or (A and C) or (B and C)) + Data[ 7] + longint($5a827999), 5); - C:= LRot32(C + ((D and A) or (D and B) or (A and B)) + Data[11] + longint($5a827999), 9); - B:= LRot32(B + ((C and D) or (C and A) or (D and A)) + Data[15] + longint($5a827999), 13); - - A:= LRot32(A + (B xor C xor D) + Data[ 0] + longint($6ed9eba1), 3); - D:= LRot32(D + (A xor B xor C) + Data[ 8] + longint($6ed9eba1), 9); - C:= LRot32(C + (D xor A xor B) + Data[ 4] + longint($6ed9eba1), 11); - B:= LRot32(B + (C xor D xor A) + Data[12] + longint($6ed9eba1), 15); - A:= LRot32(A + (B xor C xor D) + Data[ 2] + longint($6ed9eba1), 3); - D:= LRot32(D + (A xor B xor C) + Data[10] + longint($6ed9eba1), 9); - C:= LRot32(C + (D xor A xor B) + Data[ 6] + longint($6ed9eba1), 11); - B:= LRot32(B + (C xor D xor A) + Data[14] + longint($6ed9eba1), 15); - A:= LRot32(A + (B xor C xor D) + Data[ 1] + longint($6ed9eba1), 3); - D:= LRot32(D + (A xor B xor C) + Data[ 9] + longint($6ed9eba1), 9); - C:= LRot32(C + (D xor A xor B) + Data[ 5] + longint($6ed9eba1), 11); - B:= LRot32(B + (C xor D xor A) + Data[13] + longint($6ed9eba1), 15); - A:= LRot32(A + (B xor C xor D) + Data[ 3] + longint($6ed9eba1), 3); - D:= LRot32(D + (A xor B xor C) + Data[11] + longint($6ed9eba1), 9); - C:= LRot32(C + (D xor A xor B) + Data[ 7] + longint($6ed9eba1), 11); - B:= LRot32(B + (C xor D xor A) + Data[15] + longint($6ed9eba1), 15); - - Inc(Buf[0], A); - Inc(Buf[1], B); - Inc(Buf[2], C); - Inc(Buf[3], D); -end; - -{==============================================================================} - -function MD4(const Value: AnsiString): AnsiString; -var - MDContext: TMDCtx; -begin - MDInit(MDContext); - MDUpdate(MDContext, Value, @MD4Transform); - Result := MDFinal(MDContext, @MD4Transform); -end; - -{==============================================================================} - - -end. diff --git a/3rd/synapse/source/synacrypt.pas b/3rd/synapse/source/synacrypt.pas deleted file mode 100644 index f19d25604..000000000 --- a/3rd/synapse/source/synacrypt.pas +++ /dev/null @@ -1,2412 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.000 | -|==============================================================================| -| Content: Encryption support | -|==============================================================================| -| Copyright (c)2007-2011, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2007-2011. | -| All Rights Reserved. | -| Based on work of David Barton and Eric Young | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Encryption support) - -Implemented are DES and 3DES encryption/decryption by ECB, CBC, CFB-8bit, - CFB-block, OFB and CTR methods. -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$R-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit synacrypt; - -interface - -uses - SysUtils, Classes, synautil, synafpc; - -type - {:@abstract(Implementation of common routines block ciphers (dafault size is 64-bits)) - - Do not use this class directly, use descendants only!} - TSynaBlockCipher= class(TObject) - protected - procedure InitKey(Key: AnsiString); virtual; - function GetSize: byte; virtual; - private - IV, CV: AnsiString; - procedure IncCounter; - public - {:Sets the IV to Value and performs a reset} - procedure SetIV(const Value: AnsiString); virtual; - {:Returns the current chaining information, not the actual IV} - function GetIV: AnsiString; virtual; - {:Reset any stored chaining information} - procedure Reset; virtual; - {:Encrypt a 64-bit block of data using the ECB method of encryption} - function EncryptECB(const InData: AnsiString): AnsiString; virtual; - {:Decrypt a 64-bit block of data using the ECB method of decryption} - function DecryptECB(const InData: AnsiString): AnsiString; virtual; - {:Encrypt data using the CBC method of encryption} - function EncryptCBC(const Indata: AnsiString): AnsiString; virtual; - {:Decrypt data using the CBC method of decryption} - function DecryptCBC(const Indata: AnsiString): AnsiString; virtual; - {:Encrypt data using the CFB (8 bit) method of encryption} - function EncryptCFB8bit(const Indata: AnsiString): AnsiString; virtual; - {:Decrypt data using the CFB (8 bit) method of decryption} - function DecryptCFB8bit(const Indata: AnsiString): AnsiString; virtual; - {:Encrypt data using the CFB (block) method of encryption} - function EncryptCFBblock(const Indata: AnsiString): AnsiString; virtual; - {:Decrypt data using the CFB (block) method of decryption} - function DecryptCFBblock(const Indata: AnsiString): AnsiString; virtual; - {:Encrypt data using the OFB method of encryption} - function EncryptOFB(const Indata: AnsiString): AnsiString; virtual; - {:Decrypt data using the OFB method of decryption} - function DecryptOFB(const Indata: AnsiString): AnsiString; virtual; - {:Encrypt data using the CTR method of encryption} - function EncryptCTR(const Indata: AnsiString): AnsiString; virtual; - {:Decrypt data using the CTR method of decryption} - function DecryptCTR(const Indata: AnsiString): AnsiString; virtual; - {:Create a encryptor/decryptor instance and initialize it by the Key.} - constructor Create(Key: AnsiString); - end; - - {:@abstract(Datatype for holding one DES key data) - - This data type is used internally.} - TDesKeyData = array[0..31] of integer; - - {:@abstract(Implementation of common routines for DES encryption) - - Do not use this class directly, use descendants only!} - TSynaCustomDes = class(TSynaBlockcipher) - protected - procedure DoInit(KeyB: AnsiString; var KeyData: TDesKeyData); - function EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString; - function DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString; - end; - - {:@abstract(Implementation of DES encryption)} - TSynaDes= class(TSynaCustomDes) - protected - KeyData: TDesKeyData; - procedure InitKey(Key: AnsiString); override; - public - {:Encrypt a 64-bit block of data using the ECB method of encryption} - function EncryptECB(const InData: AnsiString): AnsiString; override; - {:Decrypt a 64-bit block of data using the ECB method of decryption} - function DecryptECB(const InData: AnsiString): AnsiString; override; - end; - - {:@abstract(Implementation of 3DES encryption)} - TSyna3Des= class(TSynaCustomDes) - protected - KeyData: array[0..2] of TDesKeyData; - procedure InitKey(Key: AnsiString); override; - public - {:Encrypt a 64-bit block of data using the ECB method of encryption} - function EncryptECB(const InData: AnsiString): AnsiString; override; - {:Decrypt a 64-bit block of data using the ECB method of decryption} - function DecryptECB(const InData: AnsiString): AnsiString; override; - end; - -const - BC = 4; - MAXROUNDS = 14; -type - {:@abstract(Implementation of AES encryption)} - TSynaAes= class(TSynaBlockcipher) - protected - numrounds: longword; - rk, drk: array[0..MAXROUNDS,0..7] of longword; - procedure InitKey(Key: AnsiString); override; - function GetSize: byte; override; - public - {:Encrypt a 128-bit block of data using the ECB method of encryption} - function EncryptECB(const InData: AnsiString): AnsiString; override; - {:Decrypt a 128-bit block of data using the ECB method of decryption} - function DecryptECB(const InData: AnsiString): AnsiString; override; - end; - -{:Call internal test of all DES encryptions. Returns @true if all is OK.} -function TestDes: boolean; -{:Call internal test of all 3DES encryptions. Returns @true if all is OK.} -function Test3Des: boolean; -{:Call internal test of all AES encryptions. Returns @true if all is OK.} -function TestAes: boolean; - -{==============================================================================} -implementation - -//DES consts -const - shifts2: array[0..15]of byte= - (0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0); - - des_skb: array[0..7,0..63]of integer=( - ( - (* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 *) - integer($00000000),integer($00000010),integer($20000000),integer($20000010), - integer($00010000),integer($00010010),integer($20010000),integer($20010010), - integer($00000800),integer($00000810),integer($20000800),integer($20000810), - integer($00010800),integer($00010810),integer($20010800),integer($20010810), - integer($00000020),integer($00000030),integer($20000020),integer($20000030), - integer($00010020),integer($00010030),integer($20010020),integer($20010030), - integer($00000820),integer($00000830),integer($20000820),integer($20000830), - integer($00010820),integer($00010830),integer($20010820),integer($20010830), - integer($00080000),integer($00080010),integer($20080000),integer($20080010), - integer($00090000),integer($00090010),integer($20090000),integer($20090010), - integer($00080800),integer($00080810),integer($20080800),integer($20080810), - integer($00090800),integer($00090810),integer($20090800),integer($20090810), - integer($00080020),integer($00080030),integer($20080020),integer($20080030), - integer($00090020),integer($00090030),integer($20090020),integer($20090030), - integer($00080820),integer($00080830),integer($20080820),integer($20080830), - integer($00090820),integer($00090830),integer($20090820),integer($20090830) - ),( - (* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 *) - integer($00000000),integer($02000000),integer($00002000),integer($02002000), - integer($00200000),integer($02200000),integer($00202000),integer($02202000), - integer($00000004),integer($02000004),integer($00002004),integer($02002004), - integer($00200004),integer($02200004),integer($00202004),integer($02202004), - integer($00000400),integer($02000400),integer($00002400),integer($02002400), - integer($00200400),integer($02200400),integer($00202400),integer($02202400), - integer($00000404),integer($02000404),integer($00002404),integer($02002404), - integer($00200404),integer($02200404),integer($00202404),integer($02202404), - integer($10000000),integer($12000000),integer($10002000),integer($12002000), - integer($10200000),integer($12200000),integer($10202000),integer($12202000), - integer($10000004),integer($12000004),integer($10002004),integer($12002004), - integer($10200004),integer($12200004),integer($10202004),integer($12202004), - integer($10000400),integer($12000400),integer($10002400),integer($12002400), - integer($10200400),integer($12200400),integer($10202400),integer($12202400), - integer($10000404),integer($12000404),integer($10002404),integer($12002404), - integer($10200404),integer($12200404),integer($10202404),integer($12202404) - ),( - (* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 *) - integer($00000000),integer($00000001),integer($00040000),integer($00040001), - integer($01000000),integer($01000001),integer($01040000),integer($01040001), - integer($00000002),integer($00000003),integer($00040002),integer($00040003), - integer($01000002),integer($01000003),integer($01040002),integer($01040003), - integer($00000200),integer($00000201),integer($00040200),integer($00040201), - integer($01000200),integer($01000201),integer($01040200),integer($01040201), - integer($00000202),integer($00000203),integer($00040202),integer($00040203), - integer($01000202),integer($01000203),integer($01040202),integer($01040203), - integer($08000000),integer($08000001),integer($08040000),integer($08040001), - integer($09000000),integer($09000001),integer($09040000),integer($09040001), - integer($08000002),integer($08000003),integer($08040002),integer($08040003), - integer($09000002),integer($09000003),integer($09040002),integer($09040003), - integer($08000200),integer($08000201),integer($08040200),integer($08040201), - integer($09000200),integer($09000201),integer($09040200),integer($09040201), - integer($08000202),integer($08000203),integer($08040202),integer($08040203), - integer($09000202),integer($09000203),integer($09040202),integer($09040203) - ),( - (* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 *) - integer($00000000),integer($00100000),integer($00000100),integer($00100100), - integer($00000008),integer($00100008),integer($00000108),integer($00100108), - integer($00001000),integer($00101000),integer($00001100),integer($00101100), - integer($00001008),integer($00101008),integer($00001108),integer($00101108), - integer($04000000),integer($04100000),integer($04000100),integer($04100100), - integer($04000008),integer($04100008),integer($04000108),integer($04100108), - integer($04001000),integer($04101000),integer($04001100),integer($04101100), - integer($04001008),integer($04101008),integer($04001108),integer($04101108), - integer($00020000),integer($00120000),integer($00020100),integer($00120100), - integer($00020008),integer($00120008),integer($00020108),integer($00120108), - integer($00021000),integer($00121000),integer($00021100),integer($00121100), - integer($00021008),integer($00121008),integer($00021108),integer($00121108), - integer($04020000),integer($04120000),integer($04020100),integer($04120100), - integer($04020008),integer($04120008),integer($04020108),integer($04120108), - integer($04021000),integer($04121000),integer($04021100),integer($04121100), - integer($04021008),integer($04121008),integer($04021108),integer($04121108) - ),( - (* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 *) - integer($00000000),integer($10000000),integer($00010000),integer($10010000), - integer($00000004),integer($10000004),integer($00010004),integer($10010004), - integer($20000000),integer($30000000),integer($20010000),integer($30010000), - integer($20000004),integer($30000004),integer($20010004),integer($30010004), - integer($00100000),integer($10100000),integer($00110000),integer($10110000), - integer($00100004),integer($10100004),integer($00110004),integer($10110004), - integer($20100000),integer($30100000),integer($20110000),integer($30110000), - integer($20100004),integer($30100004),integer($20110004),integer($30110004), - integer($00001000),integer($10001000),integer($00011000),integer($10011000), - integer($00001004),integer($10001004),integer($00011004),integer($10011004), - integer($20001000),integer($30001000),integer($20011000),integer($30011000), - integer($20001004),integer($30001004),integer($20011004),integer($30011004), - integer($00101000),integer($10101000),integer($00111000),integer($10111000), - integer($00101004),integer($10101004),integer($00111004),integer($10111004), - integer($20101000),integer($30101000),integer($20111000),integer($30111000), - integer($20101004),integer($30101004),integer($20111004),integer($30111004) - ),( - (* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 *) - integer($00000000),integer($08000000),integer($00000008),integer($08000008), - integer($00000400),integer($08000400),integer($00000408),integer($08000408), - integer($00020000),integer($08020000),integer($00020008),integer($08020008), - integer($00020400),integer($08020400),integer($00020408),integer($08020408), - integer($00000001),integer($08000001),integer($00000009),integer($08000009), - integer($00000401),integer($08000401),integer($00000409),integer($08000409), - integer($00020001),integer($08020001),integer($00020009),integer($08020009), - integer($00020401),integer($08020401),integer($00020409),integer($08020409), - integer($02000000),integer($0A000000),integer($02000008),integer($0A000008), - integer($02000400),integer($0A000400),integer($02000408),integer($0A000408), - integer($02020000),integer($0A020000),integer($02020008),integer($0A020008), - integer($02020400),integer($0A020400),integer($02020408),integer($0A020408), - integer($02000001),integer($0A000001),integer($02000009),integer($0A000009), - integer($02000401),integer($0A000401),integer($02000409),integer($0A000409), - integer($02020001),integer($0A020001),integer($02020009),integer($0A020009), - integer($02020401),integer($0A020401),integer($02020409),integer($0A020409) - ),( - (* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 *) - integer($00000000),integer($00000100),integer($00080000),integer($00080100), - integer($01000000),integer($01000100),integer($01080000),integer($01080100), - integer($00000010),integer($00000110),integer($00080010),integer($00080110), - integer($01000010),integer($01000110),integer($01080010),integer($01080110), - integer($00200000),integer($00200100),integer($00280000),integer($00280100), - integer($01200000),integer($01200100),integer($01280000),integer($01280100), - integer($00200010),integer($00200110),integer($00280010),integer($00280110), - integer($01200010),integer($01200110),integer($01280010),integer($01280110), - integer($00000200),integer($00000300),integer($00080200),integer($00080300), - integer($01000200),integer($01000300),integer($01080200),integer($01080300), - integer($00000210),integer($00000310),integer($00080210),integer($00080310), - integer($01000210),integer($01000310),integer($01080210),integer($01080310), - integer($00200200),integer($00200300),integer($00280200),integer($00280300), - integer($01200200),integer($01200300),integer($01280200),integer($01280300), - integer($00200210),integer($00200310),integer($00280210),integer($00280310), - integer($01200210),integer($01200310),integer($01280210),integer($01280310) - ),( - (* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 *) - integer($00000000),integer($04000000),integer($00040000),integer($04040000), - integer($00000002),integer($04000002),integer($00040002),integer($04040002), - integer($00002000),integer($04002000),integer($00042000),integer($04042000), - integer($00002002),integer($04002002),integer($00042002),integer($04042002), - integer($00000020),integer($04000020),integer($00040020),integer($04040020), - integer($00000022),integer($04000022),integer($00040022),integer($04040022), - integer($00002020),integer($04002020),integer($00042020),integer($04042020), - integer($00002022),integer($04002022),integer($00042022),integer($04042022), - integer($00000800),integer($04000800),integer($00040800),integer($04040800), - integer($00000802),integer($04000802),integer($00040802),integer($04040802), - integer($00002800),integer($04002800),integer($00042800),integer($04042800), - integer($00002802),integer($04002802),integer($00042802),integer($04042802), - integer($00000820),integer($04000820),integer($00040820),integer($04040820), - integer($00000822),integer($04000822),integer($00040822),integer($04040822), - integer($00002820),integer($04002820),integer($00042820),integer($04042820), - integer($00002822),integer($04002822),integer($00042822),integer($04042822) - )); - - des_sptrans: array[0..7,0..63] of integer=( - ( - (* nibble 0 *) - integer($02080800), integer($00080000), integer($02000002), integer($02080802), - integer($02000000), integer($00080802), integer($00080002), integer($02000002), - integer($00080802), integer($02080800), integer($02080000), integer($00000802), - integer($02000802), integer($02000000), integer($00000000), integer($00080002), - integer($00080000), integer($00000002), integer($02000800), integer($00080800), - integer($02080802), integer($02080000), integer($00000802), integer($02000800), - integer($00000002), integer($00000800), integer($00080800), integer($02080002), - integer($00000800), integer($02000802), integer($02080002), integer($00000000), - integer($00000000), integer($02080802), integer($02000800), integer($00080002), - integer($02080800), integer($00080000), integer($00000802), integer($02000800), - integer($02080002), integer($00000800), integer($00080800), integer($02000002), - integer($00080802), integer($00000002), integer($02000002), integer($02080000), - integer($02080802), integer($00080800), integer($02080000), integer($02000802), - integer($02000000), integer($00000802), integer($00080002), integer($00000000), - integer($00080000), integer($02000000), integer($02000802), integer($02080800), - integer($00000002), integer($02080002), integer($00000800), integer($00080802) - ),( - (* nibble 1 *) - integer($40108010), integer($00000000), integer($00108000), integer($40100000), - integer($40000010), integer($00008010), integer($40008000), integer($00108000), - integer($00008000), integer($40100010), integer($00000010), integer($40008000), - integer($00100010), integer($40108000), integer($40100000), integer($00000010), - integer($00100000), integer($40008010), integer($40100010), integer($00008000), - integer($00108010), integer($40000000), integer($00000000), integer($00100010), - integer($40008010), integer($00108010), integer($40108000), integer($40000010), - integer($40000000), integer($00100000), integer($00008010), integer($40108010), - integer($00100010), integer($40108000), integer($40008000), integer($00108010), - integer($40108010), integer($00100010), integer($40000010), integer($00000000), - integer($40000000), integer($00008010), integer($00100000), integer($40100010), - integer($00008000), integer($40000000), integer($00108010), integer($40008010), - integer($40108000), integer($00008000), integer($00000000), integer($40000010), - integer($00000010), integer($40108010), integer($00108000), integer($40100000), - integer($40100010), integer($00100000), integer($00008010), integer($40008000), - integer($40008010), integer($00000010), integer($40100000), integer($00108000) - ),( - (* nibble 2 *) - integer($04000001), integer($04040100), integer($00000100), integer($04000101), - integer($00040001), integer($04000000), integer($04000101), integer($00040100), - integer($04000100), integer($00040000), integer($04040000), integer($00000001), - integer($04040101), integer($00000101), integer($00000001), integer($04040001), - integer($00000000), integer($00040001), integer($04040100), integer($00000100), - integer($00000101), integer($04040101), integer($00040000), integer($04000001), - integer($04040001), integer($04000100), integer($00040101), integer($04040000), - integer($00040100), integer($00000000), integer($04000000), integer($00040101), - integer($04040100), integer($00000100), integer($00000001), integer($00040000), - integer($00000101), integer($00040001), integer($04040000), integer($04000101), - integer($00000000), integer($04040100), integer($00040100), integer($04040001), - integer($00040001), integer($04000000), integer($04040101), integer($00000001), - integer($00040101), integer($04000001), integer($04000000), integer($04040101), - integer($00040000), integer($04000100), integer($04000101), integer($00040100), - integer($04000100), integer($00000000), integer($04040001), integer($00000101), - integer($04000001), integer($00040101), integer($00000100), integer($04040000) - ),( - (* nibble 3 *) - integer($00401008), integer($10001000), integer($00000008), integer($10401008), - integer($00000000), integer($10400000), integer($10001008), integer($00400008), - integer($10401000), integer($10000008), integer($10000000), integer($00001008), - integer($10000008), integer($00401008), integer($00400000), integer($10000000), - integer($10400008), integer($00401000), integer($00001000), integer($00000008), - integer($00401000), integer($10001008), integer($10400000), integer($00001000), - integer($00001008), integer($00000000), integer($00400008), integer($10401000), - integer($10001000), integer($10400008), integer($10401008), integer($00400000), - integer($10400008), integer($00001008), integer($00400000), integer($10000008), - integer($00401000), integer($10001000), integer($00000008), integer($10400000), - integer($10001008), integer($00000000), integer($00001000), integer($00400008), - integer($00000000), integer($10400008), integer($10401000), integer($00001000), - integer($10000000), integer($10401008), integer($00401008), integer($00400000), - integer($10401008), integer($00000008), integer($10001000), integer($00401008), - integer($00400008), integer($00401000), integer($10400000), integer($10001008), - integer($00001008), integer($10000000), integer($10000008), integer($10401000) - ),( - (* nibble 4 *) - integer($08000000), integer($00010000), integer($00000400), integer($08010420), - integer($08010020), integer($08000400), integer($00010420), integer($08010000), - integer($00010000), integer($00000020), integer($08000020), integer($00010400), - integer($08000420), integer($08010020), integer($08010400), integer($00000000), - integer($00010400), integer($08000000), integer($00010020), integer($00000420), - integer($08000400), integer($00010420), integer($00000000), integer($08000020), - integer($00000020), integer($08000420), integer($08010420), integer($00010020), - integer($08010000), integer($00000400), integer($00000420), integer($08010400), - integer($08010400), integer($08000420), integer($00010020), integer($08010000), - integer($00010000), integer($00000020), integer($08000020), integer($08000400), - integer($08000000), integer($00010400), integer($08010420), integer($00000000), - integer($00010420), integer($08000000), integer($00000400), integer($00010020), - integer($08000420), integer($00000400), integer($00000000), integer($08010420), - integer($08010020), integer($08010400), integer($00000420), integer($00010000), - integer($00010400), integer($08010020), integer($08000400), integer($00000420), - integer($00000020), integer($00010420), integer($08010000), integer($08000020) - ),( - (* nibble 5 *) - integer($80000040), integer($00200040), integer($00000000), integer($80202000), - integer($00200040), integer($00002000), integer($80002040), integer($00200000), - integer($00002040), integer($80202040), integer($00202000), integer($80000000), - integer($80002000), integer($80000040), integer($80200000), integer($00202040), - integer($00200000), integer($80002040), integer($80200040), integer($00000000), - integer($00002000), integer($00000040), integer($80202000), integer($80200040), - integer($80202040), integer($80200000), integer($80000000), integer($00002040), - integer($00000040), integer($00202000), integer($00202040), integer($80002000), - integer($00002040), integer($80000000), integer($80002000), integer($00202040), - integer($80202000), integer($00200040), integer($00000000), integer($80002000), - integer($80000000), integer($00002000), integer($80200040), integer($00200000), - integer($00200040), integer($80202040), integer($00202000), integer($00000040), - integer($80202040), integer($00202000), integer($00200000), integer($80002040), - integer($80000040), integer($80200000), integer($00202040), integer($00000000), - integer($00002000), integer($80000040), integer($80002040), integer($80202000), - integer($80200000), integer($00002040), integer($00000040), integer($80200040) - ),( - (* nibble 6 *) - integer($00004000), integer($00000200), integer($01000200), integer($01000004), - integer($01004204), integer($00004004), integer($00004200), integer($00000000), - integer($01000000), integer($01000204), integer($00000204), integer($01004000), - integer($00000004), integer($01004200), integer($01004000), integer($00000204), - integer($01000204), integer($00004000), integer($00004004), integer($01004204), - integer($00000000), integer($01000200), integer($01000004), integer($00004200), - integer($01004004), integer($00004204), integer($01004200), integer($00000004), - integer($00004204), integer($01004004), integer($00000200), integer($01000000), - integer($00004204), integer($01004000), integer($01004004), integer($00000204), - integer($00004000), integer($00000200), integer($01000000), integer($01004004), - integer($01000204), integer($00004204), integer($00004200), integer($00000000), - integer($00000200), integer($01000004), integer($00000004), integer($01000200), - integer($00000000), integer($01000204), integer($01000200), integer($00004200), - integer($00000204), integer($00004000), integer($01004204), integer($01000000), - integer($01004200), integer($00000004), integer($00004004), integer($01004204), - integer($01000004), integer($01004200), integer($01004000), integer($00004004) - ),( - (* nibble 7 *) - integer($20800080), integer($20820000), integer($00020080), integer($00000000), - integer($20020000), integer($00800080), integer($20800000), integer($20820080), - integer($00000080), integer($20000000), integer($00820000), integer($00020080), - integer($00820080), integer($20020080), integer($20000080), integer($20800000), - integer($00020000), integer($00820080), integer($00800080), integer($20020000), - integer($20820080), integer($20000080), integer($00000000), integer($00820000), - integer($20000000), integer($00800000), integer($20020080), integer($20800080), - integer($00800000), integer($00020000), integer($20820000), integer($00000080), - integer($00800000), integer($00020000), integer($20000080), integer($20820080), - integer($00020080), integer($20000000), integer($00000000), integer($00820000), - integer($20800080), integer($20020080), integer($20020000), integer($00800080), - integer($20820000), integer($00000080), integer($00800080), integer($20020000), - integer($20820080), integer($00800000), integer($20800000), integer($20000080), - integer($00820000), integer($00020080), integer($20020080), integer($20800000), - integer($00000080), integer($20820000), integer($00820080), integer($00000000), - integer($20000000), integer($20800080), integer($00020000), integer($00820080) - )); - -//AES consts -const - MAXBC= 8; - MAXKC= 8; - - S: array[0..255] of byte= ( - 99, 124, 119, 123, 242, 107, 111, 197, 48, 1, 103, 43, 254, 215, 171, 118, - 202, 130, 201, 125, 250, 89, 71, 240, 173, 212, 162, 175, 156, 164, 114, 192, - 183, 253, 147, 38, 54, 63, 247, 204, 52, 165, 229, 241, 113, 216, 49, 21, - 4, 199, 35, 195, 24, 150, 5, 154, 7, 18, 128, 226, 235, 39, 178, 117, - 9, 131, 44, 26, 27, 110, 90, 160, 82, 59, 214, 179, 41, 227, 47, 132, - 83, 209, 0, 237, 32, 252, 177, 91, 106, 203, 190, 57, 74, 76, 88, 207, - 208, 239, 170, 251, 67, 77, 51, 133, 69, 249, 2, 127, 80, 60, 159, 168, - 81, 163, 64, 143, 146, 157, 56, 245, 188, 182, 218, 33, 16, 255, 243, 210, - 205, 12, 19, 236, 95, 151, 68, 23, 196, 167, 126, 61, 100, 93, 25, 115, - 96, 129, 79, 220, 34, 42, 144, 136, 70, 238, 184, 20, 222, 94, 11, 219, - 224, 50, 58, 10, 73, 6, 36, 92, 194, 211, 172, 98, 145, 149, 228, 121, - 231, 200, 55, 109, 141, 213, 78, 169, 108, 86, 244, 234, 101, 122, 174, 8, - 186, 120, 37, 46, 28, 166, 180, 198, 232, 221, 116, 31, 75, 189, 139, 138, - 112, 62, 181, 102, 72, 3, 246, 14, 97, 53, 87, 185, 134, 193, 29, 158, - 225, 248, 152, 17, 105, 217, 142, 148, 155, 30, 135, 233, 206, 85, 40, 223, - 140, 161, 137, 13, 191, 230, 66, 104, 65, 153, 45, 15, 176, 84, 187, 22); - T1: array[0..255,0..3] of byte= ( - ($c6,$63,$63,$a5), ($f8,$7c,$7c,$84), ($ee,$77,$77,$99), ($f6,$7b,$7b,$8d), - ($ff,$f2,$f2,$0d), ($d6,$6b,$6b,$bd), ($de,$6f,$6f,$b1), ($91,$c5,$c5,$54), - ($60,$30,$30,$50), ($02,$01,$01,$03), ($ce,$67,$67,$a9), ($56,$2b,$2b,$7d), - ($e7,$fe,$fe,$19), ($b5,$d7,$d7,$62), ($4d,$ab,$ab,$e6), ($ec,$76,$76,$9a), - ($8f,$ca,$ca,$45), ($1f,$82,$82,$9d), ($89,$c9,$c9,$40), ($fa,$7d,$7d,$87), - ($ef,$fa,$fa,$15), ($b2,$59,$59,$eb), ($8e,$47,$47,$c9), ($fb,$f0,$f0,$0b), - ($41,$ad,$ad,$ec), ($b3,$d4,$d4,$67), ($5f,$a2,$a2,$fd), ($45,$af,$af,$ea), - ($23,$9c,$9c,$bf), ($53,$a4,$a4,$f7), ($e4,$72,$72,$96), ($9b,$c0,$c0,$5b), - ($75,$b7,$b7,$c2), ($e1,$fd,$fd,$1c), ($3d,$93,$93,$ae), ($4c,$26,$26,$6a), - ($6c,$36,$36,$5a), ($7e,$3f,$3f,$41), ($f5,$f7,$f7,$02), ($83,$cc,$cc,$4f), - ($68,$34,$34,$5c), ($51,$a5,$a5,$f4), ($d1,$e5,$e5,$34), ($f9,$f1,$f1,$08), - ($e2,$71,$71,$93), ($ab,$d8,$d8,$73), ($62,$31,$31,$53), ($2a,$15,$15,$3f), - ($08,$04,$04,$0c), ($95,$c7,$c7,$52), ($46,$23,$23,$65), ($9d,$c3,$c3,$5e), - ($30,$18,$18,$28), ($37,$96,$96,$a1), ($0a,$05,$05,$0f), ($2f,$9a,$9a,$b5), - ($0e,$07,$07,$09), ($24,$12,$12,$36), ($1b,$80,$80,$9b), ($df,$e2,$e2,$3d), - ($cd,$eb,$eb,$26), ($4e,$27,$27,$69), ($7f,$b2,$b2,$cd), ($ea,$75,$75,$9f), - ($12,$09,$09,$1b), ($1d,$83,$83,$9e), ($58,$2c,$2c,$74), ($34,$1a,$1a,$2e), - ($36,$1b,$1b,$2d), ($dc,$6e,$6e,$b2), ($b4,$5a,$5a,$ee), ($5b,$a0,$a0,$fb), - ($a4,$52,$52,$f6), ($76,$3b,$3b,$4d), ($b7,$d6,$d6,$61), ($7d,$b3,$b3,$ce), - ($52,$29,$29,$7b), ($dd,$e3,$e3,$3e), ($5e,$2f,$2f,$71), ($13,$84,$84,$97), - ($a6,$53,$53,$f5), ($b9,$d1,$d1,$68), ($00,$00,$00,$00), ($c1,$ed,$ed,$2c), - ($40,$20,$20,$60), ($e3,$fc,$fc,$1f), ($79,$b1,$b1,$c8), ($b6,$5b,$5b,$ed), - ($d4,$6a,$6a,$be), ($8d,$cb,$cb,$46), ($67,$be,$be,$d9), ($72,$39,$39,$4b), - ($94,$4a,$4a,$de), ($98,$4c,$4c,$d4), ($b0,$58,$58,$e8), ($85,$cf,$cf,$4a), - ($bb,$d0,$d0,$6b), ($c5,$ef,$ef,$2a), ($4f,$aa,$aa,$e5), ($ed,$fb,$fb,$16), - ($86,$43,$43,$c5), ($9a,$4d,$4d,$d7), ($66,$33,$33,$55), ($11,$85,$85,$94), - ($8a,$45,$45,$cf), ($e9,$f9,$f9,$10), ($04,$02,$02,$06), ($fe,$7f,$7f,$81), - ($a0,$50,$50,$f0), ($78,$3c,$3c,$44), ($25,$9f,$9f,$ba), ($4b,$a8,$a8,$e3), - ($a2,$51,$51,$f3), ($5d,$a3,$a3,$fe), ($80,$40,$40,$c0), ($05,$8f,$8f,$8a), - ($3f,$92,$92,$ad), ($21,$9d,$9d,$bc), ($70,$38,$38,$48), ($f1,$f5,$f5,$04), - ($63,$bc,$bc,$df), ($77,$b6,$b6,$c1), ($af,$da,$da,$75), ($42,$21,$21,$63), - ($20,$10,$10,$30), ($e5,$ff,$ff,$1a), ($fd,$f3,$f3,$0e), ($bf,$d2,$d2,$6d), - ($81,$cd,$cd,$4c), ($18,$0c,$0c,$14), ($26,$13,$13,$35), ($c3,$ec,$ec,$2f), - ($be,$5f,$5f,$e1), ($35,$97,$97,$a2), ($88,$44,$44,$cc), ($2e,$17,$17,$39), - ($93,$c4,$c4,$57), ($55,$a7,$a7,$f2), ($fc,$7e,$7e,$82), ($7a,$3d,$3d,$47), - ($c8,$64,$64,$ac), ($ba,$5d,$5d,$e7), ($32,$19,$19,$2b), ($e6,$73,$73,$95), - ($c0,$60,$60,$a0), ($19,$81,$81,$98), ($9e,$4f,$4f,$d1), ($a3,$dc,$dc,$7f), - ($44,$22,$22,$66), ($54,$2a,$2a,$7e), ($3b,$90,$90,$ab), ($0b,$88,$88,$83), - ($8c,$46,$46,$ca), ($c7,$ee,$ee,$29), ($6b,$b8,$b8,$d3), ($28,$14,$14,$3c), - ($a7,$de,$de,$79), ($bc,$5e,$5e,$e2), ($16,$0b,$0b,$1d), ($ad,$db,$db,$76), - ($db,$e0,$e0,$3b), ($64,$32,$32,$56), ($74,$3a,$3a,$4e), ($14,$0a,$0a,$1e), - ($92,$49,$49,$db), ($0c,$06,$06,$0a), ($48,$24,$24,$6c), ($b8,$5c,$5c,$e4), - ($9f,$c2,$c2,$5d), ($bd,$d3,$d3,$6e), ($43,$ac,$ac,$ef), ($c4,$62,$62,$a6), - ($39,$91,$91,$a8), ($31,$95,$95,$a4), ($d3,$e4,$e4,$37), ($f2,$79,$79,$8b), - ($d5,$e7,$e7,$32), ($8b,$c8,$c8,$43), ($6e,$37,$37,$59), ($da,$6d,$6d,$b7), - ($01,$8d,$8d,$8c), ($b1,$d5,$d5,$64), ($9c,$4e,$4e,$d2), ($49,$a9,$a9,$e0), - ($d8,$6c,$6c,$b4), ($ac,$56,$56,$fa), ($f3,$f4,$f4,$07), ($cf,$ea,$ea,$25), - ($ca,$65,$65,$af), ($f4,$7a,$7a,$8e), ($47,$ae,$ae,$e9), ($10,$08,$08,$18), - ($6f,$ba,$ba,$d5), ($f0,$78,$78,$88), ($4a,$25,$25,$6f), ($5c,$2e,$2e,$72), - ($38,$1c,$1c,$24), ($57,$a6,$a6,$f1), ($73,$b4,$b4,$c7), ($97,$c6,$c6,$51), - ($cb,$e8,$e8,$23), ($a1,$dd,$dd,$7c), ($e8,$74,$74,$9c), ($3e,$1f,$1f,$21), - ($96,$4b,$4b,$dd), ($61,$bd,$bd,$dc), ($0d,$8b,$8b,$86), ($0f,$8a,$8a,$85), - ($e0,$70,$70,$90), ($7c,$3e,$3e,$42), ($71,$b5,$b5,$c4), ($cc,$66,$66,$aa), - ($90,$48,$48,$d8), ($06,$03,$03,$05), ($f7,$f6,$f6,$01), ($1c,$0e,$0e,$12), - ($c2,$61,$61,$a3), ($6a,$35,$35,$5f), ($ae,$57,$57,$f9), ($69,$b9,$b9,$d0), - ($17,$86,$86,$91), ($99,$c1,$c1,$58), ($3a,$1d,$1d,$27), ($27,$9e,$9e,$b9), - ($d9,$e1,$e1,$38), ($eb,$f8,$f8,$13), ($2b,$98,$98,$b3), ($22,$11,$11,$33), - ($d2,$69,$69,$bb), ($a9,$d9,$d9,$70), ($07,$8e,$8e,$89), ($33,$94,$94,$a7), - ($2d,$9b,$9b,$b6), ($3c,$1e,$1e,$22), ($15,$87,$87,$92), ($c9,$e9,$e9,$20), - ($87,$ce,$ce,$49), ($aa,$55,$55,$ff), ($50,$28,$28,$78), ($a5,$df,$df,$7a), - ($03,$8c,$8c,$8f), ($59,$a1,$a1,$f8), ($09,$89,$89,$80), ($1a,$0d,$0d,$17), - ($65,$bf,$bf,$da), ($d7,$e6,$e6,$31), ($84,$42,$42,$c6), ($d0,$68,$68,$b8), - ($82,$41,$41,$c3), ($29,$99,$99,$b0), ($5a,$2d,$2d,$77), ($1e,$0f,$0f,$11), - ($7b,$b0,$b0,$cb), ($a8,$54,$54,$fc), ($6d,$bb,$bb,$d6), ($2c,$16,$16,$3a)); - T2: array[0..255,0..3] of byte= ( - ($a5,$c6,$63,$63), ($84,$f8,$7c,$7c), ($99,$ee,$77,$77), ($8d,$f6,$7b,$7b), - ($0d,$ff,$f2,$f2), ($bd,$d6,$6b,$6b), ($b1,$de,$6f,$6f), ($54,$91,$c5,$c5), - ($50,$60,$30,$30), ($03,$02,$01,$01), ($a9,$ce,$67,$67), ($7d,$56,$2b,$2b), - ($19,$e7,$fe,$fe), ($62,$b5,$d7,$d7), ($e6,$4d,$ab,$ab), ($9a,$ec,$76,$76), - ($45,$8f,$ca,$ca), ($9d,$1f,$82,$82), ($40,$89,$c9,$c9), ($87,$fa,$7d,$7d), - ($15,$ef,$fa,$fa), ($eb,$b2,$59,$59), ($c9,$8e,$47,$47), ($0b,$fb,$f0,$f0), - ($ec,$41,$ad,$ad), ($67,$b3,$d4,$d4), ($fd,$5f,$a2,$a2), ($ea,$45,$af,$af), - ($bf,$23,$9c,$9c), ($f7,$53,$a4,$a4), ($96,$e4,$72,$72), ($5b,$9b,$c0,$c0), - ($c2,$75,$b7,$b7), ($1c,$e1,$fd,$fd), ($ae,$3d,$93,$93), ($6a,$4c,$26,$26), - ($5a,$6c,$36,$36), ($41,$7e,$3f,$3f), ($02,$f5,$f7,$f7), ($4f,$83,$cc,$cc), - ($5c,$68,$34,$34), ($f4,$51,$a5,$a5), ($34,$d1,$e5,$e5), ($08,$f9,$f1,$f1), - ($93,$e2,$71,$71), ($73,$ab,$d8,$d8), ($53,$62,$31,$31), ($3f,$2a,$15,$15), - ($0c,$08,$04,$04), ($52,$95,$c7,$c7), ($65,$46,$23,$23), ($5e,$9d,$c3,$c3), - ($28,$30,$18,$18), ($a1,$37,$96,$96), ($0f,$0a,$05,$05), ($b5,$2f,$9a,$9a), - ($09,$0e,$07,$07), ($36,$24,$12,$12), ($9b,$1b,$80,$80), ($3d,$df,$e2,$e2), - ($26,$cd,$eb,$eb), ($69,$4e,$27,$27), ($cd,$7f,$b2,$b2), ($9f,$ea,$75,$75), - ($1b,$12,$09,$09), ($9e,$1d,$83,$83), ($74,$58,$2c,$2c), ($2e,$34,$1a,$1a), - ($2d,$36,$1b,$1b), ($b2,$dc,$6e,$6e), ($ee,$b4,$5a,$5a), ($fb,$5b,$a0,$a0), - ($f6,$a4,$52,$52), ($4d,$76,$3b,$3b), ($61,$b7,$d6,$d6), ($ce,$7d,$b3,$b3), - ($7b,$52,$29,$29), ($3e,$dd,$e3,$e3), ($71,$5e,$2f,$2f), ($97,$13,$84,$84), - ($f5,$a6,$53,$53), ($68,$b9,$d1,$d1), ($00,$00,$00,$00), ($2c,$c1,$ed,$ed), - ($60,$40,$20,$20), ($1f,$e3,$fc,$fc), ($c8,$79,$b1,$b1), ($ed,$b6,$5b,$5b), - ($be,$d4,$6a,$6a), ($46,$8d,$cb,$cb), ($d9,$67,$be,$be), ($4b,$72,$39,$39), - ($de,$94,$4a,$4a), ($d4,$98,$4c,$4c), ($e8,$b0,$58,$58), ($4a,$85,$cf,$cf), - ($6b,$bb,$d0,$d0), ($2a,$c5,$ef,$ef), ($e5,$4f,$aa,$aa), ($16,$ed,$fb,$fb), - ($c5,$86,$43,$43), ($d7,$9a,$4d,$4d), ($55,$66,$33,$33), ($94,$11,$85,$85), - ($cf,$8a,$45,$45), ($10,$e9,$f9,$f9), ($06,$04,$02,$02), ($81,$fe,$7f,$7f), - ($f0,$a0,$50,$50), ($44,$78,$3c,$3c), ($ba,$25,$9f,$9f), ($e3,$4b,$a8,$a8), - ($f3,$a2,$51,$51), ($fe,$5d,$a3,$a3), ($c0,$80,$40,$40), ($8a,$05,$8f,$8f), - ($ad,$3f,$92,$92), ($bc,$21,$9d,$9d), ($48,$70,$38,$38), ($04,$f1,$f5,$f5), - ($df,$63,$bc,$bc), ($c1,$77,$b6,$b6), ($75,$af,$da,$da), ($63,$42,$21,$21), - ($30,$20,$10,$10), ($1a,$e5,$ff,$ff), ($0e,$fd,$f3,$f3), ($6d,$bf,$d2,$d2), - ($4c,$81,$cd,$cd), ($14,$18,$0c,$0c), ($35,$26,$13,$13), ($2f,$c3,$ec,$ec), - ($e1,$be,$5f,$5f), ($a2,$35,$97,$97), ($cc,$88,$44,$44), ($39,$2e,$17,$17), - ($57,$93,$c4,$c4), ($f2,$55,$a7,$a7), ($82,$fc,$7e,$7e), ($47,$7a,$3d,$3d), - ($ac,$c8,$64,$64), ($e7,$ba,$5d,$5d), ($2b,$32,$19,$19), ($95,$e6,$73,$73), - ($a0,$c0,$60,$60), ($98,$19,$81,$81), ($d1,$9e,$4f,$4f), ($7f,$a3,$dc,$dc), - ($66,$44,$22,$22), ($7e,$54,$2a,$2a), ($ab,$3b,$90,$90), ($83,$0b,$88,$88), - ($ca,$8c,$46,$46), ($29,$c7,$ee,$ee), ($d3,$6b,$b8,$b8), ($3c,$28,$14,$14), - ($79,$a7,$de,$de), ($e2,$bc,$5e,$5e), ($1d,$16,$0b,$0b), ($76,$ad,$db,$db), - ($3b,$db,$e0,$e0), ($56,$64,$32,$32), ($4e,$74,$3a,$3a), ($1e,$14,$0a,$0a), - ($db,$92,$49,$49), ($0a,$0c,$06,$06), ($6c,$48,$24,$24), ($e4,$b8,$5c,$5c), - ($5d,$9f,$c2,$c2), ($6e,$bd,$d3,$d3), ($ef,$43,$ac,$ac), ($a6,$c4,$62,$62), - ($a8,$39,$91,$91), ($a4,$31,$95,$95), ($37,$d3,$e4,$e4), ($8b,$f2,$79,$79), - ($32,$d5,$e7,$e7), ($43,$8b,$c8,$c8), ($59,$6e,$37,$37), ($b7,$da,$6d,$6d), - ($8c,$01,$8d,$8d), ($64,$b1,$d5,$d5), ($d2,$9c,$4e,$4e), ($e0,$49,$a9,$a9), - ($b4,$d8,$6c,$6c), ($fa,$ac,$56,$56), ($07,$f3,$f4,$f4), ($25,$cf,$ea,$ea), - ($af,$ca,$65,$65), ($8e,$f4,$7a,$7a), ($e9,$47,$ae,$ae), ($18,$10,$08,$08), - ($d5,$6f,$ba,$ba), ($88,$f0,$78,$78), ($6f,$4a,$25,$25), ($72,$5c,$2e,$2e), - ($24,$38,$1c,$1c), ($f1,$57,$a6,$a6), ($c7,$73,$b4,$b4), ($51,$97,$c6,$c6), - ($23,$cb,$e8,$e8), ($7c,$a1,$dd,$dd), ($9c,$e8,$74,$74), ($21,$3e,$1f,$1f), - ($dd,$96,$4b,$4b), ($dc,$61,$bd,$bd), ($86,$0d,$8b,$8b), ($85,$0f,$8a,$8a), - ($90,$e0,$70,$70), ($42,$7c,$3e,$3e), ($c4,$71,$b5,$b5), ($aa,$cc,$66,$66), - ($d8,$90,$48,$48), ($05,$06,$03,$03), ($01,$f7,$f6,$f6), ($12,$1c,$0e,$0e), - ($a3,$c2,$61,$61), ($5f,$6a,$35,$35), ($f9,$ae,$57,$57), ($d0,$69,$b9,$b9), - ($91,$17,$86,$86), ($58,$99,$c1,$c1), ($27,$3a,$1d,$1d), ($b9,$27,$9e,$9e), - ($38,$d9,$e1,$e1), ($13,$eb,$f8,$f8), ($b3,$2b,$98,$98), ($33,$22,$11,$11), - ($bb,$d2,$69,$69), ($70,$a9,$d9,$d9), ($89,$07,$8e,$8e), ($a7,$33,$94,$94), - ($b6,$2d,$9b,$9b), ($22,$3c,$1e,$1e), ($92,$15,$87,$87), ($20,$c9,$e9,$e9), - ($49,$87,$ce,$ce), ($ff,$aa,$55,$55), ($78,$50,$28,$28), ($7a,$a5,$df,$df), - ($8f,$03,$8c,$8c), ($f8,$59,$a1,$a1), ($80,$09,$89,$89), ($17,$1a,$0d,$0d), - ($da,$65,$bf,$bf), ($31,$d7,$e6,$e6), ($c6,$84,$42,$42), ($b8,$d0,$68,$68), - ($c3,$82,$41,$41), ($b0,$29,$99,$99), ($77,$5a,$2d,$2d), ($11,$1e,$0f,$0f), - ($cb,$7b,$b0,$b0), ($fc,$a8,$54,$54), ($d6,$6d,$bb,$bb), ($3a,$2c,$16,$16)); - T3: array[0..255,0..3] of byte= ( - ($63,$a5,$c6,$63), ($7c,$84,$f8,$7c), ($77,$99,$ee,$77), ($7b,$8d,$f6,$7b), - ($f2,$0d,$ff,$f2), ($6b,$bd,$d6,$6b), ($6f,$b1,$de,$6f), ($c5,$54,$91,$c5), - ($30,$50,$60,$30), ($01,$03,$02,$01), ($67,$a9,$ce,$67), ($2b,$7d,$56,$2b), - ($fe,$19,$e7,$fe), ($d7,$62,$b5,$d7), ($ab,$e6,$4d,$ab), ($76,$9a,$ec,$76), - ($ca,$45,$8f,$ca), ($82,$9d,$1f,$82), ($c9,$40,$89,$c9), ($7d,$87,$fa,$7d), - ($fa,$15,$ef,$fa), ($59,$eb,$b2,$59), ($47,$c9,$8e,$47), ($f0,$0b,$fb,$f0), - ($ad,$ec,$41,$ad), ($d4,$67,$b3,$d4), ($a2,$fd,$5f,$a2), ($af,$ea,$45,$af), - ($9c,$bf,$23,$9c), ($a4,$f7,$53,$a4), ($72,$96,$e4,$72), ($c0,$5b,$9b,$c0), - ($b7,$c2,$75,$b7), ($fd,$1c,$e1,$fd), ($93,$ae,$3d,$93), ($26,$6a,$4c,$26), - ($36,$5a,$6c,$36), ($3f,$41,$7e,$3f), ($f7,$02,$f5,$f7), ($cc,$4f,$83,$cc), - ($34,$5c,$68,$34), ($a5,$f4,$51,$a5), ($e5,$34,$d1,$e5), ($f1,$08,$f9,$f1), - ($71,$93,$e2,$71), ($d8,$73,$ab,$d8), ($31,$53,$62,$31), ($15,$3f,$2a,$15), - ($04,$0c,$08,$04), ($c7,$52,$95,$c7), ($23,$65,$46,$23), ($c3,$5e,$9d,$c3), - ($18,$28,$30,$18), ($96,$a1,$37,$96), ($05,$0f,$0a,$05), ($9a,$b5,$2f,$9a), - ($07,$09,$0e,$07), ($12,$36,$24,$12), ($80,$9b,$1b,$80), ($e2,$3d,$df,$e2), - ($eb,$26,$cd,$eb), ($27,$69,$4e,$27), ($b2,$cd,$7f,$b2), ($75,$9f,$ea,$75), - ($09,$1b,$12,$09), ($83,$9e,$1d,$83), ($2c,$74,$58,$2c), ($1a,$2e,$34,$1a), - ($1b,$2d,$36,$1b), ($6e,$b2,$dc,$6e), ($5a,$ee,$b4,$5a), ($a0,$fb,$5b,$a0), - ($52,$f6,$a4,$52), ($3b,$4d,$76,$3b), ($d6,$61,$b7,$d6), ($b3,$ce,$7d,$b3), - ($29,$7b,$52,$29), ($e3,$3e,$dd,$e3), ($2f,$71,$5e,$2f), ($84,$97,$13,$84), - ($53,$f5,$a6,$53), ($d1,$68,$b9,$d1), ($00,$00,$00,$00), ($ed,$2c,$c1,$ed), - ($20,$60,$40,$20), ($fc,$1f,$e3,$fc), ($b1,$c8,$79,$b1), ($5b,$ed,$b6,$5b), - ($6a,$be,$d4,$6a), ($cb,$46,$8d,$cb), ($be,$d9,$67,$be), ($39,$4b,$72,$39), - ($4a,$de,$94,$4a), ($4c,$d4,$98,$4c), ($58,$e8,$b0,$58), ($cf,$4a,$85,$cf), - ($d0,$6b,$bb,$d0), ($ef,$2a,$c5,$ef), ($aa,$e5,$4f,$aa), ($fb,$16,$ed,$fb), - ($43,$c5,$86,$43), ($4d,$d7,$9a,$4d), ($33,$55,$66,$33), ($85,$94,$11,$85), - ($45,$cf,$8a,$45), ($f9,$10,$e9,$f9), ($02,$06,$04,$02), ($7f,$81,$fe,$7f), - ($50,$f0,$a0,$50), ($3c,$44,$78,$3c), ($9f,$ba,$25,$9f), ($a8,$e3,$4b,$a8), - ($51,$f3,$a2,$51), ($a3,$fe,$5d,$a3), ($40,$c0,$80,$40), ($8f,$8a,$05,$8f), - ($92,$ad,$3f,$92), ($9d,$bc,$21,$9d), ($38,$48,$70,$38), ($f5,$04,$f1,$f5), - ($bc,$df,$63,$bc), ($b6,$c1,$77,$b6), ($da,$75,$af,$da), ($21,$63,$42,$21), - ($10,$30,$20,$10), ($ff,$1a,$e5,$ff), ($f3,$0e,$fd,$f3), ($d2,$6d,$bf,$d2), - ($cd,$4c,$81,$cd), ($0c,$14,$18,$0c), ($13,$35,$26,$13), ($ec,$2f,$c3,$ec), - ($5f,$e1,$be,$5f), ($97,$a2,$35,$97), ($44,$cc,$88,$44), ($17,$39,$2e,$17), - ($c4,$57,$93,$c4), ($a7,$f2,$55,$a7), ($7e,$82,$fc,$7e), ($3d,$47,$7a,$3d), - ($64,$ac,$c8,$64), ($5d,$e7,$ba,$5d), ($19,$2b,$32,$19), ($73,$95,$e6,$73), - ($60,$a0,$c0,$60), ($81,$98,$19,$81), ($4f,$d1,$9e,$4f), ($dc,$7f,$a3,$dc), - ($22,$66,$44,$22), ($2a,$7e,$54,$2a), ($90,$ab,$3b,$90), ($88,$83,$0b,$88), - ($46,$ca,$8c,$46), ($ee,$29,$c7,$ee), ($b8,$d3,$6b,$b8), ($14,$3c,$28,$14), - ($de,$79,$a7,$de), ($5e,$e2,$bc,$5e), ($0b,$1d,$16,$0b), ($db,$76,$ad,$db), - ($e0,$3b,$db,$e0), ($32,$56,$64,$32), ($3a,$4e,$74,$3a), ($0a,$1e,$14,$0a), - ($49,$db,$92,$49), ($06,$0a,$0c,$06), ($24,$6c,$48,$24), ($5c,$e4,$b8,$5c), - ($c2,$5d,$9f,$c2), ($d3,$6e,$bd,$d3), ($ac,$ef,$43,$ac), ($62,$a6,$c4,$62), - ($91,$a8,$39,$91), ($95,$a4,$31,$95), ($e4,$37,$d3,$e4), ($79,$8b,$f2,$79), - ($e7,$32,$d5,$e7), ($c8,$43,$8b,$c8), ($37,$59,$6e,$37), ($6d,$b7,$da,$6d), - ($8d,$8c,$01,$8d), ($d5,$64,$b1,$d5), ($4e,$d2,$9c,$4e), ($a9,$e0,$49,$a9), - ($6c,$b4,$d8,$6c), ($56,$fa,$ac,$56), ($f4,$07,$f3,$f4), ($ea,$25,$cf,$ea), - ($65,$af,$ca,$65), ($7a,$8e,$f4,$7a), ($ae,$e9,$47,$ae), ($08,$18,$10,$08), - ($ba,$d5,$6f,$ba), ($78,$88,$f0,$78), ($25,$6f,$4a,$25), ($2e,$72,$5c,$2e), - ($1c,$24,$38,$1c), ($a6,$f1,$57,$a6), ($b4,$c7,$73,$b4), ($c6,$51,$97,$c6), - ($e8,$23,$cb,$e8), ($dd,$7c,$a1,$dd), ($74,$9c,$e8,$74), ($1f,$21,$3e,$1f), - ($4b,$dd,$96,$4b), ($bd,$dc,$61,$bd), ($8b,$86,$0d,$8b), ($8a,$85,$0f,$8a), - ($70,$90,$e0,$70), ($3e,$42,$7c,$3e), ($b5,$c4,$71,$b5), ($66,$aa,$cc,$66), - ($48,$d8,$90,$48), ($03,$05,$06,$03), ($f6,$01,$f7,$f6), ($0e,$12,$1c,$0e), - ($61,$a3,$c2,$61), ($35,$5f,$6a,$35), ($57,$f9,$ae,$57), ($b9,$d0,$69,$b9), - ($86,$91,$17,$86), ($c1,$58,$99,$c1), ($1d,$27,$3a,$1d), ($9e,$b9,$27,$9e), - ($e1,$38,$d9,$e1), ($f8,$13,$eb,$f8), ($98,$b3,$2b,$98), ($11,$33,$22,$11), - ($69,$bb,$d2,$69), ($d9,$70,$a9,$d9), ($8e,$89,$07,$8e), ($94,$a7,$33,$94), - ($9b,$b6,$2d,$9b), ($1e,$22,$3c,$1e), ($87,$92,$15,$87), ($e9,$20,$c9,$e9), - ($ce,$49,$87,$ce), ($55,$ff,$aa,$55), ($28,$78,$50,$28), ($df,$7a,$a5,$df), - ($8c,$8f,$03,$8c), ($a1,$f8,$59,$a1), ($89,$80,$09,$89), ($0d,$17,$1a,$0d), - ($bf,$da,$65,$bf), ($e6,$31,$d7,$e6), ($42,$c6,$84,$42), ($68,$b8,$d0,$68), - ($41,$c3,$82,$41), ($99,$b0,$29,$99), ($2d,$77,$5a,$2d), ($0f,$11,$1e,$0f), - ($b0,$cb,$7b,$b0), ($54,$fc,$a8,$54), ($bb,$d6,$6d,$bb), ($16,$3a,$2c,$16)); - T4: array[0..255,0..3] of byte= ( - ($63,$63,$a5,$c6), ($7c,$7c,$84,$f8), ($77,$77,$99,$ee), ($7b,$7b,$8d,$f6), - ($f2,$f2,$0d,$ff), ($6b,$6b,$bd,$d6), ($6f,$6f,$b1,$de), ($c5,$c5,$54,$91), - ($30,$30,$50,$60), ($01,$01,$03,$02), ($67,$67,$a9,$ce), ($2b,$2b,$7d,$56), - ($fe,$fe,$19,$e7), ($d7,$d7,$62,$b5), ($ab,$ab,$e6,$4d), ($76,$76,$9a,$ec), - ($ca,$ca,$45,$8f), ($82,$82,$9d,$1f), ($c9,$c9,$40,$89), ($7d,$7d,$87,$fa), - ($fa,$fa,$15,$ef), ($59,$59,$eb,$b2), ($47,$47,$c9,$8e), ($f0,$f0,$0b,$fb), - ($ad,$ad,$ec,$41), ($d4,$d4,$67,$b3), ($a2,$a2,$fd,$5f), ($af,$af,$ea,$45), - ($9c,$9c,$bf,$23), ($a4,$a4,$f7,$53), ($72,$72,$96,$e4), ($c0,$c0,$5b,$9b), - ($b7,$b7,$c2,$75), ($fd,$fd,$1c,$e1), ($93,$93,$ae,$3d), ($26,$26,$6a,$4c), - ($36,$36,$5a,$6c), ($3f,$3f,$41,$7e), ($f7,$f7,$02,$f5), ($cc,$cc,$4f,$83), - ($34,$34,$5c,$68), ($a5,$a5,$f4,$51), ($e5,$e5,$34,$d1), ($f1,$f1,$08,$f9), - ($71,$71,$93,$e2), ($d8,$d8,$73,$ab), ($31,$31,$53,$62), ($15,$15,$3f,$2a), - ($04,$04,$0c,$08), ($c7,$c7,$52,$95), ($23,$23,$65,$46), ($c3,$c3,$5e,$9d), - ($18,$18,$28,$30), ($96,$96,$a1,$37), ($05,$05,$0f,$0a), ($9a,$9a,$b5,$2f), - ($07,$07,$09,$0e), ($12,$12,$36,$24), ($80,$80,$9b,$1b), ($e2,$e2,$3d,$df), - ($eb,$eb,$26,$cd), ($27,$27,$69,$4e), ($b2,$b2,$cd,$7f), ($75,$75,$9f,$ea), - ($09,$09,$1b,$12), ($83,$83,$9e,$1d), ($2c,$2c,$74,$58), ($1a,$1a,$2e,$34), - ($1b,$1b,$2d,$36), ($6e,$6e,$b2,$dc), ($5a,$5a,$ee,$b4), ($a0,$a0,$fb,$5b), - ($52,$52,$f6,$a4), ($3b,$3b,$4d,$76), ($d6,$d6,$61,$b7), ($b3,$b3,$ce,$7d), - ($29,$29,$7b,$52), ($e3,$e3,$3e,$dd), ($2f,$2f,$71,$5e), ($84,$84,$97,$13), - ($53,$53,$f5,$a6), ($d1,$d1,$68,$b9), ($00,$00,$00,$00), ($ed,$ed,$2c,$c1), - ($20,$20,$60,$40), ($fc,$fc,$1f,$e3), ($b1,$b1,$c8,$79), ($5b,$5b,$ed,$b6), - ($6a,$6a,$be,$d4), ($cb,$cb,$46,$8d), ($be,$be,$d9,$67), ($39,$39,$4b,$72), - ($4a,$4a,$de,$94), ($4c,$4c,$d4,$98), ($58,$58,$e8,$b0), ($cf,$cf,$4a,$85), - ($d0,$d0,$6b,$bb), ($ef,$ef,$2a,$c5), ($aa,$aa,$e5,$4f), ($fb,$fb,$16,$ed), - ($43,$43,$c5,$86), ($4d,$4d,$d7,$9a), ($33,$33,$55,$66), ($85,$85,$94,$11), - ($45,$45,$cf,$8a), ($f9,$f9,$10,$e9), ($02,$02,$06,$04), ($7f,$7f,$81,$fe), - ($50,$50,$f0,$a0), ($3c,$3c,$44,$78), ($9f,$9f,$ba,$25), ($a8,$a8,$e3,$4b), - ($51,$51,$f3,$a2), ($a3,$a3,$fe,$5d), ($40,$40,$c0,$80), ($8f,$8f,$8a,$05), - ($92,$92,$ad,$3f), ($9d,$9d,$bc,$21), ($38,$38,$48,$70), ($f5,$f5,$04,$f1), - ($bc,$bc,$df,$63), ($b6,$b6,$c1,$77), ($da,$da,$75,$af), ($21,$21,$63,$42), - ($10,$10,$30,$20), ($ff,$ff,$1a,$e5), ($f3,$f3,$0e,$fd), ($d2,$d2,$6d,$bf), - ($cd,$cd,$4c,$81), ($0c,$0c,$14,$18), ($13,$13,$35,$26), ($ec,$ec,$2f,$c3), - ($5f,$5f,$e1,$be), ($97,$97,$a2,$35), ($44,$44,$cc,$88), ($17,$17,$39,$2e), - ($c4,$c4,$57,$93), ($a7,$a7,$f2,$55), ($7e,$7e,$82,$fc), ($3d,$3d,$47,$7a), - ($64,$64,$ac,$c8), ($5d,$5d,$e7,$ba), ($19,$19,$2b,$32), ($73,$73,$95,$e6), - ($60,$60,$a0,$c0), ($81,$81,$98,$19), ($4f,$4f,$d1,$9e), ($dc,$dc,$7f,$a3), - ($22,$22,$66,$44), ($2a,$2a,$7e,$54), ($90,$90,$ab,$3b), ($88,$88,$83,$0b), - ($46,$46,$ca,$8c), ($ee,$ee,$29,$c7), ($b8,$b8,$d3,$6b), ($14,$14,$3c,$28), - ($de,$de,$79,$a7), ($5e,$5e,$e2,$bc), ($0b,$0b,$1d,$16), ($db,$db,$76,$ad), - ($e0,$e0,$3b,$db), ($32,$32,$56,$64), ($3a,$3a,$4e,$74), ($0a,$0a,$1e,$14), - ($49,$49,$db,$92), ($06,$06,$0a,$0c), ($24,$24,$6c,$48), ($5c,$5c,$e4,$b8), - ($c2,$c2,$5d,$9f), ($d3,$d3,$6e,$bd), ($ac,$ac,$ef,$43), ($62,$62,$a6,$c4), - ($91,$91,$a8,$39), ($95,$95,$a4,$31), ($e4,$e4,$37,$d3), ($79,$79,$8b,$f2), - ($e7,$e7,$32,$d5), ($c8,$c8,$43,$8b), ($37,$37,$59,$6e), ($6d,$6d,$b7,$da), - ($8d,$8d,$8c,$01), ($d5,$d5,$64,$b1), ($4e,$4e,$d2,$9c), ($a9,$a9,$e0,$49), - ($6c,$6c,$b4,$d8), ($56,$56,$fa,$ac), ($f4,$f4,$07,$f3), ($ea,$ea,$25,$cf), - ($65,$65,$af,$ca), ($7a,$7a,$8e,$f4), ($ae,$ae,$e9,$47), ($08,$08,$18,$10), - ($ba,$ba,$d5,$6f), ($78,$78,$88,$f0), ($25,$25,$6f,$4a), ($2e,$2e,$72,$5c), - ($1c,$1c,$24,$38), ($a6,$a6,$f1,$57), ($b4,$b4,$c7,$73), ($c6,$c6,$51,$97), - ($e8,$e8,$23,$cb), ($dd,$dd,$7c,$a1), ($74,$74,$9c,$e8), ($1f,$1f,$21,$3e), - ($4b,$4b,$dd,$96), ($bd,$bd,$dc,$61), ($8b,$8b,$86,$0d), ($8a,$8a,$85,$0f), - ($70,$70,$90,$e0), ($3e,$3e,$42,$7c), ($b5,$b5,$c4,$71), ($66,$66,$aa,$cc), - ($48,$48,$d8,$90), ($03,$03,$05,$06), ($f6,$f6,$01,$f7), ($0e,$0e,$12,$1c), - ($61,$61,$a3,$c2), ($35,$35,$5f,$6a), ($57,$57,$f9,$ae), ($b9,$b9,$d0,$69), - ($86,$86,$91,$17), ($c1,$c1,$58,$99), ($1d,$1d,$27,$3a), ($9e,$9e,$b9,$27), - ($e1,$e1,$38,$d9), ($f8,$f8,$13,$eb), ($98,$98,$b3,$2b), ($11,$11,$33,$22), - ($69,$69,$bb,$d2), ($d9,$d9,$70,$a9), ($8e,$8e,$89,$07), ($94,$94,$a7,$33), - ($9b,$9b,$b6,$2d), ($1e,$1e,$22,$3c), ($87,$87,$92,$15), ($e9,$e9,$20,$c9), - ($ce,$ce,$49,$87), ($55,$55,$ff,$aa), ($28,$28,$78,$50), ($df,$df,$7a,$a5), - ($8c,$8c,$8f,$03), ($a1,$a1,$f8,$59), ($89,$89,$80,$09), ($0d,$0d,$17,$1a), - ($bf,$bf,$da,$65), ($e6,$e6,$31,$d7), ($42,$42,$c6,$84), ($68,$68,$b8,$d0), - ($41,$41,$c3,$82), ($99,$99,$b0,$29), ($2d,$2d,$77,$5a), ($0f,$0f,$11,$1e), - ($b0,$b0,$cb,$7b), ($54,$54,$fc,$a8), ($bb,$bb,$d6,$6d), ($16,$16,$3a,$2c)); - T5: array[0..255,0..3] of byte= ( - ($51,$f4,$a7,$50), ($7e,$41,$65,$53), ($1a,$17,$a4,$c3), ($3a,$27,$5e,$96), - ($3b,$ab,$6b,$cb), ($1f,$9d,$45,$f1), ($ac,$fa,$58,$ab), ($4b,$e3,$03,$93), - ($20,$30,$fa,$55), ($ad,$76,$6d,$f6), ($88,$cc,$76,$91), ($f5,$02,$4c,$25), - ($4f,$e5,$d7,$fc), ($c5,$2a,$cb,$d7), ($26,$35,$44,$80), ($b5,$62,$a3,$8f), - ($de,$b1,$5a,$49), ($25,$ba,$1b,$67), ($45,$ea,$0e,$98), ($5d,$fe,$c0,$e1), - ($c3,$2f,$75,$02), ($81,$4c,$f0,$12), ($8d,$46,$97,$a3), ($6b,$d3,$f9,$c6), - ($03,$8f,$5f,$e7), ($15,$92,$9c,$95), ($bf,$6d,$7a,$eb), ($95,$52,$59,$da), - ($d4,$be,$83,$2d), ($58,$74,$21,$d3), ($49,$e0,$69,$29), ($8e,$c9,$c8,$44), - ($75,$c2,$89,$6a), ($f4,$8e,$79,$78), ($99,$58,$3e,$6b), ($27,$b9,$71,$dd), - ($be,$e1,$4f,$b6), ($f0,$88,$ad,$17), ($c9,$20,$ac,$66), ($7d,$ce,$3a,$b4), - ($63,$df,$4a,$18), ($e5,$1a,$31,$82), ($97,$51,$33,$60), ($62,$53,$7f,$45), - ($b1,$64,$77,$e0), ($bb,$6b,$ae,$84), ($fe,$81,$a0,$1c), ($f9,$08,$2b,$94), - ($70,$48,$68,$58), ($8f,$45,$fd,$19), ($94,$de,$6c,$87), ($52,$7b,$f8,$b7), - ($ab,$73,$d3,$23), ($72,$4b,$02,$e2), ($e3,$1f,$8f,$57), ($66,$55,$ab,$2a), - ($b2,$eb,$28,$07), ($2f,$b5,$c2,$03), ($86,$c5,$7b,$9a), ($d3,$37,$08,$a5), - ($30,$28,$87,$f2), ($23,$bf,$a5,$b2), ($02,$03,$6a,$ba), ($ed,$16,$82,$5c), - ($8a,$cf,$1c,$2b), ($a7,$79,$b4,$92), ($f3,$07,$f2,$f0), ($4e,$69,$e2,$a1), - ($65,$da,$f4,$cd), ($06,$05,$be,$d5), ($d1,$34,$62,$1f), ($c4,$a6,$fe,$8a), - ($34,$2e,$53,$9d), ($a2,$f3,$55,$a0), ($05,$8a,$e1,$32), ($a4,$f6,$eb,$75), - ($0b,$83,$ec,$39), ($40,$60,$ef,$aa), ($5e,$71,$9f,$06), ($bd,$6e,$10,$51), - ($3e,$21,$8a,$f9), ($96,$dd,$06,$3d), ($dd,$3e,$05,$ae), ($4d,$e6,$bd,$46), - ($91,$54,$8d,$b5), ($71,$c4,$5d,$05), ($04,$06,$d4,$6f), ($60,$50,$15,$ff), - ($19,$98,$fb,$24), ($d6,$bd,$e9,$97), ($89,$40,$43,$cc), ($67,$d9,$9e,$77), - ($b0,$e8,$42,$bd), ($07,$89,$8b,$88), ($e7,$19,$5b,$38), ($79,$c8,$ee,$db), - ($a1,$7c,$0a,$47), ($7c,$42,$0f,$e9), ($f8,$84,$1e,$c9), ($00,$00,$00,$00), - ($09,$80,$86,$83), ($32,$2b,$ed,$48), ($1e,$11,$70,$ac), ($6c,$5a,$72,$4e), - ($fd,$0e,$ff,$fb), ($0f,$85,$38,$56), ($3d,$ae,$d5,$1e), ($36,$2d,$39,$27), - ($0a,$0f,$d9,$64), ($68,$5c,$a6,$21), ($9b,$5b,$54,$d1), ($24,$36,$2e,$3a), - ($0c,$0a,$67,$b1), ($93,$57,$e7,$0f), ($b4,$ee,$96,$d2), ($1b,$9b,$91,$9e), - ($80,$c0,$c5,$4f), ($61,$dc,$20,$a2), ($5a,$77,$4b,$69), ($1c,$12,$1a,$16), - ($e2,$93,$ba,$0a), ($c0,$a0,$2a,$e5), ($3c,$22,$e0,$43), ($12,$1b,$17,$1d), - ($0e,$09,$0d,$0b), ($f2,$8b,$c7,$ad), ($2d,$b6,$a8,$b9), ($14,$1e,$a9,$c8), - ($57,$f1,$19,$85), ($af,$75,$07,$4c), ($ee,$99,$dd,$bb), ($a3,$7f,$60,$fd), - ($f7,$01,$26,$9f), ($5c,$72,$f5,$bc), ($44,$66,$3b,$c5), ($5b,$fb,$7e,$34), - ($8b,$43,$29,$76), ($cb,$23,$c6,$dc), ($b6,$ed,$fc,$68), ($b8,$e4,$f1,$63), - ($d7,$31,$dc,$ca), ($42,$63,$85,$10), ($13,$97,$22,$40), ($84,$c6,$11,$20), - ($85,$4a,$24,$7d), ($d2,$bb,$3d,$f8), ($ae,$f9,$32,$11), ($c7,$29,$a1,$6d), - ($1d,$9e,$2f,$4b), ($dc,$b2,$30,$f3), ($0d,$86,$52,$ec), ($77,$c1,$e3,$d0), - ($2b,$b3,$16,$6c), ($a9,$70,$b9,$99), ($11,$94,$48,$fa), ($47,$e9,$64,$22), - ($a8,$fc,$8c,$c4), ($a0,$f0,$3f,$1a), ($56,$7d,$2c,$d8), ($22,$33,$90,$ef), - ($87,$49,$4e,$c7), ($d9,$38,$d1,$c1), ($8c,$ca,$a2,$fe), ($98,$d4,$0b,$36), - ($a6,$f5,$81,$cf), ($a5,$7a,$de,$28), ($da,$b7,$8e,$26), ($3f,$ad,$bf,$a4), - ($2c,$3a,$9d,$e4), ($50,$78,$92,$0d), ($6a,$5f,$cc,$9b), ($54,$7e,$46,$62), - ($f6,$8d,$13,$c2), ($90,$d8,$b8,$e8), ($2e,$39,$f7,$5e), ($82,$c3,$af,$f5), - ($9f,$5d,$80,$be), ($69,$d0,$93,$7c), ($6f,$d5,$2d,$a9), ($cf,$25,$12,$b3), - ($c8,$ac,$99,$3b), ($10,$18,$7d,$a7), ($e8,$9c,$63,$6e), ($db,$3b,$bb,$7b), - ($cd,$26,$78,$09), ($6e,$59,$18,$f4), ($ec,$9a,$b7,$01), ($83,$4f,$9a,$a8), - ($e6,$95,$6e,$65), ($aa,$ff,$e6,$7e), ($21,$bc,$cf,$08), ($ef,$15,$e8,$e6), - ($ba,$e7,$9b,$d9), ($4a,$6f,$36,$ce), ($ea,$9f,$09,$d4), ($29,$b0,$7c,$d6), - ($31,$a4,$b2,$af), ($2a,$3f,$23,$31), ($c6,$a5,$94,$30), ($35,$a2,$66,$c0), - ($74,$4e,$bc,$37), ($fc,$82,$ca,$a6), ($e0,$90,$d0,$b0), ($33,$a7,$d8,$15), - ($f1,$04,$98,$4a), ($41,$ec,$da,$f7), ($7f,$cd,$50,$0e), ($17,$91,$f6,$2f), - ($76,$4d,$d6,$8d), ($43,$ef,$b0,$4d), ($cc,$aa,$4d,$54), ($e4,$96,$04,$df), - ($9e,$d1,$b5,$e3), ($4c,$6a,$88,$1b), ($c1,$2c,$1f,$b8), ($46,$65,$51,$7f), - ($9d,$5e,$ea,$04), ($01,$8c,$35,$5d), ($fa,$87,$74,$73), ($fb,$0b,$41,$2e), - ($b3,$67,$1d,$5a), ($92,$db,$d2,$52), ($e9,$10,$56,$33), ($6d,$d6,$47,$13), - ($9a,$d7,$61,$8c), ($37,$a1,$0c,$7a), ($59,$f8,$14,$8e), ($eb,$13,$3c,$89), - ($ce,$a9,$27,$ee), ($b7,$61,$c9,$35), ($e1,$1c,$e5,$ed), ($7a,$47,$b1,$3c), - ($9c,$d2,$df,$59), ($55,$f2,$73,$3f), ($18,$14,$ce,$79), ($73,$c7,$37,$bf), - ($53,$f7,$cd,$ea), ($5f,$fd,$aa,$5b), ($df,$3d,$6f,$14), ($78,$44,$db,$86), - ($ca,$af,$f3,$81), ($b9,$68,$c4,$3e), ($38,$24,$34,$2c), ($c2,$a3,$40,$5f), - ($16,$1d,$c3,$72), ($bc,$e2,$25,$0c), ($28,$3c,$49,$8b), ($ff,$0d,$95,$41), - ($39,$a8,$01,$71), ($08,$0c,$b3,$de), ($d8,$b4,$e4,$9c), ($64,$56,$c1,$90), - ($7b,$cb,$84,$61), ($d5,$32,$b6,$70), ($48,$6c,$5c,$74), ($d0,$b8,$57,$42)); - T6: array[0..255,0..3] of byte= ( - ($50,$51,$f4,$a7), ($53,$7e,$41,$65), ($c3,$1a,$17,$a4), ($96,$3a,$27,$5e), - ($cb,$3b,$ab,$6b), ($f1,$1f,$9d,$45), ($ab,$ac,$fa,$58), ($93,$4b,$e3,$03), - ($55,$20,$30,$fa), ($f6,$ad,$76,$6d), ($91,$88,$cc,$76), ($25,$f5,$02,$4c), - ($fc,$4f,$e5,$d7), ($d7,$c5,$2a,$cb), ($80,$26,$35,$44), ($8f,$b5,$62,$a3), - ($49,$de,$b1,$5a), ($67,$25,$ba,$1b), ($98,$45,$ea,$0e), ($e1,$5d,$fe,$c0), - ($02,$c3,$2f,$75), ($12,$81,$4c,$f0), ($a3,$8d,$46,$97), ($c6,$6b,$d3,$f9), - ($e7,$03,$8f,$5f), ($95,$15,$92,$9c), ($eb,$bf,$6d,$7a), ($da,$95,$52,$59), - ($2d,$d4,$be,$83), ($d3,$58,$74,$21), ($29,$49,$e0,$69), ($44,$8e,$c9,$c8), - ($6a,$75,$c2,$89), ($78,$f4,$8e,$79), ($6b,$99,$58,$3e), ($dd,$27,$b9,$71), - ($b6,$be,$e1,$4f), ($17,$f0,$88,$ad), ($66,$c9,$20,$ac), ($b4,$7d,$ce,$3a), - ($18,$63,$df,$4a), ($82,$e5,$1a,$31), ($60,$97,$51,$33), ($45,$62,$53,$7f), - ($e0,$b1,$64,$77), ($84,$bb,$6b,$ae), ($1c,$fe,$81,$a0), ($94,$f9,$08,$2b), - ($58,$70,$48,$68), ($19,$8f,$45,$fd), ($87,$94,$de,$6c), ($b7,$52,$7b,$f8), - ($23,$ab,$73,$d3), ($e2,$72,$4b,$02), ($57,$e3,$1f,$8f), ($2a,$66,$55,$ab), - ($07,$b2,$eb,$28), ($03,$2f,$b5,$c2), ($9a,$86,$c5,$7b), ($a5,$d3,$37,$08), - ($f2,$30,$28,$87), ($b2,$23,$bf,$a5), ($ba,$02,$03,$6a), ($5c,$ed,$16,$82), - ($2b,$8a,$cf,$1c), ($92,$a7,$79,$b4), ($f0,$f3,$07,$f2), ($a1,$4e,$69,$e2), - ($cd,$65,$da,$f4), ($d5,$06,$05,$be), ($1f,$d1,$34,$62), ($8a,$c4,$a6,$fe), - ($9d,$34,$2e,$53), ($a0,$a2,$f3,$55), ($32,$05,$8a,$e1), ($75,$a4,$f6,$eb), - ($39,$0b,$83,$ec), ($aa,$40,$60,$ef), ($06,$5e,$71,$9f), ($51,$bd,$6e,$10), - ($f9,$3e,$21,$8a), ($3d,$96,$dd,$06), ($ae,$dd,$3e,$05), ($46,$4d,$e6,$bd), - ($b5,$91,$54,$8d), ($05,$71,$c4,$5d), ($6f,$04,$06,$d4), ($ff,$60,$50,$15), - ($24,$19,$98,$fb), ($97,$d6,$bd,$e9), ($cc,$89,$40,$43), ($77,$67,$d9,$9e), - ($bd,$b0,$e8,$42), ($88,$07,$89,$8b), ($38,$e7,$19,$5b), ($db,$79,$c8,$ee), - ($47,$a1,$7c,$0a), ($e9,$7c,$42,$0f), ($c9,$f8,$84,$1e), ($00,$00,$00,$00), - ($83,$09,$80,$86), ($48,$32,$2b,$ed), ($ac,$1e,$11,$70), ($4e,$6c,$5a,$72), - ($fb,$fd,$0e,$ff), ($56,$0f,$85,$38), ($1e,$3d,$ae,$d5), ($27,$36,$2d,$39), - ($64,$0a,$0f,$d9), ($21,$68,$5c,$a6), ($d1,$9b,$5b,$54), ($3a,$24,$36,$2e), - ($b1,$0c,$0a,$67), ($0f,$93,$57,$e7), ($d2,$b4,$ee,$96), ($9e,$1b,$9b,$91), - ($4f,$80,$c0,$c5), ($a2,$61,$dc,$20), ($69,$5a,$77,$4b), ($16,$1c,$12,$1a), - ($0a,$e2,$93,$ba), ($e5,$c0,$a0,$2a), ($43,$3c,$22,$e0), ($1d,$12,$1b,$17), - ($0b,$0e,$09,$0d), ($ad,$f2,$8b,$c7), ($b9,$2d,$b6,$a8), ($c8,$14,$1e,$a9), - ($85,$57,$f1,$19), ($4c,$af,$75,$07), ($bb,$ee,$99,$dd), ($fd,$a3,$7f,$60), - ($9f,$f7,$01,$26), ($bc,$5c,$72,$f5), ($c5,$44,$66,$3b), ($34,$5b,$fb,$7e), - ($76,$8b,$43,$29), ($dc,$cb,$23,$c6), ($68,$b6,$ed,$fc), ($63,$b8,$e4,$f1), - ($ca,$d7,$31,$dc), ($10,$42,$63,$85), ($40,$13,$97,$22), ($20,$84,$c6,$11), - ($7d,$85,$4a,$24), ($f8,$d2,$bb,$3d), ($11,$ae,$f9,$32), ($6d,$c7,$29,$a1), - ($4b,$1d,$9e,$2f), ($f3,$dc,$b2,$30), ($ec,$0d,$86,$52), ($d0,$77,$c1,$e3), - ($6c,$2b,$b3,$16), ($99,$a9,$70,$b9), ($fa,$11,$94,$48), ($22,$47,$e9,$64), - ($c4,$a8,$fc,$8c), ($1a,$a0,$f0,$3f), ($d8,$56,$7d,$2c), ($ef,$22,$33,$90), - ($c7,$87,$49,$4e), ($c1,$d9,$38,$d1), ($fe,$8c,$ca,$a2), ($36,$98,$d4,$0b), - ($cf,$a6,$f5,$81), ($28,$a5,$7a,$de), ($26,$da,$b7,$8e), ($a4,$3f,$ad,$bf), - ($e4,$2c,$3a,$9d), ($0d,$50,$78,$92), ($9b,$6a,$5f,$cc), ($62,$54,$7e,$46), - ($c2,$f6,$8d,$13), ($e8,$90,$d8,$b8), ($5e,$2e,$39,$f7), ($f5,$82,$c3,$af), - ($be,$9f,$5d,$80), ($7c,$69,$d0,$93), ($a9,$6f,$d5,$2d), ($b3,$cf,$25,$12), - ($3b,$c8,$ac,$99), ($a7,$10,$18,$7d), ($6e,$e8,$9c,$63), ($7b,$db,$3b,$bb), - ($09,$cd,$26,$78), ($f4,$6e,$59,$18), ($01,$ec,$9a,$b7), ($a8,$83,$4f,$9a), - ($65,$e6,$95,$6e), ($7e,$aa,$ff,$e6), ($08,$21,$bc,$cf), ($e6,$ef,$15,$e8), - ($d9,$ba,$e7,$9b), ($ce,$4a,$6f,$36), ($d4,$ea,$9f,$09), ($d6,$29,$b0,$7c), - ($af,$31,$a4,$b2), ($31,$2a,$3f,$23), ($30,$c6,$a5,$94), ($c0,$35,$a2,$66), - ($37,$74,$4e,$bc), ($a6,$fc,$82,$ca), ($b0,$e0,$90,$d0), ($15,$33,$a7,$d8), - ($4a,$f1,$04,$98), ($f7,$41,$ec,$da), ($0e,$7f,$cd,$50), ($2f,$17,$91,$f6), - ($8d,$76,$4d,$d6), ($4d,$43,$ef,$b0), ($54,$cc,$aa,$4d), ($df,$e4,$96,$04), - ($e3,$9e,$d1,$b5), ($1b,$4c,$6a,$88), ($b8,$c1,$2c,$1f), ($7f,$46,$65,$51), - ($04,$9d,$5e,$ea), ($5d,$01,$8c,$35), ($73,$fa,$87,$74), ($2e,$fb,$0b,$41), - ($5a,$b3,$67,$1d), ($52,$92,$db,$d2), ($33,$e9,$10,$56), ($13,$6d,$d6,$47), - ($8c,$9a,$d7,$61), ($7a,$37,$a1,$0c), ($8e,$59,$f8,$14), ($89,$eb,$13,$3c), - ($ee,$ce,$a9,$27), ($35,$b7,$61,$c9), ($ed,$e1,$1c,$e5), ($3c,$7a,$47,$b1), - ($59,$9c,$d2,$df), ($3f,$55,$f2,$73), ($79,$18,$14,$ce), ($bf,$73,$c7,$37), - ($ea,$53,$f7,$cd), ($5b,$5f,$fd,$aa), ($14,$df,$3d,$6f), ($86,$78,$44,$db), - ($81,$ca,$af,$f3), ($3e,$b9,$68,$c4), ($2c,$38,$24,$34), ($5f,$c2,$a3,$40), - ($72,$16,$1d,$c3), ($0c,$bc,$e2,$25), ($8b,$28,$3c,$49), ($41,$ff,$0d,$95), - ($71,$39,$a8,$01), ($de,$08,$0c,$b3), ($9c,$d8,$b4,$e4), ($90,$64,$56,$c1), - ($61,$7b,$cb,$84), ($70,$d5,$32,$b6), ($74,$48,$6c,$5c), ($42,$d0,$b8,$57)); - T7: array[0..255,0..3] of byte= ( - ($a7,$50,$51,$f4), ($65,$53,$7e,$41), ($a4,$c3,$1a,$17), ($5e,$96,$3a,$27), - ($6b,$cb,$3b,$ab), ($45,$f1,$1f,$9d), ($58,$ab,$ac,$fa), ($03,$93,$4b,$e3), - ($fa,$55,$20,$30), ($6d,$f6,$ad,$76), ($76,$91,$88,$cc), ($4c,$25,$f5,$02), - ($d7,$fc,$4f,$e5), ($cb,$d7,$c5,$2a), ($44,$80,$26,$35), ($a3,$8f,$b5,$62), - ($5a,$49,$de,$b1), ($1b,$67,$25,$ba), ($0e,$98,$45,$ea), ($c0,$e1,$5d,$fe), - ($75,$02,$c3,$2f), ($f0,$12,$81,$4c), ($97,$a3,$8d,$46), ($f9,$c6,$6b,$d3), - ($5f,$e7,$03,$8f), ($9c,$95,$15,$92), ($7a,$eb,$bf,$6d), ($59,$da,$95,$52), - ($83,$2d,$d4,$be), ($21,$d3,$58,$74), ($69,$29,$49,$e0), ($c8,$44,$8e,$c9), - ($89,$6a,$75,$c2), ($79,$78,$f4,$8e), ($3e,$6b,$99,$58), ($71,$dd,$27,$b9), - ($4f,$b6,$be,$e1), ($ad,$17,$f0,$88), ($ac,$66,$c9,$20), ($3a,$b4,$7d,$ce), - ($4a,$18,$63,$df), ($31,$82,$e5,$1a), ($33,$60,$97,$51), ($7f,$45,$62,$53), - ($77,$e0,$b1,$64), ($ae,$84,$bb,$6b), ($a0,$1c,$fe,$81), ($2b,$94,$f9,$08), - ($68,$58,$70,$48), ($fd,$19,$8f,$45), ($6c,$87,$94,$de), ($f8,$b7,$52,$7b), - ($d3,$23,$ab,$73), ($02,$e2,$72,$4b), ($8f,$57,$e3,$1f), ($ab,$2a,$66,$55), - ($28,$07,$b2,$eb), ($c2,$03,$2f,$b5), ($7b,$9a,$86,$c5), ($08,$a5,$d3,$37), - ($87,$f2,$30,$28), ($a5,$b2,$23,$bf), ($6a,$ba,$02,$03), ($82,$5c,$ed,$16), - ($1c,$2b,$8a,$cf), ($b4,$92,$a7,$79), ($f2,$f0,$f3,$07), ($e2,$a1,$4e,$69), - ($f4,$cd,$65,$da), ($be,$d5,$06,$05), ($62,$1f,$d1,$34), ($fe,$8a,$c4,$a6), - ($53,$9d,$34,$2e), ($55,$a0,$a2,$f3), ($e1,$32,$05,$8a), ($eb,$75,$a4,$f6), - ($ec,$39,$0b,$83), ($ef,$aa,$40,$60), ($9f,$06,$5e,$71), ($10,$51,$bd,$6e), - ($8a,$f9,$3e,$21), ($06,$3d,$96,$dd), ($05,$ae,$dd,$3e), ($bd,$46,$4d,$e6), - ($8d,$b5,$91,$54), ($5d,$05,$71,$c4), ($d4,$6f,$04,$06), ($15,$ff,$60,$50), - ($fb,$24,$19,$98), ($e9,$97,$d6,$bd), ($43,$cc,$89,$40), ($9e,$77,$67,$d9), - ($42,$bd,$b0,$e8), ($8b,$88,$07,$89), ($5b,$38,$e7,$19), ($ee,$db,$79,$c8), - ($0a,$47,$a1,$7c), ($0f,$e9,$7c,$42), ($1e,$c9,$f8,$84), ($00,$00,$00,$00), - ($86,$83,$09,$80), ($ed,$48,$32,$2b), ($70,$ac,$1e,$11), ($72,$4e,$6c,$5a), - ($ff,$fb,$fd,$0e), ($38,$56,$0f,$85), ($d5,$1e,$3d,$ae), ($39,$27,$36,$2d), - ($d9,$64,$0a,$0f), ($a6,$21,$68,$5c), ($54,$d1,$9b,$5b), ($2e,$3a,$24,$36), - ($67,$b1,$0c,$0a), ($e7,$0f,$93,$57), ($96,$d2,$b4,$ee), ($91,$9e,$1b,$9b), - ($c5,$4f,$80,$c0), ($20,$a2,$61,$dc), ($4b,$69,$5a,$77), ($1a,$16,$1c,$12), - ($ba,$0a,$e2,$93), ($2a,$e5,$c0,$a0), ($e0,$43,$3c,$22), ($17,$1d,$12,$1b), - ($0d,$0b,$0e,$09), ($c7,$ad,$f2,$8b), ($a8,$b9,$2d,$b6), ($a9,$c8,$14,$1e), - ($19,$85,$57,$f1), ($07,$4c,$af,$75), ($dd,$bb,$ee,$99), ($60,$fd,$a3,$7f), - ($26,$9f,$f7,$01), ($f5,$bc,$5c,$72), ($3b,$c5,$44,$66), ($7e,$34,$5b,$fb), - ($29,$76,$8b,$43), ($c6,$dc,$cb,$23), ($fc,$68,$b6,$ed), ($f1,$63,$b8,$e4), - ($dc,$ca,$d7,$31), ($85,$10,$42,$63), ($22,$40,$13,$97), ($11,$20,$84,$c6), - ($24,$7d,$85,$4a), ($3d,$f8,$d2,$bb), ($32,$11,$ae,$f9), ($a1,$6d,$c7,$29), - ($2f,$4b,$1d,$9e), ($30,$f3,$dc,$b2), ($52,$ec,$0d,$86), ($e3,$d0,$77,$c1), - ($16,$6c,$2b,$b3), ($b9,$99,$a9,$70), ($48,$fa,$11,$94), ($64,$22,$47,$e9), - ($8c,$c4,$a8,$fc), ($3f,$1a,$a0,$f0), ($2c,$d8,$56,$7d), ($90,$ef,$22,$33), - ($4e,$c7,$87,$49), ($d1,$c1,$d9,$38), ($a2,$fe,$8c,$ca), ($0b,$36,$98,$d4), - ($81,$cf,$a6,$f5), ($de,$28,$a5,$7a), ($8e,$26,$da,$b7), ($bf,$a4,$3f,$ad), - ($9d,$e4,$2c,$3a), ($92,$0d,$50,$78), ($cc,$9b,$6a,$5f), ($46,$62,$54,$7e), - ($13,$c2,$f6,$8d), ($b8,$e8,$90,$d8), ($f7,$5e,$2e,$39), ($af,$f5,$82,$c3), - ($80,$be,$9f,$5d), ($93,$7c,$69,$d0), ($2d,$a9,$6f,$d5), ($12,$b3,$cf,$25), - ($99,$3b,$c8,$ac), ($7d,$a7,$10,$18), ($63,$6e,$e8,$9c), ($bb,$7b,$db,$3b), - ($78,$09,$cd,$26), ($18,$f4,$6e,$59), ($b7,$01,$ec,$9a), ($9a,$a8,$83,$4f), - ($6e,$65,$e6,$95), ($e6,$7e,$aa,$ff), ($cf,$08,$21,$bc), ($e8,$e6,$ef,$15), - ($9b,$d9,$ba,$e7), ($36,$ce,$4a,$6f), ($09,$d4,$ea,$9f), ($7c,$d6,$29,$b0), - ($b2,$af,$31,$a4), ($23,$31,$2a,$3f), ($94,$30,$c6,$a5), ($66,$c0,$35,$a2), - ($bc,$37,$74,$4e), ($ca,$a6,$fc,$82), ($d0,$b0,$e0,$90), ($d8,$15,$33,$a7), - ($98,$4a,$f1,$04), ($da,$f7,$41,$ec), ($50,$0e,$7f,$cd), ($f6,$2f,$17,$91), - ($d6,$8d,$76,$4d), ($b0,$4d,$43,$ef), ($4d,$54,$cc,$aa), ($04,$df,$e4,$96), - ($b5,$e3,$9e,$d1), ($88,$1b,$4c,$6a), ($1f,$b8,$c1,$2c), ($51,$7f,$46,$65), - ($ea,$04,$9d,$5e), ($35,$5d,$01,$8c), ($74,$73,$fa,$87), ($41,$2e,$fb,$0b), - ($1d,$5a,$b3,$67), ($d2,$52,$92,$db), ($56,$33,$e9,$10), ($47,$13,$6d,$d6), - ($61,$8c,$9a,$d7), ($0c,$7a,$37,$a1), ($14,$8e,$59,$f8), ($3c,$89,$eb,$13), - ($27,$ee,$ce,$a9), ($c9,$35,$b7,$61), ($e5,$ed,$e1,$1c), ($b1,$3c,$7a,$47), - ($df,$59,$9c,$d2), ($73,$3f,$55,$f2), ($ce,$79,$18,$14), ($37,$bf,$73,$c7), - ($cd,$ea,$53,$f7), ($aa,$5b,$5f,$fd), ($6f,$14,$df,$3d), ($db,$86,$78,$44), - ($f3,$81,$ca,$af), ($c4,$3e,$b9,$68), ($34,$2c,$38,$24), ($40,$5f,$c2,$a3), - ($c3,$72,$16,$1d), ($25,$0c,$bc,$e2), ($49,$8b,$28,$3c), ($95,$41,$ff,$0d), - ($01,$71,$39,$a8), ($b3,$de,$08,$0c), ($e4,$9c,$d8,$b4), ($c1,$90,$64,$56), - ($84,$61,$7b,$cb), ($b6,$70,$d5,$32), ($5c,$74,$48,$6c), ($57,$42,$d0,$b8)); - T8: array[0..255,0..3] of byte= ( - ($f4,$a7,$50,$51), ($41,$65,$53,$7e), ($17,$a4,$c3,$1a), ($27,$5e,$96,$3a), - ($ab,$6b,$cb,$3b), ($9d,$45,$f1,$1f), ($fa,$58,$ab,$ac), ($e3,$03,$93,$4b), - ($30,$fa,$55,$20), ($76,$6d,$f6,$ad), ($cc,$76,$91,$88), ($02,$4c,$25,$f5), - ($e5,$d7,$fc,$4f), ($2a,$cb,$d7,$c5), ($35,$44,$80,$26), ($62,$a3,$8f,$b5), - ($b1,$5a,$49,$de), ($ba,$1b,$67,$25), ($ea,$0e,$98,$45), ($fe,$c0,$e1,$5d), - ($2f,$75,$02,$c3), ($4c,$f0,$12,$81), ($46,$97,$a3,$8d), ($d3,$f9,$c6,$6b), - ($8f,$5f,$e7,$03), ($92,$9c,$95,$15), ($6d,$7a,$eb,$bf), ($52,$59,$da,$95), - ($be,$83,$2d,$d4), ($74,$21,$d3,$58), ($e0,$69,$29,$49), ($c9,$c8,$44,$8e), - ($c2,$89,$6a,$75), ($8e,$79,$78,$f4), ($58,$3e,$6b,$99), ($b9,$71,$dd,$27), - ($e1,$4f,$b6,$be), ($88,$ad,$17,$f0), ($20,$ac,$66,$c9), ($ce,$3a,$b4,$7d), - ($df,$4a,$18,$63), ($1a,$31,$82,$e5), ($51,$33,$60,$97), ($53,$7f,$45,$62), - ($64,$77,$e0,$b1), ($6b,$ae,$84,$bb), ($81,$a0,$1c,$fe), ($08,$2b,$94,$f9), - ($48,$68,$58,$70), ($45,$fd,$19,$8f), ($de,$6c,$87,$94), ($7b,$f8,$b7,$52), - ($73,$d3,$23,$ab), ($4b,$02,$e2,$72), ($1f,$8f,$57,$e3), ($55,$ab,$2a,$66), - ($eb,$28,$07,$b2), ($b5,$c2,$03,$2f), ($c5,$7b,$9a,$86), ($37,$08,$a5,$d3), - ($28,$87,$f2,$30), ($bf,$a5,$b2,$23), ($03,$6a,$ba,$02), ($16,$82,$5c,$ed), - ($cf,$1c,$2b,$8a), ($79,$b4,$92,$a7), ($07,$f2,$f0,$f3), ($69,$e2,$a1,$4e), - ($da,$f4,$cd,$65), ($05,$be,$d5,$06), ($34,$62,$1f,$d1), ($a6,$fe,$8a,$c4), - ($2e,$53,$9d,$34), ($f3,$55,$a0,$a2), ($8a,$e1,$32,$05), ($f6,$eb,$75,$a4), - ($83,$ec,$39,$0b), ($60,$ef,$aa,$40), ($71,$9f,$06,$5e), ($6e,$10,$51,$bd), - ($21,$8a,$f9,$3e), ($dd,$06,$3d,$96), ($3e,$05,$ae,$dd), ($e6,$bd,$46,$4d), - ($54,$8d,$b5,$91), ($c4,$5d,$05,$71), ($06,$d4,$6f,$04), ($50,$15,$ff,$60), - ($98,$fb,$24,$19), ($bd,$e9,$97,$d6), ($40,$43,$cc,$89), ($d9,$9e,$77,$67), - ($e8,$42,$bd,$b0), ($89,$8b,$88,$07), ($19,$5b,$38,$e7), ($c8,$ee,$db,$79), - ($7c,$0a,$47,$a1), ($42,$0f,$e9,$7c), ($84,$1e,$c9,$f8), ($00,$00,$00,$00), - ($80,$86,$83,$09), ($2b,$ed,$48,$32), ($11,$70,$ac,$1e), ($5a,$72,$4e,$6c), - ($0e,$ff,$fb,$fd), ($85,$38,$56,$0f), ($ae,$d5,$1e,$3d), ($2d,$39,$27,$36), - ($0f,$d9,$64,$0a), ($5c,$a6,$21,$68), ($5b,$54,$d1,$9b), ($36,$2e,$3a,$24), - ($0a,$67,$b1,$0c), ($57,$e7,$0f,$93), ($ee,$96,$d2,$b4), ($9b,$91,$9e,$1b), - ($c0,$c5,$4f,$80), ($dc,$20,$a2,$61), ($77,$4b,$69,$5a), ($12,$1a,$16,$1c), - ($93,$ba,$0a,$e2), ($a0,$2a,$e5,$c0), ($22,$e0,$43,$3c), ($1b,$17,$1d,$12), - ($09,$0d,$0b,$0e), ($8b,$c7,$ad,$f2), ($b6,$a8,$b9,$2d), ($1e,$a9,$c8,$14), - ($f1,$19,$85,$57), ($75,$07,$4c,$af), ($99,$dd,$bb,$ee), ($7f,$60,$fd,$a3), - ($01,$26,$9f,$f7), ($72,$f5,$bc,$5c), ($66,$3b,$c5,$44), ($fb,$7e,$34,$5b), - ($43,$29,$76,$8b), ($23,$c6,$dc,$cb), ($ed,$fc,$68,$b6), ($e4,$f1,$63,$b8), - ($31,$dc,$ca,$d7), ($63,$85,$10,$42), ($97,$22,$40,$13), ($c6,$11,$20,$84), - ($4a,$24,$7d,$85), ($bb,$3d,$f8,$d2), ($f9,$32,$11,$ae), ($29,$a1,$6d,$c7), - ($9e,$2f,$4b,$1d), ($b2,$30,$f3,$dc), ($86,$52,$ec,$0d), ($c1,$e3,$d0,$77), - ($b3,$16,$6c,$2b), ($70,$b9,$99,$a9), ($94,$48,$fa,$11), ($e9,$64,$22,$47), - ($fc,$8c,$c4,$a8), ($f0,$3f,$1a,$a0), ($7d,$2c,$d8,$56), ($33,$90,$ef,$22), - ($49,$4e,$c7,$87), ($38,$d1,$c1,$d9), ($ca,$a2,$fe,$8c), ($d4,$0b,$36,$98), - ($f5,$81,$cf,$a6), ($7a,$de,$28,$a5), ($b7,$8e,$26,$da), ($ad,$bf,$a4,$3f), - ($3a,$9d,$e4,$2c), ($78,$92,$0d,$50), ($5f,$cc,$9b,$6a), ($7e,$46,$62,$54), - ($8d,$13,$c2,$f6), ($d8,$b8,$e8,$90), ($39,$f7,$5e,$2e), ($c3,$af,$f5,$82), - ($5d,$80,$be,$9f), ($d0,$93,$7c,$69), ($d5,$2d,$a9,$6f), ($25,$12,$b3,$cf), - ($ac,$99,$3b,$c8), ($18,$7d,$a7,$10), ($9c,$63,$6e,$e8), ($3b,$bb,$7b,$db), - ($26,$78,$09,$cd), ($59,$18,$f4,$6e), ($9a,$b7,$01,$ec), ($4f,$9a,$a8,$83), - ($95,$6e,$65,$e6), ($ff,$e6,$7e,$aa), ($bc,$cf,$08,$21), ($15,$e8,$e6,$ef), - ($e7,$9b,$d9,$ba), ($6f,$36,$ce,$4a), ($9f,$09,$d4,$ea), ($b0,$7c,$d6,$29), - ($a4,$b2,$af,$31), ($3f,$23,$31,$2a), ($a5,$94,$30,$c6), ($a2,$66,$c0,$35), - ($4e,$bc,$37,$74), ($82,$ca,$a6,$fc), ($90,$d0,$b0,$e0), ($a7,$d8,$15,$33), - ($04,$98,$4a,$f1), ($ec,$da,$f7,$41), ($cd,$50,$0e,$7f), ($91,$f6,$2f,$17), - ($4d,$d6,$8d,$76), ($ef,$b0,$4d,$43), ($aa,$4d,$54,$cc), ($96,$04,$df,$e4), - ($d1,$b5,$e3,$9e), ($6a,$88,$1b,$4c), ($2c,$1f,$b8,$c1), ($65,$51,$7f,$46), - ($5e,$ea,$04,$9d), ($8c,$35,$5d,$01), ($87,$74,$73,$fa), ($0b,$41,$2e,$fb), - ($67,$1d,$5a,$b3), ($db,$d2,$52,$92), ($10,$56,$33,$e9), ($d6,$47,$13,$6d), - ($d7,$61,$8c,$9a), ($a1,$0c,$7a,$37), ($f8,$14,$8e,$59), ($13,$3c,$89,$eb), - ($a9,$27,$ee,$ce), ($61,$c9,$35,$b7), ($1c,$e5,$ed,$e1), ($47,$b1,$3c,$7a), - ($d2,$df,$59,$9c), ($f2,$73,$3f,$55), ($14,$ce,$79,$18), ($c7,$37,$bf,$73), - ($f7,$cd,$ea,$53), ($fd,$aa,$5b,$5f), ($3d,$6f,$14,$df), ($44,$db,$86,$78), - ($af,$f3,$81,$ca), ($68,$c4,$3e,$b9), ($24,$34,$2c,$38), ($a3,$40,$5f,$c2), - ($1d,$c3,$72,$16), ($e2,$25,$0c,$bc), ($3c,$49,$8b,$28), ($0d,$95,$41,$ff), - ($a8,$01,$71,$39), ($0c,$b3,$de,$08), ($b4,$e4,$9c,$d8), ($56,$c1,$90,$64), - ($cb,$84,$61,$7b), ($32,$b6,$70,$d5), ($6c,$5c,$74,$48), ($b8,$57,$42,$d0)); - S5: array[0..255] of byte= ( - $52,$09,$6a,$d5, - $30,$36,$a5,$38, - $bf,$40,$a3,$9e, - $81,$f3,$d7,$fb, - $7c,$e3,$39,$82, - $9b,$2f,$ff,$87, - $34,$8e,$43,$44, - $c4,$de,$e9,$cb, - $54,$7b,$94,$32, - $a6,$c2,$23,$3d, - $ee,$4c,$95,$0b, - $42,$fa,$c3,$4e, - $08,$2e,$a1,$66, - $28,$d9,$24,$b2, - $76,$5b,$a2,$49, - $6d,$8b,$d1,$25, - $72,$f8,$f6,$64, - $86,$68,$98,$16, - $d4,$a4,$5c,$cc, - $5d,$65,$b6,$92, - $6c,$70,$48,$50, - $fd,$ed,$b9,$da, - $5e,$15,$46,$57, - $a7,$8d,$9d,$84, - $90,$d8,$ab,$00, - $8c,$bc,$d3,$0a, - $f7,$e4,$58,$05, - $b8,$b3,$45,$06, - $d0,$2c,$1e,$8f, - $ca,$3f,$0f,$02, - $c1,$af,$bd,$03, - $01,$13,$8a,$6b, - $3a,$91,$11,$41, - $4f,$67,$dc,$ea, - $97,$f2,$cf,$ce, - $f0,$b4,$e6,$73, - $96,$ac,$74,$22, - $e7,$ad,$35,$85, - $e2,$f9,$37,$e8, - $1c,$75,$df,$6e, - $47,$f1,$1a,$71, - $1d,$29,$c5,$89, - $6f,$b7,$62,$0e, - $aa,$18,$be,$1b, - $fc,$56,$3e,$4b, - $c6,$d2,$79,$20, - $9a,$db,$c0,$fe, - $78,$cd,$5a,$f4, - $1f,$dd,$a8,$33, - $88,$07,$c7,$31, - $b1,$12,$10,$59, - $27,$80,$ec,$5f, - $60,$51,$7f,$a9, - $19,$b5,$4a,$0d, - $2d,$e5,$7a,$9f, - $93,$c9,$9c,$ef, - $a0,$e0,$3b,$4d, - $ae,$2a,$f5,$b0, - $c8,$eb,$bb,$3c, - $83,$53,$99,$61, - $17,$2b,$04,$7e, - $ba,$77,$d6,$26, - $e1,$69,$14,$63, - $55,$21,$0c,$7d); - U1: array[0..255,0..3] of byte= ( - ($00,$00,$00,$00), ($0e,$09,$0d,$0b), ($1c,$12,$1a,$16), ($12,$1b,$17,$1d), - ($38,$24,$34,$2c), ($36,$2d,$39,$27), ($24,$36,$2e,$3a), ($2a,$3f,$23,$31), - ($70,$48,$68,$58), ($7e,$41,$65,$53), ($6c,$5a,$72,$4e), ($62,$53,$7f,$45), - ($48,$6c,$5c,$74), ($46,$65,$51,$7f), ($54,$7e,$46,$62), ($5a,$77,$4b,$69), - ($e0,$90,$d0,$b0), ($ee,$99,$dd,$bb), ($fc,$82,$ca,$a6), ($f2,$8b,$c7,$ad), - ($d8,$b4,$e4,$9c), ($d6,$bd,$e9,$97), ($c4,$a6,$fe,$8a), ($ca,$af,$f3,$81), - ($90,$d8,$b8,$e8), ($9e,$d1,$b5,$e3), ($8c,$ca,$a2,$fe), ($82,$c3,$af,$f5), - ($a8,$fc,$8c,$c4), ($a6,$f5,$81,$cf), ($b4,$ee,$96,$d2), ($ba,$e7,$9b,$d9), - ($db,$3b,$bb,$7b), ($d5,$32,$b6,$70), ($c7,$29,$a1,$6d), ($c9,$20,$ac,$66), - ($e3,$1f,$8f,$57), ($ed,$16,$82,$5c), ($ff,$0d,$95,$41), ($f1,$04,$98,$4a), - ($ab,$73,$d3,$23), ($a5,$7a,$de,$28), ($b7,$61,$c9,$35), ($b9,$68,$c4,$3e), - ($93,$57,$e7,$0f), ($9d,$5e,$ea,$04), ($8f,$45,$fd,$19), ($81,$4c,$f0,$12), - ($3b,$ab,$6b,$cb), ($35,$a2,$66,$c0), ($27,$b9,$71,$dd), ($29,$b0,$7c,$d6), - ($03,$8f,$5f,$e7), ($0d,$86,$52,$ec), ($1f,$9d,$45,$f1), ($11,$94,$48,$fa), - ($4b,$e3,$03,$93), ($45,$ea,$0e,$98), ($57,$f1,$19,$85), ($59,$f8,$14,$8e), - ($73,$c7,$37,$bf), ($7d,$ce,$3a,$b4), ($6f,$d5,$2d,$a9), ($61,$dc,$20,$a2), - ($ad,$76,$6d,$f6), ($a3,$7f,$60,$fd), ($b1,$64,$77,$e0), ($bf,$6d,$7a,$eb), - ($95,$52,$59,$da), ($9b,$5b,$54,$d1), ($89,$40,$43,$cc), ($87,$49,$4e,$c7), - ($dd,$3e,$05,$ae), ($d3,$37,$08,$a5), ($c1,$2c,$1f,$b8), ($cf,$25,$12,$b3), - ($e5,$1a,$31,$82), ($eb,$13,$3c,$89), ($f9,$08,$2b,$94), ($f7,$01,$26,$9f), - ($4d,$e6,$bd,$46), ($43,$ef,$b0,$4d), ($51,$f4,$a7,$50), ($5f,$fd,$aa,$5b), - ($75,$c2,$89,$6a), ($7b,$cb,$84,$61), ($69,$d0,$93,$7c), ($67,$d9,$9e,$77), - ($3d,$ae,$d5,$1e), ($33,$a7,$d8,$15), ($21,$bc,$cf,$08), ($2f,$b5,$c2,$03), - ($05,$8a,$e1,$32), ($0b,$83,$ec,$39), ($19,$98,$fb,$24), ($17,$91,$f6,$2f), - ($76,$4d,$d6,$8d), ($78,$44,$db,$86), ($6a,$5f,$cc,$9b), ($64,$56,$c1,$90), - ($4e,$69,$e2,$a1), ($40,$60,$ef,$aa), ($52,$7b,$f8,$b7), ($5c,$72,$f5,$bc), - ($06,$05,$be,$d5), ($08,$0c,$b3,$de), ($1a,$17,$a4,$c3), ($14,$1e,$a9,$c8), - ($3e,$21,$8a,$f9), ($30,$28,$87,$f2), ($22,$33,$90,$ef), ($2c,$3a,$9d,$e4), - ($96,$dd,$06,$3d), ($98,$d4,$0b,$36), ($8a,$cf,$1c,$2b), ($84,$c6,$11,$20), - ($ae,$f9,$32,$11), ($a0,$f0,$3f,$1a), ($b2,$eb,$28,$07), ($bc,$e2,$25,$0c), - ($e6,$95,$6e,$65), ($e8,$9c,$63,$6e), ($fa,$87,$74,$73), ($f4,$8e,$79,$78), - ($de,$b1,$5a,$49), ($d0,$b8,$57,$42), ($c2,$a3,$40,$5f), ($cc,$aa,$4d,$54), - ($41,$ec,$da,$f7), ($4f,$e5,$d7,$fc), ($5d,$fe,$c0,$e1), ($53,$f7,$cd,$ea), - ($79,$c8,$ee,$db), ($77,$c1,$e3,$d0), ($65,$da,$f4,$cd), ($6b,$d3,$f9,$c6), - ($31,$a4,$b2,$af), ($3f,$ad,$bf,$a4), ($2d,$b6,$a8,$b9), ($23,$bf,$a5,$b2), - ($09,$80,$86,$83), ($07,$89,$8b,$88), ($15,$92,$9c,$95), ($1b,$9b,$91,$9e), - ($a1,$7c,$0a,$47), ($af,$75,$07,$4c), ($bd,$6e,$10,$51), ($b3,$67,$1d,$5a), - ($99,$58,$3e,$6b), ($97,$51,$33,$60), ($85,$4a,$24,$7d), ($8b,$43,$29,$76), - ($d1,$34,$62,$1f), ($df,$3d,$6f,$14), ($cd,$26,$78,$09), ($c3,$2f,$75,$02), - ($e9,$10,$56,$33), ($e7,$19,$5b,$38), ($f5,$02,$4c,$25), ($fb,$0b,$41,$2e), - ($9a,$d7,$61,$8c), ($94,$de,$6c,$87), ($86,$c5,$7b,$9a), ($88,$cc,$76,$91), - ($a2,$f3,$55,$a0), ($ac,$fa,$58,$ab), ($be,$e1,$4f,$b6), ($b0,$e8,$42,$bd), - ($ea,$9f,$09,$d4), ($e4,$96,$04,$df), ($f6,$8d,$13,$c2), ($f8,$84,$1e,$c9), - ($d2,$bb,$3d,$f8), ($dc,$b2,$30,$f3), ($ce,$a9,$27,$ee), ($c0,$a0,$2a,$e5), - ($7a,$47,$b1,$3c), ($74,$4e,$bc,$37), ($66,$55,$ab,$2a), ($68,$5c,$a6,$21), - ($42,$63,$85,$10), ($4c,$6a,$88,$1b), ($5e,$71,$9f,$06), ($50,$78,$92,$0d), - ($0a,$0f,$d9,$64), ($04,$06,$d4,$6f), ($16,$1d,$c3,$72), ($18,$14,$ce,$79), - ($32,$2b,$ed,$48), ($3c,$22,$e0,$43), ($2e,$39,$f7,$5e), ($20,$30,$fa,$55), - ($ec,$9a,$b7,$01), ($e2,$93,$ba,$0a), ($f0,$88,$ad,$17), ($fe,$81,$a0,$1c), - ($d4,$be,$83,$2d), ($da,$b7,$8e,$26), ($c8,$ac,$99,$3b), ($c6,$a5,$94,$30), - ($9c,$d2,$df,$59), ($92,$db,$d2,$52), ($80,$c0,$c5,$4f), ($8e,$c9,$c8,$44), - ($a4,$f6,$eb,$75), ($aa,$ff,$e6,$7e), ($b8,$e4,$f1,$63), ($b6,$ed,$fc,$68), - ($0c,$0a,$67,$b1), ($02,$03,$6a,$ba), ($10,$18,$7d,$a7), ($1e,$11,$70,$ac), - ($34,$2e,$53,$9d), ($3a,$27,$5e,$96), ($28,$3c,$49,$8b), ($26,$35,$44,$80), - ($7c,$42,$0f,$e9), ($72,$4b,$02,$e2), ($60,$50,$15,$ff), ($6e,$59,$18,$f4), - ($44,$66,$3b,$c5), ($4a,$6f,$36,$ce), ($58,$74,$21,$d3), ($56,$7d,$2c,$d8), - ($37,$a1,$0c,$7a), ($39,$a8,$01,$71), ($2b,$b3,$16,$6c), ($25,$ba,$1b,$67), - ($0f,$85,$38,$56), ($01,$8c,$35,$5d), ($13,$97,$22,$40), ($1d,$9e,$2f,$4b), - ($47,$e9,$64,$22), ($49,$e0,$69,$29), ($5b,$fb,$7e,$34), ($55,$f2,$73,$3f), - ($7f,$cd,$50,$0e), ($71,$c4,$5d,$05), ($63,$df,$4a,$18), ($6d,$d6,$47,$13), - ($d7,$31,$dc,$ca), ($d9,$38,$d1,$c1), ($cb,$23,$c6,$dc), ($c5,$2a,$cb,$d7), - ($ef,$15,$e8,$e6), ($e1,$1c,$e5,$ed), ($f3,$07,$f2,$f0), ($fd,$0e,$ff,$fb), - ($a7,$79,$b4,$92), ($a9,$70,$b9,$99), ($bb,$6b,$ae,$84), ($b5,$62,$a3,$8f), - ($9f,$5d,$80,$be), ($91,$54,$8d,$b5), ($83,$4f,$9a,$a8), ($8d,$46,$97,$a3)); - U2: array[0..255,0..3] of byte= ( - ($00,$00,$00,$00), ($0b,$0e,$09,$0d), ($16,$1c,$12,$1a), ($1d,$12,$1b,$17), - ($2c,$38,$24,$34), ($27,$36,$2d,$39), ($3a,$24,$36,$2e), ($31,$2a,$3f,$23), - ($58,$70,$48,$68), ($53,$7e,$41,$65), ($4e,$6c,$5a,$72), ($45,$62,$53,$7f), - ($74,$48,$6c,$5c), ($7f,$46,$65,$51), ($62,$54,$7e,$46), ($69,$5a,$77,$4b), - ($b0,$e0,$90,$d0), ($bb,$ee,$99,$dd), ($a6,$fc,$82,$ca), ($ad,$f2,$8b,$c7), - ($9c,$d8,$b4,$e4), ($97,$d6,$bd,$e9), ($8a,$c4,$a6,$fe), ($81,$ca,$af,$f3), - ($e8,$90,$d8,$b8), ($e3,$9e,$d1,$b5), ($fe,$8c,$ca,$a2), ($f5,$82,$c3,$af), - ($c4,$a8,$fc,$8c), ($cf,$a6,$f5,$81), ($d2,$b4,$ee,$96), ($d9,$ba,$e7,$9b), - ($7b,$db,$3b,$bb), ($70,$d5,$32,$b6), ($6d,$c7,$29,$a1), ($66,$c9,$20,$ac), - ($57,$e3,$1f,$8f), ($5c,$ed,$16,$82), ($41,$ff,$0d,$95), ($4a,$f1,$04,$98), - ($23,$ab,$73,$d3), ($28,$a5,$7a,$de), ($35,$b7,$61,$c9), ($3e,$b9,$68,$c4), - ($0f,$93,$57,$e7), ($04,$9d,$5e,$ea), ($19,$8f,$45,$fd), ($12,$81,$4c,$f0), - ($cb,$3b,$ab,$6b), ($c0,$35,$a2,$66), ($dd,$27,$b9,$71), ($d6,$29,$b0,$7c), - ($e7,$03,$8f,$5f), ($ec,$0d,$86,$52), ($f1,$1f,$9d,$45), ($fa,$11,$94,$48), - ($93,$4b,$e3,$03), ($98,$45,$ea,$0e), ($85,$57,$f1,$19), ($8e,$59,$f8,$14), - ($bf,$73,$c7,$37), ($b4,$7d,$ce,$3a), ($a9,$6f,$d5,$2d), ($a2,$61,$dc,$20), - ($f6,$ad,$76,$6d), ($fd,$a3,$7f,$60), ($e0,$b1,$64,$77), ($eb,$bf,$6d,$7a), - ($da,$95,$52,$59), ($d1,$9b,$5b,$54), ($cc,$89,$40,$43), ($c7,$87,$49,$4e), - ($ae,$dd,$3e,$05), ($a5,$d3,$37,$08), ($b8,$c1,$2c,$1f), ($b3,$cf,$25,$12), - ($82,$e5,$1a,$31), ($89,$eb,$13,$3c), ($94,$f9,$08,$2b), ($9f,$f7,$01,$26), - ($46,$4d,$e6,$bd), ($4d,$43,$ef,$b0), ($50,$51,$f4,$a7), ($5b,$5f,$fd,$aa), - ($6a,$75,$c2,$89), ($61,$7b,$cb,$84), ($7c,$69,$d0,$93), ($77,$67,$d9,$9e), - ($1e,$3d,$ae,$d5), ($15,$33,$a7,$d8), ($08,$21,$bc,$cf), ($03,$2f,$b5,$c2), - ($32,$05,$8a,$e1), ($39,$0b,$83,$ec), ($24,$19,$98,$fb), ($2f,$17,$91,$f6), - ($8d,$76,$4d,$d6), ($86,$78,$44,$db), ($9b,$6a,$5f,$cc), ($90,$64,$56,$c1), - ($a1,$4e,$69,$e2), ($aa,$40,$60,$ef), ($b7,$52,$7b,$f8), ($bc,$5c,$72,$f5), - ($d5,$06,$05,$be), ($de,$08,$0c,$b3), ($c3,$1a,$17,$a4), ($c8,$14,$1e,$a9), - ($f9,$3e,$21,$8a), ($f2,$30,$28,$87), ($ef,$22,$33,$90), ($e4,$2c,$3a,$9d), - ($3d,$96,$dd,$06), ($36,$98,$d4,$0b), ($2b,$8a,$cf,$1c), ($20,$84,$c6,$11), - ($11,$ae,$f9,$32), ($1a,$a0,$f0,$3f), ($07,$b2,$eb,$28), ($0c,$bc,$e2,$25), - ($65,$e6,$95,$6e), ($6e,$e8,$9c,$63), ($73,$fa,$87,$74), ($78,$f4,$8e,$79), - ($49,$de,$b1,$5a), ($42,$d0,$b8,$57), ($5f,$c2,$a3,$40), ($54,$cc,$aa,$4d), - ($f7,$41,$ec,$da), ($fc,$4f,$e5,$d7), ($e1,$5d,$fe,$c0), ($ea,$53,$f7,$cd), - ($db,$79,$c8,$ee), ($d0,$77,$c1,$e3), ($cd,$65,$da,$f4), ($c6,$6b,$d3,$f9), - ($af,$31,$a4,$b2), ($a4,$3f,$ad,$bf), ($b9,$2d,$b6,$a8), ($b2,$23,$bf,$a5), - ($83,$09,$80,$86), ($88,$07,$89,$8b), ($95,$15,$92,$9c), ($9e,$1b,$9b,$91), - ($47,$a1,$7c,$0a), ($4c,$af,$75,$07), ($51,$bd,$6e,$10), ($5a,$b3,$67,$1d), - ($6b,$99,$58,$3e), ($60,$97,$51,$33), ($7d,$85,$4a,$24), ($76,$8b,$43,$29), - ($1f,$d1,$34,$62), ($14,$df,$3d,$6f), ($09,$cd,$26,$78), ($02,$c3,$2f,$75), - ($33,$e9,$10,$56), ($38,$e7,$19,$5b), ($25,$f5,$02,$4c), ($2e,$fb,$0b,$41), - ($8c,$9a,$d7,$61), ($87,$94,$de,$6c), ($9a,$86,$c5,$7b), ($91,$88,$cc,$76), - ($a0,$a2,$f3,$55), ($ab,$ac,$fa,$58), ($b6,$be,$e1,$4f), ($bd,$b0,$e8,$42), - ($d4,$ea,$9f,$09), ($df,$e4,$96,$04), ($c2,$f6,$8d,$13), ($c9,$f8,$84,$1e), - ($f8,$d2,$bb,$3d), ($f3,$dc,$b2,$30), ($ee,$ce,$a9,$27), ($e5,$c0,$a0,$2a), - ($3c,$7a,$47,$b1), ($37,$74,$4e,$bc), ($2a,$66,$55,$ab), ($21,$68,$5c,$a6), - ($10,$42,$63,$85), ($1b,$4c,$6a,$88), ($06,$5e,$71,$9f), ($0d,$50,$78,$92), - ($64,$0a,$0f,$d9), ($6f,$04,$06,$d4), ($72,$16,$1d,$c3), ($79,$18,$14,$ce), - ($48,$32,$2b,$ed), ($43,$3c,$22,$e0), ($5e,$2e,$39,$f7), ($55,$20,$30,$fa), - ($01,$ec,$9a,$b7), ($0a,$e2,$93,$ba), ($17,$f0,$88,$ad), ($1c,$fe,$81,$a0), - ($2d,$d4,$be,$83), ($26,$da,$b7,$8e), ($3b,$c8,$ac,$99), ($30,$c6,$a5,$94), - ($59,$9c,$d2,$df), ($52,$92,$db,$d2), ($4f,$80,$c0,$c5), ($44,$8e,$c9,$c8), - ($75,$a4,$f6,$eb), ($7e,$aa,$ff,$e6), ($63,$b8,$e4,$f1), ($68,$b6,$ed,$fc), - ($b1,$0c,$0a,$67), ($ba,$02,$03,$6a), ($a7,$10,$18,$7d), ($ac,$1e,$11,$70), - ($9d,$34,$2e,$53), ($96,$3a,$27,$5e), ($8b,$28,$3c,$49), ($80,$26,$35,$44), - ($e9,$7c,$42,$0f), ($e2,$72,$4b,$02), ($ff,$60,$50,$15), ($f4,$6e,$59,$18), - ($c5,$44,$66,$3b), ($ce,$4a,$6f,$36), ($d3,$58,$74,$21), ($d8,$56,$7d,$2c), - ($7a,$37,$a1,$0c), ($71,$39,$a8,$01), ($6c,$2b,$b3,$16), ($67,$25,$ba,$1b), - ($56,$0f,$85,$38), ($5d,$01,$8c,$35), ($40,$13,$97,$22), ($4b,$1d,$9e,$2f), - ($22,$47,$e9,$64), ($29,$49,$e0,$69), ($34,$5b,$fb,$7e), ($3f,$55,$f2,$73), - ($0e,$7f,$cd,$50), ($05,$71,$c4,$5d), ($18,$63,$df,$4a), ($13,$6d,$d6,$47), - ($ca,$d7,$31,$dc), ($c1,$d9,$38,$d1), ($dc,$cb,$23,$c6), ($d7,$c5,$2a,$cb), - ($e6,$ef,$15,$e8), ($ed,$e1,$1c,$e5), ($f0,$f3,$07,$f2), ($fb,$fd,$0e,$ff), - ($92,$a7,$79,$b4), ($99,$a9,$70,$b9), ($84,$bb,$6b,$ae), ($8f,$b5,$62,$a3), - ($be,$9f,$5d,$80), ($b5,$91,$54,$8d), ($a8,$83,$4f,$9a), ($a3,$8d,$46,$97)); - U3: array[0..255,0..3] of byte= ( - ($00,$00,$00,$00), ($0d,$0b,$0e,$09), ($1a,$16,$1c,$12), ($17,$1d,$12,$1b), - ($34,$2c,$38,$24), ($39,$27,$36,$2d), ($2e,$3a,$24,$36), ($23,$31,$2a,$3f), - ($68,$58,$70,$48), ($65,$53,$7e,$41), ($72,$4e,$6c,$5a), ($7f,$45,$62,$53), - ($5c,$74,$48,$6c), ($51,$7f,$46,$65), ($46,$62,$54,$7e), ($4b,$69,$5a,$77), - ($d0,$b0,$e0,$90), ($dd,$bb,$ee,$99), ($ca,$a6,$fc,$82), ($c7,$ad,$f2,$8b), - ($e4,$9c,$d8,$b4), ($e9,$97,$d6,$bd), ($fe,$8a,$c4,$a6), ($f3,$81,$ca,$af), - ($b8,$e8,$90,$d8), ($b5,$e3,$9e,$d1), ($a2,$fe,$8c,$ca), ($af,$f5,$82,$c3), - ($8c,$c4,$a8,$fc), ($81,$cf,$a6,$f5), ($96,$d2,$b4,$ee), ($9b,$d9,$ba,$e7), - ($bb,$7b,$db,$3b), ($b6,$70,$d5,$32), ($a1,$6d,$c7,$29), ($ac,$66,$c9,$20), - ($8f,$57,$e3,$1f), ($82,$5c,$ed,$16), ($95,$41,$ff,$0d), ($98,$4a,$f1,$04), - ($d3,$23,$ab,$73), ($de,$28,$a5,$7a), ($c9,$35,$b7,$61), ($c4,$3e,$b9,$68), - ($e7,$0f,$93,$57), ($ea,$04,$9d,$5e), ($fd,$19,$8f,$45), ($f0,$12,$81,$4c), - ($6b,$cb,$3b,$ab), ($66,$c0,$35,$a2), ($71,$dd,$27,$b9), ($7c,$d6,$29,$b0), - ($5f,$e7,$03,$8f), ($52,$ec,$0d,$86), ($45,$f1,$1f,$9d), ($48,$fa,$11,$94), - ($03,$93,$4b,$e3), ($0e,$98,$45,$ea), ($19,$85,$57,$f1), ($14,$8e,$59,$f8), - ($37,$bf,$73,$c7), ($3a,$b4,$7d,$ce), ($2d,$a9,$6f,$d5), ($20,$a2,$61,$dc), - ($6d,$f6,$ad,$76), ($60,$fd,$a3,$7f), ($77,$e0,$b1,$64), ($7a,$eb,$bf,$6d), - ($59,$da,$95,$52), ($54,$d1,$9b,$5b), ($43,$cc,$89,$40), ($4e,$c7,$87,$49), - ($05,$ae,$dd,$3e), ($08,$a5,$d3,$37), ($1f,$b8,$c1,$2c), ($12,$b3,$cf,$25), - ($31,$82,$e5,$1a), ($3c,$89,$eb,$13), ($2b,$94,$f9,$08), ($26,$9f,$f7,$01), - ($bd,$46,$4d,$e6), ($b0,$4d,$43,$ef), ($a7,$50,$51,$f4), ($aa,$5b,$5f,$fd), - ($89,$6a,$75,$c2), ($84,$61,$7b,$cb), ($93,$7c,$69,$d0), ($9e,$77,$67,$d9), - ($d5,$1e,$3d,$ae), ($d8,$15,$33,$a7), ($cf,$08,$21,$bc), ($c2,$03,$2f,$b5), - ($e1,$32,$05,$8a), ($ec,$39,$0b,$83), ($fb,$24,$19,$98), ($f6,$2f,$17,$91), - ($d6,$8d,$76,$4d), ($db,$86,$78,$44), ($cc,$9b,$6a,$5f), ($c1,$90,$64,$56), - ($e2,$a1,$4e,$69), ($ef,$aa,$40,$60), ($f8,$b7,$52,$7b), ($f5,$bc,$5c,$72), - ($be,$d5,$06,$05), ($b3,$de,$08,$0c), ($a4,$c3,$1a,$17), ($a9,$c8,$14,$1e), - ($8a,$f9,$3e,$21), ($87,$f2,$30,$28), ($90,$ef,$22,$33), ($9d,$e4,$2c,$3a), - ($06,$3d,$96,$dd), ($0b,$36,$98,$d4), ($1c,$2b,$8a,$cf), ($11,$20,$84,$c6), - ($32,$11,$ae,$f9), ($3f,$1a,$a0,$f0), ($28,$07,$b2,$eb), ($25,$0c,$bc,$e2), - ($6e,$65,$e6,$95), ($63,$6e,$e8,$9c), ($74,$73,$fa,$87), ($79,$78,$f4,$8e), - ($5a,$49,$de,$b1), ($57,$42,$d0,$b8), ($40,$5f,$c2,$a3), ($4d,$54,$cc,$aa), - ($da,$f7,$41,$ec), ($d7,$fc,$4f,$e5), ($c0,$e1,$5d,$fe), ($cd,$ea,$53,$f7), - ($ee,$db,$79,$c8), ($e3,$d0,$77,$c1), ($f4,$cd,$65,$da), ($f9,$c6,$6b,$d3), - ($b2,$af,$31,$a4), ($bf,$a4,$3f,$ad), ($a8,$b9,$2d,$b6), ($a5,$b2,$23,$bf), - ($86,$83,$09,$80), ($8b,$88,$07,$89), ($9c,$95,$15,$92), ($91,$9e,$1b,$9b), - ($0a,$47,$a1,$7c), ($07,$4c,$af,$75), ($10,$51,$bd,$6e), ($1d,$5a,$b3,$67), - ($3e,$6b,$99,$58), ($33,$60,$97,$51), ($24,$7d,$85,$4a), ($29,$76,$8b,$43), - ($62,$1f,$d1,$34), ($6f,$14,$df,$3d), ($78,$09,$cd,$26), ($75,$02,$c3,$2f), - ($56,$33,$e9,$10), ($5b,$38,$e7,$19), ($4c,$25,$f5,$02), ($41,$2e,$fb,$0b), - ($61,$8c,$9a,$d7), ($6c,$87,$94,$de), ($7b,$9a,$86,$c5), ($76,$91,$88,$cc), - ($55,$a0,$a2,$f3), ($58,$ab,$ac,$fa), ($4f,$b6,$be,$e1), ($42,$bd,$b0,$e8), - ($09,$d4,$ea,$9f), ($04,$df,$e4,$96), ($13,$c2,$f6,$8d), ($1e,$c9,$f8,$84), - ($3d,$f8,$d2,$bb), ($30,$f3,$dc,$b2), ($27,$ee,$ce,$a9), ($2a,$e5,$c0,$a0), - ($b1,$3c,$7a,$47), ($bc,$37,$74,$4e), ($ab,$2a,$66,$55), ($a6,$21,$68,$5c), - ($85,$10,$42,$63), ($88,$1b,$4c,$6a), ($9f,$06,$5e,$71), ($92,$0d,$50,$78), - ($d9,$64,$0a,$0f), ($d4,$6f,$04,$06), ($c3,$72,$16,$1d), ($ce,$79,$18,$14), - ($ed,$48,$32,$2b), ($e0,$43,$3c,$22), ($f7,$5e,$2e,$39), ($fa,$55,$20,$30), - ($b7,$01,$ec,$9a), ($ba,$0a,$e2,$93), ($ad,$17,$f0,$88), ($a0,$1c,$fe,$81), - ($83,$2d,$d4,$be), ($8e,$26,$da,$b7), ($99,$3b,$c8,$ac), ($94,$30,$c6,$a5), - ($df,$59,$9c,$d2), ($d2,$52,$92,$db), ($c5,$4f,$80,$c0), ($c8,$44,$8e,$c9), - ($eb,$75,$a4,$f6), ($e6,$7e,$aa,$ff), ($f1,$63,$b8,$e4), ($fc,$68,$b6,$ed), - ($67,$b1,$0c,$0a), ($6a,$ba,$02,$03), ($7d,$a7,$10,$18), ($70,$ac,$1e,$11), - ($53,$9d,$34,$2e), ($5e,$96,$3a,$27), ($49,$8b,$28,$3c), ($44,$80,$26,$35), - ($0f,$e9,$7c,$42), ($02,$e2,$72,$4b), ($15,$ff,$60,$50), ($18,$f4,$6e,$59), - ($3b,$c5,$44,$66), ($36,$ce,$4a,$6f), ($21,$d3,$58,$74), ($2c,$d8,$56,$7d), - ($0c,$7a,$37,$a1), ($01,$71,$39,$a8), ($16,$6c,$2b,$b3), ($1b,$67,$25,$ba), - ($38,$56,$0f,$85), ($35,$5d,$01,$8c), ($22,$40,$13,$97), ($2f,$4b,$1d,$9e), - ($64,$22,$47,$e9), ($69,$29,$49,$e0), ($7e,$34,$5b,$fb), ($73,$3f,$55,$f2), - ($50,$0e,$7f,$cd), ($5d,$05,$71,$c4), ($4a,$18,$63,$df), ($47,$13,$6d,$d6), - ($dc,$ca,$d7,$31), ($d1,$c1,$d9,$38), ($c6,$dc,$cb,$23), ($cb,$d7,$c5,$2a), - ($e8,$e6,$ef,$15), ($e5,$ed,$e1,$1c), ($f2,$f0,$f3,$07), ($ff,$fb,$fd,$0e), - ($b4,$92,$a7,$79), ($b9,$99,$a9,$70), ($ae,$84,$bb,$6b), ($a3,$8f,$b5,$62), - ($80,$be,$9f,$5d), ($8d,$b5,$91,$54), ($9a,$a8,$83,$4f), ($97,$a3,$8d,$46)); - U4: array[0..255,0..3] of byte= ( - ($00,$00,$00,$00), ($09,$0d,$0b,$0e), ($12,$1a,$16,$1c), ($1b,$17,$1d,$12), - ($24,$34,$2c,$38), ($2d,$39,$27,$36), ($36,$2e,$3a,$24), ($3f,$23,$31,$2a), - ($48,$68,$58,$70), ($41,$65,$53,$7e), ($5a,$72,$4e,$6c), ($53,$7f,$45,$62), - ($6c,$5c,$74,$48), ($65,$51,$7f,$46), ($7e,$46,$62,$54), ($77,$4b,$69,$5a), - ($90,$d0,$b0,$e0), ($99,$dd,$bb,$ee), ($82,$ca,$a6,$fc), ($8b,$c7,$ad,$f2), - ($b4,$e4,$9c,$d8), ($bd,$e9,$97,$d6), ($a6,$fe,$8a,$c4), ($af,$f3,$81,$ca), - ($d8,$b8,$e8,$90), ($d1,$b5,$e3,$9e), ($ca,$a2,$fe,$8c), ($c3,$af,$f5,$82), - ($fc,$8c,$c4,$a8), ($f5,$81,$cf,$a6), ($ee,$96,$d2,$b4), ($e7,$9b,$d9,$ba), - ($3b,$bb,$7b,$db), ($32,$b6,$70,$d5), ($29,$a1,$6d,$c7), ($20,$ac,$66,$c9), - ($1f,$8f,$57,$e3), ($16,$82,$5c,$ed), ($0d,$95,$41,$ff), ($04,$98,$4a,$f1), - ($73,$d3,$23,$ab), ($7a,$de,$28,$a5), ($61,$c9,$35,$b7), ($68,$c4,$3e,$b9), - ($57,$e7,$0f,$93), ($5e,$ea,$04,$9d), ($45,$fd,$19,$8f), ($4c,$f0,$12,$81), - ($ab,$6b,$cb,$3b), ($a2,$66,$c0,$35), ($b9,$71,$dd,$27), ($b0,$7c,$d6,$29), - ($8f,$5f,$e7,$03), ($86,$52,$ec,$0d), ($9d,$45,$f1,$1f), ($94,$48,$fa,$11), - ($e3,$03,$93,$4b), ($ea,$0e,$98,$45), ($f1,$19,$85,$57), ($f8,$14,$8e,$59), - ($c7,$37,$bf,$73), ($ce,$3a,$b4,$7d), ($d5,$2d,$a9,$6f), ($dc,$20,$a2,$61), - ($76,$6d,$f6,$ad), ($7f,$60,$fd,$a3), ($64,$77,$e0,$b1), ($6d,$7a,$eb,$bf), - ($52,$59,$da,$95), ($5b,$54,$d1,$9b), ($40,$43,$cc,$89), ($49,$4e,$c7,$87), - ($3e,$05,$ae,$dd), ($37,$08,$a5,$d3), ($2c,$1f,$b8,$c1), ($25,$12,$b3,$cf), - ($1a,$31,$82,$e5), ($13,$3c,$89,$eb), ($08,$2b,$94,$f9), ($01,$26,$9f,$f7), - ($e6,$bd,$46,$4d), ($ef,$b0,$4d,$43), ($f4,$a7,$50,$51), ($fd,$aa,$5b,$5f), - ($c2,$89,$6a,$75), ($cb,$84,$61,$7b), ($d0,$93,$7c,$69), ($d9,$9e,$77,$67), - ($ae,$d5,$1e,$3d), ($a7,$d8,$15,$33), ($bc,$cf,$08,$21), ($b5,$c2,$03,$2f), - ($8a,$e1,$32,$05), ($83,$ec,$39,$0b), ($98,$fb,$24,$19), ($91,$f6,$2f,$17), - ($4d,$d6,$8d,$76), ($44,$db,$86,$78), ($5f,$cc,$9b,$6a), ($56,$c1,$90,$64), - ($69,$e2,$a1,$4e), ($60,$ef,$aa,$40), ($7b,$f8,$b7,$52), ($72,$f5,$bc,$5c), - ($05,$be,$d5,$06), ($0c,$b3,$de,$08), ($17,$a4,$c3,$1a), ($1e,$a9,$c8,$14), - ($21,$8a,$f9,$3e), ($28,$87,$f2,$30), ($33,$90,$ef,$22), ($3a,$9d,$e4,$2c), - ($dd,$06,$3d,$96), ($d4,$0b,$36,$98), ($cf,$1c,$2b,$8a), ($c6,$11,$20,$84), - ($f9,$32,$11,$ae), ($f0,$3f,$1a,$a0), ($eb,$28,$07,$b2), ($e2,$25,$0c,$bc), - ($95,$6e,$65,$e6), ($9c,$63,$6e,$e8), ($87,$74,$73,$fa), ($8e,$79,$78,$f4), - ($b1,$5a,$49,$de), ($b8,$57,$42,$d0), ($a3,$40,$5f,$c2), ($aa,$4d,$54,$cc), - ($ec,$da,$f7,$41), ($e5,$d7,$fc,$4f), ($fe,$c0,$e1,$5d), ($f7,$cd,$ea,$53), - ($c8,$ee,$db,$79), ($c1,$e3,$d0,$77), ($da,$f4,$cd,$65), ($d3,$f9,$c6,$6b), - ($a4,$b2,$af,$31), ($ad,$bf,$a4,$3f), ($b6,$a8,$b9,$2d), ($bf,$a5,$b2,$23), - ($80,$86,$83,$09), ($89,$8b,$88,$07), ($92,$9c,$95,$15), ($9b,$91,$9e,$1b), - ($7c,$0a,$47,$a1), ($75,$07,$4c,$af), ($6e,$10,$51,$bd), ($67,$1d,$5a,$b3), - ($58,$3e,$6b,$99), ($51,$33,$60,$97), ($4a,$24,$7d,$85), ($43,$29,$76,$8b), - ($34,$62,$1f,$d1), ($3d,$6f,$14,$df), ($26,$78,$09,$cd), ($2f,$75,$02,$c3), - ($10,$56,$33,$e9), ($19,$5b,$38,$e7), ($02,$4c,$25,$f5), ($0b,$41,$2e,$fb), - ($d7,$61,$8c,$9a), ($de,$6c,$87,$94), ($c5,$7b,$9a,$86), ($cc,$76,$91,$88), - ($f3,$55,$a0,$a2), ($fa,$58,$ab,$ac), ($e1,$4f,$b6,$be), ($e8,$42,$bd,$b0), - ($9f,$09,$d4,$ea), ($96,$04,$df,$e4), ($8d,$13,$c2,$f6), ($84,$1e,$c9,$f8), - ($bb,$3d,$f8,$d2), ($b2,$30,$f3,$dc), ($a9,$27,$ee,$ce), ($a0,$2a,$e5,$c0), - ($47,$b1,$3c,$7a), ($4e,$bc,$37,$74), ($55,$ab,$2a,$66), ($5c,$a6,$21,$68), - ($63,$85,$10,$42), ($6a,$88,$1b,$4c), ($71,$9f,$06,$5e), ($78,$92,$0d,$50), - ($0f,$d9,$64,$0a), ($06,$d4,$6f,$04), ($1d,$c3,$72,$16), ($14,$ce,$79,$18), - ($2b,$ed,$48,$32), ($22,$e0,$43,$3c), ($39,$f7,$5e,$2e), ($30,$fa,$55,$20), - ($9a,$b7,$01,$ec), ($93,$ba,$0a,$e2), ($88,$ad,$17,$f0), ($81,$a0,$1c,$fe), - ($be,$83,$2d,$d4), ($b7,$8e,$26,$da), ($ac,$99,$3b,$c8), ($a5,$94,$30,$c6), - ($d2,$df,$59,$9c), ($db,$d2,$52,$92), ($c0,$c5,$4f,$80), ($c9,$c8,$44,$8e), - ($f6,$eb,$75,$a4), ($ff,$e6,$7e,$aa), ($e4,$f1,$63,$b8), ($ed,$fc,$68,$b6), - ($0a,$67,$b1,$0c), ($03,$6a,$ba,$02), ($18,$7d,$a7,$10), ($11,$70,$ac,$1e), - ($2e,$53,$9d,$34), ($27,$5e,$96,$3a), ($3c,$49,$8b,$28), ($35,$44,$80,$26), - ($42,$0f,$e9,$7c), ($4b,$02,$e2,$72), ($50,$15,$ff,$60), ($59,$18,$f4,$6e), - ($66,$3b,$c5,$44), ($6f,$36,$ce,$4a), ($74,$21,$d3,$58), ($7d,$2c,$d8,$56), - ($a1,$0c,$7a,$37), ($a8,$01,$71,$39), ($b3,$16,$6c,$2b), ($ba,$1b,$67,$25), - ($85,$38,$56,$0f), ($8c,$35,$5d,$01), ($97,$22,$40,$13), ($9e,$2f,$4b,$1d), - ($e9,$64,$22,$47), ($e0,$69,$29,$49), ($fb,$7e,$34,$5b), ($f2,$73,$3f,$55), - ($cd,$50,$0e,$7f), ($c4,$5d,$05,$71), ($df,$4a,$18,$63), ($d6,$47,$13,$6d), - ($31,$dc,$ca,$d7), ($38,$d1,$c1,$d9), ($23,$c6,$dc,$cb), ($2a,$cb,$d7,$c5), - ($15,$e8,$e6,$ef), ($1c,$e5,$ed,$e1), ($07,$f2,$f0,$f3), ($0e,$ff,$fb,$fd), - ($79,$b4,$92,$a7), ($70,$b9,$99,$a9), ($6b,$ae,$84,$bb), ($62,$a3,$8f,$b5), - ($5d,$80,$be,$9f), ($54,$8d,$b5,$91), ($4f,$9a,$a8,$83), ($46,$97,$a3,$8d)); - - rcon: array[0..29] of cardinal= ( - $01, $02, $04, $08, $10, $20, $40, $80, $1b, $36, $6c, $d8, $ab, $4d, $9a, - $2f, $5e, $bc, $63, $c6, $97, $35, $6a, $d4, $b3, $7d, $fa, $ef, $c5, $91); - -{==============================================================================} -type - PDWord = ^LongWord; - -procedure hperm_op(var a, t: integer; n, m: integer); -begin - t:= ((a shl (16 - n)) xor a) and m; - a:= a xor t xor (t shr (16 - n)); -end; - -procedure perm_op(var a, b, t: integer; n, m: integer); -begin - t:= ((a shr n) xor b) and m; - b:= b xor t; - a:= a xor (t shl n); -end; - -{==============================================================================} -function TSynaBlockCipher.GetSize: byte; -begin - Result := 8; -end; - -procedure TSynaBlockCipher.IncCounter; -var - i: integer; -begin - Inc(CV[GetSize]); - i:= GetSize -1; - while (i> 0) and (CV[i + 1] = #0) do - begin - Inc(CV[i]); - Dec(i); - end; -end; - -procedure TSynaBlockCipher.Reset; -begin - CV := IV; -end; - -procedure TSynaBlockCipher.InitKey(Key: AnsiString); -begin -end; - -procedure TSynaBlockCipher.SetIV(const Value: AnsiString); -begin - IV := PadString(Value, GetSize, #0); - Reset; -end; - -function TSynaBlockCipher.GetIV: AnsiString; -begin - Result := CV; -end; - -function TSynaBlockCipher.EncryptECB(const InData: AnsiString): AnsiString; -begin - Result := InData; -end; - -function TSynaBlockCipher.DecryptECB(const InData: AnsiString): AnsiString; -begin - Result := InData; -end; - -function TSynaBlockCipher.EncryptCBC(const Indata: AnsiString): AnsiString; -var - i: integer; - s: ansistring; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, CV); - s := EncryptECB(s); - CV := s; - Result := Result + s; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.DecryptCBC(const Indata: AnsiString): AnsiString; -var - i: integer; - s, temp: ansistring; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - s := copy(Indata, (i - 1) * bs + 1, bs); - temp := s; - s := DecryptECB(s); - s := XorString(s, CV); - Result := Result + s; - CV := Temp; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.EncryptCFB8bit(const Indata: AnsiString): AnsiString; -var - i: integer; - Temp: AnsiString; - c: AnsiChar; -begin - Result := ''; - for i:= 1 to Length(Indata) do - begin - Temp := EncryptECB(CV); - c := AnsiChar(ord(InData[i]) xor ord(temp[1])); - Result := Result + c; - Delete(CV, 1, 1); - CV := CV + c; - end; -end; - -function TSynaBlockCipher.DecryptCFB8bit(const Indata: AnsiString): AnsiString; -var - i: integer; - Temp: AnsiString; - c: AnsiChar; -begin - Result := ''; - for i:= 1 to length(Indata) do - begin - c:= Indata[i]; - Temp := EncryptECB(CV); - Result := Result + AnsiChar(ord(InData[i]) xor ord(temp[1])); - Delete(CV, 1, 1); - CV := CV + c; - end; -end; - -function TSynaBlockCipher.EncryptCFBblock(const Indata: AnsiString): AnsiString; -var - i: integer; - s: AnsiString; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - CV := EncryptECB(CV); - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, CV); - Result := Result + s; - CV := s; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.DecryptCFBblock(const Indata: AnsiString): AnsiString; -var - i: integer; - S, Temp: AnsiString; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - s := copy(Indata, (i - 1) * bs + 1, bs); - Temp := s; - CV := EncryptECB(CV); - s := XorString(s, CV); - Result := result + s; - CV := temp; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.EncryptOFB(const Indata: AnsiString): AnsiString; -var - i: integer; - s: AnsiString; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - CV := EncryptECB(CV); - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, CV); - Result := Result + s; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.DecryptOFB(const Indata: AnsiString): AnsiString; -var - i: integer; - s: AnsiString; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - Cv := EncryptECB(CV); - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, CV); - Result := Result + s; - end; - if (l mod bs)<> 0 then - begin - CV := EncryptECB(CV); - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, CV); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.EncryptCTR(const Indata: AnsiString): AnsiString; -var - temp: AnsiString; - i: integer; - s: AnsiString; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - temp := EncryptECB(CV); - IncCounter; - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, temp); - Result := Result + s; - end; - if (l mod bs)<> 0 then - begin - temp := EncryptECB(CV); - IncCounter; - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, temp); - Result := Result + s; - end; -end; - -function TSynaBlockCipher.DecryptCTR(const Indata: AnsiString): AnsiString; -var - temp: AnsiString; - s: AnsiString; - i: integer; - l: integer; - bs: byte; -begin - Result := ''; - l := Length(InData); - bs := GetSize; - for i:= 1 to (l div bs) do - begin - temp := EncryptECB(CV); - IncCounter; - s := copy(Indata, (i - 1) * bs + 1, bs); - s := XorString(s, temp); - Result := Result + s; - end; - if (l mod bs)<> 0 then - begin - temp := EncryptECB(CV); - IncCounter; - s := copy(Indata, (l div bs) * bs + 1, l mod bs); - s := XorString(s, temp); - Result := Result + s; - end; -end; - -constructor TSynaBlockCipher.Create(Key: AnsiString); -begin - inherited Create; - InitKey(Key); - IV := StringOfChar(#0, GetSize); - IV := EncryptECB(IV); - Reset; -end; - -{==============================================================================} - -procedure TSynaCustomDes.DoInit(KeyB: AnsiString; var KeyData: TDesKeyData); -var - c, d, t, s, t2, i: integer; -begin - KeyB := PadString(KeyB, 8, #0); - c:= ord(KeyB[1]) or (ord(KeyB[2]) shl 8) or (ord(KeyB[3]) shl 16) or (ord(KeyB[4]) shl 24); - d:= ord(KeyB[5]) or (ord(KeyB[6]) shl 8) or (ord(KeyB[7]) shl 16) or (ord(KeyB[8]) shl 24); - perm_op(d,c,t,4,integer($0f0f0f0f)); - hperm_op(c,t,integer(-2),integer($cccc0000)); - hperm_op(d,t,integer(-2),integer($cccc0000)); - perm_op(d,c,t,1,integer($55555555)); - perm_op(c,d,t,8,integer($00ff00ff)); - perm_op(d,c,t,1,integer($55555555)); - d:= ((d and $ff) shl 16) or (d and $ff00) or ((d and $ff0000) shr 16) or - ((c and integer($f0000000)) shr 4); - c:= c and $fffffff; - for i:= 0 to 15 do - begin - if shifts2[i]<> 0 then - begin - c:= ((c shr 2) or (c shl 26)); - d:= ((d shr 2) or (d shl 26)); - end - else - begin - c:= ((c shr 1) or (c shl 27)); - d:= ((d shr 1) or (d shl 27)); - end; - c:= c and $fffffff; - d:= d and $fffffff; - s:= des_skb[0,c and $3f] or - des_skb[1,((c shr 6) and $03) or ((c shr 7) and $3c)] or - des_skb[2,((c shr 13) and $0f) or ((c shr 14) and $30)] or - des_skb[3,((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)]; - t:= des_skb[4,d and $3f] or - des_skb[5,((d shr 7) and $03) or ((d shr 8) and $3c)] or - des_skb[6, (d shr 15) and $3f ] or - des_skb[7,((d shr 21) and $0f) or ((d shr 22) and $30)]; - t2:= ((t shl 16) or (s and $ffff)); - KeyData[(i shl 1)]:= ((t2 shl 2) or (t2 shr 30)); - t2:= ((s shr 16) or (t and integer($ffff0000))); - KeyData[(i shl 1)+1]:= ((t2 shl 6) or (t2 shr 26)); - end; -end; - -function TSynaCustomDes.EncryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString; -var - l, r, t, u: integer; - i: longint; -begin - r := Swapbytes(DecodeLongint(Indata, 1)); - l := swapbytes(DecodeLongint(Indata, 5)); - t:= ((l shr 4) xor r) and $0f0f0f0f; - r:= r xor t; - l:= l xor (t shl 4); - t:= ((r shr 16) xor l) and $0000ffff; - l:= l xor t; - r:= r xor (t shl 16); - t:= ((l shr 2) xor r) and $33333333; - r:= r xor t; - l:= l xor (t shl 2); - t:= ((r shr 8) xor l) and $00ff00ff; - l:= l xor t; - r:= r xor (t shl 8); - t:= ((l shr 1) xor r) and $55555555; - r:= r xor t; - l:= l xor (t shl 1); - r:= (r shr 29) or (r shl 3); - l:= (l shr 29) or (l shl 3); - i:= 0; - while i< 32 do - begin - u:= r xor KeyData[i ]; - t:= r xor KeyData[i+1]; - t:= (t shr 4) or (t shl 28); - l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= l xor KeyData[i+2]; - t:= l xor KeyData[i+3]; - t:= (t shr 4) or (t shl 28); - r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= r xor KeyData[i+4]; - t:= r xor KeyData[i+5]; - t:= (t shr 4) or (t shl 28); - l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= l xor KeyData[i+6]; - t:= l xor KeyData[i+7]; - t:= (t shr 4) or (t shl 28); - r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - Inc(i,8); - end; - r:= (r shr 3) or (r shl 29); - l:= (l shr 3) or (l shl 29); - t:= ((r shr 1) xor l) and $55555555; - l:= l xor t; - r:= r xor (t shl 1); - t:= ((l shr 8) xor r) and $00ff00ff; - r:= r xor t; - l:= l xor (t shl 8); - t:= ((r shr 2) xor l) and $33333333; - l:= l xor t; - r:= r xor (t shl 2); - t:= ((l shr 16) xor r) and $0000ffff; - r:= r xor t; - l:= l xor (t shl 16); - t:= ((r shr 4) xor l) and $0f0f0f0f; - l:= l xor t; - r:= r xor (t shl 4); - Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r)); -end; - -function TSynaCustomDes.DecryptBlock(const InData: AnsiString; var KeyData: TDesKeyData): AnsiString; -var - l, r, t, u: integer; - i: longint; -begin - r := Swapbytes(DecodeLongint(Indata, 1)); - l := Swapbytes(DecodeLongint(Indata, 5)); - t:= ((l shr 4) xor r) and $0f0f0f0f; - r:= r xor t; - l:= l xor (t shl 4); - t:= ((r shr 16) xor l) and $0000ffff; - l:= l xor t; - r:= r xor (t shl 16); - t:= ((l shr 2) xor r) and $33333333; - r:= r xor t; - l:= l xor (t shl 2); - t:= ((r shr 8) xor l) and $00ff00ff; - l:= l xor t; - r:= r xor (t shl 8); - t:= ((l shr 1) xor r) and $55555555; - r:= r xor t; - l:= l xor (t shl 1); - r:= (r shr 29) or (r shl 3); - l:= (l shr 29) or (l shl 3); - i:= 30; - while i> 0 do - begin - u:= r xor KeyData[i ]; - t:= r xor KeyData[i+1]; - t:= (t shr 4) or (t shl 28); - l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= l xor KeyData[i-2]; - t:= l xor KeyData[i-1]; - t:= (t shr 4) or (t shl 28); - r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= r xor KeyData[i-4]; - t:= r xor KeyData[i-3]; - t:= (t shr 4) or (t shl 28); - l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - u:= l xor KeyData[i-6]; - t:= l xor KeyData[i-5]; - t:= (t shr 4) or (t shl 28); - r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor - des_SPtrans[2,(u shr 10) and $3f] xor - des_SPtrans[4,(u shr 18) and $3f] xor - des_SPtrans[6,(u shr 26) and $3f] xor - des_SPtrans[1,(t shr 2) and $3f] xor - des_SPtrans[3,(t shr 10) and $3f] xor - des_SPtrans[5,(t shr 18) and $3f] xor - des_SPtrans[7,(t shr 26) and $3f]; - Dec(i,8); - end; - r:= (r shr 3) or (r shl 29); - l:= (l shr 3) or (l shl 29); - t:= ((r shr 1) xor l) and $55555555; - l:= l xor t; - r:= r xor (t shl 1); - t:= ((l shr 8) xor r) and $00ff00ff; - r:= r xor t; - l:= l xor (t shl 8); - t:= ((r shr 2) xor l) and $33333333; - l:= l xor t; - r:= r xor (t shl 2); - t:= ((l shr 16) xor r) and $0000ffff; - r:= r xor t; - l:= l xor (t shl 16); - t:= ((r shr 4) xor l) and $0f0f0f0f; - l:= l xor t; - r:= r xor (t shl 4); - Result := CodeLongInt(Swapbytes(l)) + CodeLongInt(Swapbytes(r)); -end; - -{==============================================================================} - -procedure TSynaDes.InitKey(Key: AnsiString); -begin - Key := PadString(Key, 8, #0); - DoInit(Key,KeyData); -end; - -function TSynaDes.EncryptECB(const InData: AnsiString): AnsiString; -begin - Result := EncryptBlock(InData,KeyData); -end; - -function TSynaDes.DecryptECB(const InData: AnsiString): AnsiString; -begin - Result := DecryptBlock(Indata,KeyData); -end; - -{==============================================================================} - -procedure TSyna3Des.InitKey(Key: AnsiString); -var - Size: integer; - n: integer; -begin - Size := length(Key); - key := PadString(key, 3 * 8, #0); - DoInit(Copy(key, 1, 8),KeyData[0]); - DoInit(Copy(key, 9, 8),KeyData[1]); - if Size > 16 then - DoInit(Copy(key, 17, 8),KeyData[2]) - else - for n := 0 to high(KeyData[0]) do - KeyData[2][n] := Keydata[0][n]; -end; - -function TSyna3Des.EncryptECB(const InData: AnsiString): AnsiString; -begin - Result := EncryptBlock(Indata,KeyData[0]); - Result := DecryptBlock(Result,KeyData[1]); - Result := EncryptBlock(Result,KeyData[2]); -end; - -function TSyna3Des.DecryptECB(const InData: AnsiString): AnsiString; -begin - Result := DecryptBlock(InData,KeyData[2]); - Result := EncryptBlock(Result,KeyData[1]); - Result := DecryptBlock(Result,KeyData[0]); -end; - -{==============================================================================} - -procedure InvMixColumn(a: PByteArray; BC: byte); -var - j: longword; -begin - for j:= 0 to (BC-1) do - PDWord(@(a^[j*4]))^:= PDWord(@U1[a^[j*4+0]])^ - xor PDWord(@U2[a^[j*4+1]])^ - xor PDWord(@U3[a^[j*4+2]])^ - xor PDWord(@U4[a^[j*4+3]])^; -end; - -{==============================================================================} - -function TSynaAes.GetSize: byte; -begin - Result := 16; -end; - -procedure TSynaAes.InitKey(Key: AnsiString); -var - Size: integer; - KC, ROUNDS, j, r, t, rconpointer: longword; - tk: array[0..MAXKC-1,0..3] of byte; - n: integer; -begin - FillChar(tk,Sizeof(tk),0); - //key must have at least 128 bits and max 256 bits - if length(key) < 16 then - key := PadString(key, 16, #0); - if length(key) > 32 then - delete(key, 33, maxint); - Size := length(Key); - Move(PAnsiChar(Key)^, tk, Size); - if Size<= 16 then - begin - KC:= 4; - Rounds:= 10; - end - else if Size<= 24 then - begin - KC:= 6; - Rounds:= 12; - end - else - begin - KC:= 8; - Rounds:= 14; - end; - numrounds:= rounds; - r:= 0; - t:= 0; - j:= 0; - while (j< KC) and (r< (rounds+1)) do - begin - while (j< KC) and (t< BC) do - begin - rk[r,t]:= PDWord(@tk[j])^; - Inc(j); - Inc(t); - end; - if t= BC then - begin - t:= 0; - Inc(r); - end; - end; - rconpointer:= 0; - while (r< (rounds+1)) do - begin - tk[0,0]:= tk[0,0] xor S[tk[KC-1,1]]; - tk[0,1]:= tk[0,1] xor S[tk[KC-1,2]]; - tk[0,2]:= tk[0,2] xor S[tk[KC-1,3]]; - tk[0,3]:= tk[0,3] xor S[tk[KC-1,0]]; - tk[0,0]:= tk[0,0] xor rcon[rconpointer]; - Inc(rconpointer); - if KC<> 8 then - begin - for j:= 1 to (KC-1) do - PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^; - end - else - begin - for j:= 1 to ((KC div 2)-1) do - PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^; - tk[KC div 2,0]:= tk[KC div 2,0] xor S[tk[KC div 2 - 1,0]]; - tk[KC div 2,1]:= tk[KC div 2,1] xor S[tk[KC div 2 - 1,1]]; - tk[KC div 2,2]:= tk[KC div 2,2] xor S[tk[KC div 2 - 1,2]]; - tk[KC div 2,3]:= tk[KC div 2,3] xor S[tk[KC div 2 - 1,3]]; - for j:= ((KC div 2) + 1) to (KC-1) do - PDWord(@tk[j])^:= PDWord(@tk[j])^ xor PDWord(@tk[j-1])^; - end; - j:= 0; - while (j< KC) and (r< (rounds+1)) do - begin - while (j< KC) and (t< BC) do - begin - rk[r,t]:= PDWord(@tk[j])^; - Inc(j); - Inc(t); - end; - if t= BC then - begin - Inc(r); - t:= 0; - end; - end; - end; - Move(rk,drk,Sizeof(rk)); - for r:= 1 to (numrounds-1) do - InvMixColumn(@drk[r],BC); -end; - -function TSynaAes.EncryptECB(const InData: AnsiString): AnsiString; -var - r: longword; - tempb: array[0..MAXBC-1,0..3] of byte; - a: array[0..MAXBC,0..3] of byte; - p: pointer; -begin - p := @a[0,0]; - move(pointer(InData)^, p^, 16); - for r:= 0 to (numrounds-2) do - begin - PDWord(@tempb[0])^:= PDWord(@a[0])^ xor rk[r,0]; - PDWord(@tempb[1])^:= PDWord(@a[1])^ xor rk[r,1]; - PDWord(@tempb[2])^:= PDWord(@a[2])^ xor rk[r,2]; - PDWord(@tempb[3])^:= PDWord(@a[3])^ xor rk[r,3]; - PDWord(@a[0])^:= PDWord(@T1[tempb[0,0]])^ xor - PDWord(@T2[tempb[1,1]])^ xor - PDWord(@T3[tempb[2,2]])^ xor - PDWord(@T4[tempb[3,3]])^; - PDWord(@a[1])^:= PDWord(@T1[tempb[1,0]])^ xor - PDWord(@T2[tempb[2,1]])^ xor - PDWord(@T3[tempb[3,2]])^ xor - PDWord(@T4[tempb[0,3]])^; - PDWord(@a[2])^:= PDWord(@T1[tempb[2,0]])^ xor - PDWord(@T2[tempb[3,1]])^ xor - PDWord(@T3[tempb[0,2]])^ xor - PDWord(@T4[tempb[1,3]])^; - PDWord(@a[3])^:= PDWord(@T1[tempb[3,0]])^ xor - PDWord(@T2[tempb[0,1]])^ xor - PDWord(@T3[tempb[1,2]])^ xor - PDWord(@T4[tempb[2,3]])^; - end; - PDWord(@tempb[0])^:= PDWord(@a[0])^ xor rk[numrounds-1,0]; - PDWord(@tempb[1])^:= PDWord(@a[1])^ xor rk[numrounds-1,1]; - PDWord(@tempb[2])^:= PDWord(@a[2])^ xor rk[numrounds-1,2]; - PDWord(@tempb[3])^:= PDWord(@a[3])^ xor rk[numrounds-1,3]; - a[0,0]:= T1[tempb[0,0],1]; - a[0,1]:= T1[tempb[1,1],1]; - a[0,2]:= T1[tempb[2,2],1]; - a[0,3]:= T1[tempb[3,3],1]; - a[1,0]:= T1[tempb[1,0],1]; - a[1,1]:= T1[tempb[2,1],1]; - a[1,2]:= T1[tempb[3,2],1]; - a[1,3]:= T1[tempb[0,3],1]; - a[2,0]:= T1[tempb[2,0],1]; - a[2,1]:= T1[tempb[3,1],1]; - a[2,2]:= T1[tempb[0,2],1]; - a[2,3]:= T1[tempb[1,3],1]; - a[3,0]:= T1[tempb[3,0],1]; - a[3,1]:= T1[tempb[0,1],1]; - a[3,2]:= T1[tempb[1,2],1]; - a[3,3]:= T1[tempb[2,3],1]; - PDWord(@a[0])^:= PDWord(@a[0])^ xor rk[numrounds,0]; - PDWord(@a[1])^:= PDWord(@a[1])^ xor rk[numrounds,1]; - PDWord(@a[2])^:= PDWord(@a[2])^ xor rk[numrounds,2]; - PDWord(@a[3])^:= PDWord(@a[3])^ xor rk[numrounds,3]; - - Result := StringOfChar(#0, 16); - move(p^, pointer(Result)^, 16); -end; - -function TSynaAes.DecryptECB(const InData: AnsiString): AnsiString; -var - r: longword; - tempb: array[0..MAXBC-1,0..3] of byte; - a: array[0..MAXBC,0..3] of byte; - p: pointer; -begin - p := @a[0,0]; - move(pointer(InData)^, p^, 16); - for r:= NumRounds downto 2 do - begin - PDWord(@tempb[0])^:= PDWord(@a[0])^ xor drk[r,0]; - PDWord(@tempb[1])^:= PDWord(@a[1])^ xor drk[r,1]; - PDWord(@tempb[2])^:= PDWord(@a[2])^ xor drk[r,2]; - PDWord(@tempb[3])^:= PDWord(@a[3])^ xor drk[r,3]; - PDWord(@a[0])^:= PDWord(@T5[tempb[0,0]])^ xor - PDWord(@T6[tempb[3,1]])^ xor - PDWord(@T7[tempb[2,2]])^ xor - PDWord(@T8[tempb[1,3]])^; - PDWord(@a[1])^:= PDWord(@T5[tempb[1,0]])^ xor - PDWord(@T6[tempb[0,1]])^ xor - PDWord(@T7[tempb[3,2]])^ xor - PDWord(@T8[tempb[2,3]])^; - PDWord(@a[2])^:= PDWord(@T5[tempb[2,0]])^ xor - PDWord(@T6[tempb[1,1]])^ xor - PDWord(@T7[tempb[0,2]])^ xor - PDWord(@T8[tempb[3,3]])^; - PDWord(@a[3])^:= PDWord(@T5[tempb[3,0]])^ xor - PDWord(@T6[tempb[2,1]])^ xor - PDWord(@T7[tempb[1,2]])^ xor - PDWord(@T8[tempb[0,3]])^; - end; - PDWord(@tempb[0])^:= PDWord(@a[0])^ xor drk[1,0]; - PDWord(@tempb[1])^:= PDWord(@a[1])^ xor drk[1,1]; - PDWord(@tempb[2])^:= PDWord(@a[2])^ xor drk[1,2]; - PDWord(@tempb[3])^:= PDWord(@a[3])^ xor drk[1,3]; - a[0,0]:= S5[tempb[0,0]]; - a[0,1]:= S5[tempb[3,1]]; - a[0,2]:= S5[tempb[2,2]]; - a[0,3]:= S5[tempb[1,3]]; - a[1,0]:= S5[tempb[1,0]]; - a[1,1]:= S5[tempb[0,1]]; - a[1,2]:= S5[tempb[3,2]]; - a[1,3]:= S5[tempb[2,3]]; - a[2,0]:= S5[tempb[2,0]]; - a[2,1]:= S5[tempb[1,1]]; - a[2,2]:= S5[tempb[0,2]]; - a[2,3]:= S5[tempb[3,3]]; - a[3,0]:= S5[tempb[3,0]]; - a[3,1]:= S5[tempb[2,1]]; - a[3,2]:= S5[tempb[1,2]]; - a[3,3]:= S5[tempb[0,3]]; - PDWord(@a[0])^:= PDWord(@a[0])^ xor drk[0,0]; - PDWord(@a[1])^:= PDWord(@a[1])^ xor drk[0,1]; - PDWord(@a[2])^:= PDWord(@a[2])^ xor drk[0,2]; - PDWord(@a[3])^:= PDWord(@a[3])^ xor drk[0,3]; - Result := StringOfChar(#0, 16); - move(p^, pointer(Result)^, 16); -end; - -{==============================================================================} - -function TestDes: boolean; -var - des: TSynaDes; - s, t: string; -const - key = '01234567'; - data1= '01234567'; - data2= '0123456789abcdefghij'; -begin - //ECB - des := TSynaDes.Create(key); - try - s := des.EncryptECB(data1); - t := strtohex(s); - result := t = 'c50ad028c6da9800'; - s := des.DecryptECB(s); - result := result and (data1 = s); - finally - des.free; - end; - //CBC - des := TSynaDes.Create(key); - try - s := des.EncryptCBC(data2); - t := strtohex(s); - result := result and (t = 'eec50f6353115ad6dee90a22ed1b6a88a0926e35'); - des.Reset; - s := des.DecryptCBC(s); - result := result and (data2 = s); - finally - des.free; - end; - //CFB-8bit - des := TSynaDes.Create(key); - try - s := des.EncryptCFB8bit(data2); - t := strtohex(s); - result := result and (t = 'eb6aa12c2f0ff634b4dfb6da6cb2af8f9c5c1452'); - des.Reset; - s := des.DecryptCFB8bit(s); - result := result and (data2 = s); - finally - des.free; - end; - //CFB-block - des := TSynaDes.Create(key); - try - s := des.EncryptCFBblock(data2); - t := strtohex(s); - result := result and (t = 'ebdbbaa7f9286cdec28605e07f9b7f3be1053257'); - des.Reset; - s := des.DecryptCFBblock(s); - result := result and (data2 = s); - finally - des.free; - end; - //OFB - des := TSynaDes.Create(key); - try - s := des.EncryptOFB(data2); - t := strtohex(s); - result := result and (t = 'ebdbbaa7f9286cdee0b8b3798c4c34baac87dbdc'); - des.Reset; - s := des.DecryptOFB(s); - result := result and (data2 = s); - finally - des.free; - end; - //CTR - des := TSynaDes.Create(key); - try - s := des.EncryptCTR(data2); - t := strtohex(s); - result := result and (t = 'ebdbbaa7f9286cde0dd20b45f3afd9aa1b91b87e'); - des.Reset; - s := des.DecryptCTR(s); - result := result and (data2 = s); - finally - des.free; - end; -end; - -function Test3Des: boolean; -var - des: TSyna3Des; - s, t: string; -const - key = '0123456789abcdefghijklmn'; - data1= '01234567'; - data2= '0123456789abcdefghij'; -begin - //ECB - des := TSyna3Des.Create(key); - try - s := des.EncryptECB(data1); - t := strtohex(s); - result := t = 'e0dee91008dc460c'; - s := des.DecryptECB(s); - result := result and (data1 = s); - finally - des.free; - end; - //CBC - des := TSyna3Des.Create(key); - try - s := des.EncryptCBC(data2); - t := strtohex(s); - result := result and (t = 'ee844a2a4f49c01b91a1599b8eba29128c1ad87a'); - des.Reset; - s := des.DecryptCBC(s); - result := result and (data2 = s); - finally - des.free; - end; - //CFB-8bit - des := TSyna3Des.Create(key); - try - s := des.EncryptCFB8bit(data2); - t := strtohex(s); - result := result and (t = '935bbf5210c32cfa1faf61f91e8dc02dfa0ff1e8'); - des.Reset; - s := des.DecryptCFB8bit(s); - result := result and (data2 = s); - finally - des.free; - end; - //CFB-block - des := TSyna3Des.Create(key); - try - s := des.EncryptCFBblock(data2); - t := strtohex(s); - result := result and (t = '93754e3d54828fbf4bd81f1739419e8d2cfe1671'); - des.Reset; - s := des.DecryptCFBblock(s); - result := result and (data2 = s); - finally - des.free; - end; - //OFB - des := TSyna3Des.Create(key); - try - s := des.EncryptOFB(data2); - t := strtohex(s); - result := result and (t = '93754e3d54828fbf04ef0a5efc926ebdf2d95f20'); - des.Reset; - s := des.DecryptOFB(s); - result := result and (data2 = s); - finally - des.free; - end; - //CTR - des := TSyna3Des.Create(key); - try - s := des.EncryptCTR(data2); - t := strtohex(s); - result := result and (t = '93754e3d54828fbf1c51a121d2c93f989e70b3ad'); - des.Reset; - s := des.DecryptCTR(s); - result := result and (data2 = s); - finally - des.free; - end; -end; - -function TestAes: boolean; -var - aes: TSynaAes; - s, t: string; -const - key1 = #$00#$01#$02#$03#$05#$06#$07#$08#$0A#$0B#$0C#$0D#$0F#$10#$11#$12; - data1= #$50#$68#$12#$A4#$5F#$08#$C8#$89#$B9#$7F#$59#$80#$03#$8B#$83#$59; - key2 = #$A0#$A1#$A2#$A3#$A5#$A6#$A7#$A8#$AA#$AB#$AC#$AD#$AF#$B0#$B1#$B2#$B4#$B5#$B6#$B7#$B9#$BA#$BB#$BC; - data2= #$4F#$1C#$76#$9D#$1E#$5B#$05#$52#$C7#$EC#$A8#$4D#$EA#$26#$A5#$49; - key3 = #$00#$01#$02#$03#$05#$06#$07#$08#$0A#$0B#$0C#$0D#$0F#$10#$11#$12#$14#$15#$16#$17#$19#$1A#$1B#$1C#$1E#$1F#$20#$21#$23#$24#$25#$26; - data3= #$5E#$25#$CA#$78#$F0#$DE#$55#$80#$25#$24#$D3#$8D#$A3#$FE#$44#$56; -begin - //ECB - aes := TSynaAes.Create(key1); - try - t := aes.EncryptECB(data1); - result := t = #$D8#$F5#$32#$53#$82#$89#$EF#$7D#$06#$B5#$06#$A4#$FD#$5B#$E9#$C9; - s := aes.DecryptECB(t); - result := result and (data1 = s); - finally - aes.free; - end; - aes := TSynaAes.Create(key2); - try - t := aes.EncryptECB(data2); - result := result and (t = #$F3#$84#$72#$10#$D5#$39#$1E#$23#$60#$60#$8E#$5A#$CB#$56#$05#$81); - s := aes.DecryptECB(t); - result := result and (data2 = s); - finally - aes.free; - end; - aes := TSynaAes.Create(key3); - try - t := aes.EncryptECB(data3); - result := result and (t = #$E8#$B7#$2B#$4E#$8B#$E2#$43#$43#$8C#$9F#$FF#$1F#$0E#$20#$58#$72); - s := aes.DecryptECB(t); - result := result and (data3 = s); - finally - aes.free; - end; -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/synadbg.pas b/3rd/synapse/source/synadbg.pas deleted file mode 100644 index 6f60f4cc9..000000000 --- a/3rd/synapse/source/synadbg.pas +++ /dev/null @@ -1,156 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.002 | -|==============================================================================| -| Content: Socket debug tools | -|==============================================================================| -| Copyright (c)2008-2011, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2008-2011. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Socket debug tools) - -Routines for help with debugging of events on the Sockets. -} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit synadbg; - -interface - -uses - blcksock, synsock, synautil, classes, sysutils, synafpc; - -type - TSynaDebug = class(TObject) - class procedure HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string); - class procedure HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer); - end; - -procedure AppendToLog(const value: Ansistring); - -var - LogFile: string; - -implementation - -procedure AppendToLog(const value: Ansistring); -var - st: TFileStream; - s: string; - h, m, ss, ms: word; - dt: Tdatetime; -begin - if fileexists(LogFile) then - st := TFileStream.Create(LogFile, fmOpenReadWrite or fmShareDenyWrite) - else - st := TFileStream.Create(LogFile, fmCreate or fmShareDenyWrite); - try - st.Position := st.Size; - dt := now; - decodetime(dt, h, m, ss, ms); - s := formatdatetime('yyyymmdd-hhnnss', dt) + format('.%.3d', [ms]) + ' ' + value; - WriteStrToStream(st, s); - finally - st.free; - end; -end; - -class procedure TSynaDebug.HookStatus(Sender: TObject; Reason: THookSocketReason; const Value: string); -var - s: string; -begin - case Reason of - HR_ResolvingBegin: - s := 'HR_ResolvingBegin'; - HR_ResolvingEnd: - s := 'HR_ResolvingEnd'; - HR_SocketCreate: - s := 'HR_SocketCreate'; - HR_SocketClose: - s := 'HR_SocketClose'; - HR_Bind: - s := 'HR_Bind'; - HR_Connect: - s := 'HR_Connect'; - HR_CanRead: - s := 'HR_CanRead'; - HR_CanWrite: - s := 'HR_CanWrite'; - HR_Listen: - s := 'HR_Listen'; - HR_Accept: - s := 'HR_Accept'; - HR_ReadCount: - s := 'HR_ReadCount'; - HR_WriteCount: - s := 'HR_WriteCount'; - HR_Wait: - s := 'HR_Wait'; - HR_Error: - s := 'HR_Error'; - else - s := '-unknown-'; - end; - s := inttohex(PtrInt(Sender), 8) + s + ': ' + value + CRLF; - AppendToLog(s); -end; - -class procedure TSynaDebug.HookMonitor(Sender: TObject; Writing: Boolean; const Buffer: TMemory; Len: Integer); -var - s, d: Ansistring; -begin - setlength(s, len); - move(Buffer^, pointer(s)^, len); - if writing then - d := '-> ' - else - d := '<- '; - s :=inttohex(PtrInt(Sender), 8) + d + s + CRLF; - AppendToLog(s); -end; - -initialization -begin - Logfile := changefileext(paramstr(0), '.slog'); -end; - -end. diff --git a/3rd/synapse/source/synafpc.pas b/3rd/synapse/source/synafpc.pas deleted file mode 100644 index 63b5eb23c..000000000 --- a/3rd/synapse/source/synafpc.pas +++ /dev/null @@ -1,148 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.003.001 | -|==============================================================================| -| Content: Utils for FreePascal compatibility | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2003-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Tomas Hajny (OS2 support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -unit synafpc; - -interface - -uses -{$IFDEF FPC} - dynlibs, sysutils; -{$ELSE} - {$IFDEF MSWINDOWS} - Windows; - {$ELSE} - SysUtils; - {$ENDIF} -{$ENDIF} - -{$IFDEF FPC} -type - TLibHandle = dynlibs.TLibHandle; - -function LoadLibrary(ModuleName: PChar): TLibHandle; -function FreeLibrary(Module: TLibHandle): LongBool; -function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; -function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; -{$ELSE} //not FPC -type - {$IFDEF CIL} - TLibHandle = Integer; - PtrInt = Integer; - {$ELSE} - TLibHandle = HModule; - {$IFDEF WIN64} - PtrInt = NativeInt; - {$ELSE} - PtrInt = Integer; - {$ENDIF} - {$ENDIF} - {$IFDEF VER100} - LongWord = DWord; - {$ENDIF} -{$ENDIF} - -procedure Sleep(milliseconds: Cardinal); - - -implementation - -{==============================================================================} -{$IFDEF FPC} -function LoadLibrary(ModuleName: PChar): TLibHandle; -begin - Result := dynlibs.LoadLibrary(Modulename); -end; - -function FreeLibrary(Module: TLibHandle): LongBool; -begin - Result := dynlibs.UnloadLibrary(Module); -end; - -function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer; -begin -{$IFDEF OS2GCC} - Result := dynlibs.GetProcedureAddress(Module, '_' + Proc); -{$ELSE OS2GCC} - Result := dynlibs.GetProcedureAddress(Module, Proc); -{$ENDIF OS2GCC} -end; - -function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer; -begin - Result := 0; -end; - -{$ELSE} -{$ENDIF} - -procedure Sleep(milliseconds: Cardinal); -begin -{$IFDEF MSWINDOWS} - {$IFDEF FPC} - sysutils.sleep(milliseconds); - {$ELSE} - windows.sleep(milliseconds); - {$ENDIF} -{$ELSE} - sysutils.sleep(milliseconds); -{$ENDIF} - -end; - -end. diff --git a/3rd/synapse/source/synaicnv.pas b/3rd/synapse/source/synaicnv.pas deleted file mode 100644 index 8a51db5b2..000000000 --- a/3rd/synapse/source/synaicnv.pas +++ /dev/null @@ -1,368 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.001.002 | -|==============================================================================| -| Content: ICONV support for Win32, OS/2, Linux and .NET | -|==============================================================================| -| Copyright (c)2004-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2004-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Tomas Hajny (OS2 support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{:@abstract(LibIconv support) - -This unit is Pascal interface to LibIconv library for charset translations. -LibIconv is loaded dynamicly on-demand. If this library is not found in system, -requested LibIconv function just return errorcode. -} -unit synaicnv; - -interface - -uses -{$IFDEF CIL} - System.Runtime.InteropServices, - System.Text, -{$ENDIF} - synafpc, -{$IFNDEF MSWINDOWS} - {$IFNDEF FPC} - Libc, - {$ENDIF} - SysUtils; -{$ELSE} - Windows; -{$ENDIF} - - -const - {$IFNDEF MSWINDOWS} - {$IFDEF OS2} - DLLIconvName = 'iconv.dll'; - {$ELSE OS2} - DLLIconvName = 'libiconv.so'; - {$ENDIF OS2} - {$ELSE} - DLLIconvName = 'iconv.dll'; - {$ENDIF} - -type - size_t = Cardinal; -{$IFDEF CIL} - iconv_t = IntPtr; -{$ELSE} - iconv_t = Pointer; -{$ENDIF} - argptr = iconv_t; - -var - iconvLibHandle: TLibHandle = 0; - -function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t; -function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t; -function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t; -function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer; -function SynaIconvClose(var cd: iconv_t): integer; -function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer; - -function IsIconvloaded: Boolean; -function InitIconvInterface: Boolean; -function DestroyIconvInterface: Boolean; - -const - ICONV_TRIVIALP = 0; // int *argument - ICONV_GET_TRANSLITERATE = 1; // int *argument - ICONV_SET_TRANSLITERATE = 2; // const int *argument - ICONV_GET_DISCARD_ILSEQ = 3; // int *argument - ICONV_SET_DISCARD_ILSEQ = 4; // const int *argument - - -implementation - -uses SyncObjs; - -{$IFDEF CIL} - [DllImport(DLLIconvName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'libiconv_open')] - function _iconv_open(tocode: string; fromcode: string): iconv_t; external; - - [DllImport(DLLIconvName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'libiconv')] - function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t; - var outbuf: IntPtr; var outbytesleft: size_t): size_t; external; - - [DllImport(DLLIconvName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'libiconv_close')] - function _iconv_close(cd: iconv_t): integer; external; - - [DllImport(DLLIconvName, CharSet = CharSet.Ansi, - SetLastError = False, CallingConvention= CallingConvention.cdecl, - EntryPoint = 'libiconvctl')] - function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external; - -{$ELSE} -type - Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl; - Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t; - var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl; - Ticonv_close = function(cd: iconv_t): integer; cdecl; - Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl; -var - _iconv_open: Ticonv_open = nil; - _iconv: Ticonv = nil; - _iconv_close: Ticonv_close = nil; - _iconvctl: Ticonvctl = nil; -{$ENDIF} - - -var - IconvCS: TCriticalSection; - Iconvloaded: boolean = false; - -function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t; -begin -{$IFDEF CIL} - try - Result := _iconv_open(tocode, fromcode); - except - on Exception do - Result := iconv_t(-1); - end; -{$ELSE} - if InitIconvInterface and Assigned(_iconv_open) then - Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode)) - else - Result := iconv_t(-1); -{$ENDIF} -end; - -function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t; -begin - Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode); -end; - -function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t; -begin - Result := SynaIconvOpen(tocode + '//IGNORE', fromcode); -end; - -function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer; -var -{$IFDEF CIL} - ib, ob: IntPtr; - ibsave, obsave: IntPtr; - l: integer; -{$ELSE} - ib, ob: Pointer; -{$ENDIF} - ix, ox: size_t; -begin -{$IFDEF CIL} - l := Length(inbuf) * 4; - ibsave := IntPtr.Zero; - obsave := IntPtr.Zero; - try - ibsave := Marshal.StringToHGlobalAnsi(inbuf); - obsave := Marshal.AllocHGlobal(l); - ib := ibsave; - ob := obsave; - ix := Length(inbuf); - ox := l; - _iconv(cd, ib, ix, ob, ox); - Outbuf := Marshal.PtrToStringAnsi(obsave, l); - setlength(Outbuf, l - ox); - Result := Length(inbuf) - ix; - finally - Marshal.FreeCoTaskMem(ibsave); - Marshal.FreeHGlobal(obsave); - end; -{$ELSE} - if InitIconvInterface and Assigned(_iconv) then - begin - setlength(Outbuf, Length(inbuf) * 4); - ib := Pointer(inbuf); - ob := Pointer(Outbuf); - ix := Length(inbuf); - ox := Length(Outbuf); - _iconv(cd, ib, ix, ob, ox); - setlength(Outbuf, cardinal(Length(Outbuf)) - ox); - Result := Cardinal(Length(inbuf)) - ix; - end - else - begin - Outbuf := ''; - Result := 0; - end; -{$ENDIF} -end; - -function SynaIconvClose(var cd: iconv_t): integer; -begin - if cd = iconv_t(-1) then - begin - Result := 0; - Exit; - end; -{$IFDEF CIL} - try; - Result := _iconv_close(cd) - except - on Exception do - Result := -1; - end; - cd := iconv_t(-1); -{$ELSE} - if InitIconvInterface and Assigned(_iconv_close) then - Result := _iconv_close(cd) - else - Result := -1; - cd := iconv_t(-1); -{$ENDIF} -end; - -function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer; -begin -{$IFDEF CIL} - Result := _iconvctl(cd, request, argument) -{$ELSE} - if InitIconvInterface and Assigned(_iconvctl) then - Result := _iconvctl(cd, request, argument) - else - Result := 0; -{$ENDIF} -end; - -function InitIconvInterface: Boolean; -begin - IconvCS.Enter; - try - if not IsIconvloaded then - begin -{$IFDEF CIL} - IconvLibHandle := 1; -{$ELSE} - IconvLibHandle := LoadLibrary(PChar(DLLIconvName)); -{$ENDIF} - if (IconvLibHandle <> 0) then - begin -{$IFNDEF CIL} - _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open'))); - _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv'))); - _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close'))); - _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl'))); -{$ENDIF} - Result := True; - Iconvloaded := True; - end - else - begin - //load failed! - if IconvLibHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(IconvLibHandle); -{$ENDIF} - IconvLibHandle := 0; - end; - Result := False; - end; - end - else - //loaded before... - Result := true; - finally - IconvCS.Leave; - end; -end; - -function DestroyIconvInterface: Boolean; -begin - IconvCS.Enter; - try - Iconvloaded := false; - if IconvLibHandle <> 0 then - begin -{$IFNDEF CIL} - FreeLibrary(IconvLibHandle); -{$ENDIF} - IconvLibHandle := 0; - end; -{$IFNDEF CIL} - _iconv_open := nil; - _iconv := nil; - _iconv_close := nil; - _iconvctl := nil; -{$ENDIF} - finally - IconvCS.Leave; - end; - Result := True; -end; - -function IsIconvloaded: Boolean; -begin - Result := IconvLoaded; -end; - - initialization -begin - IconvCS:= TCriticalSection.Create; -end; - -finalization -begin -{$IFNDEF CIL} - DestroyIconvInterface; -{$ENDIF} - IconvCS.Free; -end; - -end. diff --git a/3rd/synapse/source/synaip.pas b/3rd/synapse/source/synaip.pas deleted file mode 100644 index 82a7da47e..000000000 --- a/3rd/synapse/source/synaip.pas +++ /dev/null @@ -1,422 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.002.001 | -|==============================================================================| -| Content: IP address support procedures and functions | -|==============================================================================| -| Copyright (c)2006-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 2006-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(IP adress support procedures and functions)} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$R-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} - {$WARN SUSPICIOUS_TYPECAST OFF} -{$ENDIF} - -unit synaip; - -interface - -uses - SysUtils, SynaUtil; - -type -{:binary form of IPv6 adress (for string conversion routines)} - TIp6Bytes = array [0..15] of Byte; -{:binary form of IPv6 adress (for string conversion routines)} - TIp6Words = array [0..7] of Word; - -{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!} -function IsIP(const Value: string): Boolean; - -{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!} -function IsIP6(const Value: string): Boolean; - -{:Returns a string with the "Host" ip address converted to binary form.} -function IPToID(Host: string): Ansistring; - -{:Convert IPv6 address from their string form to binary byte array.} -function StrToIp6(value: string): TIp6Bytes; - -{:Convert IPv6 address from binary byte array to string form.} -function Ip6ToStr(value: TIp6Bytes): string; - -{:Convert IPv4 address from their string form to binary.} -function StrToIp(value: string): integer; - -{:Convert IPv4 address from binary to string form.} -function IpToStr(value: integer): string; - -{:Convert IPv4 address to reverse form.} -function ReverseIP(Value: AnsiString): AnsiString; - -{:Convert IPv6 address to reverse form.} -function ReverseIP6(Value: AnsiString): AnsiString; - -{:Expand short form of IPv6 address to long form.} -function ExpandIP6(Value: AnsiString): AnsiString; - - -implementation - -{==============================================================================} - -function IsIP(const Value: string): Boolean; -var - TempIP: string; - function ByteIsOk(const Value: string): Boolean; - var - x, n: integer; - begin - x := StrToIntDef(Value, -1); - Result := (x >= 0) and (x < 256); - // X may be in correct range, but value still may not be correct value! - // i.e. "$80" - if Result then - for n := 1 to length(Value) do - if not (AnsiChar(Value[n]) in ['0'..'9']) then - begin - Result := False; - Break; - end; - end; -begin - TempIP := Value; - Result := False; - if not ByteIsOk(Fetch(TempIP, '.')) then - Exit; - if not ByteIsOk(Fetch(TempIP, '.')) then - Exit; - if not ByteIsOk(Fetch(TempIP, '.')) then - Exit; - if ByteIsOk(TempIP) then - Result := True; -end; - -{==============================================================================} - -function IsIP6(const Value: string): Boolean; -var - TempIP: string; - s,t: string; - x: integer; - partcount: integer; - zerocount: integer; - First: Boolean; -begin - TempIP := Value; - Result := False; - if Value = '::' then - begin - Result := True; - Exit; - end; - partcount := 0; - zerocount := 0; - First := True; - while tempIP <> '' do - begin - s := fetch(TempIP, ':'); - if not(First) and (s = '') then - Inc(zerocount); - First := False; - if zerocount > 1 then - break; - Inc(partCount); - if s = '' then - Continue; - if partCount > 8 then - break; - if tempIP = '' then - begin - t := SeparateRight(s, '%'); - s := SeparateLeft(s, '%'); - x := StrToIntDef('$' + t, -1); - if (x < 0) or (x > $ffff) then - break; - end; - x := StrToIntDef('$' + s, -1); - if (x < 0) or (x > $ffff) then - break; - if tempIP = '' then - if not((PartCount = 1) and (ZeroCount = 0)) then - Result := True; - end; -end; - -{==============================================================================} -function IPToID(Host: string): Ansistring; -var - s: string; - i, x: Integer; -begin - Result := ''; - for x := 0 to 3 do - begin - s := Fetch(Host, '.'); - i := StrToIntDef(s, 0); - Result := Result + AnsiChar(i); - end; -end; - -{==============================================================================} - -function StrToIp(value: string): integer; -var - s: string; - i, x: Integer; -begin - Result := 0; - for x := 0 to 3 do - begin - s := Fetch(value, '.'); - i := StrToIntDef(s, 0); - Result := (256 * Result) + i; - end; -end; - -{==============================================================================} - -function IpToStr(value: integer): string; -var - x1, x2: word; - y1, y2: byte; -begin - Result := ''; - x1 := value shr 16; - x2 := value and $FFFF; - y1 := x1 div $100; - y2 := x1 mod $100; - Result := inttostr(y1) + '.' + inttostr(y2) + '.'; - y1 := x2 div $100; - y2 := x2 mod $100; - Result := Result + inttostr(y1) + '.' + inttostr(y2); -end; - -{==============================================================================} - -function ExpandIP6(Value: AnsiString): AnsiString; -var - n: integer; - s: ansistring; - x: integer; -begin - Result := ''; - if value = '' then - exit; - x := countofchar(value, ':'); - if x > 7 then - exit; - if value[1] = ':' then - value := '0' + value; - if value[length(value)] = ':' then - value := value + '0'; - x := 8 - x; - s := ''; - for n := 1 to x do - s := s + ':0'; - s := s + ':'; - Result := replacestring(value, '::', s); -end; -{==============================================================================} - -function StrToIp6(Value: string): TIp6Bytes; -var - IPv6: TIp6Words; - Index: Integer; - n: integer; - b1, b2: byte; - s: string; - x: integer; -begin - for n := 0 to 15 do - Result[n] := 0; - for n := 0 to 7 do - Ipv6[n] := 0; - Index := 0; - Value := ExpandIP6(value); - if value = '' then - exit; - while Value <> '' do - begin - if Index > 7 then - Exit; - s := fetch(value, ':'); - if s = '@' then - break; - if s = '' then - begin - IPv6[Index] := 0; - end - else - begin - x := StrToIntDef('$' + s, -1); - if (x > 65535) or (x < 0) then - Exit; - IPv6[Index] := x; - end; - Inc(Index); - end; - for n := 0 to 7 do - begin - b1 := ipv6[n] div 256; - b2 := ipv6[n] mod 256; - Result[n * 2] := b1; - Result[(n * 2) + 1] := b2; - end; -end; - -{==============================================================================} -//based on routine by the Free Pascal development team -function Ip6ToStr(value: TIp6Bytes): string; -var - i, x: byte; - zr1,zr2: set of byte; - zc1,zc2: byte; - have_skipped: boolean; - ip6w: TIp6words; -begin - zr1 := []; - zr2 := []; - zc1 := 0; - zc2 := 0; - for i := 0 to 7 do - begin - x := i * 2; - ip6w[i] := value[x] * 256 + value[x + 1]; - if ip6w[i] = 0 then - begin - include(zr2, i); - inc(zc2); - end - else - begin - if zc1 < zc2 then - begin - zc1 := zc2; - zr1 := zr2; - zc2 := 0; - zr2 := []; - end; - end; - end; - if zc1 < zc2 then - begin - zr1 := zr2; - end; - SetLength(Result, 8*5-1); - SetLength(Result, 0); - have_skipped := false; - for i := 0 to 7 do - begin - if not(i in zr1) then - begin - if have_skipped then - begin - if Result = '' then - Result := '::' - else - Result := Result + ':'; - have_skipped := false; - end; - Result := Result + IntToHex(Ip6w[i], 1) + ':'; - end - else - begin - have_skipped := true; - end; - end; - if have_skipped then - if Result = '' then - Result := '::0' - else - Result := Result + ':'; - - if Result = '' then - Result := '::0'; - if not (7 in zr1) then - SetLength(Result, Length(Result)-1); - Result := LowerCase(result); -end; - -{==============================================================================} -function ReverseIP(Value: AnsiString): AnsiString; -var - x: Integer; -begin - Result := ''; - repeat - x := LastDelimiter('.', Value); - Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x); - Delete(Value, x, Length(Value) - x + 1); - until x < 1; - if Length(Result) > 0 then - if Result[1] = '.' then - Delete(Result, 1, 1); -end; - -{==============================================================================} -function ReverseIP6(Value: AnsiString): AnsiString; -var - ip6: TIp6bytes; - n: integer; - x, y: integer; -begin - ip6 := StrToIP6(Value); - x := ip6[15] div 16; - y := ip6[15] mod 16; - Result := IntToHex(y, 1) + '.' + IntToHex(x, 1); - for n := 14 downto 0 do - begin - x := ip6[n] div 16; - y := ip6[n] mod 16; - Result := Result + '.' + IntToHex(y, 1) + '.' + IntToHex(x, 1); - end; -end; - -{==============================================================================} -end. diff --git a/3rd/synapse/source/synamisc.pas b/3rd/synapse/source/synamisc.pas deleted file mode 100644 index 838c5c615..000000000 --- a/3rd/synapse/source/synamisc.pas +++ /dev/null @@ -1,408 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.003.001 | -|==============================================================================| -| Content: misc. procedures and functions | -|==============================================================================| -| Copyright (c)1999-2014, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 2002-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Miscellaneous network based utilities)} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$Q-} -{$H+} - -//Kylix does not known UNIX define -{$IFDEF LINUX} - {$IFNDEF UNIX} - {$DEFINE UNIX} - {$ENDIF} -{$ENDIF} - -{$TYPEDADDRESS OFF} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit synamisc; - -interface - -{$IFDEF VER125} - {$DEFINE BCB} -{$ENDIF} -{$IFDEF BCB} - {$ObjExportAll On} - {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'} -{$ENDIF} - -uses - synautil, blcksock, SysUtils, Classes -{$IFDEF UNIX} - {$IFNDEF FPC} - , Libc - {$ENDIF} -{$ELSE} - , Windows -{$ENDIF} -; - -Type - {:@abstract(This record contains information about proxy settings.)} - TProxySetting = record - Host: string; - Port: string; - Bypass: string; - end; - -{:With this function you can turn on a computer on the network, if this computer - supports Wake-on-LAN feature. You need the MAC address - (network card identifier) of the computer. You can also assign a target IP - addres. If you do not specify it, then broadcast is used to deliver magic - wake-on-LAN packet. - However broadcasts work only on your local network. When you need to wake-up a - computer on another network, you must specify any existing IP addres on same - network segment as targeting computer.} -procedure WakeOnLan(MAC, IP: string); - -{:Autodetect current DNS servers used by the system. If more than one DNS server - is defined, then the result is comma-delimited.} -function GetDNS: string; - -{:Autodetect InternetExplorer proxy setting for given protocol. This function -works only on windows!} -function GetIEProxy(protocol: string): TProxySetting; - -{:Return all known IP addresses on the local system. Addresses are divided by -comma/comma-delimited.} -function GetLocalIPs: string; - -implementation - -{==============================================================================} -procedure WakeOnLan(MAC, IP: string); -var - sock: TUDPBlockSocket; - HexMac: Ansistring; - data: Ansistring; - n: integer; - b: Byte; -begin - if MAC <> '' then - begin - MAC := ReplaceString(MAC, '-', ''); - MAC := ReplaceString(MAC, ':', ''); - if Length(MAC) < 12 then - Exit; - HexMac := ''; - for n := 0 to 5 do - begin - b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0); - HexMac := HexMac + char(b); - end; - if IP = '' then - IP := cBroadcast; - sock := TUDPBlockSocket.Create; - try - sock.CreateSocket; - sock.EnableBroadcast(true); - sock.Connect(IP, '9'); - data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF; - for n := 1 to 16 do - data := data + HexMac; - sock.SendString(data); - finally - sock.Free; - end; - end; -end; - -{==============================================================================} - -{$IFNDEF UNIX} -function GetDNSbyIpHlp: string; -type - PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING; - TIP_ADDRESS_STRING = array[0..15] of Ansichar; - PTIP_ADDR_STRING = ^TIP_ADDR_STRING; - TIP_ADDR_STRING = packed record - Next: PTIP_ADDR_STRING; - IpAddress: TIP_ADDRESS_STRING; - IpMask: TIP_ADDRESS_STRING; - Context: DWORD; - end; - PTFixedInfo = ^TFixedInfo; - TFixedInfo = packed record - HostName: array[1..128 + 4] of Ansichar; - DomainName: array[1..128 + 4] of Ansichar; - CurrentDNSServer: PTIP_ADDR_STRING; - DNSServerList: TIP_ADDR_STRING; - NodeType: UINT; - ScopeID: array[1..256 + 4] of Ansichar; - EnableRouting: UINT; - EnableProxy: UINT; - EnableDNS: UINT; - end; -const - IpHlpDLL = 'IPHLPAPI.DLL'; -var - IpHlpModule: THandle; - FixedInfo: PTFixedInfo; - InfoSize: Longint; - PDnsServer: PTIP_ADDR_STRING; - err: integer; - GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall; -begin - InfoSize := 0; - Result := '...'; - IpHlpModule := LoadLibrary(IpHlpDLL); - if IpHlpModule = 0 then - exit; - try - GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams'))); - if @GetNetworkParams = nil then - Exit; - err := GetNetworkParams(Nil, @InfoSize); - if err <> ERROR_BUFFER_OVERFLOW then - Exit; - Result := ''; - GetMem (FixedInfo, InfoSize); - try - err := GetNetworkParams(FixedInfo, @InfoSize); - if err <> ERROR_SUCCESS then - exit; - with FixedInfo^ do - begin - Result := DnsServerList.IpAddress; - PDnsServer := DnsServerList.Next; - while PDnsServer <> Nil do - begin - if Result <> '' then - Result := Result + ','; - Result := Result + PDnsServer^.IPAddress; - PDnsServer := PDnsServer.Next; - end; - end; - finally - FreeMem(FixedInfo); - end; - finally - FreeLibrary(IpHlpModule); - end; -end; - -function ReadReg(SubKey, Vn: PChar): string; -var - OpenKey: HKEY; - DataType, DataSize: integer; - Temp: array [0..2048] of char; -begin - Result := ''; - if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE, - KEY_READ, OpenKey) = ERROR_SUCCESS then - begin - DataType := REG_SZ; - DataSize := SizeOf(Temp); - if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then - SetString(Result, Temp, DataSize div SizeOf(Char) - 1); - RegCloseKey(OpenKey); - end; -end ; -{$ENDIF} - -function GetDNS: string; -{$IFDEF UNIX} -var - l: TStringList; - n: integer; -begin - Result := ''; - l := TStringList.Create; - try - l.LoadFromFile('/etc/resolv.conf'); - for n := 0 to l.Count - 1 do - if Pos('NAMESERVER', uppercase(l[n])) = 1 then - begin - if Result <> '' then - Result := Result + ','; - Result := Result + SeparateRight(l[n], ' '); - end; - finally - l.Free; - end; -end; -{$ELSE} -const - NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary'; - NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters'; - W9xfix = 'System\CurrentControlSet\Services\MSTCP'; -begin - Result := GetDNSbyIpHlp; - if Result = '...' then - begin - if Win32Platform = VER_PLATFORM_WIN32_NT then - begin - Result := ReadReg(NTdyn, 'NameServer'); - if result = '' then - Result := ReadReg(NTfix, 'NameServer'); - if result = '' then - Result := ReadReg(NTfix, 'DhcpNameServer'); - end - else - Result := ReadReg(W9xfix, 'NameServer'); - Result := ReplaceString(trim(Result), ' ', ','); - end; -end; -{$ENDIF} - -{==============================================================================} - -function GetIEProxy(protocol: string): TProxySetting; -{$IFDEF UNIX} -begin - Result.Host := ''; - Result.Port := ''; - Result.Bypass := ''; -end; -{$ELSE} -type - PInternetProxyInfo = ^TInternetProxyInfo; - TInternetProxyInfo = packed record - dwAccessType: DWORD; - lpszProxy: LPCSTR; - lpszProxyBypass: LPCSTR; - end; -const - INTERNET_OPTION_PROXY = 38; - INTERNET_OPEN_TYPE_PROXY = 3; - WininetDLL = 'WININET.DLL'; -var - WininetModule: THandle; - ProxyInfo: PInternetProxyInfo; - Err: Boolean; - Len: DWORD; - Proxy: string; - DefProxy: string; - ProxyList: TStringList; - n: integer; - InternetQueryOption: function (hInet: Pointer; dwOption: DWORD; - lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall; -begin - Result.Host := ''; - Result.Port := ''; - Result.Bypass := ''; - WininetModule := LoadLibrary(WininetDLL); - if WininetModule = 0 then - exit; - try - InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA'))); - if @InternetQueryOption = nil then - Exit; - - if protocol = '' then - protocol := 'http'; - Len := 4096; - GetMem(ProxyInfo, Len); - ProxyList := TStringList.Create; - try - Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len); - if Err then - if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then - begin - ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ','); - Proxy := ''; - DefProxy := ''; - for n := 0 to ProxyList.Count -1 do - begin - if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then - begin - Proxy := SeparateRight(ProxyList[n], '='); - break; - end; - if Pos('=', ProxyList[n]) < 1 then - DefProxy := ProxyList[n]; - end; - if Proxy = '' then - Proxy := DefProxy; - if Proxy <> '' then - begin - Result.Host := Trim(SeparateLeft(Proxy, ':')); - Result.Port := Trim(SeparateRight(Proxy, ':')); - end; - Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ','); - end; - finally - ProxyList.Free; - FreeMem(ProxyInfo); - end; - finally - FreeLibrary(WininetModule); - end; -end; -{$ENDIF} - -{==============================================================================} - -function GetLocalIPs: string; -var - TcpSock: TTCPBlockSocket; - ipList: TStringList; -begin - Result := ''; - ipList := TStringList.Create; - try - TcpSock := TTCPBlockSocket.create; - try - TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList); - Result := ipList.CommaText; - finally - TcpSock.Free; - end; - finally - ipList.Free; - end; -end; - -{==============================================================================} - -end. diff --git a/3rd/synapse/source/synaser.pas b/3rd/synapse/source/synaser.pas deleted file mode 100644 index 526ecb4fa..000000000 --- a/3rd/synapse/source/synaser.pas +++ /dev/null @@ -1,2336 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 007.005.006 | -|==============================================================================| -| Content: Serial port support | -|==============================================================================| -| Copyright (c)2001-2014, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2001-2014. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{: @abstract(Serial port communication library) -This unit contains a class that implements serial port communication - for Windows, Linux, Unix or MacOSx. This class provides numerous methods with - same name and functionality as methods of the Ararat Synapse TCP/IP library. - -The following is a small example how establish a connection by modem (in this -case with my USB modem): -@longcode(# - ser:=TBlockSerial.Create; - try - ser.Connect('COM3'); - ser.config(460800,8,'N',0,false,true); - ser.ATCommand('AT'); - if (ser.LastError <> 0) or (not ser.ATResult) then - Exit; - ser.ATConnect('ATDT+420971200111'); - if (ser.LastError <> 0) or (not ser.ATResult) then - Exit; - // you are now connected to a modem at +420971200111 - // you can transmit or receive data now - finally - ser.free; - end; -#) -} - -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -//Kylix does not known UNIX define -{$IFDEF LINUX} - {$IFNDEF UNIX} - {$DEFINE UNIX} - {$ENDIF} -{$ENDIF} - -{$IFDEF FPC} - {$MODE DELPHI} - {$IFDEF MSWINDOWS} - {$ASMMODE intel} - {$ENDIF} - {define working mode w/o LIBC for fpc} - {$DEFINE NO_LIBC} -{$ENDIF} -{$Q-} -{$H+} -{$M+} - -unit synaser; - -interface - -uses -{$IFNDEF MSWINDOWS} - {$IFNDEF NO_LIBC} - Libc, - KernelIoctl, - {$ELSE} - termio, baseunix, unix, - {$ENDIF} - {$IFNDEF FPC} - Types, - {$ENDIF} -{$ELSE} - Windows, registry, - {$IFDEF FPC} - winver, - {$ENDIF} -{$ENDIF} - synafpc, - Classes, SysUtils, synautil; - -const - CR = #$0d; - LF = #$0a; - CRLF = CR + LF; - cSerialChunk = 8192; - - LockfileDirectory = '/var/lock'; {HGJ} - PortIsClosed = -1; {HGJ} - ErrAlreadyOwned = 9991; {HGJ} - ErrAlreadyInUse = 9992; {HGJ} - ErrWrongParameter = 9993; {HGJ} - ErrPortNotOpen = 9994; {HGJ} - ErrNoDeviceAnswer = 9995; {HGJ} - ErrMaxBuffer = 9996; - ErrTimeout = 9997; - ErrNotRead = 9998; - ErrFrame = 9999; - ErrOverrun = 10000; - ErrRxOver = 10001; - ErrRxParity = 10002; - ErrTxFull = 10003; - - dcb_Binary = $00000001; - dcb_ParityCheck = $00000002; - dcb_OutxCtsFlow = $00000004; - dcb_OutxDsrFlow = $00000008; - dcb_DtrControlMask = $00000030; - dcb_DtrControlDisable = $00000000; - dcb_DtrControlEnable = $00000010; - dcb_DtrControlHandshake = $00000020; - dcb_DsrSensivity = $00000040; - dcb_TXContinueOnXoff = $00000080; - dcb_OutX = $00000100; - dcb_InX = $00000200; - dcb_ErrorChar = $00000400; - dcb_NullStrip = $00000800; - dcb_RtsControlMask = $00003000; - dcb_RtsControlDisable = $00000000; - dcb_RtsControlEnable = $00001000; - dcb_RtsControlHandshake = $00002000; - dcb_RtsControlToggle = $00003000; - dcb_AbortOnError = $00004000; - dcb_Reserveds = $FFFF8000; - - {:stopbit value for 1 stopbit} - SB1 = 0; - {:stopbit value for 1.5 stopbit} - SB1andHalf = 1; - {:stopbit value for 2 stopbits} - SB2 = 2; - -{$IFNDEF MSWINDOWS} -const - INVALID_HANDLE_VALUE = THandle(-1); - CS7fix = $0000020; - -type - TDCB = record - DCBlength: DWORD; - BaudRate: DWORD; - Flags: Longint; - wReserved: Word; - XonLim: Word; - XoffLim: Word; - ByteSize: Byte; - Parity: Byte; - StopBits: Byte; - XonChar: CHAR; - XoffChar: CHAR; - ErrorChar: CHAR; - EofChar: CHAR; - EvtChar: CHAR; - wReserved1: Word; - end; - PDCB = ^TDCB; - -const -{$IFDEF UNIX} - {$IFDEF BSD} - MaxRates = 18; //MAC - {$ELSE} - MaxRates = 30; //UNIX - {$ENDIF} -{$ELSE} - MaxRates = 19; //WIN -{$ENDIF} - Rates: array[0..MaxRates, 0..1] of cardinal = - ( - (0, B0), - (50, B50), - (75, B75), - (110, B110), - (134, B134), - (150, B150), - (200, B200), - (300, B300), - (600, B600), - (1200, B1200), - (1800, B1800), - (2400, B2400), - (4800, B4800), - (9600, B9600), - (19200, B19200), - (38400, B38400), - (57600, B57600), - (115200, B115200), - (230400, B230400) -{$IFNDEF BSD} - ,(460800, B460800) - {$IFDEF UNIX} - ,(500000, B500000), - (576000, B576000), - (921600, B921600), - (1000000, B1000000), - (1152000, B1152000), - (1500000, B1500000), - (2000000, B2000000), - (2500000, B2500000), - (3000000, B3000000), - (3500000, B3500000), - (4000000, B4000000) - {$ENDIF} -{$ENDIF} - ); -{$ENDIF} - -{$IFDEF BSD} -const // From fcntl.h - O_SYNC = $0080; { synchronous writes } -{$ENDIF} - -const - sOK = 0; - sErr = integer(-1); - -type - - {:Possible status event types for @link(THookSerialStatus)} - THookSerialReason = ( - HR_SerialClose, - HR_Connect, - HR_CanRead, - HR_CanWrite, - HR_ReadCount, - HR_WriteCount, - HR_Wait - ); - - {:procedural prototype for status event hooking} - THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason; - const Value: string) of object; - - {:@abstract(Exception type for SynaSer errors)} - ESynaSerError = class(Exception) - public - ErrorCode: integer; - ErrorMessage: string; - end; - - {:@abstract(Main class implementing all communication routines)} - TBlockSerial = class(TObject) - protected - FOnStatus: THookSerialStatus; - Fhandle: THandle; - FTag: integer; - FDevice: string; - FLastError: integer; - FLastErrorDesc: string; - FBuffer: AnsiString; - FRaiseExcept: boolean; - FRecvBuffer: integer; - FSendBuffer: integer; - FModemWord: integer; - FRTSToggle: Boolean; - FDeadlockTimeout: integer; - FInstanceActive: boolean; {HGJ} - FTestDSR: Boolean; - FTestCTS: Boolean; - FLastCR: Boolean; - FLastLF: Boolean; - FMaxLineLength: Integer; - FLinuxLock: Boolean; - FMaxSendBandwidth: Integer; - FNextSend: LongWord; - FMaxRecvBandwidth: Integer; - FNextRecv: LongWord; - FConvertLineEnd: Boolean; - FATResult: Boolean; - FAtTimeout: integer; - FInterPacketTimeout: Boolean; - FComNr: integer; -{$IFDEF MSWINDOWS} - FPortAddr: Word; - function CanEvent(Event: dword; Timeout: integer): boolean; - procedure DecodeCommError(Error: DWord); virtual; - {$IFDEF WIN32} - function GetPortAddr: Word; virtual; - function ReadTxEmpty(PortAddr: Word): Boolean; virtual; - {$ENDIF} -{$ENDIF} - procedure SetSizeRecvBuffer(size: integer); virtual; - function GetDSR: Boolean; virtual; - procedure SetDTRF(Value: Boolean); virtual; - function GetCTS: Boolean; virtual; - procedure SetRTSF(Value: Boolean); virtual; - function GetCarrier: Boolean; virtual; - function GetRing: Boolean; virtual; - procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual; - procedure GetComNr(Value: string); virtual; - function PreTestFailing: boolean; virtual;{HGJ} - function TestCtrlLine: Boolean; virtual; -{$IFDEF UNIX} - procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual; - procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual; - function ReadLockfile: integer; virtual; - function LockfileName: String; virtual; - procedure CreateLockfile(PidNr: integer); virtual; -{$ENDIF} - procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); virtual; - procedure SetBandwidth(Value: Integer); virtual; - public - {: data Control Block with communication parameters. Usable only when you - need to call API directly.} - DCB: Tdcb; -{$IFDEF UNIX} - TermiosStruc: termios; -{$ENDIF} - {:Object constructor.} - constructor Create; - {:Object destructor.} - destructor Destroy; override; - - {:Returns a string containing the version number of the library.} - class function GetVersion: string; virtual; - - {:Destroy handle in use. It close connection to serial port.} - procedure CloseSocket; virtual; - - {:Reconfigure communication parameters on the fly. You must be connected to - port before! - @param(baud Define connection speed. Baud rate can be from 50 to 4000000 - bits per second. (it depends on your hardware!)) - @param(bits Number of bits in communication.) - @param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).) - @param(stop Define number of stopbits. Use constants @link(SB1), - @link(SB1andHalf) and @link(SB2).) - @param(softflow Enable XON/XOFF handshake.) - @param(hardflow Enable CTS/RTS handshake.)} - procedure Config(baud, bits: integer; parity: char; stop: integer; - softflow, hardflow: boolean); virtual; - - {:Connects to the port indicated by comport. Comport can be used in Windows - style (COM2), or in Linux style (/dev/ttyS1). When you use windows style - in Linux, then it will be converted to Linux name. And vice versa! However - you can specify any device name! (other device names then standart is not - converted!) - - After successfull connection the DTR signal is set (if you not set hardware - handshake, then the RTS signal is set, too!) - - Connection parameters is predefined by your system configuration. If you - need use another parameters, then you can use Config method after. - Notes: - - - Remember, the commonly used serial Laplink cable does not support - hardware handshake. - - - Before setting any handshake you must be sure that it is supported by - your hardware. - - - Some serial devices are slow. In some cases you must wait up to a few - seconds after connection for the device to respond. - - - when you connect to a modem device, then is best to test it by an empty - AT command. (call ATCommand('AT'))} - procedure Connect(comport: string); virtual; - - {:Set communication parameters from the DCB structure (the DCB structure is - simulated under Linux).} - procedure SetCommState; virtual; - - {:Read communication parameters into the DCB structure (DCB structure is - simulated under Linux).} - procedure GetCommState; virtual; - - {:Sends Length bytes of data from Buffer through the connected port.} - function SendBuffer(buffer: pointer; length: integer): integer; virtual; - - {:One data BYTE is sent.} - procedure SendByte(data: byte); virtual; - - {:Send the string in the data parameter. No terminator is appended by this - method. If you need to send a string with CR/LF terminator, you must append - the CR/LF characters to the data string! - - Since no terminator is appended, you can use this function for sending - binary data too.} - procedure SendString(data: AnsiString); virtual; - - {:send four bytes as integer.} - procedure SendInteger(Data: integer); virtual; - - {:send data as one block. Each block begins with integer value with Length - of block.} - procedure SendBlock(const Data: AnsiString); virtual; - - {:send content of stream from current position} - procedure SendStreamRaw(const Stream: TStream); virtual; - - {:send content of stream as block. see @link(SendBlock)} - procedure SendStream(const Stream: TStream); virtual; - - {:send content of stream as block, but this is compatioble with Indy library. - (it have swapped lenght of block). See @link(SendStream)} - procedure SendStreamIndy(const Stream: TStream); virtual; - - {:Waits until the allocated buffer is filled by received data. Returns number - of data bytes received, which equals to the Length value under normal - operation. If it is not equal, the communication channel is possibly broken. - - This method not using any internal buffering, like all others receiving - methods. You cannot freely combine this method with all others receiving - methods!} - function RecvBuffer(buffer: pointer; length: integer): integer; virtual; - - {:Method waits until data is received. If no data is received within - the Timeout (in milliseconds) period, @link(LastError) is set to - @link(ErrTimeout). This method is used to read any amount of data - (e. g. 1MB), and may be freely combined with all receviving methods what - have Timeout parameter, like the @link(RecvString), @link(RecvByte) or - @link(RecvTerminated) methods.} - function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual; - - {:It is like recvBufferEx, but data is readed to dynamicly allocated binary - string.} - function RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; virtual; - - {:Read all available data and return it in the function result string. This - function may be combined with @link(RecvString), @link(RecvByte) or related - methods.} - function RecvPacket(Timeout: Integer): AnsiString; virtual; - - {:Waits until one data byte is received which is returned as the function - result. If no data is received within the Timeout (in milliseconds) period, - @link(LastError) is set to @link(ErrTimeout).} - function RecvByte(timeout: integer): byte; virtual; - - {:This method waits until a terminated data string is received. This string - is terminated by the Terminator string. The resulting string is returned - without this termination string! If no data is received within the Timeout - (in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).} - function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual; - - {:This method waits until a terminated data string is received. The string - is terminated by a CR/LF sequence. The resulting string is returned without - the terminator (CR/LF)! If no data is received within the Timeout (in - milliseconds) period, @link(LastError) is set to @link(ErrTimeout). - - If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly - CR/LF. See the description of @link(ConvertLineEnd). - - This method serves for line protocol implementation and uses its own - buffers to maximize performance. Therefore do NOT use this method with the - @link(RecvBuffer) method to receive data as it may cause data loss.} - function Recvstring(timeout: integer): AnsiString; virtual; - - {:Waits until four data bytes are received which is returned as the function - integer result. If no data is received within the Timeout (in milliseconds) period, - @link(LastError) is set to @link(ErrTimeout).} - function RecvInteger(Timeout: Integer): Integer; virtual; - - {:Waits until one data block is received. See @link(sendblock). If no data - is received within the Timeout (in milliseconds) period, @link(LastError) - is set to @link(ErrTimeout).} - function RecvBlock(Timeout: Integer): AnsiString; virtual; - - {:Receive all data to stream, until some error occured. (for example timeout)} - procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual; - - {:receive requested count of bytes to stream} - procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual; - - {:receive block of data to stream. (Data can be sended by @link(sendstream)} - procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual; - - {:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)} - procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual; - - {:Returns the number of received bytes waiting for reading. 0 is returned - when there is no data waiting.} - function WaitingData: integer; virtual; - - {:Same as @link(WaitingData), but in respect to data in the internal - @link(LineBuffer).} - function WaitingDataEx: integer; virtual; - - {:Returns the number of bytes waiting to be sent in the output buffer. - 0 is returned when the output buffer is empty.} - function SendingData: integer; virtual; - - {:Enable or disable RTS driven communication (half-duplex). It can be used - to communicate with RS485 converters, or other special equipment. If you - enable this feature, the system automatically controls the RTS signal. - - Notes: - - - On Windows NT (or higher) ir RTS signal driven by system driver. - - - On Win9x family is used special code for waiting until last byte is - sended from your UART. - - - On Linux you must have kernel 2.1 or higher!} - procedure EnableRTSToggle(value: boolean); virtual; - - {:Waits until all data to is sent and buffers are emptied. - Warning: On Windows systems is this method returns when all buffers are - flushed to the serial port controller, before the last byte is sent!} - procedure Flush; virtual; - - {:Unconditionally empty all buffers. It is good when you need to interrupt - communication and for cleanups.} - procedure Purge; virtual; - - {:Returns @True, if you can from read any data from the port. Status is - tested for a period of time given by the Timeout parameter (in milliseconds). - If the value of the Timeout parameter is 0, the status is tested only once - and the function returns immediately. If the value of the Timeout parameter - is set to -1, the function returns only after it detects data on the port - (this may cause the process to hang).} - function CanRead(Timeout: integer): boolean; virtual; - - {:Returns @True, if you can write any data to the port (this function is not - sending the contents of the buffer). Status is tested for a period of time - given by the Timeout parameter (in milliseconds). If the value of - the Timeout parameter is 0, the status is tested only once and the function - returns immediately. If the value of the Timeout parameter is set to -1, - the function returns only after it detects that it can write data to - the port (this may cause the process to hang).} - function CanWrite(Timeout: integer): boolean; virtual; - - {:Same as @link(CanRead), but the test is against data in the internal - @link(LineBuffer) too.} - function CanReadEx(Timeout: integer): boolean; virtual; - - {:Returns the status word of the modem. Decoding the status word could yield - the status of carrier detect signaland other signals. This method is used - internally by the modem status reading properties. You usually do not need - to call this method directly.} - function ModemStatus: integer; virtual; - - {:Send a break signal to the communication device for Duration milliseconds.} - procedure SetBreak(Duration: integer); virtual; - - {:This function is designed to send AT commands to the modem. The AT command - is sent in the Value parameter and the response is returned in the function - return value (may contain multiple lines!). - If the AT command is processed successfully (modem returns OK), then the - @link(ATResult) property is set to True. - - This function is designed only for AT commands that return OK or ERROR - response! To call connection commands the @link(ATConnect) method. - Remember, when you connect to a modem device, it is in AT command mode. - Now you can send AT commands to the modem. If you need to transfer data to - the modem on the other side of the line, you must first switch to data mode - using the @link(ATConnect) method.} - function ATCommand(value: AnsiString): AnsiString; virtual; - - {:This function is used to send connect type AT commands to the modem. It is - for commands to switch to connected state. (ATD, ATA, ATO,...) - It sends the AT command in the Value parameter and returns the modem's - response (may be multiple lines - usually with connection parameters info). - If the AT command is processed successfully (the modem returns CONNECT), - then the ATResult property is set to @True. - - This function is designed only for AT commands which respond by CONNECT, - BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the - @link(ATCommand) method. - - The connect timeout is 90*@link(ATTimeout). If this command is successful - (@link(ATresult) is @true), then the modem is in data state. When you now - send or receive some data, it is not to or from your modem, but from the - modem on other side of the line. Now you can transfer your data. - If the connection attempt failed (@link(ATResult) is @False), then the - modem is still in AT command mode.} - function ATConnect(value: AnsiString): AnsiString; virtual; - - {:If you "manually" call API functions, forward their return code in - the SerialResult parameter to this function, which evaluates it and sets - @link(LastError) and @link(LastErrorDesc).} - function SerialCheck(SerialResult: integer): integer; virtual; - - {:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure - raises an exception. This method is used internally. You may need it only - in special cases.} - procedure ExceptCheck; virtual; - - {:Set Synaser to error state with ErrNumber code. Usually used by internal - routines.} - procedure SetSynaError(ErrNumber: integer); virtual; - - {:Raise Synaser error with ErrNumber code. Usually used by internal routines.} - procedure RaiseSynaError(ErrNumber: integer); virtual; -{$IFDEF UNIX} - function cpomComportAccessible: boolean; virtual;{HGJ} - procedure cpomReleaseComport; virtual; {HGJ} -{$ENDIF} - {:True device name of currently used port} - property Device: string read FDevice; - - {:Error code of last operation. Value is defined by the host operating - system, but value 0 is always OK.} - property LastError: integer read FLastError; - - {:Human readable description of LastError code.} - property LastErrorDesc: string read FLastErrorDesc; - - {:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful} - property ATResult: Boolean read FATResult; - - {:Read the value of the RTS signal.} - property RTS: Boolean write SetRTSF; - - {:Indicates the presence of the CTS signal} - property CTS: boolean read GetCTS; - - {:Use this property to set the value of the DTR signal.} - property DTR: Boolean write SetDTRF; - - {:Exposes the status of the DSR signal.} - property DSR: boolean read GetDSR; - - {:Indicates the presence of the Carrier signal} - property Carrier: boolean read GetCarrier; - - {:Reflects the status of the Ring signal.} - property Ring: boolean read GetRing; - - {:indicates if this instance of SynaSer is active. (Connected to some port)} - property InstanceActive: boolean read FInstanceActive; {HGJ} - - {:Defines maximum bandwidth for all sending operations in bytes per second. - If this value is set to 0 (default), bandwidth limitation is not used.} - property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth; - - {:Defines maximum bandwidth for all receiving operations in bytes per second. - If this value is set to 0 (default), bandwidth limitation is not used.} - property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth; - - {:Defines maximum bandwidth for all sending and receiving operations - in bytes per second. If this value is set to 0 (default), bandwidth - limitation is not used.} - property MaxBandwidth: Integer Write SetBandwidth; - - {:Size of the Windows internal receive buffer. Default value is usually - 4096 bytes. Note: Valid only in Windows versions!} - property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer; - published - {:Returns the descriptive text associated with ErrorCode. You need this - method only in special cases. Description of LastError is now accessible - through the LastErrorDesc property.} - class function GetErrorDesc(ErrorCode: integer): string; - - {:Freely usable property} - property Tag: integer read FTag write FTag; - - {:Contains the handle of the open communication port. - You may need this value to directly call communication functions outside - SynaSer.} - property Handle: THandle read Fhandle write FHandle; - - {:Internally used read buffer.} - property LineBuffer: AnsiString read FBuffer write FBuffer; - - {:If @true, communication errors raise exceptions. If @false (default), only - the @link(LastError) value is set.} - property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept; - - {:This event is triggered when the communication status changes. It can be - used to monitor communication status.} - property OnStatus: THookSerialStatus read FOnStatus write FOnStatus; - - {:If you set this property to @true, then the value of the DSR signal - is tested before every data transfer. It can be used to detect the presence - of a communications device.} - property TestDSR: boolean read FTestDSR write FTestDSR; - - {:If you set this property to @true, then the value of the CTS signal - is tested before every data transfer. It can be used to detect the presence - of a communications device. Warning: This property cannot be used if you - need hardware handshake!} - property TestCTS: boolean read FTestCTS write FTestCTS; - - {:Use this property you to limit the maximum size of LineBuffer - (as a protection against unlimited memory allocation for LineBuffer). - Default value is 0 - no limit.} - property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength; - - {:This timeout value is used as deadlock protection when trying to send data - to (or receive data from) a device that stopped communicating during data - transmission (e.g. by physically disconnecting the device). - The timeout value is in milliseconds. The default value is 30,000 (30 seconds).} - property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout; - - {:If set to @true (default value), port locking is enabled (under Linux only). - WARNING: To use this feature, the application must run by a user with full - permission to the /var/lock directory!} - property LinuxLock: Boolean read FLinuxLock write FLinuxLock; - - {:Indicates if non-standard line terminators should be converted to a CR/LF pair - (standard DOS line terminator). If @TRUE, line terminators CR, single LF - or LF/CR are converted to CR/LF. Defaults to @FALSE. - This property has effect only on the behavior of the RecvString method.} - property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd; - - {:Timeout for AT modem based operations} - property AtTimeout: integer read FAtTimeout Write FAtTimeout; - - {:If @true (default), then all timeouts is timeout between two characters. - If @False, then timeout is overall for whoole reading operation.} - property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout; - end; - -{:Returns list of existing computer serial ports. Working properly only in Windows!} -function GetSerialPortNames: string; - -implementation - -constructor TBlockSerial.Create; -begin - inherited create; - FRaiseExcept := false; - FHandle := INVALID_HANDLE_VALUE; - FDevice := ''; - FComNr:= PortIsClosed; {HGJ} - FInstanceActive:= false; {HGJ} - Fbuffer := ''; - FRTSToggle := False; - FMaxLineLength := 0; - FTestDSR := False; - FTestCTS := False; - FDeadlockTimeout := 30000; - FLinuxLock := True; - FMaxSendBandwidth := 0; - FNextSend := 0; - FMaxRecvBandwidth := 0; - FNextRecv := 0; - FConvertLineEnd := False; - SetSynaError(sOK); - FRecvBuffer := 4096; - FLastCR := False; - FLastLF := False; - FAtTimeout := 1000; - FInterPacketTimeout := True; -end; - -destructor TBlockSerial.Destroy; -begin - CloseSocket; - inherited destroy; -end; - -class function TBlockSerial.GetVersion: string; -begin - Result := 'SynaSer 7.5.4'; -end; - -procedure TBlockSerial.CloseSocket; -begin - if Fhandle <> INVALID_HANDLE_VALUE then - begin - Purge; - RTS := False; - DTR := False; - FileClose(FHandle); - end; - if InstanceActive then - begin - {$IFDEF UNIX} - if FLinuxLock then - cpomReleaseComport; - {$ENDIF} - FInstanceActive:= false - end; - Fhandle := INVALID_HANDLE_VALUE; - FComNr:= PortIsClosed; - SetSynaError(sOK); - DoStatus(HR_SerialClose, FDevice); -end; - -{$IFDEF WIN32} -function TBlockSerial.GetPortAddr: Word; -begin - Result := 0; - if Win32Platform <> VER_PLATFORM_WIN32_NT then - begin - EscapeCommFunction(FHandle, 10); - asm - MOV @Result, DX; - end; - end; -end; - -function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean; -begin - Result := True; - if Win32Platform <> VER_PLATFORM_WIN32_NT then - begin - asm - MOV DX, PortAddr; - ADD DX, 5; - IN AL, DX; - AND AL, $40; - JZ @K; - MOV AL,1; - @K: MOV @Result, AL; - end; - end; -end; -{$ENDIF} - -procedure TBlockSerial.GetComNr(Value: string); -begin - FComNr := PortIsClosed; - if pos('COM', uppercase(Value)) = 1 then - FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1; - if pos('/DEV/TTYS', uppercase(Value)) = 1 then - FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1); -end; - -procedure TBlockSerial.SetBandwidth(Value: Integer); -begin - MaxSendBandwidth := Value; - MaxRecvBandwidth := Value; -end; - -procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); -var - x: LongWord; - y: LongWord; -begin - if MaxB > 0 then - begin - y := GetTick; - if Next > y then - begin - x := Next - y; - if x > 0 then - begin - DoStatus(HR_Wait, IntToStr(x)); - sleep(x); - end; - end; - Next := GetTick + Trunc((Length / MaxB) * 1000); - end; -end; - -procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer; - softflow, hardflow: boolean); -begin - FillChar(dcb, SizeOf(dcb), 0); - GetCommState; - dcb.DCBlength := SizeOf(dcb); - dcb.BaudRate := baud; - dcb.ByteSize := bits; - case parity of - 'N', 'n': dcb.parity := 0; - 'O', 'o': dcb.parity := 1; - 'E', 'e': dcb.parity := 2; - 'M', 'm': dcb.parity := 3; - 'S', 's': dcb.parity := 4; - end; - dcb.StopBits := stop; - dcb.XonChar := #17; - dcb.XoffChar := #19; - dcb.XonLim := FRecvBuffer div 4; - dcb.XoffLim := FRecvBuffer div 4; - dcb.Flags := dcb_Binary; - if softflow then - dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX; - if hardflow then - dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake - else - dcb.Flags := dcb.Flags or dcb_RtsControlEnable; - dcb.Flags := dcb.Flags or dcb_DtrControlEnable; - if dcb.Parity > 0 then - dcb.Flags := dcb.Flags or dcb_ParityCheck; - SetCommState; -end; - -procedure TBlockSerial.Connect(comport: string); -{$IFDEF MSWINDOWS} -var - CommTimeouts: TCommTimeouts; -{$ENDIF} -begin - // Is this TBlockSerial Instance already busy? - if InstanceActive then {HGJ} - begin {HGJ} - RaiseSynaError(ErrAlreadyInUse); - Exit; {HGJ} - end; {HGJ} - FBuffer := ''; - FDevice := comport; - GetComNr(comport); -{$IFDEF MSWINDOWS} - SetLastError (sOK); -{$ELSE} - {$IFNDEF FPC} - SetLastError (sOK); - {$ELSE} - fpSetErrno(sOK); - {$ENDIF} -{$ENDIF} -{$IFNDEF MSWINDOWS} - if FComNr <> PortIsClosed then - FDevice := '/dev/ttyS' + IntToStr(FComNr); - // Comport already owned by another process? {HGJ} - if FLinuxLock then - if not cpomComportAccessible then - begin - RaiseSynaError(ErrAlreadyOwned); - Exit; - end; -{$IFNDEF FPC} - FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC)); -{$ELSE} - FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC)); -{$ENDIF} - if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms! - SerialCheck(-1) - else - SerialCheck(0); - {$IFDEF UNIX} - if FLastError <> sOK then - if FLinuxLock then - cpomReleaseComport; - {$ENDIF} - ExceptCheck; - if FLastError <> sOK then - Exit; -{$ELSE} - if FComNr <> PortIsClosed then - FDevice := '\\.\COM' + IntToStr(FComNr + 1); - FHandle := THandle(CreateFile(PChar(FDevice), GENERIC_READ or GENERIC_WRITE, - 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0)); - if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms! - SerialCheck(-1) - else - SerialCheck(0); - ExceptCheck; - if FLastError <> sOK then - Exit; - SetCommMask(FHandle, 0); - SetupComm(Fhandle, FRecvBuffer, 0); - CommTimeOuts.ReadIntervalTimeout := MAXWORD; - CommTimeOuts.ReadTotalTimeoutMultiplier := 0; - CommTimeOuts.ReadTotalTimeoutConstant := 0; - CommTimeOuts.WriteTotalTimeoutMultiplier := 0; - CommTimeOuts.WriteTotalTimeoutConstant := 0; - SetCommTimeOuts(FHandle, CommTimeOuts); - {$IFDEF WIN32} - FPortAddr := GetPortAddr; - {$ENDIF} -{$ENDIF} - SetSynaError(sOK); - if not TestCtrlLine then {HGJ} - begin - SetSynaError(ErrNoDeviceAnswer); - FileClose(FHandle); {HGJ} - {$IFDEF UNIX} - if FLinuxLock then - cpomReleaseComport; {HGJ} - {$ENDIF} {HGJ} - Fhandle := INVALID_HANDLE_VALUE; {HGJ} - FComNr:= PortIsClosed; {HGJ} - end - else - begin - FInstanceActive:= True; - RTS := True; - DTR := True; - Purge; - end; - ExceptCheck; - DoStatus(HR_Connect, FDevice); -end; - -function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer; -{$IFDEF MSWINDOWS} -var - Overlapped: TOverlapped; - x, y, Err: DWord; -{$ENDIF} -begin - Result := 0; - if PreTestFailing then {HGJ} - Exit; {HGJ} - LimitBandwidth(Length, FMaxSendBandwidth, FNextsend); - if FRTSToggle then - begin - Flush; - RTS := True; - end; -{$IFNDEF MSWINDOWS} - result := FileWrite(Fhandle, Buffer^, Length); - serialcheck(result); -{$ELSE} - FillChar(Overlapped, Sizeof(Overlapped), 0); - SetSynaError(sOK); - y := 0; - if not WriteFile(FHandle, Buffer^, Length, DWord(Result), @Overlapped) then - y := GetLastError; - if y = ERROR_IO_PENDING then - begin - x := WaitForSingleObject(FHandle, FDeadlockTimeout); - if x = WAIT_TIMEOUT then - begin - PurgeComm(FHandle, PURGE_TXABORT); - SetSynaError(ErrTimeout); - end; - GetOverlappedResult(FHandle, Overlapped, Dword(Result), False); - end - else - SetSynaError(y); - ClearCommError(FHandle, err, nil); - if err <> 0 then - DecodeCommError(err); -{$ENDIF} - if FRTSToggle then - begin - Flush; - CanWrite(255); - RTS := False; - end; - ExceptCheck; - DoStatus(HR_WriteCount, IntToStr(Result)); -end; - -procedure TBlockSerial.SendByte(data: byte); -begin - SendBuffer(@Data, 1); -end; - -procedure TBlockSerial.SendString(data: AnsiString); -begin - SendBuffer(Pointer(Data), Length(Data)); -end; - -procedure TBlockSerial.SendInteger(Data: integer); -begin - SendBuffer(@data, SizeOf(Data)); -end; - -procedure TBlockSerial.SendBlock(const Data: AnsiString); -begin - SendInteger(Length(data)); - SendString(Data); -end; - -procedure TBlockSerial.SendStreamRaw(const Stream: TStream); -var - si: integer; - x, y, yr: integer; - s: AnsiString; -begin - si := Stream.Size - Stream.Position; - x := 0; - while x < si do - begin - y := si - x; - if y > cSerialChunk then - y := cSerialChunk; - Setlength(s, y); - yr := Stream.read(PAnsiChar(s)^, y); - if yr > 0 then - begin - SetLength(s, yr); - SendString(s); - Inc(x, yr); - end - else - break; - end; -end; - -procedure TBlockSerial.SendStreamIndy(const Stream: TStream); -var - si: integer; -begin - si := Stream.Size - Stream.Position; - si := Swapbytes(si); - SendInteger(si); - SendStreamRaw(Stream); -end; - -procedure TBlockSerial.SendStream(const Stream: TStream); -var - si: integer; -begin - si := Stream.Size - Stream.Position; - SendInteger(si); - SendStreamRaw(Stream); -end; - -function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer; -{$IFNDEF MSWINDOWS} -begin - Result := 0; - if PreTestFailing then {HGJ} - Exit; {HGJ} - LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); - result := FileRead(FHandle, Buffer^, length); - serialcheck(result); -{$ELSE} -var - Overlapped: TOverlapped; - x, y, Err: DWord; -begin - Result := 0; - if PreTestFailing then {HGJ} - Exit; {HGJ} - LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); - FillChar(Overlapped, Sizeof(Overlapped), 0); - SetSynaError(sOK); - y := 0; - if not ReadFile(FHandle, Buffer^, length, Dword(Result), @Overlapped) then - y := GetLastError; - if y = ERROR_IO_PENDING then - begin - x := WaitForSingleObject(FHandle, FDeadlockTimeout); - if x = WAIT_TIMEOUT then - begin - PurgeComm(FHandle, PURGE_RXABORT); - SetSynaError(ErrTimeout); - end; - GetOverlappedResult(FHandle, Overlapped, Dword(Result), False); - end - else - SetSynaError(y); - ClearCommError(FHandle, err, nil); - if err <> 0 then - DecodeCommError(err); -{$ENDIF} - ExceptCheck; - DoStatus(HR_ReadCount, IntToStr(Result)); -end; - -function TBlockSerial.RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; -var - s: AnsiString; - rl, l: integer; - ti: LongWord; -begin - Result := 0; - if PreTestFailing then {HGJ} - Exit; {HGJ} - SetSynaError(sOK); - rl := 0; - repeat - ti := GetTick; - s := RecvPacket(Timeout); - l := System.Length(s); - if (rl + l) > Length then - l := Length - rl; - Move(Pointer(s)^, IncPoint(Buffer, rl)^, l); - rl := rl + l; - if FLastError <> sOK then - Break; - if rl >= Length then - Break; - if not FInterPacketTimeout then - begin - Timeout := Timeout - integer(TickDelta(ti, GetTick)); - if Timeout <= 0 then - begin - SetSynaError(ErrTimeout); - Break; - end; - end; - until False; - delete(s, 1, l); - FBuffer := s; - Result := rl; -end; - -function TBlockSerial.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; -var - x: integer; -begin - Result := ''; - if PreTestFailing then {HGJ} - Exit; {HGJ} - SetSynaError(sOK); - if Length > 0 then - begin - Setlength(Result, Length); - x := RecvBufferEx(PAnsiChar(Result), Length , Timeout); - if FLastError = sOK then - SetLength(Result, x) - else - Result := ''; - end; -end; - -function TBlockSerial.RecvPacket(Timeout: Integer): AnsiString; -var - x: integer; -begin - Result := ''; - if PreTestFailing then {HGJ} - Exit; {HGJ} - SetSynaError(sOK); - if FBuffer <> '' then - begin - Result := FBuffer; - FBuffer := ''; - end - else - begin - //not drain CPU on large downloads... - Sleep(0); - x := WaitingData; - if x > 0 then - begin - SetLength(Result, x); - x := RecvBuffer(Pointer(Result), x); - if x >= 0 then - SetLength(Result, x); - end - else - begin - if CanRead(Timeout) then - begin - x := WaitingData; - if x = 0 then - SetSynaError(ErrTimeout); - if x > 0 then - begin - SetLength(Result, x); - x := RecvBuffer(Pointer(Result), x); - if x >= 0 then - SetLength(Result, x); - end; - end - else - SetSynaError(ErrTimeout); - end; - end; - ExceptCheck; -end; - - -function TBlockSerial.RecvByte(timeout: integer): byte; -begin - Result := 0; - if PreTestFailing then {HGJ} - Exit; {HGJ} - SetSynaError(sOK); - if FBuffer = '' then - FBuffer := RecvPacket(Timeout); - if (FLastError = sOK) and (FBuffer <> '') then - begin - Result := Ord(FBuffer[1]); - System.Delete(FBuffer, 1, 1); - end; - ExceptCheck; -end; - -function TBlockSerial.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; -var - x: Integer; - s: AnsiString; - l: Integer; - CorCRLF: Boolean; - t: ansistring; - tl: integer; - ti: LongWord; -begin - Result := ''; - if PreTestFailing then {HGJ} - Exit; {HGJ} - SetSynaError(sOK); - l := system.Length(Terminator); - if l = 0 then - Exit; - tl := l; - CorCRLF := FConvertLineEnd and (Terminator = CRLF); - s := ''; - x := 0; - repeat - ti := GetTick; - //get rest of FBuffer or incomming new data... - s := s + RecvPacket(Timeout); - if FLastError <> sOK then - Break; - x := 0; - if Length(s) > 0 then - if CorCRLF then - begin - if FLastCR and (s[1] = LF) then - Delete(s, 1, 1); - if FLastLF and (s[1] = CR) then - Delete(s, 1, 1); - FLastCR := False; - FLastLF := False; - t := ''; - x := PosCRLF(s, t); - tl := system.Length(t); - if t = CR then - FLastCR := True; - if t = LF then - FLastLF := True; - end - else - begin - x := pos(Terminator, s); - tl := l; - end; - if (FMaxLineLength <> 0) and (system.Length(s) > FMaxLineLength) then - begin - SetSynaError(ErrMaxBuffer); - Break; - end; - if x > 0 then - Break; - if not FInterPacketTimeout then - begin - Timeout := Timeout - integer(TickDelta(ti, GetTick)); - if Timeout <= 0 then - begin - SetSynaError(ErrTimeout); - Break; - end; - end; - until False; - if x > 0 then - begin - Result := Copy(s, 1, x - 1); - System.Delete(s, 1, x + tl - 1); - end; - FBuffer := s; - ExceptCheck; -end; - - -function TBlockSerial.RecvString(Timeout: Integer): AnsiString; -var - s: AnsiString; -begin - Result := ''; - s := RecvTerminated(Timeout, #13 + #10); - if FLastError = sOK then - Result := s; -end; - -function TBlockSerial.RecvInteger(Timeout: Integer): Integer; -var - s: AnsiString; -begin - Result := 0; - s := RecvBufferStr(4, Timeout); - if FLastError = 0 then - Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536; -end; - -function TBlockSerial.RecvBlock(Timeout: Integer): AnsiString; -var - x: integer; -begin - Result := ''; - x := RecvInteger(Timeout); - if FLastError = 0 then - Result := RecvBufferStr(x, Timeout); -end; - -procedure TBlockSerial.RecvStreamRaw(const Stream: TStream; Timeout: Integer); -var - s: AnsiString; -begin - repeat - s := RecvPacket(Timeout); - if FLastError = 0 then - WriteStrToStream(Stream, s); - until FLastError <> 0; -end; - -procedure TBlockSerial.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); -var - s: AnsiString; - n: integer; -begin - for n := 1 to (Size div cSerialChunk) do - begin - s := RecvBufferStr(cSerialChunk, Timeout); - if FLastError <> 0 then - Exit; - Stream.Write(PAnsichar(s)^, cSerialChunk); - end; - n := Size mod cSerialChunk; - if n > 0 then - begin - s := RecvBufferStr(n, Timeout); - if FLastError <> 0 then - Exit; - Stream.Write(PAnsichar(s)^, n); - end; -end; - -procedure TBlockSerial.RecvStreamIndy(const Stream: TStream; Timeout: Integer); -var - x: integer; -begin - x := RecvInteger(Timeout); - x := SwapBytes(x); - if FLastError = 0 then - RecvStreamSize(Stream, Timeout, x); -end; - -procedure TBlockSerial.RecvStream(const Stream: TStream; Timeout: Integer); -var - x: integer; -begin - x := RecvInteger(Timeout); - if FLastError = 0 then - RecvStreamSize(Stream, Timeout, x); -end; - -{$IFNDEF MSWINDOWS} -function TBlockSerial.WaitingData: integer; -begin -{$IFNDEF FPC} - serialcheck(ioctl(FHandle, FIONREAD, @result)); -{$ELSE} - serialcheck(fpIoctl(FHandle, FIONREAD, @result)); -{$ENDIF} - if FLastError <> 0 then - Result := 0; - ExceptCheck; -end; -{$ELSE} -function TBlockSerial.WaitingData: integer; -var - stat: TComStat; - err: DWORD; -begin - if ClearCommError(FHandle, err, @stat) then - begin - SetSynaError(sOK); - Result := stat.cbInQue; - end - else - begin - SerialCheck(sErr); - Result := 0; - end; - ExceptCheck; -end; -{$ENDIF} - -function TBlockSerial.WaitingDataEx: integer; -begin - if FBuffer <> '' then - Result := Length(FBuffer) - else - Result := Waitingdata; -end; - -{$IFNDEF MSWINDOWS} -function TBlockSerial.SendingData: integer; -begin - SetSynaError(sOK); - Result := 0; -end; -{$ELSE} -function TBlockSerial.SendingData: integer; -var - stat: TComStat; - err: DWORD; -begin - SetSynaError(sOK); - if not ClearCommError(FHandle, err, @stat) then - serialcheck(sErr); - ExceptCheck; - result := stat.cbOutQue; -end; -{$ENDIF} - -{$IFNDEF MSWINDOWS} -procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios); -var - n: integer; - x: cardinal; -begin - //others - cfmakeraw(term); - term.c_cflag := term.c_cflag or CREAD; - term.c_cflag := term.c_cflag or CLOCAL; - term.c_cflag := term.c_cflag or HUPCL; - //hardware handshake - if (dcb.flags and dcb_RtsControlHandshake) > 0 then - term.c_cflag := term.c_cflag or CRTSCTS - else - term.c_cflag := term.c_cflag and (not CRTSCTS); - //software handshake - if (dcb.flags and dcb_OutX) > 0 then - term.c_iflag := term.c_iflag or IXON or IXOFF or IXANY - else - term.c_iflag := term.c_iflag and (not (IXON or IXOFF or IXANY)); - //size of byte - term.c_cflag := term.c_cflag and (not CSIZE); - case dcb.bytesize of - 5: - term.c_cflag := term.c_cflag or CS5; - 6: - term.c_cflag := term.c_cflag or CS6; - 7: -{$IFDEF FPC} - term.c_cflag := term.c_cflag or CS7; -{$ELSE} - term.c_cflag := term.c_cflag or CS7fix; -{$ENDIF} - 8: - term.c_cflag := term.c_cflag or CS8; - end; - //parity - if (dcb.flags and dcb_ParityCheck) > 0 then - term.c_cflag := term.c_cflag or PARENB - else - term.c_cflag := term.c_cflag and (not PARENB); - case dcb.parity of - 1: //'O' - term.c_cflag := term.c_cflag or PARODD; - 2: //'E' - term.c_cflag := term.c_cflag and (not PARODD); - end; - //stop bits - if dcb.stopbits > 0 then - term.c_cflag := term.c_cflag or CSTOPB - else - term.c_cflag := term.c_cflag and (not CSTOPB); - //set baudrate; - x := 0; - for n := 0 to Maxrates do - if rates[n, 0] = dcb.BaudRate then - begin - x := rates[n, 1]; - break; - end; - cfsetospeed(term, x); - cfsetispeed(term, x); -end; - -procedure TBlockSerial.TermiosToDcb(const term: termios; var dcb: TDCB); -var - n: integer; - x: cardinal; -begin - //set baudrate; - dcb.baudrate := 0; - {$IFDEF FPC} - //why FPC not have cfgetospeed??? - x := term.c_oflag and $0F; - {$ELSE} - x := cfgetospeed(term); - {$ENDIF} - for n := 0 to Maxrates do - if rates[n, 1] = x then - begin - dcb.baudrate := rates[n, 0]; - break; - end; - //hardware handshake - if (term.c_cflag and CRTSCTS) > 0 then - dcb.flags := dcb.flags or dcb_RtsControlHandshake or dcb_OutxCtsFlow - else - dcb.flags := dcb.flags and (not (dcb_RtsControlHandshake or dcb_OutxCtsFlow)); - //software handshake - if (term.c_cflag and IXOFF) > 0 then - dcb.flags := dcb.flags or dcb_OutX or dcb_InX - else - dcb.flags := dcb.flags and (not (dcb_OutX or dcb_InX)); - //size of byte - case term.c_cflag and CSIZE of - CS5: - dcb.bytesize := 5; - CS6: - dcb.bytesize := 6; - CS7fix: - dcb.bytesize := 7; - CS8: - dcb.bytesize := 8; - end; - //parity - if (term.c_cflag and PARENB) > 0 then - dcb.flags := dcb.flags or dcb_ParityCheck - else - dcb.flags := dcb.flags and (not dcb_ParityCheck); - dcb.parity := 0; - if (term.c_cflag and PARODD) > 0 then - dcb.parity := 1 - else - dcb.parity := 2; - //stop bits - if (term.c_cflag and CSTOPB) > 0 then - dcb.stopbits := 2 - else - dcb.stopbits := 0; -end; -{$ENDIF} - -{$IFNDEF MSWINDOWS} -procedure TBlockSerial.SetCommState; -begin - DcbToTermios(dcb, termiosstruc); - SerialCheck(tcsetattr(FHandle, TCSANOW, termiosstruc)); - ExceptCheck; -end; -{$ELSE} -procedure TBlockSerial.SetCommState; -begin - SetSynaError(sOK); - if not windows.SetCommState(Fhandle, dcb) then - SerialCheck(sErr); - ExceptCheck; -end; -{$ENDIF} - -{$IFNDEF MSWINDOWS} -procedure TBlockSerial.GetCommState; -begin - SerialCheck(tcgetattr(FHandle, termiosstruc)); - ExceptCheck; - TermiostoDCB(termiosstruc, dcb); -end; -{$ELSE} -procedure TBlockSerial.GetCommState; -begin - SetSynaError(sOK); - if not windows.GetCommState(Fhandle, dcb) then - SerialCheck(sErr); - ExceptCheck; -end; -{$ENDIF} - -procedure TBlockSerial.SetSizeRecvBuffer(size: integer); -begin -{$IFDEF MSWINDOWS} - SetupComm(Fhandle, size, 0); - GetCommState; - dcb.XonLim := size div 4; - dcb.XoffLim := size div 4; - SetCommState; -{$ENDIF} - FRecvBuffer := size; -end; - -function TBlockSerial.GetDSR: Boolean; -begin - ModemStatus; -{$IFNDEF MSWINDOWS} - Result := (FModemWord and TIOCM_DSR) > 0; -{$ELSE} - Result := (FModemWord and MS_DSR_ON) > 0; -{$ENDIF} -end; - -procedure TBlockSerial.SetDTRF(Value: Boolean); -begin -{$IFNDEF MSWINDOWS} - ModemStatus; - if Value then - FModemWord := FModemWord or TIOCM_DTR - else - FModemWord := FModemWord and not TIOCM_DTR; - {$IFNDEF FPC} - ioctl(FHandle, TIOCMSET, @FModemWord); - {$ELSE} - fpioctl(FHandle, TIOCMSET, @FModemWord); - {$ENDIF} -{$ELSE} - if Value then - EscapeCommFunction(FHandle, SETDTR) - else - EscapeCommFunction(FHandle, CLRDTR); -{$ENDIF} -end; - -function TBlockSerial.GetCTS: Boolean; -begin - ModemStatus; -{$IFNDEF MSWINDOWS} - Result := (FModemWord and TIOCM_CTS) > 0; -{$ELSE} - Result := (FModemWord and MS_CTS_ON) > 0; -{$ENDIF} -end; - -procedure TBlockSerial.SetRTSF(Value: Boolean); -begin -{$IFNDEF MSWINDOWS} - ModemStatus; - if Value then - FModemWord := FModemWord or TIOCM_RTS - else - FModemWord := FModemWord and not TIOCM_RTS; - {$IFNDEF FPC} - ioctl(FHandle, TIOCMSET, @FModemWord); - {$ELSE} - fpioctl(FHandle, TIOCMSET, @FModemWord); - {$ENDIF} -{$ELSE} - if Value then - EscapeCommFunction(FHandle, SETRTS) - else - EscapeCommFunction(FHandle, CLRRTS); -{$ENDIF} -end; - -function TBlockSerial.GetCarrier: Boolean; -begin - ModemStatus; -{$IFNDEF MSWINDOWS} - Result := (FModemWord and TIOCM_CAR) > 0; -{$ELSE} - Result := (FModemWord and MS_RLSD_ON) > 0; -{$ENDIF} -end; - -function TBlockSerial.GetRing: Boolean; -begin - ModemStatus; -{$IFNDEF MSWINDOWS} - Result := (FModemWord and TIOCM_RNG) > 0; -{$ELSE} - Result := (FModemWord and MS_RING_ON) > 0; -{$ENDIF} -end; - -{$IFDEF MSWINDOWS} -function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean; -var - ex: DWord; - y: Integer; - Overlapped: TOverlapped; -begin - FillChar(Overlapped, Sizeof(Overlapped), 0); - Overlapped.hEvent := CreateEvent(nil, True, False, nil); - try - SetCommMask(FHandle, Event); - SetSynaError(sOK); - if (Event = EV_RXCHAR) and (Waitingdata > 0) then - Result := True - else - begin - y := 0; - if not WaitCommEvent(FHandle, ex, @Overlapped) then - y := GetLastError; - if y = ERROR_IO_PENDING then - begin - //timedout - WaitForSingleObject(Overlapped.hEvent, Timeout); - SetCommMask(FHandle, 0); - GetOverlappedResult(FHandle, Overlapped, DWord(y), True); - end; - Result := (ex and Event) = Event; - end; - finally - SetCommMask(FHandle, 0); - CloseHandle(Overlapped.hEvent); - end; -end; -{$ENDIF} - -{$IFNDEF MSWINDOWS} -function TBlockSerial.CanRead(Timeout: integer): boolean; -var - FDSet: TFDSet; - TimeVal: PTimeVal; - TimeV: TTimeVal; - x: Integer; -begin - TimeV.tv_usec := (Timeout mod 1000) * 1000; - TimeV.tv_sec := Timeout div 1000; - TimeVal := @TimeV; - if Timeout = -1 then - TimeVal := nil; - {$IFNDEF FPC} - FD_ZERO(FDSet); - FD_SET(FHandle, FDSet); - x := Select(FHandle + 1, @FDSet, nil, nil, TimeVal); - {$ELSE} - fpFD_ZERO(FDSet); - fpFD_SET(FHandle, FDSet); - x := fpSelect(FHandle + 1, @FDSet, nil, nil, TimeVal); - {$ENDIF} - SerialCheck(x); - if FLastError <> sOK then - x := 0; - Result := x > 0; - ExceptCheck; - if Result then - DoStatus(HR_CanRead, ''); -end; -{$ELSE} -function TBlockSerial.CanRead(Timeout: integer): boolean; -begin - Result := WaitingData > 0; - if not Result then - Result := CanEvent(EV_RXCHAR, Timeout) or (WaitingData > 0); - //check WaitingData again due some broken virtual ports - if Result then - DoStatus(HR_CanRead, ''); -end; -{$ENDIF} - -{$IFNDEF MSWINDOWS} -function TBlockSerial.CanWrite(Timeout: integer): boolean; -var - FDSet: TFDSet; - TimeVal: PTimeVal; - TimeV: TTimeVal; - x: Integer; -begin - TimeV.tv_usec := (Timeout mod 1000) * 1000; - TimeV.tv_sec := Timeout div 1000; - TimeVal := @TimeV; - if Timeout = -1 then - TimeVal := nil; - {$IFNDEF FPC} - FD_ZERO(FDSet); - FD_SET(FHandle, FDSet); - x := Select(FHandle + 1, nil, @FDSet, nil, TimeVal); - {$ELSE} - fpFD_ZERO(FDSet); - fpFD_SET(FHandle, FDSet); - x := fpSelect(FHandle + 1, nil, @FDSet, nil, TimeVal); - {$ENDIF} - SerialCheck(x); - if FLastError <> sOK then - x := 0; - Result := x > 0; - ExceptCheck; - if Result then - DoStatus(HR_CanWrite, ''); -end; -{$ELSE} -function TBlockSerial.CanWrite(Timeout: integer): boolean; -var - t: LongWord; -begin - Result := SendingData = 0; - if not Result then - Result := CanEvent(EV_TXEMPTY, Timeout); - {$IFDEF WIN32} - if Result and (Win32Platform <> VER_PLATFORM_WIN32_NT) then - begin - t := GetTick; - while not ReadTxEmpty(FPortAddr) do - begin - if TickDelta(t, GetTick) > 255 then - Break; - Sleep(0); - end; - end; - {$ENDIF} - if Result then - DoStatus(HR_CanWrite, ''); -end; -{$ENDIF} - -function TBlockSerial.CanReadEx(Timeout: integer): boolean; -begin - if Fbuffer <> '' then - Result := True - else - Result := CanRead(Timeout); -end; - -procedure TBlockSerial.EnableRTSToggle(Value: boolean); -begin - SetSynaError(sOK); -{$IFNDEF MSWINDOWS} - FRTSToggle := Value; - if Value then - RTS:=False; -{$ELSE} - if Win32Platform = VER_PLATFORM_WIN32_NT then - begin - GetCommState; - if value then - dcb.Flags := dcb.Flags or dcb_RtsControlToggle - else - dcb.flags := dcb.flags and (not dcb_RtsControlToggle); - SetCommState; - end - else - begin - FRTSToggle := Value; - if Value then - RTS:=False; - end; -{$ENDIF} -end; - -procedure TBlockSerial.Flush; -begin -{$IFNDEF MSWINDOWS} - SerialCheck(tcdrain(FHandle)); -{$ELSE} - SetSynaError(sOK); - if not Flushfilebuffers(FHandle) then - SerialCheck(sErr); -{$ENDIF} - ExceptCheck; -end; - -{$IFNDEF MSWINDOWS} -procedure TBlockSerial.Purge; -begin - {$IFNDEF FPC} - SerialCheck(ioctl(FHandle, TCFLSH, TCIOFLUSH)); - {$ELSE} - {$IFDEF DARWIN} - SerialCheck(fpioctl(FHandle, TCIOflush, Pointer(TCIOFLUSH))); - {$ELSE} - SerialCheck(fpioctl(FHandle, {$IFDEF FreeBSD}TCIOFLUSH{$ELSE}TCFLSH{$ENDIF}, Pointer(PtrInt(TCIOFLUSH)))); - {$ENDIF} - {$ENDIF} - FBuffer := ''; - ExceptCheck; -end; -{$ELSE} -procedure TBlockSerial.Purge; -var - x: integer; -begin - SetSynaError(sOK); - x := PURGE_TXABORT or PURGE_TXCLEAR or PURGE_RXABORT or PURGE_RXCLEAR; - if not PurgeComm(FHandle, x) then - SerialCheck(sErr); - FBuffer := ''; - ExceptCheck; -end; -{$ENDIF} - -function TBlockSerial.ModemStatus: integer; -begin - Result := 0; -{$IFNDEF MSWINDOWS} - {$IFNDEF FPC} - SerialCheck(ioctl(FHandle, TIOCMGET, @Result)); - {$ELSE} - SerialCheck(fpioctl(FHandle, TIOCMGET, @Result)); - {$ENDIF} -{$ELSE} - SetSynaError(sOK); - if not GetCommModemStatus(FHandle, dword(Result)) then - SerialCheck(sErr); -{$ENDIF} - ExceptCheck; - FModemWord := Result; -end; - -procedure TBlockSerial.SetBreak(Duration: integer); -begin -{$IFNDEF MSWINDOWS} - SerialCheck(tcsendbreak(FHandle, Duration)); -{$ELSE} - SetCommBreak(FHandle); - Sleep(Duration); - SetSynaError(sOK); - if not ClearCommBreak(FHandle) then - SerialCheck(sErr); -{$ENDIF} -end; - -{$IFDEF MSWINDOWS} -procedure TBlockSerial.DecodeCommError(Error: DWord); -begin - if (Error and DWord(CE_FRAME)) > 1 then - FLastError := ErrFrame; - if (Error and DWord(CE_OVERRUN)) > 1 then - FLastError := ErrOverrun; - if (Error and DWord(CE_RXOVER)) > 1 then - FLastError := ErrRxOver; - if (Error and DWord(CE_RXPARITY)) > 1 then - FLastError := ErrRxParity; - if (Error and DWord(CE_TXFULL)) > 1 then - FLastError := ErrTxFull; -end; -{$ENDIF} - -//HGJ -function TBlockSerial.PreTestFailing: Boolean; -begin - if not FInstanceActive then - begin - RaiseSynaError(ErrPortNotOpen); - result:= true; - Exit; - end; - Result := not TestCtrlLine; - if result then - RaiseSynaError(ErrNoDeviceAnswer) -end; - -function TBlockSerial.TestCtrlLine: Boolean; -begin - result := ((not FTestDSR) or DSR) and ((not FTestCTS) or CTS); -end; - -function TBlockSerial.ATCommand(value: AnsiString): AnsiString; -var - s: AnsiString; - ConvSave: Boolean; -begin - result := ''; - FAtResult := False; - ConvSave := FConvertLineEnd; - try - FConvertLineEnd := True; - SendString(value + #$0D); - repeat - s := RecvString(FAtTimeout); - if s <> Value then - result := result + s + CRLF; - if s = 'OK' then - begin - FAtResult := True; - break; - end; - if s = 'ERROR' then - break; - until FLastError <> sOK; - finally - FConvertLineEnd := Convsave; - end; -end; - - -function TBlockSerial.ATConnect(value: AnsiString): AnsiString; -var - s: AnsiString; - ConvSave: Boolean; -begin - result := ''; - FAtResult := False; - ConvSave := FConvertLineEnd; - try - FConvertLineEnd := True; - SendString(value + #$0D); - repeat - s := RecvString(90 * FAtTimeout); - if s <> Value then - result := result + s + CRLF; - if s = 'NO CARRIER' then - break; - if s = 'ERROR' then - break; - if s = 'BUSY' then - break; - if s = 'NO DIALTONE' then - break; - if Pos('CONNECT', s) = 1 then - begin - FAtResult := True; - break; - end; - until FLastError <> sOK; - finally - FConvertLineEnd := Convsave; - end; -end; - -function TBlockSerial.SerialCheck(SerialResult: integer): integer; -begin - if SerialResult = integer(INVALID_HANDLE_VALUE) then -{$IFDEF MSWINDOWS} - result := GetLastError -{$ELSE} - {$IFNDEF FPC} - result := GetLastError - {$ELSE} - result := fpGetErrno - {$ENDIF} -{$ENDIF} - else - result := sOK; - FLastError := result; - FLastErrorDesc := GetErrorDesc(FLastError); -end; - -procedure TBlockSerial.ExceptCheck; -var - e: ESynaSerError; - s: string; -begin - if FRaiseExcept and (FLastError <> sOK) then - begin - s := GetErrorDesc(FLastError); - e := ESynaSerError.CreateFmt('Communication error %d: %s', [FLastError, s]); - e.ErrorCode := FLastError; - e.ErrorMessage := s; - raise e; - end; -end; - -procedure TBlockSerial.SetSynaError(ErrNumber: integer); -begin - FLastError := ErrNumber; - FLastErrorDesc := GetErrorDesc(FLastError); -end; - -procedure TBlockSerial.RaiseSynaError(ErrNumber: integer); -begin - SetSynaError(ErrNumber); - ExceptCheck; -end; - -procedure TBlockSerial.DoStatus(Reason: THookSerialReason; const Value: string); -begin - if assigned(OnStatus) then - OnStatus(Self, Reason, Value); -end; - -{======================================================================} - -class function TBlockSerial.GetErrorDesc(ErrorCode: integer): string; -begin - Result:= ''; - case ErrorCode of - sOK: Result := 'OK'; - ErrAlreadyOwned: Result := 'Port owned by other process';{HGJ} - ErrAlreadyInUse: Result := 'Instance already in use'; {HGJ} - ErrWrongParameter: Result := 'Wrong parameter at call'; {HGJ} - ErrPortNotOpen: Result := 'Instance not yet connected'; {HGJ} - ErrNoDeviceAnswer: Result := 'No device answer detected'; {HGJ} - ErrMaxBuffer: Result := 'Maximal buffer length exceeded'; - ErrTimeout: Result := 'Timeout during operation'; - ErrNotRead: Result := 'Reading of data failed'; - ErrFrame: Result := 'Receive framing error'; - ErrOverrun: Result := 'Receive Overrun Error'; - ErrRxOver: Result := 'Receive Queue overflow'; - ErrRxParity: Result := 'Receive Parity Error'; - ErrTxFull: Result := 'Tranceive Queue is full'; - end; - if Result = '' then - begin - Result := SysErrorMessage(ErrorCode); - end; -end; - - -{---------- cpom Comport Ownership Manager Routines ------------- - by Hans-Georg Joepgen of Stuttgart, Germany. - Copyright (c) 2002, by Hans-Georg Joepgen - - Stefan Krauss of Stuttgart, Germany, contributed literature and Internet - research results, invaluable advice and excellent answers to the Comport - Ownership Manager. -} - -{$IFDEF UNIX} - -function TBlockSerial.LockfileName: String; -var - s: string; -begin - s := SeparateRight(FDevice, '/dev/'); - result := LockfileDirectory + '/LCK..' + s; -end; - -procedure TBlockSerial.CreateLockfile(PidNr: integer); -var - f: TextFile; - s: string; -begin - // Create content for file - s := IntToStr(PidNr); - while length(s) < 10 do - s := ' ' + s; - // Create file - try - AssignFile(f, LockfileName); - try - Rewrite(f); - writeln(f, s); - finally - CloseFile(f); - end; - // Allow all users to enjoy the benefits of cpom - s := 'chmod a+rw ' + LockfileName; -{$IFNDEF FPC} - FileSetReadOnly( LockfileName, False ) ; - // Libc.system(pchar(s)); -{$ELSE} - fpSystem(s); -{$ENDIF} - except - // not raise exception, if you not have write permission for lock. - on Exception do - ; - end; -end; - -function TBlockSerial.ReadLockfile: integer; -{Returns PID from Lockfile. Lockfile must exist.} -var - f: TextFile; - s: string; -begin - AssignFile(f, LockfileName); - Reset(f); - try - readln(f, s); - finally - CloseFile(f); - end; - Result := StrToIntDef(s, -1) -end; - -function TBlockSerial.cpomComportAccessible: boolean; -var - MyPid: integer; - Filename: string; -begin - Filename := LockfileName; - {$IFNDEF FPC} - MyPid := Libc.getpid; - {$ELSE} - MyPid := fpGetPid; - {$ENDIF} - // Make sure, the Lock Files Directory exists. We need it. - if not DirectoryExists(LockfileDirectory) then - CreateDir(LockfileDirectory); - // Check the Lockfile - if not FileExists (Filename) then - begin // comport is not locked. Lock it for us. - CreateLockfile(MyPid); - result := true; - exit; // done. - end; - // Is port owned by orphan? Then it's time for error recovery. - //FPC forgot to add getsid.. :-( - {$IFNDEF FPC} - if Libc.getsid(ReadLockfile) = -1 then - begin // Lockfile was left from former desaster - DeleteFile(Filename); // error recovery - CreateLockfile(MyPid); - result := true; - exit; - end; - {$ENDIF} - result := false // Sorry, port is owned by living PID and locked -end; - -procedure TBlockSerial.cpomReleaseComport; -begin - DeleteFile(LockfileName); -end; - -{$ENDIF} -{----------------------------------------------------------------} - -{$IFDEF MSWINDOWS} -function GetSerialPortNames: string; -var - reg: TRegistry; - l, v: TStringList; - n: integer; -begin - l := TStringList.Create; - v := TStringList.Create; - reg := TRegistry.Create; - try -{$IFNDEF VER100} -{$IFNDEF VER120} - reg.Access := KEY_READ; -{$ENDIF} -{$ENDIF} - reg.RootKey := HKEY_LOCAL_MACHINE; - reg.OpenKey('\HARDWARE\DEVICEMAP\SERIALCOMM', false); - reg.GetValueNames(l); - for n := 0 to l.Count - 1 do - v.Add(reg.ReadString(l[n])); - Result := v.CommaText; - finally - reg.Free; - l.Free; - v.Free; - end; -end; -{$ENDIF} -{$IFNDEF MSWINDOWS} -function GetSerialPortNames: string; -var - sr : TSearchRec; -begin - Result := ''; - if FindFirst('/dev/ttyS*', $FFFFFFFF, sr) = 0 then - begin - repeat - if (sr.Attr and $FFFFFFFF) = Sr.Attr then - begin - if Result <> '' then - Result := Result + ','; - Result := Result + sr.Name; - end; - until FindNext(sr) <> 0; - end; - FindClose(sr); -end; -{$ENDIF} - -end. \ No newline at end of file diff --git a/3rd/synapse/source/synautil.pas b/3rd/synapse/source/synautil.pas deleted file mode 100644 index e421840cc..000000000 --- a/3rd/synapse/source/synautil.pas +++ /dev/null @@ -1,2124 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 004.015.006 | -|==============================================================================| -| Content: support procedures and functions | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c) 1999-2013. | -| Portions created by Hernan Sanchez are Copyright (c) 2000. | -| Portions created by Petr Fejfar are Copyright (c)2011-2012. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Hernan Sanchez (hernan.sanchez@iname.com) | -| Tomas Hajny (OS2 support) | -| Radek Cervinka (POSIX support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Support procedures and functions)} - -{$I jedi.inc} // load common compiler defines - -{$Q-} -{$R-} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} - {$WARN SUSPICIOUS_TYPECAST OFF} -{$ENDIF} - -unit synautil; - -interface - -uses -{$IFDEF MSWINDOWS} - Windows, -{$ELSE MSWINDOWS} - {$IFDEF FPC} - {$IFDEF OS2} - Dos, TZUtil, - {$ELSE OS2} - UnixUtil, Unix, BaseUnix, - {$ENDIF OS2} - {$ELSE FPC} - {$IFDEF POSIX} - Posix.Base, Posix.Time, Posix.SysTypes, Posix.SysTime, Posix.Stdio, - {$ELSE} - Libc, - {$ENDIF} - {$ENDIF} -{$ENDIF} -{$IFDEF CIL} - System.IO, -{$ENDIF} - SysUtils, Classes, SynaFpc; - -{$IFDEF VER100} -type - int64 = integer; -{$ENDIF} -{$IFDEF POSIX} -type - TTimeVal = Posix.SysTime.timeval; - Ttimezone = record - tz_minuteswest: Integer ; // minutes west of Greenwich - tz_dsttime: integer ; // type of DST correction - end; - - PTimeZone = ^Ttimezone; -{$ENDIF} - - -{:Return your timezone bias from UTC time in minutes.} -function TimeZoneBias: integer; - -{:Return your timezone bias from UTC time in string representation like "+0200".} -function TimeZone: string; - -{:Returns current time in format defined in RFC-822. Useful for SMTP messages, - but other protocols use this time format as well. Results contains the timezone - specification. Four digit year is used to break any Y2K concerns. (Example - 'Fri, 15 Oct 1999 21:14:56 +0200')} -function Rfc822DateTime(t: TDateTime): string; - -{:Returns date and time in format defined in C compilers in format "mmm dd hh:nn:ss"} -function CDateTime(t: TDateTime): string; - -{:Returns date and time in format defined in format 'yymmdd hhnnss'} -function SimpleDateTime(t: TDateTime): string; - -{:Returns date and time in format defined in ANSI C compilers in format - "ddd mmm d hh:nn:ss yyyy" } -function AnsiCDateTime(t: TDateTime): string; - -{:Decode three-letter string with name of month to their month number. If string - not match any month name, then is returned 0. For parsing are used predefined - names for English, French and German and names from system locale too.} -function GetMonthNumber(Value: String): integer; - -{:Return decoded time from given string. Time must be witch separator ':'. You - can use "hh:mm" or "hh:mm:ss".} -function GetTimeFromStr(Value: string): TDateTime; - -{:Decode string representation of TimeZone (CEST, GMT, +0200, -0800, etc.) - to timezone offset.} -function DecodeTimeZone(Value: string; var Zone: integer): Boolean; - -{:Decode string in format "m-d-y" to TDateTime type.} -function GetDateMDYFromStr(Value: string): TDateTime; - -{:Decode various string representations of date and time to Tdatetime type. - This function do all timezone corrections too! This function can decode lot of - formats like: - @longcode(# - ddd, d mmm yyyy hh:mm:ss - ddd, d mmm yy hh:mm:ss - ddd, mmm d yyyy hh:mm:ss - ddd mmm dd hh:mm:ss yyyy #) - -and more with lot of modifications, include: -@longcode(# -Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123 -Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036 -Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() Format -#) -Timezone corrections known lot of symbolic timezone names (like CEST, EDT, etc.) -or numeric representation (like +0200). By convention defined in RFC timezone - +0000 is GMT and -0000 is current your system timezone.} -function DecodeRfcDateTime(Value: string): TDateTime; - -{:Return current system date and time in UTC timezone.} -function GetUTTime: TDateTime; - -{:Set Newdt as current system date and time in UTC timezone. This function work - only if you have administrator rights!} -function SetUTTime(Newdt: TDateTime): Boolean; - -{:Return current value of system timer with precizion 1 millisecond. Good for - measure time difference.} -function GetTick: LongWord; - -{:Return difference between two timestamps. It working fine only for differences - smaller then maxint. (difference must be smaller then 24 days.)} -function TickDelta(TickOld, TickNew: LongWord): LongWord; - -{:Return two characters, which ordinal values represents the value in byte - format. (High-endian)} -function CodeInt(Value: Word): Ansistring; - -{:Decodes two characters located at "Index" offset position of the "Value" - string to Word values.} -function DecodeInt(const Value: Ansistring; Index: Integer): Word; - -{:Return four characters, which ordinal values represents the value in byte - format. (High-endian)} -function CodeLongInt(Value: LongInt): Ansistring; - -{:Decodes four characters located at "Index" offset position of the "Value" - string to LongInt values.} -function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt; - -{:Dump binary buffer stored in a string to a result string.} -function DumpStr(const Buffer: Ansistring): string; - -{:Dump binary buffer stored in a string to a result string. All bytes with code - of character is written as character, not as hexadecimal value.} -function DumpExStr(const Buffer: Ansistring): string; - -{:Dump binary buffer stored in a string to a file with DumpFile filename.} -procedure Dump(const Buffer: AnsiString; DumpFile: string); - -{:Dump binary buffer stored in a string to a file with DumpFile filename. All - bytes with code of character is written as character, not as hexadecimal value.} -procedure DumpEx(const Buffer: AnsiString; DumpFile: string); - -{:Like TrimLeft, but remove only spaces, not control characters!} -function TrimSPLeft(const S: string): string; - -{:Like TrimRight, but remove only spaces, not control characters!} -function TrimSPRight(const S: string): string; - -{:Like Trim, but remove only spaces, not control characters!} -function TrimSP(const S: string): string; - -{:Returns a portion of the "Value" string located to the left of the "Delimiter" - string. If a delimiter is not found, results is original string.} -function SeparateLeft(const Value, Delimiter: string): string; - -{:Returns the portion of the "Value" string located to the right of the - "Delimiter" string. If a delimiter is not found, results is original string.} -function SeparateRight(const Value, Delimiter: string): string; - -{:Returns parameter value from string in format: - parameter1="value1"; parameter2=value2} -function GetParameter(const Value, Parameter: string): string; - -{:parse value string with elements differed by Delimiter into stringlist.} -procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings); - -{:parse value string with elements differed by ';' into stringlist.} -procedure ParseParameters(Value: string; const Parameters: TStrings); - -{:Index of string in stringlist with same beginning as Value is returned.} -function IndexByBegin(Value: string; const List: TStrings): integer; - -{:Returns only the e-mail portion of an address from the full address format. - i.e. returns 'nobody@@somewhere.com' from '"someone" '} -function GetEmailAddr(const Value: string): string; - -{:Returns only the description part from a full address format. i.e. returns - 'someone' from '"someone" '} -function GetEmailDesc(Value: string): string; - -{:Returns a string with hexadecimal digits representing the corresponding values - of the bytes found in "Value" string.} -function StrToHex(const Value: Ansistring): string; - -{:Returns a string of binary "Digits" representing "Value".} -function IntToBin(Value: Integer; Digits: Byte): string; - -{:Returns an integer equivalent of the binary string in "Value". - (i.e. ('10001010') returns 138)} -function BinToInt(const Value: string): Integer; - -{:Parses a URL to its various components.} -function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path, - Para: string): string; - -{:Replaces all "Search" string values found within "Value" string, with the - "Replace" string value.} -function ReplaceString(Value, Search, Replace: AnsiString): AnsiString; - -{:It is like RPos, but search is from specified possition.} -function RPosEx(const Sub, Value: string; From: integer): Integer; - -{:It is like POS function, but from right side of Value string.} -function RPos(const Sub, Value: String): Integer; - -{:Like @link(fetch), but working with binary strings, not with text.} -function FetchBin(var Value: string; const Delimiter: string): string; - -{:Fetch string from left of Value string.} -function Fetch(var Value: string; const Delimiter: string): string; - -{:Fetch string from left of Value string. This function ignore delimitesr inside - quotations.} -function FetchEx(var Value: string; const Delimiter, Quotation: string): string; - -{:If string is binary string (contains non-printable characters), then is - returned true.} -function IsBinaryString(const Value: AnsiString): Boolean; - -{:return position of string terminator in string. If terminator found, then is - returned in terminator parameter. - Possible line terminators are: CRLF, LFCR, CR, LF} -function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer; - -{:Delete empty strings from end of stringlist.} -Procedure StringsTrim(const value: TStrings); - -{:Like Pos function, buf from given string possition.} -function PosFrom(const SubStr, Value: String; From: integer): integer; - -{$IFNDEF CIL} -{:Increase pointer by value.} -function IncPoint(const p: pointer; Value: integer): pointer; -{$ENDIF} - -{:Get string between PairBegin and PairEnd. This function respect nesting. - For example: - @longcode(# - Value is: 'Hi! (hello(yes!))' - pairbegin is: '(' - pairend is: ')' - In this case result is: 'hello(yes!)'#)} -function GetBetween(const PairBegin, PairEnd, Value: string): string; - -{:Return count of Chr in Value string.} -function CountOfChar(const Value: string; Chr: char): integer; - -{:Remove quotation from Value string. If Value is not quoted, then return same - string without any modification. } -function UnquoteStr(const Value: string; Quote: Char): string; - -{:Quote Value string. If Value contains some Quote chars, then it is doubled.} -function QuoteStr(const Value: string; Quote: Char): string; - -{:Convert lines in stringlist from 'name: value' form to 'name=value' form.} -procedure HeadersToList(const Value: TStrings); - -{:Convert lines in stringlist from 'name=value' form to 'name: value' form.} -procedure ListToHeaders(const Value: TStrings); - -{:swap bytes in integer.} -function SwapBytes(Value: integer): integer; - -{:read string with requested length form stream.} -function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString; - -{:write string to stream.} -procedure WriteStrToStream(const Stream: TStream; Value: AnsiString); - -{:Return filename of new temporary file in Dir (if empty, then default temporary - directory is used) and with optional filename prefix.} -function GetTempFile(const Dir, prefix: String): String; - -{:Return padded string. If length is greater, string is truncated. If length is - smaller, string is padded by Pad character.} -function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString; - -{:XOR each byte in the strings} -function XorString(Indata1, Indata2: AnsiString): AnsiString; - -{:Read header from "Value" stringlist beginning at "Index" position. If header - is Splitted into multiple lines, then this procedure de-split it into one line.} -function NormalizeHeader(Value: TStrings; var Index: Integer): string; - -{pf} -{:Search for one of line terminators CR, LF or NUL. Return position of the - line beginning and length of text.} -procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer); -{:Skip both line terminators CR LF (if any). Move APtr position forward.} -procedure SkipLineBreak(var APtr:PANSIChar; AEtx:PANSIChar); -{:Skip all blank lines in a buffer starting at APtr and move APtr position forward.} -procedure SkipNullLines (var APtr:PANSIChar; AEtx:PANSIChar); -{:Copy all lines from a buffer starting at APtr to ALines until empty line - or end of the buffer is reached. Move APtr position forward).} -procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings); -{:Copy all lines from a buffer starting at APtr to ALines until ABoundary - or end of the buffer is reached. Move APtr position forward).} -procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString); -{:Search ABoundary in a buffer starting at APtr. - Return beginning of the ABoundary. Move APtr forward behind a trailing CRLF if any).} -function SearchForBoundary (var APtr:PANSIChar; AEtx:PANSIChar; const ABoundary:ANSIString): PANSIChar; -{:Compare a text at position ABOL with ABoundary and return position behind the - match (including a trailing CRLF if any).} -function MatchBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar; -{:Compare a text at position ABOL with ABoundary + the last boundary suffix - and return position behind the match (including a trailing CRLF if any).} -function MatchLastBoundary (ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar; -{:Copy data from a buffer starting at position APtr and delimited by AEtx - position into ANSIString.} -function BuildStringFromBuffer (AStx,AEtx:PANSIChar): ANSIString; -{/pf} - -var - {:can be used for your own months strings for @link(getmonthnumber)} - CustomMonthNames: array[1..12] of string; - -implementation - -{==============================================================================} - -const - MyDayNames: array[1..7] of AnsiString = - ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); -var - MyMonthNames: array[0..6, 1..12] of String = - ( - ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', //rewrited by system locales - 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'), - ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', //English - 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'), - ('jan', 'f�v', 'mar', 'avr', 'mai', 'jun', //French - 'jul', 'ao�', 'sep', 'oct', 'nov', 'd�c'), - ('jan', 'fev', 'mar', 'avr', 'mai', 'jun', //French#2 - 'jul', 'aou', 'sep', 'oct', 'nov', 'dec'), - ('Jan', 'Feb', 'Mar', 'Apr', 'Mai', 'Jun', //German - 'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'), - ('Jan', 'Feb', 'M�r', 'Apr', 'Mai', 'Jun', //German#2 - 'Jul', 'Aug', 'Sep', 'Okt', 'Nov', 'Dez'), - ('Led', '�no', 'B�e', 'Dub', 'Kv�', '�en', //Czech - '�ec', 'Srp', 'Z��', '��j', 'Lis', 'Pro') - ); - - -{==============================================================================} - -function TimeZoneBias: integer; -{$IFNDEF MSWINDOWS} -{$IFNDEF FPC} -var -{$IFDEF POSIX} - t: Posix.SysTypes.time_t; - UT: Posix.time.tm; -{$ELSE} - t: TTime_T; - UT: TUnixTime; -{$ENDIF} -begin - {$IFDEF POSIX} - __time(T); - localtime_r(T, UT); - Result := UT.tm_gmtoff div 60; - {$ELSE} - __time(@T); - localtime_r(@T, UT); - Result := ut.__tm_gmtoff div 60; - {$ENDIF} -{$ELSE} -begin - Result := TZSeconds div 60; -{$ENDIF} -{$ELSE} -var - zoneinfo: TTimeZoneInformation; - bias: Integer; -begin - case GetTimeZoneInformation(Zoneinfo) of - 2: - bias := zoneinfo.Bias + zoneinfo.DaylightBias; - 1: - bias := zoneinfo.Bias + zoneinfo.StandardBias; - else - bias := zoneinfo.Bias; - end; - Result := bias * (-1); -{$ENDIF} -end; - -{==============================================================================} - -function TimeZone: string; -var - bias: Integer; - h, m: Integer; -begin - bias := TimeZoneBias; - if bias >= 0 then - Result := '+' - else - Result := '-'; - bias := Abs(bias); - h := bias div 60; - m := bias mod 60; - Result := Result + Format('%.2d%.2d', [h, m]); -end; - -{==============================================================================} - -function Rfc822DateTime(t: TDateTime): string; -var - wYear, wMonth, wDay: word; -begin - DecodeDate(t, wYear, wMonth, wDay); - Result := Format('%s, %d %s %s %s', [MyDayNames[DayOfWeek(t)], wDay, - MyMonthNames[1, wMonth], FormatDateTime('yyyy hh":"nn":"ss', t), TimeZone]); -end; - -{==============================================================================} - -function CDateTime(t: TDateTime): string; -var - wYear, wMonth, wDay: word; -begin - DecodeDate(t, wYear, wMonth, wDay); - Result:= Format('%s %2d %s', [MyMonthNames[1, wMonth], wDay, - FormatDateTime('hh":"nn":"ss', t)]); -end; - -{==============================================================================} - -function SimpleDateTime(t: TDateTime): string; -begin - Result := FormatDateTime('yymmdd hhnnss', t); -end; - -{==============================================================================} - -function AnsiCDateTime(t: TDateTime): string; -var - wYear, wMonth, wDay: word; -begin - DecodeDate(t, wYear, wMonth, wDay); - Result := Format('%s %s %d %s', [MyDayNames[DayOfWeek(t)], MyMonthNames[1, wMonth], - wDay, FormatDateTime('hh":"nn":"ss yyyy ', t)]); -end; - -{==============================================================================} - -function DecodeTimeZone(Value: string; var Zone: integer): Boolean; -var - x: integer; - zh, zm: integer; - s: string; -begin - Result := false; - s := Value; - if (Pos('+', s) = 1) or (Pos('-',s) = 1) then - begin - if s = '-0000' then - Zone := TimeZoneBias - else - if Length(s) > 4 then - begin - zh := StrToIntdef(s[2] + s[3], 0); - zm := StrToIntdef(s[4] + s[5], 0); - zone := zh * 60 + zm; - if s[1] = '-' then - zone := zone * (-1); - end; - Result := True; - end - else - begin - x := 32767; - if s = 'NZDT' then x := 13; - if s = 'IDLE' then x := 12; - if s = 'NZST' then x := 12; - if s = 'NZT' then x := 12; - if s = 'EADT' then x := 11; - if s = 'GST' then x := 10; - if s = 'JST' then x := 9; - if s = 'CCT' then x := 8; - if s = 'WADT' then x := 8; - if s = 'WAST' then x := 7; - if s = 'ZP6' then x := 6; - if s = 'ZP5' then x := 5; - if s = 'ZP4' then x := 4; - if s = 'BT' then x := 3; - if s = 'EET' then x := 2; - if s = 'MEST' then x := 2; - if s = 'MESZ' then x := 2; - if s = 'SST' then x := 2; - if s = 'FST' then x := 2; - if s = 'CEST' then x := 2; - if s = 'CET' then x := 1; - if s = 'FWT' then x := 1; - if s = 'MET' then x := 1; - if s = 'MEWT' then x := 1; - if s = 'SWT' then x := 1; - if s = 'UT' then x := 0; - if s = 'UTC' then x := 0; - if s = 'GMT' then x := 0; - if s = 'WET' then x := 0; - if s = 'WAT' then x := -1; - if s = 'BST' then x := -1; - if s = 'AT' then x := -2; - if s = 'ADT' then x := -3; - if s = 'AST' then x := -4; - if s = 'EDT' then x := -4; - if s = 'EST' then x := -5; - if s = 'CDT' then x := -5; - if s = 'CST' then x := -6; - if s = 'MDT' then x := -6; - if s = 'MST' then x := -7; - if s = 'PDT' then x := -7; - if s = 'PST' then x := -8; - if s = 'YDT' then x := -8; - if s = 'YST' then x := -9; - if s = 'HDT' then x := -9; - if s = 'AHST' then x := -10; - if s = 'CAT' then x := -10; - if s = 'HST' then x := -10; - if s = 'EAST' then x := -10; - if s = 'NT' then x := -11; - if s = 'IDLW' then x := -12; - if x <> 32767 then - begin - zone := x * 60; - Result := True; - end; - end; -end; - -{==============================================================================} - -function GetMonthNumber(Value: String): integer; -var - n: integer; - function TestMonth(Value: String; Index: Integer): Boolean; - var - n: integer; - begin - Result := False; - for n := 0 to 6 do - if Value = AnsiUppercase(MyMonthNames[n, Index]) then - begin - Result := True; - Break; - end; - end; -begin - Result := 0; - Value := AnsiUppercase(Value); - for n := 1 to 12 do - if TestMonth(Value, n) or (Value = AnsiUppercase(CustomMonthNames[n])) then - begin - Result := n; - Break; - end; -end; - -{==============================================================================} - -function GetTimeFromStr(Value: string): TDateTime; -var - x: integer; -begin - x := rpos(':', Value); - if (x > 0) and ((Length(Value) - x) > 2) then - Value := Copy(Value, 1, x + 2); - Value := ReplaceString(Value, ':', {$IFDEF COMPILER15_UP}FormatSettings.{$ENDIF}TimeSeparator); - Result := -1; - try - Result := StrToTime(Value); - except - on Exception do ; - end; -end; - -{==============================================================================} - -function GetDateMDYFromStr(Value: string): TDateTime; -var - wYear, wMonth, wDay: word; - s: string; -begin - Result := 0; - s := Fetch(Value, '-'); - wMonth := StrToIntDef(s, 12); - s := Fetch(Value, '-'); - wDay := StrToIntDef(s, 30); - wYear := StrToIntDef(Value, 1899); - if wYear < 1000 then - if (wYear > 99) then - wYear := wYear + 1900 - else - if wYear > 50 then - wYear := wYear + 1900 - else - wYear := wYear + 2000; - try - Result := EncodeDate(wYear, wMonth, wDay); - except - on Exception do ; - end; -end; - -{==============================================================================} - -function DecodeRfcDateTime(Value: string): TDateTime; -var - day, month, year: Word; - zone: integer; - x, y: integer; - s: string; - t: TDateTime; -begin -// ddd, d mmm yyyy hh:mm:ss -// ddd, d mmm yy hh:mm:ss -// ddd, mmm d yyyy hh:mm:ss -// ddd mmm dd hh:mm:ss yyyy -// Sun, 06 Nov 1994 08:49:37 GMT ; RFC 822, updated by RFC 1123 -// Sunday, 06-Nov-94 08:49:37 GMT ; RFC 850, obsoleted by RFC 1036 -// Sun Nov 6 08:49:37 1994 ; ANSI C's asctime() Format - - Result := 0; - if Value = '' then - Exit; - day := 0; - month := 0; - year := 0; - zone := 0; - Value := ReplaceString(Value, ' -', ' #'); - Value := ReplaceString(Value, '-', ' '); - Value := ReplaceString(Value, ' #', ' -'); - while Value <> '' do - begin - s := Fetch(Value, ' '); - s := uppercase(s); - // timezone - if DecodetimeZone(s, x) then - begin - zone := x; - continue; - end; - x := StrToIntDef(s, 0); - // day or year - if x > 0 then - if (x < 32) and (day = 0) then - begin - day := x; - continue; - end - else - begin - if (year = 0) and ((month > 0) or (x > 12)) then - begin - year := x; - if year < 32 then - year := year + 2000; - if year < 1000 then - year := year + 1900; - continue; - end; - end; - // time - if rpos(':', s) > Pos(':', s) then - begin - t := GetTimeFromStr(s); - if t <> -1 then - Result := t; - continue; - end; - //timezone daylight saving time - if s = 'DST' then - begin - zone := zone + 60; - continue; - end; - // month - y := GetMonthNumber(s); - if (y > 0) and (month = 0) then - month := y; - end; - if year = 0 then - year := 1980; - if month < 1 then - month := 1; - if month > 12 then - month := 12; - if day < 1 then - day := 1; - x := MonthDays[IsLeapYear(year), month]; - if day > x then - day := x; - Result := Result + Encodedate(year, month, day); - zone := zone - TimeZoneBias; - x := zone div 1440; - Result := Result - x; - zone := zone mod 1440; - t := EncodeTime(Abs(zone) div 60, Abs(zone) mod 60, 0, 0); - if zone < 0 then - t := 0 - t; - Result := Result - t; -end; - -{==============================================================================} - -function GetUTTime: TDateTime; -{$IFDEF MSWINDOWS} -{$IFNDEF FPC} -var - st: TSystemTime; -begin - GetSystemTime(st); - result := SystemTimeToDateTime(st); -{$ELSE} -var - st: SysUtils.TSystemTime; - stw: Windows.TSystemTime; -begin - GetSystemTime(stw); - st.Year := stw.wYear; - st.Month := stw.wMonth; - st.Day := stw.wDay; - st.Hour := stw.wHour; - st.Minute := stw.wMinute; - st.Second := stw.wSecond; - st.Millisecond := stw.wMilliseconds; - result := SystemTimeToDateTime(st); -{$ENDIF} -{$ELSE MSWINDOWS} -{$IFNDEF FPC} -var - TV: TTimeVal; -begin - gettimeofday(TV, nil); - Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400; -{$ELSE FPC} - {$IFDEF UNIX} -var - TV: TimeVal; -begin - fpgettimeofday(@TV, nil); - Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400; - {$ELSE UNIX} - {$IFDEF OS2} -var - ST: TSystemTime; -begin - GetLocalTime (ST); - Result := SystemTimeToDateTime (ST); - {$ENDIF OS2} - {$ENDIF UNIX} -{$ENDIF FPC} -{$ENDIF MSWINDOWS} -end; - -{==============================================================================} - -function SetUTTime(Newdt: TDateTime): Boolean; -{$IFDEF MSWINDOWS} -{$IFNDEF FPC} -var - st: TSystemTime; -begin - DateTimeToSystemTime(newdt,st); - Result := SetSystemTime(st); -{$ELSE} -var - st: SysUtils.TSystemTime; - stw: Windows.TSystemTime; -begin - DateTimeToSystemTime(newdt,st); - stw.wYear := st.Year; - stw.wMonth := st.Month; - stw.wDay := st.Day; - stw.wHour := st.Hour; - stw.wMinute := st.Minute; - stw.wSecond := st.Second; - stw.wMilliseconds := st.Millisecond; - Result := SetSystemTime(stw); -{$ENDIF} -{$ELSE MSWINDOWS} -{$IFNDEF FPC} -var - TV: TTimeVal; - d: double; - TZ: Ttimezone; - PZ: PTimeZone; -begin - TZ.tz_minuteswest := 0; - TZ.tz_dsttime := 0; - PZ := @TZ; - gettimeofday(TV, PZ); - d := (newdt - UnixDateDelta) * 86400; - TV.tv_sec := trunc(d); - TV.tv_usec := trunc(frac(d) * 1000000); - {$IFNDEF POSIX} - Result := settimeofday(TV, TZ) <> -1; - {$ELSE} - Result := False; // in POSIX settimeofday is not defined? http://www.kernel.org/doc/man-pages/online/pages/man2/gettimeofday.2.html - {$ENDIF} -{$ELSE FPC} - {$IFDEF UNIX} -var - TV: TimeVal; - d: double; -begin - d := (newdt - UnixDateDelta) * 86400; - TV.tv_sec := trunc(d); - TV.tv_usec := trunc(frac(d) * 1000000); - Result := fpsettimeofday(@TV, nil) <> -1; - {$ELSE UNIX} - {$IFDEF OS2} -var - ST: TSystemTime; -begin - DateTimeToSystemTime (NewDT, ST); - SetTime (ST.Hour, ST.Minute, ST.Second, ST.Millisecond div 10); - Result := true; - {$ENDIF OS2} - {$ENDIF UNIX} -{$ENDIF FPC} -{$ENDIF MSWINDOWS} -end; - -{==============================================================================} - -{$IFNDEF MSWINDOWS} -function GetTick: LongWord; -var - Stamp: TTimeStamp; -begin - Stamp := DateTimeToTimeStamp(Now); - Result := Stamp.Time; -end; -{$ELSE} -function GetTick: LongWord; -var - tick, freq: TLargeInteger; -{$IFDEF VER100} - x: TLargeInteger; -{$ENDIF} -begin - if Windows.QueryPerformanceFrequency(freq) then - begin - Windows.QueryPerformanceCounter(tick); -{$IFDEF VER100} - x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000; - Result := x.LowPart; -{$ELSE} - Result := Trunc((tick / freq) * 1000) and High(LongWord) -{$ENDIF} - end - else - Result := Windows.GetTickCount; -end; -{$ENDIF} - -{==============================================================================} - -function TickDelta(TickOld, TickNew: LongWord): LongWord; -begin -//if DWord is signed type (older Deplhi), -// then it not work properly on differencies larger then maxint! - Result := 0; - if TickOld <> TickNew then - begin - if TickNew < TickOld then - begin - TickNew := TickNew + LongWord(MaxInt) + 1; - TickOld := TickOld + LongWord(MaxInt) + 1; - end; - Result := TickNew - TickOld; - if TickNew < TickOld then - if Result > 0 then - Result := 0 - Result; - end; -end; - -{==============================================================================} - -function CodeInt(Value: Word): Ansistring; -begin - setlength(result, 2); - result[1] := AnsiChar(Value div 256); - result[2] := AnsiChar(Value mod 256); -// Result := AnsiChar(Value div 256) + AnsiChar(Value mod 256) -end; - -{==============================================================================} - -function DecodeInt(const Value: Ansistring; Index: Integer): Word; -var - x, y: Byte; -begin - if Length(Value) > Index then - x := Ord(Value[Index]) - else - x := 0; - if Length(Value) >= (Index + 1) then - y := Ord(Value[Index + 1]) - else - y := 0; - Result := x * 256 + y; -end; - -{==============================================================================} - -function CodeLongInt(Value: Longint): Ansistring; -var - x, y: word; -begin - // this is fix for negative numbers on systems where longint = integer - x := (Value shr 16) and integer($ffff); - y := Value and integer($ffff); - setlength(result, 4); - result[1] := AnsiChar(x div 256); - result[2] := AnsiChar(x mod 256); - result[3] := AnsiChar(y div 256); - result[4] := AnsiChar(y mod 256); -end; - -{==============================================================================} - -function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt; -var - x, y: Byte; - xl, yl: Byte; -begin - if Length(Value) > Index then - x := Ord(Value[Index]) - else - x := 0; - if Length(Value) >= (Index + 1) then - y := Ord(Value[Index + 1]) - else - y := 0; - if Length(Value) >= (Index + 2) then - xl := Ord(Value[Index + 2]) - else - xl := 0; - if Length(Value) >= (Index + 3) then - yl := Ord(Value[Index + 3]) - else - yl := 0; - Result := ((x * 256 + y) * 65536) + (xl * 256 + yl); -end; - -{==============================================================================} - -function DumpStr(const Buffer: Ansistring): string; -var - n: Integer; -begin - Result := ''; - for n := 1 to Length(Buffer) do - Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2); -end; - -{==============================================================================} - -function DumpExStr(const Buffer: Ansistring): string; -var - n: Integer; - x: Byte; -begin - Result := ''; - for n := 1 to Length(Buffer) do - begin - x := Ord(Buffer[n]); - if x in [65..90, 97..122] then - Result := Result + ' +''' + char(x) + '''' - else - Result := Result + ' +#$' + IntToHex(Ord(Buffer[n]), 2); - end; -end; - -{==============================================================================} - -procedure Dump(const Buffer: AnsiString; DumpFile: string); -var - f: Text; -begin - AssignFile(f, DumpFile); - if FileExists(DumpFile) then - DeleteFile(DumpFile); - Rewrite(f); - try - Writeln(f, DumpStr(Buffer)); - finally - CloseFile(f); - end; -end; - -{==============================================================================} - -procedure DumpEx(const Buffer: AnsiString; DumpFile: string); -var - f: Text; -begin - AssignFile(f, DumpFile); - if FileExists(DumpFile) then - DeleteFile(DumpFile); - Rewrite(f); - try - Writeln(f, DumpExStr(Buffer)); - finally - CloseFile(f); - end; -end; - -{==============================================================================} - -function TrimSPLeft(const S: string): string; -var - I, L: Integer; -begin - Result := ''; - if S = '' then - Exit; - L := Length(S); - I := 1; - while (I <= L) and (S[I] = ' ') do - Inc(I); - Result := Copy(S, I, Maxint); -end; - -{==============================================================================} - -function TrimSPRight(const S: string): string; -var - I: Integer; -begin - Result := ''; - if S = '' then - Exit; - I := Length(S); - while (I > 0) and (S[I] = ' ') do - Dec(I); - Result := Copy(S, 1, I); -end; - -{==============================================================================} - -function TrimSP(const S: string): string; -begin - Result := TrimSPLeft(s); - Result := TrimSPRight(Result); -end; - -{==============================================================================} - -function SeparateLeft(const Value, Delimiter: string): string; -var - x: Integer; -begin - x := Pos(Delimiter, Value); - if x < 1 then - Result := Value - else - Result := Copy(Value, 1, x - 1); -end; - -{==============================================================================} - -function SeparateRight(const Value, Delimiter: string): string; -var - x: Integer; -begin - x := Pos(Delimiter, Value); - if x > 0 then - x := x + Length(Delimiter) - 1; - Result := Copy(Value, x + 1, Length(Value) - x); -end; - -{==============================================================================} - -function GetParameter(const Value, Parameter: string): string; -var - s: string; - v: string; -begin - Result := ''; - v := Value; - while v <> '' do - begin - s := Trim(FetchEx(v, ';', '"')); - if Pos(Uppercase(parameter), Uppercase(s)) = 1 then - begin - Delete(s, 1, Length(Parameter)); - s := Trim(s); - if s = '' then - Break; - if s[1] = '=' then - begin - Result := Trim(SeparateRight(s, '=')); - Result := UnquoteStr(Result, '"'); - break; - end; - end; - end; -end; - -{==============================================================================} - -procedure ParseParametersEx(Value, Delimiter: string; const Parameters: TStrings); -var - s: string; -begin - Parameters.Clear; - while Value <> '' do - begin - s := Trim(FetchEx(Value, Delimiter, '"')); - Parameters.Add(s); - end; -end; - -{==============================================================================} - -procedure ParseParameters(Value: string; const Parameters: TStrings); -begin - ParseParametersEx(Value, ';', Parameters); -end; - -{==============================================================================} - -function IndexByBegin(Value: string; const List: TStrings): integer; -var - n: integer; - s: string; -begin - Result := -1; - Value := uppercase(Value); - for n := 0 to List.Count -1 do - begin - s := UpperCase(List[n]); - if Pos(Value, s) = 1 then - begin - Result := n; - Break; - end; - end; -end; - -{==============================================================================} - -function GetEmailAddr(const Value: string): string; -var - s: string; -begin - s := SeparateRight(Value, '<'); - s := SeparateLeft(s, '>'); - Result := Trim(s); -end; - -{==============================================================================} - -function GetEmailDesc(Value: string): string; -var - s: string; -begin - Value := Trim(Value); - s := SeparateRight(Value, '"'); - if s <> Value then - s := SeparateLeft(s, '"') - else - begin - s := SeparateLeft(Value, '<'); - if s = Value then - begin - s := SeparateRight(Value, '('); - if s <> Value then - s := SeparateLeft(s, ')') - else - s := ''; - end; - end; - Result := Trim(s); -end; - -{==============================================================================} - -function StrToHex(const Value: Ansistring): string; -var - n: Integer; -begin - Result := ''; - for n := 1 to Length(Value) do - Result := Result + IntToHex(Byte(Value[n]), 2); - Result := LowerCase(Result); -end; - -{==============================================================================} - -function IntToBin(Value: Integer; Digits: Byte): string; -var - x, y, n: Integer; -begin - Result := ''; - x := Value; - repeat - y := x mod 2; - x := x div 2; - if y > 0 then - Result := '1' + Result - else - Result := '0' + Result; - until x = 0; - x := Length(Result); - for n := x to Digits - 1 do - Result := '0' + Result; -end; - -{==============================================================================} - -function BinToInt(const Value: string): Integer; -var - n: Integer; -begin - Result := 0; - for n := 1 to Length(Value) do - begin - if Value[n] = '0' then - Result := Result * 2 - else - if Value[n] = '1' then - Result := Result * 2 + 1 - else - Break; - end; -end; - -{==============================================================================} - -function ParseURL(URL: string; var Prot, User, Pass, Host, Port, Path, - Para: string): string; -var - x, y: Integer; - sURL: string; - s: string; - s1, s2: string; -begin - Prot := 'http'; - User := ''; - Pass := ''; - Port := '80'; - Para := ''; - - x := Pos('://', URL); - if x > 0 then - begin - Prot := SeparateLeft(URL, '://'); - sURL := SeparateRight(URL, '://'); - end - else - sURL := URL; - if UpperCase(Prot) = 'HTTPS' then - Port := '443'; - if UpperCase(Prot) = 'FTP' then - Port := '21'; - x := Pos('@', sURL); - y := Pos('/', sURL); - if (x > 0) and ((x < y) or (y < 1))then - begin - s := SeparateLeft(sURL, '@'); - sURL := SeparateRight(sURL, '@'); - x := Pos(':', s); - if x > 0 then - begin - User := SeparateLeft(s, ':'); - Pass := SeparateRight(s, ':'); - end - else - User := s; - end; - x := Pos('/', sURL); - if x > 0 then - begin - s1 := SeparateLeft(sURL, '/'); - s2 := SeparateRight(sURL, '/'); - end - else - begin - s1 := sURL; - s2 := ''; - end; - if Pos('[', s1) = 1 then - begin - Host := Separateleft(s1, ']'); - Delete(Host, 1, 1); - s1 := SeparateRight(s1, ']'); - if Pos(':', s1) = 1 then - Port := SeparateRight(s1, ':'); - end - else - begin - x := Pos(':', s1); - if x > 0 then - begin - Host := SeparateLeft(s1, ':'); - Port := SeparateRight(s1, ':'); - end - else - Host := s1; - end; - Result := '/' + s2; - x := Pos('?', s2); - if x > 0 then - begin - Path := '/' + SeparateLeft(s2, '?'); - Para := SeparateRight(s2, '?'); - end - else - Path := '/' + s2; - if Host = '' then - Host := 'localhost'; -end; - -{==============================================================================} - -function ReplaceString(Value, Search, Replace: AnsiString): AnsiString; -var - x, l, ls, lr: Integer; -begin - if (Value = '') or (Search = '') then - begin - Result := Value; - Exit; - end; - ls := Length(Search); - lr := Length(Replace); - Result := ''; - x := Pos(Search, Value); - while x > 0 do - begin - {$IFNDEF CIL} - l := Length(Result); - SetLength(Result, l + x - 1); - Move(Pointer(Value)^, Pointer(@Result[l + 1])^, x - 1); - {$ELSE} - Result:=Result+Copy(Value,1,x-1); - {$ENDIF} - {$IFNDEF CIL} - l := Length(Result); - SetLength(Result, l + lr); - Move(Pointer(Replace)^, Pointer(@Result[l + 1])^, lr); - {$ELSE} - Result:=Result+Replace; - {$ENDIF} - Delete(Value, 1, x - 1 + ls); - x := Pos(Search, Value); - end; - Result := Result + Value; -end; - -{==============================================================================} - -function RPosEx(const Sub, Value: string; From: integer): Integer; -var - n: Integer; - l: Integer; -begin - result := 0; - l := Length(Sub); - for n := From - l + 1 downto 1 do - begin - if Copy(Value, n, l) = Sub then - begin - result := n; - break; - end; - end; -end; - -{==============================================================================} - -function RPos(const Sub, Value: String): Integer; -begin - Result := RPosEx(Sub, Value, Length(Value)); -end; - -{==============================================================================} - -function FetchBin(var Value: string; const Delimiter: string): string; -var - s: string; -begin - Result := SeparateLeft(Value, Delimiter); - s := SeparateRight(Value, Delimiter); - if s = Value then - Value := '' - else - Value := s; -end; - -{==============================================================================} - -function Fetch(var Value: string; const Delimiter: string): string; -begin - Result := FetchBin(Value, Delimiter); - Result := TrimSP(Result); - Value := TrimSP(Value); -end; - -{==============================================================================} - -function FetchEx(var Value: string; const Delimiter, Quotation: string): string; -var - b: Boolean; -begin - Result := ''; - b := False; - while Length(Value) > 0 do - begin - if b then - begin - if Pos(Quotation, Value) = 1 then - b := False; - Result := Result + Value[1]; - Delete(Value, 1, 1); - end - else - begin - if Pos(Delimiter, Value) = 1 then - begin - Delete(Value, 1, Length(delimiter)); - break; - end; - b := Pos(Quotation, Value) = 1; - Result := Result + Value[1]; - Delete(Value, 1, 1); - end; - end; -end; - -{==============================================================================} - -function IsBinaryString(const Value: AnsiString): Boolean; -var - n: integer; -begin - Result := False; - for n := 1 to Length(Value) do - if Value[n] in [#0..#8, #10..#31] then - //ignore null-terminated strings - if not ((n = Length(value)) and (Value[n] = AnsiChar(#0))) then - begin - Result := True; - Break; - end; -end; - -{==============================================================================} - -function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer; -var - n, l: integer; -begin - Result := -1; - Terminator := ''; - l := length(value); - for n := 1 to l do - if value[n] in [#$0d, #$0a] then - begin - Result := n; - Terminator := Value[n]; - if n <> l then - case value[n] of - #$0d: - if value[n + 1] = #$0a then - Terminator := #$0d + #$0a; - #$0a: - if value[n + 1] = #$0d then - Terminator := #$0a + #$0d; - end; - Break; - end; -end; - -{==============================================================================} - -Procedure StringsTrim(const Value: TStrings); -var - n: integer; -begin - for n := Value.Count - 1 downto 0 do - if Value[n] = '' then - Value.Delete(n) - else - Break; -end; - -{==============================================================================} - -function PosFrom(const SubStr, Value: String; From: integer): integer; -var - ls,lv: integer; -begin - Result := 0; - ls := Length(SubStr); - lv := Length(Value); - if (ls = 0) or (lv = 0) then - Exit; - if From < 1 then - From := 1; - while (ls + from - 1) <= (lv) do - begin - {$IFNDEF CIL} - if CompareMem(@SubStr[1],@Value[from],ls) then - {$ELSE} - if SubStr = copy(Value, from, ls) then - {$ENDIF} - begin - result := from; - break; - end - else - inc(from); - end; -end; - -{==============================================================================} - -{$IFNDEF CIL} -function IncPoint(const p: pointer; Value: integer): pointer; -begin - Result := PAnsiChar(p) + Value; -end; -{$ENDIF} - -{==============================================================================} -//improved by 'DoggyDawg' -function GetBetween(const PairBegin, PairEnd, Value: string): string; -var - n: integer; - x: integer; - s: string; - lenBegin: integer; - lenEnd: integer; - str: string; - max: integer; -begin - lenBegin := Length(PairBegin); - lenEnd := Length(PairEnd); - n := Length(Value); - if (Value = PairBegin + PairEnd) then - begin - Result := '';//nothing between - exit; - end; - if (n < lenBegin + lenEnd) then - begin - Result := Value; - exit; - end; - s := SeparateRight(Value, PairBegin); - if (s = Value) then - begin - Result := Value; - exit; - end; - n := Pos(PairEnd, s); - if (n = 0) then - begin - Result := Value; - exit; - end; - Result := ''; - x := 1; - max := Length(s) - lenEnd + 1; - for n := 1 to max do - begin - str := copy(s, n, lenEnd); - if (str = PairEnd) then - begin - Dec(x); - if (x <= 0) then - Break; - end; - str := copy(s, n, lenBegin); - if (str = PairBegin) then - Inc(x); - Result := Result + s[n]; - end; -end; - -{==============================================================================} - -function CountOfChar(const Value: string; Chr: char): integer; -var - n: integer; -begin - Result := 0; - for n := 1 to Length(Value) do - if Value[n] = chr then - Inc(Result); -end; - -{==============================================================================} -// ! do not use AnsiExtractQuotedStr, it's very buggy and can crash application! -function UnquoteStr(const Value: string; Quote: Char): string; -var - n: integer; - inq, dq: Boolean; - c, cn: char; -begin - Result := ''; - if Value = '' then - Exit; - if Value = Quote + Quote then - Exit; - inq := False; - dq := False; - for n := 1 to Length(Value) do - begin - c := Value[n]; - if n <> Length(Value) then - cn := Value[n + 1] - else - cn := #0; - if c = quote then - if dq then - dq := False - else - if not inq then - inq := True - else - if cn = quote then - begin - Result := Result + Quote; - dq := True; - end - else - inq := False - else - Result := Result + c; - end; -end; - -{==============================================================================} - -function QuoteStr(const Value: string; Quote: Char): string; -var - n: integer; -begin - Result := ''; - for n := 1 to length(value) do - begin - Result := result + Value[n]; - if value[n] = Quote then - Result := Result + Quote; - end; - Result := Quote + Result + Quote; -end; - -{==============================================================================} - -procedure HeadersToList(const Value: TStrings); -var - n, x, y: integer; - s: string; -begin - for n := 0 to Value.Count -1 do - begin - s := Value[n]; - x := Pos(':', s); - if x > 0 then - begin - y:= Pos('=',s); - if not ((y > 0) and (y < x)) then - begin - s[x] := '='; - Value[n] := s; - end; - end; - end; -end; - -{==============================================================================} - -procedure ListToHeaders(const Value: TStrings); -var - n, x: integer; - s: string; -begin - for n := 0 to Value.Count -1 do - begin - s := Value[n]; - x := Pos('=', s); - if x > 0 then - begin - s[x] := ':'; - Value[n] := s; - end; - end; -end; - -{==============================================================================} - -function SwapBytes(Value: integer): integer; -var - s: AnsiString; - x, y, xl, yl: Byte; -begin - s := CodeLongInt(Value); - x := Ord(s[4]); - y := Ord(s[3]); - xl := Ord(s[2]); - yl := Ord(s[1]); - Result := ((x * 256 + y) * 65536) + (xl * 256 + yl); -end; - -{==============================================================================} - -function ReadStrFromStream(const Stream: TStream; len: integer): AnsiString; -var - x: integer; -{$IFDEF CIL} - buf: Array of Byte; -{$ENDIF} -begin -{$IFDEF CIL} - Setlength(buf, Len); - x := Stream.read(buf, Len); - SetLength(buf, x); - Result := StringOf(Buf); -{$ELSE} - Setlength(Result, Len); - x := Stream.read(PAnsiChar(Result)^, Len); - SetLength(Result, x); -{$ENDIF} -end; - -{==============================================================================} - -procedure WriteStrToStream(const Stream: TStream; Value: AnsiString); -{$IFDEF CIL} -var - buf: Array of Byte; -{$ENDIF} -begin -{$IFDEF CIL} - buf := BytesOf(Value); - Stream.Write(buf,length(Value)); -{$ELSE} - Stream.Write(PAnsiChar(Value)^, Length(Value)); -{$ENDIF} -end; - -{==============================================================================} - -{$IFDEF POSIX} -function tempnam(const Path: PAnsiChar; const Prefix: PAnsiChar): PAnsiChar; cdecl; - external libc name _PU + 'tempnam'; -{$ENDIF} - -function GetTempFile(const Dir, prefix: String): String; -{$IFNDEF FPC} -{$IFDEF MSWINDOWS} -var - Path: String; - x: integer; -{$ENDIF} -{$ENDIF} -begin -{$IFDEF FPC} - Result := GetTempFileName(Dir, Prefix); -{$ELSE} - {$IFNDEF MSWINDOWS} - Result := tempnam(Pointer(Dir), Pointer(prefix)); - {$ELSE} - {$IFDEF CIL} - Result := System.IO.Path.GetTempFileName; - {$ELSE} - if Dir = '' then - begin - SetLength(Path, MAX_PATH); - x := GetTempPath(Length(Path), PChar(Path)); - SetLength(Path, x); - end - else - Path := Dir; - x := Length(Path); - if Path[x] <> '\' then - Path := Path + '\'; - SetLength(Result, MAX_PATH + 1); - GetTempFileName(PChar(Path), PChar(Prefix), 0, PChar(Result)); - Result := PChar(Result); - SetFileattributes(PChar(Result), GetFileAttributes(PChar(Result)) or FILE_ATTRIBUTE_TEMPORARY); - {$ENDIF} - {$ENDIF} -{$ENDIF} -end; - -{==============================================================================} - -function PadString(const Value: AnsiString; len: integer; Pad: AnsiChar): AnsiString; -begin - if length(value) >= len then - Result := Copy(value, 1, len) - else - Result := Value + StringOfChar(Pad, len - length(value)); -end; - -{==============================================================================} - -function XorString(Indata1, Indata2: AnsiString): AnsiString; -var - i: integer; -begin - Indata2 := PadString(Indata2, length(Indata1), #0); - Result := ''; - for i := 1 to length(Indata1) do - Result := Result + AnsiChar(ord(Indata1[i]) xor ord(Indata2[i])); -end; - -{==============================================================================} - -function NormalizeHeader(Value: TStrings; var Index: Integer): string; -var - s, t: string; - n: Integer; -begin - s := Value[Index]; - Inc(Index); - if s <> '' then - while (Value.Count - 1) > Index do - begin - t := Value[Index]; - if t = '' then - Break; - for n := 1 to Length(t) do - if t[n] = #9 then - t[n] := ' '; - if not(AnsiChar(t[1]) in [' ', '"', ':', '=']) then - Break - else - begin - s := s + ' ' + Trim(t); - Inc(Index); - end; - end; - Result := TrimRight(s); -end; - -{==============================================================================} - -{pf} -procedure SearchForLineBreak(var APtr:PANSIChar; AEtx:PANSIChar; out ABol:PANSIChar; out ALength:integer); -begin - ABol := APtr; - while (APtr0 then - begin - APtr := bol; - Break; - end; - end; -end; -{/pf} - -{pf} -procedure CopyLinesFromStreamUntilNullLine(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings); -var - bol: PANSIChar; - lng: integer; - s: ANSIString; -begin - // Copying until body separator will be reached - while (APtr#0) do - begin - SearchForLineBreak(APtr,AEtx,bol,lng); - SkipLineBreak(APtr,AEtx); - if lng=0 then - Break; - SetString(s,bol,lng); - ALines.Add(s); - end; -end; -{/pf} - -{pf} -procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar; AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString); -var - bol: PANSIChar; - lng: integer; - s: ANSIString; - BackStop: ANSIString; - eob1: PANSIChar; - eob2: PANSIChar; -begin - BackStop := '--'+ABoundary; - eob2 := nil; - // Copying until Boundary will be reached - while (APtrAETX then - exit; - if strlcomp(MatchPos,#13#10,2)=0 then - inc(MatchPos,2); - if (MatchPos+2+Lng)>AETX then - exit; - if strlcomp(MatchPos,'--',2)<>0 then - exit; - inc(MatchPos,2); - if strlcomp(MatchPos,PANSIChar(ABoundary),Lng)<>0 then - exit; - inc(MatchPos,Lng); - if ((MatchPos+2)<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then - inc(MatchPos,2); - Result := MatchPos; -end; -{/pf} - -{pf} -function MatchLastBoundary(ABOL,AETX:PANSIChar; const ABoundary:ANSIString): PANSIChar; -var - MatchPos: PANSIChar; -begin - Result := nil; - MatchPos := MatchBoundary(ABOL,AETX,ABoundary); - if not Assigned(MatchPos) then - exit; - if strlcomp(MatchPos,'--',2)<>0 then - exit; - inc(MatchPos,2); - if (MatchPos+2<=AEtx) and (strlcomp(MatchPos,#13#10,2)=0) then - inc(MatchPos,2); - Result := MatchPos; -end; -{/pf} - -{pf} -function BuildStringFromBuffer(AStx,AEtx:PANSIChar): ANSIString; -var - lng: integer; -begin - Lng := 0; - if Assigned(AStx) and Assigned(AEtx) then - begin - Lng := AEtx-AStx; - if Lng<0 then - Lng := 0; - end; - SetString(Result,AStx,lng); -end; -{/pf} - - - - -{==============================================================================} -var - n: integer; -begin - for n := 1 to 12 do - begin - CustomMonthNames[n] := {$IFDEF COMPILER15_UP}FormatSettings.{$ENDIF}ShortMonthNames[n]; - MyMonthNames[0, n] := {$IFDEF COMPILER15_UP}FormatSettings.{$ENDIF}ShortMonthNames[n]; - end; -end. diff --git a/3rd/synapse/source/synsock.pas b/3rd/synapse/source/synsock.pas deleted file mode 100644 index 8f8aa4a11..000000000 --- a/3rd/synapse/source/synsock.pas +++ /dev/null @@ -1,86 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 005.002.003 | -|==============================================================================| -| Content: Socket Independent Platform Layer | -|==============================================================================| -| Copyright (c)1999-2013, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2001-2013. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -| Tomas Hajny (OS2 support) | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@exclude} - -unit synsock; - -{$MINENUMSIZE 4} - -//old Delphi does not have MSWINDOWS define. -{$IFDEF WIN32} - {$IFNDEF MSWINDOWS} - {$DEFINE MSWINDOWS} - {$ENDIF} -{$ENDIF} - -{$IFDEF CIL} - {$I ssdotnet.inc} -{$ELSE} - {$IFDEF MSWINDOWS} - {$I sswin32.inc} - {$ELSE} - {$IFDEF WINCE} - {$I sswin32.inc} //not complete yet! - {$ELSE} - {$IFDEF FPC} - {$IFDEF OS2} - {$I ssos2ws1.inc} - {$ELSE OS2} - {$I ssfpc.inc} - {$ENDIF OS2} - {$ELSE} - {$I sslinux.inc} - {$ENDIF} - {$ENDIF} - {$ENDIF} -{$ENDIF} -{$IFDEF POSIX} -//Posix.SysSocket - {$I ssposix.inc} //experimental! -{$ENDIF} - -end. - diff --git a/3rd/synapse/source/tlntsend.pas b/3rd/synapse/source/tlntsend.pas deleted file mode 100644 index 557266c59..000000000 --- a/3rd/synapse/source/tlntsend.pas +++ /dev/null @@ -1,364 +0,0 @@ -{==============================================================================| -| Project : Ararat Synapse | 001.003.001 | -|==============================================================================| -| Content: TELNET and SSH2 client | -|==============================================================================| -| Copyright (c)1999-2010, Lukas Gebauer | -| All rights reserved. | -| | -| Redistribution and use in source and binary forms, with or without | -| modification, are permitted provided that the following conditions are met: | -| | -| Redistributions of source code must retain the above copyright notice, this | -| list of conditions and the following disclaimer. | -| | -| Redistributions in binary form must reproduce the above copyright notice, | -| this list of conditions and the following disclaimer in the documentation | -| and/or other materials provided with the distribution. | -| | -| Neither the name of Lukas Gebauer nor the names of its contributors may | -| be used to endorse or promote products derived from this software without | -| specific prior written permission. | -| | -| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | -| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | -| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | -| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR | -| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL | -| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR | -| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER | -| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT | -| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY | -| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH | -| DAMAGE. | -|==============================================================================| -| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| -| Portions created by Lukas Gebauer are Copyright (c)2002-2010. | -| All Rights Reserved. | -|==============================================================================| -| Contributor(s): | -|==============================================================================| -| History: see HISTORY.HTM from distribution package | -| (Found at URL: http://www.ararat.cz/synapse/) | -|==============================================================================} - -{:@abstract(Telnet script client) - -Used RFC: RFC-854 -} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} -{$H+} - -{$IFDEF UNICODE} - {$WARN IMPLICIT_STRING_CAST OFF} - {$WARN IMPLICIT_STRING_CAST_LOSS OFF} -{$ENDIF} - -unit tlntsend; - -interface - -uses - SysUtils, Classes, - blcksock, synautil; - -const - cTelnetProtocol = '23'; - cSSHProtocol = '22'; - - TLNT_EOR = #239; - TLNT_SE = #240; - TLNT_NOP = #241; - TLNT_DATA_MARK = #242; - TLNT_BREAK = #243; - TLNT_IP = #244; - TLNT_AO = #245; - TLNT_AYT = #246; - TLNT_EC = #247; - TLNT_EL = #248; - TLNT_GA = #249; - TLNT_SB = #250; - TLNT_WILL = #251; - TLNT_WONT = #252; - TLNT_DO = #253; - TLNT_DONT = #254; - TLNT_IAC = #255; - -type - {:@abstract(State of telnet protocol). Used internaly by TTelnetSend.} - TTelnetState =(tsDATA, tsIAC, tsIAC_SB, tsIAC_WILL, tsIAC_DO, tsIAC_WONT, - tsIAC_DONT, tsIAC_SBIAC, tsIAC_SBDATA, tsSBDATA_IAC); - - {:@abstract(Class with implementation of Telnet/SSH script client.) - - Note: Are you missing properties for specify server address and port? Look to - parent @link(TSynaClient) too!} - TTelnetSend = class(TSynaClient) - private - FSock: TTCPBlockSocket; - FBuffer: Ansistring; - FState: TTelnetState; - FSessionLog: Ansistring; - FSubNeg: Ansistring; - FSubType: Ansichar; - FTermType: Ansistring; - function Connect: Boolean; - function Negotiate(const Buf: Ansistring): Ansistring; - procedure FilterHook(Sender: TObject; var Value: AnsiString); - public - constructor Create; - destructor Destroy; override; - - {:Connects to Telnet server.} - function Login: Boolean; - - {:Connects to SSH2 server and login by Username and Password properties. - - You must use some of SSL plugins with SSH support. For exammple CryptLib.} - function SSHLogin: Boolean; - - {:Logout from telnet server.} - procedure Logout; - - {:Send this data to telnet server.} - procedure Send(const Value: string); - - {:Reading data from telnet server until Value is readed. If it is not readed - until timeout, result is @false. Otherwise result is @true.} - function WaitFor(const Value: string): Boolean; - - {:Read data terminated by terminator from telnet server.} - function RecvTerminated(const Terminator: string): string; - - {:Read string from telnet server.} - function RecvString: string; - published - {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.} - property Sock: TTCPBlockSocket read FSock; - - {:all readed datas in this session (from connect) is stored in this large - string.} - property SessionLog: Ansistring read FSessionLog write FSessionLog; - - {:Terminal type indentification. By default is 'SYNAPSE'.} - property TermType: Ansistring read FTermType write FTermType; - end; - -implementation - -constructor TTelnetSend.Create; -begin - inherited Create; - FSock := TTCPBlockSocket.Create; - FSock.Owner := self; - FSock.OnReadFilter := FilterHook; - FTimeout := 60000; - FTargetPort := cTelnetProtocol; - FSubNeg := ''; - FSubType := #0; - FTermType := 'SYNAPSE'; -end; - -destructor TTelnetSend.Destroy; -begin - FSock.Free; - inherited Destroy; -end; - -function TTelnetSend.Connect: Boolean; -begin - // Do not call this function! It is calling by LOGIN method! - FBuffer := ''; - FSessionLog := ''; - FState := tsDATA; - FSock.CloseSocket; - FSock.LineBuffer := ''; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); - Result := FSock.LastError = 0; -end; - -function TTelnetSend.RecvTerminated(const Terminator: string): string; -begin - Result := FSock.RecvTerminated(FTimeout, Terminator); -end; - -function TTelnetSend.RecvString: string; -begin - Result := FSock.RecvTerminated(FTimeout, CRLF); -end; - -function TTelnetSend.WaitFor(const Value: string): Boolean; -begin - Result := FSock.RecvTerminated(FTimeout, Value) <> ''; -end; - -procedure TTelnetSend.FilterHook(Sender: TObject; var Value: AnsiString); -begin - Value := Negotiate(Value); - FSessionLog := FSessionLog + Value; -end; - -function TTelnetSend.Negotiate(const Buf: Ansistring): Ansistring; -var - n: integer; - c: Ansichar; - Reply: Ansistring; - SubReply: Ansistring; -begin - Result := ''; - for n := 1 to Length(Buf) do - begin - c := Buf[n]; - Reply := ''; - case FState of - tsData: - if c = TLNT_IAC then - FState := tsIAC - else - Result := Result + c; - - tsIAC: - case c of - TLNT_IAC: - begin - FState := tsData; - Result := Result + TLNT_IAC; - end; - TLNT_WILL: - FState := tsIAC_WILL; - TLNT_WONT: - FState := tsIAC_WONT; - TLNT_DONT: - FState := tsIAC_DONT; - TLNT_DO: - FState := tsIAC_DO; - TLNT_EOR: - FState := tsDATA; - TLNT_SB: - begin - FState := tsIAC_SB; - FSubType := #0; - FSubNeg := ''; - end; - else - FState := tsData; - end; - - tsIAC_WILL: - begin - case c of - #3: //suppress GA - Reply := TLNT_DO; - else - Reply := TLNT_DONT; - end; - FState := tsData; - end; - - tsIAC_WONT: - begin - Reply := TLNT_DONT; - FState := tsData; - end; - - tsIAC_DO: - begin - case c of - #24: //termtype - Reply := TLNT_WILL; - else - Reply := TLNT_WONT; - end; - FState := tsData; - end; - - tsIAC_DONT: - begin - Reply := TLNT_WONT; - FState := tsData; - end; - - tsIAC_SB: - begin - FSubType := c; - FState := tsIAC_SBDATA; - end; - - tsIAC_SBDATA: - begin - if c = TLNT_IAC then - FState := tsSBDATA_IAC - else - FSubNeg := FSubNeg + c; - end; - - tsSBDATA_IAC: - case c of - TLNT_IAC: - begin - FState := tsIAC_SBDATA; - FSubNeg := FSubNeg + c; - end; - TLNT_SE: - begin - SubReply := ''; - case FSubType of - #24: //termtype - begin - if (FSubNeg <> '') and (FSubNeg[1] = #1) then - SubReply := #0 + FTermType; - end; - end; - Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE); - FState := tsDATA; - end; - else - FState := tsDATA; - end; - - else - FState := tsData; - end; - if Reply <> '' then - Sock.SendString(TLNT_IAC + Reply + c); - end; - -end; - -procedure TTelnetSend.Send(const Value: string); -begin - Sock.SendString(ReplaceString(Value, TLNT_IAC, TLNT_IAC + TLNT_IAC)); -end; - -function TTelnetSend.Login: Boolean; -begin - Result := False; - if not Connect then - Exit; - Result := True; -end; - -function TTelnetSend.SSHLogin: Boolean; -begin - Result := False; - if Connect then - begin - FSock.SSL.SSLType := LT_SSHv2; - FSock.SSL.Username := FUsername; - FSock.SSL.Password := FPassword; - FSock.SSLDoConnect; - Result := FSock.LastError = 0; - end; -end; - -procedure TTelnetSend.Logout; -begin - FSock.CloseSocket; -end; - - -end. diff --git a/3rd/synapse/source/tzutil.pas b/3rd/synapse/source/tzutil.pas deleted file mode 100644 index 7657f1645..000000000 --- a/3rd/synapse/source/tzutil.pas +++ /dev/null @@ -1,702 +0,0 @@ -//Unit with timezone support for some Freepascal platforms. -//Tomas Hajny - -unit tzutil; - - -interface - -type - DSTSpecType = (DSTMonthWeekDay, DSTMonthDay, DSTJulian, DSTJulianX); - -(* Initialized to default values *) -const - TZName: string = ''; - TZDSTName: string = ''; - TZOffset: longint = 0; - DSTOffset: longint = 0; - DSTStartMonth: byte = 4; - DSTStartWeek: shortint = 1; - DSTStartDay: word = 0; - DSTStartSec: cardinal = 7200; - DSTEndMonth: byte = 10; - DSTEndWeek: shortint = -1; - DSTEndDay: word = 0; - DSTEndSec: cardinal = 10800; - DSTStartSpecType: DSTSpecType = DSTMonthWeekDay; - DSTEndSpecType: DSTSpecType = DSTMonthWeekDay; - -function TZSeconds: longint; -(* Return current offset from UTC in seconds while respecting DST *) - -implementation - -uses - Dos; - -function TZSeconds: longint; -const - MonthDays: array [1..12] of byte = - (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); - MonthEnds: array [1..12] of word = - (31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365); -var - Y, Mo, D, WD, H, Mi, S, S100: word; - MS, DS, ME, DE: byte; - L: longint; - Second: cardinal; - AfterDSTStart, BeforeDSTEnd: boolean; - -function LeapDay: byte; -begin - if (Y mod 400 = 0) or (Y mod 100 <> 0) and (Y mod 4 = 0) then - LeapDay := 1 - else - LeapDay := 0; -end; - -function FirstDay (MM: byte): byte; -(* What day of week (0-6) is the first day of month MM? *) -var - DD: longint; -begin - if MM < Mo then - begin - DD := D + MonthEnds [Pred (Mo)]; - if MM > 1 then - Dec (DD, MonthEnds [Pred (MM)]); - if (MM <= 2) and (Mo > 2) then - Inc (DD, LeapDay); - end - else - if MM > Mo then - begin - DD := - MonthDays [Mo] + D - MonthEnds [Pred (MM)] + MonthEnds [Mo]; - if (Mo <= 2) and (MM > 2) then - Dec (DD, LeapDay); - end - else -(* M = MM *) - DD := D; - DD := WD - DD mod 7 + 1; - if DD < 0 then - FirstDay := DD + 7 - else - FirstDay := DD mod 7; -end; - -begin - TZSeconds := TZOffset; - if DSTOffset <> TZOffset then - begin - GetDate (Y, Mo, D, WD); - GetTime (H, Mi, S, S100); - Second := cardinal (H) * 3600 + Mi * 60 + S; - - if (DSTStartSpecType = DSTMonthWeekDay) or (DSTStartSpecType = DSTMonthDay) - then - begin - MS := DSTStartMonth; - if DSTStartSpecType = DSTMonthDay then - DS := DSTStartDay - else - begin - DS := FirstDay (DSTStartMonth); - if (DSTStartWeek >= 1) and (DSTStartWeek <= 4) then - if DSTStartDay < DS then - DS := DSTStartWeek * 7 + DSTStartDay - DS + 1 - else - DS := Pred (DSTStartWeek) * 7 + DSTStartDay - DS + 1 - else -(* Last week in month *) - begin - DS := DS + MonthDays [MS] - 1; - if MS = 2 then - Inc (DS, LeapDay); - DS := DS mod 7; - if DS < DSTStartDay then - DS := DS + 7 - DSTStartDay - else - DS := DS - DSTStartDay; - DS := MonthDays [MS] - DS; - end; - end; - end - else - begin -(* Julian day *) - L := DSTStartDay; - if (DSTStartSpecType = DSTJulian) then -(* 0-based *) - if (L + LeapDay <= 59) then - Inc (L) - else - L := L + 1 - LeapDay; - if L <= 31 then - begin - MS := 1; - DS := L; - end - else - if (L <= 59) or - (DSTStartSpecType = DSTJulian) and (L - LeapDay <= 59) then - begin - MS := 2; - DS := DSTStartDay - 31; - end - else - begin - MS := 3; - while (MS < 12) and (MonthEnds [MS] > L) do - Inc (MS); - DS := L - MonthEnds [Pred (MS)]; - end; - end; - - if (DSTEndSpecType = DSTMonthWeekDay) or (DSTEndSpecType = DSTMonthDay) then - begin - ME := DSTEndMonth; - if DSTEndSpecType = DSTMonthDay then - DE := DSTEndDay - else - begin - DE := FirstDay (DSTEndMonth); - if (DSTEndWeek >= 1) and (DSTEndWeek <= 4) then - if DSTEndDay < DE then - DE := DSTEndWeek * 7 + DSTEndDay - DE + 1 - else - DE := Pred (DSTEndWeek) * 7 + DSTEndDay - DE + 1 - else -(* Last week in month *) - begin - DE := DE + MonthDays [ME] - 1; - if ME = 2 then - Inc (DE, LeapDay); - DE := DE mod 7; - if DE < DSTEndDay then - DE := DE + 7 - DSTEndDay - else - DE := DE - DSTEndDay; - DE := MonthDays [ME] - DE; - end; - end; - end - else - begin -(* Julian day *) - L := DSTEndDay; - if (DSTEndSpecType = DSTJulian) then -(* 0-based *) - if (L + LeapDay <= 59) then - Inc (L) - else - L := L + 1 - LeapDay; - if L <= 31 then - begin - ME := 1; - DE := L; - end - else - if (L <= 59) or - (DSTEndSpecType = DSTJulian) and (L - LeapDay <= 59) then - begin - ME := 2; - DE := DSTEndDay - 31; - end - else - begin - ME := 3; - while (ME < 12) and (MonthEnds [ME] > L) do - Inc (ME); - DE := L - MonthEnds [Pred (ME)]; - end; - end; - - if Mo < MS then - AfterDSTStart := false - else - if Mo > MS then - AfterDSTStart := true - else - if D < DS then - AfterDSTStart := false - else - if D > DS then - AfterDSTStart := true - else - AfterDSTStart := Second > DSTStartSec; - if Mo > ME then - BeforeDSTEnd := false - else - if Mo < ME then - BeforeDSTEnd := true - else - if D > DE then - BeforeDSTEnd := false - else - if D < DE then - BeforeDSTEnd := true - else - BeforeDSTEnd := Second < DSTEndSec; - if AfterDSTStart and BeforeDSTEnd then - TZSeconds := DSTOffset; - end; -end; - -procedure InitTZ; -const - TZEnvName = 'TZ'; - EMXTZEnvName = 'EMXTZ'; -var - TZ, S: string; - I, J: byte; - Err: longint; - GnuFmt: boolean; - ADSTStartMonth: byte; - ADSTStartWeek: shortint; - ADSTStartDay: word; - ADSTStartSec: cardinal; - ADSTEndMonth: byte; - ADSTEndWeek: shortint; - ADSTEndDay: word; - ADSTEndSec: cardinal; - ADSTStartSpecType: DSTSpecType; - ADSTEndSpecType: DSTSpecType; - ADSTChangeSec: cardinal; - - function ParseOffset (OffStr: string): longint; - (* Parse time offset given as [-|+]HH[:MI[:SS]] and return in seconds *) - var - TZShiftHH, TZShiftDir: shortint; - TZShiftMI, TZShiftSS: byte; - N1, N2: byte; - begin - TZShiftHH := 0; - TZShiftMI := 0; - TZShiftSS := 0; - TZShiftDir := 1; - N1 := 1; - while (N1 <= Length (OffStr)) and (OffStr [N1] <> ':') do - Inc (N1); - Val (Copy (OffStr, 1, Pred (N1)), TZShiftHH, Err); - if (Err = 0) and (TZShiftHH >= -24) and (TZShiftHH <= 23) then - begin -(* Normalize the hour offset to -12..11 if necessary *) - if TZShiftHH > 11 then - Dec (TZShiftHH, 24) else - if TZShiftHH < -12 then - Inc (TZShiftHH, 24); - if TZShiftHH < 0 then - TZShiftDir := -1; - if (N1 <= Length (OffStr)) then - begin - N2 := Succ (N1); - while (N2 <= Length (OffStr)) and (OffStr [N2] <> ':') do - Inc (N2); - Val (Copy (OffStr, Succ (N1), N2 - N1), TZShiftMI, Err); - if (Err = 0) and (TZShiftMI <= 59) then - begin - if (N2 <= Length (OffStr)) then - begin - Val (Copy (OffStr, Succ (N2), Length (OffStr) - N2), TZShiftSS, Err); - if (Err <> 0) or (TZShiftSS > 59) then - TZShiftSS := 0; - end - end - else - TZShiftMI := 0; - end; - end - else - TZShiftHH := 0; - ParseOffset := longint (TZShiftHH) * 3600 + - TZShiftDir * (longint (TZShiftMI) * 60 + TZShiftSS); - end; - -begin - TZ := GetEnv (TZEnvName); - if TZ = '' then - TZ := GetEnv (EMXTZEnvName); - if TZ <> '' then - begin - TZ := Upcase (TZ); -(* Timezone name *) - I := 1; - while (I <= Length (TZ)) and (TZ [I] in ['A'..'Z']) do - Inc (I); - TZName := Copy (TZ, 1, Pred (I)); - if I <= Length (TZ) then - begin -(* Timezone shift *) - J := Succ (I); - while (J <= Length (TZ)) and not (TZ [J] in ['A'..'Z']) do - Inc (J); - TZOffset := ParseOffset (Copy (TZ, I, J - I)); -(* DST timezone name *) - I := J; - while (J <= Length (TZ)) and (TZ [J] in ['A'..'Z']) do - Inc (J); - if J > I then - begin - TZDSTName := Copy (TZ, I, J - I); -(* DST timezone name provided; if equal to the standard timezone *) -(* name then DSTOffset is set to be equal to TZOffset by default, *) -(* otherwise it is set to TZOffset - 3600 seconds. *) - if TZDSTName <> TZName then - DSTOffset := -3600 + TZOffset - else - DSTOffset := TZOffset; - end - else - begin - TZDSTName := TZName; -(* No DST timezone name provided => DSTOffset is equal to TZOffset *) - DSTOffset := TZOffset; - end; - if J <= Length (TZ) then - begin -(* Check if DST offset is specified here; *) -(* if not, default value set above is used. *) - if TZ [J] <> ',' then - begin - I := J; - Inc (J); - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - DSTOffset := ParseOffset (Copy (TZ, I, J - I)); - end; - if J < Length (TZ) then - begin - Inc (J); -(* DST switching details *) - case TZ [J] of - 'M': - begin -(* Mmonth.week.dayofweek[/StartHour] *) - ADSTStartSpecType := DSTMonthWeekDay; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do - Inc (J); - if (J >= Length (TZ)) or (TZ [J] <> '.') then - Exit; - Val (Copy (TZ, I, J - I), ADSTStartMonth, Err); - if (Err > 0) or (ADSTStartMonth > 12) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do - Inc (J); - if (J >= Length (TZ)) or (TZ [J] <> '.') then - Exit; - Val (Copy (TZ, I, J - I), ADSTStartWeek, Err); - if (Err > 0) or (ADSTStartWeek < 1) or (ADSTStartWeek > 5) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartDay, Err); - if (Err > 0) or (ADSTStartDay < 0) or (ADSTStartDay > 6) - or (J >= Length (TZ)) then - Exit; - if TZ [J] = '/' then - begin - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartSec, Err); - if (Err > 0) or (ADSTStartSec > 86399) or (J >= Length (TZ)) - then - Exit - else - ADSTStartSec := ADSTStartSec * 3600; - end - else - (* Use the preset default *) - ADSTStartSec := DSTStartSec; - Inc (J); - end; - 'J': - begin -(* Jjulianday[/StartHour] *) - ADSTStartSpecType := DSTJulianX; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in [',', '/']) do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartDay, Err); - if (Err > 0) or (ADSTStartDay = 0) or (ADSTStartDay > 365) - or (J >= Length (TZ)) then - Exit; - if TZ [J] = '/' then - begin - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartSec, Err); - if (Err > 0) or (ADSTStartSec > 86399) or (J >= Length (TZ)) - then - Exit - else - ADSTStartSec := ADSTStartSec * 3600; - end - else - (* Use the preset default *) - ADSTStartSec := DSTStartSec; - Inc (J); - end - else - begin -(* Check the used format first - GNU libc / GCC / EMX expect *) -(* "NameOffsetDstname[Dstoffset],Start[/StartHour],End[/EndHour]"; *) -(* if more than one comma (',') is found, the following format is assumed: *) -(* "NameOffsetDstname[Dstoffset],StartMonth,StartWeek,StartDay,StartSecond, *) -(* EndMonth,EndWeek,EndDay,EndSecond,DSTDifference". *) - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - S := Copy (TZ, I, J - I); - if J < Length (TZ) then - begin - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - GnuFmt := J > Length (TZ); - end - else - Exit; - if GnuFmt then - begin - ADSTStartSpecType := DSTJulian; - J := Pos ('/', S); - if J = 0 then - begin - Val (S, ADSTStartDay, Err); - if (Err > 0) or (ADSTStartDay > 365) then - Exit; - (* Use the preset default *) - ADSTStartSec := DSTStartSec; - end - else - begin - if J = Length (S) then - Exit; - Val (Copy (S, 1, Pred (J)), ADSTStartDay, Err); - if (Err > 0) or (ADSTStartDay > 365) then - Exit; - Val (Copy (S, Succ (J), Length (S) - J), ADSTStartSec, Err); - if (Err > 0) or (ADSTStartSec > 86399) then - Exit - else - ADSTStartSec := ADSTStartSec * 3600; - end; - J := I; - end - else - begin - Val (S, ADSTStartMonth, Err); - if (Err > 0) or (ADSTStartMonth > 12) then - Exit; - Val (Copy (TZ, I, J - I), ADSTStartWeek, Err); - if (Err > 0) or (ADSTStartWeek < -1) or (ADSTStartWeek > 5) or - (J >= Length (TZ)) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartDay, Err); - if (DSTStartWeek = 0) then - begin - if (Err > 0) or (ADSTStartDay < 1) or (ADSTStartDay > 31) - or (ADSTStartDay > 30) and (ADSTStartMonth in [4, 6, 9, 11]) - or (ADSTStartMonth = 2) and (ADSTStartDay > 29) then - Exit; - ADSTStartSpecType := DSTMonthDay; - end - else - begin - if (Err > 0) or (ADSTStartDay < 0) or (ADSTStartDay > 6) then - Exit; - ADSTStartSpecType := DSTMonthWeekDay; - end; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTStartSec, Err); - if (Err > 0) or (ADSTStartSec > 86399) or (J >= Length (TZ)) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndMonth, Err); - if (Err > 0) or (ADSTEndMonth > 12) or (J >= Length (TZ)) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndWeek, Err); - if (Err > 0) or (ADSTEndWeek < -1) or (ADSTEndWeek > 5) - or (J >= Length (TZ)) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndDay, Err); - if (DSTEndWeek = 0) then - begin - if (Err > 0) or (ADSTEndDay < 1) or (ADSTEndDay > 31) - or (ADSTEndDay > 30) and (ADSTEndMonth in [4, 6, 9, 11]) - or (ADSTEndMonth = 2) and (ADSTEndDay > 29) then - Exit; - ADSTEndSpecType := DSTMonthDay; - end - else - begin - if (Err > 0) or (ADSTEndDay < 0) or (ADSTEndDay > 6) then - Exit; - ADSTEndSpecType := DSTMonthWeekDay; - end; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> ',') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndSec, Err); - if (Err > 0) or (ADSTEndSec > 86399) or (J >= Length (TZ)) then - Exit; - Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTChangeSec, Err); - if (Err = 0) and (ADSTChangeSec < 86400) then - begin -(* Format complete, all checks successful => accept the parsed values. *) - DSTStartMonth := ADSTStartMonth; - DSTStartWeek := ADSTStartWeek; - DSTStartDay := ADSTStartDay; - DSTStartSec := ADSTStartSec; - DSTEndMonth := ADSTEndMonth; - DSTEndWeek := ADSTEndWeek; - DSTEndDay := ADSTEndDay; - DSTEndSec := ADSTEndSec; - DSTStartSpecType := ADSTStartSpecType; - DSTEndSpecType := ADSTEndSpecType; - DSTOffset := TZOffset - ADSTChangeSec; - end; -(* Parsing finished *) - Exit; - end; - end; - end; -(* GnuFmt - DST end specification *) - if TZ [J] = 'M' then - begin -(* Mmonth.week.dayofweek *) - ADSTEndSpecType := DSTMonthWeekDay; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do - Inc (J); - if (J >= Length (TZ)) or (TZ [J] <> '.') then - Exit; - Val (Copy (TZ, I, J - I), ADSTEndMonth, Err); - if (Err > 0) or (ADSTEndMonth > 12) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and not (TZ [J] in ['.', ',', '/']) do - Inc (J); - if (J >= Length (TZ)) or (TZ [J] <> '.') then - Exit; - Val (Copy (TZ, I, J - I), ADSTEndWeek, Err); - if (Err > 0) or (ADSTEndWeek < 1) or (ADSTEndWeek > 5) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> '/') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndDay, Err); - if (Err > 0) or (ADSTEndDay < 0) or (ADSTEndDay > 6) then - Exit; - end - else - begin - if TZ [J] = 'J' then - begin -(* Jjulianday *) - if J = Length (TZ) then - Exit; - Inc (J); - ADSTEndSpecType := DSTJulianX - end - else - ADSTEndSpecType := DSTJulian; - if J >= Length (TZ) then - Exit; - Inc (J); - I := J; - while (J <= Length (TZ)) and (TZ [J] <> '/') do - Inc (J); - Val (Copy (TZ, I, J - I), ADSTEndDay, Err); - if (Err > 0) or (ADSTEndDay = 0) and (ADSTEndSpecType = DSTJulianX) - or (ADSTEndDay > 365) then - Exit; - end; - if (J <= Length (TZ)) and (TZ [J] = '/') then - begin - if J = Length (TZ) then - Exit; - Val (Copy (TZ, Succ (J), Length (TZ) - J), ADSTEndSec, Err); - if (Err > 0) or (ADSTEndSec > 86399) then - Exit - else - ADSTEndSec := ADSTEndSec * 3600; - end - else - (* Use the preset default *) - ADSTEndSec := DSTEndSec; - -(* Format complete, all checks successful => accept the parsed values. *) - if ADSTStartSpecType = DSTMonthWeekDay then - begin - DSTStartMonth := ADSTStartMonth; - DSTStartWeek := ADSTStartWeek; - end; - DSTStartDay := ADSTStartDay; - DSTStartSec := ADSTStartSec; - if ADSTStartSpecType = DSTMonthWeekDay then - begin - DSTEndMonth := ADSTEndMonth; - DSTEndWeek := ADSTEndWeek; - end; - DSTEndDay := ADSTEndDay; - DSTEndSec := ADSTEndSec; - DSTStartSpecType := ADSTStartSpecType; - DSTEndSpecType := ADSTEndSpecType; - end; - end - else - DSTOffset := -3600 + TZOffset; - end; - end; -end; - - -begin - InitTZ; -end. diff --git a/COPYING.GPL.txt b/COPYING.GPL.txt deleted file mode 100644 index c79e32906..000000000 --- a/COPYING.GPL.txt +++ /dev/null @@ -1,340 +0,0 @@ - - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 675 Mass Ave, Cambridge, MA 02139, USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - Appendix: How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) 19yy - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) 19yy name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/README.md b/README.md new file mode 100644 index 000000000..2948a7ed5 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# The Free Manga Downloader (FMD) + +(Forked from https://sf.net/p/fmd) + +## Download the latest release + +[![Latest release](https://img.shields.io/github/release/riderkick/FMD.svg)](https://github.com/riderkick/FMD/releases/latest) [![Download latest release (Win32)](https://img.shields.io/github/downloads/riderkick/FMD/latest/fmd_0.9.158.0.7z.svg?label=Win32)](https://github.com/riderkick/FMD/releases/download/0.9.158.0/fmd_0.9.158.0.7z) [![Download latest release (Win64)](https://img.shields.io/github/downloads/riderkick/FMD/latest/fmd_0.9.158.0_Win64.7z.svg?label=Win64)](https://github.com/riderkick/FMD/releases/download/0.9.158.0/fmd_0.9.158.0_Win64.7z) + +## Content + +- [About FMD](#about-fmd) +- [Build instructions](#build-instructions) +- [Localization](#localization) + +## About FMD + +The Free Manga Downloader is a free open source application written in Object Pascal for managing and downloading manga from various websites. The source code was released under the GPLv2 license. FMD homesite is at https://github.com/riderkick/FMD or http://sf.net/p/newfmd. + +## Build instructions + +In order to build FMD from the source code, you must install the latest version of Lazarus and Free Pascal Compiler from http://www.lazarus-ide.org/. Then you must install the following 3rd party libraries and components: + + - [RichMemo](https://sourceforge.net/p/lazarus-ccr/svn/HEAD/tree/components/richmemo/) + - [Virtual TreeView](https://github.com/blikblum/VirtualTreeView-Lazarus/tree/lazarus-v4) (and `lclextensions` from the Releases page) + - [Synapse](https://sourceforge.net/p/synalist/code/HEAD/tree/trunk/) (at least revision `r160`) + - [InternetTools](https://github.com/benibela/internettools) + - [MultiLog](https://github.com/blikblum/multilog) + - [DCPCypt](https://sourceforge.net/projects/lazarus-ccr/) + +After everything is installed, open the file `md.lpi` by using Lazarus IDE. Make sure to add `ssl_openssl` to uses list of the `laz_synapse` package. +Then select `Run -> Build` to build the source code. If everything is ok, the binary file should be in `FMD_source_code_folder/bin`. + +If InternetTools fail to compile (incompatible PPU), make sure to compile them individually first. + +## Localization + +Translations are stored inside `languages` folder with `.po` extension. In order to translate FMD to your native languages you can copy `fmd.po` and rename it to `fmd.xx.po`, where `xx` stand for two-letter language code. Additionally you can add country code at the end of language code. For reference you can look at http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes and http://en.wikipedia.org/wiki/ISO_3166-1. For example `id_ID` will be recognized as `Bahasa Indonesia (Indonesia)`. To translate the content of the file you need to use translation tools like [Poedit](https://poedit.net). Once you have finished translating all of its content you can launch FMD and it will automatically detect your new languages upon startup. diff --git a/baseunits/BaseCrypto.pas b/baseunits/BaseCrypto.pas new file mode 100644 index 000000000..25c651bca --- /dev/null +++ b/baseunits/BaseCrypto.pas @@ -0,0 +1,185 @@ +unit BaseCrypto; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, base64, DCPrijndael, DCPsha256, DCPmd5, Math; + +function HexToStr(const h: String): String; +procedure HexToBytes(const h: String; var o :TBytes); +function BytesToHex(const b: TBytes): String; +function BytesToString(const b: TBytes): String; +function JSHexToStr(const h: String): String; +function StrToHexStr(const s: String): String; + +function Pkcs7AddPad(const s: String): String; +function Pkcs7RemovePad(const s: String): String; +function AESEncrpytCBCSHA256Base64Pkcs7(const s, key, iv: String): string; +function AESDecryptCBCSHA256Base64Pkcs7(const s, key, iv: String): string; +function AESDecryptCBCMD5Base64ZerosPadding(const s, key, iv: String): String; +function MD5Hex(const s: String): String; +function AESDecryptCBC(const s, key, iv: String): String; + +implementation + +function HexToStr(const h: String): String; +var + i: Integer; +begin + SetLength(Result,Length(h) div 2); + for i:=1 to Length(Result) do + Result[i]:=Char(StrToInt('$'+Copy(h,(i*2)-1,2))); +end; + +procedure HexToBytes(const h: String; var o :TBytes); +var + i, l: Integer; +begin + l:=Length(h) div 2; + SetLength(o,l); + for i:=Low(o) to High(o) do + o[i]:=Byte(StrToInt('$'+Copy(h,(i*2)+1,2))); +end; + +function BytesToHex(const b: TBytes): String; +var + i: Integer; +begin + Result:=''; + for i:=Low(b) to High(b) do + Result+=IntToHex(b[i],2); +end; + +function BytesToString(const b: TBytes): String; +var + i: Integer; +begin + Result:=''; + for i:=Low(b) to High(b) do + Result+=Char(b[i]); +end; + +function JSHexToStr(const h: String): String; +begin + Result := HexToStr(StringReplace(h, '\x', '', [rfIgnoreCase, rfReplaceAll])); +end; + +function StrToHexStr(const s: String): String; +begin + SetLength(Result, Length(s) * 2); + BinToHex(@s[1],@Result[1],Length(s)); +end; + +// Pkcs7 padding described in RFC 5652 https://tools.ietf.org/html/rfc5652#section-6.3 +function Pkcs7AddPad(const s: String): String; +var + l: Integer; +begin + Result:=s; + l:=16-(Length(s) and 15); + if l>0 then + result += StringOfChar(Char(l),l); +end; + +function Pkcs7RemovePad(const s: String): String; +begin + Result:=s; + SetLength(Result,Length(Result)-Ord(Result[Length(Result)])); +end; + +function AESEncrpytCBCSHA256Base64Pkcs7(const s, key, iv: String): string; +var + i: String; + ivb: TBytes; +begin + Result:=''; + with TDCP_rijndael.Create(nil) do + begin + try + InitStr(key,TDCP_sha256); + HexToBytes(iv,ivb); + SetIV(ivb[0]); + i:=Pkcs7AddPad(s); + SetLength(Result,Length(i)); + EncryptCBC(i[1],Result[1],Length(i)); + Burn; + Result:=EncodeStringBase64(Result); + except + end; + Free; + end; +end; + +function AESDecryptCBCSHA256Base64Pkcs7(const s, key, iv: String): string; +var + data: String; + ivb: TBytes; +begin + Result:=''; + with TDCP_rijndael.Create(nil) do + begin + try + InitStr(key,TDCP_sha256); + HexToBytes(iv,ivb); + SetIV(ivb[0]); + data:=DecodeStringBase64(s); + SetLength(Result,Length(data)); + DecryptCBC(data[1],Result[1],Length(data)); + Burn; + Result:=Pkcs7RemovePad(Result); + except + end; + Free; + end; +end; + +function AESDecryptCBC(const s, key, iv: String): String; +var + ivBytes: array[0 .. 15] of Byte; + keyBytes: TBytes; + i: Integer; +begin + Result := ''; + SetLength(keyBytes, Length(key)); + for i := 0 to Length(key)-1 do + keyBytes[i] := Byte(key[i + 1]); + + FillChar(ivBytes, 16, 0); + for i := 0 to Min(16, Length(iv)) - 1 do + ivBytes[i] := Byte(iv[i + 1]); + + with TDCP_rijndael.Create(nil) do + try + Init(keyBytes, Length(key) * 8, @ivBytes[0]); + SetLength(Result,Length(s)); + DecryptCBC(s[1],Result[1],Length(s)); + Burn; + finally + Free; + end; +end; + +function AESDecryptCBCMD5Base64ZerosPadding(const s, key, iv: String): String; +begin + Result := AESDecryptCBC(DecodeStringBase64(s), MD5Hex(key), iv); +end; + +function MD5Hex(const s: String): String; +var + h: array[0 .. 15] of Byte; +begin + with TDCP_md5.Create(nil) do + try + Init; + UpdateStr(s); + Final(h); + finally + Free; + end; + Result := LowerCase(StrToHexStr(BytesToString(h))); +end; + +end. + diff --git a/baseunits/BaseThread.pas b/baseunits/BaseThread.pas new file mode 100644 index 000000000..154315e06 --- /dev/null +++ b/baseunits/BaseThread.pas @@ -0,0 +1,60 @@ +unit BaseThread; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + + { TBaseThread } + + TBaseThread = class(TThread) + private + FOnCustomTerminate: TNotifyEvent; + function GetTerminated: Boolean; + procedure CallOnCustomTerminate; inline; + public + constructor Create(CreateSuspended: Boolean = True); + destructor Destroy; override; + procedure Terminate; + property IsTerminated: Boolean read GetTerminated; + property OnCustomTerminate: TNotifyEvent read FOnCustomTerminate write FOnCustomTerminate; + end; + +implementation + +{ TBaseThread } + +function TBaseThread.GetTerminated: Boolean; +begin + Result := Self.Terminated; +end; + +procedure TBaseThread.CallOnCustomTerminate; +begin + FOnCustomTerminate(Self); +end; + +constructor TBaseThread.Create(CreateSuspended: Boolean); +begin + inherited Create(CreateSuspended); + FreeOnTerminate := True; +end; + +destructor TBaseThread.Destroy; +begin + inherited Destroy; +end; + +procedure TBaseThread.Terminate; +begin + inherited Terminate; + if Assigned(FOnCustomTerminate) then + FOnCustomTerminate(Self); +end; + +end. + diff --git a/baseunits/CheckUpdate.pas b/baseunits/CheckUpdate.pas new file mode 100644 index 000000000..33474b785 --- /dev/null +++ b/baseunits/CheckUpdate.pas @@ -0,0 +1,141 @@ +{ + License: GPLv2 + This unit is a part of Free Manga Downloader +} + +unit CheckUpdate; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, uBaseUnit, FMDOptions, httpsendthread, + BaseThread, SelfUpdater, fileinfo; + +type + + TCheckUpdateThread = class(TBaseThread) + private + FHTTP: THTTPSendThread; + FNewVersionNumber: TProgramVersion; + FNewVersionString: String; + FUpdateURL: String; + FChangelog: String; + procedure MainThreadUpdate; + procedure SyncStartUpdate; + procedure SyncEndUpdate; + protected + procedure Execute; override; + public + constructor Create; + destructor Destroy; override; + end; + +resourcestring + RS_NewVersionFound = 'New Version found!'; + RS_CurrentVersion = 'Installed Version'; + RS_LatestVersion = 'Latest Version '; + RS_BtnCheckUpdates = 'Check for latest version'; + +implementation + +uses + frmMain, frmUpdateDialog, FMDVars; + +{ TCheckUpdateThread } + +procedure TCheckUpdateThread.MainThreadUpdate; +begin + if IsDlgCounter then Exit; + with TUpdateDialogForm.Create(MainForm) do try + Caption := Application.Title + ' - ' + RS_NewVersionFound; + with mmLog.Lines do + begin + BeginUpdate; + try + Clear; + Add(RS_CurrentVersion + ' : ' + FMD_VERSION_STRING); + Add(RS_LatestVersion + ' : ' + FNewVersionString + LineEnding); + AddText(FChangelog); + finally + EndUpdate; + end; + end; + if ShowModal = mrYes then + begin + with TSelfUpdaterThread.Create do + begin + UpdateURL := FUpdateURL; + NewVersionString := FNewVersionString; + Start; + end; + end + else + MainForm.btCheckLatestVersion.Caption := RS_BtnCheckUpdates; + finally + Free; + end; +end; + +procedure TCheckUpdateThread.SyncStartUpdate; +begin + with MainForm.btCheckLatestVersion do + begin + MainForm.btAbortCheckLatestVersion.Visible := True; + Width := Width - MainForm.btAbortCheckLatestVersion.Width - 4; + Caption := RS_Checking; + end; +end; + +procedure TCheckUpdateThread.SyncEndUpdate; +begin + with MainForm.btCheckLatestVersion do + begin + MainForm.btAbortCheckLatestVersion.Visible := False; + Width := Width + MainForm.btAbortCheckLatestVersion.Width + 4; + Caption := RS_BtnCheckUpdates; + end; +end; + +procedure TCheckUpdateThread.Execute; +begin + FNewVersionString := ''; + FUpdateURL := ''; + FChangelog := ''; + Synchronize(@SyncStartUpdate); + if not Terminated and FHTTP.Get(UPDATE_URL) then + with TStringList.Create do try + LoadFromStream(FHTTP.Document); + if Count <> 0 then begin + NameValueSeparator := '='; + FNewVersionString := Trim(Values['VERSION']); + if not TryStrToProgramVersion(FNewVersionString, FNewVersionNumber) then + FNewVersionNumber := StrToProgramVersion('0.0.0.0'); + if NewerVersion(FNewVersionNumber, FMD_VERSION_NUMBER) then + FUpdateURL := Trim(Values[UpperCase(FMD_TARGETOS)]); + end; + finally + Free; + end; + if not Terminated and (FUpdateURL <> '') and FHTTP.Get(CHANGELOG_URL) then + FChangelog := StreamToString(FHTTP.Document); + Synchronize(@SyncEndUpdate); + if not Terminated and (FUpdateURL <> '') and (not isDlgCounter) then + Synchronize(@MainThreadUpdate); +end; + +constructor TCheckUpdateThread.Create; +begin + inherited Create(False); + FHTTP := THTTPSendThread.Create(Self); +end; + +destructor TCheckUpdateThread.Destroy; +begin + FHTTP.Free; + CheckUpdateThread := nil; + inherited Destroy; +end; + +end. diff --git a/baseunits/DBDataProcess.pas b/baseunits/DBDataProcess.pas new file mode 100644 index 000000000..e3f06d99c --- /dev/null +++ b/baseunits/DBDataProcess.pas @@ -0,0 +1,1192 @@ +{ + License: GPLv2 + This unit is a part of Free Manga Downloader +} + +unit DBDataProcess; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LazFileUtils, FMDOptions, MultiLog, sqlite3conn, + sqlite3backup, sqlite3dyn, sqldb, DB, RegExpr; + +type + + { TDBDataProcess } + + TDBDataProcess = class(TObject) + private + FConn: TSQLite3Connection; + FTrans: TSQLTransaction; + FQuery: TSQLQuery; + FRegxp: TRegExpr; + FWebsite: String; + FTableName: String; + FRecordCount: Integer; + FFiltered: Boolean; + FFilterAllSites: Boolean; + FFilterApplied: Boolean; + FAllSitesAttached: Boolean; + FSitesList: TStringList; + FAttachedSites: TStringList; + FSQLSelect: String; + FFilterSQL: String; + FLinks: TStringList; + FRecNo: Integer; + function GetLinkCount: Integer; + procedure ResetRecNo(Dataset: TDataSet); + procedure GoToRecNo(const ARecIndex: Integer); + protected + procedure CreateTable; + procedure ConvertNewTable; + procedure VacuumTable; + procedure GetRecordCount; + procedure AddSQLCond(const sqltext: String; useOR: Boolean = False); + procedure AddSQLSimpleFilter(const fieldname, Value: String; + useNOT: Boolean = False; useOR: Boolean = False; useRegexp: Boolean = False); + function GetConnected: Boolean; + function InternalOpen(const FilePath: String = ''): Boolean; + function GetWebsiteName(RecIndex: Integer): String; + function GetValue(RecIndex, FieldIndex: Integer): String; + function GetValueInt(RecIndex, FieldIndex: Integer): Integer; + procedure AttachAllSites; + procedure DetachAllSites; + function ExecuteDirect(SQL: String): Boolean; + public + constructor Create; + destructor Destroy; override; + + function Connect(AWebsite: String): Boolean; + function Open(AWebsite: String = ''): Boolean; + function OpenTable(const ATableName: String = ''; + CheckRecordCount: Boolean = False): Boolean; + function TableExist(const ATableName: String): Boolean; + function Search(ATitle: String): Boolean; + function CanFilter(const checkedGenres, uncheckedGenres: TStringList; + const stTitle, stAuthors, stArtists, stStatus, stSummary: String; + const {%H-}minusDay: Integer; + const haveAllChecked, searchNewManga: Boolean): Boolean; + function Filter(const checkedGenres, uncheckedGenres: TStringList; + const stTitle, stAuthors, stArtists, stStatus, stSummary: String; + const minusDay: Integer; const haveAllChecked, searchNewManga: Boolean; + useRegExpr: Boolean = False): Boolean; + function WebsiteLoaded(const AWebsite: String): Boolean; + function LinkExist(ALink: String): Boolean; + + procedure InitLocateLink; + procedure DoneLocateLink; + procedure CreateDatabase(AWebsite: String = ''); + procedure GetFieldNames(List: TStringList); + procedure Close; + procedure CloseTable; + procedure Save; + procedure Backup(AWebsite: String); + procedure Refresh(RecheckDataCount: Boolean = False); + function AddData(Const Title, Link, Authors, Artists, Genres, Status, Summary: String; + NumChapter, JDN: Integer): Boolean; overload; + function AddData(Const Title, Link, Authors, Artists, Genres, Status, Summary: String; + NumChapter: Integer; JDN: TDateTime): Boolean; overload; inline; + function UpdateData(Const Title, Link, Authors, Artists, Genres, Status, Summary: String; + NumChapter: Integer; AWebsite: String = ''): Boolean; + function DeleteData(const RecIndex: Integer): Boolean; + procedure Commit; + procedure Rollback; + procedure RemoveFilter; + procedure Sort; + + property Website: String read FWebsite write FWebsite; + property TableName: String read FTableName write FTableName; + property Connected: Boolean read GetConnected; + property RecordCount: Integer read FRecordCount; + property Filtered: Boolean read FFiltered; + property FilterAllSites: Boolean read FFilterAllSites write FFilterAllSites; + property SitesList: TStringList read FSitesList write FSitesList; + property WebsiteName[RecIndex: Integer]: String read GetWebsiteName; + property Value[RecIndex, FieldIndex: Integer]: String read GetValue; default; + property ValueInt[RecIndex, FieldIndex: Integer]: Integer read GetValueInt; + property LinkCount: Integer read GetLinkCount; + property Connection: TSQLite3Connection read FConn; + property Transaction: TSQLTransaction read FTrans; + property Table: TSQLQuery read FQuery; + end; + +const + DBDataProcessParam = '"link","title","authors","artists","genres","status","summary","numchapter","jdn"'; + DBDataProcessParams: array [0..8] of ShortString = + ('link', 'title', 'authors', 'artists', 'genres', 'status', + 'summary', 'numchapter', 'jdn'); + DBTempFieldWebsiteIndex = Length(DBDataProcessParams); + DBDataProccesCreateParam = + '"link" TEXT NOT NULL PRIMARY KEY,' + + '"title" TEXT,' + + '"authors" TEXT,' + + '"artists" TEXT,' + + '"genres" TEXT,' + + '"status" TEXT,' + + '"summary" TEXT,' + + '"numchapter" INTEGER,' + + '"jdn" INTEGER'; + +function DBDataFilePath(const AWebsite: String): String; +function DataFileExist(const AWebsite: String): Boolean; +procedure CopyDBDataProcess(const AWebsite, NWebsite: String); +function DeleteDBDataProcess(const AWebsite: String): Boolean; +procedure OverwriteDBDataProcess(const AWebsite, NWebsite: String); + +implementation + +uses + uBaseUnit; + +function NaturalCompareCallback({%H-}user: pointer; len1: longint; + data1: pointer; len2: longint; data2: pointer): longint; cdecl; +var + s1, s2: String; +begin + SetString(s1, data1, len1); + SetString(s2, data2, len2); + Result := NaturalCompareStr(s1, s2); +end; + +procedure RegexCallback(context: PSqlite3_Context; argc: longint; + argv: PPSqlite3_Value); cdecl; +var + regexp, Text: PChar; + regex: TRegExpr; +begin + if sqlite3_user_data(context) = nil then + begin + sqlite3_result_int64(context, 0); + Exit; + end; + if argc <> 2 then + begin + sqlite3_result_int64(context, 0); + Exit; + end; + regexp := sqlite3_value_text(argv[0]); + Text := sqlite3_value_text(argv[1]); + if (regexp = nil) or (Text = nil) then + begin + sqlite3_result_int64(context, 0); + Exit; + end; + try + regex := TRegExpr(sqlite3_user_data(context)); + regex.Expression := regexp; + sqlite3_result_int64(context, int64(regex.Exec(Text))); + except + sqlite3_result_int64(context, 0); + end; +end; + +function QuotedLike(const S: String): String; +begin + Result := QuotedStr('%'+S+'%'); +end; + +function DBDataFilePath(const AWebsite: String): String; +begin + Result := DATA_FOLDER + AWebsite + DBDATA_EXT; +end; + +function DataFileExist(const AWebsite: String): Boolean; +begin + if AWebsite = '' then + Exit(False); + Result := FileExistsUTF8(DATA_FOLDER + AWebsite + DATA_EXT) or + FileExistsUTF8(DATA_FOLDER + AWebsite + DBDATA_EXT); +end; + +procedure CopyDBDataProcess(const AWebsite, NWebsite: String); +begin + if NWebsite = '' then + Exit; + if DataFileExist(AWebsite) then + begin + try + CopyFile(DATA_FOLDER + AWebsite + DBDATA_EXT, + DATA_FOLDER + NWebsite + DBDATA_EXT, + [cffPreserveTime, cffOverwriteFile], True); + except + on E: Exception do + Logger.SendException('CopyDBDataProcess.Error!', E); + end; + end; +end; + +function DeleteDBDataProcess(const AWebsite: String): Boolean; +var + tryc: Integer; +begin + Result := not FileExistsUTF8(DATA_FOLDER + AWebsite + DBDATA_EXT); + if Result = False then + begin + tryc := 0; + while not DeleteFileUTF8(DATA_FOLDER + AWebsite + DBDATA_EXT) do + begin + if tryc > 3 then + Break; + Inc(tryc); + Sleep(250); + end; + Result := not FileExistsUTF8(DATA_FOLDER + AWebsite + DBDATA_EXT); + end; +end; + +procedure OverwriteDBDataProcess(const AWebsite, NWebsite: String); +begin + if FileExistsUTF8(DATA_FOLDER + NWebsite + DBDATA_EXT) then + begin + if DeleteDBDataProcess(AWebsite) then + RenameFileUTF8(DATA_FOLDER + NWebsite + DBDATA_EXT, + DATA_FOLDER + AWebsite + DBDATA_EXT); + end; +end; + +{ TDBDataProcess } + +function TDBDataProcess.GetLinkCount: Integer; +begin + if Assigned(FLinks) then + Result := FLinks.Count + else + Result := 0; +end; + +procedure TDBDataProcess.ResetRecNo(Dataset: TDataSet); +begin + FRecNo := 0; +end; + +procedure TDBDataProcess.GoToRecNo(const ARecIndex: Integer); +begin + if FRecNo<>ARecIndex then + begin + if FRecNo=ARecIndex+1 then + FQuery.Prior + else + if FRecNo=ARecIndex-1 then + FQuery.Next + else + FQuery.RecNo:=ARecIndex+1; + FRecNo:=ARecIndex; + end; +end; + +procedure TDBDataProcess.CreateTable; +begin + if FConn.Connected then + begin + FConn.ExecuteDirect('DROP TABLE IF EXISTS ' + QuotedStrd(FTableName)); + FConn.ExecuteDirect('CREATE TABLE ' + QuotedStrd(FTableName) + ' (' + + DBDataProccesCreateParam + ');'); + FTrans.Commit; + end; +end; + +procedure TDBDataProcess.ConvertNewTable; +begin + if FQuery.Active = False then Exit; + if (FQuery.Fields[0].FieldName <> 'link') or + (FieldTypeNames[FQuery.FieldByName('title').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('link').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('authors').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('artists').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('genres').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('status').DataType] <> Fieldtypenames[ftMemo]) or + (FieldTypeNames[FQuery.FieldByName('summary').DataType] <> Fieldtypenames[ftMemo]) then + try + FQuery.Close; + with fconn do begin + ExecuteDirect('DROP TABLE IF EXISTS '+QuotedStr('temp'+FTableName)); + ExecuteDirect('CREATE TABLE '+QuotedStrd('temp'+FTableName)+ ' (' + DBDataProccesCreateParam + ')'); + ExecuteDirect('INSERT INTO '+QuotedStrd('temp'+FTableName)+' ('+DBDataProcessParam+') SELECT ' + DBDataProcessParam + ' FROM '+QuotedStrd(FTableName)); + ExecuteDirect('DROP TABLE '+QuotedStrd(FTableName)); + ExecuteDirect('ALTER TABLE '+QuotedStrd('temp'+FTableName)+' RENAME TO '+QuotedStrd(FTableName)); + end; + FTrans.Commit; + VacuumTable; + FQuery.Open; + except + FTrans.Rollback; + end; +end; + +procedure TDBDataProcess.VacuumTable; +var + queryactive: Boolean; +begin + if FConn.Connected then + begin + queryactive := FQuery.Active; + FQuery.Close; + with FConn do + begin + ExecuteDirect('END TRANSACTION'); + try + ExecuteDirect('VACUUM'); + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].VacuumTable.Error!', E); + end; + ExecuteDirect('BEGIN TRANSACTION'); + end; + if FQuery.Active <> queryactive then + FQuery.Active := queryactive; + end; +end; + +procedure TDBDataProcess.GetRecordCount; +var + bsql, s: String; + queryopen: Boolean; +begin + FRecordCount := 0; + queryopen := FQuery.Active; + if queryopen then FQuery.Close; + bsql := Trim(FQuery.SQL.Text); + if UpperCase(LeftStr(bsql, 8)) = 'SELECT *' then + begin + s := 'SELECT COUNT("link") as recordcount' + Copy(bsql, 9, Length(bsql)); + FQuery.SQL.Text := s; + FQuery.Open; + if FQuery.Active then + begin + FRecordCount := FQuery.Fields[0].AsInteger; + FQuery.Close; + end; + end; + FQuery.SQL.Text := bsql; + if FQuery.Active <> queryopen then + FQuery.Active := queryopen; +end; + +procedure TDBDataProcess.AddSQLCond(const sqltext: String; useOR: Boolean); +begin + with FQuery.SQL do + begin + if Count > 0 then + if (Strings[Count - 1] <> '(') and + (UpCase(Trim(Strings[Count - 1])) <> 'WHERE') then + begin + if useOR then + Add('OR') + else + Add('AND'); + end; + Add(sqltext); + end; +end; + +procedure TDBDataProcess.AddSQLSimpleFilter(const fieldname, Value: String; + useNOT: Boolean; useOR: Boolean; useRegexp: Boolean); +var + svalue: String; + scond: String; +begin + svalue := LowerCase(Trim(Value)); + if (fieldname = '') or (svalue = '') then + Exit; + if useNOT then + scond := ' NOT' + else + scond := ''; + if useRegexp then + AddSQLCond(QuotedStrd(fieldname) + scond + ' REGEXP ' + QuotedStr(svalue), useOR) + else + AddSQLCond(QuotedStrd(fieldname) + scond + ' LIKE ' + QuotedLike(svalue), useOR); +end; + +function TDBDataProcess.GetConnected: Boolean; +begin + Result := FConn.Connected; +end; + +function TDBDataProcess.InternalOpen(const FilePath: String): Boolean; +begin + Result := False; + if FilePath <> '' then + FConn.DatabaseName := FilePath; + if FConn.DatabaseName = '' then + Exit; + try + FConn.CharSet := 'UTF8'; + FConn.Connected := True; + sqlite3_create_collation(FConn.Handle, PChar('NATCMP'), SQLITE_UTF8, nil, + @NaturalCompareCallback); + sqlite3_create_function(FConn.Handle, PChar('REGEXP'), 2, SQLITE_UTF8, FRegxp, + @RegexCallback, nil, nil); + FTrans.Active := True; + except + on E: Exception do + begin + Logger.SendException(Self.ClassName+'['+Website+'].InternalOpen.Error!', E); + Result := False; + end; + end; + Result := FConn.Connected; +end; + +function TDBDataProcess.GetWebsiteName(RecIndex: Integer): String; +begin + Result:=FWebsite; + if FAllSitesAttached then + try + FQuery.RecNo:=RecIndex+1; + Result:=FQuery.Fields[DBTempFieldWebsiteIndex].AsString; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].GetWebsiteName Error!'+ + 'RecIndex: '+IntToStr(RecIndex), E); + end; +end; + +function TDBDataProcess.GetValue(RecIndex, FieldIndex: Integer): String; +begin + if FieldIndex in [DATA_PARAM_NUMCHAPTER,DATA_PARAM_JDN] then + Result:='0' + else + Result:=''; + if FQuery.Active=False then Exit; + try + GoToRecNo(RecIndex); + Result:=FQuery.Fields[FieldIndex].AsString; + except + end; +end; + +function TDBDataProcess.GetValueInt(RecIndex, FieldIndex: Integer): Integer; +begin + Result:=0; + if FQuery.Active=False then Exit; + if not (FieldIndex in [DATA_PARAM_NUMCHAPTER,DATA_PARAM_JDN]) then + Exit; + try + GoToRecNo(RecIndex); + Result:=FQuery.Fields[FieldIndex].AsInteger; + except + end; +end; + +procedure TDBDataProcess.AttachAllSites; + + procedure RemoveCurrentSite; + var + j: Integer; + begin + if SitesList.Count > 0 then + for j := 0 to SitesList.Count - 1 do + if SitesList[j] = FWebsite then + begin + SitesList.Delete(j); + Break; + end; + end; + +var + i: Integer; +begin + RemoveCurrentSite; + if (not FConn.Connected) or (SitesList.Count = 0) then Exit; + if Trim(SitesList.Text) = Trim(FAttachedSites.Text) then Exit; + DetachAllSites; + FConn.ExecuteDirect('END TRANSACTION'); + try + for i:=0 to SitesList.Count-1 do begin + //max attached database is 10 + //if FAttachedSites.Count=10 then Break; + if (FAttachedSites.IndexOf(SitesList[i]) = -1) and + (FileExistsUTF8(DBDataFilePath(SitesList[i]))) then + begin + FConn.ExecuteDirect('ATTACH ' + + QuotedStr(DBDataFilePath(SitesList[i])) + ' AS ' + QuotedStrd(SitesList[i])); + FAttachedSites.Add(SitesList[i]); + end; + end; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].AttachAllSites.Error!'+ + ' try to attach '+QuotedStr(SitesList[i]), E) + end; + FConn.ExecuteDirect('BEGIN TRANSACTION'); + FAllSitesAttached := FAttachedSites.Count > 0; +end; + +procedure TDBDataProcess.DetachAllSites; +var + i: Integer; + queryactive: Boolean; +begin + if (not FConn.Connected) or (FAttachedSites.Count = 0) then Exit; + queryactive := FQuery.Active; + if FQuery.Active then FQuery.Close; + FTrans.Commit; + FConn.ExecuteDirect('END TRANSACTION'); + for i := FAttachedSites.Count - 1 downto 0 do begin + try + FConn.ExecuteDirect('DETACH ' + QuotedStrd(FAttachedSites[i])); + FAttachedSites.Delete(i); + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].DetachAllSites.Error!', E); + end; + end; + FConn.ExecuteDirect('BEGIN TRANSACTION'); + FAllSitesAttached := FAttachedSites.Count > 0; + if FQuery.Active <> queryactive then FQuery.Active := queryactive; +end; + +function TDBDataProcess.ExecuteDirect(SQL: String): Boolean; +begin + Result := False; + if FConn.Connected then + try + FConn.ExecuteDirect(SQL); + Result := True; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].ExecuteDirect.Error!'#13#10 + + 'SQL: ' + SQL, E); + end; +end; + +constructor TDBDataProcess.Create; +begin + inherited Create; + FConn := TSQLite3Connection.Create(nil); + FTrans := TSQLTransaction.Create(nil); + FQuery := TSQLQuery.Create(nil); + FConn.Transaction := FTrans; + FQuery.PacketRecords := 25; + FQuery.DataBase := FTrans.DataBase; + FQuery.Transaction := FTrans; + FRegxp := TRegExpr.Create; + FRegxp.ModifierI := True; + FSitesList := TStringList.Create; + FAttachedSites := TStringList.Create; + FTableName := 'masterlist'; + FSQLSelect := 'SELECT * FROM ' + QuotedStrd(FTableName); + FRecordCount := 0; + FFiltered := False; + FFilterAllSites := False; + FFilterApplied := False; + FFilterSQL := ''; + FAllSitesAttached := False; + + ResetRecNo(nil); + FQuery.AfterOpen := @ResetRecNo; + FQuery.AfterInsert := @ResetRecNo; + FQuery.AfterDelete := @ResetRecNo; + FQuery.AfterEdit := @ResetRecNo; + FQuery.AfterRefresh := @ResetRecNo; +end; + +destructor TDBDataProcess.Destroy; +begin + try + if FConn.Connected then + begin + FQuery.Close; + Commit; + Close; + end; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Destroy.Error!', E); + end; + DoneLocateLink; + FAttachedSites.Free; + FSitesList.Free; + FQuery.Free; + FTrans.Free; + FConn.Free; + FRegxp.Free; + inherited Destroy; +end; + +function TDBDataProcess.Connect(AWebsite: String): Boolean; +var + filepath: String; +begin + Result := False; + if AWebsite <> '' then + FWebsite := AWebsite; + if FWebsite = '' then + Exit; + filepath := DATA_FOLDER + FWebsite + DBDATA_EXT; + if not FileExistsUTF8(filepath) then + Exit; + Result := InternalOpen(filepath); +end; + +function TDBDataProcess.Open(AWebsite: String): Boolean; +var + filepath: String; +begin + Result := False; + Self.Close; + if AWebsite <> '' then + FWebsite := AWebsite; + if FWebsite = '' then + Exit; + filepath := DATA_FOLDER + FWebsite + DBDATA_EXT; + if not FileExistsUTF8(filepath) then + Exit; + try + if InternalOpen(filepath) then + begin + if not TableExist(FTableName) then + CreateTable; + OpenTable(FTableName, True); + end; + Result := FQuery.Active; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Open.Error!', E); + end; +end; + +function TDBDataProcess.OpenTable(const ATableName: String; + CheckRecordCount: Boolean): Boolean; +begin + Result := False; + if FConn.Connected then + begin + try + if ATableName <> '' then + FTableName := ATableName; + if FTableName = '' then + Exit; + if TableExist(FTableName) then + begin + if FQuery.Active then + FQuery.Close; + if FTrans.Active=False then FTrans.Active:=True; + FSQLSelect := 'SELECT * FROM ' + QuotedStrd(FTableName); + FQuery.SQL.Text := FSQLSelect; + if CheckRecordCount then + GetRecordCount; + FQuery.Open; + end; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].OpenTable.Error!', E); + end; + end; + Result := FQuery.Active; + if Result then ConvertNewTable; +end; + +function TDBDataProcess.TableExist(const ATableName: String): Boolean; +var + ts: TStringList; + i: Integer; +begin + Result := False; + if FConn.Connected then + begin + ts := TStringList.Create; + try + FConn.GetTableNames(ts); + ts.Sorted := True; + Result := ts.Find(ATableName, i); + finally + ts.Free; + end; + end; +end; + +procedure TDBDataProcess.Close; +begin + FRecordCount := 0; + if FConn.Connected then + try + FQuery.Close; + RemoveFilter; + FConn.Close; + FConn.DatabaseName := ''; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Close.Error!', E); + end; +end; + +procedure TDBDataProcess.CloseTable; +begin + if FQuery.Active then + begin + FRecordCount := 0; + RemoveFilter; + FQuery.Close; + end; +end; + +procedure TDBDataProcess.Save; +begin + Commit; +end; + +procedure TDBDataProcess.Backup(AWebsite: String); +begin + if AWebsite = '' then + Exit; + if FConn.Connected then + begin + with TSQLite3Backup.Create do + try + Backup(FConn, DATA_FOLDER + AWebsite + DBDATA_EXT); + finally + Free; + end; + end; +end; + +procedure TDBDataProcess.Refresh(RecheckDataCount: Boolean); +begin + if FConn.Connected then + begin + if FQuery.Active then begin + if RecheckDataCount then + GetRecordCount; + FQuery.Refresh; + end + else + if Trim(FQuery.SQL.Text) <> '' then + begin + if RecheckDataCount then + GetRecordCount; + FQuery.Open; + end; + end; +end; + +function TDBDataProcess.AddData(const Title, Link, Authors, Artists, Genres, + Status, Summary: String; NumChapter, JDN: Integer): Boolean; +begin + Result:=False; + if Link='' then Exit; + if FConn.Connected=False then Exit; + try + FConn.ExecuteDirect( + 'INSERT INTO '+QuotedStrd(FTableName)+' ('+DBDataProcessParam+') VALUES ('+ + QuotedStr(Link)+', '+ + QuotedStr(Title)+', '+ + QuotedStr(Authors)+', '+ + QuotedStr(Artists)+', '+ + QuotedStr(Genres)+', '+ + QuotedStr(Status)+', '+ + QuotedStr(Summary)+', '+ + QuotedStr(IntToStr(NumChapter))+', '+ + QuotedStr(IntToStr(JDN))+');'); + Result:=True; + except + end; +end; + +function TDBDataProcess.AddData(const Title, Link, Authors, Artists, Genres, + Status, Summary: String; NumChapter: Integer; JDN: TDateTime): Boolean; +begin + Result := AddData(Title, Link, Authors, Artists, Genres, Status, Summary, + NumChapter, DateToJDN(JDN)); +end; + +function TDBDataProcess.UpdateData(const Title, Link, Authors, Artists, Genres, + Status, Summary: String; NumChapter: Integer; AWebsite: String): Boolean; +var + sql: String; +begin + Result:=False; + if Link='' then Exit; + if FConn.Connected=False then Exit; + try + sql:='UPDATE '; + if (AWebsite<>'') and (AWebsite<>FWebsite) and FAllSitesAttached then + sql+=QuotedStrd(AWebsite)+'.'+QuotedStrd(FTableName) + else + sql+=QuotedStrd(FTableName); + sql+=' SET "title"='+QuotedStr(Title)+ + ', "authors"='+QuotedStr(Authors)+ + ', "artists"='+QuotedStr(Artists)+ + ', "genres"='+QuotedStr(Genres)+ + ', "status"='+QuotedStr(Status)+ + ', "summary"='+QuotedStr(Summary)+ + ', "numchapter"='+QuotedStr(IntToStr(NumChapter))+ + ' WHERE ("link"='+QuotedStr(Link)+');'; + FConn.ExecuteDirect(sql); + Result:=True; + except + end; +end; + +function TDBDataProcess.DeleteData(const RecIndex: Integer): Boolean; +begin + Result := False; + try + GoToRecNo(RecIndex); + FQuery.Delete; + Dec(FRecordCount); + Result := True; + except + end; +end; + +procedure TDBDataProcess.Commit; +var + queryactive: Boolean; +begin + if FConn.Connected then + try + queryactive := FQuery.Active; + if FQuery.Active then FQuery.Close; + FTrans.Commit; + if FQuery.Active <> queryactive then + FQuery.Active := queryactive; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Commit.Error!',E); + end; +end; + +procedure TDBDataProcess.Rollback; +begin + if FConn.Connected then + try + FTrans.Rollback; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Rollback.Error!',E); + end; +end; + +function TDBDataProcess.Search(ATitle: String): Boolean; +var + i: Integer; +begin + if FQuery.Active then + begin + try + FQuery.Close; + with FQuery do + begin + SQL.Clear; + if FFilterApplied then + SQL.AddText(FFilterSQL) + else + SQL.Add(FSQLSelect); + if ATitle <> '' then + begin + if not FFilterApplied then + SQL.Add('WHERE'); + if FAllSitesAttached then + begin + if SQL.Count > 0 then + begin + i := 0; + while i < SQL.Count do + begin + if (SQL[i] = 'UNION ALL') or (SQL[i] = ')') then + begin + SQL.Insert(i, 'AND'); + SQL.Insert(i + 1, '"title" LIKE ' + QuotedLike(ATitle)); + Inc(i, 3); + end + else + Inc(i); + end; + end; + end + else + AddSQLSimpleFilter('title', ATitle); + FFiltered := True; + end + else + FFiltered := FFilterApplied; + end; + GetRecordCount; + FQuery.Open; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Search.Error!'#13#10 + + 'SQL:'#13#10 + FQuery.SQL.Text, E); + end; + end; + Result := FQuery.Active; + if not Result then + begin + FFiltered := False; + FRecordCount := 0; + end; +end; + +function TDBDataProcess.CanFilter(const checkedGenres, uncheckedGenres: TStringList; + const stTitle, stAuthors, stArtists, stStatus, stSummary: String; + const minusDay: Integer; const haveAllChecked, searchNewManga: Boolean): Boolean; +begin + Result := False; + if not FQuery.Active then + Exit; + if ((stTitle = '') and + (stAuthors = '') and + (stArtists = '') and + (stSummary = '') and + (stStatus = '2') and + (checkedGenres.Count = 0) and + (uncheckedGenres.Count = 0)) and + (not searchNewManga) and + haveAllChecked then + Result := False + else + Result := True; +end; + +function TDBDataProcess.Filter(const checkedGenres, uncheckedGenres: TStringList; + const stTitle, stAuthors, stArtists, stStatus, stSummary: String; + const minusDay: Integer; const haveAllChecked, searchNewManga: Boolean; + useRegExpr: Boolean): Boolean; +var + tsql: String; + i: Integer; + filtersingle: Boolean = True; + + procedure GenerateSQLFilter; + var + j: Integer; + begin + // filter new manga based on date + if searchNewManga then + AddSQLCond('"jdn" > ' + + QuotedStrd(IntToStr(DateToJDN(Now)-minusDay))); + + // filter title + AddSQLSimpleFilter('title', stTitle, False, False, useRegExpr); + + // filter authors + AddSQLSimpleFilter('authors', stAuthors, False, False, useRegExpr); + + // filter artists + AddSQLSimpleFilter('artists', stArtists, False, False, useRegExpr); + + // filter summary + AddSQLSimpleFilter('summary', stSummary, False, False, useRegExpr); + + // filter status + if stStatus <> '2' then + AddSQLCond('"status"=' + QuotedStrd(stStatus)); + + //filter checked genres + if checkedGenres.Count > 0 then + begin + AddSQLCond('('); + for j := 0 to checkedGenres.Count - 1 do + AddSQLSimpleFilter('genres', checkedGenres[j], False, + (not haveAllChecked), useRegExpr); + FQuery.SQL.Add(')'); + end; + + //filter unchecked genres + if uncheckedGenres.Count > 0 then + begin + AddSQLCond('('); + for j := 0 to uncheckedGenres.Count - 1 do + AddSQLSimpleFilter('genres', uncheckedGenres[j], True, + (not haveAllChecked), useRegExpr); + FQuery.SQL.Add(')'); + end; + end; + +begin + Result := False; + if FQuery.Active = False then + Exit; + if not CanFilter(checkedGenres, uncheckedGenres, stTitle, stAuthors, + stArtists, stStatus, stSummary, minusDay, haveAllChecked, searchNewManga) then + Exit; + with FQuery do + begin + FQuery.Close; + FRecordCount := 0; + tsql := SQL.Text; + SQL.Clear; + try + if FFilterAllSites and (FSitesList.Count > 0) then + begin + AttachAllSites; + if FAttachedSites.Count > 0 then + begin + SQL.Add('SELECT * FROM'); + SQL.Add('('); + SQL.Add('SELECT *, ' + QuotedStrd(FWebsite) + ' AS "website" FROM ' + + QuotedStrd(FTableName)); + SQL.Add('WHERE'); + GenerateSQLFilter; + for i := 0 to FAttachedSites.Count - 1 do + begin + SQL.Add('UNION ALL'); + SQL.Add('SELECT *, ' + QuotedStrd(FAttachedSites[i]) + + ' AS "website" FROM ' + + QuotedStrd(FAttachedSites[i]) + '.' + QuotedStrd(FTableName)); + SQL.Add('WHERE'); + GenerateSQLFilter; + end; + SQL.Add(')'); + SQL.Add('ORDER BY "title" COLLATE NATCMP'); + filtersingle := False; + end; + end; + + if filtersingle then + begin + SQL.Add(FSQLSelect); + SQL.Add('WHERE'); + GenerateSQLFilter; + end; + + Self.GetRecordCount; + FQuery.Open; + FFiltered := Active; + FFilterApplied := FFiltered; + if FFilterApplied then + FFilterSQL := SQL.Text + else + FFilterSQL := ''; + except + on E: Exception do + begin + Logger.SendException(Self.ClassName+'['+Website+'].Filter.Error!'#13#10 + + 'SQL:'#13#10 + FQuery.SQL.Text, E); + FQuery.Close; + SQL.Text := tsql; + Self.GetRecordCount; + FQuery.Open; + FFilterAllSites := False; + FFiltered := False; + FFilterApplied := False; + FFilterSQL := ''; + end; + end; + Result := FFiltered; + Result := FFiltered; + end; +end; + +procedure TDBDataProcess.CreateDatabase(AWebsite: String); +var + filepath: String; +begin + if AWebsite <> '' then FWebsite := AWebsite; + if FWebsite = '' then Exit; + Close; + filepath := DATA_FOLDER + FWebsite + DBDATA_EXT; + if FileExistsUTF8(filepath) then + DeleteFileUTF8(filepath); + if ForceDirectoriesUTF8(DATA_FOLDER) then + begin + InternalOpen(filepath); + CreateTable; + end; +end; + +procedure TDBDataProcess.GetFieldNames(List: TStringList); +begin + if (List <> nil) and (FQuery.Active) then + FQuery.GetFieldNames(List); +end; + +procedure TDBDataProcess.RemoveFilter; +begin + if FFiltered then + begin + FFilterAllSites := False; + FFiltered := False; + FFilterApplied := False; + FFilterSQL := ''; + FQuery.SQL.Text := FSQLSelect; + FRecordCount := 0; + DetachAllSites; + if FQuery.Active then + OpenTable(FTableName, True); + end; +end; + +procedure TDBDataProcess.Sort; +var + queryactive: Boolean; +begin + if FConn.Connected then + begin + queryactive := FQuery.Active; + FQuery.Close; + with FConn do + try + ExecuteDirect('DROP TABLE IF EXISTS ' + QuotedStrd(FTableName + '_ordered')); + ExecuteDirect('CREATE TABLE ' + QuotedStrd(FTableName + '_ordered') + ' (' + DBDataProccesCreateParam +')'); + ExecuteDirect('INSERT INTO '+QuotedStrd(FTableName + '_ordered') + ' (' + DBDataProcessParam + ') SELECT '+ DBDataProcessParam +' FROM ' + QuotedStrd(FTableName) + ' ORDER BY "title" COLLATE NATCMP'); + ExecuteDirect('DROP TABLE ' + QuotedStrd(FTableName)); + ExecuteDirect('ALTER TABLE ' + QuotedStrd(FTableName + '_ordered') + ' RENAME TO ' + QuotedStrd(FTableName)); + FTrans.Commit; + VacuumTable; + except + on E: Exception do + Logger.SendException(Self.ClassName+'['+Website+'].Sort.Error!', E); + end; + if FQuery.Active <> queryactive then + FQuery.Active := queryactive; + end; +end; + +function TDBDataProcess.WebsiteLoaded(const AWebsite: String): Boolean; +var + i: Integer; +begin + Result := False; + if FWebsite = AWebsite then + Exit(True); + if FAllSitesAttached then + for i := 0 to FAttachedSites.Count - 1 do + if FAttachedSites[i] = AWebsite then + begin + Result := True; + Break; + end; +end; + +function TDBDataProcess.LinkExist(ALink: String): Boolean; +var + i: Integer; +begin + if Assigned(FLinks) then + Result := FLinks.Find(ALink, i) + else + Result := False; +end; + +procedure TDBDataProcess.InitLocateLink; +begin + if Assigned(FLinks) then + FLinks.Clear + else + FLinks := TStringList.Create; + FLinks.Sorted := False; + if FQuery.Active then + begin + FQuery.First; + repeat + FLinks.Add(FQuery.Fields[1].AsString); + FQuery.Next; + until FQuery.EOF; + if FLinks.Count > 0 then + FLinks.Sorted := True; + end; +end; + +procedure TDBDataProcess.DoneLocateLink; +begin + if Assigned(FLinks) then + FreeAndNil(FLinks); +end; + +end. diff --git a/baseunits/DBUpdater.pas b/baseunits/DBUpdater.pas new file mode 100644 index 000000000..80f90fd15 --- /dev/null +++ b/baseunits/DBUpdater.pas @@ -0,0 +1,408 @@ +unit DBUpdater; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, httpsendthread, BaseThread, FMDOptions, process, ComCtrls, + Controls, Dialogs, StdCtrls, Buttons, blcksock; + +type + + { TDBUpdaterThread } + + TDBUpdaterThread = class(TBaseThread) + private + FStatusBar: TStatusBar; + FProgressBar: TProgressBar; + FButtonCancel: TSpeedButton; + FHTTP: THTTPSendThread; + FTotalSize: Integer; + FCurrentSize: Integer; + FCurrentName: String; + FFailedList: TStringList; + FCurrentId: Integer; + FStatusText: String; + protected + procedure ButtonCancelClick(Sender: TObject); + procedure HTTPSockOnStatus(Sender: TObject; Reason: THookSocketReason; + const Value: String); + procedure HTTPRedirected(const AHTTP: THTTPSendThread; const URL: String); + protected + procedure SyncStart; + procedure SyncFinal; + procedure SyncStartDownload; + procedure SyncUpdateProgress; + procedure SyncUpdateStatus; + procedure SyncUpdateHint; + procedure SyncShowFailed; + procedure SyncCloseUsed; + procedure SyncReopenUsed; + procedure SyncRemoveAttached; + procedure UpdateStatusText(const S: String); + procedure Execute; override; + public + Items: TStringList; + constructor Create; + destructor Destroy; override; + procedure Add(const S: String); overload; + procedure Add(const S: TStrings); overload; + procedure UpdateStatus; // should be called from mainthread + end; + +resourcestring + RS_Downloading = 'Downloading %s'; + RS_FailedItemsTitle = 'Failed'; + RS_FailedItems = 'Failed to finish:'#13#10#13#10'%s'; + RS_FailedDownload = '%s: %d %s'; + RS_FailedToSave = '%s: failed to save'; + RS_MissingZipExe = '%s: Missing %s'; + RS_Extracting = 'Extracting %s'; + RS_FailedExtract = '%s: failed to extract, exitstatus = %d'; + RS_ButtonCancel = 'Abort'; + +implementation + +uses FMDVars, LazFileUtils; + +function GetDBURL(const AName: String): String; +begin + if Pos('', AnsiLowerCase(DB_URL)) <> -1 then + Result := StringReplace(DB_URL, '', AName, [rfIgnoreCase, rfReplaceAll]) + else + Result := AName; +end; + +{ TDBUpdaterThread } + +procedure TDBUpdaterThread.ButtonCancelClick(Sender: TObject); +begin + Self.Terminate; +end; + +procedure TDBUpdaterThread.HTTPSockOnStatus(Sender: TObject; + Reason: THookSocketReason; const Value: String); +begin + if Terminated then + Exit; + if Reason = HR_ReadCount then + begin + if FTotalSize = 0 then + FTotalSize := StrToIntDef(Trim(FHTTP.Headers.Values['Content-Length']), 0); + Inc(FCurrentSize, StrToInt(Value)); + Synchronize(@SyncUpdateProgress); + end + else + if Reason = HR_Connect then + begin + FCurrentSize := 0; + FTotalSize := 0; + end; +end; + +procedure TDBUpdaterThread.HTTPRedirected(const AHTTP: THTTPSendThread; + const URL: String); +begin + UpdateStatusText(Format('[%d/%d] ' + RS_Downloading, + [FCurrentId + 1, Items.Count, FCurrentName + DBDATA_EXT + ' ' + URL])); +end; + +procedure TDBUpdaterThread.SyncStart; +begin + DBUpdaterThread := Self; + + FStatusBar := TStatusBar.Create(FormMain); + with FStatusBar do + begin + Parent := FormMain; + SimplePanel := False; + with Panels.Add do // panel for progress bar + Width := 100; + Panels.Add; // panel for progress text + Panels.Add; // panel for status text + end; + + FProgressBar := TProgressBar.Create(FormMain); + with FProgressBar do + begin + Parent := FStatusBar; + Align := alNone; + Smooth := True; + Style := pbstNormal; + Min := 0; + Width := FStatusBar.Panels[0].Width - 10; + Anchors := [akTop, akLeft, akBottom]; + AnchorSideTop.Control := FStatusBar; + AnchorSideTop.Side := asrTop; + AnchorSideLeft.Control := FStatusBar; + AnchorSideLeft.Side := asrTop; + AnchorSideBottom.Control := FStatusBar; + AnchorSideBottom.Side := asrBottom; + BorderSpacing.Top := 2; + BorderSpacing.Left := 5; + BorderSpacing.Bottom := 2; + end; + + FButtonCancel := TSpeedButton.Create(FormMain); + with FButtonCancel do + begin + Parent := FStatusBar; + Align := alNone; + AutoSize := True; + Caption := RS_ButtonCancel; + ShowCaption := True; + Flat := True; + Anchors := [akTop, akRight, akBottom]; + AnchorSideTop.Control := FStatusBar; + AnchorSideTop.Side := asrTop; + AnchorSideRight.Control := FStatusBar; + AnchorSideRight.Side := asrRight; + AnchorSideBottom.Control := FStatusBar; + AnchorSideBottom.Side := asrBottom; + BorderSpacing.Top := 2; + BorderSpacing.Right := 5; + BorderSpacing.Bottom := 2; + OnClick := @ButtonCancelClick; + end; +end; + +procedure TDBUpdaterThread.SyncFinal; +begin + DBUpdaterThread := nil; + FHTTP.Sock.OnStatus := nil; + FreeAndNil(FStatusBar); + FreeAndNil(FProgressBar); + FreeAndNil(FButtonCancel); +end; + +procedure TDBUpdaterThread.SyncStartDownload; +begin + FCurrentSize := 0; + FTotalSize := 0; + FProgressBar.Max := 0; + FProgressBar.Position := 0; + FStatusBar.Panels[1].Text := ''; + FStatusBar.Panels[1].Width := 0; + FStatusBar.Panels[2].Text := Format('[%d/%d] ' + RS_Downloading, + [FCurrentId + 1, Items.Count, + FCurrentName + DBDATA_EXT]); +end; + +procedure TDBUpdaterThread.SyncUpdateProgress; +var + s: String; +begin + if FStatusBar = nil then + Exit; + if FProgressBar.Max <> FTotalSize then + FProgressBar.Max := FTotalSize; + if FProgressBar.Position <> FCurrentSize then + FProgressBar.Position := FCurrentSize; + + s := FormatByteSize(FCurrentSize); + if FTotalSize <> 0 then + s += '/' + FormatByteSize(FTotalSize); + FStatusBar.Panels[1].Width := FStatusBar.Canvas.TextWidth(s) + 10; + FStatusBar.Panels[1].Text := s; +end; + +procedure TDBUpdaterThread.SyncUpdateStatus; +begin + FStatusBar.Panels[2].Text := FStatusText; +end; + +procedure TDBUpdaterThread.SyncUpdateHint; +begin + FStatusBar.Hint := Trim(Items.Text); +end; + +procedure TDBUpdaterThread.SyncShowFailed; +begin + MessageDlg(RS_FailedItemsTitle, Format(RS_FailedItems, [FFailedList.Text]), + mtError, [mbOK], 0); +end; + +procedure TDBUpdaterThread.SyncCloseUsed; +begin + FormMain.edMangaListSearch.Clear; + FormMain.vtMangaList.Clear; + dataProcess.Close; +end; + +procedure TDBUpdaterThread.SyncReopenUsed; +begin + FormMain.OpenDataDB(FCurrentName); +end; + +procedure TDBUpdaterThread.SyncRemoveAttached; +begin + dataProcess.RemoveFilter; +end; + +procedure TDBUpdaterThread.UpdateStatusText(const S: String); +begin + if FStatusText = S then + Exit; + FStatusText := S; + Synchronize(@SyncUpdateStatus); +end; + +procedure TDBUpdaterThread.Execute; +var + currentfilename, lurl: String; + cont: Boolean; + used: Boolean; +begin + FCurrentId := 0; + Synchronize(@SyncUpdateHint); + while FCurrentId < Items.Count do + begin + if Terminated then + Break; + try + FCurrentName := Items[FCurrentId]; + Synchronize(@SyncStartDownload); + lurl := GetDBURL(FCurrentName); + if FHTTP.GET(GetDBURL(FCurrentName)) and (FHTTP.ResultCode < 300) then + begin + cont := True; + // save to data folder + ForceDirectoriesUTF8(DATA_FOLDER); + currentfilename := DATA_FOLDER + FCurrentName + DBDATA_SERVER_EXT; + if FileExists(currentfilename) then + DeleteFile(currentfilename); + if not FileExists(currentfilename) then + begin + FHTTP.Document.SaveToFile(currentfilename); + if not FileExists(currentfilename) then + begin + FFailedList.Add(Format(RS_FailedToSave, [FCurrentName])); + cont := False; + end; + end + else + begin + FFailedList.Add(Format(RS_FailedToSave, [FCurrentName])); + cont := False; + end; + + if cont and (not FileExists(CURRENT_ZIP_EXE)) then + begin + FFailedList.Add(Format(RS_MissingZipExe, [FCurrentName, ZIP_EXE])); + cont := False; + end; + + if cont then + begin + // close and reopen current used + used := FCurrentName = + FormMain.cbSelectManga.Items[FormMain.cbSelectManga.ItemIndex]; + + if used then + Synchronize(@SyncCloseUsed) + else + if dataProcess.WebsiteLoaded(FCurrentName) then + Synchronize(@SyncRemoveAttached); + with TProcess.Create(nil) do + try + UpdateStatusText(Format('[%d/%d] ' + RS_Extracting, + [FCurrentId + 1, Items.Count, + FCurrentName + DBDATA_EXT])); + Executable := CURRENT_ZIP_EXE; + CurrentDirectory := FMD_DIRECTORY; + Parameters.Add('x'); // extract + Parameters.Add(currentfilename); // input + Parameters.Add('-o' + AnsiQuotedStr(DATA_FOLDER, '"')); // destination + Parameters.Add('-aoa'); // overwrite all + Options := Options + [poWaitOnExit]; + ShowWindow := swoHIDE; + Execute; + cont := ExitStatus = 0; + if cont then + DeleteFile(currentfilename) + else + FFailedList.Add(RS_FailedExtract, [FCurrentName, ExitStatus]); + finally + Free; + end; + if cont and used then + Synchronize(@SyncReopenUsed); + end; + end + else + FFailedList.Add(Format(RS_FailedDownload, [FCurrentName, FHTTP.ResultCode, + FHTTP.ResultString])); + except + on E: Exception do + FFailedList.Add(E.Message); + end; + Inc(FCurrentId); + end; +end; + +constructor TDBUpdaterThread.Create; +begin + inherited Create(True); + FreeOnTerminate := True; + FFailedList := TStringList.Create; + FHTTP := THTTPSendThread.Create(Self); + FHTTP.UserAgent := UserAgentCURL; + FHTTP.Sock.OnStatus := @HTTPSockOnStatus; + FHTTP.OnRedirected:=@HTTPRedirected; + Items := TStringList.Create; + Synchronize(@SyncStart); +end; + +destructor TDBUpdaterThread.Destroy; +begin + if (not Terminated) and (FFailedList.Count <> 0) then + Synchronize(@SyncShowFailed); + Synchronize(@SyncFinal); + FHTTP.Free; + FFailedList.Free; + FreeAndNil(Items); + inherited Destroy; +end; + +procedure TDBUpdaterThread.Add(const S: String); +var + i: Integer; +begin + if Items = nil then Exit; + // search on not sorted + for i := 0 to Items.Count - 1 do + if S = Items[i] then + Exit; + Items.Add(S); + UpdateStatus; +end; + +procedure TDBUpdaterThread.Add(const S: TStrings); +var + i, j, jmax: Integer; +begin + if Items = nil then Exit; + // search on not sorted + jmax := Items.Count; + for i := 0 to S.Count - 1 do + begin + j := 0; + while j < jmax do + if S[i] = Items[j] then + Break + else + Inc(j); + if j = jmax then + Items.Add(S[i]); + end; + UpdateStatus; +end; + +procedure TDBUpdaterThread.UpdateStatus; +begin + SyncUpdateStatus; + SyncUpdateHint; +end; + +end. diff --git a/baseunits/DownloadedChaptersDB.pas b/baseunits/DownloadedChaptersDB.pas new file mode 100644 index 000000000..3c0604a14 --- /dev/null +++ b/baseunits/DownloadedChaptersDB.pas @@ -0,0 +1,140 @@ +unit DownloadedChaptersDB; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, SQLiteData, uBaseUnit, LazFileUtils; + +type + + { TDownloadedChaptersDB } + + TDownloadedChaptersDB = class(TSQliteData) + private + locklocate: TRTLCriticalSection; + function GetChapters(const AWebsiteLink: String): String; + procedure SetChapters(const AWebsiteLink: String; AValue: String); + public + constructor Create; + destructor Destroy; override; + procedure Delete(const AWebsiteLink: String); + property Chapters[const AWebsiteLink: String]: String read GetChapters write SetChapters; + function ImportFromIni(const AFilename: String): Boolean; + end; + +implementation + +function CleanStr(const S: String): String; +begin + Result := LowerCase(Trim(S)); + if Pos(' ', Result) > 0 then + Result := StringReplace(Result, ' ', '', [rfReplaceAll]); + while Pos(LineEnding + LineEnding, Result) > 0 do + Result := StringReplace(Result, LineEnding + LineEnding, LineEnding, [rfReplaceAll]); +end; + +{ TDownloadedChaptersDB } + +function TDownloadedChaptersDB.GetChapters(const AWebsiteLink: String): String; +begin + Result := ''; + if AWebsiteLink = '' then Exit; + if not Connected then Exit; + EnterCriticalsection(locklocate); + with Table do + try + if Locate('websitelink', LowerCase(AWebsiteLink), []) then + Result := Fields[1].AsString; + finally + LeaveCriticalsection(locklocate); + end; +end; + +procedure TDownloadedChaptersDB.SetChapters(const AWebsiteLink: String; AValue: String); +begin + if AWebsiteLink = '' then Exit; + if AValue = '' then Exit; + if not Connected then Exit; + EnterCriticalsection(locklocate); + with Table do + try + if Locate('websitelink', LowerCase(AWebsiteLink), []) then + begin + Edit; + Fields[1].AsString := MergeCaseInsensitive([Fields[1].AsString, AValue]); + end + else + begin + Append; + Fields[0].AsString := LowerCase(AWebsiteLink); + Fields[1].AsString := AValue; + end; + try + Post; + except + CancelUpdates; + end; + finally + LeaveCriticalsection(locklocate); + end; +end; + +constructor TDownloadedChaptersDB.Create; +begin + inherited Create; + InitCriticalSection(locklocate); + AutoApplyUpdates := True; + TableName := 'downloadedchapters'; + CreateParams := + '"websitelink" VARCHAR(3000) NOT NULL PRIMARY KEY,' + + '"chapters" TEXT'; + FieldsParams := '"websitelink","chapters"'; + SelectParams := 'SELECT ' + FieldsParams + ' FROM ' + QuotedStrD(TableName); +end; + +destructor TDownloadedChaptersDB.Destroy; +begin + inherited Destroy; + DoneCriticalsection(locklocate); +end; + +procedure TDownloadedChaptersDB.Delete(const AWebsiteLink: String); +begin + if not Connected then Exit; + EnterCriticalsection(locklocate); + with Table do + try + if Locate('websitelink', LowerCase(AWebsiteLink), []) then + Delete; + finally + LeaveCriticalsection(locklocate); + end; +end; + +function TDownloadedChaptersDB.ImportFromIni(const AFilename: String): Boolean; +var + dc: TStringList; + i: Integer = 0; +begin + Result := False; + if not Connected then Exit; + if not FileExistsUTF8(AFilename) then Exit; + dc := TStringList.Create; + try + dc.LoadFromFile(AFilename); + if dc.Count > 0 then + while i <= dc.Count - 2 do + begin + Chapters[dc[i]] := RemoveHostFromURL(GetParams(dc[i + 1])); + Inc(i, 2); + end; + Result := True; + finally + dc.Free; + end; +end; + +end. + diff --git a/baseunits/DownloadsDB.pas b/baseunits/DownloadsDB.pas new file mode 100644 index 000000000..ef35063a3 --- /dev/null +++ b/baseunits/DownloadsDB.pas @@ -0,0 +1,238 @@ +unit DownloadsDB; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, SQLiteData, uBaseUnit, sqlite3dyn; + +type + + { TDownloadsDB } + + TDownloadsDB = class(TSQliteData) + private + FCommitCount: Integer; + FAutoCommitCount: Integer; + procedure SetAutoCommitCount(AValue: Integer); + public + constructor Create(const AFilename: String); + function Open: Boolean; + function Add(var Adlid: Integer; + const Aenabled: Boolean; + const Aorder, Ataskstatus, Achapterptr, Anumberofpages, Acurrentpage: Integer; + const Awebsite, Alink, Atitle, Astatus, Aprogress, Asaveto: String; + const Adatetime: TDateTime; + const Achapterslinks, Achaptersnames, Apagelinks, Apagecontainerlinks, Afilenames, Acustomfilenames, + Achaptersstatus: String): Boolean; + procedure Delete(const ADlId: Integer); + procedure Commit; override; + procedure Close; override; + property AutoCommitCount: Integer read FAutoCommitCount write SetAutoCommitCount; + end; + +const + f_dlid = 0; + f_enabled = 1; + f_order = 2; + f_taskstatus = 3; + f_chapterptr = 4; + f_numberofpages = 5; + f_currentpage = 6; + f_website = 7; + f_link = 8; + f_title = 9; + f_status = 10; + f_progress = 11; + f_saveto = 12; + f_datetime = 13; + f_chapterslinks = 14; + f_chaptersnames = 15; + f_pagelinks = 16; + f_pagecontainerlinks = 17; + f_filenames = 18; + f_customfilenames = 19; + f_chaptersstatus = 20; + +implementation + +{ TDownloadsDB } + +procedure TDownloadsDB.SetAutoCommitCount(AValue: Integer); +begin + if FAutoCommitCount = AValue then Exit; + FAutoCommitCount := AValue; +end; + +constructor TDownloadsDB.Create(const AFilename: String); +begin + inherited Create; + FCommitCount := 0; + FAutoCommitCount := 300; + Filename := AFilename; + TableName := 'downloads'; + Table.PacketRecords := 1; + CreateParams := + '"dlid" INTEGER PRIMARY KEY,' + + '"enabled" BOOLEAN,' + + '"order" INTEGER,' + + '"taskstatus" INTEGER,' + + '"chapterptr" INTEGER,' + + '"numberofpages" INTEGER,' + + '"currentpage" INTEGER,' + + '"website" TEXT,' + + '"link" TEXT,' + + '"title" TEXT,' + + '"status" TEXT,' + + '"progress" TEXT,' + + '"saveto" TEXT,' + + '"datetime" DATETIME,' + + '"chapterslinks" TEXT,' + + '"chaptersnames" TEXT,' + + '"pagelinks" TEXT,' + + '"pagecontainerlinks" TEXT,' + + '"filenames" TEXT,' + + '"customfilenames" TEXT,' + + '"chaptersstatus" TEXT'; + FieldsParams := '"dlid","enabled","order","taskstatus","chapterptr","numberofpages","currentpage","website","link","title","status","progress","saveto","datetime","chapterslinks","chaptersnames","pagelinks","pagecontainerlinks","filenames","customfilenames","chaptersstatus"'; + SelectParams := 'SELECT ' + FieldsParams + ' FROM '+QuotedStrD(TableName)+' ORDER BY "order"'; +end; + +function TDownloadsDB.Open: Boolean; +begin + Result := inherited Open(False, False); + Table.SQL.Text := 'SELECT * FROM ' + QuotedStrD(TableName); + Table.Open; + if Table.Active then + begin + // convert table, replace failedchapterlink, failedchaptername with chaptersstatus + if (Table.Fields.Count = 22) and (Table.Fields[20].FieldName = 'failedchapterlinks') then + begin + Table.Close; + with Connection do + begin + ExecuteDirect('DROP TABLE IF EXISTS ' + QuotedStrD('temp' + TableName)); + ExecuteDirect('CREATE TABLE ' + QuotedStrD('temp' + TableName) + ' (' + CreateParams + ')'); + ExecuteDirect('INSERT INTO ' + QuotedStrD('temp' + TableName) + ' (' + FieldsParams + ') SELECT ' + + '"dlid","enabled","order","taskstatus","chapterptr","numberofpages","currentpage","website","link","title","status","progress","saveto","datetime","chapterslinks"||"failedchapterlinks","chaptersnames"||"failedchapternames","pagelinks","pagecontainerlinks","filenames","customfilenames",""' + + ' FROM "' + TableName + '"'); + ExecuteDirect('DROP TABLE ' + QuotedStrD(TableName)); + ExecuteDirect('ALTER TABLE ' + QuotedStrD('temp' + TableName) + ' RENAME TO ' + QuotedStrD(TableName)); + Transaction.Commit; + end; + end; + end; + CloseTable; +end; + +function TDownloadsDB.Add(var Adlid: Integer; const Aenabled: Boolean; + const Aorder, Ataskstatus, Achapterptr, Anumberofpages, + Acurrentpage: Integer; const Awebsite, Alink, Atitle, Astatus, Aprogress, + Asaveto: String; const Adatetime: TDateTime; const Achapterslinks, + Achaptersnames, Apagelinks, Apagecontainerlinks, Afilenames, + Acustomfilenames, Achaptersstatus: String): Boolean; +begin + Result := False; + if not Connection.Connected then Exit; + try + if Adlid = -1 then + begin + Connection.ExecuteDirect('INSERT INTO "downloads" ("enabled","order","taskstatus","chapterptr","numberofpages","currentpage","website","link","title","status","progress","saveto","datetime","chapterslinks","chaptersnames","pagelinks","pagecontainerlinks","filenames","customfilenames","chaptersstatus")' + + ' VALUES (' + + QuotedStr(Aenabled) + ', ' + + QuotedStr(Aorder) + ', ' + + QuotedStr(Ataskstatus) + ',' + + QuotedStr(Achapterptr) + ',' + + QuotedStr(Anumberofpages) + ',' + + QuotedStr(Acurrentpage) + ',' + + QuotedStr(Awebsite) + ', ' + + QuotedStr(Alink) + ', ' + + QuotedStr(Atitle) + ', ' + + QuotedStr(Astatus) + ', ' + + QuotedStr(Aprogress) + ', ' + + QuotedStr(Asaveto) + ', ' + + QuotedStr(Adatetime) + ', ' + + QuotedStr(Achapterslinks) + ', ' + + QuotedStr(Achaptersnames) + ', ' + + QuotedStr(Apagelinks) + ', ' + + QuotedStr(Apagecontainerlinks) + ', ' + + QuotedStr(Afilenames) + ', ' + + QuotedStr(Acustomfilenames) + ', ' + + QuotedStr(Achaptersstatus) + + ')'); + Adlid := Connection.GetInsertID; + end + else + Connection.ExecuteDirect('UPDATE "downloads" SET ' + + '"enabled"=' + QuotedStr(Aenabled) + ', ' + + '"order"=' + QuotedStr(Aorder) + ', ' + + '"taskstatus"=' + QuotedStr(Ataskstatus) + ',' + + '"chapterptr"=' + QuotedStr(Achapterptr) + ',' + + '"numberofpages"=' + QuotedStr(Anumberofpages) + ',' + + '"currentpage"=' + QuotedStr(Acurrentpage) + ',' + + '"website"=' + QuotedStr(Awebsite) + ', ' + + '"link"=' + QuotedStr(Alink) + ', ' + + '"title"=' + QuotedStr(Atitle) + ', ' + + '"status"=' + QuotedStr(Astatus) + ', ' + + '"progress"=' + QuotedStr(Aprogress) + ', ' + + '"saveto"=' + QuotedStr(Asaveto) + ', ' + + '"datetime"=' + QuotedStr(Adatetime) + ', ' + + '"chapterslinks"=' + QuotedStr(Achapterslinks) + ', ' + + '"chaptersnames"=' + QuotedStr(Achaptersnames) + ', ' + + '"pagelinks"=' + QuotedStr(Apagelinks) + ', ' + + '"pagecontainerlinks"=' + QuotedStr(Apagecontainerlinks) + ', ' + + '"filenames"=' + QuotedStr(Afilenames) + ', ' + + '"customfilenames"=' + QuotedStr(Acustomfilenames) + ', ' + + '"chaptersstatus"=' + QuotedStr(Achaptersstatus) + + ' WHERE "dlid"=' + QuotedStr(Adlid)); + Inc(FCommitCount); + if FCommitCount >= FAutoCommitCount then + Commit; + Result := True; + except + on E: Exception do + SendLogException(ClassName + '.Add failed!', E); + end; +end; + +procedure TDownloadsDB.Delete(const ADlId: Integer); +begin + if ADlId = -1 then Exit; + if not Connection.Connected then Exit; + try + Connection.ExecuteDirect( + 'DELETE FROM "downloads" WHERE "dlid"=' + QuotedStr(ADlId)); + Inc(FCommitCount); + if FCommitCount >= FAutoCommitCount then + Commit; + except + on E: Exception do + SendLogException(ClassName + '.Delete failed!', E); + end; +end; + +procedure TDownloadsDB.Commit; +begin + if not Connection.Connected then Exit; + try + Transaction.Commit; + FCommitCount := 0; + except + on E: Exception do + begin + Transaction.Rollback; + SendLogException(ClassName + '.Commit failed! Rollback!', E); + end; + end; +end; + +procedure TDownloadsDB.Close; +begin + if FCommitCount <> 0 then + Commit; + inherited Close; +end; + +end. + diff --git a/baseunits/Duktape.Api.pas b/baseunits/Duktape.Api.pas new file mode 100644 index 000000000..67a1cc3a9 --- /dev/null +++ b/baseunits/Duktape.Api.pas @@ -0,0 +1,1745 @@ +{ + +https://github.com/grijjy/DelphiDuktape + +DelphiDuktape is licensed under the Simplified BSD License. + +------------------------------------------------------------------------------- + +Copyright (c) 2018 by Grijjy, Inc. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +} + +unit Duktape.Api; + +interface + +const + {$IF Defined(WIN32)} + LIB_DUKTAPE = 'duktape32.dll'; + PREFIX = ''; + {$ELSEIF Defined(WIN64)} + LIB_DUKTAPE = 'duktape64.dll'; + PREFIX = ''; + {$ELSEIF Defined(ANDROID)} + LIB_DUKTAPE = 'libduktape_android.a'; + PREFIX = ''; + {$ELSEIF Defined(IOS)} + LIB_DUKTAPE = 'libduktape_ios.a'; + PREFIX = ''; + {$ELSEIF Defined(MACOS)} + LIB_DUKTAPE = 'libduktape_osx32.dylib'; + PREFIX = '_'; + {$ELSEIF Defined(LINUX)} + LIB_DUKTAPE = 'libduktape_linux64.so'; + PREFIX = ''; + {$ELSE} + {$MESSAGE Error 'Unsupported platform'} + {$ENDIF} + +(* + * duk_config.h configuration header generated by genconfig.py. + * + * Git commit a459cf3c9bd1779fc01b435d69302b742675a08f (v2.2.0). + * Git branch: master + * + * Supported platforms: + * - Mac OSX, iPhone, Darwin + * - Orbis + * - OpenBSD + * - Generic BSD + * - Atari ST TOS + * - AmigaOS + * - Durango (XboxOne) + * - Windows + * - Flashplayer (Crossbridge) + * - QNX + * - TI-Nspire + * - Emscripten + * - Linux + * - Solaris + * - AIX + * - HPUX + * - Generic POSIX + * - Cygwin + * - Generic UNIX + * - Generic fallback + * + * Supported architectures: + * - x86 + * - x64 + * - x32 + * - ARM 32-bit + * - ARM 64-bit + * - MIPS 32-bit + * - MIPS 64-bit + * - PowerPC 32-bit + * - PowerPC 64-bit + * - SPARC 32-bit + * - SPARC 64-bit + * - SuperH + * - Motorola 68k + * - Emscripten + * - Generic + * + * Supported compilers: + * - Clang + * - GCC + * - MSVC + * - Emscripten + * - TinyC + * - VBCC + * - Bruce's C compiler + * - Generic + * + *) + +type MarshaledAString = ^AnsiChar; + +type + TDukUInt8 = UInt8; + TDukInt8 = Int8; + TDukUInt16 = UInt16; + TDukInt16 = Int16; + TDukUInt32 = UInt32; + TDukInt32 = Int32; + TDukUInt64 = UInt32; + TDukInt64 = Int32; + TDukUInt = Cardinal; + TDukInt = Integer; + TDukSize = NativeUInt; + TDukPtrDiff = NativeInt; + TDukSmallUInt = Cardinal; + TDukSmallInt = Integer; + TDukBool = TDukSmallUInt; + TDukIdx = TDukInt; + TDukUIdx = TDukUInt; + TDukUArrIdx = TDukUInt; + TDukRet = TDukSmallInt; + TDukErrCode = TDukInt; + TDukCodepoint = TDukInt; + TDukUCodepoint = TDukUInt; + TDukFloat = Single; + TDukDouble = Double; + +type + PDukUInt8 = ^TDukUInt8; + PDukInt8 = ^TDukInt8; + PDukUInt16 = ^TDukUInt16; + PDukInt16 = ^TDukInt16; + PDukUInt32 = ^TDukUInt32; + PDukInt32 = ^TDukInt32; + PDukUInt64 = ^TDukUInt64; + PDukInt64 = ^TDukInt64; + PDukUInt = ^TDukUInt; + PDukInt = ^TDukInt; + PDukSize = ^TDukSize; + PDukPtrDiff = ^TDukPtrDiff; + PDukSmallUInt = ^TDukSmallUInt; + PDukSmallInt = ^TDukSmallInt; + PDukBool = ^TDukBool; + PDukIdx = ^TDukIdx; + PDukUIdx = ^TDukUIdx; + PDukUArrIdx = ^TDukUArrIdx; + PDukRet = ^TDukRet; + PDukErrCode = ^TDukErrCode; + PDukCodepoint = ^TDukCodepoint; + PDukUCodepoint = ^TDukUCodepoint; + PDukFloat = ^TDukFloat; + PDukDouble = ^TDukDouble; + +type + TDukUIntLeast8 = TDukUInt8; + TDukIntLeast8 = TDukInt8; + TDukUIntLeast16 = TDukUInt16; + TDukIntLeast16 = TDukInt16; + TDukUIntLeast32 = TDukUInt32; + TDukIntLeast32 = TDukInt32; + TDukUIntLeast64 = TDukUInt64; + TDukIntLeast64 = TDukInt64; + +type + TDukUIntFast8 = TDukUInt8; + TDukIntFast8 = TDukInt8; + TDukUIntFast16 = TDukUInt16; + TDukIntFast16 = TDukInt16; + TDukUIntFast32 = TDukUInt32; + TDukIntFast32 = TDukInt32; + TDukUIntFast64 = TDukUInt64; + TDukIntFast64 = TDukInt64; + TDukUIntFast = TDukUIntFast32; + TDukIntFast = TDukIntFast32; + TDukSmallUIntFast = TDukUIntFast16; + TDukSmallIntFast = TDukIntFast16; + +type + TDukUIntMax = TDukUInt64; + TDukIntMax = TDukInt64; + +const + DUK_UINT8_MIN = $00; + DUK_UINT8_MAX = $FF; + DUK_INT8_MIN = -$80; + DUK_INT8_MAX = $7F; + DUK_UINT_LEAST8_MIN = $00; + DUK_UINT_LEAST8_MAX = $FF; + DUK_INT_LEAST8_MIN = -$80; + DUK_INT_LEAST8_MAX = $7F; + DUK_UINT_FAST8_MIN = $00; + DUK_UINT_FAST8_MAX = $FF; + DUK_INT_FAST8_MIN = -$80; + DUK_INT_FAST8_MAX = $7F; + DUK_UINT16_MIN = $0000; + DUK_UINT16_MAX = $FFFF; + DUK_INT16_MIN = -$8000; + DUK_INT16_MAX = $7FFF; + DUK_UINT_LEAST16_MIN = $0000; + DUK_UINT_LEAST16_MAX = $FFFF; + DUK_INT_LEAST16_MIN = -$8000; + DUK_INT_LEAST16_MAX = $7FFF; + DUK_UINT_FAST16_MIN = $0000; + DUK_UINT_FAST16_MAX = $FFFF; + DUK_INT_FAST16_MIN = -$8000; + DUK_INT_FAST16_MAX = $7FFF; + DUK_UINT32_MIN = $00000000; + DUK_UINT32_MAX = $FFFFFFFF; + DUK_INT32_MIN = -$80000000; + DUK_INT32_MAX = $7FFFFFFF; + DUK_UINT_LEAST32_MIN = $00000000; + DUK_UINT_LEAST32_MAX = $FFFFFFFF; + DUK_INT_LEAST32_MIN = -$80000000; + DUK_INT_LEAST32_MAX = $7FFFFFFF; + DUK_UINT_FAST32_MIN = $00000000; + DUK_UINT_FAST32_MAX = $FFFFFFFF; + DUK_INT_FAST32_MIN = -$80000000; + DUK_INT_FAST32_MAX = $7FFFFFFF; + DUK_UINT64_MIN = $0000000000000000; + DUK_UINT64_MAX = $FFFFFFFFFFFFFFFF; + DUK_INT64_MIN = -$8000000000000000; + DUK_INT64_MAX = $7FFFFFFFFFFFFFFF; + DUK_UINT_LEAST64_MIN = $0000000000000000; + DUK_UINT_LEAST64_MAX = $FFFFFFFFFFFFFFFF; + DUK_INT_LEAST64_MIN = -$8000000000000000; + DUK_INT_LEAST64_MAX = $7FFFFFFFFFFFFFFF; + DUK_UINT_FAST64_MIN = $0000000000000000; + DUK_UINT_FAST64_MAX = $FFFFFFFFFFFFFFFF; + DUK_INT_FAST64_MIN = -$8000000000000000; + DUK_INT_FAST64_MAX = $7FFFFFFFFFFFFFFF; + +const + DUK_UINTMAX_MIN = DUK_UINT64_MIN; + DUK_UINTMAX_MAX = DUK_UINT64_MAX; + DUK_INTMAX_MIN = DUK_INT64_MIN; + DUK_INTMAX_MAX = DUK_INT64_MAX; + +const + DUK_UINT_MIN = DUK_UINT32_MIN; + DUK_UINT_MAX = DUK_UINT32_MAX; + DUK_INT_MIN = DUK_INT32_MIN; + DUK_INT_MAX = DUK_INT32_MAX; + DUK_UINT_FAST_MIN = DUK_UINT_FAST32_MIN; + DUK_UINT_FAST_MAX = DUK_UINT_FAST32_MAX; + DUK_INT_FAST_MIN = DUK_INT_FAST32_MIN; + DUK_INT_FAST_MAX = DUK_INT_FAST32_MAX; + DUK_SMALL_UINT_MIN = DUK_UINT32_MIN; + DUK_SMALL_UINT_MAX = DUK_UINT32_MAX; + DUK_SMALL_INT_MIN = DUK_INT32_MIN; + DUK_SMALL_INT_MAX = DUK_INT32_MAX; + DUK_SMALL_UINT_FAST_MIN = DUK_UINT16_MIN; + DUK_SMALL_UINT_FAST_MAX = DUK_UINT16_MAX; + DUK_SMALL_INT_FAST_MIN = DUK_INT16_MIN; + DUK_SMALL_INT_FAST_MAX = DUK_INT16_MAX; + DUK_BOOL_MIN = DUK_SMALL_INT_MIN; + DUK_BOOL_MAX = DUK_SMALL_INT_MAX; + DUK_IDX_MIN = DUK_INT_MIN; + DUK_IDX_MAX = DUK_INT_MAX; + DUK_UIDX_MIN = DUK_UINT_MIN; + DUK_UIDX_MAX = DUK_UINT_MAX; + DUK_UARRIDX_MIN = DUK_UINT_MIN; + DUK_UARRIDX_MAX = DUK_UINT_MAX; + DUK_ERRCODE_MIN = DUK_INT_MIN; + DUK_ERRCODE_MAX = DUK_INT_MAX; + DUK_CODEPOINT_MIN = DUK_INT_MIN; + DUK_CODEPOINT_MAX = DUK_INT_MAX; + DUK_UCODEPOINT_MIN = DUK_UINT_MIN; + DUK_UCODEPOINT_MAX = DUK_UINT_MAX; + DUK_RET_MIN = DUK_SMALL_INT_MIN; + DUK_RET_MAX = DUK_SMALL_INT_MAX; + +(* + * Duktape public API for Duktape 2.1.0. + * + * See the API reference for documentation on call semantics. The exposed, + * supported API is between the "BEGIN PUBLIC API" and "END PUBLIC API" + * comments. Other parts of the header are Duktape internal and related to + * e.g. platform/compiler/feature detection. + * + * Git commit a459cf3c9bd1779fc01b435d69302b742675a08f (v2.2.0). + * Git branch master. + * + * See Duktape AUTHORS.rst and LICENSE.txt for copyright and + * licensing information. + *) + +(* + * =============== + * Duktape license + * =============== + * + * (http://opensource.org/licenses/MIT) + * + * Copyright (c) 2013-2017 by Duktape authors (see AUTHORS.rst) + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * in the Software without restriction, including without limitation the rights + * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell + * copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN + * THE SOFTWARE. + *) + +(* + * =============== + * Duktape authors + * =============== + * + * Copyright + * ========= + * + * Duktape copyrights are held by its authors. Each author has a copyright + * to their contribution, and agrees to irrevocably license the contribution + * under the Duktape ``LICENSE.txt``. + * + * Authors + * ======= + * + * Please include an e-mail address, a link to your GitHub profile, or something + * similar to allow your contribution to be identified accurately. + * + * The following people have contributed code, website contents, or Wiki contents, + * and agreed to irrevocably license their contributions under the Duktape + * ``LICENSE.txt`` (in order of appearance): + * + * * Sami Vaarala + * * Niki Dobrev + * * Andreas \u00d6man + * * L\u00e1szl\u00f3 Lang\u00f3 + * * Legimet + * * Karl Skomski + * * Bruce Pascoe + * * Ren\u00e9 Hollander + * * Julien Hamaide (https://github.com/crazyjul) + * * Sebastian G\u00f6tte (https://github.com/jaseg) + * * Tomasz Magulski (https://github.com/magul) + * * \D. Bohdan (https://github.com/dbohdan) + * * Ond\u0159ej Jirman (https://github.com/megous) + * * Sa\u00fal Ibarra Corretg\u00e9 + * * Jeremy HU + * * Ole Andr\u00e9 Vadla Ravn\u00e5s (https://github.com/oleavr) + * * Harold Brenes (https://github.com/harold-b) + * * Oliver Crow (https://github.com/ocrow) + * * Jakub Ch\u0142api\u0144ski (https://github.com/jchlapinski) + * * Brett Vickers (https://github.com/beevik) + * * Dominik Okwieka (https://github.com/okitec) + * * Remko Tron\u00e7on (https://el-tramo.be) + * * Romero Malaquias (rbsm@ic.ufal.br) + * * Michael Drake + * * Steven Don (https://github.com/shdon) + * * Simon Stone (https://github.com/sstone1) + * * \J. McC. (https://github.com/jmhmccr) + * + * Other contributions + * =================== + * + * The following people have contributed something other than code (e.g. reported + * bugs, provided ideas, etc; roughly in order of appearance): + * + * * Greg Burns + * * Anthony Rabine + * * Carlos Costa + * * Aur\u00e9lien Bouilland + * * Preet Desai (Pris Matic) + * * judofyr (http://www.reddit.com/user/judofyr) + * * Jason Woofenden + * * Micha\u0142 Przyby\u015b + * * Anthony Howe + * * Conrad Pankoff + * * Jim Schimpf + * * Rajaran Gaunker (https://github.com/zimbabao) + * * Andreas \u00d6man + * * Doug Sanden + * * Josh Engebretson (https://github.com/JoshEngebretson) + * * Remo Eichenberger (https://github.com/remoe) + * * Mamod Mehyar (https://github.com/mamod) + * * David Demelier (https://github.com/markand) + * * Tim Caswell (https://github.com/creationix) + * * Mitchell Blank Jr (https://github.com/mitchblank) + * * https://github.com/yushli + * * Seo Sanghyeon (https://github.com/sanxiyn) + * * Han ChoongWoo (https://github.com/tunz) + * * Joshua Peek (https://github.com/josh) + * * Bruce E. Pascoe (https://github.com/fatcerberus) + * * https://github.com/Kelledin + * * https://github.com/sstruchtrup + * * Michael Drake (https://github.com/tlsa) + * * https://github.com/chris-y + * * Laurent Zubiaur (https://github.com/lzubiaur) + * * Neil Kolban (https://github.com/nkolban) + * + * If you are accidentally missing from this list, send me an e-mail + * (``sami.vaarala@iki.fi``) and I'll fix the omission. + *) + +(* + * BEGIN PUBLIC API + *) + +(* + * Version and Git commit identification + *) + +(* Duktape version, (major * 10000) + (minor * 100) + patch. Allows C code + * to #if (DUK_VERSION >= NNN) against Duktape API version. The same value + * is also available to Ecmascript code in Duktape.version. Unofficial + * development snapshots have 99 for patch level (e.g. 0.10.99 would be a + * development version after 0.10.0 but before the next official release). + *) +const + DUK_VERSION = 20200; + +(* Git commit, describe, and branch for Duktape build. Useful for + * non-official snapshot builds so that application code can easily log + * which Duktape snapshot was used. Not available in the Ecmascript + * environment. + *) +const + DUK_GIT_COMMIT = 'a459cf3c9bd1779fc01b435d69302b742675a08f'; + DUK_GIT_DESCRIBE = 'v2.2.0'; + DUK_GIT_BRANCH = 'master'; + +(* + * Public API specific typedefs + * + * Many types are wrapped by Duktape for portability to rare platforms + * where e.g. 'int' is a 16-bit type. See practical typing discussion + * in Duktape web documentation. + *) + +type + PDukContext = Pointer; + +type + TDukAllocFunction = function(udata: Pointer; size: TDukSize): Pointer; cdecl; + TDukReallocFunction = function(udata: Pointer; ptr: Pointer; size: TDukSize): Pointer; cdecl; + TDukFreeFunction = procedure(udata: Pointer; ptr: Pointer); cdecl; + TDukCFunction = function(ctx: PDukContext): TDukRet; cdecl; + TDukFatalFunction = procedure(udata: Pointer; const msg: MarshaledAString); cdecl; + TDukDecodeCharFunction = procedure(udata: Pointer; codepoint: TDukCodepoint); cdecl; + TDukMapCharFunction = function(udata: Pointer; codepoint: TDukCodepoint): TDukCodepoint; cdecl; + TDukSafeCallFunction = function(ctx: PDukContext; udata: Pointer): TDukRet; cdecl; + TDukDebugReadFunction = function(udata: Pointer; buffer: MarshaledAString; length: TDukSize): TDukSize; cdecl; + TDukDebugWriteFunction = function(udata: Pointer; const buffer: MarshaledAString; length: TDukSize): TDukSize; cdecl; + TDukDebugPeekFunction = function(udata: Pointer): TDukSize; cdecl; + TDukDebugReadFlushFunction = procedure(udata: Pointer); cdecl; + TDukDebugWriteFlushFunction = procedure(udata: Pointer); cdecl; + TDukDebugRequestFunction = function(ctx: PDukContext; udata: Pointer; nvalues: TDukIdx): TDukIdx; cdecl; + TDukDebugDetachedFunction = procedure(ctx: PDukContext; udata: Pointer); cdecl; + +type + PDukThreadState = ^TDukThreadState; + TDukThreadState = record + { Enough space to hold internal suspend/resume structure. + This is rather awkward and to be fixed when the internal + structure is visible for the public API header. } + Data: array [0..127] of Byte; + end; + +type + PDukMemoryFunctions = ^TDukMemoryFunctions; + TDukMemoryFunctions = record + AllocFunc: TDukAllocFunction; + ReallocFunc: TDukReallocFunction; + FreeFunc: TDukFreeFunction; + UserData: Pointer; + end; + +type + PDukFunctionListEntry = ^TDukFunctionListEntry; + TDukFunctionListEntry = record + Key: MarshaledAString; + Value: TDukCFunction; + NumArgs: TDukIdx; + end; + +type + PDukNumberListEntry = ^TDukNumberListEntry; + TDukNumberListEntry = record + Key: MarshaledAString; + Value: TDukDouble; + end; + +type + PDukTimeComponents = ^TDukTimeComponents; + TDukTimeComponents = record + Year: TDukDouble; + Month: TDukDouble; + Day: TDukDouble; + Hours: TDukDouble; + Minutes: TDukDouble; + Seconds: TDukDouble; + Milliseconds: TDukDouble; + Weekday: TDukDouble; + end; + +(* + * Constants + *) + +(* Duktape debug protocol version used by this build. *) +const + DUK_DEBUG_PROTOCOL_VERSION = 2; + +(* Used to represent invalid index; if caller uses this without checking, + * this index will map to a non-existent stack entry. Also used in some + * API calls as a marker to denote "no value". + *) +const + DUK_INVALID_INDEX = DUK_IDX_MIN; + +(* Indicates that a native function does not have a fixed number of args, + * and the argument stack should not be capped/extended at all. + *) +const + DUK_VARARGS = -1; + +(* Number of value stack entries (in addition to actual call arguments) + * guaranteed to be allocated on entry to a Duktape/C function. + *) +const + DUK_API_ENTRY_STACK = 64; + +(* Value types, used by e.g. duk_get_type() *) +const + DUK_TYPE_MIN = 0; + DUK_TYPE_NONE = 0; (* no value, e.g. invalid index *) + DUK_TYPE_UNDEFINED = 1; (* Ecmascript undefined *) + DUK_TYPE_NULL = 2; (* Ecmascript null *) + DUK_TYPE_BOOLEAN = 3; (* Ecmascript boolean: 0 or 1 *) + DUK_TYPE_NUMBER = 4; (* Ecmascript number: double *) + DUK_TYPE_STRING = 5; (* Ecmascript string: CESU-8 / extended UTF-8 encoded *) + DUK_TYPE_OBJECT = 6; (* Ecmascript object: includes objects, arrays, functions, threads *) + DUK_TYPE_BUFFER = 7; (* fixed or dynamic, garbage collected byte buffer *) + DUK_TYPE_POINTER = 8; (* raw void pointer *) + DUK_TYPE_LIGHTFUNC = 9; (* lightweight function pointer *) + DUK_TYPE_MAX = 9; + +(* Value mask types, used by e.g. duk_get_type_mask() *) +const + DUK_TYPE_MASK_NONE = 1 shl DUK_TYPE_NONE; + DUK_TYPE_MASK_UNDEFINED = 1 shl DUK_TYPE_UNDEFINED; + DUK_TYPE_MASK_NULL = 1 shl DUK_TYPE_NULL; + DUK_TYPE_MASK_BOOLEAN = 1 shl DUK_TYPE_BOOLEAN; + DUK_TYPE_MASK_NUMBER = 1 shl DUK_TYPE_NUMBER; + DUK_TYPE_MASK_STRING = 1 shl DUK_TYPE_STRING; + DUK_TYPE_MASK_OBJECT = 1 shl DUK_TYPE_OBJECT; + DUK_TYPE_MASK_BUFFER = 1 shl DUK_TYPE_BUFFER; + DUK_TYPE_MASK_POINTER = 1 shl DUK_TYPE_POINTER; + DUK_TYPE_MASK_LIGHTFUNC = 1 shl DUK_TYPE_LIGHTFUNC; + DUK_TYPE_MASK_THROW = 1 shl 10; (* internal flag value: throw if mask doesn't match *) + DUK_TYPE_MASK_PROMOTE = 1 shl 11; (* internal flag value: promote to object if mask matches *) + +(* Coercion hints *) +const + DUK_HINT_NONE = 0; (* prefer number, unless input is a Date, in which + * case prefer string (E5 Section 8.12.8) *) + DUK_HINT_STRING = 1; (* prefer string *) + DUK_HINT_NUMBER = 2; (* prefer number *) + +(* Enumeration flags for duk_enum() *) +const + DUK_ENUM_INCLUDE_NONENUMERABLE = 1 shl 0; (* enumerate non-numerable properties in addition to enumerable *) + DUK_ENUM_INCLUDE_HIDDEN = 1 shl 1; (* enumerate hidden symbols too (in Duktape 1.x called internal properties) *) + DUK_ENUM_INCLUDE_SYMBOLS = 1 shl 2; (* enumerate symbols *) + DUK_ENUM_EXCLUDE_STRINGS = 1 shl 3; (* exclude strings *) + DUK_ENUM_OWN_PROPERTIES_ONLY = 1 shl 4; (* don't walk prototype chain, only check own properties *) + DUK_ENUM_ARRAY_INDICES_ONLY = 1 shl 5; (* only enumerate array indices *) + DUK_ENUM_SORT_ARRAY_INDICES = 1 shl 6; (* sort array indices (applied to full enumeration result, including inherited array indices) *) + DUK_ENUM_NO_PROXY_BEHAVIOR = 1 shl 7; (* enumerate a proxy object itself without invoking proxy behavior *) + +(* Compilation flags for duk_compile() and duk_eval() *) +(* DUK_COMPILE_xxx bits 0-2 are reserved for an internal 'nargs' argument. + *) +const + DUK_COMPILE_EVAL = 1 shl 3; (* compile eval code (instead of global code) *) + DUK_COMPILE_FUNCTION = 1 shl 4; (* compile function code (instead of global code) *) + DUK_COMPILE_STRICT = 1 shl 5; (* use strict (outer) context for global, eval, or function code *) + DUK_COMPILE_SHEBANG = 1 shl 6; (* allow shebang ('#! ...') comment on first line of source *) + DUK_COMPILE_SAFE = 1 shl 7; (* (internal) catch compilation errors *) + DUK_COMPILE_NORESULT = 1 shl 8; (* (internal) omit eval result *) + DUK_COMPILE_NOSOURCE = 1 shl 9; (* (internal) no source string on stack *) + DUK_COMPILE_STRLEN = 1 shl 10; (* (internal) take strlen() of src_buffer (avoids double evaluation in macro) *) + DUK_COMPILE_NOFILENAME = 1 shl 11; (* (internal) no filename on stack *) + DUK_COMPILE_FUNCEXPR = 1 shl 12; (* (internal) source is a function expression (used for Function constructor) *) + +(* Flags for duk_def_prop() and its variants *) +const + DUK_DEFPROP_WRITABLE = 1 shl 0; (* set writable (effective if DUK_DEFPROP_HAVE_WRITABLE set) *) + DUK_DEFPROP_ENUMERABLE = 1 shl 1; (* set enumerable (effective if DUK_DEFPROP_HAVE_ENUMERABLE set) *) + DUK_DEFPROP_CONFIGURABLE = 1 shl 2; (* set configurable (effective if DUK_DEFPROP_HAVE_CONFIGURABLE set) *) + DUK_DEFPROP_HAVE_WRITABLE = 1 shl 3; (* set/clear writable *) + DUK_DEFPROP_HAVE_ENUMERABLE = 1 shl 4; (* set/clear enumerable *) + DUK_DEFPROP_HAVE_CONFIGURABLE = 1 shl 5; (* set/clear configurable *) + DUK_DEFPROP_HAVE_VALUE = 1 shl 6; (* set value (given on value stack) *) + DUK_DEFPROP_HAVE_GETTER = 1 shl 7; (* set getter (given on value stack) *) + DUK_DEFPROP_HAVE_SETTER = 1 shl 8; (* set setter (given on value stack) *) + DUK_DEFPROP_FORCE = 1 shl 9; (* force change if possible, may still fail for e.g. virtual properties *) + DUK_DEFPROP_SET_WRITABLE = DUK_DEFPROP_HAVE_WRITABLE or DUK_DEFPROP_WRITABLE; + DUK_DEFPROP_CLEAR_WRITABLE = DUK_DEFPROP_HAVE_WRITABLE; + DUK_DEFPROP_SET_ENUMERABLE = DUK_DEFPROP_HAVE_ENUMERABLE or DUK_DEFPROP_ENUMERABLE; + DUK_DEFPROP_CLEAR_ENUMERABLE = DUK_DEFPROP_HAVE_ENUMERABLE; + DUK_DEFPROP_SET_CONFIGURABLE = DUK_DEFPROP_HAVE_CONFIGURABLE or DUK_DEFPROP_CONFIGURABLE; + DUK_DEFPROP_CLEAR_CONFIGURABLE = DUK_DEFPROP_HAVE_CONFIGURABLE; + DUK_DEFPROP_W = DUK_DEFPROP_WRITABLE; + DUK_DEFPROP_E = DUK_DEFPROP_ENUMERABLE; + DUK_DEFPROP_C = DUK_DEFPROP_CONFIGURABLE; + DUK_DEFPROP_WE = DUK_DEFPROP_WRITABLE or DUK_DEFPROP_ENUMERABLE; + DUK_DEFPROP_WC = DUK_DEFPROP_WRITABLE or DUK_DEFPROP_CONFIGURABLE; + DUK_DEFPROP_WEC = DUK_DEFPROP_WRITABLE or DUK_DEFPROP_ENUMERABLE or DUK_DEFPROP_CONFIGURABLE; + DUK_DEFPROP_HAVE_W = DUK_DEFPROP_HAVE_WRITABLE; + DUK_DEFPROP_HAVE_E = DUK_DEFPROP_HAVE_ENUMERABLE; + DUK_DEFPROP_HAVE_C = DUK_DEFPROP_HAVE_CONFIGURABLE; + DUK_DEFPROP_HAVE_WE = DUK_DEFPROP_HAVE_WRITABLE or DUK_DEFPROP_HAVE_ENUMERABLE; + DUK_DEFPROP_HAVE_WC = DUK_DEFPROP_HAVE_WRITABLE or DUK_DEFPROP_HAVE_CONFIGURABLE; + DUK_DEFPROP_HAVE_WEC = DUK_DEFPROP_HAVE_WRITABLE or DUK_DEFPROP_HAVE_ENUMERABLE or DUK_DEFPROP_HAVE_CONFIGURABLE; + DUK_DEFPROP_SET_W = DUK_DEFPROP_SET_WRITABLE; + DUK_DEFPROP_SET_E = DUK_DEFPROP_SET_ENUMERABLE; + DUK_DEFPROP_SET_C = DUK_DEFPROP_SET_CONFIGURABLE; + DUK_DEFPROP_SET_WE = DUK_DEFPROP_SET_WRITABLE or DUK_DEFPROP_SET_ENUMERABLE; + DUK_DEFPROP_SET_WC = DUK_DEFPROP_SET_WRITABLE or DUK_DEFPROP_SET_CONFIGURABLE; + DUK_DEFPROP_SET_WEC = DUK_DEFPROP_SET_WRITABLE or DUK_DEFPROP_SET_ENUMERABLE or DUK_DEFPROP_SET_CONFIGURABLE; + DUK_DEFPROP_CLEAR_W = DUK_DEFPROP_CLEAR_WRITABLE; + DUK_DEFPROP_CLEAR_E = DUK_DEFPROP_CLEAR_ENUMERABLE; + DUK_DEFPROP_CLEAR_C = DUK_DEFPROP_CLEAR_CONFIGURABLE; + DUK_DEFPROP_CLEAR_WE = DUK_DEFPROP_CLEAR_WRITABLE or DUK_DEFPROP_CLEAR_ENUMERABLE; + DUK_DEFPROP_CLEAR_WC = DUK_DEFPROP_CLEAR_WRITABLE or DUK_DEFPROP_CLEAR_CONFIGURABLE; + DUK_DEFPROP_CLEAR_WEC = DUK_DEFPROP_CLEAR_WRITABLE or DUK_DEFPROP_CLEAR_ENUMERABLE or DUK_DEFPROP_CLEAR_CONFIGURABLE; + DUK_DEFPROP_ATTR_W = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_W; + DUK_DEFPROP_ATTR_E = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_E; + DUK_DEFPROP_ATTR_C = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_C; + DUK_DEFPROP_ATTR_WE = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_WE; + DUK_DEFPROP_ATTR_WC = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_WC; + DUK_DEFPROP_ATTR_WEC = DUK_DEFPROP_HAVE_WEC or DUK_DEFPROP_WEC; + +(* Flags for duk_push_thread_raw() *) +const + DUK_THREAD_NEW_GLOBAL_ENV = 1 shl 0; (* create a new global environment *) + +(* Flags for duk_gc() *) +const + DUK_GC_COMPACT = 1 shl 0; (* compact heap objects *) + +(* Error codes (must be 8 bits at most, see duk_error.h) *) +const + DUK_ERR_NONE = 0; (* no error (e.g. from duk_get_error_code()) *) + DUK_ERR_ERROR = 1; (* Error *) + DUK_ERR_EVAL_ERROR = 2; (* EvalError *) + DUK_ERR_RANGE_ERROR = 3; (* RangeError *) + DUK_ERR_REFERENCE_ERROR = 4; (* ReferenceError *) + DUK_ERR_SYNTAX_ERROR = 5; (* SyntaxError *) + DUK_ERR_TYPE_ERROR = 6; (* TypeError *) + DUK_ERR_URI_ERROR = 7; (* URIError *) + +(* Return codes for C functions (shortcut for throwing an error) *) +const + DUK_RET_ERROR = -DUK_ERR_ERROR; + DUK_RET_EVAL_ERROR = -DUK_ERR_EVAL_ERROR; + DUK_RET_RANGE_ERROR = -DUK_ERR_RANGE_ERROR; + DUK_RET_REFERENCE_ERROR = -DUK_ERR_REFERENCE_ERROR; + DUK_RET_SYNTAX_ERROR = -DUK_ERR_SYNTAX_ERROR; + DUK_RET_TYPE_ERROR = -DUK_ERR_TYPE_ERROR; + DUK_RET_URI_ERROR = -DUK_ERR_URI_ERROR; + +(* Return codes for protected calls (duk_safe_call(), duk_pcall()) *) +const + DUK_EXEC_SUCCESS = 0; + DUK_EXEC_ERROR = 1; + +(* Debug levels for DUK_USE_DEBUG_WRITE(). *) +const + DUK_LEVEL_DEBUG = 0; + DUK_LEVEL_DDEBUG = 1; + DUK_LEVEL_DDDEBUG = 2; + +(* + * Macros to create Symbols as C statically constructed strings. + * + * Call e.g. as DUK_HIDDEN_SYMBOL("myProperty") <=> ("\xFF" "myProperty"). + * Local symbols have a unique suffix, caller should take care to avoid + * conflicting with the Duktape internal representation by e.g. prepending + * a '!' character: DUK_LOCAL_SYMBOL("myLocal", "!123"). + * + * Note that these can only be used for string constants, not dynamically + * created strings. + *) + +function DUK_HIDDEN_SYMBOL(const AX: UTF8String): UTF8String; inline; +function DUK_GLOBAL_SYMBOL(const AX: UTF8String): UTF8String; inline; +function DUK_LOCAL_SYMBOL(const AX, AUniq: UTF8String): UTF8String; inline; +function DUK_WELLKNOWN_SYMBOL(const AX: UTF8String): UTF8String; inline; + +(* + * Context management + *) + +function duk_create_heap(alloc_func: TDukAllocFunction; realloc_func: TDukReallocFunction; free_func: TDukFreeFunction; heap_udata: Pointer; fatal_handler: TDukFatalFunction): PDukContext; cdecl external LIB_DUKTAPE name PREFIX + 'duk_create_heap'; +procedure duk_destroy_heap(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_destroy_heap'; + +procedure duk_suspend(ctx: PDukContext; state: PDukThreadState); cdecl external LIB_DUKTAPE name PREFIX + 'duk_suspend'; +procedure duk_resume(ctx: PDukContext; const state: PDukThreadState); cdecl external LIB_DUKTAPE name PREFIX + 'duk_resume'; + +function duk_create_heap_default: PDukContext; inline; + +(* + * Memory management + * + * Raw functions have no side effects (cannot trigger GC). + *) + +function duk_alloc_raw(ctx: PDukContext; size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_alloc_raw'; +procedure duk_free_raw(ctx: PDukContext; ptr: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_free_raw'; +function duk_realloc_raw(ctx: PDukContext; ptr: Pointer; size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_realloc_raw'; +function duk_alloc(ctx: PDukContext; size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_alloc'; +procedure duk_free(ctx: PDukContext; ptr: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_free'; +function duk_realloc(ctx: PDukContext; ptr: Pointer; size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_realloc'; +procedure duk_get_memory_functions(ctx: PDukContext; out_funcs: PDukMemoryFunctions); cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_memory_functions'; +procedure duk_gc(ctx: PDukContext; flags: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_gc'; + +(* + * Error handling + *) + +procedure duk_throw_raw(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_throw_raw'; +procedure duk_throw(ctx: PDukContext); inline; + +procedure duk_fatal_raw(ctx: PDukContext; const err_msg: MarshaledAString); cdecl external LIB_DUKTAPE name PREFIX + 'duk_fatal_raw'; +procedure duk_fatal(ctx: PDukContext; const err_msg: MarshaledAString); inline; + +procedure duk_error_raw(ctx: PDukContext; err_code: TDukErrCode; const filename: MarshaledAString; const line: TDukInt; const fmt: MarshaledAString); varargs; cdecl external LIB_DUKTAPE name PREFIX + 'duk_error_raw'; +procedure duk_error(ctx: PDukContext; err_code: TDukErrCode; const fmt: MarshaledAString); inline; +procedure duk_generic_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_eval_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_range_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_reference_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_syntax_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_type_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +procedure duk_uri_error(ctx: PDukContext; const fmt: MarshaledAString); inline; + +(* + * Other state related functions + *) + +function duk_is_strict_call(ctx: PDukContext): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_strict_call'; +function duk_is_constructor_call(ctx: PDukContext): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_constructor_call'; + +(* + * Stack management + *) + +function duk_normalize_index(ctx: PDukContext; idx: TDukIdx): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_normalize_index'; +function duk_require_normalize_index(ctx: PDukContext; idx: TDukIdx): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_normalize_index'; +function duk_is_valid_index(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_valid_index'; +procedure duk_require_valid_index(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_valid_index'; + +function duk_get_top(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_top'; +procedure duk_set_top(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_top'; +function duk_get_top_index(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_top_index'; +function duk_require_top_index(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_top_index'; + +(* Although extra/top could be an unsigned type here, using a signed type + * makes the API more robust to calling code calculation errors or corner + * cases (where caller might occasionally come up with negative values). + * Negative values are treated as zero, which is better than casting them + * to a large unsigned number. (This principle is used elsewhere in the + * API too.) + *) +function duk_check_stack(ctx: PDukContext; extra: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_check_stack'; +procedure duk_require_stack(ctx: PDukContext; extra: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_stack'; +function duk_check_stack_top(ctx: PDukContext; top: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_check_stack_top'; +procedure duk_require_stack_top(ctx: PDukContext; top: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_stack_top'; + +(* + * Stack manipulation (other than push/pop) + *) + +procedure duk_swap(ctx: PDukContext; idx1: TDukIdx; idx2: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_swap'; +procedure duk_swap_top(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_swap_top'; +procedure duk_dup(ctx: PDukContext; from_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_dup'; +procedure duk_dup_top(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_dup_top'; +procedure duk_insert(ctx: PDukContext; to_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_insert'; +procedure duk_replace(ctx: PDukContext; to_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_replace'; +procedure duk_copy(ctx: PDukContext; from_idx: TDukIdx; to_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_copy'; +procedure duk_remove(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_remove'; +procedure duk_xcopymove_raw(to_ctx: PDukContext; from_ctx: PDukContext; count: TDukIdx; is_copy: TDukBool); cdecl external LIB_DUKTAPE name PREFIX + 'duk_xcopymove_raw'; + +procedure duk_xmove_top(to_ctx: PDukContext; from_ctx: PDukContext; count: TDukIdx); inline; +procedure duk_xcopy_top(to_ctx: PDukContext; from_ctx: PDukContext; count: TDukIdx); inline; + +(* + * Push operations + * + * Push functions return the absolute (relative to bottom of frame) + * position of the pushed value for convenience. + * + * Note: duk_dup() is technically a push. + *) + +procedure duk_push_undefined(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_undefined'; +procedure duk_push_null(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_null'; +procedure duk_push_boolean(ctx: PDukContext; val: TDukBool); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_boolean'; +procedure duk_push_true(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_true'; +procedure duk_push_false(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_false'; +procedure duk_push_number(ctx: PDukContext; val: TDukDouble); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_number'; +procedure duk_push_nan(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_nan'; +procedure duk_push_int(ctx: PDukContext; val: TDukInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_int'; +procedure duk_push_uint(ctx: PDukContext; val: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_uint'; +function duk_push_string(ctx: PDukContext; const str: MarshaledAString): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_string'; +function duk_push_lstring(ctx: PDukContext; const str: MarshaledAString; len: TDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_lstring'; +procedure duk_push_pointer(ctx: PDukContext; p: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_pointer'; +function duk_push_sprintf(ctx: PDukContext; const fmt: MarshaledAString): MarshaledAString; cdecl; varargs external LIB_DUKTAPE name PREFIX + 'duk_push_sprintf'; + +procedure duk_push_this(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_this'; +procedure duk_push_current_function(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_current_function'; +procedure duk_push_current_thread(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_current_thread'; +procedure duk_push_global_object(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_global_object'; +procedure duk_push_heap_stash(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_heap_stash'; +procedure duk_push_global_stash(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_global_stash'; +procedure duk_push_thread_stash(ctx: PDukContext; target_ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_thread_stash'; + +function duk_push_object(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_object'; +function duk_push_bare_object(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_bare_object'; +function duk_push_array(ctx: PDukContext): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_array'; +function duk_push_c_function(ctx: PDukContext; func: TDukCFunction; nargs: TDukIdx): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_c_function'; +function duk_push_c_lightfunc(ctx: PDukContext; func: TDukCFunction; nargs: TDukIdx; length: TDukIdx; magic: TDukInt): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_c_lightfunc'; +function duk_push_thread_raw(ctx: PDukContext; flags: TDukUInt): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_thread_raw'; +function duk_push_proxy(ctx: PDukContext; proxy_flags: TDukUInt): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_proxy'; + +function duk_push_thread(ctx: PDukContext): TDukIdx; inline; +function duk_push_thread_new_globalenv(ctx: PDukContext): TDukIdx; inline; + +function duk_push_error_object_raw(ctx: PDukContext; err_code: TDukErrcode; const filename: MarshaledAString; line: TDukInt; const fmt: MarshaledAString): TDukIdx; cdecl; varargs external LIB_DUKTAPE name PREFIX + 'duk_push_error_object_raw'; +function duk_push_error_object(ctx: PDukContext; err_code: TDukErrcode; const fmt: MarshaledAString): TDukIdx; inline; + +const + DUK_BUF_FLAG_DYNAMIC = 1 shl 0; (* internal flag: dynamic buffer *) + DUK_BUF_FLAG_EXTERNAL = 1 shl 1; (* internal flag: external buffer *) + DUK_BUF_FLAG_NOZERO = 1 shl 2; (* internal flag: don't zero allocated buffer *) + +function duk_push_buffer_raw(ctx: PDukContext; size: TDukSize; flags: TDukSmallUInt): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_buffer_raw'; +function duk_push_buffer(ctx: PDukContext; size: TDukSize; dynamic: Boolean): Pointer; inline; +function duk_push_fixed_buffer(ctx: PDukContext; size: TDukSize): Pointer; inline; +function duk_push_dynamic_buffer(ctx: PDukContext; size: TDukSize): Pointer; inline; +function duk_push_external_buffer(ctx: PDukContext): Pointer; inline; + +const + DUK_BUFOBJ_ARRAYBUFFER = 0; + DUK_BUFOBJ_NODEJS_BUFFER = 1; + DUK_BUFOBJ_DATAVIEW = 2; + DUK_BUFOBJ_INT8ARRAY = 3; + DUK_BUFOBJ_UINT8ARRAY = 4; + DUK_BUFOBJ_UINT8CLAMPEDARRAY = 5; + DUK_BUFOBJ_INT16ARRAY = 6; + DUK_BUFOBJ_UINT16ARRAY = 7; + DUK_BUFOBJ_INT32ARRAY = 8; + DUK_BUFOBJ_UINT32ARRAY = 9; + DUK_BUFOBJ_FLOAT32ARRAY = 10; + DUK_BUFOBJ_FLOAT64ARRAY = 11; + +procedure duk_push_buffer_object(ctx: PDukContext; idx_buffer: TDukIdx; byte_offset: TDukSize; byte_length: TDukSize; flags: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_buffer_object'; + +function duk_push_heapptr(ctx: PDukContext; ptr: Pointer): TDukIdx; cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_heapptr'; + +(* + * Pop operations + *) + +procedure duk_pop(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_pop'; +procedure duk_pop_n(ctx: PDukContext; count: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_pop_n'; +procedure duk_pop_2(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_pop_2'; +procedure duk_pop_3(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_pop_3'; + +(* + * Type checks + * + * duk_is_none(), which would indicate whether index it outside of stack, + * is not needed; duk_is_valid_index() gives the same information. + *) + +function duk_get_type(ctx: PDukContext; idx: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_type'; +function duk_check_type(ctx: PDukContext; idx: TDukIdx; _type: TDukInt): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_check_type'; +function duk_get_type_mask(ctx: PDukContext; idx: TDukIdx): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_type_mask'; +function duk_check_type_mask(ctx: PDukContext; idx: TDukIdx; mask: TDukUInt): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_check_type_mask'; + +function duk_is_undefined(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_undefined'; +function duk_is_null(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_null'; +function duk_is_null_or_undefined(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; + +function duk_is_boolean(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_boolean'; +function duk_is_number(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_number'; +function duk_is_nan(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_nan'; +function duk_is_string(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_string'; +function duk_is_object(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_object'; +function duk_is_buffer(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_buffer'; +function duk_is_buffer_data(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_buffer_data'; +function duk_is_pointer(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_pointer'; +function duk_is_lightfunc(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_lightfunc'; + +function duk_is_symbol(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_symbol'; +function duk_is_array(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_array'; +function duk_is_function(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_function'; +function duk_is_c_function(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_c_function'; +function duk_is_ecmascript_function(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_ecmascript_function'; +function duk_is_bound_function(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_bound_function'; +function duk_is_thread(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_thread'; +function duk_is_callable(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; +function duk_is_constructable(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_constructable'; + +function duk_is_dynamic_buffer(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_dynamic_buffer'; +function duk_is_fixed_buffer(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_fixed_buffer'; +function duk_is_external_buffer(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_is_external_buffer'; + +(* Buffers and lightfuncs are not considered primitive because they mimic + * objects and e.g. duk_to_primitive() will coerce them instead of returning + * them as is. Symbols are represented as strings internally. + *) +function duk_is_primitive(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; + +(* Symbols are object coercible, covered by DUK_TYPE_MASK_STRING. *) +function duk_is_object_coercible(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; + +function duk_get_error_code(ctx: PDukContext; idx: TDukIdx): TDukErrcode; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_error_code'; +function duk_is_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_eval_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_range_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_reference_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_syntax_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_type_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +function duk_is_uri_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; + +(* + * Get operations: no coercion, returns default value for invalid + * indices and invalid value types. + * + * duk_get_undefined() and duk_get_null() would be pointless and + * are not included. + *) + +function duk_get_boolean(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_boolean'; +function duk_get_number(ctx: PDukContext; idx: TDukIdx): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_number'; +function duk_get_int(ctx: PDukContext; idx: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_int'; +function duk_get_uint(ctx: PDukContext; idx: TDukIdx): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_uint'; +function duk_get_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_string'; +function duk_get_lstring(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_lstring'; +function duk_get_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_buffer'; +function duk_get_buffer_data(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_buffer_data'; +function duk_get_pointer(ctx: PDukContext; idx: TDukIdx): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_pointer'; +function duk_get_c_function(ctx: PDukContext; idx: TDukIdx): TDukCFunction; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_c_function'; +function duk_get_context(ctx: PDukContext; idx: TDukIdx): PDukContext; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_context'; +function duk_get_heapptr(ctx: PDukContext; idx: TDukIdx): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_heapptr'; + +(* + * Get-with-explicit default operations: like get operations but with an + * explicit default value. + *) + +function duk_get_boolean_default(ctx: PDukContext; idx: TDukIdx; def_value: TDukBool): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_boolean_default'; +function duk_get_number_default(ctx: PDukContext; idx: TDukIdx; def_value: TDukDouble): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_number_default'; +function duk_get_int_default(ctx: PDukContext; idx: TDukIdx; def_value: TDukInt): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_int_default'; +function duk_get_uint_default(ctx: PDukContext; idx: TDukIdx; def_value: TDukUInt): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_uint_default'; +function duk_get_string_default(ctx: PDukContext; idx: TDukIdx; const def_value: MarshaledAString): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_string_default'; +function duk_get_lstring_default(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize; const def_ptr: MarshaledAString; def_len: TDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_lstring_default'; +function duk_get_buffer_default(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize; def_ptr: Pointer; def_len: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_buffer_default'; +function duk_get_buffer_data_default(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize; def_ptr: Pointer; def_len: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_buffer_data_default'; +function duk_get_pointer_default(ctx: PDukContext; idx: TDukIdx; def_value: Pointer): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_pointer_default'; +function duk_get_c_function_default(ctx: PDukContext; idx: TDukIdx; def_value: TDukCFunction): TDukCFunction; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_c_function_default'; +function duk_get_context_default(ctx: PDukContext; idx: TDukIdx; def_value: PDukContext): PDukContext; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_context_default'; +function duk_get_heapptr_default(ctx: PDukContext; idx: TDukIdx; def_value: Pointer): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_heapptr_default'; + +(* + * Opt operations: like require operations but with an explicit default value + * when value is undefined or index is invalid, null and non-matching types + * cause a TypeError. + *) + +function duk_opt_boolean(ctx: PDukContext; idx: TDukIdx; def_value: TDukBool): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_boolean'; +function duk_opt_number(ctx: PDukContext; idx: TDukIdx; def_value: TDukDouble): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_number'; +function duk_opt_int(ctx: PDukContext; idx: TDukIdx; def_value: TDukInt): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_int'; +function duk_opt_uint(ctx: PDukContext; idx: TDukIdx; def_value: TDukUInt): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_uint'; +function duk_opt_string(ctx: PDukContext; idx: TDukIdx; const def_ptr: MarshaledAString): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_string'; +function duk_opt_lstring(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize; const def_ptr: MarshaledAString; def_len: TDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_lstring'; +function duk_opt_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize; def_ptr: Pointer; def_size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_buffer'; +function duk_opt_buffer_data(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize; def_ptr: Pointer; def_size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_buffer_data'; +function duk_opt_pointer(ctx: PDukContext; idx: TDukIdx; def_value: Pointer): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_pointer'; +function duk_opt_c_function(ctx: PDukContext; idx: TDukIdx; def_value: TDukCFunction): TDukCFunction; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_c_function'; +function duk_opt_context(ctx: PDukContext; idx: TDukIdx; def_value: PDukContext): PDukContext; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_context'; +function duk_opt_heapptr(ctx: PDukContext; idx: TDukIdx; def_value: Pointer): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_opt_heapptr'; + +(* + * Require operations: no coercion, throw error if index or type + * is incorrect. No defaulting. + *) + +procedure duk_require_type_mask(ctx: PDukContext; idx: TDukIdx; mask: TDukUInt); inline; + +procedure duk_require_undefined(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_undefined'; +procedure duk_require_null(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_null'; +function duk_require_boolean(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_boolean'; +function duk_require_number(ctx: PDukContext; idx: TDukIdx): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_number'; +function duk_require_int(ctx: PDukContext; idx: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_int'; +function duk_require_uint(ctx: PDukContext; idx: TDukIdx): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_uint'; +function duk_require_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_string'; +function duk_require_lstring(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_lstring'; +procedure duk_require_object(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_object'; +function duk_require_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_buffer'; +function duk_require_buffer_data(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_buffer_data'; +function duk_require_pointer(ctx: PDukContext; idx: TDukIdx): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_pointer'; +function duk_require_c_function(ctx: PDukContext; idx: TDukIdx): TDukCFunction; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_c_function'; +function duk_require_context(ctx: PDukContext; idx: TDukIdx): PDukContext; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_context'; +procedure duk_require_function(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_function'; +procedure duk_require_callable(ctx: PDukContext; idx: TDukIdx); inline; +function duk_require_heapptr(ctx: PDukContext; idx: TDukIdx): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_require_heapptr'; + +(* Symbols are object coercible and covered by DUK_TYPE_MASK_STRING. *) +procedure duk_require_object_coercible(ctx: PDukContext; idx: TDukIdx); inline; + +(* + * Coercion operations: in-place coercion, return coerced value where + * applicable. If index is invalid, throw error. Some coercions may + * throw an expected error (e.g. from a toString() or valueOf() call) + * or an internal error (e.g. from out of memory). + *) + +procedure duk_to_undefined(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_undefined'; +procedure duk_to_null(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_null'; +function duk_to_boolean(ctx: PDukContext; idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_boolean'; +function duk_to_number(ctx: PDukContext; idx: TDukIdx): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_number'; +function duk_to_int(ctx: PDukContext; idx: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_int'; +function duk_to_uint(ctx: PDukContext; idx: TDukIdx): TDukUInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_uint'; +function duk_to_int32(ctx: PDukContext; idx: TDukIdx): TDukInt32; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_int32'; +function duk_to_uint32(ctx: PDukContext; idx: TDukIdx): TDukUInt32; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_uint32'; +function duk_to_uint16(ctx: PDukContext; idx: TDukIdx): TDukUInt16; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_uint16'; +function duk_to_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_string'; +function duk_to_lstring(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_lstring'; +function duk_to_buffer_raw(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize; flags: TDukUInt): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_buffer_raw'; +function duk_to_pointer(ctx: PDukContext; idx: TDukIdx): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_pointer'; +procedure duk_to_object(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_object'; +procedure duk_to_primitive(ctx: PDukContext; idx: TDukIdx; hint: TDukInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_to_primitive'; + +const + DUK_BUF_MODE_FIXED = 0; (* internal: request fixed buffer result *) + DUK_BUF_MODE_DYNAMIC = 1; (* internal: request dynamic buffer result *) + DUK_BUF_MODE_DONTCARE = 2; (* internal: don't care about fixed/dynamic nature *) + +function duk_to_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; +function duk_to_fixed_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; +function duk_to_dynamic_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; + +(* safe variants of a few coercion operations *) +function duk_safe_to_lstring(ctx: PDukContext; idx: TDukIdx; out_len: PDukSize): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_safe_to_lstring'; +function duk_safe_to_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; inline; + +(* + * Value length + *) + +function duk_get_length(ctx: PDukContext; idx: TDukIdx): TDukSize; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_length'; +procedure duk_set_length(ctx: PDukContext; idx: TDukIdx; len: TDukSize); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_length'; + +(* + * Misc conversion + *) + +function duk_base64_encode(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_base64_encode'; +procedure duk_base64_decode(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_base64_decode'; +function duk_hex_encode(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_hex_encode'; +procedure duk_hex_decode(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_hex_decode'; +function duk_json_encode(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_json_encode'; +procedure duk_json_decode(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_json_decode'; + +function duk_buffer_to_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; cdecl external LIB_DUKTAPE name PREFIX + 'duk_buffer_to_string'; + +(* + * Buffer + *) + +function duk_resize_buffer(ctx: PDukContext; idx: TDukIdx; new_size: TDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_resize_buffer'; +function duk_steal_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; cdecl external LIB_DUKTAPE name PREFIX + 'duk_steal_buffer'; +procedure duk_config_buffer(ctx: PDukContext; idx: TDukIdx; ptr: Pointer; len: TDukSize); cdecl external LIB_DUKTAPE name PREFIX + 'duk_config_buffer'; + +(* + * Property access + * + * The basic function assumes key is on stack. The _string variant takes + * a C string as a property name, while the _index variant takes an array + * index as a property name (e.g. 123 is equivalent to the key "123"). + *) + +function duk_get_prop(ctx: PDukContext; obj_idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop'; +function duk_get_prop_string(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop_string'; +function duk_get_prop_lstring(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop_lstring'; +function duk_get_prop_index(ctx: PDukContext; obj_idx: TDukIdx; arr_idx: TDukUArrIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop_index'; +function duk_get_prop_heapptr(ctx: PDukContext; obj_idx: TDukIdx; ptr: Pointer): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop_heapptr'; +function duk_put_prop(ctx: PDukContext; obj_idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_prop'; +function duk_put_prop_string(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_prop_string'; +function duk_put_prop_lstring(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_prop_lstring'; +function duk_put_prop_index(ctx: PDukContext; obj_idx: TDukIdx; arr_idx: TDukUArrIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_prop_index'; +function duk_put_prop_heapptr(ctx: PDukContext; obj_idx: TDukIdx; ptr: Pointer): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_prop_heapptr'; +function duk_del_prop(ctx: PDukContext; obj_idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_del_prop'; +function duk_del_prop_string(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_del_prop_string'; +function duk_del_prop_lstring(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_del_prop_lstring'; +function duk_del_prop_index(ctx: PDukContext; obj_idx: TDukIdx; arr_idx: TDukUArrIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_del_prop_index'; +function duk_del_prop_heapptr(ctx: PDukContext; obj_idx: TDukIdx; ptr: Pointer): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_del_prop_heapptr'; +function duk_has_prop(ctx: PDukContext; obj_idx: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_has_prop'; +function duk_has_prop_string(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_has_prop_string'; +function duk_has_prop_lstring(ctx: PDukContext; obj_idx: TDukIdx; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_has_prop_lstring'; +function duk_has_prop_index(ctx: PDukContext; obj_idx: TDukIdx; arr_idx: TDukUArrIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_has_prop_index'; +function duk_has_prop_heapptr(ctx: PDukContext; obj_idx: TDukIdx; ptr: Pointer): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_has_prop_heapptr'; + +procedure duk_get_prop_desc(ctx: PDukContext; obj_idx: TDukIdx; flags: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prop_desc'; +procedure duk_def_prop(ctx: PDukContext; obj_idx: TDukIdx; flags: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_def_prop'; + +function duk_get_global_string(ctx: PDukContext; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_global_string'; +function duk_get_global_lstring(ctx: PDukContext; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_global_lstring'; +function duk_put_global_string(ctx: PDukContext; const key: MarshaledAString): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_global_string'; +function duk_put_global_lstring(ctx: PDukContext; const key: MarshaledAString; key_len: TDukSize): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_global_lstring'; + +(* + * Inspection + *) + +procedure duk_inspect_value(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_inspect_value'; +procedure duk_inspect_callstack_entry(ctx: PDukContext; level: TDukInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_inspect_callstack_entry'; + +(* + * Object prototype + *) + +procedure duk_get_prototype(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_prototype'; +procedure duk_set_prototype(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_prototype'; + +(* + * Object finalizer + *) + +procedure duk_get_finalizer(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_finalizer'; +procedure duk_set_finalizer(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_finalizer'; + +(* + * Global object + *) + +procedure duk_set_global_object(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_global_object'; + +(* + * Duktape/C function magic value + *) + +function duk_get_magic(ctx: PDukContext; idx: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_magic'; +procedure duk_set_magic(ctx: PDukContext; idx: TDukIdx; magic: TDukInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_set_magic'; +function duk_get_current_magic(ctx: PDukContext): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_current_magic'; + +(* + * Module helpers: put multiple function or constant properties + *) + +procedure duk_put_function_list(ctx: PDukContext; obj_idx: TDukIdx; const funcs: PDukFunctionListEntry); cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_function_list'; +procedure duk_put_number_list(ctx: PDukContext; obj_idx: TDukIdx; const numbers: PDukNumberListEntry); cdecl external LIB_DUKTAPE name PREFIX + 'duk_put_number_list'; + +(* + * Object operations + *) + +procedure duk_compact(ctx: PDukContext; obj_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_compact'; +procedure duk_enum(ctx: PDukContext; obj_idx: TDukIdx; enum_flags: TDukUInt); cdecl external LIB_DUKTAPE name PREFIX + 'duk_enum'; +function duk_next(ctx: PDukContext; enum_idx: TDukIdx; get_value: TDukBool): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_next'; +procedure duk_seal(ctx: PDukContext; obj_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_seal'; +procedure duk_freeze(ctx: PDukContext; obj_idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_freeze'; + +(* + * String manipulation + *) + +procedure duk_concat(ctx: PDukContext; count: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_concat'; +procedure duk_join(ctx: PDukContext; count: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_join'; +procedure duk_decode_string(ctx: PDukContext; idx: TDukIdx; callback: TDukDecodeCharFunction; udata: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_decode_string'; +procedure duk_map_string(ctx: PDukContext; idx: TDukIdx; callback: TDukMapCharFunction; udata: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_map_string'; +procedure duk_substring(ctx: PDukContext; idx: TDukIdx; start_char_offset: TDukSize; end_char_offset: TDukSize); cdecl external LIB_DUKTAPE name PREFIX + 'duk_substring'; +procedure duk_trim(ctx: PDukContext; idx: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_trim'; +function duk_char_code_at(ctx: PDukContext; idx: TDukIdx; char_offset: TDukSize): TDukCodepoint; cdecl external LIB_DUKTAPE name PREFIX + 'duk_char_code_at'; + +(* + * Ecmascript operators + *) + +function duk_equals(ctx: PDukContext; idx1: TDukIdx; idx2: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_equals'; +function duk_strict_equals(ctx: PDukContext; idx1: TDukIdx; idx2: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_strict_equals'; +function duk_samevalue(ctx: PDukContext; idx1: TDukIdx; idx2: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_samevalue'; +function duk_instanceof(ctx: PDukContext; idx1: TDukIdx; idx2: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_instanceof'; + +(* + * Function (method) calls + *) + +procedure duk_call(ctx: PDukContext; nargs: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_call'; +procedure duk_call_method(ctx: PDukContext; nargs: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_call_method'; +procedure duk_call_prop(ctx: PDukContext; obj_idx: TDukIdx; nargs: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_call_prop'; +function duk_pcall(ctx: PDukContext; nargs: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_pcall'; +function duk_pcall_method(ctx: PDukContext; nargs: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_pcall_method'; +function duk_pcall_prop(ctx: PDukContext; obj_idx: TDukIdx; nargs: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_pcall_prop'; +procedure duk_new(ctx: PDukContext; nargs: TDukIdx); cdecl external LIB_DUKTAPE name PREFIX + 'duk_new'; +function duk_pnew(ctx: PDukContext; nargs: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_pnew'; +function duk_safe_call(ctx: PDukContext; func: TDukSafeCallFunction; udata: Pointer; nargs: TDukIdx; nrets: TDukIdx): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_safe_call'; + +(* + * Thread management + *) + +(* There are currently no native functions to yield/resume, due to the internal + * limitations on coroutine handling. These will be added later. + *) + +(* + * Compilation and evaluation + *) + +function duk_eval_raw(ctx: PDukContext; const src_buffer: MarshaledAString; src_length: TDukSize; flags: TDukUInt): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_eval_raw'; +function duk_compile_raw(ctx: PDukContext; const src_buffer: MarshaledAString; src_length: TDukSize; flags: TDukUInt): TDukInt; cdecl external LIB_DUKTAPE name PREFIX + 'duk_compile_raw'; + +(* plain *) +function duk_eval(ctx: PDukContext): TDukInt; inline; +function duk_eval_noresult(ctx: PDukContext): TDukInt; inline; +function duk_peval(ctx: PDukContext): TDukInt; inline; +function duk_peval_noresult(ctx: PDukContext): TDukInt; inline; +function duk_compile(ctx: PDukContext; flags: TDukUInt): TDukInt; inline; +function duk_pcompile(ctx: PDukContext; flags: TDukUInt): TDukInt; inline; + +(* string *) +function duk_eval_string(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +function duk_eval_string_noresult(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +function duk_peval_string(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +function duk_peval_string_noresult(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +function duk_compile_string(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +function duk_compile_string_filename(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +function duk_pcompile_string(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +function duk_pcompile_string_filename(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; + +(* lstring *) +function duk_eval_lstring(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_eval_lstring_noresult(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_peval_lstring(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_peval_lstring_noresult(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_compile_lstring(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_compile_lstring_filename(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_pcompile_lstring(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +function duk_pcompile_lstring_filename(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; + +(* + * Bytecode load/dump + *) + +procedure duk_dump_function(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_dump_function'; +procedure duk_load_function(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_load_function'; + +(* + * Debugging + *) + +procedure duk_push_context_dump(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_push_context_dump'; + +(* + * Debugger (debug protocol) + *) + +procedure duk_debugger_attach(ctx: PDukContext; read_cb: TDukDebugReadFunction; write_cb: TDukDebugWriteFunction; peek_cb: TDukDebugPeekFunction; read_flush_cb: TDukDebugReadFlushFunction; write_flush_cb: TDukDebugWriteFlushFunction; request_cb: TDukDebugRequestFunction; detached_cb: TDukDebugDetachedFunction; udata: Pointer); cdecl external LIB_DUKTAPE name PREFIX + 'duk_debugger_attach'; +procedure duk_debugger_detach(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_debugger_detach'; +procedure duk_debugger_cooperate(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_debugger_cooperate'; +function duk_debugger_notify(ctx: PDukContext; nvalues: TDukIdx): TDukBool; cdecl external LIB_DUKTAPE name PREFIX + 'duk_debugger_notify'; +procedure duk_debugger_pause(ctx: PDukContext); cdecl external LIB_DUKTAPE name PREFIX + 'duk_debugger_pause'; + +(* + * Time handling + *) + +function duk_get_now(ctx: PDukContext): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_get_now'; +procedure duk_time_to_components(ctx: PDukContext; timeval: TDukDouble; comp: PDukTimeComponents); cdecl external LIB_DUKTAPE name PREFIX + 'duk_time_to_components'; +function duk_components_to_time(ctx: PDukContext; comp: PDukTimeComponents): TDukDouble; cdecl external LIB_DUKTAPE name PREFIX + 'duk_components_to_time'; + +(* + * Date provider related constants + * + * NOTE: These are "semi public" - you should only use these if you write + * your own platform specific Date provider, see doc/datetime.rst. + *) + +(* Millisecond count constants. *) +const + DUK_DATE_MSEC_SECOND = 1000; + DUK_DATE_MSEC_MINUTE = 60 * 1000; + DUK_DATE_MSEC_HOUR = 60 * 60 * 1000; + DUK_DATE_MSEC_DAY = 24 * 60 * 60 * 1000; + +(* Ecmascript date range is 100 million days from Epoch: + * > 100e6 * 24 * 60 * 60 * 1000 // 100M days in millisecs + * 8640000000000000 + * (= 8.64e15) + *) +const + DUK_DATE_MSEC_100M_DAYS = 8.64e15; + DUK_DATE_MSEC_100M_DAYS_LEEWAY = 8.64e15 + 24 * 3600e3; + +(* Ecmascript year range: + * > new Date(100e6 * 24 * 3600e3).toISOString() + * '+275760-09-13T00:00:00.000Z' + * > new Date(-100e6 * 24 * 3600e3).toISOString() + * '-271821-04-20T00:00:00.000Z' + *) +const + DUK_DATE_MIN_ECMA_YEAR = -271821; + DUK_DATE_MAX_ECMA_YEAR = 275760; + +(* Part indices for internal breakdowns. Part order from DUK_DATE_IDX_YEAR + * to DUK_DATE_IDX_MILLISECOND matches argument ordering of Ecmascript API + * calls (like Date constructor call). Some functions in duk_bi_date.c + * depend on the specific ordering, so change with care. 16 bits are not + * enough for all parts (year, specifically). + * + * Must be in-sync with genbuiltins.py. + *) +const + DUK_DATE_IDX_YEAR = 0; (* year *) + DUK_DATE_IDX_MONTH = 1; (* month: 0 to 11 *) + DUK_DATE_IDX_DAY = 2; (* day within month: 0 to 30 *) + DUK_DATE_IDX_HOUR = 3; + DUK_DATE_IDX_MINUTE = 4; + DUK_DATE_IDX_SECOND = 5; + DUK_DATE_IDX_MILLISECOND = 6; + DUK_DATE_IDX_WEEKDAY = 7; (* weekday: 0 to 6, 0=sunday, 1=monday, etc *) + DUK_DATE_IDX_NUM_PARTS = 8; + +(* Internal API call flags, used for various functions in duk_bi_date.c. + * Certain flags are used by only certain functions, but since the flags + * don't overlap, a single flags value can be passed around to multiple + * functions. + * + * The unused top bits of the flags field are also used to pass values + * to helpers (duk__get_part_helper() and duk__set_part_helper()). + * + * Must be in-sync with genbuiltins.py. + *) + +(* NOTE: when writing a Date provider you only need a few specific + * flags from here, the rest are internal. Avoid using anything you + * don't need. + *) +const + DUK_DATE_FLAG_NAN_TO_ZERO = 1 shl 0; (* timeval breakdown: internal time value NaN -> zero *) + DUK_DATE_FLAG_NAN_TO_RANGE_ERROR = 1 shl 1; (* timeval breakdown: internal time value NaN -> RangeError (toISOString) *) + DUK_DATE_FLAG_ONEBASED = 1 shl 2; (* timeval breakdown: convert month and day-of-month parts to one-based (default is zero-based) *) + DUK_DATE_FLAG_EQUIVYEAR = 1 shl 3; (* timeval breakdown: replace year with equivalent year in the [1971,2037] range for DST calculations *) + DUK_DATE_FLAG_LOCALTIME = 1 shl 4; (* convert time value to local time *) + DUK_DATE_FLAG_SUB1900 = 1 shl 5; (* getter: subtract 1900 from year when getting year part *) + DUK_DATE_FLAG_TOSTRING_DATE = 1 shl 6; (* include date part in string conversion result *) + DUK_DATE_FLAG_TOSTRING_TIME = 1 shl 7; (* include time part in string conversion result *) + DUK_DATE_FLAG_TOSTRING_LOCALE = 1 shl 8; (* use locale specific formatting if available *) + DUK_DATE_FLAG_TIMESETTER = 1 shl 9; (* setter: call is a time setter (affects hour, min, sec, ms); otherwise date setter (affects year, month, day-in-month) *) + DUK_DATE_FLAG_YEAR_FIXUP = 1 shl 10; (* setter: perform 2-digit year fixup (00...99 -> 1900...1999) *) + DUK_DATE_FLAG_SEP_T = 1 shl 11; (* string conversion: use 'T' instead of ' ' as a separator *) + DUK_DATE_FLAG_VALUE_SHIFT = 12; (* additional values begin at bit 12 *) + +(* + * END PUBLIC API + *) + +implementation + +function DUK_HIDDEN_SYMBOL(const AX: UTF8String): UTF8String; inline; +begin + Result := #$FF + AX; +end; + +function DUK_GLOBAL_SYMBOL(const AX: UTF8String): UTF8String; inline; +begin + Result := #$80 + AX; +end; + +function DUK_LOCAL_SYMBOL(const AX, AUniq: UTF8String): UTF8String; inline; +begin + Result := #$81 + AX + #$FF + AUniq; +end; + +function DUK_WELLKNOWN_SYMBOL(const AX: UTF8String): UTF8String; inline; +begin + Result := #$81 + AX + #$FF; +end; + +function duk_create_heap_default: PDukContext; inline; +begin + Result := duk_create_heap(nil, nil, nil, nil, nil); +end; + +procedure duk_throw(ctx: PDukContext); inline; +begin + duk_throw_raw(ctx); +end; + +procedure duk_fatal(ctx: PDukContext; const err_msg: MarshaledAString); inline; +begin + duk_fatal_raw(ctx, err_msg); +end; + +procedure duk_error(ctx: PDukContext; err_code: TDukErrCode; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, err_code, nil, 0, fmt); +end; + +procedure duk_generic_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_ERROR, nil, 0, fmt); +end; + +procedure duk_eval_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_EVAL_ERROR, nil, 0, fmt); +end; + +procedure duk_range_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_RANGE_ERROR, nil, 0, fmt); +end; + +procedure duk_reference_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_REFERENCE_ERROR, nil, 0, fmt); +end; + +procedure duk_syntax_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_SYNTAX_ERROR, nil, 0, fmt); +end; + +procedure duk_type_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_TYPE_ERROR, nil, 0, fmt); +end; + +procedure duk_uri_error(ctx: PDukContext; const fmt: MarshaledAString); inline; +begin + duk_error_raw(ctx, DUK_ERR_URI_ERROR, nil, 0, fmt); +end; + +procedure duk_xmove_top(to_ctx: PDukContext; from_ctx: PDukContext; count: TDukIdx); inline; +begin + duk_xcopymove_raw(to_ctx, from_ctx, count, 0); +end; + +procedure duk_xcopy_top(to_ctx: PDukContext; from_ctx: PDukContext; count: TDukIdx); inline; +begin + duk_xcopymove_raw(to_ctx, from_ctx, count, 1); +end; + +function duk_push_thread(ctx: PDukContext): TDukIdx; inline; +begin + Result := duk_push_thread_raw(ctx, 0); +end; + +function duk_push_thread_new_globalenv(ctx: PDukContext): TDukIdx; inline; +begin + Result := duk_push_thread_raw(ctx, DUK_THREAD_NEW_GLOBAL_ENV); +end; + +function duk_push_error_object(ctx: PDukContext; err_code: TDukErrcode; const fmt: MarshaledAString): TDukIdx; inline; +begin + Result := duk_push_error_object_raw(ctx, err_code, nil, 0, fmt); +end; + +function duk_push_buffer(ctx: PDukContext; size: TDukSize; dynamic: Boolean): Pointer; inline; +begin + if (dynamic) then + Result := duk_push_buffer_raw(ctx, size, DUK_BUF_FLAG_DYNAMIC) + else + Result := duk_push_buffer_raw(ctx, size, 0); +end; + +function duk_push_fixed_buffer(ctx: PDukContext; size: TDukSize): Pointer; inline; +begin + Result := duk_push_buffer_raw(ctx, size, 0); +end; + +function duk_push_dynamic_buffer(ctx: PDukContext; size: TDukSize): Pointer; inline; +begin + Result := duk_push_buffer_raw(ctx, size, DUK_BUF_FLAG_DYNAMIC); +end; + +function duk_push_external_buffer(ctx: PDukContext): Pointer; inline; +begin + Result := duk_push_buffer_raw(ctx, 0, DUK_BUF_FLAG_DYNAMIC or DUK_BUF_FLAG_EXTERNAL); +end; + +function duk_is_null_or_undefined(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; +begin + Result := Ord((duk_get_type_mask(ctx, idx) and (DUK_TYPE_MASK_NULL or DUK_TYPE_MASK_UNDEFINED)) <> 0); +end; + +function duk_is_callable(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; +begin + Result := duk_is_function(ctx, idx); +end; + +function duk_is_primitive(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; +begin + Result := duk_check_type_mask(ctx, idx, DUK_TYPE_MASK_UNDEFINED or + DUK_TYPE_MASK_NULL or DUK_TYPE_MASK_BOOLEAN or DUK_TYPE_MASK_NUMBER or + DUK_TYPE_MASK_STRING or DUK_TYPE_MASK_POINTER); +end; + +function duk_is_object_coercible(ctx: PDukContext; idx: TDukIdx): TDukBool; inline; +begin + Result := duk_check_type_mask(ctx, idx, DUK_TYPE_MASK_BOOLEAN or + DUK_TYPE_MASK_NUMBER or DUK_TYPE_MASK_STRING or DUK_TYPE_MASK_OBJECT or + DUK_TYPE_MASK_BUFFER or DUK_TYPE_MASK_POINTER or DUK_TYPE_MASK_LIGHTFUNC); +end; + +function duk_is_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) <> 0); +end; + +function duk_is_eval_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_EVAL_ERROR); +end; + +function duk_is_range_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_RANGE_ERROR); +end; + +function duk_is_reference_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_REFERENCE_ERROR); +end; + +function duk_is_syntax_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_SYNTAX_ERROR); +end; + +function duk_is_type_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_TYPE_ERROR); +end; + +function duk_is_uri_error(ctx: PDukContext; idx: TDukIdx): Boolean; inline; +begin + Result := (duk_get_error_code(ctx, idx) = DUK_ERR_URI_ERROR); +end; + +procedure duk_require_type_mask(ctx: PDukContext; idx: TDukIdx; mask: TDukUInt); inline; +begin + duk_check_type_mask(ctx, idx, mask or DUK_TYPE_MASK_THROW); +end; + +procedure duk_require_callable(ctx: PDukContext; idx: TDukIdx); inline; +begin + duk_require_function(ctx, idx); +end; + +procedure duk_require_object_coercible(ctx: PDukContext; idx: TDukIdx); inline; +begin + duk_check_type_mask(ctx, idx, DUK_TYPE_MASK_BOOLEAN or DUK_TYPE_MASK_NUMBER or + DUK_TYPE_MASK_STRING or DUK_TYPE_MASK_OBJECT or DUK_TYPE_MASK_BUFFER or + DUK_TYPE_MASK_POINTER or DUK_TYPE_MASK_LIGHTFUNC or DUK_TYPE_MASK_THROW); +end; + +function duk_to_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; +begin + Result := duk_to_buffer_raw(ctx, idx, out_size, DUK_BUF_MODE_DONTCARE); +end; + +function duk_to_fixed_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; +begin + Result := duk_to_buffer_raw(ctx, idx, out_size, DUK_BUF_MODE_FIXED); +end; + +function duk_to_dynamic_buffer(ctx: PDukContext; idx: TDukIdx; out_size: PDukSize): Pointer; inline; +begin + Result := duk_to_buffer_raw(ctx, idx, out_size, DUK_BUF_MODE_DYNAMIC); +end; + +function duk_safe_to_string(ctx: PDukContext; idx: TDukIdx): MarshaledAString; inline; +begin + Result := duk_safe_to_lstring(ctx, idx, nil); +end; + +function duk_eval(ctx: PDukContext): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, nil, 0, 1 or DUK_COMPILE_EVAL + or DUK_COMPILE_NOFILENAME); +end; + +function duk_eval_noresult(ctx: PDukContext): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, nil, 0, 1 or DUK_COMPILE_EVAL + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_NORESULT); +end; + +function duk_peval(ctx: PDukContext): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, nil, 0, 1 or DUK_COMPILE_EVAL + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE); +end; + +function duk_peval_noresult(ctx: PDukContext): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, nil, 0, 1 or DUK_COMPILE_EVAL + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE or DUK_COMPILE_NORESULT); +end; + +function duk_compile(ctx: PDukContext; flags: TDukUInt): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, 2 or flags); +end; + +function duk_pcompile(ctx: PDukContext; flags: TDukUInt): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, 2 or flags or DUK_COMPILE_SAFE); +end; + +function duk_eval_string(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, src, 0, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME); +end; + +function duk_eval_string_noresult(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, src, 0, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME or DUK_COMPILE_NORESULT); +end; + +function duk_peval_string(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, src, 0, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE); +end; + +function duk_peval_string_noresult(ctx: PDukContext; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, src, 0, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE + or DUK_COMPILE_NORESULT); +end; + +function duk_compile_string(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME); +end; + +function duk_compile_string_filename(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, 1 or flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_STRLEN); +end; + +function duk_pcompile_string(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_STRLEN or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE); +end; + +function duk_pcompile_string_filename(ctx: PDukContext; flags: TDukUInt; const src: MarshaledAString): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, nil, 0, 1 or flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_STRLEN or DUK_COMPILE_SAFE); +end; + +function duk_eval_lstring(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, buf, len, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_NOFILENAME); +end; + +function duk_eval_lstring_noresult(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, buf, len, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_NORESULT); +end; + +function duk_peval_lstring(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, buf, len, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE); +end; + +function duk_peval_lstring_noresult(ctx: PDukContext; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_eval_raw(ctx, buf, len, DUK_COMPILE_EVAL or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE or DUK_COMPILE_NORESULT); +end; + +function duk_compile_lstring(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, buf, len, flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_NOFILENAME); +end; + +function duk_compile_lstring_filename(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, buf, len, 1 or flags or DUK_COMPILE_NOSOURCE); +end; + +function duk_pcompile_lstring(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, buf, len, flags or DUK_COMPILE_NOSOURCE or + DUK_COMPILE_NOFILENAME or DUK_COMPILE_SAFE); +end; + +function duk_pcompile_lstring_filename(ctx: PDukContext; flags: TDukUInt; const buf: MarshaledAString; len: TDukSize): TDukInt; inline; +begin + Result := duk_compile_raw(ctx, buf, len, 1 or flags or DUK_COMPILE_NOSOURCE + or DUK_COMPILE_SAFE); +end; + +end. diff --git a/baseunits/FMDOptions.pas b/baseunits/FMDOptions.pas new file mode 100644 index 000000000..17df664b4 --- /dev/null +++ b/baseunits/FMDOptions.pas @@ -0,0 +1,380 @@ +unit FMDOptions; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, IniFiles, fileinfo, FileUtil, Forms, Graphics, LazFileUtils, LazUTF8; + +type + + { TIniFileRun } + + TIniFileRun = class(IniFiles.TMemIniFile) + private + FCSLock: TRTLCriticalSection; + FFileAge: LongInt; + FRealFileName: String; + public + constructor Create(const AFileName: String; AEscapeLineFeeds: Boolean = False); overload; override; + destructor Destroy; override; + procedure UpdateFile; override; + end; + + TFMDDo = (DO_NOTHING, DO_EXIT, DO_POWEROFF, DO_HIBERNATE, DO_UPDATE); + +const + FMD_REVISION = '$WCREV$'; + FMD_INSTANCE = '_FreeMangaDownloaderInstance_'; + FMD_TARGETOS = {$i %FPCTARGETOS%}; + FMD_TARGETCPU = {$i %FPCTARGETCPU%}; + + EXPARAM_PATH = '%PATH%'; + EXPARAM_CHAPTER = '%CHAPTER%'; + DEFAULT_EXPARAM = '"' + EXPARAM_PATH + EXPARAM_CHAPTER + '"'; + + DEFAULT_MANGA_CUSTOMRENAME = '%MANGA%'; + DEFAULT_CHAPTER_CUSTOMRENAME = '%CHAPTER%'; + DEFAULT_FILENAME_CUSTOMRENAME = '%FILENAME%'; + + DATA_EXT = '.dat'; + DBDATA_EXT = '.db'; + DBDATA_SERVER_EXT = '.7z'; + UPDATER_EXE = 'updater.exe'; + OLD_UPDATER_EXE = 'old_' + UPDATER_EXE; + ZIP_EXE = '7za.exe'; + RUN_EXE = '.run'; + + + SOCKHEARTBEATRATE = 500; + {$IFDEF WINDOWS} + {$IFDEF WIN32} + MAX_TASKLIMIT = 16; + MAX_CONNECTIONPERHOSTLIMIT = 64; + {$ENDIF} + {$IFDEF WIN64} + MAX_TASKLIMIT = 64; + MAX_CONNECTIONPERHOSTLIMIT = 256; + {$ENDIF} + {$ELSE} + MAX_TASKLIMIT = 8; + MAX_CONNECTIONPERHOSTLIMIT = 32; + {$ENDIF} + +var + FMD_VERSION_NUMBER: TProgramVersion; + FMD_VERSION_STRING, + FMD_DIRECTORY, + FMD_EXENAME, + CURRENT_UPDATER_EXE, + OLD_CURRENT_UPDATER_EXE, + CURRENT_ZIP_EXE, + APPDATA_DIRECTORY, + DEFAULT_PATH, + WORK_FOLDER, + WORK_FILE, + WORK_FILEDB, + DOWNLOADEDCHAPTERS_FILE, + DOWNLOADEDCHAPTERSDB_FILE, + FAVORITES_FILE, + FAVORITESDB_FILE, + CONFIG_FOLDER, + CONFIG_FILE, + REVISION_FILE, + UPDATE_FILE, + BASE_FILE, + ACCOUNTS_FILE, + MODULES_FILE, + DATA_FOLDER, + IMAGE_FOLDER, + LANGUAGE_FILE, + CHANGELOG_FILE, + DEFAULT_LOG_FILE, + README_FILE, + EXTRAS_FOLDER, + MANGAFOXTEMPLATE_FOLDER, + LUA_WEBSITEMODULE_FOLDER, + LUA_WEBSITEMODULE_FILE: String; + + // ini files + revisionfile, + updatesfile: TIniFile; + configfile: TIniFileRun; + + // base url, should be in base.ini + DEFAULT_SELECTED_WEBSITES: String = 'MangaFox,MangaHere,MangaInn,MangaReader'; + DB_URL: String = 'https://sourceforge.net/projects/newfmd/files/data/.7z/download'; + UPDATE_URL: String = 'https://raw.githubusercontent.com/riderkick/FMD/master/update'; + CHANGELOG_URL: String = 'https://raw.githubusercontent.com/riderkick/FMD/master/changelog.txt'; + UPDATE_PACKAGE_NAME: String = 'updatepackage.7z'; + MODULES_URL: String = 'https://api.github.com/repos/riderkick/FMD/contents/lua/modules'; + MODULES_URL2: String = 'https://github.com/riderkick/FMD/file-list/master/lua/modules'; + + currentWebsite: String; + + // available website + AvailableWebsites: TStringList; + + // general + OptionLetFMDDo: TFMDDo = DO_NOTHING; + OptionDeleteCompletedTasksOnClose: Boolean = False; + + // saveto + OptionChangeUnicodeCharacter: Boolean = False; + OptionChangeUnicodeCharacterStr: String = '_'; + OptionGenerateMangaFolder: Boolean = False; + OptionMangaCustomRename: String; + OptionGenerateChapterFolder: Boolean = True; + OptionChapterCustomRename: String; + OptionFilenameCustomRename: String; + + OptionConvertDigitVolume: Boolean; + OptionConvertDigitChapter: Boolean; + OptionConvertDigitVolumeLength: Integer; + OptionConvertDigitChapterLength: Integer; + + OptionPDFQuality: Cardinal = 95; + + OptionPNGSaveAsJPEG: Boolean = False; + OptionWebPSaveAs: Integer = 1; + OptionPNGCompressionLevel: Integer = 1; + OptionJPEGQuality: Integer = 80; + + // connections + OptionMaxParallel: Integer = 1; + OptionMaxThreads: Integer = 1; + OptionMaxRetry: Integer = 5; + OptionConnectionTimeout: Integer = 30; + OptionRetryFailedTask: Integer = 1; + OptionAlwaysStartTaskFromFailedChapters: Boolean = True; + + // view + OptionEnableLoadCover: Boolean = False; + OptionShowBalloonHint: Boolean = True; + + // updates + OptionAutoCheckLatestVersion: Boolean = True; + OptionAutoCheckFavStartup: Boolean = True; + OptionAutoCheckFavInterval: Boolean = True; + OptionAutoCheckFavIntervalMinutes: Cardinal = 60; + OptionNewMangaTime: Integer = 1; + OptionJDNNewMangaTime: Integer = MaxInt; + OptionAutoCheckFavDownload: Boolean = False; + OptionAutoCheckFavRemoveCompletedManga: Boolean = False; + OptionUpdateListNoMangaInfo: Boolean = False; + OptionUpdateListRemoveDuplicateLocalData: Boolean = False; + + // modules + OptionModulesUpdaterShowUpdateWarning: Boolean = True; + OptionModulesUpdaterAutoRestart: Boolean = False; + + OptionHTTPUseGzip: Boolean = True; + + OptionRemoveMangaNameFromChapter: Boolean = False; + + OptionRestartFMD: Boolean = False; + + //custom color + //basiclist + CL_BSNormalText: TColor = clWindowText; + CL_BSFocusedSelectionText: TColor = clHighlightText; + CL_BSUnfocesedSelectionText: TColor = clWindowText; + CL_BSOdd: TColor = clBtnFace; + CL_BSEven: TColor = clWindow; + CL_BSSortedColumn: TColor = $F8E6D6; + + //mangalist color + CL_MNNewManga: TColor = $FDC594; + CL_MNCompletedManga: TColor = $B8FFB8; + + //favoritelist color + CL_FVBrokenFavorite: TColor = $8080FF; + CL_FVChecking: TColor = $80EBFE; + CL_FVNewChapterFound: TColor = $FDC594; + CL_FVCompletedManga: TColor = $B8FFB8; + CL_FVEmptyChapters: TColor = $CCDDFF; + + //chapterlist color + CL_CHDownloaded: TColor = $B8FFB8; + +// set base directory +procedure SetFMDdirectory(const ADir: String); +procedure SetAppDataDirectory(const ADir: String); + +procedure RestartFMD; +procedure DoRestartFMD; + +implementation + +uses FMDVars, UTF8Process; + +{ TIniFileRun } + +constructor TIniFileRun.Create(const AFileName: String; AEscapeLineFeeds: Boolean); +begin + FRealFileName := AFileName; + if FileExistsUTF8(AFileName + RUN_EXE) then + DeleteFileUTF8(RUN_EXE); + if FileExistsUTF8(AFileName) then + CopyFile(AFileName, AFileName + RUN_EXE); + InitCriticalSection(FCSLock); + if FileExistsUTF8(AFileName) then + FFileAge := FileAgeUTF8(AFileName) + else + FFileAge := 0; + inherited Create(AFileName + RUN_EXE, AEscapeLineFeeds); +end; + +destructor TIniFileRun.Destroy; +begin + inherited Destroy; + DoneCriticalsection(FCSLock); + if FileExistsUTF8(FileName) then + DeleteFileUTF8(FileName); +end; + +procedure TIniFileRun.UpdateFile; +begin + if CacheUpdates and (Dirty = False) then Exit; + inherited UpdateFile; + try + CopyFile(FileName, FRealFileName, [cffOverwriteFile, cffPreserveTime, cffCreateDestDirectory]); + except + end; +end; + +procedure FreeNil(var Obj); +begin + if Pointer(Obj) <> nil then + TObject(Obj).Free; + Pointer(Obj) := nil; +end; + +procedure FreeIniFiles; +begin + FreeNil(configfile); +end; + +procedure SetIniFiles; +begin + FreeIniFiles; + configfile := TIniFileRun.Create(CONFIG_FILE); +end; + +procedure ReadBaseFile; +begin + if not FileExistsUTF8(BASE_FILE) then Exit; + with TIniFile.Create(BASE_FILE) do + try + DEFAULT_SELECTED_WEBSITES:=ReadString('base','DEFAULT_SELECTED_WEBSITES',DEFAULT_SELECTED_WEBSITES); + DB_URL:=ReadString('base','DB_URL',DB_URL); + UPDATE_URL:=ReadString('base','UPDATE_URL',UPDATE_URL); + CHANGELOG_URL:=ReadString('base','CHANGELOG_URL',CHANGELOG_URL); + UPDATE_PACKAGE_NAME:=ReadString('base','UPDATE_PACKAGE_NAME',UPDATE_PACKAGE_NAME); + MODULES_URL:=ReadString('base','MODULES_URL',MODULES_URL); + MODULES_URL2:=ReadString('base','MODULES_URL2',MODULES_URL2); + finally + Free; + end; +end; + +procedure SetFMDdirectory(const ADir: String); +begin + FMD_DIRECTORY := CleanAndExpandDirectory(ADir); + FMD_EXENAME := ExtractFileNameOnly(Application.ExeName); + + CONFIG_FOLDER := FMD_DIRECTORY + 'config' + PathDelim; + REVISION_FILE := CONFIG_FOLDER + 'revision.ini'; + UPDATE_FILE := CONFIG_FOLDER + 'updates.ini'; + BASE_FILE := CONFIG_FOLDER + 'base.ini'; + + IMAGE_FOLDER := FMD_DIRECTORY + 'images' + PathDelim; + LANGUAGE_FILE := FMD_DIRECTORY + 'languages.ini'; + CHANGELOG_FILE := FMD_DIRECTORY + 'changelog.txt'; + README_FILE := FMD_DIRECTORY + 'readme.rtf'; + EXTRAS_FOLDER := FMD_DIRECTORY + 'extras' + PathDelim; + MANGAFOXTEMPLATE_FOLDER := EXTRAS_FOLDER + 'mangafoxtemplate' + PathDelim; + DEFAULT_LOG_FILE := FMD_DIRECTORY + FMD_EXENAME + '.log'; + CURRENT_UPDATER_EXE := FMD_DIRECTORY + UPDATER_EXE; + OLD_CURRENT_UPDATER_EXE := FMD_DIRECTORY + OLD_UPDATER_EXE; + CURRENT_ZIP_EXE := FMD_DIRECTORY + ZIP_EXE; + + + ReadBaseFile; +end; + +procedure SetAppDataDirectory(const ADir: String); +begin + APPDATA_DIRECTORY := CleanAndExpandDirectory(ADir); + + DEFAULT_PATH := 'downloads' + PathDelim; + + CONFIG_FOLDER := APPDATA_DIRECTORY + 'config' + PathDelim; + CONFIG_FILE := CONFIG_FOLDER + 'config.ini'; + ACCOUNTS_FILE := CONFIG_FOLDER + 'accounts.db'; + MODULES_FILE := CONFIG_FOLDER + 'modules.json'; + LUA_WEBSITEMODULE_FILE := CONFIG_FOLDER + 'luamodules.json'; + + DATA_FOLDER := APPDATA_DIRECTORY + 'data' + PathDelim; + + WORK_FOLDER := APPDATA_DIRECTORY + 'works' + PathDelim; + WORK_FILE := WORK_FOLDER + 'works.ini'; + WORK_FILEDB := WORK_FOLDER + 'downloads.db'; + DOWNLOADEDCHAPTERS_FILE := WORK_FOLDER + 'downloadedchapters.ini'; + DOWNLOADEDCHAPTERSDB_FILE := WORK_FOLDER + 'downloadedchapters.db'; + FAVORITES_FILE := WORK_FOLDER + 'favorites.ini'; + FAVORITESDB_FILE := WORK_FOLDER + 'favorites.db'; + + LUA_WEBSITEMODULE_FOLDER := FMD_DIRECTORY + 'lua' + PathDelim + 'modules' + PathDelim; + + SetIniFiles; +end; + +procedure RestartFMD; +begin + OptionRestartFMD := True; + FormMain.Close; +end; + +procedure DoRestartFMD; +var + p: TProcessUTF8; + i: Integer; +begin + p := TProcessUTF8.Create(nil); + try + p.InheritHandles := False; + p.CurrentDirectory := ExtractFilePath(Application.ExeName); + p.Executable := Application.ExeName; + for i := 1 to ParamCount do + p.Parameters.Add(ParamStrUTF8(i)); + p.Execute; + finally + p.Free; + end; +end; + +procedure doInitialization; +begin + GetProgramVersion(FMD_VERSION_NUMBER); + FMD_VERSION_STRING := ProgramversionToStr(FMD_VERSION_NUMBER); + AvailableWebsites := TStringList.Create; + AvailableWebsites.Sorted := False; + SetFMDdirectory(ExtractFilePath(Application.ExeName)); + SetAppDataDirectory(FMD_DIRECTORY); +end; + +procedure doFinalization; +begin + FreeIniFiles; + AvailableWebsites.Free; +end; + +initialization + doInitialization; + +finalization + doFinalization; + +end. diff --git a/baseunits/FMDVars.pas b/baseunits/FMDVars.pas new file mode 100644 index 000000000..adc93738b --- /dev/null +++ b/baseunits/FMDVars.pas @@ -0,0 +1,66 @@ +unit FMDVars; + +{$mode objfpc}{$H+} + +interface + +uses + frmMain, uDownloadsManager, uFavoritesManager, uUpdateThread, DBDataProcess, + uSilentThread, uBaseUnit, uGetMangaInfosThread, CheckUpdate, + FMDOptions, DBUpdater, SelfUpdater, FileChannel, simpleipc; + +var + FormMain: TMainForm; + + isRunDownloadFilter, + isUpdating, + isPendingExitCounter, + isNormalExit: Boolean; + isStartup: Boolean = True; + + //Instance + FMDInstance: TSimpleIPCServer; + + // update fmd through main thread + DoAfterFMD: TFMDDo; + IsDlgCounter: Boolean = False; + + // file logger + FileLogger: TFileChannel; + + // status in status bar update + ulTotalPtr, + ulWorkPtr: Integer; + + // download manager + DLManager: TDownloadManager; + + // favorite manager + FavoriteManager: TFavoriteManager; + + // main dataprocess for manga list + dataProcess: TDBDataProcess; + + // update manga list thread manager + updateList: TUpdateListManagerThread; + + // dbupdater thread + DBUpdaterThread: TDBUpdaterThread; + + // silent thread for download all or add to favorite + SilentThreadManager: TSilentThreadManager; + + // get manga info + mangaInfo: TMangaInfo; + GetInfosThread: TGetMangaInfosThread; + + // check update thread + CheckUpdateThread: TCheckUpdateThread; + + // self updater thread + SelfUpdaterThread: TSelfUpdaterThread; + +implementation + +end. + diff --git a/baseunits/FavoritesDB.pas b/baseunits/FavoritesDB.pas new file mode 100644 index 000000000..c46555ea5 --- /dev/null +++ b/baseunits/FavoritesDB.pas @@ -0,0 +1,166 @@ +unit FavoritesDB; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, SQLiteData, uBaseUnit; + +type + + { TFavoritesDB } + + TFavoritesDB = class(TSQliteData) + private + FNFEnabled: Boolean; + FCommitCount: Integer; + FAutoCommitCount: Integer; + procedure SetAutoCommitCount(AValue: Integer); + protected + function ConvertNewTableIF: Boolean; override; + public + constructor Create(const AFilename: String); + function Add(const AOrder: Integer; + const AEnabled: Boolean; + const AWebsite, ALink, ATitle, ACurrentChapter, ADownloadedChapterList, ASaveTo: String): Boolean; + procedure Delete(const AWebsite, ALink: String); + procedure Commit; override; + function Open: Boolean; + procedure Close; override; + property AutoCommitCount: Integer read FAutoCommitCount write SetAutoCommitCount; + end; + +const + f_websitelink = 0; + f_order = 1; + f_enabled = 2; + f_website = 3; + f_link = 4; + f_title = 5; + f_currentchapter = 6; + f_downloadedchapterlist = 7; + f_saveto = 8; + +implementation + +{ TFavoritesDB } + +procedure TFavoritesDB.SetAutoCommitCount(AValue: Integer); +begin + if FAutoCommitCount = AValue then Exit; + FAutoCommitCount := AValue; +end; + +function TFavoritesDB.ConvertNewTableIF: Boolean; +begin + Result := Table.Fields.Count < 9; + FNFEnabled := Table.Fields.Count = 8; +end; + +constructor TFavoritesDB.Create(const AFilename: String); +begin + inherited Create; + FNFEnabled := False; + FCommitCount := 0; + FAutoCommitCount := 500; + Filename := AFilename; + TableName := 'favorites'; + Table.PacketRecords := 1; + CreateParams := + '"websitelink" VARCHAR(3000) NOT NULL PRIMARY KEY,' + + '"order" INTEGER,' + + '"enabled" BOOLEAN,' + + '"website" TEXT,' + + '"link" TEXT,' + + '"title" TEXT,' + + '"currentchapter" TEXT,' + + '"downloadedchapterlist" TEXT,' + + '"saveto" TEXT'; + FieldsParams := '"websitelink","order","enabled","website","link","title","currentchapter","downloadedchapterlist","saveto"'; + SelectParams := 'SELECT * FROM ' + QuotedStrD(TableName) + ' ORDER BY "order"'; +end; + +function TFavoritesDB.Add(const AOrder: Integer; const AEnabled: Boolean; + const AWebsite, ALink, ATitle, ACurrentChapter, ADownloadedChapterList, + ASaveTo: String): Boolean; +begin + Result := False; + if (AWebsite = '') or (ALink = '') then Exit; + if not Connection.Connected then Exit; + try + Connection.ExecuteDirect('INSERT OR REPLACE INTO "favorites" (' + + FieldsParams + + ') VALUES (' + + QuotedStr(LowerCase(AWebsite + ALink)) + ', ' + + QuotedStr(AOrder) + ', ' + + QuotedStr(AEnabled) + ', ' + + QuotedStr(AWebsite) + ', ' + + QuotedStr(ALink) + ', ' + + QuotedStr(ATitle) + ', ' + + QuotedStr(ACurrentChapter) + ', ' + + QuotedStr(ADownloadedChapterList) + ', ' + + QuotedStr(ASaveTo) + ')'); + Result := True; + Inc(FCommitCount); + if FCommitCount >= FAutoCommitCount then + Commit; + except + on E: Exception do + SendLogException(ClassName + '.Add failed!', E); + end; +end; + +procedure TFavoritesDB.Delete(const AWebsite, ALink: String); +begin + if (AWebsite = '') or (ALink = '') then Exit; + if not Connection.Connected then Exit; + try + Connection.ExecuteDirect( + 'DELETE FROM "favorites" WHERE "websitelink"=' + QuotedStr(LowerCase(AWebsite + ALink))); + Inc(FCommitCount); + if FCommitCount >= FAutoCommitCount then + Commit; + except + on E: Exception do + SendLogException(ClassName + '.Delete failed!', E); + end; +end; + +procedure TFavoritesDB.Commit; +begin + if not Connection.Connected then Exit; + try + Transaction.Commit; + FCommitCount := 0; + except + on E: Exception do + begin + Transaction.Rollback; + SendLogException(ClassName + '.Commit failed! Rollback!', E); + end; + end; +end; + +function TFavoritesDB.Open: Boolean; +begin + Result := inherited Open(True, False); + if FNFEnabled then + try + Connection.ExecuteDirect('UPDATE "favorites" SET "enabled"=''1'''); + Transaction.Commit; + finally + FNFEnabled := False; + end; + CloseTable; +end; + +procedure TFavoritesDB.Close; +begin + if FCommitCount <> 0 then + Commit; + inherited Close; +end; + +end. + diff --git a/baseunits/ImagePuzzle.pas b/baseunits/ImagePuzzle.pas new file mode 100644 index 000000000..1629dd1c2 --- /dev/null +++ b/baseunits/ImagePuzzle.pas @@ -0,0 +1,87 @@ +unit ImagePuzzle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, Types; + +type + TImagePuzzle = class + private + FHorBlock, FVerBlock, FMultiply: Integer; + FMatrix: TIntegerDynArray; + public + constructor Create(horBlockCount, verBlockCount: Integer); + procedure DeScramble(input, output: TStream); + property HorBlock: Integer read FHorBlock; + property VerBlock: Integer read FVerBlock; + property Multiply: Integer read FMultiply write FMultiply default 1; + property Matrix: TIntegerDynArray read FMatrix; + end; + +implementation + +uses Math; + +constructor TImagePuzzle.Create(horBlockCount, verBlockCount: Integer); +var i: Integer; +begin + FHorBlock := horBlockCount; + FVerBlock := verBlockCount; + SetLength(FMatrix, FHorBlock * FVerBlock); + for i := 0 to High(FMatrix) do + FMatrix[i] := i; +end; + +procedure TImagePuzzle.DeScramble(input, output: TStream); +var + image, result: TPicture; + blockWidth, blockHeight: Extended; + i, row, col: Integer; + x1, y1: Integer; + dstrect, srcrect: TRect; + ext: String = 'jpg'; +begin + if not Assigned(input) or not Assigned(output) then Exit; + Assert(Assigned(Matrix), 'Matrix is not set'); + Assert(Length(Matrix) >= HorBlock * VerBlock, 'Invalid matrix size'); + image := TPicture.Create; + result := TPicture.Create; + try + image.LoadFromStream(input); + if image.Graphic is TPortableNetworkGraphic then ext := 'png'; + result.Bitmap.SetSize(image.Width, image.Height); + if Multiply <= 1 then begin + blockWidth := float(image.Width) / HorBlock; + blockHeight := float(image.Height) / VerBlock; + end + else begin + blockWidth := trunc(float(image.Width) / (HorBlock * Multiply)) * Multiply; + blockHeight := trunc(float(image.Height) / (VerBlock * Multiply)) * Multiply; + end; + for i := 0 to HorBlock * VerBlock - 1 do begin + row := floor(float(Matrix[i]) / VerBlock); + col := Matrix[i] - row * HorBlock; + x1 := trunc(col * blockWidth); + y1 := trunc(row * blockHeight); + dstrect := Rect(x1, y1, Trunc(x1 + blockWidth), Trunc(y1 + blockHeight)); + row := floor(float(i) / HorBlock); + col := i - row * HorBlock; + x1 := trunc(col * blockWidth); + y1 := trunc(row * blockHeight); + srcrect := Rect(x1, y1, Trunc(x1 + blockWidth), Trunc(y1 + blockHeight)); + result.Bitmap.Canvas.CopyRect(dstrect, image.Bitmap.Canvas, srcrect); + end; + output.Position := 0; + output.Size := 0; + result.SaveToStreamWithFileExt(output, ext); + finally + result.Free; + image.Free; + end; +end; + +end. + diff --git a/baseunits/Img2Pdf.pas b/baseunits/Img2Pdf.pas new file mode 100644 index 000000000..63d8d1245 --- /dev/null +++ b/baseunits/Img2Pdf.pas @@ -0,0 +1,699 @@ +{ Img2Pdf.pas + + Copyright (C) 2016 + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit Img2Pdf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazFileUtils, LazUTF8Classes, FPimage, ImgInfos, MemBitmap, + FPReadJPEG, FPWriteJPEG, FPReadPNG, JPEGLib, JdAPImin, JDataSrc, Jerror, + zstream; + +type + TCompressionQuality = 0..100; + + TImg2PDF = class; + + { TPageInfo } + + TPageInfo = class + public + constructor Create(const AOwner: TImg2PDF); + destructor Destroy; override; + public + Owner: TImg2PDF; + FileName: String; + Ext: String; + Width: Integer; + Height: Integer; + BitsPerComponent: Integer; + ColorSpace: String; + Filter: String; + Stream: TMemoryStreamUTF8; + public + procedure GetImageInfos; + procedure LoadImageData; + procedure FlushImageData; + end; + + TPDFInfos = record + Title, + Subject, + Author, + Creator, + Producer, + Keywords: String; + CreationDate: TDateTime; + ModDate: TDateTime; + end; + + { TImg2PDF } + + TImg2PDF = class + private + FPageInfos: TFPList; + function GetPageInfo(const Index: Integer): TPageInfo; + public + constructor Create; + destructor Destroy; override; + public + Infos: TPDFInfos; + CompressionQuality: TCompressionQuality; + function AddImage(const AFileName: String): Integer; + procedure DeleteImage(const Index: Integer); + procedure SaveToStream(const Stream: TStream); + procedure SaveToFile(const AFileName: String); + public + property PageInfo[const Index: Integer]: TPageInfo read GetPageInfo; + end; + +implementation + +uses webp, FPWritePNG; + +type + + { TFPReaderPNGInfo } + + TFPReaderPNGInfo = class(TFPReaderPNG) + public + property Header; + end; + +const + CRLF = #13#10; + PDF_VERSION = '%PDF-1.3'; + PDF_FILE_END = '%%EOF'; + PDF_MAX_GEN_NUM = 65535; + +var + JPEGError: jpeg_error_mgr; + +{ TFPReaderPNGToPageInfo } + +function PDFString(const S: String): String; +begin + Result := S; + if Pos(Result, '\') <> -1 then + Result := StringReplace(Result, '\', '\\', [rfReplaceAll]); + if Pos(Result, ')') <> -1 then + Result := StringReplace(Result, ')', '\)', [rfReplaceAll]); + if Pos(Result, '(') <> -1 then + Result := StringReplace(Result, '(', '\(', [rfReplaceAll]); +end; + +function PDFInt(const I: Integer; PadLength: Integer): String; +begin + Result := IntToStr(I); + PadLength := PadLength - Length(Result); + if PadLength > 0 then + Result := StringOfChar('0', PadLength) + Result; +end; + +{ TPageInfo } + +constructor TPageInfo.Create(const AOwner: TImg2PDF); +begin + Owner := AOwner; + FileName := ''; + Ext := ''; + Width := 0; + Height := 0; + BitsPerComponent := 8; + ColorSpace := ''; + Filter := ''; +end; + +destructor TPageInfo.Destroy; +begin + FlushImageData; + inherited Destroy; +end; + +procedure TPageInfo.GetImageInfos; +begin + Ext := GetImageFileSize(FileName, Width, Height); +end; + +procedure JPEGToPageInfo(const PageInfo: TPageInfo); +var + AFS: TFileStreamUTF8; + JDS: jpeg_decompress_struct; +begin + PageInfo.Filter := 'DCTDecode'; + try + AFS := TFileStreamUTF8.Create(PageInfo.FileName, fmOpenRead or fmShareDenyWrite); + FillChar(JDS{%H-}, SizeOf(JDS), 0); + JDS.err := @JPEGError; + jpeg_CreateDecompress(@JDS, JPEG_LIB_VERSION, SizeOf(JDS)); + try + jpeg_stdio_src(@JDS, @AFS); + jpeg_read_header(@JDS, True); + case JDS.jpeg_color_space of + JCS_GRAYSCALE: PageInfo.ColorSpace := 'DeviceGray'; + JCS_RGB: PageInfo.ColorSpace := 'DeviceRGB'; + JCS_CMYK: PageInfo.ColorSpace := 'DeviceCMYK'; + else + PageInfo.ColorSpace := 'DeviceRGB'; + end; + finally + jpeg_Destroy_Decompress(@JDS); + end; + PageInfo.Stream.LoadFromStream(AFS); + finally + AFS.Free; + end; +end; + +procedure JPEGCompressToPageInfo(const PageInfo: TPageInfo); +var + IMG: TFPMemoryImage; + RDR: TFPCustomImageReader; + AFS: TFileStreamUTF8; + WRT: TFPWriterJPEG; +begin + PageInfo.Filter := 'DCTDecode'; + IMG := TFPMemoryImage.Create(0, 0); + try + try + RDR := GetImageExtReaderClass(PageInfo.Ext).Create; + AFS := TFileStreamUTF8.Create(PageInfo.FileName, fmOpenRead or fmShareDenyWrite); + IMG.LoadFromStream(AFS, RDR); + if (RDR is TFPReaderJPEG) and TFPReaderJPEG(RDR).GrayScale then + PageInfo.ColorSpace := 'DeviceGray' + else + PageInfo.ColorSpace := 'DeviceRGB'; + finally + RDR.Free; + AFS.Free; + end; + WRT := TFPWriterJPEG.Create; + try + WRT.CompressionQuality := PageInfo.Owner.CompressionQuality; + {$IF (FPC_FULLVERSION >= 30101)} + WRT.GrayScale := (PageInfo.ColorSpace = 'DeviceGray'); + {$ENDIF} + IMG.SaveToStream(PageInfo.Stream, WRT); + finally + WRT.Free; + end; + finally + IMG.Free; + end; +end; + +procedure PNGToPageInfo(const PageInfo: TPageInfo; const AStream: TStream = nil); +var + AFS: TStream; + IMG: TFPCustomImage; + RDR: TFPReaderPNGInfo; + AMS: TMemoryStreamUTF8; + X, Y: Integer; + CLW, C: TFPColor; + isGrayScale: Boolean; +begin + IMG := TFPMemoryImage.Create(0, 0); + try + try + if AStream = nil then + AFS := TFileStreamUTF8.Create(PageInfo.FileName, fmOpenRead or fmShareDenyWrite) + else + AFS := AStream; + RDR := TFPReaderPNGInfo.Create; + try + RDR.CheckContents(AFS); + if RDR.Header.ColorType = 3 then + IMG.UsePalette := True; + AFS.Position := 0; + IMG.LoadFromStream(AFS, RDR); + finally + if AStream = nil then + FreeAndNil(AFS); + end; + + PageInfo.Filter := 'FlateDecode'; + PageInfo.BitsPerComponent := 8; + + AMS := TMemoryStreamUTF8.Create; + try + case RDR.Header.ColorType of + 0, 4: + begin + PageInfo.ColorSpace := 'DeviceGray'; + for Y := 0 to IMG.Height - 1 do + for X := 0 to IMG.Width - 1 do + AMS.WriteByte(IMG.Colors[X, Y].red shr 8); + end; + 3: + begin + PageInfo.ColorSpace := 'Indexed '; + if Assigned(IMG.Palette) then + begin + isGrayScale := True; + for X := 0 to IMG.Palette.Count - 1 do + begin + C := IMG.Palette.Color[X]; + if (C.red <> C.green) or (C.red <> C.blue) or (C.green <> C.blue) then + begin + isGrayScale := False; + Break; + end; + end; + if isGrayScale then + PageInfo.ColorSpace := PageInfo.ColorSpace + '/DeviceGray' + else + PageInfo.ColorSpace := PageInfo.ColorSpace + '/DeviceRGB'; + PageInfo.ColorSpace := PageInfo.ColorSpace + ' ' + IntToStr(IMG.Palette.Count - 1) + ' <'; + if isGrayScale then + for X := 0 to IMG.Palette.Count - 1 do + PageInfo.ColorSpace := PageInfo.ColorSpace + IntToHex(IMG.Palette.Color[X].red shr 8, 2) + else + for X := 0 to IMG.Palette.Count - 1 do + begin + C := IMG.Palette.Color[X]; + PageInfo.ColorSpace := PageInfo.ColorSpace + + IntToHex(C.red shr 8, 2) + IntToHex(C.green shr 8, 2) + IntToHex(C.blue shr 8, 2); + end; + PageInfo.ColorSpace := PageInfo.ColorSpace + '>'; + end; + + for Y := 0 to IMG.Height - 1 do + for X := 0 to IMG.Width - 1 do + AMS.WriteByte(Byte(IMG.Pixels[X, Y])); + end; + else + begin + PageInfo.ColorSpace := 'DeviceRGB'; + FillChar(CLW{%H-}, SizeOf(CLW), $FF); + for Y := 0 to IMG.Height - 1 do + for X := 0 to IMG.Width - 1 do + begin + C := IMG.Colors[X, Y]; + if C.alpha < $FFFF then + C := AlphaBlend(CLW, C); + AMS.WriteByte(C.Red shr 8); + AMS.WriteByte(C.Green shr 8); + AMS.WriteByte(C.blue shr 8); + end; + end; + end; + with Tcompressionstream.Create(cldefault, PageInfo.Stream) do + try + AMS.Position := 0; + Write(AMS.Memory^, AMS.Size); + flush; + finally + Free; + end; + finally + AMS.Free; + end; + finally + RDR.Free; + end + finally + IMG.Free; + end; +end; + +procedure WEBPToPageInfo(const PageInfo: TPageInfo); +var + AMS: TMemoryStreamUTF8; + MBM: TMemBitmap; + WRT: TFPWriterPNG; +begin + AMS := TMemoryStreamUTF8.Create; + try + AMS.LoadFromFile(PageInfo.FileName); + MBM := nil; + try + MBM := WebPToMemBitmap(AMS); + if Assigned(MBM) then + try + WRT := TFPWriterPNG.create; + WRT.Indexed := False; + WRT.UseAlpha := MBM.HasTransparentPixels; + WRT.CompressionLevel := clnone; + MBM.SaveToStream(AMS, WRT); + finally + WRT.Free; + end; + finally + if Assigned(MBM) then + MBM.Free; + end; + PNGToPageInfo(PageInfo, AMS); + finally + AMS.Free; + end; +end; + +procedure ImageToPageInfo(const PageInfo: TPageInfo); +var + IMG: TFPCustomImage; + RDR: TFPCustomImageReader; + AFS: TFileStreamUTF8; + AMS: TMemoryStreamUTF8; + CLW, C: TFPColor; + X, Y: Integer; +begin + PageInfo.Filter := 'FlateDecode'; + PageInfo.ColorSpace := 'DeviceRGB'; + IMG := TFPMemoryImage.Create(0, 0); + try + try + RDR := GetImageExtReaderClass(PageInfo.Ext).Create; + AFS := TFileStreamUTF8.Create(PageInfo.FileName, fmOpenRead or fmShareDenyWrite); + IMG.LoadFromStream(AFS, RDR); + finally + RDR.Free; + AFS.Free; + end; + AMS := TMemoryStreamUTF8.Create; + try + FillChar(CLW{%H-}, SizeOf(CLW), $FF); + for Y := 0 to IMG.Height - 1 do + for X := 0 to IMG.Width - 1 do + begin + C := IMG.Colors[X, Y]; + if C.alpha < $FFFF then + C := AlphaBlend(CLW, C); + AMS.WriteByte(C.Red shr 8); + AMS.WriteByte(C.Green shr 8); + AMS.WriteByte(C.blue shr 8); + end; + with Tcompressionstream.Create(cldefault, PageInfo.Stream) do + try + AMS.Position := 0; + Write(AMS.Memory^, AMS.Size); + flush; + finally + Free; + end; + finally + AMS.Free; + end; + finally + IMG.Free; + end; +end; + +procedure TPageInfo.LoadImageData; +begin + if Assigned(Stream) then Exit; + if Ext = '' then Exit; + Stream := TMemoryStreamUTF8.Create; + try + if (Ext = 'jpg') and (Owner.CompressionQuality >= 75) then + JPEGToPageInfo(Self) + else + if Owner.CompressionQuality < 100 then + JPEGCompressToPageInfo(Self) + else + if Ext = 'png' then + PNGToPageInfo(Self) + else + if Ext = 'webp' then + WEBPToPageInfo(Self) + else + ImageToPageInfo(Self); + except + end; +end; + +procedure TPageInfo.FlushImageData; +begin + if Assigned(Stream) then + FreeAndNil(Stream); +end; + +{ TImg2PDF } + +function TImg2PDF.GetPageInfo(const Index: Integer): TPageInfo; +begin + Result := TPageInfo(FPageInfos[Index]); +end; + +constructor TImg2PDF.Create; +begin + FPageInfos := TFPList.Create; + Infos.Title := ''; + Infos.Subject := ''; + Infos.Author := ''; + Infos.Creator := ''; + Infos.Producer := 'Img2Pdf'; + Infos.Keywords := ''; + Infos.CreationDate := Now; + Infos.ModDate := Now; + CompressionQuality := 100; +end; + +destructor TImg2PDF.Destroy; +begin + while FPageInfos.Count <> 0 do + DeleteImage(FPageInfos.Count - 1); + FPageInfos.Free; + inherited Destroy; +end; + +function TImg2PDF.AddImage(const AFileName: String): Integer; +var + P: TPageInfo; +begin + Result := -1; + if not FileExistsUTF8(AFileName) then Exit; + P := TPageInfo.Create(Self); + P.FileName := AFileName; + P.GetImageInfos; + if P.Ext <> '' then + Result := FPageInfos.Add(P) + else + p.Free; +end; + +procedure TImg2PDF.DeleteImage(const Index: Integer); +begin + TPageInfo(FPageInfos[Index]).Free; + FPageInfos.Delete(Index); +end; + +procedure TImg2PDF.SaveToStream(const Stream: TStream); +var + PDFBuffer: String; + AData, vkids: String; + AObjs: array of Integer; + AObjCount, i, vnbpal, vni, vo: Integer; + + procedure PDFFlush; + begin + if PDFBuffer = '' then Exit; + Stream.Write(Pointer(PDFBuffer)^, Length(PDFBuffer)); + PDFBuffer := ''; + end; + + procedure PDFWrite(const S: String); + begin + PDFBuffer := PDFBuffer + S + CRLF; + end; + + procedure CreateNewObj; + begin + Inc(AObjCount); + SetLength(AObjs, Length(AObjs) + 1); + AObjs[AObjCount] := Stream.Size; + PDFWrite(IntToStr(AObjCount) + ' 0 obj'); + end; + +begin + if FPageInfos.Count = 0 then Exit; + + PDFBuffer := ''; + AObjCount := 2; + SetLength(AObjs, 3); + + try + PDFWrite(PDF_VERSION); + + for i := 0 to FPageInfos.Count - 1 do + begin + CreateNewObj; + PDFWrite('<<'); + PDFWrite('/Type /Page'); + PDFWrite('/Parent 1 0 R'); + PDFWrite('/MediaBox [0 0 ' + IntToStr(PageInfo[i].Width) + ' ' + IntToStr(PageInfo[i].Height) + ']'); + PDFWrite('/Resources 2 0 R'); + PDFWrite('/Contents ' + IntToStr(AObjCount + 1) + ' 0 R'); + PDFWrite('>>'); + PDFWrite('endobj'); + + CreateNewObj; + AData := '1 0 0 1 0 ' + IntToStr(PageInfo[i].Height) + ' cm' + CRLF + + Format('q %d 0 0 %d 0 -%d cm /I%d Do Q', [PageInfo[i].Width, PageInfo[i].Height, + PageInfo[i].Height, i + 1]); + PDFWrite('<<'); + PDFWrite('/Length ' + IntToStr(Length(AData))); + PDFWrite('>>'); + PDFWrite('stream'); + PDFWrite(AData + CRLF + 'endstream'); + PDFWrite('endobj'); + end; + PDFFlush; + + vni := AObjCount; + for i := 0 to FPageInfos.Count - 1 do + try + PageInfo[i].LoadImageData; + CreateNewObj; + PDFWrite('<<'); + PDFWrite('/Type /XObject'); + PDFWrite('/Subtype /Image'); + PDFWrite('/Width ' + IntToStr(PageInfo[i].Width)); + PDFWrite('/Height ' + IntToStr(PageInfo[i].Height)); + PDFWrite('/ColorSpace [/' + PageInfo[i].ColorSpace + ']'); + PDFWrite('/BitsPerComponent ' + IntToStr(PageInfo[i].BitsPerComponent)); + PDFWrite('/Filter /' + PageInfo[i].Filter); + PDFWrite('/Length ' + IntToStr(PageInfo[i].Stream.Size)); + PDFWrite('>>'); + PDFWrite('stream'); + PDFFlush; + if Assigned(PageInfo[i].Stream) then + begin + PageInfo[i].Stream.Position := 0; + Stream.CopyFrom(PageInfo[i].Stream, PageInfo[i].Stream.Size); + end; + PDFWrite(CRLF + 'endstream'); + PDFWrite('endobj'); + finally + PageInfo[i].FlushImageData; + end; + PDFFlush; + + AObjs[1] := Stream.Size; + PDFWrite('1 0 obj'); + PDFWrite('<<'); + PDFWrite('/Type /Pages'); + vkids := '/Kids ['; + for i := 0 to FPageInfos.Count - 1 do + vkids := vkids + IntToStr(3 + 2 * i) + ' 0 R '; + PDFWrite(vkids + ']'); + PDFWrite('/Count ' + IntToStr(FPageInfos.Count)); + PDFWrite('/MediaBox [0 0 800 600]'); + PDFWrite('>>'); + PDFWrite('endobj'); + + AObjs[2] := Stream.Size; + PDFWrite('2 0 obj'); + PDFWrite('<<'); + PDFWrite('/ProcSet [/PDF /Text /ImageB /ImageC /ImageI]'); + PDFWrite('/Font'); + PDFWrite('<<'); + PDFWrite('>>'); + PDFWrite('/XObject'); + PDFWrite('<<'); + vnbpal := 0; + for i := 1 to FPageInfos.Count do + begin + PDFWrite('/I' + IntToStr(i) + ' ' + IntToStr(vni + (i) + vnbpal) + ' 0 R'); + if (PageInfo[i - 1].ColorSpace = 'Indexed') then + vnbpal := vnbpal + 1; + end; + PDFWrite('>>'); + PDFWrite('>>'); + PDFWrite('endobj'); + + CreateNewObj; + PDFWrite('<<'); + PDFWrite('/CreationDate (D:' + FormatDateTime('yyyymmddhhnnss', Infos.CreationDate) + ')'); + PDFWrite('/ModDate (D:' + FormatDateTime('yyyymmddhhnnss', Infos.ModDate) + ')'); + if Infos.Title <> '' then + PDFWrite('/Title (' + PDFString(Infos.Title) + ')'); + if Infos.Subject <> '' then + PDFWrite('/Subject (' + PDFString(Infos.Subject) + ')'); + if Infos.Author <> '' then + PDFWrite('/Author (' + PDFString(Infos.Author) + ')'); + if Infos.Creator <> '' then + PDFWrite('/Creator (' + PDFString(Infos.Creator) + ')'); + if Infos.Producer <> '' then + PDFWrite('/Producer (' + PDFString(Infos.Producer) + ')'); + if Infos.Keywords <> '' then + PDFWrite('/Keywords (' + PDFString(Infos.Keywords) + ')'); + PDFWrite('>>'); + PDFWrite('endobj'); + + CreateNewObj; + PDFWrite('<<'); + PDFWrite('/Type /Catalog'); + PDFWrite('/OpenAction [3 0 R /FitH null]'); + PDFWrite('/Pages 1 0 R'); + PDFWrite('>>'); + PDFWrite('endobj'); + + vo := Stream.Size; + PDFWrite('xref'); + PDFWrite('0 ' + IntToStr(AObjCount + 1)); + PDFWrite('0000000000 ' + PDFInt(PDF_MAX_GEN_NUM, 5) + ' f'); + for i := 1 to AObjCount do + PDFWrite(PDFInt(AObjs[i], 10) + ' 00000 n'); + PDFWrite('trailer'); + PDFWrite('<<'); + PDFWrite('/Size ' + IntToStr(AObjCount + 1)); + PDFWrite('/Root ' + IntToStr(AObjCount) + ' 0 R'); + PDFWrite('/Info ' + IntToStr(AObjCount - 1) + ' 0 R'); + PDFWrite('>>'); + PDFWrite('startxref'); + PDFWrite(IntToStr(vo)); + + PDFWrite(PDF_FILE_END); + PDFFlush; + finally + SetLength(AObjs, 0); + end; +end; + +procedure TImg2PDF.SaveToFile(const AFileName: String); +var + fs: TFileStreamUTF8; +begin + if FPageInfos.Count = 0 then Exit; + fs := TFileStreamUTF8.Create(AFileName, fmCreate); + try + SaveToStream(fs); + finally + fs.Free; + end; +end; + +initialization + FillChar(JPEGError, SizeOf(JPEGError), 0); + jpeg_std_error(JPEGError); + +end. diff --git a/baseunits/ImgInfos.pas b/baseunits/ImgInfos.pas new file mode 100644 index 000000000..13bff4399 --- /dev/null +++ b/baseunits/ImgInfos.pas @@ -0,0 +1,644 @@ +{ ImgInfos.pas + + Copyright (C) 2016 + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit ImgInfos; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazUTF8Classes, LazFileUtils, FPimage, + FPReadJPEG, FPReadPNG, FPReadGif, FPReadBMP, FPReadTiff, + FPWriteJPEG, FPWritePNG, FPWriteBMP, FPWriteTiff; + +type + PImageHandlerRec = ^TImageHandlerRec; + TCheckImageStreamFunc = function(const Stream: TStream): Boolean; + TGetImageStreamSizeProc = procedure(const Stream: TStream; out Width, Height: Integer); + TImageHandlerRec = record + ReaderClass: TFPCustomImageReaderClass; + WriterClass: TFPCustomImageWriterClass; + CheckImageStream: TCheckImageStreamFunc; + GetImageStreamSize: TGetImageStreamSizeProc; + Ext: String; + WExt: String; + end; + + + { TimageHandlerMgr } + + TimageHandlerMgr = class + private + FList: array of TImageHandlerRec; + FEmptyHandlerRec: TImageHandlerRec; + function GetCount: Integer; + public + constructor Create; + destructor Destroy; override; + procedure Add(const ReaderClass: TFPCustomImageReaderClass; + const WriterClass: TFPCustomImageWriterClass; + const CheckImageStreamFunc: TCheckImageStreamFunc; + const GetImageStreamSizeProc: TGetImageStreamSizeProc; + const Ext: String; + const WExt: String = ''); + function GetImageHandlerByStream(const Stream: TStream): PImageHandlerRec; + function GetImageHandlerByFile(const FileName: String): PImageHandlerRec; + function GetImageHandlerByExt(const Ext: String): PImageHandlerRec; + function GetImageStreamExt(const Stream: TStream): String; inline; + function GetImageFileExt(const FileName: String): String; inline; + function GetImageStreamSize(const Stream: TStream; out Width, Height: Integer): String; + function GetImageFileSize(const FileName: String; out Width, Height: Integer): String; + function GetImageStreamReaderClass(const Stream: TStream): TFPCustomImageReaderClass; inline; + function GetImageFileReaderClass(const FileName: String): TFPCustomImageReaderClass; inline; + function GetImageExtReaderClass(const Ext: String): TFPCustomImageReaderClass; inline; + function GetImageStreamWriterClass(const Stream: TStream): TFPCustomImageWriterClass; inline; + function GetImageFileWriterClass(const FileName: String): TFPCustomImageWriterClass; inline; + function GetImageExtWriterClass(const Ext: String): TFPCustomImageWriterClass; inline; + function GetImageWriterExt(const Ext: String): String; inline; + public + property Count: Integer read GetCount; + end; + +function GetImageHandlerByStream(const Stream: TStream): TImageHandlerRec; inline; +function GetImageHandlerByFile(const FileName: String): TImageHandlerRec; inline; +function GetImageHandlerByExt(const Ext: String): TImageHandlerRec; inline; +function GetImageStreamExt(const Stream: TStream): String; inline; +function GetImageFileExt(const FileName: String): String; inline; +function GetImageStreamSize(const Stream: TStream; out Width, Height: Integer): String; inline; +function GetImageFileSize(const FileName: String; out Width, Height: Integer): String; inline; +function GetImageStreamReaderClass(const Stream: TStream): TFPCustomImageReaderClass; inline; +function GetImageFileReaderClass(const FileName: String): TFPCustomImageReaderClass; inline; +function GetImageExtReaderClass(const Ext: String): TFPCustomImageReaderClass; inline; +function GetImageStreamWriterClass(const Stream: TStream): TFPCustomImageWriterClass; inline; +function GetImageFileWriterClass(const FileName: String): TFPCustomImageWriterClass; inline; +function GetImageExtWriterClass(const Ext: String): TFPCustomImageWriterClass; inline; +function GetImageWriterExt(const Ext: String): String; inline; + +var + ImageHandlerMgr: TimageHandlerMgr; + +implementation + +function GetImageHandlerByStream(const Stream: TStream): TImageHandlerRec; +begin + Result := ImageHandlerMgr.GetImageHandlerByStream(Stream)^; +end; + +function GetImageHandlerByFile(const FileName: String): TImageHandlerRec; +begin + Result := ImageHandlerMgr.GetImageHandlerByFile(FileName)^; +end; + +function GetImageHandlerByExt(const Ext: String): TImageHandlerRec; +begin + Result := ImageHandlerMgr.GetImageHandlerByExt(Ext)^; +end; + +function GetImageStreamExt(const Stream: TStream): String; +begin + Result := ImageHandlerMgr.GetImageStreamExt(Stream); +end; + +function GetImageFileExt(const FileName: String): String; +begin + Result := ImageHandlerMgr.GetImageFileExt(FileName); +end; + +function GetImageStreamSize(const Stream: TStream; out Width, Height: Integer): String; +begin + Result := ImageHandlerMgr.GetImageStreamSize(Stream, Width, Height); +end; + +function GetImageFileSize(const FileName: String; out Width, Height: Integer): String; +begin + Result := ImageHandlerMgr.GetImageFileSize(FileName, Width, Height); +end; + +function GetImageStreamReaderClass(const Stream: TStream): TFPCustomImageReaderClass; +begin + Result := ImageHandlerMgr.GetImageStreamReaderClass(Stream); +end; + +function GetImageFileReaderClass(const FileName: String): TFPCustomImageReaderClass; +begin + Result := ImageHandlerMgr.GetImageFileReaderClass(FileName); +end; + +function GetImageExtReaderClass(const Ext: String): TFPCustomImageReaderClass; +begin + Result := ImageHandlerMgr.GetImageExtReaderClass(Ext); +end; + +function GetImageStreamWriterClass(const Stream: TStream): TFPCustomImageWriterClass; +begin + Result := ImageHandlerMgr.GetImageStreamWriterClass(Stream); +end; + +function GetImageFileWriterClass(const FileName: String): TFPCustomImageWriterClass; +begin + Result := GetImageFileWriterClass(FileName); +end; + +function GetImageExtWriterClass(const Ext: String): TFPCustomImageWriterClass; +begin + Result := GetImageExtWriterClass(Ext); +end; + +function GetImageWriterExt(const Ext: String): String; +begin + Result := GetImageWriterExt(Ext); +end; + +{ TimageHandlerMgr } + +function TimageHandlerMgr.GetCount: Integer; +begin + Result := Length(FList); +end; + +constructor TimageHandlerMgr.Create; +begin + FillChar(FEmptyHandlerRec, SizeOf(FEmptyHandlerRec), 0); +end; + +destructor TimageHandlerMgr.Destroy; +begin + SetLength(Flist, 0); + inherited Destroy; +end; + +procedure TimageHandlerMgr.Add(const ReaderClass: TFPCustomImageReaderClass; + const WriterClass: TFPCustomImageWriterClass; + const CheckImageStreamFunc: TCheckImageStreamFunc; + const GetImageStreamSizeProc: TGetImageStreamSizeProc; const Ext: String; + const WExt: String); +var + i: Integer; +begin + i := Length(FList); + SetLength(FList, i + 1); + FList[i].ReaderClass := ReaderClass; + FList[i].WriterClass := WriterClass; + FList[i].CheckImageStream := CheckImageStreamFunc; + FList[i].GetImageStreamSize := GetImageStreamSizeProc; + FList[i].Ext := Ext; + if WExt <> '' then + FList[i].WExt := WExt + else + FList[i].WExt := Ext; +end; + +function TimageHandlerMgr.GetImageHandlerByStream(const Stream: TStream): PImageHandlerRec; +var + P: Int64; + i: Integer; +begin + Result := @FEmptyHandlerRec; + if Stream = nil then Exit; + if Stream.Size = 0 then Exit; + P := Stream.Position; + try + for i := Low(FList) to High(Flist) do + begin + Stream.Position := 0; + if FList[i].CheckImageStream(Stream) then + begin + Result := @FList[i]; + Break; + end; + end; + finally + Stream.Position := P; + end; +end; + +function TimageHandlerMgr.GetImageHandlerByFile(const FileName: String): PImageHandlerRec; +var + FS: TFileStreamUTF8; +begin + Result := @FEmptyHandlerRec; + if not FileExistsUTF8(FileName) then Exit; + try + FS := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); + Result := GetImageHandlerByStream(FS); + finally + FS.Free; + end; +end; + +function TimageHandlerMgr.GetImageHandlerByExt(const Ext: String): PImageHandlerRec; +var + i: Integer; +begin + Result := @FEmptyHandlerRec; + for i := Low(FList) to High(Flist) do + if Ext = FList[i].Ext then + begin + Result := @FList[i]; + Break; + end; +end; + +function TimageHandlerMgr.GetImageStreamExt(const Stream: TStream): String; +begin + Result := GetImageHandlerByStream(Stream)^.Ext; +end; + +function TimageHandlerMgr.GetImageFileExt(const FileName: String): String; +begin + Result := GetImageHandlerByFile(FileName)^.Ext; +end; + +function TimageHandlerMgr.GetImageStreamSize(const Stream: TStream; out Width, + Height: Integer): String; +var + H: PImageHandlerRec; +begin + Width := 0; + Height := 0; + H := GetImageHandlerByStream(Stream); + Result := H^.Ext; + if Assigned(H^.GetImageStreamSize) then + H^.GetImageStreamSize(Stream, Width, Height); +end; + +function TimageHandlerMgr.GetImageFileSize(const FileName: String; out Width, + Height: Integer): String; +var + FS: TFileStreamUTF8; +begin + Result := ''; + Width := 0; + Height := 0; + if not FileExistsUTF8(FileName) then Exit; + try + FS := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); + Result := GetImageStreamSize(FS, Width, Height); + finally + FS.Free; + end; +end; + +function TimageHandlerMgr.GetImageStreamReaderClass(const Stream: TStream + ): TFPCustomImageReaderClass; +begin + Result := GetImageHandlerByStream(Stream)^.ReaderClass; +end; + +function TimageHandlerMgr.GetImageFileReaderClass(const FileName: String + ): TFPCustomImageReaderClass; +begin + Result := GetImageHandlerByFile(FileName)^.ReaderClass; +end; + +function TimageHandlerMgr.GetImageExtReaderClass(const Ext: String + ): TFPCustomImageReaderClass; +begin + Result := GetImageHandlerByExt(Ext)^.ReaderClass; +end; + +function TimageHandlerMgr.GetImageStreamWriterClass(const Stream: TStream + ): TFPCustomImageWriterClass; +begin + Result := GetImageHandlerByStream(Stream)^.WriterClass; +end; + +function TimageHandlerMgr.GetImageFileWriterClass(const FileName: String + ): TFPCustomImageWriterClass; +begin + Result := GetImageHandlerByFile(FileName)^.WriterClass; +end; + +function TimageHandlerMgr.GetImageExtWriterClass(const Ext: String + ): TFPCustomImageWriterClass; +begin + Result := GetImageHandlerByExt(Ext)^.WriterClass; +end; + +function TimageHandlerMgr.GetImageWriterExt(const Ext: String): String; +begin + Result := GetImageHandlerByExt(Ext)^.WExt; +end; + +function JPEGCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: Word = 0; +begin + Result := (Stream.Read(Hdr, 2) = 2) and (Hdr = $D8FF); +end; + +procedure JPEGGetImageSize(const Stream: TStream; out Width, Height: Integer); +var + B: Byte = 0; + W: Word = 0; +begin + if Stream.Seek(2, soFromBeginning) <> 2 then Exit; + if Stream.Read(B, 1) <> 1 then Exit; + while (Stream.Position < Stream.Size) and (B = $FF) do + begin + Stream.Read(B, 1); + case B of + $C0..$C3: + begin + Stream.Seek(3, soFromCurrent); + Stream.Read(W, 2); + Height := Swap(W); + Stream.Read(W, 2); + Width := Swap(W); + Stream.Read(B, 1); + Exit; + end; + $FF: + Stream.Read(B, 1); + $D0..$D9, $01: + begin + Stream.Seek(1, soFromCurrent); + Stream.Read(B, 1); + end; + else + begin + Stream.Read(W, 2); + Stream.Seek(Swap(W) - 2, soFromCurrent); + Stream.Read(B, 1); + end; + end; + end; +end; + +function PNGCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: array[0..7] of Char = (' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '); +begin + Result := (Stream.Read(Hdr, 8) = 8) and (Hdr = #137'PNG'#13#10#26#10); +end; + +procedure PNGGetImageSize(const Stream: TStream; out Width, Height: Integer); +var + W: Word = 0; + H: Word = 0; +begin + if not ((Stream.Seek(18, soFromBeginning) = 18) + and (Stream.Read(W, 2) = 2) + and (Stream.Seek(2, soFromCurrent) = 22) + and (Stream.Read(H, 2) = 2)) then Exit; + {$IFDEF ENDIAN_LITTLE} + W := Swap(W); + H := Swap(H); + {$ENDIF} + Width := W; + Height := H; +end; + +function GIFCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: array[0..5] of Char = (' ', ' ', ' ', ' ', ' ', ' '); +begin + Result := (Stream.Read(Hdr, 6) = 6) and ((Hdr = 'GIF87a') or (Hdr = 'GIF89a')); +end; + +procedure GIFGetImageSize(const Stream: TStream; out Width, Height: Integer); +type + TGifHeader = packed record + Sig: array[0..5] of Char; + ScreenWidth, + ScreenHeight: Word; + PackedBit, + BackgroundColor, + AspectRatio: Byte; + end; + TGifImageDescriptor = packed record + Left, + Top, + Width, + Height: Word; + PackedBit: Byte; + end; +var + Hdr: TGifHeader; + Des: TGifImageDescriptor; + PalleteSize: Integer = 0; + C: Byte = 0; +begin + FillChar(Hdr{%H-}, SizeOf(Hdr), 0); + if Stream.Read(Hdr, SizeOf(TGifHeader)) <> SizeOf(TGifHeader) then Exit; + if (Hdr.PackedBit and $80) <> 0 then + begin + PalleteSize := 3 * (1 shl (Hdr.Packedbit and 7 + 1)); + if Stream.Seek(PalleteSize, soFromCurrent) <> SizeOf(TGifHeader) + PalleteSize then Exit; + end; + FillChar(Des{%H-}, SizeOf(TGifImageDescriptor), 0); + while Stream.Position < Stream.Size do + begin + Stream.Read(C, 1); + if C = $2C then + begin + if Stream.Read(Des, SizeOf(TGifImageDescriptor)) <> SizeOf(TGifImageDescriptor) then Exit; + {$IFDEF ENDIAN_BIG} + Des.Width := LEtoN(Width); + Des.Height := LEtoN(Height); + {$ENDIF} + Width := Des.Width; + Height := Des.Height; + Break; + end; + end; +end; + +function BMPCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: Word = 0; +begin + Result := (Stream.Read(Hdr, 2) = 2) and (Hdr = 19778); +end; + +procedure BMPGetImageSize(const Stream: TStream; out Width, Height: Integer); +var + W: LongInt = 0; + H: LongInt = 0; +begin + if not ((Stream.Seek(18, soFromBeginning) = 18) + and (Stream.Read(W, 4) = 4) + and (Stream.Read(H, 4) = 4)) then Exit; + Width := LEtoN(W); + Height := abs(LEtoN(H)); +end; + +function FixEndian(const W: Word; const BE: Boolean): Word; overload; +begin + if BE then + Result := BEtoN(W) + else + Result := LEtoN(W); +end; + +function TIFFCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: array[0..1] of Char = (' ', ' '); + Sig: Word = 0; + BE: Boolean = False; + + function CheckHdr: Boolean; + begin + Result := True; + if Hdr = 'II' then BE := False + else if Hdr = 'MM' then BE := True + else Result := False; + end; + +begin + Result := (Stream.Read(Hdr, 2) = 2) and CheckHdr + and (Stream.Read(Sig, 2) = 2) and (FixEndian(Sig, BE) = 42); +end; + +function FixEndian(const W: DWord; const BE: Boolean): DWord; overload; +begin + if BE then + Result := BEtoN(W) + else + Result := LEtoN(W); +end; + +procedure TIFFGetImageSize(const Stream: TStream; out Width, Height: Integer); +type + TIDF_Field = packed record + Tag, + FieldType: Word; + ValCount, + ValOffset: DWord; + end; +var + Hdr: array[0..1] of Char = (' ', ' '); + BE: Boolean = False; + Imgs: Word = 0; + Field: TIDF_Field; + i: Word; + + function CheckHdr: Boolean; + begin + Result := True; + if Hdr = 'II' then BE := False + else if Hdr = 'MM' then BE := True + else Result := False; + end; + + function ReadDir: Boolean; + begin + Result := Stream.Read(Field, SizeOf(TIDF_Field)) = SizeOf(TIDF_Field); + if not Result then Exit; + Field.Tag := FixEndian(Field.Tag, BE); + Field.ValOffset := FixEndian(Field.ValOffset, BE); + end; + +begin + if not ((Stream.Read(Hdr, 2) = 2) and CheckHdr) then Exit; + if Stream.Seek(6, soFromCurrent) <> 8 then Exit; + if Stream.Read(Imgs, 2) <> 2 then Exit; + Imgs := FixEndian(Imgs, BE); + FillChar(Field{%H-}, SizeOf(TIDF_Field), 0); + for i := 1 to Imgs do + begin + if not ReadDir then Exit; + case Field.Tag of + $0100: Width := Field.ValOffset; + $0101: Height := Field.ValOffset; + end; + end; +end; + +function WEBPCheckImageStream(const Stream: TStream): Boolean; +var + Hdr: array[0..3] of Char = (#0, #0, #0, #0); +begin + Result := (Stream.Read(Hdr, 4) = 4) and (Hdr = 'RIFF') and + (Stream.Seek(4, soFromCurrent) = 8) and + (Stream.Read(Hdr, 4) = 4) and (Hdr = 'WEBP'); +end; + +procedure WEBPGetImageSize(const Stream: TStream; out Width, Height: Integer); +var + Hdr: array[0..3] of Byte = (0, 0, 0, 0); +begin + Width := 0; + Height := 0; + if (Stream.Seek(12, soFromBeginning) <> 12) or + (stream.Read(Hdr, 4) <> 4) then Exit; + if not ((Hdr[0] = $56) and (Hdr[1] = $50) and (Hdr[2] = $38)) then Exit; + // "VP8 " + if Hdr[3] = $20 then + begin + // https://tools.ietf.org/html/rfc6386#page-30 + // 7 byte + 3 byte signature 9D 01 2A + Stream.Seek(7, soFromCurrent); + Stream.Read(Hdr, 3); + if not ((Hdr[0] = $9D) and (Hdr[1] = $01) and (Hdr[2] = $2A)) then Exit; + Stream.Read(Width, 2); + Stream.Read(Height, 2); + Width := LEtoN(Width); + Height := LEtoN(Height); + end + else + // "VP8L" + if Hdr[3] = $4C then + begin + // https://developers.google.com/speed/webp/docs/webp_lossless_bitstream_specification + // 4 byte + 1 byte signature 2F + Stream.Seek(4, soFromCurrent); + Stream.Read(Hdr, 1); + if Hdr[0] <> $2F then Exit; + Stream.Read(Hdr, 4); + Width := (((Hdr[1] and $3F) shl 8) or Hdr[0]) + 1; + Height := (((Hdr[3] and $F) shl 10) or (Hdr[2] shl 2) or ((Hdr[1] and $C0) shr 6)) + 1; + end + else + // "VP8X" + if Hdr[3] = $58 then + begin + // https://developers.google.com/speed/webp/docs/riff_container#extended_file_format + Stream.Seek(8, soFromCurrent); + Stream.Read(Width, 3); + Stream.Read(Height, 3); + Width := LEtoN(Width) + 1; + Height := LEtoN(Height) + 1; + end; +end; + +initialization + ImageHandlerMgr := TimageHandlerMgr.Create; + ImageHandlerMgr.Add(TFPReaderJPEG, TFPWriterJPEG, @JPEGCheckImageStream, @JPEGGetImageSize, 'jpg'); + ImageHandlerMgr.Add(TFPReaderPNG, TFPWriterPNG, @PNGCheckImageStream, @PNGGetImageSize, 'png'); + ImageHandlerMgr.Add(TFPReaderGif, TFPWriterPNG, @GIFCheckImageStream, @GIFGetImageSize, 'gif', 'png'); + ImageHandlerMgr.Add(TFPReaderBMP, TFPWriterBMP, @BMPCheckImageStream, @BMPGetImageSize, 'bmp'); + ImageHandlerMgr.Add(TFPReaderTiff, TFPWriterTiff, @TIFFCheckImageStream, @TIFFGetImageSize, 'tif'); + ImageHandlerMgr.Add(nil, nil, @WEBPCheckImageStream, @WEBPGetImageSize, 'webp'); + +finalization + ImageHandlerMgr.Free; + +end. diff --git a/baseunits/JSUtils.pas b/baseunits/JSUtils.pas new file mode 100644 index 000000000..4c6e87714 --- /dev/null +++ b/baseunits/JSUtils.pas @@ -0,0 +1,35 @@ +unit JSUtils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Duktape.Api, MultiLog; + +function ExecJS(const text: String): String; + +implementation + +function ExecJS(const text: String): String; +var + ctx: PDukContext; + r: TDukInt; + s: String; +begin + Result := ''; + ctx := duk_create_heap_default; + if ctx = nil then begin + Logger.SendError('Failed to create a Duktape heap.'); + Exit; + end; + duk_push_string(ctx, PAnsiChar(text)); + r := duk_peval(ctx); + s := duk_safe_to_string(ctx, -1); + if r <> 0 then Logger.SendError('Error: ' + s) + else Result := s; + duk_destroy_heap(ctx); +end; + +end. + diff --git a/baseunits/ModuleList.inc b/baseunits/ModuleList.inc new file mode 100644 index 000000000..a20acb166 --- /dev/null +++ b/baseunits/ModuleList.inc @@ -0,0 +1,52 @@ +uses + MangaFox, + Mangacan, + MangaReader, + MangaLife, + MangaHere, + MangaTr, + Madokami, + RawSenManga, + KissManga, + MangaHome, + MangaChanRU, + MintMangaRU, + MangaHubRU, + AcademyVN, + Webtoons, + Tsumino, + WebtoonTr, + KuManga, + SenManga, + MangaInn, + LeoManga, + MangaIndo, + GoodManga, + MangaZuki, + ReadMangaToday, + MangaOnlineBR, + Tapas, + Taadd, + NineManga, + BlogTruyen, + MangaAe, + MangaTube, + Mangaf, + MangaRock, + PsychoPlay, + MangaWindow, + TranslateWebtoon, + // Raw Official + SundayWebEvery, + TonariNoYoungJump, + YoungAceUp, + NewType, + Comico, + Shogakukan, + // Adult + WPAdultSiteSkins, + EHentai, + Luscious, + EightMuses, + HentaiCafe, + Hentai2Read; diff --git a/baseunits/SQLiteData.pas b/baseunits/SQLiteData.pas new file mode 100644 index 000000000..1f6efaec8 --- /dev/null +++ b/baseunits/SQLiteData.pas @@ -0,0 +1,417 @@ +unit SQLiteData; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, LazFileUtils, strutils, sqlite3conn, sqldb; + +type + + { TSQLite3ConnectionH } + + TSQLite3ConnectionH = class(TSQLite3Connection) + public + property Handle read GetHandle; + end; + + TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; + + { TSQliteData } + + TSQliteData = class + private + FAutoVacuum: Boolean; + FConn: TSQLite3ConnectionH; + FFieldsParams: String; + FOnError: TExceptionEvent; + FTrans: TSQLTransaction; + FQuery: TSQLQuery; + FFilename: String; + FTableName: String; + FCreateParams: String; + FSelectParams: String; + FRecordCount: Integer; + procedure DoOnError(E: Exception); + function GetAutoApplyUpdates: Boolean; + procedure SetAutoApplyUpdates(AValue: Boolean); + procedure SetAutoVacuum(AValue: Boolean); + procedure SetCreateParams(AValue: String); + procedure SetFieldsParams(AValue: String); + procedure SetOnError(AValue: TExceptionEvent); + procedure SetSelectParams(AValue: String); + protected + function OpenDB: Boolean; virtual; + function CreateDB: Boolean; virtual; + function ConvertNewTableIF: Boolean; virtual; + procedure DoConvertNewTable; + procedure GetRecordCount; virtual; + procedure SetRecordCount(const AValue: Integer); virtual; + procedure IncRecordCount(const N: Integer = 1); + procedure Vacuum; virtual; + public + constructor Create; + destructor Destroy; override; + function Open(const AOpenTable: Boolean = True; const AGetRecordCount: Boolean = True): Boolean; virtual; + function OpenTable(const AGetRecordCount: Boolean = True): Boolean; virtual; + procedure Close; virtual; + procedure CloseTable; virtual; + procedure Refresh(RecheckDataCount: Boolean = False); virtual; + procedure Commit; virtual; + procedure CommitRetaining; virtual; + procedure Save; virtual; + function Connected: Boolean; inline; + property Connection: TSQLite3ConnectionH read FConn; + property Transaction: TSQLTransaction read FTrans; + property Table: TSQLQuery read FQuery; + property Filename: String read FFilename write FFilename; + property TableName: String read FTableName write FTableName; + property CreateParams: String read FCreateParams write SetCreateParams; + property SelectParams: String read FSelectParams write SetSelectParams; + property FieldsParams: String read FFieldsParams write SetFieldsParams; + property RecordCount: Integer read FRecordCount; + property AutoApplyUpdates: Boolean read GetAutoApplyUpdates write SetAutoApplyUpdates; + property AutoVacuum: Boolean read FAutoVacuum write SetAutoVacuum; + property OnError: TExceptionEvent read FOnError write SetOnError; + end; + +function QuotedStr(const S: Integer): String; overload; inline; +function QuotedStr(const S: Boolean): String; overload; inline; +function QuotedStr(const S: TDateTime): String; overload; inline; +function QuotedStrD(const S: String): String; overload; inline; +function QuotedStrD(const S: Integer): String; overload; inline; + +implementation + +function QuotedStr(const S: Integer): String; +begin + Result := AnsiQuotedStr(IntToStr(S), ''''); +end; + +function QuotedStr(const S: Boolean): String; +begin + Result := AnsiQuotedStr(BoolToStr(S, '1', '0'), ''''); +end; + +function QuotedStr(const S: TDateTime): String; +begin + Result := AnsiQuotedStr(FormatDateTime('yyyy-mm-dd hh:mm:ss', S), ''''); +end; + +function QuotedStrD(const S: String): String; +begin + Result := AnsiQuotedStr(S, '"'); +end; + +function QuotedStrD(const S: Integer): String; +begin + Result := AnsiQuotedStr(IntToStr(S), '"'); +end; + +{ TSQliteData } + +procedure TSQliteData.DoOnError(E: Exception); +begin + if Assigned(OnError) then + OnError(Self, E); +end; + +function TSQliteData.GetAutoApplyUpdates: Boolean; +begin + Result := sqoAutoApplyUpdates in FQuery.Options; +end; + +procedure TSQliteData.SetAutoApplyUpdates(AValue: Boolean); +begin + if AValue then + FQuery.Options := FQuery.Options + [sqoAutoApplyUpdates] + else + FQuery.Options := FQuery.Options - [sqoAutoApplyUpdates]; +end; + +procedure TSQliteData.SetAutoVacuum(AValue: Boolean); +begin + if FAutoVacuum = AValue then Exit; + FAutoVacuum := AValue; +end; + +procedure TSQliteData.SetCreateParams(AValue: String); +begin + if FCreateParams = AValue then Exit; + FCreateParams := TrimSet(Trim(AValue), ['(', ')', ';']); +end; + +procedure TSQliteData.SetFieldsParams(AValue: String); +begin + if FFieldsParams = AValue then Exit; + FFieldsParams := AValue; +end; + +procedure TSQliteData.SetOnError(AValue: TExceptionEvent); +begin + if FOnError = AValue then Exit; + FOnError := AValue; +end; + +procedure TSQliteData.SetSelectParams(AValue: String); +begin + if FSelectParams = AValue then Exit; + FSelectParams := AValue; +end; + +function TSQliteData.OpenDB: Boolean; +begin + Result := False; + if FFilename = '' then Exit; + try + FConn.DatabaseName := FFilename; + FConn.Connected := True; + FTrans.Active := True; + except + end; + Result := FConn.Connected; +end; + +function TSQliteData.CreateDB: Boolean; +begin + Result := False; + if (FTableName = '') or (FCreateParams = '') then Exit; + if not FConn.Connected then + if not OpenDB then Exit; + try + FConn.ExecuteDirect('DROP TABLE IF EXISTS ' + QuotedStrD(FTableName)); + FConn.ExecuteDirect('CREATE TABLE ' + QuotedStrD(FTableName) + ' (' + FCreateParams + ')'); + FTrans.Commit; + Result := True; + except + end; +end; + +function TSQliteData.ConvertNewTableIF: Boolean; +begin + Result := False; +end; + +procedure TSQliteData.DoConvertNewTable; +var + qactive: Boolean; +begin + if not ConvertNewTableIF then Exit; + if not FConn.Connected then Exit; + try + qactive := FQuery.Active; + if FQuery.Active then FQuery.Close; + with FConn do + begin + ExecuteDirect('DROP TABLE IF EXISTS ' + QuotedStrD('temp' + FTableName)); + ExecuteDirect('CREATE TABLE ' + QuotedStrD('temp' + FTableName) + ' (' + FCreateParams + ')'); + ExecuteDirect('INSERT INTO ' + QuotedStrD('temp' + FTableName) + ' (' + FieldsParams + ') SELECT ' + FieldsParams + ' FROM "' + FTableName + '"'); + ExecuteDirect('DROP TABLE ' + QuotedStrD(FTableName)); + ExecuteDirect('ALTER TABLE ' + QuotedStrD('temp' + FTableName) + ' RENAME TO ' + QuotedStrD(FTableName)); + end; + FTrans.Commit; + if qactive <> FQuery.Active then + FQuery.Active := qactive; + except + FTrans.Rollback; + end; +end; + +procedure TSQliteData.GetRecordCount; +begin + if FQuery.Active then + begin + FQuery.Last; + FRecordCount := FQuery.RecordCount; + FQuery.Refresh; + end + else FRecordCount := 0; +end; + +procedure TSQliteData.SetRecordCount(const AValue: Integer); +begin + if FRecordCount = AValue then Exit; + FRecordCount := AValue; +end; + +procedure TSQliteData.IncRecordCount(const N: Integer); +begin + Inc(FRecordCount, N); +end; + +procedure TSQliteData.Vacuum; +var + qactive: Boolean; +begin + if not FConn.Connected then Exit; + try + qactive := FQuery.Active; + if FQuery.Active then FQuery.Close; + FConn.ExecuteDirect('END TRANSACTION'); + try + FConn.ExecuteDirect('VACUUM'); + finally + FConn.ExecuteDirect('BEGIN TRANSACTION'); + if FQuery.Active <> qactive then + FQuery.Active := qactive; + end; + except + on E: Exception do + DoOnError(E); + end; +end; + +constructor TSQliteData.Create; +begin + FConn := TSQLite3ConnectionH.Create(nil); + FTrans := TSQLTransaction.Create(nil); + FQuery := TSQLQuery.Create(nil); + FConn.CharSet := 'UTF8'; + FConn.Transaction := FTrans; + FQuery.DataBase := FTrans.DataBase; + FQuery.Transaction := FTrans; + AutoApplyUpdates := True; + FAutoVacuum := True; + FRecordCount := 0; + FFilename := ''; + FTableName := 'maintable'; + FCreateParams := ''; +end; + +destructor TSQliteData.Destroy; +begin + Self.Close; + FConn.Free; + FQuery.Free; + FTrans.Free; + inherited Destroy; +end; + +function TSQliteData.Open(const AOpenTable: Boolean; + const AGetRecordCount: Boolean): Boolean; +begin + Result := False; + if (FFilename = '') or (FCreateParams = '') then Exit; + if FileExistsUTF8(FFilename) then + Result := OpenDB + else + Result := CreateDB; + if Result and AOpenTable then + Result := OpenTable(AGetRecordCount); +end; + +function TSQliteData.OpenTable(const AGetRecordCount: Boolean): Boolean; +begin + Result := False; + if not FConn.Connected then Exit; + try + if FQuery.Active then FQuery.Close; + if FSelectParams <> '' then + FQuery.SQL.Text := FSelectParams + else + FQuery.SQL.Text := 'SELECT * FROM ' + QuotedStrD(FTableName); + FQuery.Open; + if AGetRecordCount then + GetRecordCount + else + FRecordCount := FQuery.RecordCount; + except + on E: Exception do + DoOnError(E); + end; + Result := FQuery.Active; + if Result then DoConvertNewTable; +end; + +procedure TSQliteData.Close; +begin + if not FConn.Connected then Exit; + try + Save; + if FAutoVacuum then + Vacuum; + CloseTable; + FTrans.Active := False; + FConn.Close; + except + on E: Exception do + DoOnError(E); + end; +end; + +procedure TSQliteData.CloseTable; +begin + if not FConn.Connected then Exit; + if not FQuery.Active then Exit; + try + FQuery.Close; + FRecordCount := 0; + except + on E: Exception do + DoOnError(E); + end; +end; + +procedure TSQliteData.Refresh(RecheckDataCount: Boolean); +begin + if not FConn.Connected then Exit; + if FQuery.Active then + FQuery.Refresh + else + FQuery.Open; + if RecheckDataCount then + GetRecordCount + else + FRecordCount := FQuery.RecordCount; +end; + +procedure TSQliteData.Commit; +begin + if not FConn.Connected then Exit; + try + Transaction.Commit; + except + Transaction.Rollback; + end; +end; + +procedure TSQliteData.CommitRetaining; +begin + if not FConn.Connected then Exit; + try + Transaction.CommitRetaining; + except + Transaction.RollbackRetaining; + end; +end; + +procedure TSQliteData.Save; +var + qactive: Boolean; +begin + if not FConn.Connected then Exit; + try + qactive := FQuery.Active; + if FQuery.Active then + begin + FQuery.ApplyUpdates; + FQuery.Close; + end; + FTrans.Commit; + if qactive <> qactive then + FQuery.Active := FQuery.Active; + if FQuery.Active then + GetRecordCount; + except + on E: Exception do + DoOnError(E); + end; +end; + +function TSQliteData.Connected: Boolean; +begin + Result := FConn.Connected and FQuery.Active; +end; + +end. diff --git a/baseunits/SelfUpdater.pas b/baseunits/SelfUpdater.pas new file mode 100644 index 000000000..aad9ecbf1 --- /dev/null +++ b/baseunits/SelfUpdater.pas @@ -0,0 +1,323 @@ +unit SelfUpdater; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, httpsendthread, BaseThread, FMDOptions, process, ComCtrls, Controls, + Dialogs, StdCtrls, Buttons, Forms, blcksock; + +type + + { TSelfUpdaterThread } + + TSelfUpdaterThread = class(TBaseThread) + private + FStatusBar: TStatusBar; + FProgressBar: TProgressBar; + FButtonCancel: TSpeedButton; + FHTTP: THTTPSendThread; + FTotalSize: Integer; + FCurrentSize: Integer; + FFailedMessage: String; + FStatusText: String; + protected + procedure ButtonCancelClick(Sender: TObject); + procedure HTTPSockOnStatus(Sender: TObject; Reason: THookSocketReason; + const Value: String); + procedure HTTPRedirected(const AHTTP: THTTPSendThread; const URL: String); + protected + procedure SyncStart; + procedure SyncFinal; + procedure SyncStartDownload; + procedure SyncUpdateProgress; + procedure SyncUpdateStatus; + procedure SyncShowFailed; + procedure SyncFinishRestart; + procedure ProceedUpdate; + procedure UpdateStatusText(const S: String); + procedure Execute; override; + public + UpdateURL: String; + NewVersionString: String; + Filename: String; + DownloadSuccess: Boolean; + constructor Create; + destructor Destroy; override; + end; + +resourcestring + RS_Downloading = 'Downloading new version %s'; + RS_FailedTitle = 'Failed'; + RS_FailedDownload = 'Failed to download new version %s'#13#10#13#10'%d %s'; + RS_FailedToSave = 'Failed to save %s'; + RS_MissingFile = 'Missing %s'; + RS_FailedExtract = 'Failed to extract %s, exitstatus = %d'; + RS_ButtonCancel = 'Abort'; + RS_FinishRestartTitle = 'Download finished'; + RS_FinishRestart = 'Download update package finished, restart to proceed?'; + +implementation + +uses FMDVars; + +{ TSelfUpdaterThread } + +procedure TSelfUpdaterThread.ButtonCancelClick(Sender: TObject); +begin + Self.Terminate; +end; + +procedure TSelfUpdaterThread.HTTPSockOnStatus(Sender: TObject; + Reason: THookSocketReason; const Value: String); +begin + if Terminated then + Exit; + if Reason = HR_ReadCount then + begin + if FTotalSize = 0 then + FTotalSize := StrToIntDef(Trim(FHTTP.Headers.Values['Content-Length']), 0); + Inc(FCurrentSize, StrToInt(Value)); + Synchronize(@SyncUpdateProgress); + end + else + if Reason = HR_Connect then + begin + FCurrentSize := 0; + FTotalSize := 0; + end; +end; + +procedure TSelfUpdaterThread.HTTPRedirected(const AHTTP: THTTPSendThread; + const URL: String); +begin + UpdateStatusText(Format(RS_Downloading, [URL])); +end; + +procedure TSelfUpdaterThread.SyncStart; +begin + SelfUpdaterThread := Self; + + FStatusBar := TStatusBar.Create(FormMain); + with FStatusBar do + begin + Parent := FormMain; + SimplePanel := False; + with Panels.Add do // panel for progress bar + Width := 100; + Panels.Add; // panel for progress text + Panels.Add; // panel for status text + end; + + FProgressBar := TProgressBar.Create(FormMain); + with FProgressBar do + begin + Parent := FStatusBar; + Align := alNone; + Smooth := True; + Style := pbstNormal; + Min := 0; + Width := FStatusBar.Panels[0].Width - 10; + Anchors := [akTop, akLeft, akBottom]; + AnchorSideTop.Control := FStatusBar; + AnchorSideTop.Side := asrTop; + AnchorSideLeft.Control := FStatusBar; + AnchorSideLeft.Side := asrTop; + AnchorSideBottom.Control := FStatusBar; + AnchorSideBottom.Side := asrBottom; + BorderSpacing.Top := 2; + BorderSpacing.Left := 5; + BorderSpacing.Bottom := 2; + end; + + FButtonCancel := TSpeedButton.Create(FormMain); + with FButtonCancel do + begin + Parent := FStatusBar; + Align := alNone; + AutoSize := True; + Caption := RS_ButtonCancel; + ShowCaption := True; + Flat := True; + Anchors := [akTop, akRight, akBottom]; + AnchorSideTop.Control := FStatusBar; + AnchorSideTop.Side := asrTop; + AnchorSideRight.Control := FStatusBar; + AnchorSideRight.Side := asrRight; + AnchorSideBottom.Control := FStatusBar; + AnchorSideBottom.Side := asrBottom; + BorderSpacing.Top := 2; + BorderSpacing.Right := 5; + BorderSpacing.Bottom := 2; + OnClick := @ButtonCancelClick; + end; +end; + +procedure TSelfUpdaterThread.SyncFinal; +begin + FHTTP.Sock.OnStatus := nil; + FreeAndNil(FStatusBar); + FreeAndNil(FProgressBar); + FreeAndNil(FButtonCancel); + SelfUpdaterThread := nil; +end; + +procedure TSelfUpdaterThread.SyncStartDownload; +begin + FCurrentSize := 0; + FTotalSize := 0; + FProgressBar.Max := 0; + FProgressBar.Position := 0; + FStatusBar.Panels[1].Text := ''; + FStatusBar.Panels[1].Width := 0; + SyncUpdateStatus; +end; + +procedure TSelfUpdaterThread.SyncUpdateProgress; +var + s: String; +begin + if FStatusBar = nil then + Exit; + if FProgressBar.Max <> FTotalSize then + FProgressBar.Max := FTotalSize; + if FProgressBar.Position <> FCurrentSize then + FProgressBar.Position := FCurrentSize; + + s := FormatByteSize(FCurrentSize); + if FTotalSize <> 0 then + s += '/' + FormatByteSize(FTotalSize); + FStatusBar.Panels[1].Width := FStatusBar.Canvas.TextWidth(s) + 10; + FStatusBar.Panels[1].Text := s; +end; + +procedure TSelfUpdaterThread.SyncUpdateStatus; +begin + FStatusBar.Panels[2].Text := FStatusText; +end; + +procedure TSelfUpdaterThread.SyncShowFailed; +begin + MessageDlg(RS_FailedTitle, FFailedMessage, mtError, [mbOK], 0); +end; + +procedure TSelfUpdaterThread.SyncFinishRestart; +begin + if MessageDlg(RS_FinishRestartTitle, RS_FinishRestart, mtConfirmation, + mbYesNo, 0) = mrYes then + ProceedUpdate; +end; + +procedure TSelfUpdaterThread.ProceedUpdate; +begin + if not DownloadSuccess then Exit; + if FileExists(OLD_CURRENT_UPDATER_EXE) then + DeleteFile(OLD_CURRENT_UPDATER_EXE); + if FileExists(CURRENT_UPDATER_EXE) then + RenameFile(CURRENT_UPDATER_EXE, OLD_CURRENT_UPDATER_EXE); + if FileExists(OLD_CURRENT_UPDATER_EXE) then + begin + with TProcess.Create(nil) do + try + InheritHandles := False; + CurrentDirectory := FMD_DIRECTORY; + Executable := OLD_CURRENT_UPDATER_EXE; + Parameters.Add(Application.ExeName); + Parameters.Add(CURRENT_ZIP_EXE); + Parameters.Add(Self.Filename); + Parameters.Add(FMD_DIRECTORY); + Execute; + finally + Free; + end; + DoAfterFMD := DO_UPDATE; + FormMain.tmExitCommand.Interval := 32; + FormMain.tmExitCommand.Enabled := True; + end + else + FFailedMessage := Format(RS_MissingFile, [OLD_CURRENT_UPDATER_EXE]); +end; + +procedure TSelfUpdaterThread.UpdateStatusText(const S: String); +begin + if FStatusText = S then + Exit; + FStatusText := S; + Synchronize(@SyncUpdateStatus); +end; + +procedure TSelfUpdaterThread.Execute; +begin + DownloadSuccess := False; + if UpdateURL = '' then + Exit; + try + FStatusText := Format(RS_Downloading, [UpdateURL]); + Synchronize(@SyncStartDownload); + if FHTTP.GET(UpdateURL) and (FHTTP.ResultCode < 300) then + begin + DownloadSuccess := True; + Filename := FMD_DIRECTORY + UPDATE_PACKAGE_NAME; + if FileExists(Filename) then + DeleteFile(Filename); + if not FileExists(Filename) then + FHTTP.Document.SaveToFile(Filename); + + if FileExists(Filename) then + DeleteFile(Filename); + if not FileExists(Filename) then + begin + FHTTP.Document.SaveToFile(Filename); + if not FileExists(Filename) then + begin + FFailedMessage := Format(RS_FailedToSave, [Filename]); + DownloadSuccess := False; + end; + end + else + begin + FFailedMessage := Format(RS_FailedToSave, [Filename]); + DownloadSuccess := False; + end; + + if DownloadSuccess and (not FileExists(CURRENT_ZIP_EXE)) then + begin + FFailedMessage := Format(RS_MissingFile, [CURRENT_ZIP_EXE]); + DownloadSuccess := False; + end; + end + else + FFailedMessage := Format(RS_FailedDownload, [NewVersionString, + FHTTP.ResultCode, FHTTP.ResultString]); + except + on E: Exception do + FFailedMessage := E.Message; + end; +end; + +constructor TSelfUpdaterThread.Create; +begin + inherited Create(True); + FreeOnTerminate := True; + FFailedMessage := ''; + FHTTP := THTTPSendThread.Create(Self); + FHTTP.UserAgent := UserAgentCURL; + FHTTP.Sock.OnStatus := @HTTPSockOnStatus; + FHTTP.OnRedirected := @HTTPRedirected; + Synchronize(@SyncStart); +end; + +destructor TSelfUpdaterThread.Destroy; +begin + if (not Terminated) and (FFailedMessage <> '') then + Synchronize(@SyncShowFailed) + else + if DownloadSuccess then + Synchronize(@SyncFinishRestart); + Synchronize(@SyncFinal); + FHTTP.Free; + inherited Destroy; +end; + +end. diff --git a/baseunits/SimpleException/SimpleException.pas b/baseunits/SimpleException/SimpleException.pas new file mode 100644 index 000000000..4518ba882 --- /dev/null +++ b/baseunits/SimpleException/SimpleException.pas @@ -0,0 +1,705 @@ +{ SimpleException Class + + Copyright (C) 2014-2016 Nur Cholif + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} + +unit SimpleException; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazFileUtils, LazUTF8, Forms, Controls, SimpleExceptionForm + {$IFDEF WINDOWS} + , Windows, win32proc + {$ENDIF} + {$IFDEF LINUX} + , elfreader + {$ENDIF} + {$IF DEFINED(DARWIN) OR DEFINED(MACOS)} + , machoreader + {$ENDIF} + , fileinfo + {$IFDEF MULTILOG} + , MultiLog + {$ENDIF} + , LCLVersion; + +type + + { TSimpleException } + + TSimpleException = class + private + FLogFileHandle: TextFile; + FLogFileName: String; + FLogFileOK: Boolean; + FLogFileStatus: String; + FLastSender: TObject; + FLastException: Exception; + FApplicationInfo, + FLastReport: String; + FMaxStackCount: Integer; + FSimpleCriticalSection: TRTLCriticalSection; + FDefaultAppFlags: TApplicationFlags; + FUnhandled: Boolean; + procedure SetLogFileName(const AValue: String); + procedure SetMaxStackCount(AMaxStackCount: Integer); + protected + function ExceptionHeaderMessage: String; + function GetStackTraceStr: String; + procedure CreateExceptionReport; + procedure SaveLogToFile(const LogMsg: String); + procedure CallExceptionHandler; + procedure ExceptionHandler; + procedure UnhandledException(Obj: TObject; Addr: CodePointer; FrameCount: LongInt; + Frames: PCodePointer); + public + IgnoredExceptionList: TStringList; + property ApplicationInfo: String read FApplicationInfo; + property LogFileName: String read FLogFileName write SetLogFileName; + property LogFileOK: Boolean read FLogFileOK; + property LogFileStatus: String read FLogFileStatus; + property MaxStackCount: Integer read FMaxStackCount write SetMaxStackCount; + property LastSender: TObject read FLastSender; + property LastException: Exception read FLastException; + property LastReport: String read FLastReport; + procedure SimpleExceptionHandler(Sender: TObject; E: Exception); + procedure SimpleExceptionHandlerSaveLogOnly(Sender: TObject; E: Exception); + constructor Create(const FileName: String = ''); + destructor Destroy; override; + end; + +function GetIOResultStr(const AIOResult: Word): String; +function GetOSVer: String; +function GetFPCVersion: String; +function GetLCLVersion: String; +function GetWidgetSetName: String; +function GetTargetCPU_OS: String; +function GetBuildTime: String; + +function GetApplicationInfo: String; +function AddIgnoredException(const EClassName: String): Boolean; +function RemoveIgnoredClass(const EClassName: String): Boolean; +procedure SetMaxStackCount(const ACount: Integer); +procedure ClearIgnoredException; +procedure ExceptionHandle(Sender: TObject; E: Exception); +procedure ExceptionHandleSaveLogOnly(Sender: TObject; E: Exception); +procedure InitSimpleExceptionHandler(const LogFileName: String = ''); +procedure SetLogFileName(const LogFileName: String); +procedure DoneSimpleExceptionHandler; + +var + MainExceptionHandler: TSimpleException; + +{$IFDEF MULTILOG} +type + { TLoggerException } + + TLoggerException = class helper for TLogger + public + procedure SendExceptionStr(const AText: String; AExceptionStr: String); + procedure SendStrings(const AText: String; AValue: String); + procedure SendWarningStrings(const AText: String; AValue: String); + end; +{$ENDIF} + +resourcestring + SExceptionDialogTitle = 'Exception Info'; + SExceptionCaption = 'An error occured during program execution:'; + SButtonDetails = '&Show Details'; + SButtonTerminate = '&Terminate'; + SButtonContinue = '&Continue'; + SCheckBoxIgnoreException = 'Ignore this exception for next time'; + SCantHandleException = 'Can''t handle exception'; + +implementation + +uses InterfaceBase {$IF LCL_FULLVERSION >= 1080000}, LCLPlatformDef{$ENDIF}; + +{$IFDEF MULTILOG} +{ TLoggerException } + +procedure TLoggerException.SendExceptionStr(const AText: String; AExceptionStr: String); +begin + SendBuffer(ltException, AText, AExceptionStr[1], Length(AExceptionStr)); +end; + +procedure TLoggerException.SendStrings(const AText: String; AValue: String); +begin + SendBuffer(ltStrings, AText, AValue[1], Length(AValue)); +end; + +procedure TLoggerException.SendWarningStrings(const AText: String; + AValue: String); +begin + SendBuffer(ltWarning, AText, AValue[1], Length(AValue)); +end; + +{$ENDIF} + +procedure SetMaxStackCount(const ACount: Integer); +begin + if MainExceptionHandler <> nil then + MainExceptionHandler.MaxStackCount := ACount; +end; + +function GetIOResultStr(const AIOResult: Word): String; +begin + Result := IntToStr(AIOResult) + ': '; + case AIOResult of + 0 : Result := Result + 'OK.'; + 2 : Result := Result + 'File not found.'; + 3 : Result := Result + 'Path not found.'; + 4 : Result := Result + 'Too many open files.'; + 5 : Result := Result + 'Access denied.'; + 6 : Result := Result + 'Invalid file handle.'; + 12 : Result := Result + 'Invalid file-access mode.'; + 15 : Result := Result + 'Invalid disk number.'; + 16 : Result := Result + 'Cannot remove current directory.'; + 17 : Result := Result + 'Cannot rename across volumes.'; + 100: Result := Result + 'Error when reading from disk.'; + 101: Result := Result + 'Error when writing to disk.'; + 102: Result := Result + 'File not assigned.'; + 103: Result := Result + 'File not open.'; + 104: Result := Result + 'File not opened for input.'; + 105: Result := Result + 'File not opened for output.'; + 106: Result := Result + 'Invalid number.'; + 150: Result := Result + 'Disk is write protected.'; + 151: Result := Result + 'Unknown device.'; + 152: Result := Result + 'Drive not ready.'; + 153: Result := Result + 'Unknown command.'; + 154: Result := Result + 'CRC check failed.'; + 155: Result := Result + 'Invalid drive specified..'; + 156: Result := Result + 'Seek error on disk.'; + 157: Result := Result + 'Invalid media type.'; + 158: Result := Result + 'Sector not found.'; + 159: Result := Result + 'Printer out of paper.'; + 160: Result := Result + 'Error when writing to device.'; + 161: Result := Result + 'Error when reading from device.'; + 162: Result := Result + 'Hardware failure.'; + end; +end; + +function GetOSVer: String; +{$IFDEF WINDOWS} +var + wdir: array [0..MAX_PATH] of Char; + + function WinLater: String; + begin + if (Win32MajorVersion = 6) and (Win32MinorVersion = 3) then + Result := 'Windows 8.1' + else if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then + Result := 'Windows 10' + else + Result := Format('Windows %d.%d', [Win32MajorVersion, Win32MinorVersion]); + end; + +{$ENDIF} +begin + {$IFDEF LCLcarbon} + Result := 'Mac OS X 10.'; + {$ENDIF} + {$IFDEF Linux} + Result := 'Linux Kernel '; + {$ENDIF} + {$IFDEF UNIX} + Result := 'Unix '; + {$ENDIF} + {$IFDEF WINDOWS} + case WindowsVersion of + wv95: Result := 'Windows 95'; + wvNT4: Result := 'Windows NT v.4'; + wv98: Result := 'Windows 98'; + wvMe: Result := 'Windows ME'; + wv2000: Result := 'Windows 2000'; + wvXP: Result := 'Windows XP'; + wvServer2003: Result := 'Windows Server 2003'; + wvVista: Result := 'Windows Vista'; + wv7: Result := 'Windows 7'; + wv8: Result := 'Windows 8'; + else + Result := WinLater; + end; + FillChar({%H-}wdir, SizeOf(wdir), 0); + GetWindowsDirectory(PChar(wdir), MAX_PATH); + if DirectoryExists(wdir + '\SysWOW64') then + Result := Result + ' 64-bit'; + {$ENDIF} +end; + +function GetFPCVersion: String; +begin + Result := {$I %FPCVERSION%}; +end; + +function GetLCLVersion: String; +begin + Result := LCLVersion.lcl_version; +end; + +function GetWidgetSetName: String; +begin + case WidgetSet.LCLPlatform of + lpGtk : Result := 'GTK'; + lpGtk2 : Result := 'GTK2'; + lpGtk3 : Result := 'GTK3'; + lpWin32 : Result := 'Win32/Win64'; + lpWinCE : Result := 'WinCE'; + lpCarbon : Result := 'Carbon'; + lpQT : Result := 'Qt'; + lpfpGUI : Result := 'fpGUI'; + lpNoGUI : Result := 'NoGUI'; + lpCocoa : Result := 'Cocoa'; + lpCustomDrawn : Result := 'Custom Drawn'; + {$IF LCL_FULLVERSION >= 1080000} + lpQt5 : Result := 'Qt5'; + lpMUI : Result := 'MUI'; + {$ENDIF} + end; +end; + +function GetTargetCPU_OS: String; +begin + Result := {$I %FPCTARGETCPU%} + '-' + {$I %FPCTARGETOS%}; +end; + +function GetBuildTime: String; +begin + Result := {$I %DATE%} + ' ' + {$I %TIME%}; +end; + +function GetApplicationInfo: String; +begin + Result := ''; + if Assigned(MainExceptionHandler) then + Result := MainExceptionHandler.ApplicationInfo; +end; + +function AddIgnoredException(const EClassName: String): Boolean; +begin + Result := False; + if MainExceptionHandler <> nil then + if MainExceptionHandler.IgnoredExceptionList.IndexOf(EClassName) < 0 then + begin + Result := True; + MainExceptionHandler.IgnoredExceptionList.Add(EClassName); + end; +end; + +function RemoveIgnoredClass(const EClassName: String): Boolean; +begin + Result := False; + if MainExceptionHandler <> nil then + if MainExceptionHandler.IgnoredExceptionList.IndexOf(EClassName) > -1 then + begin + Result := True; + MainExceptionHandler.IgnoredExceptionList.Delete( + MainExceptionHandler.IgnoredExceptionList.IndexOf(EClassName)); + end; +end; + +procedure ClearIgnoredException; +begin + if MainExceptionHandler <> nil then + MainExceptionHandler.IgnoredExceptionList.Clear; +end; + +procedure ExceptionHandle(Sender: TObject; E: Exception); +begin + if not Assigned(MainExceptionHandler) then + InitSimpleExceptionHandler; + MainExceptionHandler.SimpleExceptionHandler(Sender, E); +end; + +procedure ExceptionHandleSaveLogOnly(Sender: TObject; E: Exception); +begin + if not Assigned(MainExceptionHandler) then + InitSimpleExceptionHandler; + MainExceptionHandler.SimpleExceptionHandlerSaveLogOnly(Sender, E); +end; + +procedure InitSimpleExceptionHandler(const LogFileName: String); +begin + if MainExceptionHandler = nil then + MainExceptionHandler := TSimpleException.Create(LogFilename); +end; + +procedure SetLogFileName(const LogFileName: String); +begin + if MainExceptionHandler <> nil then + MainExceptionHandler.LogFileName := LogFileName; +end; + +procedure DoneSimpleExceptionHandler; +begin + if MainExceptionHandler <> nil then + FreeAndNil(MainExceptionHandler); +end; + +{ TSimpleException } + +procedure TSimpleException.SetMaxStackCount(AMaxStackCount: Integer); +begin + if FMaxStackCount <> AMaxStackCount then + begin + if AMaxStackCount < 1 then + FMaxStackCount := 1 + else + if AMaxStackCount > 255 then + FMaxStackCount := 255 + else + FMaxStackCount := AMaxStackCount; + end; +end; + +procedure TSimpleException.SetLogFileName(const AValue: String); +var + ir: Word; + fe: Boolean; +begin + // always check for log file in case something changed at runtime (permission/disk removed) + FLogFileName := AValue; + AssignFile(FLogFileHandle, FLogFileName); + fe := FileExistsUTF8(FLogFileName); + if fe then + {$I-} + Append(FLogFileHandle) + else + Rewrite(FLogFileHandle); + {$I+} + ir := IOResult; + if ir = 0 then + begin + CloseFile(FLogFileHandle); + if not fe then + Erase(FLogFileHandle); + end; + FLogFileOK := ir = 0; + FLogFileStatus := GetIOResultStr(ir); +end; + +procedure TSimpleException.ExceptionHandler; +begin + if Assigned(FLastException) then + if (IgnoredExceptionList.IndexOf(FLastException.ClassName) > -1) then + Exit; + with TSimpleExceptionForm.Create(nil) do try + MemoExceptionLog.Lines.Text := FLastReport; + if Assigned(FLastException) then + LabelExceptionMessage.Caption := FLastException.Message; + if FUnhandled then + begin + CheckBoxIgnoreException.Visible := False; + ButtonContinue.Visible := False; + end; + if ShowModal = mrIgnore then + AddIgnoredException(FLastException.ClassName); + finally + Free; + end; +end; + +procedure TSimpleException.UnhandledException(Obj: TObject; Addr: CodePointer; + FrameCount: LongInt; Frames: PCodePointer); +var + i: Integer; + S: String; +begin + EnterCriticalSection(FSimpleCriticalSection); + try + FUnhandled := True; + if Obj is Exception then + begin + FLastSender := nil; + FLastException := Exception(Obj); + CreateExceptionReport; + CallExceptionHandler; + end + else + begin + FLastReport := ExceptionHeaderMessage; + if Obj is TObject then + FLastReport := FLastReport + + 'Sender Class : ' + Obj.ClassName + LineEnding; + FLastReport := FLastReport + + 'Exception Address : $' + BackTraceStrFunc(Addr) + LineEnding; + S := ''; + if FrameCount > 0 then + for i := 0 to FrameCount - 1 do + S := S + ' ' + BackTraceStrFunc(Frames[i]) + LineEnding; + FLastReport := FLastReport + S; + {$IFDEF MULTILOG} + if Logger.Enabled then + Logger.SendExceptionStr('Unhandled Exception occured at $' + BackTraceStrFunc(Addr), S) + else + {$ENDIF} + SaveLogToFile(FLastReport); + CallExceptionHandler; + end; + finally + LeaveCriticalSection(FSimpleCriticalSection); + end; +end; + +function TSimpleException.ExceptionHeaderMessage: String; +var + i: Integer; +begin + try + if FUnhandled then + Result := 'Unhandled exception!' + else + Result := 'Program exception!'; + Result := Result + LineEnding + + FApplicationInfo + LineEnding + + 'Thread ID : ' + IntToStr(GetThreadID) + LineEnding + + 'Time : ' + FormatDateTime('dd/mm/yyyy hh:nn:ss.zzz', Now) + LineEnding; + if IgnoredExceptionList.Count > 0 then + begin + Result := Result + 'Ignored Exception : ' + IgnoredExceptionList[0]; + for i := 1 to IgnoredExceptionList.Count - 1 do + Result := Result + ', ' + IgnoredExceptionList[i]; + Result := Result + LineEnding; + end; + except + Result := ''; + end; +end; + +function TSimpleException.GetStackTraceStr: String; +var + Frames: PPointer; + i, AMaxStackCount: Integer; +begin + Result := ''; + try + Result := BackTraceStrFunc(ExceptAddr); + Frames := ExceptFrames; + if ExceptFrameCount > FMaxStackCount then + AMaxStackCount := FMaxStackCount + else + AMaxStackCount := ExceptFrameCount; + for i := 0 to AMaxStackCount - 1 do + Result := Result + (LineEnding + BackTraceStrFunc(Frames[i])); + except + end; +end; + +procedure TSimpleException.CreateExceptionReport; +var + S: String; +begin + S := ''; + FLastReport := ExceptionHeaderMessage; + if Assigned(FLastSender) then + FLastReport := FLastReport + + 'Sender Class : ' + FLastSender.ClassName + LineEnding; + if Assigned(FLastException) then + begin + FLastReport := FLastReport + + 'Exception Class : ' + FLastException.ClassName + LineEnding + + 'Message : ' + FLastException.Message + LineEnding; + end; + S := GetStackTraceStr; + FLastReport := FLastReport + S; + {$IFDEF MULTILOG} + if Logger.Enabled then + begin + if Assigned(FLastException) then + Logger.SendExceptionStr(FLastException.ClassName + ' - ' + FLastException.Message, S) + else + Logger.SendExceptionStr('Program exception!', S); + end + else + {$ENDIF} + SaveLogToFile(FLastReport); +end; + +procedure TSimpleException.SaveLogToFile(const LogMsg: String); +var + ir: Word; +begin + if FLogFileName = '' then Exit; + if FileExistsUTF8(FLogFileName) then + {$I-} + Append(FLogFileHandle) + else + Rewrite(FLogFileHandle); + {$I+} + ir := IOResult; + if ir = 0 then + begin + WriteLn(FLogFileHandle, LogMsg); + CloseFile(FLogFileHandle); + end + else + begin + FLastReport := 'Failed to write exception message to "' + (FLogFileName) + '"' + LineEnding + + ' ' + GetIOResultStr(ir) + LineEnding + + FLastReport; + end; +end; + +procedure TSimpleException.CallExceptionHandler; +begin + if (ThreadID <> MainThreadID) then + try + {$IF FPC_FULLVERSION >= 20701} + TThread.Synchronize(TThread.CurrentThread, @ExceptionHandler); + {$ELSE} + if (Sender <> nil) and (Sender is TThread) then + TThread.Synchronize((Sender as TThread), @ExceptionHandler) + {$ENDIF} + except + {$IFDEF MULTILOG} + if Logger.Enabled then + Logger.SendError(SCantHandleException) + else + {$ENDIF} + SaveLogToFile(SCantHandleException); + end + else + ExceptionHandler; +end; + +procedure TSimpleException.SimpleExceptionHandler(Sender: TObject; E: Exception); +begin + if E = nil then + Exit; + EnterCriticalsection(FSimpleCriticalSection); + try + FUnhandled := False; + FLastSender := Sender; + FLastException := E; + CreateExceptionReport; + CallExceptionHandler; + finally + LeaveCriticalsection(FSimpleCriticalSection); + end; +end; + +procedure TSimpleException.SimpleExceptionHandlerSaveLogOnly(Sender: TObject; + E: Exception); +begin + if E = nil then + Exit; + EnterCriticalsection(FSimpleCriticalSection); + try + FUnhandled := False; + FLastSender := Sender; + FLastException := E; + CreateExceptionReport; + finally + LeaveCriticalsection(FSimpleCriticalSection); + end; +end; + +procedure CatchUnhandledExcept(Obj: TObject; Addr: CodePointer; FrameCount: LongInt; Frames: PCodePointer); +begin + if Assigned(MainExceptionHandler) then + MainExceptionHandler.UnhandledException(Obj, Addr, FrameCount, Frames); +end; + +constructor TSimpleException.Create(const FileName: String); +var + AFileVersion, AProductVersion: String; +begin + inherited Create; + FLogFileName := ''; + FLogFileOK := False; + FLogFileStatus := ''; + if Trim(FileName) <> '' then + LogFileName := FileName; + InitCriticalSection(FSimpleCriticalSection); + IgnoredExceptionList := TStringList.Create; + FMaxStackCount := 20; + with TFileVersionInfo.Create(nil) do + try + FileName := ParamStrUTF8(0); + if FileName = '' then + FileName := Application.ExeName; + try + Enabled := True; + if VersionStrings.Count <> 0 then + begin + AFileVersion := VersionStrings.Values['fileversion']; + AProductVersion := VersionStrings.Values['productversion']; + end; + except + end; + finally + Free; + end; + FApplicationInfo := + 'Application : ' + Application.Title + LineEnding; + if AFileVersion <> '' then + FApplicationInfo := FApplicationInfo + + 'Version : ' + AFileVersion + LineEnding; + if AProductVersion <> '' then + FApplicationInfo := FApplicationInfo + + 'Product Version : ' + AProductVersion + LineEnding; + FApplicationInfo := FApplicationInfo + + 'Host Machine : ' + GetOSVer + LineEnding + + 'FPC Version : ' + GetFPCVersion + LineEnding + + 'LCL Version : ' + GetLCLVersion + LineEnding + + 'WidgetSet : ' + GetWidgetSetName + LineEnding + + 'Target CPU-OS : ' + GetTargetCPU_OS + LineEnding + + 'Build Time : ' + GetBuildTime + LineEnding + + 'Path : ' + ParamStrUTF8(0) + LineEnding + + 'Process ID : ' + IntToStr(GetProcessID) + LineEnding + + 'MainThread ID : ' + IntToStr(MainThreadID); + if Assigned(Application) then + begin + FDefaultAppFlags := Application.Flags; + Application.Flags := Application.Flags + [AppNoExceptionMessages]; + Application.OnException := @SimpleExceptionHandler; + ExceptProc := @CatchUnhandledExcept; + end; +end; + +destructor TSimpleException.Destroy; +begin + if Assigned(Application) then + begin + Application.OnException := nil; + Application.Flags := FDefaultAppFlags; + end; + IgnoredExceptionList.Free; + DoneCriticalsection(FSimpleCriticalSection); + inherited Destroy; +end; + +initialization + +finalization + DoneSimpleExceptionHandler; + +end. diff --git a/baseunits/SimpleException/SimpleExceptionForm.lfm b/baseunits/SimpleException/SimpleExceptionForm.lfm new file mode 100644 index 000000000..087c04269 --- /dev/null +++ b/baseunits/SimpleException/SimpleExceptionForm.lfm @@ -0,0 +1,493 @@ +object SimpleExceptionForm: TSimpleExceptionForm + Left = 410 + Height = 250 + Top = 270 + Width = 580 + HorzScrollBar.Page = 445 + HorzScrollBar.Range = 445 + VertScrollBar.Page = 121 + VertScrollBar.Range = 121 + BorderIcons = [biSystemMenu] + Caption = 'SimpleExceptionForm' + ClientHeight = 250 + ClientWidth = 580 + FormStyle = fsSystemStayOnTop + OnClose = FormClose + OnCreate = FormCreate + OnShow = FormShow + Position = poDesktopCenter + object PanelTop: TPanel + Left = 0 + Height = 54 + Top = 0 + Width = 217 + AutoSize = True + BevelOuter = bvNone + ClientHeight = 54 + ClientWidth = 217 + Color = clWindow + ParentColor = False + TabOrder = 0 + object IconException: TImage + AnchorSideLeft.Control = PanelTop + AnchorSideTop.Control = PanelTop + Left = 6 + Height = 48 + Top = 6 + Width = 48 + AntialiasingMode = amOn + BorderSpacing.Left = 6 + BorderSpacing.Top = 6 + Center = True + Picture.Data = { + 1754506F727461626C654E6574776F726B47726170686963BA24000089504E47 + 0D0A1A0A0000000D49484452000000300000003008060000005702F987000000 + 097048597300000B1300000B1301009A9C18000000206348524D00007A250000 + 80830000F9FF000080E9000075300000EA6000003A980000176F925FC5460000 + 2440494441547801003024CFDB01FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000400000000ED6C4E00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000100000003E0000003E00 + 00002E0000001E000000160000000B00000000000000F5000000EA000000E200 + 0000D2000000C3000000C1000000F00000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000001394B2000400000000FFFF00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000007000000540000005C000000450000000300000000 + 0000000000000000000000000000000000000000000000060000001100000027 + 0000004500000073000000FD000000BC000000A3000000AC000000F900000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000200000000FF00FF00FF00FF00FF00FF + 00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF + 00FF00FF09FF00FF72FF00FFDDFF00FFA4FF00FF48FF00FF03FF00FF00FF00FF + 00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF + 00FF00FF00FF00FF00FF00FF03FF00FF47FF00FFA4FF00FFDEFF00FF72FF00FF + 09FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF + 00FF00FF00FF00FF00FF00FF00000000000400000000FFFF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 004900000093000000230000000000000000000000000000000003121500051A + 1F00030F1200020A0B00010709000103040000000000FFFDFC00FFF9F700FEF6 + F500FDF1EE00FBE6E100FDEEEB0000000000000000000000001A0000008D0000 + 006A0000006D000000B700000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000400000000FFFFFF000000000000 + 0000000000000000000000000000000000000000000000000000080000008E00 + 000069000000000000000000000000020A0D0007262C00061D23000104050000 + 0000000000000000000000000000000000000000000000010406000104060002 + 0B0F0004151A0007242C00FFFDFC00FAE2DC00F9DBD400FEF5F3000000000000 + 000023000000B60000009700000072000000F800000000000000000000000000 + 000000000000000000000000000000000000000400000000FFFFFF0000000000 + 000000000000000000000000000000000000000000000017000000B400000034 + 0000000000000000020809000A303900051A1E000000000000000000FFF6F300 + FEF1EE00FFF2EF00FFFAF80000FCFB0000FDFD00000000000003030000040500 + 01060800010E1100020F1200010A0B000721260007212600FBE6E200F6D0C700 + FEF8F7000000000000000069000000370000004A000000E90000000000000000 + 00000000000000000000000000000000000000000400000000FEFFFF00000000 + 000000000000000000000000000000000000000022000000B900000024000000 + 0000000000072228000A2B330001050600FFFF0000FEEBE700FDE6E000FFF5F3 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000ECE80000000000010B0D00031A20000215190004191E000D1418 + 00F6D5CD00F9DED8000000000000000032000000C400000046000000DF000000 + 0000000000000000000000000000000000000000000400000000FFFF00000000 + 00000000000000000000000000000000001C000000BD00000020000000000000 + 00000C343C00071F240000000000FEEEEA00FCDED800FFF9F700000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFF4F200FEDAD20001E1DB00042228000212 + 15000B30380004111500F4CCC3000000000000000024000000BE0000003D0000 + 00E400000000000000000000000000000000000000000400000000FEFFFF0000 + 00000000000000000000000000000A000000B20000002000000000000000000E + 394300061A1E00FFFF0000FCDAD200FDEBE70000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FFF8F600FAD6CE0003 + 15190004252C00061E23000C040500F2C7BD000000000000000020000000B200 + 00003C000000F6000000000000000000000000000000000400000000FFFFFF00 + 000000000000000000000000000000900000003100000000000000000F3A4400 + 06191D00FFFBFA00FBD9D200FEEFEC0000000000000000000000000000000000 + 000000000000000011859E000000000000000000000000000000000000000000 + 0000000000000000EF7B62000000000000000000000000000000000000000000 + FCE9E600FEFAFA0005272E0006191D000E394300F1C6BC000000000000000031 + 0000009100000065000000000000000000000000000000000200000000FEFFFF + 00FEFFFF00FEFFFF00FEFFFF4AFEFFFF65FEFFFF00FEFFFF000C343D0005181C + 00FEFAF800FAD6CE00FDEEEA00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE + 00FFFFFE00FFFFFE000000000000000000000000000000000000000000000000 + 000000000000000000FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE + 00FFFFFE00FDEEEA00FAD6CE00FEFAF80005181C000C343D00FEFFFF00FEFFFF + 00FEFFFF64FEFFFF4AFEFFFF00FEFFFF00FEFFFF00000000000200000000FFFF + FF00FFFFFF00FFFFFF08FFFFFF92FFFFFF00FFFFFF0009232900081E2300FFFE + FE00FAD8D100FDF0ED00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FDF0ED00FAD8D100FFFEFE00081E230009242A00FFFF + FF00FFFFFF00FFFFFF93FFFFFF08FFFFFF00FFFFFF00000000000200000000FE + FFFF00FEFFFF00FEFFFF69FEFFFF23FEFFFF00000709000A2A3100FFFFFF00FA + D9D100FDEEEB00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FF + FEFE00FFFEFE00FFFEFE00000000000000000000000000000000000000000000 + 0000000000000000000000FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FF + FEFE00FFFEFE00FFFEFE00FFFEFE00FDEEEB00FAD9D100FFFFFF000A29300000 + 080900FEFFFF00FEFFFF22FEFFFF69FEFFFF00FEFFFF00000000000200000000 + FEFEFF00FEFEFF07FEFEFF74FEFEFF00FEFEFF000D30370001040500FDECE800 + FCE8E500FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00 + FFFEFF00FFFEFF00FFFEFF000000000000000000000000000000000000000000 + 000000000000000000000000FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00 + FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FCE8E500FDECE80001040500 + 0D2F3700FEFEFF00FEFEFF00FEFEFF75FEFEFF08FEFEFF000000000002000000 + 00FEFFFF00FEFFFF54FEFFFF1AFEFFFF00010A0C00071A1F00FFFFFF00F8DBD4 + 00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE + 00FEFFFE00FEFFFE00FEFFFE0000000000000000000000000000000000000000 + 00000000000000000000000000FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE + 00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00F8DBD400FFFFFF + 00071A1F00020B0C00FEFFFF00FEFFFF19FEFFFF53FEFFFF0000000000020000 + 0000FFFFFF00FFFFFF5DFFFFFF00FFFFFF000C262C0000FFFF00FCE8E400FEF6 + F600FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFE + FF00FFFEFF00FFFEFF00FFFEFF00000000000000000000000000000000000000 + 0000000000000000000000000000FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFE + FF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FEF6F600FCE8 + E40000FFFF000B252C00FFFFFF00FFFFFF00FFFFFF5DFFFFFF00000000000200 + 000000FEFFFF10FEFFFF44FEFFFF00FEFFFF00091E2300FFFFFF00FAE2DD00FF + FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF + FFFE00FFFFFE00FFFFFE00FFFFFE00FFFCFB0000000000000000000000000000 + 0000000000000000000000FFFBFA00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF + FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FA + E2DD00FFFFFF00091E2300FEFFFF00FEFFFF00FEFFFF44FEFFFF100000000002 + 00000000FEFEFF3FFEFEFF03FEFEFF000511150001030300FEF5F200FDF2EF00 + FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 + FFFEFE00FFFEFE00FFFEFE00FFFEFE00FEF1EE00000000000000000000000000 + 000000000000000000000000FEF2EF00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 + FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 + FDF2EF00FEF5F2000103030005111500FEFEFF00FEFEFF03FEFEFF3F00000000 + 0200000000FEFFFF3CFEFFFF00FEFFFF00081B1F00FFFF0000FBEDEC00FEFEFF + 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF + 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FDF2F0000000000000000000000000 + 00000000000000000000000000FDF2F000FEFEFF00FEFEFF00FEFEFF00FEFEFF + 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF + 00FEFEFF00FBEDEC00FFFF0000081B1F00FEFFFF00FEFFFF00FEFFFF3D000000 + 000400000000FEFFFF290000000000000000040D0E00FF00FE00FDF1ED00FFFF + FE00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000FDF1EE0000000000000000000000 + 0000000000000000000000000000FDF1EE00FFFFFE0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000FDF1ED00FF1C1F00040E0F00FEFFFF0000000000000000290000 + 00000400000000FEFEFF250000000000000000040C0D0000FFFF00FDF5F300FF + FEFE000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000FCF1EF00000000000000000000 + 000000000000000000000000000000FCF0EE00FFFEFE00000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FDF5F30000FFFF00040B0C00FEFEFF00000000000000002400 + 0000000400000000FEFFFF18000000000000000002070900FFFFFF00FEF7F700 + FFFEFE0000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000FDF1EF000000000000000000 + 00000000000000000000000000000000FDF2F000FFFEFE000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000FEF9F900FFFFFF0002060700FEFFFF000000000000000014 + 000000000400000000FEFFFE0E000000000000000001030500FFFE0000FDFBFB + 00FFFEFF00000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000FCEFED0000000000000000 + 0000000000000000000000000000000000FCEFED00FEFEFF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000FFFBFB00FFFE000000020500FEFFFE0000000000000000 + 0C000000000400000000FEFEFF000000000000000000FF00FF0000000000FFFF + FE00FFFFFE000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FCF0ED00000000000000 + 000000000000000000000000000000000000FCF1EE00FFFFFE00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000FFFE00FF00FF00FF00FF00FEFEFF00000000000000 + 0000000000000400000000FFFFFFF20000000E00000000FEFAFA000205050000 + 020200FFFEFE0000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000FCF1EF000000000000 + 00000000000000000000000000000000000000FCF0EE00FFFEFE000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000101020000FFFF00FEFBFA00FFFFFF000000000000 + 0000F4000000000400000000FEFFFFE80000000E00000000FBF7F50006040F00 + 00050700FEF5F500000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000000000000000FAEEEB0000000000 + 0000000000000000000000000000000000000000FAEEEB00FEFEFF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000002040500FFFFFF00FCF8F700FEFFFF0000000000 + 000000EC000000000400000000FEFEFFDB0000002600000000F9F2F100050C0E + 0001080A00FFFEEC000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000FCF1EF0000FEFE + 000002020000000000000000000000000000FEFE00FCF1EF0000FEFE00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000001080A00FFFFFF00F9F2F100FEFEFF00000000 + 00000000DC000000000200000000FEFFFFD8FEFFFF00FEFFFF00F9F0EF0000FF + FF00030E1100FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE + FE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFCFC00FCF3 + F00000000000000000000000000000000000FCF3F100FFFCFC00FFFEFE00FFFE + FE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE + FE00FFFEFE00FFFEFE00FFFEFE00030E110000FFFF00F9F0EF00FEFFFF00FEFF + FF00FEFFFFD7000000000200000000FEFFFFC3FEFFFF00FEFFFF00F1E2DE00FF + FFFF0004131500FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF + FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FC + EFED0000000000000000000000000000000000FCEFEC00FFFFFE00FFFFFE00FF + FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF + FFFE00FFFFFE00FFFFFE00FFFFFE0004131500FFFFFF00F1E2DE00FEFFFF00FE + FFFF00FEFFFFC3000000000400000000FEFFFFC1000000FD00000003F4EBE900 + FDFBFB00020B0D00020C0F00FCF2F00000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + E79C8D00020A0C00000000000000000000000000FEF6F400FEFEFF0000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000040E1000020B0D00FDFBFB00F4EBE90000000000 + 000000FD000000C2000000000400000000FEFEFFF0000000BC00000047000000 + 00EFDEDA001225290007212600FBCFC800000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00F6DCD700000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000007212600FFFFFF00EFDEDB00FEFEFF00000000 + 00000000BD000000EF000000000400000000FEFFFF00000000A3000000470000 + 0000E9D5D20012242800071A1E00F5D7D100FEF7F50000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000134A56000205050000000000000000000000000000000000EDBAB000FEF7 + F500000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000002090B00071A1E0000FFFF00E9D5D100FEFFFF000000 + 0000000000A300000000000000000400000000FFFFFF00000000AD0000008B00 + 000019F9F3F100F0E2DF000F1D20000B2B3100F2CAC300000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000016556100030A0C0000000000000000000000000000000000EFC3BB00FD + F5F4000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000B2B3100FFFFFF00F1E3E000F9F3F1000000000000 + 0000E7000000AC00000000000000000200000000FEFFFF00FEFFFFF8FEFFFF8B + FEFFFF00FEFFFF00E3CAC500FCFAF90005171A0005191C00FEFFFE00FEFFFE00 + FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00 + FEFFFE00000000000000000000000000000000000000000000000000FFFFFE00 + FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00 + FEFFFE00FEFFFE0005191C0005171A00FCFBF900E3CAC500FEFFFF00FEFFFF00 + FEFFFF8CFEFFFFF8FEFFFF00000000000200000000FEFEFF00FEFEFF00FEFEFF + 97FEFEFFDEFEFEFF00F9F5F500E7D0CD0000FE00000D30380005121600FFFEFF + 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF + 00FFFEFF00000000000000000000000000000000000000000000000000FFFEFF + 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF + 00FFFEFF00051216000D30380000FE0000E7D0CE00F9F5F500FEFEFF00FEFEFF + DEFEFEFF96FEFEFF00FEFEFF00000000000200000000FEFFFF00FEFFFF00FEFF + FFF8FEFFFF6DFEFFFF00FEFFFF00E8D7D300EDDEDB00000102000D3239000411 + 1400FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE + FE00FFFEFE00000000000000000000000000000000000000000000000000FFFF + FF00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE + FE00041114000D32390000010200EDDEDB00E8D6D200FEFFFF00FEFFFF00FEFF + FF6EFEFFFFF8FEFFFF00FEFFFF00000000000200000000FFFFFF00FFFFFF00FF + FFFF00FFFFFFB6FFFFFF9DFFFFFF00FFFFFF00DEC4BE00F1E5E100020708000F + 363E0005161900FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF + FFFF00FFFFFF00000000000000000000000000000000000000000000000000FF + FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0005 + 1619000F363E0002070800F1E5E100DEC4BE00FFFFFF00FFFFFF00FFFFFF9FFF + FFFFB5FFFFFF00FFFFFF00FFFFFF000000000001FFFFFF00AF412B0000000000 + 00000000000000000000000A000000C500000030000000000000000025414600 + 101C1F00FFFEFE00F2CFC700F8E3DF0000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000000081D2100 + 0E31390001020200F0E4E100DBBFBA000000000000000000000000D00000003B + 000000F600000000000000000000000051BFD5000200000000FFFFFF00FFFFFF + 00FFFFFF00FFFFFF00FFFFFFF6FFFFFF4DFFFFFFE1FFFFFF00FFFFFF00DABEB9 + 00EBDDDA00000101000E323A000F363F0002080A00FFFEFF00FFFEFF00FFFEFF + 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF + 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF0002080A000F363F000E323A + 0000010100EBDDDA00DABEB900FFFFFF00FFFFFF00FFFFFFE1FFFFFF4DFFFFFF + F6FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000400000000FEFFFF000000 + 0000000000000000000000000000000000E400000042000000BB000000220000 + 0000DDC4BF00F5ECEB001C30340007191C0007191C00F7E3DF00F6DBD600FBF0 + EE00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000051012000A252A00091D210000000000FCFA + F900E4D0CC00E9D8D5000000000000000000000000DE00000045000000E40000 + 0000000000000000000000000000000000000000000001FFFFFF00AB3E280000 + 000000000000000000000000000000000000000000000000000018000000B500 + 000032000000000000000005090A0021373C00111E20000000000000000000FC + F3F100FAEAE800FBEEEB00FDF7F600FEF8F700FEFCFB00000000000204050002 + 08090003090A000512150006161800040D0F000000000000000000EFE2E000DF + C9C400FBF7F6000000000000000000000000CE0000004B000000E80000000000 + 0000000000000000000000000000000000000055C2D80001FFFFFF00A93D2800 + 0000000000000000000000000000000000000000000000000000000000000008 + 0000009100000066000000000000000000000000080D0E001A2B2E0015242600 + 0203040000000000000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000FEFDFC00EBDCDA00E6D5D200F8F3F200 + 0000000000000000000000000000009900000070000000F80000000000000000 + 000000000000000000000000000000000000000057C3D80001FFFFFF00A83C27 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000004A0000009200000023000000000000000000000000000000 + 000D151700131F2100090F1000080D0E00050909000304050000000000FDFCFB + 00FBF7F700F8F3F200F7F1F000EDE1DF00F3EBE9000000000000000000000000 + 0000000000000000DD0000006D000000B7000000000000000000000000000000 + 00000000000000000000000000000000000000000058C4D9000400000000FFFF + FF00000000000000000000000000000000000000000000000000000000000000 + 000000000000000000B6000000BF000000690000007400000019000000000000 + 0000F2EAE800F2EAE80000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00E70000008C00000097000000F7000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000000000000400000000FF + FFFF000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000F70000008E00000095000000540000005F00 + 0000420000000300000000000000000000000000000000000000000000000000 + 00000000000000000000000000000000000000000000FD000000BE000000A100 + 0000AC000000F900000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000400000000 + FF00000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000F9000000A5000000A5 + 000000110000003F0000003B0000002A00000022000000170000000C00000000 + 000000F4000000E9000000DE000000D6000000C5000000C1000000EF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000001FFFFFF + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000010000 + FFFF99B3ED4DB34E9B390000000049454E44AE426082 + } + Proportional = True + Transparent = True + end + object LabelExceptionCaption: TLabel + AnchorSideLeft.Control = IconException + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = IconException + Left = 60 + Height = 21 + Top = 6 + Width = 157 + BorderSpacing.Left = 6 + Caption = 'LabelExceptionCaption' + Font.Height = -16 + ParentColor = False + ParentFont = False + end + object LabelExceptionMessage: TLabel + AnchorSideLeft.Control = LabelExceptionCaption + AnchorSideTop.Control = LabelExceptionCaption + AnchorSideTop.Side = asrBottom + Left = 66 + Height = 15 + Top = 27 + Width = 147 + BorderSpacing.Left = 6 + Caption = 'LabelExceptionMessage' + Font.Height = -12 + Font.Name = 'Courier New' + ParentColor = False + ParentFont = False + WordWrap = True + end + end + object PanelBottom: TPanel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = PanelTop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 195 + Top = 55 + Width = 580 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = True + BorderSpacing.Top = 1 + BevelOuter = bvNone + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ClientHeight = 195 + ClientWidth = 580 + ParentColor = False + TabOrder = 1 + object CheckBoxIgnoreException: TCheckBox + AnchorSideLeft.Control = PanelBottom + AnchorSideTop.Control = ButtonDetails + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = ButtonDetails + Left = 6 + Height = 19 + Top = 10 + Width = 157 + Caption = 'CheckBoxIgnoreException' + TabOrder = 1 + end + object ButtonDetails: TBitBtn + AnchorSideTop.Control = ButtonTerminate + AnchorSideRight.Control = ButtonTerminate + Left = 190 + Height = 26 + Top = 6 + Width = 117 + Anchors = [akTop, akRight] + AutoSize = True + Caption = '&ButtonDetails' + Kind = bkHelp + OnClick = ButtonDetailsClick + TabOrder = 0 + end + object ButtonTerminate: TBitBtn + AnchorSideTop.Control = ButtonContinue + AnchorSideRight.Control = ButtonContinue + Left = 307 + Height = 26 + Top = 6 + Width = 136 + Anchors = [akTop, akRight] + AutoSize = True + Caption = '&ButtonTerminate' + Kind = bkAbort + ModalResult = 3 + OnClick = ButtonTerminateClick + TabOrder = 2 + end + object ButtonContinue: TBitBtn + AnchorSideTop.Control = PanelBottom + AnchorSideRight.Control = PanelBottom + AnchorSideRight.Side = asrBottom + Left = 443 + Height = 26 + Top = 6 + Width = 131 + Anchors = [akTop, akRight] + AutoSize = True + Caption = '&ButtonContinue' + Kind = bkYes + ModalResult = 6 + OnClick = ButtonContinueClick + TabOrder = 3 + end + object MemoExceptionLog: TMemo + AnchorSideLeft.Control = PanelBottom + AnchorSideTop.Control = ButtonDetails + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PanelBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = PanelBottom + AnchorSideBottom.Side = asrBottom + Left = 6 + Height = 151 + Top = 38 + Width = 568 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 6 + Font.Height = -12 + Font.Name = 'Courier New' + Lines.Strings = ( + 'MemoExceptionLog' + ) + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 4 + WordWrap = False + end + end + object BevelPannelBottom: TShape + AnchorSideLeft.Control = PanelTop + AnchorSideTop.Control = PanelTop + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = PanelTop + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 2 + Top = 54 + Width = 217 + Anchors = [akTop, akLeft, akRight] + Brush.Color = clBtnShadow + Pen.Color = clBtnShadow + Pen.Style = psClear + end +end diff --git a/baseunits/SimpleException/SimpleExceptionForm.pas b/baseunits/SimpleException/SimpleExceptionForm.pas new file mode 100644 index 000000000..f77e4749a --- /dev/null +++ b/baseunits/SimpleException/SimpleExceptionForm.pas @@ -0,0 +1,130 @@ +{ SimpleException Dialog + + Copyright (C) 2014 Nur Cholif + + This source is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 2 of the License, or (at your option) + any later version. + + This code is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + A copy of the GNU General Public License is available on the World Wide Web + at . You can also obtain it by writing + to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA. +} + +unit SimpleExceptionForm; + +{$mode objfpc}{$H+} + +interface + +uses + {$ifdef windows} + windows, + {$endif} + Forms, Controls, StdCtrls, ExtCtrls, Buttons, Classes; + +type + + { TSimpleExceptionForm } + + TSimpleExceptionForm = class(TForm) + ButtonContinue : TBitBtn; + ButtonDetails: TBitBtn; + ButtonTerminate : TBitBtn; + CheckBoxIgnoreException: TCheckBox; + IconException: TImage; + LabelExceptionMessage: TLabel; + LabelExceptionCaption: TLabel; + MemoExceptionLog: TMemo; + PanelBottom: TPanel; + PanelTop: TPanel; + BevelPannelBottom: TShape; + procedure ButtonContinueClick(Sender: TObject); + procedure ButtonDetailsClick(Sender: TObject); + procedure ButtonTerminateClick(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + { private declarations } + normalheight, + expandedheight: Integer; + public + { public declarations } + end; + +implementation + +uses SimpleException; + +{$R *.lfm} + +{ TSimpleExceptionForm } + +procedure TSimpleExceptionForm.ButtonDetailsClick(Sender: TObject); +begin + if ClientHeight <= normalheight then + ClientHeight := expandedheight + else + ClientHeight := normalheight; +end; + +procedure TSimpleExceptionForm.ButtonTerminateClick(Sender: TObject); +begin + {$ifdef windows} + TerminateProcess(GetCurrentProcess, 0); + {$else} + halt; + {$endif} +end; + +procedure TSimpleExceptionForm.FormCreate(Sender: TObject); +begin + Icon.Assign(Application.Icon); + IconException.Visible := IconException.Picture.Graphic <> nil; + Caption := SExceptionDialogTitle; + LabelExceptionCaption.Caption := SExceptionCaption; + ButtonDetails.Caption := TCaption(SButtonDetails); + ButtonTerminate.Caption := TCaption(SButtonTerminate); + ButtonContinue.Caption := TCaption(SButtonContinue); + CheckBoxIgnoreException.Caption := SCheckBoxIgnoreException; + CheckBoxIgnoreException.Checked := False; +end; + +procedure TSimpleExceptionForm.FormShow(Sender: TObject); +begin + normalheight := min(PanelTop.Height + ButtonDetails.Height + (6 * 2), Screen.Height); + expandedheight := normalheight + 300; + Constraints.MinWidth := CheckBoxIgnoreException.Width + ButtonDetails.Width + ButtonTerminate.Width + ButtonContinue.Width + (6 * 5); + Constraints.MinHeight := normalheight; + ClientWidth := min(max(PanelTop.Width, Constraints.MinWidth), Screen.Width); + ClientHeight := normalheight; + PanelTop.AutoSize := False; + PanelTop.Width := ClientWidth; + PanelTop.Anchors := [akLeft, akRight, akTop]; + Position := poMainFormCenter; +end; + +procedure TSimpleExceptionForm.ButtonContinueClick(Sender: TObject); +begin + Close; +end; + +procedure TSimpleExceptionForm.FormClose(Sender: TObject; + var CloseAction: TCloseAction); +begin + if CheckBoxIgnoreException.Checked then + ModalResult := mrIgnore + else + ModalResult := mrClose; +end; + +end. + diff --git a/baseunits/SimpleException/USimpleException.pas b/baseunits/SimpleException/USimpleException.pas deleted file mode 100644 index 099b13331..000000000 --- a/baseunits/SimpleException/USimpleException.pas +++ /dev/null @@ -1,481 +0,0 @@ -{ SimpleException Class - - Copyright (C) 2014 Nur Cholif - - This source is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your option) - any later version. - - This code is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS - FOR A PARTICULAR PURPOSE. See the GNU General Public License for more - details. - - A copy of the GNU General Public License is available on the World Wide Web - at . You can also obtain it by writing - to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, - MA 02111-1307, USA. -} - -unit USimpleException; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, FileUtil, Forms, Controls, LCLVersion, DbgInfoReader, - USimpleExceptionForm, USimpleLogger, - {$IFDEF WINDOWS} - windows, win32proc, - {$ENDIF} - {$IFDEF LINUX} - elfreader, - {$ENDIF} - {$IF DEFINED(DARWIN) OR DEFINED(MACOS)} - machoreader, - {$ENDIF} - fileinfo; - -type - - { TSimpleException } - - TSimpleException = class - private - FAppInfo_comments, - FAppInfo_companyname, - FAppInfo_filedescription, - FAppInfo_fileversion, - FAppInfo_internalname, - FAppInfo_legalcopyright, - FAppInfo_legaltrademarks, - FAppInfo_originalfilename, - FAppInfo_productname, - FAppInfo_productversion: String; - FAppVerInfo: TStringList; - FOSversion: string; - FLastSender: TObject; - FLastException: Exception; - FLastReport: String; - FMaxStackCount: Integer; - FSimpleCriticalSection: TRTLCriticalSection; - FDefaultAppFlags: TApplicationFlags; - FUnhandled: Boolean; - function OSVer: String; - procedure SetMaxStackCount(AMaxStackCount: Integer); - protected - function ExceptionHeaderMessage: string; - procedure CreateExceptionReport; - procedure SaveLogToFile(LogMsg: string); - procedure CallExceptionHandler; - procedure ExceptionHandler; - procedure UnhandledException(Obj : TObject; Addr: CodePointer; FrameCount: Longint; Frames: PCodePointer); - public - LogFilename: String; - IgnoredExceptionList: TStringlist; - property MaxStackCount: Integer read FMaxStackCount write SetMaxStackCount; - property LastSender: TObject read FLastSender; - property LastException: Exception read FLastException; - property LastReport: String read FLastReport; - procedure SimpleExceptionHandler(Sender: TObject; E: Exception); - procedure SimpleExceptionHandlerSaveLogOnly(Sender: TObject; E: Exception); - constructor Create(Filename: string = ''); - destructor Destroy; override; - end; - -function AddIgnoredException(const EClassName: String): Boolean; -function RemoveIgnoredClass(const EClassName: String): Boolean; -procedure SetMaxStackCount(const ACount: Integer); -procedure ClearIgnoredException; -procedure ExceptionHandle(Sender: TObject; E: Exception); -procedure ExceptionHandleSaveLogOnly(Sender: TObject; E: Exception); -procedure InitSimpleExceptionHandler(const LogFilename: String = ''); -procedure DoneSimpleExceptionHandler; - -var - SimpleException: TSimpleException; - -resourcestring - SExceptionDialogTitle = 'Exception Info'; - SExceptionCaption = 'An error occured during program execution:'; - SButtonDetails = '&Show Details'; - SButtonTerminate = '&Terminate'; - SButtonContinue = '&Continue'; - SCheckBoxIgnoreException = 'Ignore this exception for next time'; - SCantHandleException = 'Can''t handle exception'; - -implementation - -procedure SetMaxStackCount(const ACount : Integer); -begin - if SimpleException <> nil then - SimpleException.MaxStackCount := ACount; -end; - -function AddIgnoredException(const EClassName : String) : Boolean; -begin - Result := False; - if SimpleException <> nil then - if SimpleException.IgnoredExceptionList.IndexOf(EClassName) < 0 then - begin - Result := True; - SimpleException.IgnoredExceptionList.Add(EClassName); - end; -end; - -function RemoveIgnoredClass(const EClassName : String) : Boolean; -begin - Result := False; - if SimpleException <> nil then - if SimpleException.IgnoredExceptionList.IndexOf(EClassName) > -1 then - begin - Result := True; - SimpleException.IgnoredExceptionList.Delete( - SimpleException.IgnoredExceptionList.IndexOf(EClassName)); - end; -end; - -procedure ClearIgnoredException; -begin - if SimpleException <> nil then - SimpleException.IgnoredExceptionList.Clear; -end; - -procedure ExceptionHandle(Sender: TObject; E: Exception); -begin - if not Assigned(SimpleException) then - InitSimpleExceptionHandler; - SimpleException.SimpleExceptionHandler(Sender, E); -end; - -procedure ExceptionHandleSaveLogOnly(Sender: TObject; E: Exception); -begin - if not Assigned(SimpleException) then - InitSimpleExceptionHandler; - SimpleException.SimpleExceptionHandlerSaveLogOnly(Sender, E); -end; - -procedure InitSimpleExceptionHandler(const LogFilename : String); -begin - if SimpleException = nil then - SimpleException := TSimpleException.Create(LogFilename); -end; - -procedure DoneSimpleExceptionHandler; -begin - if SimpleException <> nil then - FreeAndNil(SimpleException); -end; - -{ TSimpleException } - -procedure TSimpleException.SetMaxStackCount(AMaxStackCount: Integer); -begin - if FMaxStackCount <> AMaxStackCount then - if AMaxStackCount < 1 then - FMaxStackCount := 1 - else - FMaxStackCount := AMaxStackCount; -end; - -function TSimpleException.OSVer: String; -{$IFDEF WINDOWS} -var - wdir: array [0..MAX_PATH] of Char; -{$ENDIF} -begin - {$IFDEF LCLcarbon} - Result := 'Mac OS X 10.'; - {$ENDIF} - {$IFDEF Linux} - Result := 'Linux Kernel '; - {$ENDIF} - {$IFDEF UNIX} - Result := 'Unix '; - {$ENDIF} - {$IFDEF WINDOWS} - case WindowsVersion of - wv95: Result := 'Windows 95'; - wvNT4: Result := 'Windows NT v.4'; - wv98: Result := 'Windows 98'; - wvMe: Result := 'Windows ME'; - wv2000: Result := 'Windows 2000'; - wvXP: Result := 'Windows XP'; - wvServer2003: Result := 'Windows Server 2003'; - wvVista: Result := 'Windows Vista'; - wv7: Result := 'Windows 7'; - wv8: Result := 'Windows 8'; - else - Result := 'Windows'; - end; - GetWindowsDirectory(PChar(wdir), MAX_PATH); - if DirectoryExists(wdir + '\SysWOW64') then - Result := Result + ' 64-bit'; - {$ENDIF} -end; - -procedure TSimpleException.ExceptionHandler; -begin - if Assigned(FLastException) then - if (IgnoredExceptionList.IndexOf(FLastException.ClassName) > -1) then - Exit; - with TSimpleExceptionForm.Create(nil) do try - MemoExceptionLog.Lines.Text := FLastReport; - if Assigned(FLastException) then - LabelExceptionMessage.Caption := FLastException.Message; - if FUnhandled then - begin - CheckBoxIgnoreException.Visible := False; - ButtonContinue.Visible := False; - end; - if ShowModal = mrIgnore then - AddIgnoredException(FLastException.ClassName); - finally - Free; - end; -end; - -procedure TSimpleException.UnhandledException(Obj: TObject; Addr: CodePointer; - FrameCount: Longint; Frames: PCodePointer); -var - i: Integer; -begin - EnterCriticalSection(FSimpleCriticalSection); - try - FUnhandled := True; - if Obj is Exception then - begin - FLastSender := nil; - FLastException := Exception(Obj); - CreateExceptionReport; - CallExceptionHandler; - end - else - begin - FLastReport := ExceptionHeaderMessage; - if Obj is TObject then - FLastReport := FLastReport + - 'Sender Class : ' + Obj.ClassName + LineEnding; - FLastReport := FLastReport + - 'Exception Address : $' + SimpleBackTraceStr(Addr) + LineEnding; - if FrameCount > 0 then - for i := 0 to FrameCount-1 do - FLastReport := FLastReport + ' ' + SimpleBackTraceStr(Frames[i]) + LineEnding; - SaveLogToFile(FLastReport); - CallExceptionHandler; - end; - finally - LeaveCriticalSection(FSimpleCriticalSection); - end; -end; - -function TSimpleException.ExceptionHeaderMessage: string; -begin - try - if FUnhandled then - Result := 'Unhandled exception!' - else - Result := 'Program exception!'; - Result := Result + LineEnding + - 'Application : ' + Application.Title + LineEnding + - 'Version : ' + FAppInfo_fileversion + LineEnding + - 'Product Version : ' + FAppInfo_productversion + LineEnding + - 'FPC Version : ' + {$i %FPCVERSION%} + LineEnding + - 'LCL Version : ' + LCLVersion.lcl_version + LineEnding + - 'Target CPU_OS : ' + {$i %FPCTARGETCPU%} +'_' + {$i %FPCTARGETOS%} +LineEnding + - 'Host Machine : ' + FOSversion + LineEnding + - 'Path : ' + ParamStrUTF8(0) + LineEnding + - 'Proccess Id : ' + IntToStr(GetProcessID) + LineEnding + - 'Thread Id : ' + IntToStr(GetThreadID) + LineEnding + - 'Time : ' + DateTimeToStr(Now) + LineEnding; - if IgnoredExceptionList.Count > 0 then - Result := Result + - 'Ignored Exception : ' + IgnoredExceptionList.DelimitedText + LineEnding; - except - Result := ''; - end; -end; - - - -procedure TSimpleException.CreateExceptionReport; -begin - try - FLastReport := ExceptionHeaderMessage; - if Assigned(FLastSender) then - FLastReport := FLastReport + - 'Sender Class : ' + FLastSender.ClassName + LineEnding; - if Assigned(FLastException) then - begin - FLastReport := FLastReport + - 'Exception Class : ' + FLastException.ClassName + LineEnding + - 'Message : ' + FLastException.Message + LineEnding; - end; - FLastReport := FLastReport + GetStackTraceInfo + LineEnding; - except - on E: Exception do - begin - FLastReport := 'Failed to create exception FLastReport!' + LineEnding + - FLastReport + LineEnding; - if Assigned(LastSender) then - FLastReport := FLastReport + 'Sender Class: ' + LastSender.ClassName + LineEnding; - FLastReport := FLastReport + E.ClassName + ': ' + E.Message; - end; - end; - SaveLogToFile(FLastReport); -end; - -procedure TSimpleException.SaveLogToFile(LogMsg: string); -var - f: TextFile; -begin - if LogFilename <> '' then - begin - AssignFile(f, LogFilename); - try - if FileExistsUTF8(LogFilename) then - Append(f) - else - Rewrite(f); - WriteLn(f, LogMsg); - finally - CloseFile(f); - end; - end; - WriteLog_E('From ExceptionHandler:'#13#10+LogMsg); -end; - -procedure TSimpleException.CallExceptionHandler; -begin - if (ThreadID <> MainThreadID) then - try - {$IF FPC_FULLVERSION >= 20701} - TThread.Synchronize(TThread.CurrentThread, @ExceptionHandler); - {$ELSE} - if (Sender <> nil) and (Sender is TThread) then - TThread.Synchronize((Sender as TThread), @ExceptionHandler) - {$ENDIF} - except - SaveLogToFile(SCantHandleException); - end - else - ExceptionHandler; -end; - -procedure TSimpleException.SimpleExceptionHandler(Sender: TObject; E: Exception); -begin - if E = nil then - Exit; - EnterCriticalsection(FSimpleCriticalSection); - try - FUnhandled := False; - FLastSender := Sender; - FLastException := E; - CreateExceptionReport; - CallExceptionHandler; - finally - LeaveCriticalsection(FSimpleCriticalSection); - end; -end; - -procedure TSimpleException.SimpleExceptionHandlerSaveLogOnly(Sender: TObject; - E: Exception); -begin - if E = nil then - Exit; - EnterCriticalsection(FSimpleCriticalSection); - try - FUnhandled := False; - FLastSender := Sender; - FLastException := E; - CreateExceptionReport; - finally - LeaveCriticalsection(FSimpleCriticalSection); - end; -end; - -Procedure CatchUnhandledExcept(Obj : TObject; Addr: CodePointer; FrameCount: Longint; Frames: PCodePointer); -begin - if Assigned(SimpleException) then - SimpleException.UnhandledException(Obj, Addr, FrameCount, Frames); -end; - -constructor TSimpleException.Create(Filename : string); -var - i: Integer; -begin - inherited Create; - InitCriticalSection(FSimpleCriticalSection); - if Trim(Filename) <> '' then - LogFilename := Filename - else - LogFilename := ExtractFileNameOnly(Application.ExeName) + '.log'; - FMaxStackCount := 20; - FAppVerInfo := TStringList.Create; - IgnoredExceptionList := TStringList.Create; - FOSversion := OSVer; - with TFileVersionInfo.Create(nil) do - try - try - fileName := ParamStrUTF8(0); - if fileName = '' then - fileName := Application.ExeName; - {$IF FPC_FULLVERSION >= 20701} - ReadFileInfo; - {$ENDIF} - if VersionStrings.Count > 0 then - begin - {$IF FPC_FULLVERSION >= 20701} - FAppVerInfo.Assign(VersionStrings); - {$ELSE} - for i := 0 to VersionStrings.Count - 1 do - FAppVerInfo.Add(VersionCategories.Strings[i] + '=' + - VersionStrings.Strings[i]); - {$ENDIF} - for i := 0 to FAppVerInfo.Count - 1 do - FAppVerInfo.Strings[i] := - LowerCase(FAppVerInfo.Names[i]) + '=' + FAppVerInfo.ValueFromIndex[i]; - FAppInfo_comments := FAppVerInfo.Values['comments']; - FAppInfo_companyname := FAppVerInfo.Values['companyname']; - FAppInfo_filedescription := FAppVerInfo.Values['filedescription']; - FAppInfo_fileversion := FAppVerInfo.Values['fileversion']; - FAppInfo_internalname := FAppVerInfo.Values['internalname']; - FAppInfo_legalcopyright := FAppVerInfo.Values['legalcopyright']; - FAppInfo_legaltrademarks := FAppVerInfo.Values['legaltrademarks']; - FAppInfo_originalfilename := FAppVerInfo.Values['originalfilename']; - FAppInfo_productname := FAppVerInfo.Values['productname']; - FAppInfo_productversion := FAppVerInfo.Values['productversion']; - end; - except - end; - finally - Free; - end; - if Assigned(Application) then - begin - FDefaultAppFlags := Application.Flags; - Application.Flags := Application.Flags + [AppNoExceptionMessages]; - Application.OnException := @SimpleExceptionHandler; - ExceptProc := @CatchUnhandledExcept; - end; -end; - -destructor TSimpleException.Destroy; -begin - if Assigned(Application) then - begin - Application.OnException := nil; - Application.Flags := FDefaultAppFlags; - end; - IgnoredExceptionList.Free; - FAppVerInfo.Free; - DoneCriticalsection(FSimpleCriticalSection); - inherited Destroy; -end; - -finalization - DoneSimpleExceptionHandler; - -end. diff --git a/baseunits/SimpleException/USimpleExceptionForm.lfm b/baseunits/SimpleException/USimpleExceptionForm.lfm deleted file mode 100644 index 569da4fbc..000000000 --- a/baseunits/SimpleException/USimpleExceptionForm.lfm +++ /dev/null @@ -1,506 +0,0 @@ -object SimpleExceptionForm: TSimpleExceptionForm - Left = 410 - Height = 226 - Top = 270 - Width = 483 - HorzScrollBar.Page = 445 - HorzScrollBar.Range = 445 - VertScrollBar.Page = 121 - VertScrollBar.Range = 121 - BorderIcons = [biSystemMenu] - Caption = 'SimpleExceptionForm' - ClientHeight = 226 - ClientWidth = 483 - FormStyle = fsSystemStayOnTop - OnClose = FormClose - OnCreate = FormCreate - OnShow = FormShow - Position = poDesktopCenter - LCLVersion = '1.5' - object PanelTop: TPanel - Left = 0 - Height = 60 - Top = 0 - Width = 483 - Align = alTop - AutoSize = True - BevelOuter = bvNone - ClientHeight = 60 - ClientWidth = 483 - Color = clWindow - ParentColor = False - TabOrder = 0 - object PanelExceptionIcon: TPanel - Left = 0 - Height = 60 - Top = 0 - Width = 60 - Align = alLeft - BevelOuter = bvNone - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ClientHeight = 60 - ClientWidth = 60 - TabOrder = 0 - object IconException: TImage - Left = 6 - Height = 48 - Top = 6 - Width = 48 - AntialiasingMode = amOn - Align = alTop - Center = True - Picture.Data = { - 1754506F727461626C654E6574776F726B47726170686963BA24000089504E47 - 0D0A1A0A0000000D49484452000000300000003008060000005702F987000000 - 097048597300000B1300000B1301009A9C18000000206348524D00007A250000 - 80830000F9FF000080E9000075300000EA6000003A980000176F925FC5460000 - 2440494441547801003024CFDB01FFFFFF000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000400000000ED6C4E00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000100000003E0000003E00 - 00002E0000001E000000160000000B00000000000000F5000000EA000000E200 - 0000D2000000C3000000C1000000F00000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000001394B2000400000000FFFF00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000007000000540000005C000000450000000300000000 - 0000000000000000000000000000000000000000000000060000001100000027 - 0000004500000073000000FD000000BC000000A3000000AC000000F900000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000200000000FF00FF00FF00FF00FF00FF - 00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF - 00FF00FF09FF00FF72FF00FFDDFF00FFA4FF00FF48FF00FF03FF00FF00FF00FF - 00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF - 00FF00FF00FF00FF00FF00FF03FF00FF47FF00FFA4FF00FFDEFF00FF72FF00FF - 09FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF00FF - 00FF00FF00FF00FF00FF00FF00000000000400000000FFFF0000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 004900000093000000230000000000000000000000000000000003121500051A - 1F00030F1200020A0B00010709000103040000000000FFFDFC00FFF9F700FEF6 - F500FDF1EE00FBE6E100FDEEEB0000000000000000000000001A0000008D0000 - 006A0000006D000000B700000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000400000000FFFFFF000000000000 - 0000000000000000000000000000000000000000000000000000080000008E00 - 000069000000000000000000000000020A0D0007262C00061D23000104050000 - 0000000000000000000000000000000000000000000000010406000104060002 - 0B0F0004151A0007242C00FFFDFC00FAE2DC00F9DBD400FEF5F3000000000000 - 000023000000B60000009700000072000000F800000000000000000000000000 - 000000000000000000000000000000000000000400000000FFFFFF0000000000 - 000000000000000000000000000000000000000000000017000000B400000034 - 0000000000000000020809000A303900051A1E000000000000000000FFF6F300 - FEF1EE00FFF2EF00FFFAF80000FCFB0000FDFD00000000000003030000040500 - 01060800010E1100020F1200010A0B000721260007212600FBE6E200F6D0C700 - FEF8F7000000000000000069000000370000004A000000E90000000000000000 - 00000000000000000000000000000000000000000400000000FEFFFF00000000 - 000000000000000000000000000000000000000022000000B900000024000000 - 0000000000072228000A2B330001050600FFFF0000FEEBE700FDE6E000FFF5F3 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000ECE80000000000010B0D00031A20000215190004191E000D1418 - 00F6D5CD00F9DED8000000000000000032000000C400000046000000DF000000 - 0000000000000000000000000000000000000000000400000000FFFF00000000 - 00000000000000000000000000000000001C000000BD00000020000000000000 - 00000C343C00071F240000000000FEEEEA00FCDED800FFF9F700000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000FFF4F200FEDAD20001E1DB00042228000212 - 15000B30380004111500F4CCC3000000000000000024000000BE0000003D0000 - 00E400000000000000000000000000000000000000000400000000FEFFFF0000 - 00000000000000000000000000000A000000B20000002000000000000000000E - 394300061A1E00FFFF0000FCDAD200FDEBE70000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000FFF8F600FAD6CE0003 - 15190004252C00061E23000C040500F2C7BD000000000000000020000000B200 - 00003C000000F6000000000000000000000000000000000400000000FFFFFF00 - 000000000000000000000000000000900000003100000000000000000F3A4400 - 06191D00FFFBFA00FBD9D200FEEFEC0000000000000000000000000000000000 - 000000000000000011859E000000000000000000000000000000000000000000 - 0000000000000000EF7B62000000000000000000000000000000000000000000 - FCE9E600FEFAFA0005272E0006191D000E394300F1C6BC000000000000000031 - 0000009100000065000000000000000000000000000000000200000000FEFFFF - 00FEFFFF00FEFFFF00FEFFFF4AFEFFFF65FEFFFF00FEFFFF000C343D0005181C - 00FEFAF800FAD6CE00FDEEEA00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE - 00FFFFFE00FFFFFE000000000000000000000000000000000000000000000000 - 000000000000000000FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE - 00FFFFFE00FDEEEA00FAD6CE00FEFAF80005181C000C343D00FEFFFF00FEFFFF - 00FEFFFF64FEFFFF4AFEFFFF00FEFFFF00FEFFFF00000000000200000000FFFF - FF00FFFFFF00FFFFFF08FFFFFF92FFFFFF00FFFFFF0009232900081E2300FFFE - FE00FAD8D100FDF0ED00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0000000000000000000000000000000000000000000000 - 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FDF0ED00FAD8D100FFFEFE00081E230009242A00FFFF - FF00FFFFFF00FFFFFF93FFFFFF08FFFFFF00FFFFFF00000000000200000000FE - FFFF00FEFFFF00FEFFFF69FEFFFF23FEFFFF00000709000A2A3100FFFFFF00FA - D9D100FDEEEB00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FF - FEFE00FFFEFE00FFFEFE00000000000000000000000000000000000000000000 - 0000000000000000000000FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FF - FEFE00FFFEFE00FFFEFE00FFFEFE00FDEEEB00FAD9D100FFFFFF000A29300000 - 080900FEFFFF00FEFFFF22FEFFFF69FEFFFF00FEFFFF00000000000200000000 - FEFEFF00FEFEFF07FEFEFF74FEFEFF00FEFEFF000D30370001040500FDECE800 - FCE8E500FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00 - FFFEFF00FFFEFF00FFFEFF000000000000000000000000000000000000000000 - 000000000000000000000000FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00 - FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FCE8E500FDECE80001040500 - 0D2F3700FEFEFF00FEFEFF00FEFEFF75FEFEFF08FEFEFF000000000002000000 - 00FEFFFF00FEFFFF54FEFFFF1AFEFFFF00010A0C00071A1F00FFFFFF00F8DBD4 - 00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE - 00FEFFFE00FEFFFE00FEFFFE0000000000000000000000000000000000000000 - 00000000000000000000000000FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE - 00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00F8DBD400FFFFFF - 00071A1F00020B0C00FEFFFF00FEFFFF19FEFFFF53FEFFFF0000000000020000 - 0000FFFFFF00FFFFFF5DFFFFFF00FFFFFF000C262C0000FFFF00FCE8E400FEF6 - F600FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFE - FF00FFFEFF00FFFEFF00FFFEFF00000000000000000000000000000000000000 - 0000000000000000000000000000FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFE - FF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FEF6F600FCE8 - E40000FFFF000B252C00FFFFFF00FFFFFF00FFFFFF5DFFFFFF00000000000200 - 000000FEFFFF10FEFFFF44FEFFFF00FEFFFF00091E2300FFFFFF00FAE2DD00FF - FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF - FFFE00FFFFFE00FFFFFE00FFFFFE00FFFCFB0000000000000000000000000000 - 0000000000000000000000FFFBFA00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF - FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FA - E2DD00FFFFFF00091E2300FEFFFF00FEFFFF00FEFFFF44FEFFFF100000000002 - 00000000FEFEFF3FFEFEFF03FEFEFF000511150001030300FEF5F200FDF2EF00 - FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 - FFFEFE00FFFEFE00FFFEFE00FFFEFE00FEF1EE00000000000000000000000000 - 000000000000000000000000FEF2EF00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 - FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00 - FDF2EF00FEF5F2000103030005111500FEFEFF00FEFEFF03FEFEFF3F00000000 - 0200000000FEFFFF3CFEFFFF00FEFFFF00081B1F00FFFF0000FBEDEC00FEFEFF - 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF - 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FDF2F0000000000000000000000000 - 00000000000000000000000000FDF2F000FEFEFF00FEFEFF00FEFEFF00FEFEFF - 00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF00FEFEFF - 00FEFEFF00FBEDEC00FFFF0000081B1F00FEFFFF00FEFFFF00FEFFFF3D000000 - 000400000000FEFFFF290000000000000000040D0E00FF00FE00FDF1ED00FFFF - FE00000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000FDF1EE0000000000000000000000 - 0000000000000000000000000000FDF1EE00FFFFFE0000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000FDF1ED00FF1C1F00040E0F00FEFFFF0000000000000000290000 - 00000400000000FEFEFF250000000000000000040C0D0000FFFF00FDF5F300FF - FEFE000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000FCF1EF00000000000000000000 - 000000000000000000000000000000FCF0EE00FFFEFE00000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000FDF5F30000FFFF00040B0C00FEFEFF00000000000000002400 - 0000000400000000FEFFFF18000000000000000002070900FFFFFF00FEF7F700 - FFFEFE0000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000FDF1EF000000000000000000 - 00000000000000000000000000000000FDF2F000FFFEFE000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000FEF9F900FFFFFF0002060700FEFFFF000000000000000014 - 000000000400000000FEFFFE0E000000000000000001030500FFFE0000FDFBFB - 00FFFEFF00000000000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000FCEFED0000000000000000 - 0000000000000000000000000000000000FCEFED00FEFEFF0000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000FFFBFB00FFFE000000020500FEFFFE0000000000000000 - 0C000000000400000000FEFEFF000000000000000000FF00FF0000000000FFFF - FE00FFFFFE000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000FCF0ED00000000000000 - 000000000000000000000000000000000000FCF1EE00FFFFFE00000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000FFFE00FF00FF00FF00FF00FEFEFF00000000000000 - 0000000000000400000000FFFFFFF20000000E00000000FEFAFA000205050000 - 020200FFFEFE0000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000FCF1EF000000000000 - 00000000000000000000000000000000000000FCF0EE00FFFEFE000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000101020000FFFF00FEFBFA00FFFFFF000000000000 - 0000F4000000000400000000FEFFFFE80000000E00000000FBF7F50006040F00 - 00050700FEF5F500000000000000000000000000000000000000000000000000 - 000000000000000000000000000000000000000000000000FAEEEB0000000000 - 0000000000000000000000000000000000000000FAEEEB00FEFEFF0000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000002040500FFFFFF00FCF8F700FEFFFF0000000000 - 000000EC000000000400000000FEFEFFDB0000002600000000F9F2F100050C0E - 0001080A00FFFEEC000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000FCF1EF0000FEFE - 000002020000000000000000000000000000FEFE00FCF1EF0000FEFE00000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000001080A00FFFFFF00F9F2F100FEFEFF00000000 - 00000000DC000000000200000000FEFFFFD8FEFFFF00FEFFFF00F9F0EF0000FF - FF00030E1100FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE - FE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFCFC00FCF3 - F00000000000000000000000000000000000FCF3F100FFFCFC00FFFEFE00FFFE - FE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE - FE00FFFEFE00FFFEFE00FFFEFE00030E110000FFFF00F9F0EF00FEFFFF00FEFF - FF00FEFFFFD7000000000200000000FEFFFFC3FEFFFF00FEFFFF00F1E2DE00FF - FFFF0004131500FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF - FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FC - EFED0000000000000000000000000000000000FCEFEC00FFFFFE00FFFFFE00FF - FFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FFFFFE00FF - FFFE00FFFFFE00FFFFFE00FFFFFE0004131500FFFFFF00F1E2DE00FEFFFF00FE - FFFF00FEFFFFC3000000000400000000FEFFFFC1000000FD00000003F4EBE900 - FDFBFB00020B0D00020C0F00FCF2F00000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - E79C8D00020A0C00000000000000000000000000FEF6F400FEFEFF0000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 000000000000000000000000040E1000020B0D00FDFBFB00F4EBE90000000000 - 000000FD000000C2000000000400000000FEFEFFF0000000BC00000047000000 - 00EFDEDA001225290007212600FBCFC800000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00F6DCD700000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000007212600FFFFFF00EFDEDB00FEFEFF00000000 - 00000000BD000000EF000000000400000000FEFFFF00000000A3000000470000 - 0000E9D5D20012242800071A1E00F5D7D100FEF7F50000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000134A56000205050000000000000000000000000000000000EDBAB000FEF7 - F500000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000002090B00071A1E0000FFFF00E9D5D100FEFFFF000000 - 0000000000A300000000000000000400000000FFFFFF00000000AD0000008B00 - 000019F9F3F100F0E2DF000F1D20000B2B3100F2CAC300000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000016556100030A0C0000000000000000000000000000000000EFC3BB00FD - F5F4000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000B2B3100FFFFFF00F1E3E000F9F3F1000000000000 - 0000E7000000AC00000000000000000200000000FEFFFF00FEFFFFF8FEFFFF8B - FEFFFF00FEFFFF00E3CAC500FCFAF90005171A0005191C00FEFFFE00FEFFFE00 - FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00 - FEFFFE00000000000000000000000000000000000000000000000000FFFFFE00 - FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00FEFFFE00 - FEFFFE00FEFFFE0005191C0005171A00FCFBF900E3CAC500FEFFFF00FEFFFF00 - FEFFFF8CFEFFFFF8FEFFFF00000000000200000000FEFEFF00FEFEFF00FEFEFF - 97FEFEFFDEFEFEFF00F9F5F500E7D0CD0000FE00000D30380005121600FFFEFF - 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF - 00FFFEFF00000000000000000000000000000000000000000000000000FFFEFF - 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF - 00FFFEFF00051216000D30380000FE0000E7D0CE00F9F5F500FEFEFF00FEFEFF - DEFEFEFF96FEFEFF00FEFEFF00000000000200000000FEFFFF00FEFFFF00FEFF - FFF8FEFFFF6DFEFFFF00FEFFFF00E8D7D300EDDEDB00000102000D3239000411 - 1400FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE - FE00FFFEFE00000000000000000000000000000000000000000000000000FFFF - FF00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFEFE00FFFE - FE00041114000D32390000010200EDDEDB00E8D6D200FEFFFF00FEFFFF00FEFF - FF6EFEFFFFF8FEFFFF00FEFFFF00000000000200000000FFFFFF00FFFFFF00FF - FFFF00FFFFFFB6FFFFFF9DFFFFFF00FFFFFF00DEC4BE00F1E5E100020708000F - 363E0005161900FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FF - FFFF00FFFFFF00000000000000000000000000000000000000000000000000FF - FFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0005 - 1619000F363E0002070800F1E5E100DEC4BE00FFFFFF00FFFFFF00FFFFFF9FFF - FFFFB5FFFFFF00FFFFFF00FFFFFF000000000001FFFFFF00AF412B0000000000 - 00000000000000000000000A000000C500000030000000000000000025414600 - 101C1F00FFFEFE00F2CFC700F8E3DF0000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000000081D2100 - 0E31390001020200F0E4E100DBBFBA000000000000000000000000D00000003B - 000000F600000000000000000000000051BFD5000200000000FFFFFF00FFFFFF - 00FFFFFF00FFFFFF00FFFFFFF6FFFFFF4DFFFFFFE1FFFFFF00FFFFFF00DABEB9 - 00EBDDDA00000101000E323A000F363F0002080A00FFFEFF00FFFEFF00FFFEFF - 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF - 00FFFEFF00FFFEFF00FFFEFF00FFFEFF00FFFEFF0002080A000F363F000E323A - 0000010100EBDDDA00DABEB900FFFFFF00FFFFFF00FFFFFFE1FFFFFF4DFFFFFF - F6FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000400000000FEFFFF000000 - 0000000000000000000000000000000000E400000042000000BB000000220000 - 0000DDC4BF00F5ECEB001C30340007191C0007191C00F7E3DF00F6DBD600FBF0 - EE00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000051012000A252A00091D210000000000FCFA - F900E4D0CC00E9D8D5000000000000000000000000DE00000045000000E40000 - 0000000000000000000000000000000000000000000001FFFFFF00AB3E280000 - 000000000000000000000000000000000000000000000000000018000000B500 - 000032000000000000000005090A0021373C00111E20000000000000000000FC - F3F100FAEAE800FBEEEB00FDF7F600FEF8F700FEFCFB00000000000204050002 - 08090003090A000512150006161800040D0F000000000000000000EFE2E000DF - C9C400FBF7F6000000000000000000000000CE0000004B000000E80000000000 - 0000000000000000000000000000000000000055C2D80001FFFFFF00A93D2800 - 0000000000000000000000000000000000000000000000000000000000000008 - 0000009100000066000000000000000000000000080D0E001A2B2E0015242600 - 0203040000000000000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000FEFDFC00EBDCDA00E6D5D200F8F3F200 - 0000000000000000000000000000009900000070000000F80000000000000000 - 000000000000000000000000000000000000000057C3D80001FFFFFF00A83C27 - 0000000000000000000000000000000000000000000000000000000000000000 - 00000000000000004A0000009200000023000000000000000000000000000000 - 000D151700131F2100090F1000080D0E00050909000304050000000000FDFCFB - 00FBF7F700F8F3F200F7F1F000EDE1DF00F3EBE9000000000000000000000000 - 0000000000000000DD0000006D000000B7000000000000000000000000000000 - 00000000000000000000000000000000000000000058C4D9000400000000FFFF - FF00000000000000000000000000000000000000000000000000000000000000 - 000000000000000000B6000000BF000000690000007400000019000000000000 - 0000F2EAE800F2EAE80000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 00E70000008C00000097000000F7000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000000000000400000000FF - FFFF000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000F70000008E00000095000000540000005F00 - 0000420000000300000000000000000000000000000000000000000000000000 - 00000000000000000000000000000000000000000000FD000000BE000000A100 - 0000AC000000F900000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000400000000 - FF00000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000F9000000A5000000A5 - 000000110000003F0000003B0000002A00000022000000170000000C00000000 - 000000F4000000E9000000DE000000D6000000C5000000C1000000EF00000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000001FFFFFF - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000010000 - FFFF99B3ED4DB34E9B390000000049454E44AE426082 - } - Proportional = True - Transparent = True - end - end - object PanelMessage: TPanel - Left = 60 - Height = 60 - Top = 0 - Width = 423 - Align = alClient - BevelOuter = bvNone - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ClientHeight = 60 - ClientWidth = 423 - TabOrder = 1 - object LabelExceptionCaption: TLabel - Left = 6 - Height = 21 - Top = 6 - Width = 411 - Align = alTop - Caption = 'LabelExceptionCaption' - Font.Height = -16 - ParentColor = False - ParentFont = False - end - object LabelExceptionMessage: TLabel - Left = 12 - Height = 21 - Top = 33 - Width = 405 - Align = alClient - BorderSpacing.Left = 6 - BorderSpacing.Around = 6 - Caption = 'LabelExceptionMessage' - Font.Height = -13 - ParentColor = False - ParentFont = False - WordWrap = True - end - end - object PanelButton: TPanel - Left = 483 - Height = 60 - Top = 0 - Width = 0 - Align = alRight - AutoSize = True - BevelOuter = bvNone - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - TabOrder = 2 - end - end - object PanelBottom: TPanel - Left = 0 - Height = 37 - Top = 62 - Width = 483 - Align = alTop - BevelOuter = bvNone - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ClientHeight = 37 - ClientWidth = 483 - TabOrder = 1 - object CheckBoxIgnoreException: TCheckBox - Left = 6 - Height = 25 - Top = 6 - Width = 157 - Align = alLeft - BorderSpacing.Left = 4 - Caption = 'CheckBoxIgnoreException' - TabOrder = 1 - end - object ButtonDetails: TBitBtn - Left = 93 - Height = 25 - Top = 6 - Width = 117 - Align = alRight - AutoSize = True - Caption = '&ButtonDetails' - Kind = bkHelp - OnClick = ButtonDetailsClick - TabOrder = 0 - end - object ButtonTerminate: TBitBtn - Left = 210 - Height = 25 - Top = 6 - Width = 136 - Align = alRight - AutoSize = True - Caption = '&ButtonTerminate' - Kind = bkAbort - ModalResult = 3 - OnClick = ButtonTerminateClick - TabOrder = 2 - end - object ButtonContinue: TBitBtn - Left = 346 - Height = 25 - Top = 6 - Width = 131 - Align = alRight - AutoSize = True - Caption = '&ButtonContinue' - Kind = bkYes - ModalResult = 6 - OnClick = ButtonContinueClick - TabOrder = 3 - end - end - object PanelCenter: TPanel - Left = 0 - Height = 127 - Top = 99 - Width = 483 - Align = alClient - BevelOuter = bvNone - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ClientHeight = 127 - ClientWidth = 483 - TabOrder = 2 - object MemoExceptionLog: TMemo - Left = 6 - Height = 115 - Top = 6 - Width = 471 - Align = alClient - Font.Height = -12 - Font.Name = 'Courier New' - Lines.Strings = ( - 'MemoExceptionLog' - ) - ParentFont = False - ReadOnly = True - ScrollBars = ssAutoBoth - TabOrder = 0 - WordWrap = False - end - end - object BevelPannelBottom: TShape - Left = 0 - Height = 2 - Top = 60 - Width = 483 - Align = alTop - Brush.Color = clBtnShadow - Pen.Color = clBtnShadow - Pen.Style = psClear - end -end diff --git a/baseunits/SimpleException/USimpleExceptionForm.pas b/baseunits/SimpleException/USimpleExceptionForm.pas deleted file mode 100644 index 6483dd253..000000000 --- a/baseunits/SimpleException/USimpleExceptionForm.pas +++ /dev/null @@ -1,125 +0,0 @@ -{ SimpleException Dialog - - Copyright (C) 2014 Nur Cholif - - This source is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your option) - any later version. - - This code is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS - FOR A PARTICULAR PURPOSE. See the GNU General Public License for more - details. - - A copy of the GNU General Public License is available on the World Wide Web - at . You can also obtain it by writing - to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, - MA 02111-1307, USA. -} - -unit USimpleExceptionForm; - -{$mode objfpc}{$H+} - -interface - -uses - Forms, Controls, StdCtrls, ExtCtrls, Buttons; - -type - - { TSimpleExceptionForm } - - TSimpleExceptionForm = class(TForm) - ButtonContinue : TBitBtn; - ButtonDetails: TBitBtn; - ButtonTerminate : TBitBtn; - CheckBoxIgnoreException: TCheckBox; - IconException: TImage; - LabelExceptionMessage: TLabel; - LabelExceptionCaption: TLabel; - MemoExceptionLog: TMemo; - PanelButton : TPanel; - PanelCenter: TPanel; - PanelMessage: TPanel; - PanelExceptionIcon: TPanel; - PanelBottom: TPanel; - PanelTop: TPanel; - BevelPannelBottom: TShape; - procedure ButtonContinueClick(Sender: TObject); - procedure ButtonDetailsClick(Sender: TObject); - procedure ButtonTerminateClick(Sender: TObject); - procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); - private - { private declarations } - public - { public declarations } - end; - -implementation - -uses USimpleException; - -{$R *.lfm} - -{ TSimpleExceptionForm } - -procedure TSimpleExceptionForm.ButtonDetailsClick(Sender: TObject); -begin - if ClientHeight <= PanelCenter.Top + PanelCenter.ChildSizing.TopBottomSpacing then - ClientHeight := PanelTop.Height + PanelBottom.Height + 200 - else - ClientHeight := PanelTop.Height + PanelBottom.Height; -end; - -procedure TSimpleExceptionForm.ButtonTerminateClick(Sender: TObject); -begin - //Application.Terminate; - halt(1); -end; - -procedure TSimpleExceptionForm.FormCreate(Sender: TObject); -begin - Icon.Assign(Application.Icon); -end; - -procedure TSimpleExceptionForm.FormShow(Sender: TObject); -begin - Caption := SExceptionDialogTitle; - if IconException.Picture.Graphic <> nil then - PanelExceptionIcon.Show - else - PanelExceptionIcon.Hide; - LabelExceptionCaption.Caption := SExceptionCaption; - ButtonDetails.Caption := TCaption(SButtonDetails); - ButtonTerminate.Caption := TCaption(SButtonTerminate); - ButtonContinue.Caption := TCaption(SButtonContinue); - CheckBoxIgnoreException.Caption := SCheckBoxIgnoreException; - CheckBoxIgnoreException.Checked := False; - ClientHeight := PanelTop.Height + PanelBottom.Height; - ClientWidth := CheckBoxIgnoreException.Width + ButtonDetails.Width + - ButtonTerminate.Width + ButtonContinue.Width + - (PanelBottom.ChildSizing.LeftRightSpacing * 3); - Position := poDesktopCenter; - Position := poMainFormCenter; -end; - -procedure TSimpleExceptionForm.ButtonContinueClick(Sender: TObject); -begin - Close; -end; - -procedure TSimpleExceptionForm.FormClose(Sender: TObject; - var CloseAction: TCloseAction); -begin - if CheckBoxIgnoreException.Checked then - ModalResult := mrIgnore - else - ModalResult := mrClose; -end; - -end. - diff --git a/baseunits/SimpleException/USimpleLogger.pas b/baseunits/SimpleException/USimpleLogger.pas deleted file mode 100644 index 9d00ec68d..000000000 --- a/baseunits/SimpleException/USimpleLogger.pas +++ /dev/null @@ -1,261 +0,0 @@ -{ Simple Logger Class, part of SimpleException - - Copyright (C) 2014 Nur Cholif - - This source is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your option) - any later version. - - This code is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS - FOR A PARTICULAR PURPOSE. See the GNU General Public License for more - details. - - A copy of the GNU General Public License is available on the World Wide Web - at . You can also obtain it by writing - to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, - MA 02111-1307, USA. -} - -unit USimpleLogger; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, DbgInfoReader, FileUtil; - -type - TLogType = (ERROR, WARNING, INFO, DEBUG, VERBOSE); - -var - _CS_LOG: TRTLCriticalSection; - _LOG_ACTIVE: Boolean = False; - _LOG_LEVEL: Integer = 2; - _FLOGFILE: String; - _HAS_DEBUG_LINE: Boolean; - -const - _LOG_SYMBOL = 'EWIDV'; - - procedure SetLogFile(const LogFileName: String); - procedure WriteLog_E(const msg: String); - procedure Writelog_W(const msg: String); - procedure Writelog_I(const msg: String); - procedure Writelog_D(const msg: String); - procedure Writelog_V(const msg: String); - function SimpleBackTraceStr(const Addr: Pointer): String; - function GetStackTraceInfo(const MaxStackCount: Integer = 20): string; - -implementation - -procedure ForceLogFile(const logfilename: string); -var - f: String; -begin - f := ExtractFileDir(logfilename); - if f <> '' then - begin - if _LOG_ACTIVE and (not DirectoryExists(f)) then - ForceDirectories(f); - f := f + PathDelim + ExtractFileName(logfilename); - end - else - f := logfilename; - _FLOGFILE := f; -end; - -procedure WriteLog(const msg: String; LogType: TLogType = DEBUG); -var - s: String; - f: TextFile; -begin - if not _LOG_ACTIVE then Exit; - if _FLOGFILE = '' then Exit; - if Integer(logType) > _LOG_LEVEL then Exit; - EnterCriticalsection(_CS_LOG); - try - s := FormatDateTime('dd/mm/yyyy|hh:nn:ss.zzz ', Now); - s := s + '[' + _LOG_SYMBOL[Integer(logType)+1] + ']'; - AssignFile(f, _FLOGFILE); - try - if FileExists(_FLOGFILE) then - Append(f) - else - begin - ForceLogFile(_FLOGFILE); - Rewrite(f); - end; - WriteLn(f, s + ' ' + msg); - finally - CloseFile(f); - end; - finally - LeaveCriticalsection(_CS_LOG); - end; -end; - -procedure SetLogFile(const LogFileName: String); -begin - if Trim(LogFileName) <> '' then - begin - EnterCriticalsection(_CS_LOG); - try - ForceLogFile(LogFileName); - finally - LeaveCriticalsection(_CS_LOG); - end; - end; -end; - -procedure WriteLog_E(const msg: String); -begin - WriteLog(msg, ERROR); -end; - -procedure Writelog_W(const msg: String); -begin - WriteLog(msg, WARNING); -end; - -procedure Writelog_I(const msg: String); -begin - WriteLog(msg, INFO); -end; - -procedure Writelog_D(const msg: String); -begin - WriteLog(msg, DEBUG); -end; - -procedure Writelog_V(const msg: String); -begin - WriteLog(msg, VERBOSE); -end; - -function SimpleBackTraceStr(const Addr: Pointer): String; -var - func, Source: ShortString; - hs: String[32]; - line: longint; -begin - Result := '$' + hexStr(Addr); - if _HAS_DEBUG_LINE then - begin - try - GetLineInfo(PtrUInt(Addr), func, Source, line); - if func <> '' then - Result := Result + ' ' + func; - if Source <> '' then - begin - if func <> '' then - Result := Result + ','; - if line <> 0 then - begin - str(line, hs); - Result := Result + ' line ' + hs; - end; - Result := Result + ' of ' + Source; - end; - except - Result := Result + ' ??'; - end; - end; -end; - -function GetStackTraceInfo(const MaxStackCount: Integer): string; -var - i, maxStack: Integer; - cf, pcf, cAddress, cFrame: Pointer; -begin - try - if ExceptFrameCount > 0 then - begin - Result := - 'Exception Address : $' + hexStr(ExceptAddr) + LineEnding; - if ExceptFrameCount > MaxStackCount then - maxStack := MaxStackCount - 1 - else - maxStack := ExceptFrameCount - 1; - for i := 0 to maxStack do - Result := Result + ' ' + SimpleBackTraceStr(ExceptFrames[i]) + - LineEnding; - end - else - begin - //cf := get_caller_frame(get_frame); - cf := get_caller_frame(get_caller_frame(get_frame)); - if cf <> nil then - begin - Result := - 'Caller Address : ' + '$' + hexStr(cf) + LineEnding; - try - i := 0; - pcf := cf - 1; - while cf > pcf do - begin - cAddress := get_caller_addr(cf); - cFrame := get_caller_frame(cf); - if cAddress = nil then - Break; - Inc(i); - if i > MaxStackCount then - Break; - Result := Result + ' ' + SimpleBackTraceStr(cAddress) + - LineEnding; - pcf := cf; - cf := cFrame; - end; - finally - end; - end; - end; - except - Result := 'Can''t get stack trace information!'; - end; - Result := TrimRight(Result); -end; - -procedure doInitialization; -var - i: Integer; -begin - InitCriticalSection(_CS_LOG); - _HAS_DEBUG_LINE := OpenSymbolFile(ParamStrUTF8(0)); - {$IFDEF LOGACTIVE} - _LOG_ACTIVE := True; - _LOG_LEVEL := SizeOf(TLogType); - {$ENDIF} - _FLOGFILE := ChangeFileExt(ExtractFileName(ParamStrUTF8(0)), '_LOG.txt'); - for i := 1 to Paramcount do - begin - if UpperCase(ParamStrUTF8(i)) = '-LOGACTIVE' then - begin - _LOG_ACTIVE := True; - if i < Paramcount then - begin - if StrToIntDef(ParamStr(i+1), -1) > -1 then - _LOG_LEVEL := StrToInt(ParamStr(i+1)); - end; - if _LOG_LEVEL > SizeOf(TLogType) then - _LOG_LEVEL := SizeOf(TLogType); - end; - end; -end; - -procedure doFinalization; -begin - CloseSymbolFile; - DoneCriticalsection(_CS_LOG); -end; - -initialization - doInitialization; - -finalization - doFinalization; - -end. - diff --git a/baseunits/SimpleException/dbginforeader.pas b/baseunits/SimpleException/dbginforeader.pas deleted file mode 100644 index 324103cfe..000000000 --- a/baseunits/SimpleException/dbginforeader.pas +++ /dev/null @@ -1,922 +0,0 @@ -{ - This file is a modified copy of the FreePascal units lnfodwrf and lineinfo -} -unit DbgInfoReader; - -{$mode objfpc}{$H-}{$S-} - -interface - -function OpenSymbolFile(AFileName: string): boolean; -procedure CloseSymbolFile; -function GetLineInfo(addr:ptruint; out func,source:string; out line:longint) : boolean; - -implementation - -uses - exeinfo, strings; - -var - { the input file to read DWARF/STABS debug info from, i.e. paramstr(0) } - e : TExeFile; - filename, dbgfn : string; - //baseaddr : pointer; - HasStabs, HasDwarf: Boolean; - -{%region ********************* lnfodwrf ************************************} - -{ Current issues: - - - ignores DW_LNS_SET_FILE -} - -{$MACRO ON} - -//{$DEFINE DEBUG_DWARF_PARSER} -{$ifdef DEBUG_DWARF_PARSER} - {$define DEBUG_WRITELN := WriteLn} - {$define DEBUG_COMMENT := } -{$else} - {$define DEBUG_WRITELN := //} - {$define DEBUG_COMMENT := //} -{$endif} - -{ some type definitions } -type - Bool8 = ByteBool; - -const - EBUF_SIZE = 100; - -//{$WARNING This code is not thread-safe, and needs improvement} -var - EBuf: Array [0..EBUF_SIZE-1] of Byte; - EBufCnt, EBufPos: Integer; - { the offset and size of the DWARF debug_line section in the file } - DwarfOffset : longint; - DwarfSize : longint; - -{ DWARF 2 default opcodes} -const - { Extended opcodes } - DW_LNE_END_SEQUENCE = 1; - DW_LNE_SET_ADDRESS = 2; - DW_LNE_DEFINE_FILE = 3; - { Standard opcodes } - DW_LNS_COPY = 1; - DW_LNS_ADVANCE_PC = 2; - DW_LNS_ADVANCE_LINE = 3; - DW_LNS_SET_FILE = 4; - DW_LNS_SET_COLUMN = 5; - DW_LNS_NEGATE_STMT = 6; - DW_LNS_SET_BASIC_BLOCK = 7; - DW_LNS_CONST_ADD_PC = 8; - DW_LNS_FIXED_ADVANCE_PC = 9; - DW_LNS_SET_PROLOGUE_END = 10; - DW_LNS_SET_EPILOGUE_BEGIN = 11; - DW_LNS_SET_ISA = 12; - -type - { state record for the line info state machine } - TMachineState = record - address : QWord; - file_id : DWord; - line : QWord; - column : DWord; - is_stmt : Boolean; - basic_block : Boolean; - end_sequence : Boolean; - prolouge_end : Boolean; - epilouge_begin : Boolean; - isa : DWord; - append_row : Boolean; - end; - -{ DWARF line number program header preceding the line number program, 64 bit version } - TLineNumberProgramHeader64 = packed record - magic : DWord; - unit_length : QWord; - version : Word; - length : QWord; - minimum_instruction_length : Byte; - default_is_stmt : Bool8; - line_base : ShortInt; - line_range : Byte; - opcode_base : Byte; - end; - -{ DWARF line number program header preceding the line number program, 32 bit version } - TLineNumberProgramHeader32 = packed record - unit_length : DWord; - version : Word; - length : DWord; - minimum_instruction_length : Byte; - default_is_stmt : Bool8; - line_base : ShortInt; - line_range : Byte; - opcode_base : Byte; - end; - -{--------------------------------------------------------------------------- - I/O utility functions ----------------------------------------------------------------------------} - -var - base, limit : SizeInt; - index : SizeInt; - -function Init(aBase, aLimit : Int64) : Boolean; -begin - base := aBase; - limit := aLimit; - Init := (aBase + limit) <= e.size; - seek(e.f, base); - EBufCnt := 0; - EBufPos := 0; - index := 0; -end; - -function Init(aBase : Int64) : Boolean; -begin - Init := Init(aBase, limit - (aBase - base)); -end; - - -function Pos() : Int64; -begin - Pos := index; -end; - - -procedure Seek(const newIndex : Int64); -begin - index := newIndex; - system.seek(e.f, base + index); - EBufCnt := 0; - EBufPos := 0; -end; - - -{ Returns the next Byte from the input stream, or -1 if there has been - an error } -function ReadNext() : Longint; inline; -var - bytesread : SizeInt; -begin - ReadNext := -1; - if EBufPos >= EBufCnt then begin - EBufPos := 0; - EBufCnt := EBUF_SIZE; - if EBufCnt > limit - index then - EBufCnt := limit - index; - blockread(e.f, EBuf, EBufCnt, bytesread{%H-}); - EBufCnt := bytesread; - end; - if EBufPos < EBufCnt then begin - ReadNext := EBuf[EBufPos]; - inc(EBufPos); - inc(index); - end - else - ReadNext := -1; -end; - -{ Reads the next size bytes into dest. Returns true if successful, - false otherwise. Note that dest may be partially overwritten after - returning false. } -function ReadNext(var dest; size : SizeInt) : Boolean; //inline; -var - bytesread, totalread : SizeInt; - r: Boolean; - d: PByte; -begin - d := @dest; - totalread := 0; - r := True; - while (totalread < size) and r do begin; - if EBufPos >= EBufCnt then begin - EBufPos := 0; - EBufCnt := EBUF_SIZE; - if EBufCnt > limit - index then - EBufCnt := limit - index; - blockread(e.f, EBuf, EBufCnt, bytesread{%H-}); - EBufCnt := bytesread; - if bytesread <= 0 then - r := False; - end; - if EBufPos < EBufCnt then begin - bytesread := EBufCnt - EBufPos; - if bytesread > size - totalread then bytesread := size - totalread; - System.Move(EBuf[EBufPos], d[totalread], bytesread); - inc(EBufPos, bytesread); - inc(index, bytesread); - inc(totalread, bytesread); - end; - end; - ReadNext := r; -end; - - -{ Reads an unsigned LEB encoded number from the input stream } -function ReadULEB128() : QWord; -var - shift : Byte; - data : PtrInt; - val : QWord; -begin - shift := 0; - ReadULEB128 := 0; - data := ReadNext(); - while (data <> -1) do begin - val := data and $7f; - ReadULEB128 := ReadULEB128 or (val shl shift); - inc(shift, 7); - if ((data and $80) = 0) then - break; - data := ReadNext(); - end; -end; - -{ Reads a signed LEB encoded number from the input stream } -function ReadLEB128() : Int64; -var - shift : Byte; - data : PtrInt; - val : Int64; -begin - shift := 0; - ReadLEB128 := 0; - data := ReadNext(); - while (data <> -1) do begin - val := data and $7f; - ReadLEB128 := ReadLEB128 or (val shl shift); - inc(shift, 7); - if ((data and $80) = 0) then - break; - data := ReadNext(); - end; - { extend sign. Note that we can not use shl/shr since the latter does not - translate to arithmetic shifting for signed types } - ReadLEB128 := (not ((ReadLEB128 and (1 shl (shift-1)))-1)) or ReadLEB128; -end; - - -{ Reads an address from the current input stream } -function ReadAddress() : PtrUInt; -begin - ReadNext(ReadAddress{%H-}, sizeof(ReadAddress)); -end; - - -{ Reads a zero-terminated string from the current input stream. If the - string is larger than 255 chars (maximum allowed number of elements in - a ShortString, excess characters will be chopped off. } -function ReadString() : ShortString; -var - temp : PtrInt; - i : PtrUInt; -begin - i := 1; - temp := ReadNext(); - while (temp > 0) do begin - ReadString[i] := char(temp); - if (i = 255) then begin - { skip remaining characters } - repeat - temp := ReadNext(); - until (temp <= 0); - break; - end; - inc(i); - temp := ReadNext(); - end; - { unexpected end of file occurred? } - if (temp = -1) then - ReadString := '' - else - Byte(ReadString[0]) := i-1; -end; - - -{ Reads an unsigned Half from the current input stream } -function ReadUHalf() : Word; -begin - ReadNext(ReadUHalf{%H-}, sizeof(ReadUHalf)); -end; - - -{--------------------------------------------------------------------------- - - Generic Dwarf lineinfo reader - - The line info reader is based on the information contained in - - DWARF Debugging Information Format Version 3 - Chapter 6.2 "Line Number Information" - - from the - - DWARF Debugging Information Format Workgroup. - - For more information on this document see also - - http://dwarf.freestandards.org/ - ----------------------------------------------------------------------------} - -{ initializes the line info state to the default values } -procedure InitStateRegisters(var state : TMachineState; const aIs_Stmt : Bool8); -begin - with state do begin - address := 0; - file_id := 1; - line := 1; - column := 0; - is_stmt := aIs_Stmt; - basic_block := false; - end_sequence := false; - prolouge_end := false; - epilouge_begin := false; - isa := 0; - append_row := false; - end; -end; - - -{ Skips all line info directory entries } -procedure SkipDirectories(); -var s : ShortString; -begin - while (true) do begin - s := ReadString(); - if (s = '') then break; - DEBUG_WRITELN('Skipping directory : ', s); - end; -end; - -{ Skips an LEB128 } -procedure SkipLEB128(); -{$ifdef DEBUG_DWARF_PARSER} -var temp : QWord; -{$endif} -begin - {$ifdef DEBUG_DWARF_PARSER}temp := {$endif}ReadLEB128(); - DEBUG_WRITELN('Skipping LEB128 : ', temp); -end; - -{ Skips the filename section from the current file stream } -procedure SkipFilenames(); -var s : ShortString; -begin - while (true) do begin - s := ReadString(); - if (s = '') then break; - DEBUG_WRITELN('Skipping filename : ', s); - SkipLEB128(); { skip the directory index for the file } - SkipLEB128(); { skip last modification time for file } - SkipLEB128(); { skip length of file } - end; -end; - -function CalculateAddressIncrement(opcode : Byte; const header : TLineNumberProgramHeader64) : Int64; -begin - CalculateAddressIncrement := (Int64(opcode) - header.opcode_base) div header.line_range * header.minimum_instruction_length; -end; - -function GetFullFilename(const filenameStart, directoryStart : Int64; const file_id : DWord) : ShortString; -var - i : DWord; - filename, directory : ShortString; - dirindex : Int64; -begin - filename := ''; - directory := ''; - i := 1; - Seek(filenameStart); - while (i <= file_id) do begin - filename := ReadString(); - DEBUG_WRITELN('Found "', filename, '"'); - if (filename = '') then break; - dirindex := ReadLEB128(); { read the directory index for the file } - SkipLEB128(); { skip last modification time for file } - SkipLEB128(); { skip length of file } - inc(i); - end; - { if we could not find the file index, exit } - if (filename = '') then begin - GetFullFilename := '(Unknown file)'; - exit; - end; - - Seek(directoryStart); - i := 1; - while (i <= dirindex) do begin - directory := ReadString(); - if (directory = '') then break; - inc(i); - end; - if (directory<>'') and (directory[length(directory)]<>'/') then - directory:=directory+'/'; - GetFullFilename := directory + filename; -end; - - -function ParseCompilationUnit(const addr : PtrUInt; const file_offset : QWord; - var source : String; var line : longint; var found : Boolean) : QWord; -var - state : TMachineState; - { we need both headers on the stack, although we only use the 64 bit one internally } - header64 : TLineNumberProgramHeader64; - header32 : TLineNumberProgramHeader32; - - adjusted_opcode : Int64; - - opcode : PtrInt; - extended_opcode : Byte; - extended_opcode_length : PtrInt; - i, addrIncrement, lineIncrement : PtrInt; - - {$ifdef DEBUG_DWARF_PARSER} - s : ShortString; - {$endif} - - numoptable : array[1..255] of Byte; - { the offset into the file where the include directories are stored for this compilation unit } - include_directories : QWord; - { the offset into the file where the file names are stored for this compilation unit } - file_names : Int64; - - temp_length : DWord; - unit_length : QWord; - header_length : SizeInt; - - first_row : Boolean; - - prev_line : QWord; - prev_file : DWord; - -begin - prev_line := 0; - prev_file := 0; - first_row := true; - - found := false; - - ReadNext(temp_length{%H-}, sizeof(temp_length)); - if (temp_length <> $ffffffff) then begin - unit_length := temp_length + sizeof(temp_length) - end else begin - ReadNext(unit_length, sizeof(unit_length)); - inc(unit_length, 12); - end; - - ParseCompilationUnit := file_offset + unit_length; - - Init(file_offset, unit_length); - - DEBUG_WRITELN('Unit length: ', unit_length); - if (temp_length <> $ffffffff) then begin - DEBUG_WRITELN('32 bit DWARF detected'); - ReadNext(header32{%H-}, sizeof(header32)); - header64.magic := $ffffffff; - header64.unit_length := header32.unit_length; - header64.version := header32.version; - header64.length := header32.length; - header64.minimum_instruction_length := header32.minimum_instruction_length; - header64.default_is_stmt := header32.default_is_stmt; - header64.line_base := header32.line_base; - header64.line_range := header32.line_range; - header64.opcode_base := header32.opcode_base; - header_length := - sizeof(header32.length) + sizeof(header32.version) + - sizeof(header32.unit_length); - end else begin - DEBUG_WRITELN('64 bit DWARF detected'); - ReadNext(header64, sizeof(header64)); - header_length := - sizeof(header64.magic) + sizeof(header64.version) + - sizeof(header64.length) + sizeof(header64.unit_length); - end; - - inc(header_length, header64.length); - - fillchar(numoptable{%H-}, sizeof(numoptable), #0); - ReadNext(numoptable, header64.opcode_base-1); - DEBUG_WRITELN('Opcode parameter count table'); - for i := 1 to header64.opcode_base-1 do begin - DEBUG_WRITELN('Opcode[', i, '] - ', numoptable[i], ' parameters'); - end; - - DEBUG_WRITELN('Reading directories...'); - include_directories := Pos(); - SkipDirectories(); - DEBUG_WRITELN('Reading filenames...'); - file_names := Pos(); - SkipFilenames(); - - Seek(header_length); - - with header64 do begin - InitStateRegisters(state{%H-}, default_is_stmt); - end; - opcode := ReadNext(); - while (opcode <> -1) and (not found) do begin - DEBUG_WRITELN('Next opcode: '); - case (opcode) of - { extended opcode } - 0 : begin - extended_opcode_length := ReadULEB128(); - extended_opcode := ReadNext(); - case (extended_opcode) of - DW_LNE_END_SEQUENCE : begin - state.end_sequence := true; - state.append_row := true; - DEBUG_WRITELN('DW_LNE_END_SEQUENCE'); - end; - DW_LNE_SET_ADDRESS : begin - state.address := ReadAddress(); - DEBUG_WRITELN('DW_LNE_SET_ADDRESS (', hexstr(state.address, sizeof(state.address)*2), ')'); - end; - DW_LNE_DEFINE_FILE : begin - {$ifdef DEBUG_DWARF_PARSER}s := {$endif}ReadString(); - SkipLEB128(); - SkipLEB128(); - SkipLEB128(); - DEBUG_WRITELN('DW_LNE_DEFINE_FILE (', s, ')'); - end; - else begin - DEBUG_WRITELN('Unknown extended opcode (opcode ', extended_opcode, ' length ', extended_opcode_length, ')'); - for i := 0 to extended_opcode_length-2 do - ReadNext(); - end; - end; - end; - DW_LNS_COPY : begin - state.basic_block := false; - state.prolouge_end := false; - state.epilouge_begin := false; - state.append_row := true; - DEBUG_WRITELN('DW_LNS_COPY'); - end; - DW_LNS_ADVANCE_PC : begin - inc(state.address, ReadULEB128() * header64.minimum_instruction_length); - DEBUG_WRITELN('DW_LNS_ADVANCE_PC (', hexstr(state.address, sizeof(state.address)*2), ')'); - end; - DW_LNS_ADVANCE_LINE : begin - // inc(state.line, ReadLEB128()); negative values are allowed - // but those may generate a range check error - state.line := state.line + ReadLEB128(); - DEBUG_WRITELN('DW_LNS_ADVANCE_LINE (', state.line, ')'); - end; - DW_LNS_SET_FILE : begin - state.file_id := ReadULEB128(); - DEBUG_WRITELN('DW_LNS_SET_FILE (', state.file_id, ')'); - end; - DW_LNS_SET_COLUMN : begin - state.column := ReadULEB128(); - DEBUG_WRITELN('DW_LNS_SET_COLUMN (', state.column, ')'); - end; - DW_LNS_NEGATE_STMT : begin - state.is_stmt := not state.is_stmt; - DEBUG_WRITELN('DW_LNS_NEGATE_STMT (', state.is_stmt, ')'); - end; - DW_LNS_SET_BASIC_BLOCK : begin - state.basic_block := true; - DEBUG_WRITELN('DW_LNS_SET_BASIC_BLOCK'); - end; - DW_LNS_CONST_ADD_PC : begin - inc(state.address, CalculateAddressIncrement(255, header64)); - DEBUG_WRITELN('DW_LNS_CONST_ADD_PC (', hexstr(state.address, sizeof(state.address)*2), ')'); - end; - DW_LNS_FIXED_ADVANCE_PC : begin - inc(state.address, ReadUHalf()); - DEBUG_WRITELN('DW_LNS_FIXED_ADVANCE_PC (', hexstr(state.address, sizeof(state.address)*2), ')'); - end; - DW_LNS_SET_PROLOGUE_END : begin - state.prolouge_end := true; - DEBUG_WRITELN('DW_LNS_SET_PROLOGUE_END'); - end; - DW_LNS_SET_EPILOGUE_BEGIN : begin - state.epilouge_begin := true; - DEBUG_WRITELN('DW_LNS_SET_EPILOGUE_BEGIN'); - end; - DW_LNS_SET_ISA : begin - state.isa := ReadULEB128(); - DEBUG_WRITELN('DW_LNS_SET_ISA (', state.isa, ')'); - end; - else begin { special opcode } - if (opcode < header64.opcode_base) then begin - DEBUG_WRITELN('Unknown standard opcode $', hexstr(opcode, 2), '; skipping'); - for i := 1 to numoptable[opcode] do - SkipLEB128(); - end else begin - adjusted_opcode := opcode - header64.opcode_base; - addrIncrement := CalculateAddressIncrement(opcode, header64); - inc(state.address, addrIncrement); - lineIncrement := header64.line_base + (adjusted_opcode mod header64.line_range); - inc(state.line, lineIncrement); - DEBUG_WRITELN('Special opcode $', hexstr(opcode, 2), ' address increment: ', addrIncrement, ' new line: ', lineIncrement); - state.basic_block := false; - state.prolouge_end := false; - state.epilouge_begin := false; - state.append_row := true; - end; - end; - end; - - if (state.append_row) then begin - DEBUG_WRITELN('Current state : address = ', hexstr(state.address, sizeof(state.address) * 2), - DEBUG_COMMENT ' file_id = ', state.file_id, ' line = ', state.line, ' column = ', state.column, - DEBUG_COMMENT ' is_stmt = ', state.is_stmt, ' basic_block = ', state.basic_block, - DEBUG_COMMENT ' end_sequence = ', state.end_sequence, ' prolouge_end = ', state.prolouge_end, - DEBUG_COMMENT ' epilouge_begin = ', state.epilouge_begin, ' isa = ', state.isa); - - if (first_row) then begin - if (state.address > addr) then - break; - first_row := false; - end; - - { when we have found the address we need to return the previous - line because that contains the call instruction } - if (state.address >= addr) then - found:=true - else - begin - { save line information } - prev_file := state.file_id; - prev_line := state.line; - end; - - state.append_row := false; - if (state.end_sequence) then begin - InitStateRegisters(state, header64.default_is_stmt); - first_row := true; - end; - end; - - opcode := ReadNext(); - end; - - if (found) then begin - line := prev_line; - source := GetFullFilename(file_names, include_directories, prev_file); - end; -end; - -function GetLineInfoDwarf(addr : ptruint; var func, source : string; var line : longint) : boolean; -var - current_offset : QWord; - end_offset : QWord; - - found : Boolean; - -begin - func := ''; - source := ''; - found := false; - GetLineInfoDwarf:=false; - if not e.isopen then exit; - - addr := addr - e.processaddress; - - current_offset := DwarfOffset; - end_offset := DwarfOffset + DwarfSize; - - while (current_offset < end_offset) and (not found) do begin - Init(current_offset, end_offset - current_offset); - current_offset := ParseCompilationUnit(addr, current_offset, - source, line, found); - end; - GetLineInfoDwarf:=found; -end; - -{%endregion ********************* lnfodwrf ************************************} - -{%region ********************* lineinfo ************************************} - -const - N_Function = $24; - N_TextLine = $44; - N_DataLine = $46; - N_BssLine = $48; - N_SourceFile = $64; - N_IncludeFile = $84; - - maxstabs = 40; { size of the stabs buffer } - -var - { GDB after 4.18 uses offset to function begin - in text section but OS/2 version still uses 4.16 PM } - StabsFunctionRelative: boolean; - -type - //pstab=^tstab; - tstab=packed record - strpos : longint; - ntype : byte; - nother : byte; - ndesc : word; - nvalue : dword; - end; - -{ We use static variable so almost no stack is required, and is thus - more safe when an error has occured in the program } -//{$WARNING This code is not thread-safe, and needs improvement } -var - stabcnt, { amount of stabs } - stablen, - stabofs, { absolute stab section offset in executable } - stabstrlen, - stabstrofs : longint; { absolute stabstr section offset in executable } - dirlength : longint; { length of the dirctory part of the source file } - stabs : array[0..maxstabs-1] of tstab; { buffer } - funcstab, { stab with current function info } - linestab, { stab with current line info } - dirstab, { stab with current directory info } - filestab : tstab; { stab with current file info } - -function GetLineInfoStabs(addr:ptruint;var func,source:string;var line:longint) : boolean; -var - res, - stabsleft, - stabscnt,i : longint; - found : boolean; - lastfunc : tstab; -begin - GetLineInfoStabs:=false; -{$ifdef DEBUG_LINEINFO} - writeln(stderr,'GetLineInfo called'); -{$endif DEBUG_LINEINFO} - fillchar(func,high(func)+1,0); - fillchar(source,high(source)+1,0); - line:=0; - if not e.isopen then exit; - - { correct the value to the correct address in the file } - { processaddress is set in OpenStabs } - addr := dword(addr - e.processaddress); - -{$ifdef DEBUG_LINEINFO} - writeln(stderr,'Addr: ',hexstr(addr,sizeof(addr)*2)); -{$endif DEBUG_LINEINFO} - - fillchar(funcstab,sizeof(tstab),0); - fillchar(filestab,sizeof(tstab),0); - fillchar(dirstab,sizeof(tstab),0); - fillchar(linestab,sizeof(tstab),0); - fillchar(lastfunc{%H-},sizeof(tstab),0); - found:=false; - system.seek(e.f,stabofs); - stabsleft:=stabcnt; - repeat - if stabsleft>maxstabs then - stabscnt:=maxstabs - else - stabscnt:=stabsleft; - blockread(e.f,stabs,stabscnt*sizeof(tstab),res{%H-}); - stabscnt:=res div sizeof(tstab); - for i:=0 to stabscnt-1 do - begin - case stabs[i].ntype of - N_BssLine, - N_DataLine, - N_TextLine : - begin - if (stabs[i].ntype=N_TextLine) and StabsFunctionRelative then - inc(stabs[i].nvalue,lastfunc.nvalue); - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>linestab.nvalue) then - begin - { if it's equal we can stop and take the last info } - if stabs[i].nvalue=addr then - found:=true - else - linestab:=stabs[i]; - end; - end; - N_Function : - begin - lastfunc:=stabs[i]; - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>funcstab.nvalue) then - begin - funcstab:=stabs[i]; - fillchar(linestab,sizeof(tstab),0); - end; - end; - N_SourceFile, - N_IncludeFile : - begin - if (stabs[i].nvalue<=addr) and - (stabs[i].nvalue>=filestab.nvalue) then - begin - { if same value and type then the first one - contained the directory PM } - if (stabs[i].nvalue=filestab.nvalue) and - (stabs[i].ntype=filestab.ntype) then - dirstab:=filestab - else - fillchar(dirstab,sizeof(tstab),0); - filestab:=stabs[i]; - fillchar(linestab,sizeof(tstab),0); - { if new file then func is not valid anymore PM } - if stabs[i].ntype=N_SourceFile then - begin - fillchar(funcstab,sizeof(tstab),0); - fillchar(lastfunc,sizeof(tstab),0); - end; - end; - end; - end; - end; - dec(stabsleft,stabscnt); - until found or (stabsleft=0); - -{ get the line,source,function info } - line:=linestab.ndesc; - if dirstab.ntype<>0 then - begin - system.seek(e.f,stabstrofs+dirstab.strpos); - blockread(e.f,source[1],high(source)-1,res); - dirlength:=strlen(@source[1]); - source[0]:=chr(dirlength); - end - else - dirlength:=0; - if filestab.ntype<>0 then - begin - system.seek(e.f,stabstrofs+filestab.strpos); - blockread(e.f,source[dirlength+1],high(source)-(dirlength+1),res); - source[0]:=chr(strlen(@source[1])); - end; - if funcstab.ntype<>0 then - begin - system.seek(e.f,stabstrofs+funcstab.strpos); - blockread(e.f,func[1],high(func)-1,res); - func[0]:=chr(strlen(@func[1])); - i:=system.pos(':',func); - if i>0 then - Delete(func,i,255); - end; - GetLineInfoStabs:=found; -end; - -{%endregion ********************* lineinfo ************************************} - -function OpenSymbolFile(AFileName: string): boolean; -begin - Result := False; - HasStabs := False; - HasDwarf := False; - filename := AFileName; - - if not OpenExeFile(e,filename) then - exit; - if ReadDebugLink(e,dbgfn) then - begin - CloseExeFile(e); - if not OpenExeFile(e,dbgfn) then - exit; - end; - - e.processaddress:=0; -// e.processaddress:=ptruint(baseaddr)-e.processaddress; - - - {%region ********************* lnfodwrf ************************************} - if FindExeSection(e,'.debug_line',dwarfoffset,dwarfsize) then begin - HasDwarf := True; - Result:=true; - end; - {%endregion ********************* lnfodwrf ************************************} - - {%region ********************* lineinfo ************************************} - StabsFunctionRelative := E.FunctionRelative; - if FindExeSection(e,'.stab',stabofs,stablen) and - FindExeSection(e,'.stabstr',stabstrofs,stabstrlen) then - begin - stabcnt:=stablen div sizeof(tstab); - HasStabs := True; - Result:=true; - end; - {%endregion ********************* lineinfo ************************************} -end; - -procedure CloseSymbolFile; -begin - CloseExeFile(e); -end; - -function GetLineInfo(addr: ptruint; out func, source: string; out line: longint): boolean; -begin - Result := False; - if HasDwarf then - Result := GetLineInfoDwarf(addr, func{%H-}, source{%H-}, line{%H-}); - if (not Result) and HasStabs then - Result := GetLineInfoStabs(addr, func, source, line); -end; - - -end. - diff --git a/baseunits/SimpleTranslator.pas b/baseunits/SimpleTranslator.pas new file mode 100644 index 000000000..cd9bd514e --- /dev/null +++ b/baseunits/SimpleTranslator.pas @@ -0,0 +1,786 @@ +{ Simple Translator + + Copyright (C) 2015 Nur Cholif + + This source is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 2 of the License, or (at your option) + any later version. + + This code is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + A copy of the GNU General Public License is available on the World Wide Web + at . You can also obtain it by writing + to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, + MA 02111-1307, USA. +} + +unit SimpleTranslator; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, strutils, gettext, LazFileUtils, LazUTF8, LCLTranslator, + Translations, LResources, Forms; + +type + TLanguageItem = record + id: String; + name: String; + end; + + TLanguageCollection = array of TLanguageItem; + +const + { + https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes + //table[2]/tbody/tr[position()>1]/concat("('",td[5],"', '",td[3],"', '",td[4],"'),") + } + lang_codes: array[0..183] of array[0..2] of string = ( + ('ab', 'Abkhaz', 'аҧсуа бызшәа, аҧсшәа'), + ('aa', 'Afar', 'Afaraf'), + ('af', 'Afrikaans', 'Afrikaans'), + ('ak', 'Akan', 'Akan'), + ('sq', 'Albanian', 'Shqip'), + ('am', 'Amharic', 'አማርኛ'), + ('ar', 'Arabic', 'العربية'), + ('an', 'Aragonese', 'aragonés'), + ('hy', 'Armenian', 'Հայերեն'), + ('as', 'Assamese', 'অসমীয়া'), + ('av', 'Avaric', 'авар мацӀ, магӀарул мацӀ'), + ('ae', 'Avestan', 'avesta'), + ('ay', 'Aymara', 'aymar aru'), + ('az', 'Azerbaijani', 'azərbaycan dili'), + ('bm', 'Bambara', 'bamanankan'), + ('ba', 'Bashkir', 'башҡорт теле'), + ('eu', 'Basque', 'euskara, euskera'), + ('be', 'Belarusian', 'беларуская мова'), + ('bn', 'Bengali, Bangla', 'বাংলা'), + ('bh', 'Bihari', 'भोजपुरी'), + ('bi', 'Bislama', 'Bislama'), + ('bs', 'Bosnian', 'bosanski jezik'), + ('br', 'Breton', 'brezhoneg'), + ('bg', 'Bulgarian', 'български език'), + ('my', 'Burmese', 'ဗမာစာ'), + ('ca', 'Catalan', 'català'), + ('ch', 'Chamorro', 'Chamoru'), + ('ce', 'Chechen', 'нохчийн мотт'), + ('ny', 'Chichewa, Chewa, Nyanja', 'chiCheŵa, chinyanja'), + ('zh', 'Chinese', '中文 (Zhōngwén), 汉语, 漢語'), + ('cv', 'Chuvash', 'чӑваш чӗлхи'), + ('kw', 'Cornish', 'Kernewek'), + ('co', 'Corsican', 'corsu, lingua corsa'), + ('cr', 'Cree', 'ᓀᐦᐃᔭᐍᐏᐣ'), + ('hr', 'Croatian', 'hrvatski jezik'), + ('cs', 'Czech', 'čeština, český jazyk'), + ('da', 'Danish', 'dansk'), + ('dv', 'Divehi, Dhivehi, Maldivian', 'ދިވެހި'), + ('nl', 'Dutch', 'Nederlands, Vlaams'), + ('dz', 'Dzongkha', 'རྫོང་ཁ'), + ('en', 'English', 'English'), + ('eo', 'Esperanto', 'Esperanto'), + ('et', 'Estonian', 'eesti, eesti keel'), + ('ee', 'Ewe', 'Eʋegbe'), + ('fo', 'Faroese', 'føroyskt'), + ('fj', 'Fijian', 'vosa Vakaviti'), + ('fi', 'Finnish', 'suomi, suomen kieli'), + ('fr', 'French', 'français, langue française'), + ('ff', 'Fula, Fulah, Pulaar, Pular', 'Fulfulde, Pulaar, Pular'), + ('gl', 'Galician', 'galego'), + ('ka', 'Georgian', 'ქართული'), + ('de', 'German', 'Deutsch'), + ('el', 'Greek (modern)', 'ελληνικά'), + ('gn', 'Guaraní', 'Avañe''ẽ'), + ('gu', 'Gujarati', 'ગુજરાતી'), + ('ht', 'Haitian, Haitian Creole', 'Kreyòl ayisyen'), + ('ha', 'Hausa', '(Hausa) هَوُسَ'), + ('he', 'Hebrew (modern)', 'עברית'), + ('hz', 'Herero', 'Otjiherero'), + ('hi', 'Hindi', 'हिन्दी, हिंदी'), + ('ho', 'Hiri Motu', 'Hiri Motu'), + ('hu', 'Hungarian', 'magyar'), + ('ia', 'Interlingua', 'Interlingua'), + ('id', 'Indonesian', 'Bahasa Indonesia'), + ('ie', 'Interlingue', 'Originally called Occidental; then Interlingue after WWII'), + ('ga', 'Irish', 'Gaeilge'), + ('ig', 'Igbo', 'Asụsụ Igbo'), + ('ik', 'Inupiaq', 'Iñupiaq, Iñupiatun'), + ('io', 'Ido', 'Ido'), + ('is', 'Icelandic', 'Íslenska'), + ('it', 'Italian', 'Italiano'), + ('iu', 'Inuktitut', 'ᐃᓄᒃᑎᑐᑦ'), + ('ja', 'Japanese', '日本語 (にほんご)'), + ('jv', 'Javanese', 'ꦧꦱꦗꦮ, Basa Jawa'), + ('kl', 'Kalaallisut, Greenlandic', 'kalaallisut, kalaallit oqaasii'), + ('kn', 'Kannada', 'ಕನ್ನಡ'), + ('kr', 'Kanuri', 'Kanuri'), + ('ks', 'Kashmiri', 'कश्मीरी, كشميري‎'), + ('kk', 'Kazakh', 'қазақ тілі'), + ('km', 'Khmer', 'ខ្មែរ, ខេមរភាសា, ភាសាខ្មែរ'), + ('ki', 'Kikuyu, Gikuyu', 'Gĩkũyũ'), + ('rw', 'Kinyarwanda', 'Ikinyarwanda'), + ('ky', 'Kyrgyz', 'Кыргызча, Кыргыз тили'), + ('kv', 'Komi', 'коми кыв'), + ('kg', 'Kongo', 'Kikongo'), + ('ko', 'Korean', '한국어'), + ('ku', 'Kurdish', 'Kurdî, كوردی‎'), + ('kj', 'Kwanyama, Kuanyama', 'Kuanyama'), + ('la', 'Latin', 'latine, lingua latina'), + ('lb', 'Luxembourgish, Letzeburgesch', 'Lëtzebuergesch'), + ('lg', 'Ganda', 'Luganda'), + ('li', 'Limburgish, Limburgan, Limburger', 'Limburgs'), + ('ln', 'Lingala', 'Lingála'), + ('lo', 'Lao', 'ພາສາລາວ'), + ('lt', 'Lithuanian', 'lietuvių kalba'), + ('lu', 'Luba-Katanga', 'Tshiluba'), + ('lv', 'Latvian', 'latviešu valoda'), + ('gv', 'Manx', 'Gaelg, Gailck'), + ('mk', 'Macedonian', 'македонски јазик'), + ('mg', 'Malagasy', 'fiteny malagasy'), + ('ms', 'Malay', 'bahasa Melayu, بهاس ملايو‎'), + ('ml', 'Malayalam', 'മലയാളം'), + ('mt', 'Maltese', 'Malti'), + ('mi', 'Māori', 'te reo Māori'), + ('mr', 'Marathi (Marāṭhī)', 'मराठी'), + ('mh', 'Marshallese', 'Kajin M̧ajeļ'), + ('mn', 'Mongolian', 'Монгол хэл'), + ('na', 'Nauruan', 'Dorerin Naoero'), + ('nv', 'Navajo, Navaho', 'Diné bizaad'), + ('nd', 'Northern Ndebele', 'isiNdebele'), + ('ne', 'Nepali', 'नेपाली'), + ('ng', 'Ndonga', 'Owambo'), + ('nb', 'Norwegian Bokmål', 'Norsk bokmål'), + ('nn', 'Norwegian Nynorsk', 'Norsk nynorsk'), + ('no', 'Norwegian', 'Norsk'), + ('ii', 'Nuosu', 'ꆈꌠ꒿ Nuosuhxop'), + ('nr', 'Southern Ndebele', 'isiNdebele'), + ('oc', 'Occitan', 'occitan, lenga d''òc'), + ('oj', 'Ojibwe, Ojibwa', 'ᐊᓂᔑᓈᐯᒧᐎᓐ'), + ('cu', 'Old Church Slavonic, Church Slavonic, Old Bulgarian', 'ѩзыкъ словѣньскъ'), + ('om', 'Oromo', 'Afaan Oromoo'), + ('or', 'Oriya', 'ଓଡ଼ିଆ'), + ('os', 'Ossetian, Ossetic', 'ирон æвзаг'), + ('pa', 'Eastern Punjabi, Eastern Panjabi', 'ਪੰਜਾਬੀ'), + ('pi', 'Pāli', 'पाऴि'), + ('fa', 'Persian (Farsi)', 'فارسی'), + ('pl', 'Polish', 'język polski, polszczyzna'), + ('ps', 'Pashto, Pushto', 'پښتو'), + ('pt', 'Portuguese', 'Português'), + ('qu', 'Quechua', 'Runa Simi, Kichwa'), + ('rm', 'Romansh', 'rumantsch grischun'), + ('rn', 'Kirundi', 'Ikirundi'), + ('ro', 'Romanian', 'Română'), + ('ru', 'Russian', 'Русский'), + ('sa', 'Sanskrit (Saṁskṛta)', 'संस्कृतम्'), + ('sc', 'Sardinian', 'sardu'), + ('sd', 'Sindhi', 'सिन्धी, سنڌي، سندھی‎'), + ('se', 'Northern Sami', 'Davvisámegiella'), + ('sm', 'Samoan', 'gagana fa''a Samoa'), + ('sg', 'Sango', 'yângâ tî sängö'), + ('sr', 'Serbian', 'српски језик'), + ('gd', 'Scottish Gaelic, Gaelic', 'Gàidhlig'), + ('sn', 'Shona', 'chiShona'), + ('si', 'Sinhalese, Sinhala', 'සිංහල'), + ('sk', 'Slovak', 'slovenčina, slovenský jazyk'), + ('sl', 'Slovene', 'slovenski jezik, slovenščina'), + ('so', 'Somali', 'Soomaaliga, af Soomaali'), + ('st', 'Southern Sotho', 'Sesotho'), + ('es', 'Spanish', 'Español'), + ('su', 'Sundanese', 'Basa Sunda'), + ('sw', 'Swahili', 'Kiswahili'), + ('ss', 'Swati', 'SiSwati'), + ('sv', 'Swedish', 'svenska'), + ('ta', 'Tamil', 'தமிழ்'), + ('te', 'Telugu', 'తెలుగు'), + ('tg', 'Tajik', 'тоҷикӣ, toçikī, تاجیکی‎'), + ('th', 'Thai', 'ไทย'), + ('ti', 'Tigrinya', 'ትግርኛ'), + ('bo', 'Tibetan Standard, Tibetan, Central', 'བོད་ཡིག'), + ('tk', 'Turkmen', 'Türkmen, Түркмен'), + ('tl', 'Tagalog', 'Wikang Tagalog'), + ('tn', 'Tswana', 'Setswana'), + ('to', 'Tonga (Tonga Islands)', 'faka Tonga'), + ('tr', 'Turkish', 'Türkçe'), + ('ts', 'Tsonga', 'Xitsonga'), + ('tt', 'Tatar', 'татар теле, tatar tele'), + ('tw', 'Twi', 'Twi'), + ('ty', 'Tahitian', 'Reo Tahiti'), + ('ug', 'Uyghur', 'ئۇيغۇرچە‎, Uyghurche'), + ('uk', 'Ukrainian', 'Українська'), + ('ur', 'Urdu', 'اردو'), + ('uz', 'Uzbek', 'Oʻzbek, Ўзбек, أۇزبېك‎'), + ('ve', 'Venda', 'Tshivenḓa'), + ('vi', 'Vietnamese', 'Tiếng Việt'), + ('vo', 'Volapük', 'Volapük'), + ('wa', 'Walloon', 'walon'), + ('cy', 'Welsh', 'Cymraeg'), + ('wo', 'Wolof', 'Wollof'), + ('fy', 'Western Frisian', 'Frysk'), + ('xh', 'Xhosa', 'isiXhosa'), + ('yi', 'Yiddish', 'ייִדיש'), + ('yo', 'Yoruba', 'Yorùbá'), + ('za', 'Zhuang, Chuang', 'Saɯ cueŋƅ, Saw cuengh'), + ('zu', 'Zulu', 'isiZulu') + ); + + { + https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2 + //table[3]/tbody/tr[position()>1]/concat("('",td[1],"', '",td[2],"'),") + } + country_codes: array[0..248] of array[0..1] of string = ( + ('AD', 'Andorra'), + ('AE', 'United Arab Emirates'), + ('AF', 'Afghanistan'), + ('AG', 'Antigua and Barbuda'), + ('AI', 'Anguilla'), + ('AL', 'Albania'), + ('AM', 'Armenia'), + ('AO', 'Angola'), + ('AQ', 'Antarctica'), + ('AR', 'Argentina'), + ('AS', 'American Samoa'), + ('AT', 'Austria'), + ('AU', 'Australia'), + ('AW', 'Aruba'), + ('AX', 'Aland Islands !Åland Islands'), + ('AZ', 'Azerbaijan'), + ('BA', 'Bosnia and Herzegovina'), + ('BB', 'Barbados'), + ('BD', 'Bangladesh'), + ('BE', 'Belgium'), + ('BF', 'Burkina Faso'), + ('BG', 'Bulgaria'), + ('BH', 'Bahrain'), + ('BI', 'Burundi'), + ('BJ', 'Benin'), + ('BL', 'Saint Barthélemy'), + ('BM', 'Bermuda'), + ('BN', 'Brunei Darussalam'), + ('BO', 'Bolivia, Plurinational State of'), + ('BQ', 'Bonaire, Sint Eustatius and Saba'), + ('BR', 'Brazil'), + ('BS', 'Bahamas'), + ('BT', 'Bhutan'), + ('BV', 'Bouvet Island'), + ('BW', 'Botswana'), + ('BY', 'Belarus'), + ('BZ', 'Belize'), + ('CA', 'Canada'), + ('CC', 'Cocos (Keeling) Islands'), + ('CD', 'Congo, the Democratic Republic of the'), + ('CF', 'Central African Republic'), + ('CG', 'Congo'), + ('CH', 'Switzerland'), + ('CI', 'Cote d''Ivoire !Côte d''Ivoire'), + ('CK', 'Cook Islands'), + ('CL', 'Chile'), + ('CM', 'Cameroon'), + ('CN', 'China'), + ('CO', 'Colombia'), + ('CR', 'Costa Rica'), + ('CU', 'Cuba'), + ('CV', 'Cabo Verde'), + ('CW', 'Curaçao'), + ('CX', 'Christmas Island'), + ('CY', 'Cyprus'), + ('CZ', 'Czechia'), + ('DE', 'Germany'), + ('DJ', 'Djibouti'), + ('DK', 'Denmark'), + ('DM', 'Dominica'), + ('DO', 'Dominican Republic'), + ('DZ', 'Algeria'), + ('EC', 'Ecuador'), + ('EE', 'Estonia'), + ('EG', 'Egypt'), + ('EH', 'Western Sahara'), + ('ER', 'Eritrea'), + ('ES', 'Spain'), + ('ET', 'Ethiopia'), + ('FI', 'Finland'), + ('FJ', 'Fiji'), + ('FK', 'Falkland Islands (Malvinas)'), + ('FM', 'Micronesia, Federated States of'), + ('FO', 'Faroe Islands'), + ('FR', 'France'), + ('GA', 'Gabon'), + ('GB', 'United Kingdom of Great Britain and Northern Ireland'), + ('GD', 'Grenada'), + ('GE', 'Georgia'), + ('GF', 'French Guiana'), + ('GG', 'Guernsey'), + ('GH', 'Ghana'), + ('GI', 'Gibraltar'), + ('GL', 'Greenland'), + ('GM', 'Gambia'), + ('GN', 'Guinea'), + ('GP', 'Guadeloupe'), + ('GQ', 'Equatorial Guinea'), + ('GR', 'Greece'), + ('GS', 'South Georgia and the South Sandwich Islands'), + ('GT', 'Guatemala'), + ('GU', 'Guam'), + ('GW', 'Guinea-Bissau'), + ('GY', 'Guyana'), + ('HK', 'Hong Kong'), + ('HM', 'Heard Island and McDonald Islands'), + ('HN', 'Honduras'), + ('HR', 'Croatia'), + ('HT', 'Haiti'), + ('HU', 'Hungary'), + ('ID', 'Indonesia'), + ('IE', 'Ireland'), + ('IL', 'Israel'), + ('IM', 'Isle of Man'), + ('IN', 'India'), + ('IO', 'British Indian Ocean Territory'), + ('IQ', 'Iraq'), + ('IR', 'Iran, Islamic Republic of'), + ('IS', 'Iceland'), + ('IT', 'Italy'), + ('JE', 'Jersey'), + ('JM', 'Jamaica'), + ('JO', 'Jordan'), + ('JP', 'Japan'), + ('KE', 'Kenya'), + ('KG', 'Kyrgyzstan'), + ('KH', 'Cambodia'), + ('KI', 'Kiribati'), + ('KM', 'Comoros'), + ('KN', 'Saint Kitts and Nevis'), + ('KP', 'Korea, Democratic People''s Republic of'), + ('KR', 'Korea, Republic of'), + ('KW', 'Kuwait'), + ('KY', 'Cayman Islands'), + ('KZ', 'Kazakhstan'), + ('LA', 'Lao People''s Democratic Republic'), + ('LB', 'Lebanon'), + ('LC', 'Saint Lucia'), + ('LI', 'Liechtenstein'), + ('LK', 'Sri Lanka'), + ('LR', 'Liberia'), + ('LS', 'Lesotho'), + ('LT', 'Lithuania'), + ('LU', 'Luxembourg'), + ('LV', 'Latvia'), + ('LY', 'Libya'), + ('MA', 'Morocco'), + ('MC', 'Monaco'), + ('MD', 'Moldova, Republic of'), + ('ME', 'Montenegro'), + ('MF', 'Saint Martin (French part)'), + ('MG', 'Madagascar'), + ('MH', 'Marshall Islands'), + ('MK', 'Macedonia, the former Yugoslav Republic of'), + ('ML', 'Mali'), + ('MM', 'Myanmar'), + ('MN', 'Mongolia'), + ('MO', 'Macao'), + ('MP', 'Northern Mariana Islands'), + ('MQ', 'Martinique'), + ('MR', 'Mauritania'), + ('MS', 'Montserrat'), + ('MT', 'Malta'), + ('MU', 'Mauritius'), + ('MV', 'Maldives'), + ('MW', 'Malawi'), + ('MX', 'Mexico'), + ('MY', 'Malaysia'), + ('MZ', 'Mozambique'), + ('NA', 'Namibia'), + ('NC', 'New Caledonia'), + ('NE', 'Niger'), + ('NF', 'Norfolk Island'), + ('NG', 'Nigeria'), + ('NI', 'Nicaragua'), + ('NL', 'Netherlands'), + ('NO', 'Norway'), + ('NP', 'Nepal'), + ('NR', 'Nauru'), + ('NU', 'Niue'), + ('NZ', 'New Zealand'), + ('OM', 'Oman'), + ('PA', 'Panama'), + ('PE', 'Peru'), + ('PF', 'French Polynesia'), + ('PG', 'Papua New Guinea'), + ('PH', 'Philippines'), + ('PK', 'Pakistan'), + ('PL', 'Poland'), + ('PM', 'Saint Pierre and Miquelon'), + ('PN', 'Pitcairn'), + ('PR', 'Puerto Rico'), + ('PS', 'Palestine, State of'), + ('PT', 'Portugal'), + ('PW', 'Palau'), + ('PY', 'Paraguay'), + ('QA', 'Qatar'), + ('RE', 'Reunion !Réunion'), + ('RO', 'Romania'), + ('RS', 'Serbia'), + ('RU', 'Russian Federation'), + ('RW', 'Rwanda'), + ('SA', 'Saudi Arabia'), + ('SB', 'Solomon Islands'), + ('SC', 'Seychelles'), + ('SD', 'Sudan'), + ('SE', 'Sweden'), + ('SG', 'Singapore'), + ('SH', 'Saint Helena, Ascension and Tristan da Cunha'), + ('SI', 'Slovenia'), + ('SJ', 'Svalbard and Jan Mayen'), + ('SK', 'Slovakia'), + ('SL', 'Sierra Leone'), + ('SM', 'San Marino'), + ('SN', 'Senegal'), + ('SO', 'Somalia'), + ('SR', 'Suriname'), + ('SS', 'South Sudan'), + ('ST', 'Sao Tome and Principe'), + ('SV', 'El Salvador'), + ('SX', 'Sint Maarten (Dutch part)'), + ('SY', 'Syrian Arab Republic'), + ('SZ', 'Swaziland'), + ('TC', 'Turks and Caicos Islands'), + ('TD', 'Chad'), + ('TF', 'French Southern Territories'), + ('TG', 'Togo'), + ('TH', 'Thailand'), + ('TJ', 'Tajikistan'), + ('TK', 'Tokelau'), + ('TL', 'Timor-Leste'), + ('TM', 'Turkmenistan'), + ('TN', 'Tunisia'), + ('TO', 'Tonga'), + ('TR', 'Turkey'), + ('TT', 'Trinidad and Tobago'), + ('TV', 'Tuvalu'), + ('TW', 'Taiwan, Province of China'), + ('TZ', 'Tanzania, United Republic of'), + ('UA', 'Ukraine'), + ('UG', 'Uganda'), + ('UM', 'United States Minor Outlying Islands'), + ('US', 'United States of America'), + ('UY', 'Uruguay'), + ('UZ', 'Uzbekistan'), + ('VA', 'Holy See'), + ('VC', 'Saint Vincent and the Grenadines'), + ('VE', 'Venezuela, Bolivarian Republic of'), + ('VG', 'Virgin Islands, British'), + ('VI', 'Virgin Islands, U.S.'), + ('VN', 'Viet Nam'), + ('VU', 'Vanuatu'), + ('WF', 'Wallis and Futuna'), + ('WS', 'Samoa'), + ('YE', 'Yemen'), + ('YT', 'Mayotte'), + ('ZA', 'South Africa'), + ('ZM', 'Zambia'), + ('ZW', 'Zimbabwe') + ); + + ldir: array[0..3] of string = + ('LANG', 'languages', 'locale', 'locale' + PathDelim + 'LC_MESSAGES'); + +var + AvailableLanguages: TStringList; + LastSelected: string = ''; + LangDir: string = ''; + LangAppName: string = ''; + + procedure CollectLanguagesFiles(const appname: string = ''; const dir: string = ''; + useNativeName: Boolean = True); + function GetLangName(const lcode: string; const useNativeName: Boolean = True): string; + + function SetLang(const lang: string; appname: string = ''): Boolean; + function SetLangByIndex(const Index: Integer): Boolean; + function GetDefaultLang: string; + +implementation + +function SortValue(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := CompareStr(List.ValueFromIndex[Index1], List.ValueFromIndex[Index2]); +end; + +procedure CollectLanguagesFiles(const appname: string; const dir: string; + useNativeName: Boolean); + + procedure searchLangDir(adir, aname: string); + var + SR: TSearchRec; + p: Integer; + ldir, lname, s, id: string; + begin + ldir := adir; + lname := LowerCase(aname); + if RightStr(ldir, 1) <> PathDelim then + ldir := ldir + PathDelim; + if DirectoryExistsUTF8(ldir) then + begin + if FindFirstUTF8(ldir + '*', faAnyFile, SR) = 0 then + repeat + s := LowerCase(SR.Name); + if (Pos(lname + '.', s) = 1) and + ((RightStr(s, 3) = '.po') or (RightStr(s, 3) = '.mo')) then + begin + s := SR.Name; + SetLength(s, Length(s) - 3); + p := Pos('.', s); + if p > 0 then + begin + id := Copy(s, p + 1, Length(s)); + if AvailableLanguages.Values[id] = '' then + AvailableLanguages.Values[id] := GetLangName(id, useNativeName); + end; + end; + until FindNextUTF8(SR) <> 0; + FindCloseUTF8(SR); + end; + end; + +var + sdir, tdir, tappname: string; + lauto: Boolean = False; + i: Integer; +begin + tdir := dir; + if tdir = '' then + begin + if LangDir <> '' then + tdir := LangDir + else + begin + tdir := ExtractFilePath(Application.ExeName); + lauto := True; + end; + end; + tappname := appname; + if tappname = '' then + begin + if LangAppName <> '' then + tappname := LangAppName + else + tappname := ExtractFileNameOnly(ParamStrUTF8(0)); + end; + AvailableLanguages.Clear; + + if lauto then + for i := Low(ldir) to High(ldir) do + begin + sdir := tdir + ldir[i] + PathDelim; + searchLangDir(sdir, tappname); + end + else + searchLangDir(tdir, tappname); + + if AvailableLanguages.Count > 0 then + AvailableLanguages.CustomSort(@SortValue); +end; + +function GetLangName(const lcode: string; const useNativeName: Boolean): string; + + function getlangcodes(const l: string): string; + var + i: Integer; + begin + Result := l; + for i := Low(lang_codes) to High(lang_codes) do + if SameText(l, lang_codes[i, 0]) then + begin + if useNativeName then + Result := lang_codes[i, 2] + else + Result := lang_codes[i, 1]; + Break; + end; + end; + + function getcountrycodes(l: string): string; + var + i: Integer; + begin + Result := l; + for i := Low(country_codes) to High(country_codes) do + begin + if SameText(l, country_codes[i, 0]) then + begin + Result := country_codes[i, 1]; + Break; + end; + end; + end; + +var + p: Integer; + s, id: String; +begin + Result := lcode; + if Result = '' then Exit; + s := TrimSet(lcode,[' ','.','_','-']); + p := Pos('_', s); + if p = 0 then + p := Pos('-', s); + if p > 1 then + begin + id := Copy(s, 1, p - 1); + Result := getlangcodes(id); + id := Copy(s, P + 1, Length(s)); + s := getcountrycodes(id); + if s <> id then + Result := Format('%s (%s)', [Result, s]); + end + else + Result := getlangcodes(s); +end; + +function TranslateLCL(Lang: string): Boolean; +var + lcllang, lcllangdir, lcllangpath: string; + mofile: Boolean; + + procedure FindLCLFile; + var + i: Integer; + l, s: string; + begin + if LangDir <> '' then + begin + lcllangdir := LangDir; + if RightStr(lcllangdir, 1) <> PathDelim then + lcllangdir := lcllangdir + PathDelim; + s := lcllangdir + 'lclstrconsts.' + lcllang; + if FileExistsUTF8(s + '.po') then + lcllangpath := s + '.po' + else if FileExistsUTF8(s + '.mo') then + begin + lcllangpath := s + '.mo'; + mofile := True; + end; + end; + if lcllangpath = '' then + begin + l := ExtractFilePath(Application.ExeName); + for i := Low(ldir) to High(ldir) do + begin + lcllangdir := l + ldir[i]; + s := lcllangdir + 'lclstrconsts.' + lcllang; + if FileExistsUTF8(s + '.po') then + begin + lcllangpath := s + '.po'; + Break; + end + else if FileExistsUTF8(s + '.mo') then + begin + lcllangpath := s + '.mo'; + mofile := True; + Break; + end; + end; + end; + end; + +begin + Result := False; + lcllangpath := ''; + mofile := False; + lcllang := Lang; + FindLCLFile; + if lcllangpath = '' then + begin + if Pos('_', lcllang) <> 0 then + SetLength(lcllang, Pos('_', lcllang)-1); + FindLCLFile; + end; + if lcllangpath <> '' then + begin + if mofile then + gettext.TranslateUnitResourceStrings('LclStrConsts', lcllangpath) + else + Translations.TranslateUnitResourceStrings('LclStrConsts', lcllangpath); + Result := True; + end; +end; + +function SetLang(const lang: string; appname: string): Boolean; +var + lfile: string; + ltrans: TUpdateTranslator; + i: Integer; +begin + Result := False; + ltrans := nil; + if (LastSelected <> lang) then + begin + LangDir := TrimRightSet(LangDir, [PathDelim]); + if appname = '' then + begin + if LangAppName <> '' then + appname := LangAppName + else + appname := ExtractFileNameOnly(ParamStrUTF8(0)); + end; + lfile := LangDir + PathDelim + appname + '.' + lang; + + if FileExistsUTF8(lfile + '.po') then //po file + begin + lfile := lfile + '.po'; + Translations.TranslateResourceStrings(lfile); + ltrans := TPOTranslator.Create(lfile); + end + else + if FileExistsUTF8(lfile + '.mo') then //mo file + begin + lfile := lfile + '.mo'; + gettext.TranslateResourceStrings(lfile); + ltrans := TDefaultTranslator.Create(lfile); + end; + + TranslateLCL(lang); + + if ltrans <> nil then + begin + if Assigned(LRSTranslator) then + LRSTranslator.Free; + LRSTranslator := ltrans; + for i := 0 to Screen.CustomFormCount-1 do + ltrans.UpdateTranslation(Screen.CustomForms[i]); + for i := 0 to Screen.DataModuleCount-1 do + ltrans.UpdateTranslation(Screen.DataModules[i]); + LastSelected := lang; + Result := True; + end; + end; +end; + +function SetLangByIndex(const Index: Integer): Boolean; +begin + Result := False; + if Index < 0 then Exit; + if LastSelected <> AvailableLanguages.Names[Index] then + Result := SetLang(AvailableLanguages.Names[Index]); +end; + +function GetDefaultLang: string; +begin + {$IF FPC_FULLVERSION >= 20701} + Result := LCLTranslator.GetDefaultLang; + {$ELSE} + Result := ''; + {$ENDIF} +end; + +initialization + AvailableLanguages := TStringList.Create; + AvailableLanguages.NameValueSeparator := '='; + +finalization + AvailableLanguages.Free; + +end. + diff --git a/baseunits/VirtualPropertyGrid.pas b/baseunits/VirtualPropertyGrid.pas new file mode 100644 index 000000000..0ff563d9e --- /dev/null +++ b/baseunits/VirtualPropertyGrid.pas @@ -0,0 +1,423 @@ +unit VirtualPropertyGrid; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, typinfo, Types, FPCanvas, VirtualTrees, Graphics, + LMessages, Themes, Controls, LCLIntf; + +type + + PObjectPropInfo = ^TObjectPropInfo; + + TObjectPropInfo = record + Obj: TObject; + PropInfo: PPropInfo; + end; + + { TVirtualPropertyGrid } + + TVirtualPropertyGrid = class(TVirtualStringTree) + private + FAutoFullExpand: Boolean; + FAutoSortTree: Boolean; + FCheckBoxPos: TPoint; + FCheckBoxSize: TSize; + FCheckBoxUncheckedDetails: TThemedElementDetails; + FCheckBoxCheckedDetails: TThemedElementDetails; + FCleanEnumName: Boolean; + FFilter: TTypeKinds; + FHideClassNames: Boolean; + FTIObject: TObject; + FIsSplitResize: Boolean; + procedure BuildProperties; + procedure SetFilter(AValue: TTypeKinds); + procedure SetTIObject(AValue: TObject); + protected + procedure DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean); override; + function DoCompare(Node1, Node2: PVirtualNode; Column: TColumnIndex): Integer; + override; + procedure DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); override; + procedure DoGetText(Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: String); override; + procedure DoFreeNode(Node: PVirtualNode); override; + procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); + override; + procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override; + procedure DoAfterPaint(TargetCanvas: TCanvas); override; + procedure DoColumnClick(Column: TColumnIndex; Shift: TShiftState); override; + procedure HandleHotTrack(X, Y: Integer); override; + procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); + override; + procedure HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo); override; + function DoCreateEditor(Node: PVirtualNode; Column: TColumnIndex): IVTEditLink; + override; + procedure DoScroll(DeltaX, DeltaY: Integer); override; + procedure KeyPress(var Key: Char); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AutoFullExpand: Boolean read FAutoFullExpand write FAutoFullExpand default False; + property AutoSortTree: Boolean read FAutoSortTree write FAutoSortTree default False; + property CleanEnumName: Boolean read FCleanEnumName write FCleanEnumName default False; + property Filter: TTypeKinds read FFilter write SetFilter default tkProperties; + property HideClassNames: Boolean read FHideClassNames write FHideClassNames default False; + property TIObject: TObject read FTIObject write SetTIObject; + end; + +implementation + +uses VirtualPropertyGridEditLink; + +{ TVirtualPropertyGrid } + +procedure TVirtualPropertyGrid.SetTIObject(AValue: TObject); +begin + if FTIObject = AValue then + Exit; + FTIObject := AValue; + BuildProperties; +end; + +procedure TVirtualPropertyGrid.BuildProperties; + + procedure BuildProps(AObj: TObject; Parent: PVirtualNode); + var + tempproplist: PPropList; + i: Integer; + node: PVirtualNode; + Data: PObjectPropInfo; + begin + if AObj = nil then + Exit; + try + GetMem(tempproplist, GetTypeData(AObj.ClassInfo)^.PropCount * SizeOf(Pointer)); + for i := 0 to GetPropList(AObj.ClassInfo, FFilter, tempproplist, False) - 1 do + begin + node := AddChild(Parent); + InitNode(node); + Data := GetNodeData(node); + with Data^ do + begin + Data^.Obj := AObj; + PropInfo := tempproplist^[i]; + if PropInfo^.PropType^.Kind = tkBool then + begin + node^.CheckType := ctCheckBox; + if Boolean(GetOrdProp(Obj, Data^.PropInfo)) then + node^.CheckState := csCheckedNormal; + end + else + if PropInfo^.PropType^.Kind = tkClass then + BuildProps(GetObjectProp(Obj, PropInfo), node); + end; + end; + finally + if tempproplist <> nil then + Freemem(tempproplist); + end; + end; + +begin + BeginUpdate; + try + Clear; + BuildProps(FTIObject, RootNode); + if FAutoSortTree then + SortTree(0, sdAscending, False); + if FAutoFullExpand then + FullExpand(); + finally + EndUpdate; + end; +end; + +procedure TVirtualPropertyGrid.SetFilter(AValue: TTypeKinds); +begin + if FFilter = AValue then + Exit; + FFilter := AValue; +end; + +procedure TVirtualPropertyGrid.DoCanEdit(Node: PVirtualNode; Column: TColumnIndex; + var Allowed: Boolean); +begin + Allowed := False; + if Column = 0 then + Exit; + if PObjectPropInfo(GetNodeData(Node))^.PropInfo^.PropType^.Kind in [tkBool, tkClass] then + Exit; + Allowed := True; + inherited DoCanEdit(Node, Column, Allowed); +end; + +function TVirtualPropertyGrid.DoCompare(Node1, Node2: PVirtualNode; + Column: TColumnIndex): Integer; +begin + if Column = 0 then + Result := AnsiCompareStr(PObjectPropInfo(GetNodeData(node1))^.PropInfo^.Name, + PObjectPropInfo(GetNodeData(node2))^.PropInfo^.Name); + Result := inherited DoCompare(Node1, Node2, Column); +end; + +procedure TVirtualPropertyGrid.DoFocusChange(Node: PVirtualNode; Column: TColumnIndex); +begin + inherited DoFocusChange(Node, Column); + EditNode(Node, Column); +end; + +procedure TVirtualPropertyGrid.DoGetText(Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType; var CellText: String); +begin + with PObjectPropInfo(GetNodeData(Node))^ do + case Column of + 0: CellText := PropInfo^.Name; + 1: case PropInfo^.PropType^.Kind of + tkSString, + tkLString, + tkAString, + tkWString: + CellText := GetStrProp(Obj, PropInfo); + tkInteger, + tkInt64: + CellText := IntToStr(GetOrdProp(Obj, PropInfo)); + tkBool: + CellText := '(' + BoolToStr(Boolean(GetOrdProp(Obj, PropInfo)), True) + ')'; + tkEnumeration: + CellText := TryCleanEnumName(GetEnumProp(Obj, PropInfo), FCleanEnumName); + tkClass: + if not FHideClassNames then + CellText := '(' + GetObjectPropClass(Obj, PropInfo^.Name).ClassName + ')'; + end; + end; + inherited DoGetText(Node, Column, TextType, CellText); +end; + +procedure TVirtualPropertyGrid.DoFreeNode(Node: PVirtualNode); +begin + Finalize(PObjectPropInfo(GetNodeData(node))^); + inherited DoFreeNode(Node); +end; + +procedure TVirtualPropertyGrid.PrepareCell(var PaintInfo: TVTPaintInfo; + WindowOrgX, MaxWidth: Integer); +var + C: TRect; +begin + with PaintInfo do + begin + C := CellRect; + if Column = 0 then + begin + CellRect := ContentRect; + CellRect.Left := CellRect.Left + 1; + end + else + begin + if PObjectPropInfo(GetNodeData(Node))^.PropInfo^.PropType^.Kind = tkBool then + ContentRect.Left := ContentRect.Left + FCheckBoxSize.Width + TextMargin; + end; + inherited PrepareCell(PaintInfo, WindowOrgX, MaxWidth); + if Column = 0 then + CellRect := C; + end; +end; + +procedure TVirtualPropertyGrid.DoPaintNode(var PaintInfo: TVTPaintInfo); +var + R: TRect; +begin + inherited DoPaintNode(PaintInfo); + with PaintInfo, PObjectPropInfo(GetNodeData(PaintInfo.Node))^ do + if Column = 1 then + begin + if PropInfo^.PropType^.Kind = tkBool then + begin + R := CellRect; + R.Left := R.Left + TextMargin; + R.Width := FCheckBoxSize.Width; + FCheckBoxPos.x := R.Left; + FCheckBoxPos.y := R.Right; + if Boolean(GetOrdProp(Obj, PropInfo)) then + ThemeServices.DrawElement(Canvas.Handle, FCheckBoxCheckedDetails, R) + else + ThemeServices.DrawElement(Canvas.Handle, FCheckBoxUncheckedDetails, R); + end; + end; +end; + +procedure TVirtualPropertyGrid.DoAfterPaint(TargetCanvas: TCanvas); +var + Node, XNode: PVirtualNode; + R, XR: TRect; +begin + inherited DoAfterPaint(TargetCanvas); + R := ClientRect; + with TargetCanvas, R do + begin + Pen.Style := psSolid; + Pen.Color := Self.Colors.GridLineColor; + Node := GetFirstVisible(); + while Node <> nil do + begin + R := GetDisplayRect(Node, 0, True, False, False); + Line(Left, Top, Left, Bottom); + if (GetPreviousVisibleSibling(Node) = nil) and + (Node^.Parent <> nil) and + (Node^.Parent <> RootNode) then + Line(Left, Top, Left - Self.Indent - 1, Top); + if (GetNextVisibleSibling(Node) = nil) then + begin + XNode := GetNextVisible(Node, False); + if (XNode <> nil) and (XNode^.Parent <> Node) then + begin + XR := GetDisplayRect(XNode, 0, True, False, False); + line(Left, Bottom - 1, XR.Left - 1, Bottom - 1); + end; + end; + Node := GetNextVisible(Node); + end; + R := ClientRect; + Left := Header.Columns[0].Left; + Right := Left + Header.Columns[0].Width - 1; + Bottom := Bottom + Header.Height; + Line(Right, Top, Right, Bottom); + Node := GetLastVisible(nil, True); + if Node <> nil then + begin + R := GetDisplayRect(Node, 0, True, False, False); + R.Top := R.Bottom; + R.Bottom := ClientRect.Bottom + Header.Height; + Line(Left, Top, Left, Bottom); + end; + end; +end; + +procedure TVirtualPropertyGrid.HandleHotTrack(X, Y: Integer); +begin + if FIsSplitResize or ((x >= Header.Columns[1].Left - TextMargin) and + (x <= Header.Columns[1].Left + TextMargin)) then + begin + Cursor := crHSplit; + if FIsSplitResize then + Header.Columns[0].Width := x; + end + else + inherited HandleHotTrack(X, Y); +end; + +procedure TVirtualPropertyGrid.HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); +begin + if (Message.XPos >= Header.Columns[1].Left - TextMargin) and + (Message.XPos <= Header.Columns[1].Left + TextMargin) then + FIsSplitResize := True + else + inherited HandleMouseDown(Message, HitInfo); +end; + +procedure TVirtualPropertyGrid.HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo); +begin + if FIsSplitResize then + begin + Cursor := crDefault; + FIsSplitResize := False; + end + else + inherited HandleMouseUp(Keys, HitInfo); +end; + +procedure TVirtualPropertyGrid.DoColumnClick(Column: TColumnIndex; Shift: TShiftState); +var + curpos: TPoint; + Node: PVirtualNode; +begin + if Column <> 1 then + Exit; + curpos := ScreenToClient(Mouse.CursorPos); + Node := GetNodeAt(curpos.x, curpos.y); + if Node = nil then + Exit; + if (curpos.x >= FCheckBoxPos.x) and (curpos.x <= FCheckBoxPos.y) then + with PObjectPropInfo(GetNodeData(Node))^ do + begin + if PropInfo^.PropType^.Kind = tkBool then + begin + SetOrdProp(Obj, PropInfo, Integer(not (Boolean(GetOrdProp(Obj, PropInfo))))); + RepaintNode(Node); + end; + end; + inherited DoColumnClick(Column, Shift); +end; + +function TVirtualPropertyGrid.DoCreateEditor(Node: PVirtualNode; + Column: TColumnIndex): IVTEditLink; +var + L: TVirtualPropertyGridEditLink; +begin + L := TVirtualPropertyGridEditLink.Create; + L.CleanEnumName := FCleanEnumName; + Result := L; + L := nil; +end; + +procedure TVirtualPropertyGrid.DoScroll(DeltaX, DeltaY: Integer); +begin + if tsEditing in TreeStates then + EndEditNode; + inherited DoScroll(DeltaX, DeltaY); +end; + +procedure TVirtualPropertyGrid.KeyPress(var Key: Char); +begin + if (FocusedColumn = 1) and (FocusedNode <> nil) and (Key in [#13, #32]) then + with PObjectPropInfo(GetNodeData(FocusedNode))^ do + if PropInfo^.PropType^.Kind = tkBool then + begin + SetOrdProp(Obj, PropInfo, Integer(not (Boolean(GetOrdProp(Obj, PropInfo))))); + RepaintNode(FocusedNode); + end; + inherited KeyPress(Key); +end; + +constructor TVirtualPropertyGrid.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FFilter := tkProperties; + DoubleBuffered := True; + NodeDataSize := SizeOf(TObjectPropInfo); + Color := clBtnFace; + EditDelay := 0; + Margin := 0; + TextMargin := 4; + Indent := 18; + Colors.GridLineColor := clBtnShadow; + DrawSelectionMode := smBlendedRectangle; + FCheckBoxUncheckedDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal); + FCheckBoxCheckedDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal); + FCheckBoxSize := ThemeServices.GetDetailSize(FCheckBoxUncheckedDetails); + with TreeOptions do + begin + PaintOptions := PaintOptions - [toShowTreeLines] + [toHideFocusRect, toPopupMode]; + SelectionOptions := SelectionOptions + [toExtendedFocus]; + MiscOptions := MiscOptions + [toEditable, toGridExtensions]; + end; + with Header do + begin + Options := Options - [hoVisible] + [hoAutoResize]; + Columns.Add; + Columns.Add; + Columns[0].Width := 200; + AutoSizeIndex := 1; + end; +end; + +destructor TVirtualPropertyGrid.Destroy; +begin + inherited Destroy; +end; + +end. diff --git a/baseunits/VirtualPropertyGridEditLink.pas b/baseunits/VirtualPropertyGridEditLink.pas new file mode 100644 index 000000000..cbab3fd42 --- /dev/null +++ b/baseunits/VirtualPropertyGridEditLink.pas @@ -0,0 +1,239 @@ +unit VirtualPropertyGridEditLink; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, Windows, SysUtils, Messages, typinfo, VirtualPropertyGrid, VirtualTrees, + Controls, StdCtrls, LMessages, LCLType, Spin, EditBtn, Forms, StringsPropEditDlg; + +type + + TEditLinkKind = (ekString, ekInteger, ekEnum); + + { TVirtualPropertyGridEditLink } + + TVirtualPropertyGridEditLink = class(TInterfacedObject, IVTEditLink) + private + FCleanEnumName: Boolean; + FColumn: TColumnIndex; + FEdit: TWinControl; + FKind: TEditLinkKind; + FNode: PVirtualNode; + FPObjectProp: PObjectPropInfo; + FTree: TVirtualStringTree; + protected + procedure EditButtonStringClick(Sender: TObject); + procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure EditExit(Sender: TObject); + public + destructor Destroy; override; + function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex): Boolean; stdcall; + function BeginEdit: Boolean; stdcall; + function CancelEdit: Boolean; stdcall; + function EndEdit: Boolean; stdcall; + function GetBounds: TRect; stdcall; + procedure SetBounds(R: TRect); stdcall; + procedure ProcessMessage(var Message: TLMessage); stdcall; + published + property CleanEnumName: Boolean read FCleanEnumName write FCleanEnumName default False; + end; + + + { TEditButtonHelper } + + TEditButtonHelper = class helper for TEditButton + public + function GetEdit: TEbEdit; + end; + +function TryCleanEnumName(const EnumName: String; Clean: Boolean = True): String; + +implementation + +function TryCleanEnumName(const EnumName: String; Clean: Boolean): String; +var + i: Integer; +begin + if not Clean then + Exit(EnumName); + Result := ''; + for i := 1 to Length(EnumName) do + begin + if EnumName[i] in ['A'..'Z'] then + begin + Result := Copy(EnumName, i, Length(EnumName) - i + 1); + Break; + end; + end; + if Result = '' then + Result := EnumName; +end; + +{ TEditButtonHelper } + +function TEditButtonHelper.GetEdit: TEbEdit; +begin + Result := Edit; +end; + +{ TVirtualPropertyGridEditLink } + +procedure TVirtualPropertyGridEditLink.EditButtonStringClick(Sender: TObject); +begin + with TStringsPropEditorFrm.Create(nil) do + try + with TEditButton(FEdit) do + begin + Memo.Lines.Text := Text; + if ShowModal = mrOk then + Text := Memo.Lines.Text; + end; + finally + Free; + end; +end; + +procedure TVirtualPropertyGridEditLink.EditKeyDown(Sender: TObject; + var Key: Word; Shift: TShiftState); +begin + case Key of + VK_ESCAPE: + begin + FTree.CancelEditNode; + Key := 0; + end; + VK_RETURN: + begin + FTree.EndEditNode; + Key := 0; + end; + VK_UP, VK_DOWN: + begin + PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0); + Key := 0; + end; + end; +end; + +procedure TVirtualPropertyGridEditLink.EditExit(Sender: TObject); +begin + FTree.EndEditNode; +end; + +destructor TVirtualPropertyGridEditLink.Destroy; +begin + Application.ReleaseComponent(FEdit); + inherited Destroy; +end; + +function TVirtualPropertyGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall; +var + i: Integer; +begin + Result := True; + FTree := Tree as TVirtualStringTree; + FNode := Node; + FColumn := Column; + FPObjectProp := FTree.GetNodeData(Node); + FEdit.Free; + FEdit := nil; + with FPObjectProp^ do + case PropInfo^.PropType^.Kind of + tkSString, tkLString, tkAString, tkWString: + begin + FKind := ekString; + FEdit := TEditButton.Create(nil); + with TEditButton(FEdit) do + begin + Text := GetStrProp(Obj, PropInfo); + ButtonCaption := '...'; + OnButtonClick := @EditButtonStringClick; + GetEdit.OnKeyDown := @EditKeyDown; + end; + end; + tkInteger, tkInt64: + begin + FKind := ekInteger; + FEdit := TSpinEdit.Create(nil); + with TSpinEdit(FEdit) do + begin + MinValue := 0; + MaxValue := MaxInt; + Value := GetOrdProp(Obj, PropInfo); + end; + end; + tkEnumeration: + begin + FKind := ekEnum; + FEdit := TComboBox.Create(nil); + with TComboBox(FEdit) do + begin + for i := 0 to GetEnumNameCount(PropInfo^.PropType) - 1 do + Items.Add(TryCleanEnumName(GetEnumName(PropInfo^.PropType, i), FCleanEnumName)); + ItemIndex := GetOrdProp(Obj, PropInfo); + end; + end; + else + Result := False; + end; + + if Result then + with FEdit do + begin + Visible := False; + Parent := FTree; + OnKeyDown := @EditKeyDown; + end; +end; + +function TVirtualPropertyGridEditLink.BeginEdit: Boolean; stdcall; +begin + Result := True; + FEdit.Visible := True; + FEdit.SetFocus; +end; + +function TVirtualPropertyGridEditLink.CancelEdit: Boolean; stdcall; +begin + Result := True; + FEdit.Hide; +end; + +function TVirtualPropertyGridEditLink.EndEdit: Boolean; stdcall; +begin + Result := True; + with FPObjectProp^ do + case FKind of + ekString: SetStrProp(Obj, PropInfo, TEditButton(FEdit).Text); + ekInteger: SetOrdProp(Obj, PropInfo, TSpinEdit(FEdit).Value); + ekEnum: SetOrdProp(Obj, PropInfo, TComboBox(FEdit).ItemIndex); + end; + FTree.InvalidateNode(FNode); + FEdit.Hide; + FTree.SetFocus; +end; + +function TVirtualPropertyGridEditLink.GetBounds: TRect; stdcall; +begin + Result := FEdit.BoundsRect; +end; + +procedure TVirtualPropertyGridEditLink.SetBounds(R: TRect); stdcall; +var + i: Integer; +begin + FTree.Header.Columns.GetColumnBounds(FColumn, i, R.Right); + FEdit.BoundsRect := R; +end; + +procedure TVirtualPropertyGridEditLink.ProcessMessage(var Message: TLMessage); + stdcall; +begin + FEdit.WindowProc(Message); +end; + +end. diff --git a/baseunits/WebsiteModules.pas b/baseunits/WebsiteModules.pas new file mode 100644 index 000000000..48654d25c --- /dev/null +++ b/baseunits/WebsiteModules.pas @@ -0,0 +1,1106 @@ +{ + License: GPLv2 + This unit is a part of Free Manga Downloader +} + +unit WebsiteModules; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fgl, uData, uDownloadsManager, FMDOptions, httpsendthread, + WebsiteModulesSettings, LazLogger, Cloudflare, RegExpr, fpjson, jsonparser, + jsonscanner, fpjsonrtti; + +const + MODULE_NOT_FOUND = -1; + NO_ERROR = 0; + NET_PROBLEM = 1; + INFORMATION_NOT_FOUND = 2; + +type + + TModuleContainer = class; + + TOnBeforeUpdateList = function(const Module: TModuleContainer): Boolean; + TOnAfterUpdateList = function(const Module: TModuleContainer): Boolean; + TOnGetDirectoryPageNumber = function(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; + TOnGetNameAndLink = function(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; + TOnGetInfo = function(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; + + TOnTaskStart = function(const Task: TTaskContainer; const Module: TModuleContainer): Boolean; + TOnGetPageNumber = function(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; + TOnGetImageURL = function(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; + + TOnBeforeDownloadImage = function(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; + + TOnDownloadImage = function(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; + + TOnSaveImage = function(const AHTTP: THTTPSendThread; + const APath, AName: String; const Module: TModuleContainer): String; + + TOnAfterImageSaved = function(const AFilename: String; const Module: TModuleContainer): Boolean; + + TOnLogin = function(const AHTTP: THTTPSendThread; const Module: TModuleContainer): Boolean; + + TModuleMethod = (MMGetDirectoryPageNumber, MMGetNameAndLink, MMGetInfo, + MMTaskStart, MMGetPageNumber, MMGetImageURL, MMBeforeDownloadImage, + MMDownloadImage, MMSaveImage, MMAfterImageSaved, MMLogin); + + TWebsiteOptionType = (woCheckBox, woEdit, woSpinEdit, woComboBox); + + TWebsiteOptionItem = record + OptionType: TWebsiteOptionType; + Name: String; + Caption: PString; + BindValue: Pointer; + Items: PString; + end; + + TAccountStatus = (asUnknown, asChecking, asValid, asInvalid); + + { TWebsiteModuleAccount } + + TWebsiteModuleAccount = class + private + FCookies: String; + FEnabled: Boolean; + FPassword: String; + FStatus: TAccountStatus; + FUsername: String; + published + property Enabled: Boolean read FEnabled write FEnabled; + property Username: String read FUsername write FUsername; + property Password: String read FPassword write FPassword; + property Cookies: String read FCookies write FCookies; + property Status: TAccountStatus read FStatus write FStatus; + end; + + PModuleContainer = ^TModuleContainer; + + { TModuleContainer } + + TModuleContainer = class + private + FAccount: TWebsiteModuleAccount; + FAccountSupport: Boolean; + FID: Integer; + FSettings: TWebsiteModuleSettings; + FTotalDirectory: Integer; + FCloudflareCF: TCFProps; + FCloudflareEnabled: Boolean; + procedure SetAccountSupport(AValue: Boolean); + procedure SetCloudflareEnabled(AValue: Boolean); + procedure CheckCloudflareEnabled(const AHTTP: THTTPSendThread); + function CloudflareHTTPRequest(const AHTTP: THTTPSendThread; const Method, URL: String; const Response: TObject = nil): Boolean; + procedure SetTotalDirectory(AValue: Integer); + procedure AddOption(const AOptionType: TWebsiteOptionType; + const ABindValue: Pointer; const AName: String; const ACaption: PString; const AItems: PString = nil); + public + Tag: Integer; + TagPtr: Pointer; + Website: String; + RootURL: String; + Category: String; + ActiveTaskCount: Integer; + ActiveConnectionCount: Integer; + SortedList: Boolean; + InformationAvailable: Boolean; + FavoriteAvailable: Boolean; + DynamicPageLink: Boolean; + TotalDirectoryPage: array of Integer; + CurrentDirectoryIndex: Integer; + MaxTaskLimit: Integer; + MaxThreadPerTaskLimit: Integer; + MaxConnectionLimit: Integer; + OptionList: array of TWebsiteOptionItem; + OnBeforeUpdateList: TOnBeforeUpdateList; + OnAfterUpdateList: TOnAfterUpdateList; + OnGetDirectoryPageNumber: TOnGetDirectoryPageNumber; + OnGetNameAndLink: TOnGetNameAndLink; + OnGetInfo: TOnGetInfo; + OnTaskStart: TOnTaskStart; + OnGetPageNumber: TOnGetPageNumber; + OnGetImageURL: TOnGetImageURL; + OnBeforeDownloadImage: TOnBeforeDownloadImage; + OnDownloadImage: TOnDownloadImage; + OnSaveImage: TOnSaveImage; + OnAfterImageSaved: TOnAfterImageSaved; + OnLogin: TOnLogin; + constructor Create; + destructor Destroy; override; + public + property ID: Integer read FID; + property TotalDirectory: Integer read FTotalDirectory write SetTotalDirectory; + procedure AddOptionCheckBox(const ABindValue: PBoolean; const AName: String; + const ACaption: PString); + procedure AddOptionEdit(const ABindValue: PString; const AName: String; + const ACaption: PString); + procedure AddOptionSpinEdit(const ABindValue: PInteger; const AName: String; + const ACaption: PString); + procedure AddOptionComboBox(const ABindValue: PInteger; const AName: String; + const ACaption, AItems: PString); + property CloudflareEnabled: Boolean read FCloudflareEnabled write SetCloudflareEnabled; + procedure PrepareHTTP(const AHTTP: THTTPSendThread); + + procedure IncActiveTaskCount; inline; + procedure DecActiveTaskCount; inline; + procedure IncActiveConnectionCount; inline; + procedure DecActiveConnectionCount; inline; + + function GetMaxConnectionLimit: Integer; + function GetMaxTaskLimit: Integer; + function GetMaxThreadPerTaskLimit: Integer; + + property Settings: TWebsiteModuleSettings read FSettings write FSettings; + property AccountSupport: Boolean read FAccountSupport write SetAccountSupport; + property Account: TWebsiteModuleAccount read FAccount write FAccount; + end; + + TModuleContainers = specialize TFPGList; + + { TWebsiteModules } + + TWebsiteModules = class + private + FCSModules: TRTLCriticalSection; + FModuleList: TModuleContainers; + function ModuleExist(const ModuleId: Integer): Boolean; inline; + function GetModule(const ModuleId: Integer): TModuleContainer; + function GetCount: Integer; + function GetMaxTaskLimit(const ModuleId: Integer): Integer; + function GetMaxThreadPerTaskLimit(const ModuleId: Integer): Integer; + function GetMaxConnectionLimit(const ModuleId: Integer): Integer; + function GetActiveTaskCount(const ModuleId: Integer): Integer; + function GetActiveConnectionLimit(const ModuleId: Integer): Integer; + function GetWebsite(const ModuleId: Integer): String; + public + constructor Create; + destructor Destroy; override; + + function AddModule: TModuleContainer; + function LocateModule(const AWebsite: String): Integer; + function LocateModule(const AWebsite: String; var M: TModuleContainer): Integer; + function LocateModuleByHost(const AHost: String): Integer; + function ModuleAvailable(const ModuleId: Integer; + const ModuleMethod: TModuleMethod): Boolean; overload; + function ModuleAvailable(const AWebsite: String; + const ModuleMethod: TModuleMethod): Boolean; overload; + function ModuleAvailable(const AWebsite: String; + const ModuleMethod: TModuleMethod; + var OutIndex: Integer): Boolean; overload; + function ModuleAvailable(const AWebsite: String): Boolean; overload; + function ModuleAvailable(const AWebsite: String; + var OutIndex: Integer): Boolean; overload; + function ModuleAvailable(const AWebsite: String; var M: TModuleContainer): Boolean; overload; + + function BeforeUpdateList(const ModuleId: Integer): Boolean; + function AfterUpdateList(const ModuleId: Integer): Boolean; + function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const ModuleId: Integer): Integer; overload; + function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const AWebsite: String): Integer; overload; inline; + + function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const ModuleId: Integer): Integer; overload; + function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; + const AURL, AWebsite: String): Integer; overload; inline; + + function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const ModuleId: Integer): Integer; overload; + function GetInfo(const MangaInfo: TMangaInformation; + const AURL, AWebsite: String): Integer; overload; inline; + + function TaskStart(const Task: TTaskContainer; + const ModuleId: Integer): Boolean; overload; + function TaskStart(const Task: TTaskContainer; + const AWebsite: String): Boolean; overload; inline; + + function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; overload; + function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; overload; inline; + + function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; overload; + function GetImageURL(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; overload; inline; + + function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const ModuleId: Integer): Boolean; overload; + function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL, AWebsite: String): Boolean; overload; inline; + + function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; overload; + function DownloadImage(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; overload; inline; + + function SaveImage(const AHTTP: THTTPSendThread; + const APath, AName: String; const ModuleId: Integer): String; overload; + function SaveImage(const AHTTP: THTTPSendThread; + const APath, AName, AWebsite: String): String; overload; inline; + + function AfterImageSaved(const AFilename: String; const ModuleId: Integer): Boolean; overload; + function AfterImageSaved(const AFilename, AWebsite: String): Boolean; overload; inline; + + function Login(const AHTTP: THTTPSendThread; const ModuleId: Integer): Boolean; overload; + function Login(const AHTTP: THTTPSendThread; const AWebsite: String): Boolean; overload; inline; + + procedure LockModules; + procedure UnlockModules; + + property Module[const ModuleId: Integer]: TModuleContainer read GetModule; default; + property Count: Integer read GetCount; + property Website[const ModuleId: Integer]: String read GetWebsite; + + property MaxTaskLimit[const ModuleId: Integer]: Integer read GetMaxTaskLimit; + property MaxThreadPerTaskLimit[const ModuleId: Integer]: Integer read GetMaxThreadPerTaskLimit; + property MaxConnectionLimit[const ModuleId: Integer]: Integer read GetMaxConnectionLimit; + property ActiveTaskCount[const ModuleId: Integer]: Integer read GetActiveTaskCount; + property ActiveConnectionCount[const ModuleId: Integer]: Integer read GetActiveConnectionLimit; + procedure IncActiveTaskCount(ModuleId: Integer); + procedure DecActiveTaskCount(ModuleId: Integer); + function CanCreateTask(ModuleId: Integer): Boolean; + procedure IncActiveConnectionCount(ModuleId: Integer); + procedure DecActiveConnectionCount(ModuleId: Integer); + function CanCreateConnection(ModuleId: Integer): Boolean; + + procedure LoadFromFile; + procedure SaveToFile; + end; + +var + Modules: TWebsiteModules; + +procedure doInitialize; +function AddModule: TModuleContainer; + +procedure LockCreateConnection; +procedure UnlockCreateConnection; + +function CleanOptionName(const S: String): String; + + +implementation + +{$I ModuleList.inc} + +var + CS_Connection: TRTLCriticalSection; + +function CleanOptionName(const S: String): String; +const + Alpha = ['A'..'Z', 'a'..'z', '_']; + Num = ['0'..'9']; + AlphaNum = Alpha + Num; +var + i: Integer; +begin + Result := Trim(S); + if Result = '' then Exit; + while (Length(Result) > 0) and (Result[1] in Num) do + Delete(Result, 1, 1); + i := 1; + while i <= Length(Result) do + if not (Result[i] in AlphaNum) then + Delete(Result, i, 1) + else + Inc(i); +end; + +{ TModuleContainer } + +procedure TModuleContainer.SetCloudflareEnabled(AValue: Boolean); +begin + if FCloudflareEnabled = AValue then Exit; + FCloudflareEnabled := AValue; + if FCloudflareEnabled then + FCloudflareCF := TCFProps.Create + else + begin + FCloudflareCF.Free; + FCloudflareCF := nil; + end; +end; + +procedure TModuleContainer.SetAccountSupport(AValue: Boolean); +begin + if FAccountSupport = AValue then Exit; + FAccountSupport := AValue; + if FAccountSupport then + begin + if FAccount = nil then + FAccount := TWebsiteModuleAccount.Create; + end + else + if FAccount<>nil then + FAccount.Free; +end; + +procedure TModuleContainer.CheckCloudflareEnabled(const AHTTP: THTTPSendThread); +begin + if FCloudflareEnabled then + if AHTTP.OnHTTPRequest <> @CloudflareHTTPRequest then + AHTTP.OnHTTPRequest := @CloudflareHTTPRequest; +end; + +function TModuleContainer.CloudflareHTTPRequest(const AHTTP: THTTPSendThread; + const Method, URL: String; const Response: TObject): Boolean; +begin + Result := Cloudflare.CFRequest(AHTTP, Method, URL, Response, FCloudflareCF); +end; + +procedure TModuleContainer.SetTotalDirectory(AValue: Integer); +var + i: Integer; +begin + if FTotalDirectory = AValue then Exit; + FTotalDirectory := AValue; + SetLength(TotalDirectoryPage, FTotalDirectory); + if Length(TotalDirectoryPage) > 0 then + for i := Low(TotalDirectoryPage) to High(TotalDirectoryPage) do + TotalDirectoryPage[i] := 1; +end; + +constructor TModuleContainer.Create; +begin + FSettings := TWebsiteModuleSettings.Create; + FID := -1; + ActiveTaskCount := 0; + ActiveConnectionCount := 0; + AccountSupport := False; + SortedList := False; + InformationAvailable := True; + FavoriteAvailable := True; + DynamicPageLink := False; + TotalDirectory := 1; + CurrentDirectoryIndex := 0; + CloudflareEnabled := True; +end; + +destructor TModuleContainer.Destroy; +begin + SetLength(TotalDirectoryPage, 0); + SetLength(OptionList,0); + if Assigned(FCloudflareCF) then + FCloudflareCF.Free; + if Assigned(FAccount) then + FAccount.Free; + FSettings.Free; + inherited Destroy; +end; + +procedure TModuleContainer.AddOptionCheckBox(const ABindValue: PBoolean; + const AName: String; const ACaption: PString); +begin + AddOption(woCheckBox, ABindValue, AName, ACaption); +end; + +procedure TModuleContainer.AddOptionEdit(const ABindValue: PString; const AName: String; + const ACaption: PString); +begin + AddOption(woEdit, ABindValue, AName, ACaption); +end; + +procedure TModuleContainer.AddOptionSpinEdit(const ABindValue: PInteger; + const AName: String; const ACaption: PString); +begin + AddOption(woSpinEdit, ABindValue, AName, ACaption); +end; + +procedure TModuleContainer.AddOptionComboBox(const ABindValue: PInteger; + const AName: String; const ACaption, AItems: PString); +begin + AddOption(woComboBox, ABindValue, AName, ACaption, AItems); +end; + +procedure TModuleContainer.PrepareHTTP(const AHTTP: THTTPSendThread); +var + s: String; +begin + CheckCloudflareEnabled(AHTTP); + if not Settings.Enabled then Exit; + with Settings.HTTP do + begin + if UserAgent<>'' then + AHTTP.UserAgent:=UserAgent; + if Cookies<>'' then + AHTTP.Cookies.Text:=Cookies; + with Proxy do + begin + s:=''; + case Proxy.ProxyType of + ptDirect:AHTTP.SetNoProxy; + ptHTTP:s:='HTTP'; + ptSOCKS4:s:='SOCKS4'; + ptSOCKS5:s:='SOCKS5'; + end; + if s<>'' then + AHTTP.SetProxy(s,ProxyHost,ProxyPort,ProxyUsername,ProxyPassword); + end; + end; +end; + +procedure TModuleContainer.IncActiveTaskCount; +begin + ActiveTaskCount := InterLockedIncrement(ActiveTaskCount); +end; + +procedure TModuleContainer.DecActiveTaskCount; +begin + ActiveTaskCount := InterLockedDecrement(ActiveTaskCount); +end; + +procedure TModuleContainer.IncActiveConnectionCount; +begin + ActiveConnectionCount := InterLockedIncrement(ActiveConnectionCount); +end; + +procedure TModuleContainer.DecActiveConnectionCount; +begin + ActiveConnectionCount := InterLockedDecrement(ActiveConnectionCount); +end; + +function TModuleContainer.GetMaxConnectionLimit: Integer; +begin + if (Settings.Enabled) and (Settings.MaxConnectionLimit <> 0) then + Result:=Settings.MaxConnectionLimit + else + Result:=MaxConnectionLimit; +end; + +function TModuleContainer.GetMaxTaskLimit: Integer; +begin + if (Settings.Enabled) and (Settings.MaxTaskLimit <> 0) then + Result:=Settings.MaxTaskLimit + else + Result:=MaxTaskLimit; +end; + +function TModuleContainer.GetMaxThreadPerTaskLimit: Integer; +begin + if (Settings.Enabled) and (Settings.MaxThreadPerTaskLimit <> 0) then + Result:=Settings.MaxThreadPerTaskLimit + else + Result:=MaxThreadPerTaskLimit; +end; + +procedure TModuleContainer.AddOption(const AOptionType: TWebsiteOptionType; + const ABindValue: Pointer; const AName: String; const ACaption: PString; + const AItems: PString); +begin + if ABindValue = nil then Exit; + if AName = '' then Exit; + SetLength(OptionList, Length(OptionList) + 1); + with OptionList[High(OptionList)] do + begin + OptionType := AOptionType; + BindValue := ABindValue; + Name := CleanOptionName(AName); + Caption := ACaption; + Items := AItems; + end; +end; + +{ TWebsiteModules } + +constructor TWebsiteModules.Create; +begin + InitCriticalSection(FCSModules); + FModuleList := TModuleContainers.Create; +end; + +destructor TWebsiteModules.Destroy; +var + i: Integer; +begin + if FModuleList.Count > 0 then + for i := FModuleList.Count - 1 downto 0 do + FModuleList[i].Free; + FModuleList.Free; + DoneCriticalsection(FCSModules); + inherited Destroy; +end; + +function TWebsiteModules.AddModule: TModuleContainer; +begin + EnterCriticalsection(FCSModules); + try + Result := TModuleContainer.Create; + Result.FID := FModuleList.Add(Result); + finally + LeaveCriticalsection(FCSModules); + end; +end; + +function TWebsiteModules.LocateModule(const AWebsite: String): Integer; +var + i: Integer; +begin + Result := -1; + if FModuleList.Count > 0 then + for i := FModuleList.Count - 1 downto 0 do + if SameText(FModuleList[i].Website, AWebsite) then + begin + Result := i; + Break; + end; +end; + +function TWebsiteModules.LocateModule(const AWebsite: String; + var M: TModuleContainer): Integer; +begin + Result := LocateModule(AWebsite); + if Result <> -1 then + M := FModuleList[Result]; +end; + +function TWebsiteModules.LocateModuleByHost(const AHost: String): Integer; + + function PosModule(const s: String): Integer; + var + i: Integer; + begin + for i := FModuleList.Count - 1 downto 0 do + if Pos(s, LowerCase(FModuleList[i].RootURL)) <> 0 then + Exit(i); + Result := -1; + end; +var + h: String; +begin + Result := -1; + if FModuleList.Count = 0 then Exit; + h := LowerCase(AHost); + Result := PosModule(h); + if Result = -1 then + begin + SplitURL(h, @h, nil, False, False); + if h = '' then Exit; + Result := PosModule(h); + end; +end; + +function TWebsiteModules.ModuleExist(const ModuleId: Integer): Boolean; +begin + Result := (ModuleId >= 0) and (ModuleId < FModuleList.Count); +end; + +function TWebsiteModules.ModuleAvailable(const ModuleId: Integer; + const ModuleMethod: TModuleMethod): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + case ModuleMethod of + MMGetDirectoryPageNumber: Result := Assigned(OnGetDirectoryPageNumber); + MMGetNameAndLink: Result := Assigned(OnGetNameAndLink); + MMGetInfo: Result := Assigned(OnGetInfo); + MMGetPageNumber: Result := Assigned(OnGetPageNumber); + MMGetImageURL: Result := Assigned(OnGetImageURL); + MMBeforeDownloadImage: Result := Assigned(OnBeforeDownloadImage); + MMDownloadImage: Result := Assigned(OnDownloadImage); + MMAfterImageSaved: Result := Assigned(OnAfterImageSaved); + MMLogin: Result := Assigned(OnLogin); + else + Result := False; + end; +end; + +function TWebsiteModules.ModuleAvailable(const AWebsite: String; + const ModuleMethod: TModuleMethod): Boolean; +begin + Result := ModuleAvailable(LocateModule(AWebsite), ModuleMethod); +end; + +function TWebsiteModules.ModuleAvailable(const AWebsite: String; + const ModuleMethod: TModuleMethod; var OutIndex: Integer): Boolean; +begin + Result := False; + OutIndex := LocateModule(AWebsite); + Result := ModuleAvailable(OutIndex, ModuleMethod); +end; + +function TWebsiteModules.ModuleAvailable(const AWebsite: String): Boolean; +begin + Result := (LocateModule(AWebsite) > -1); +end; + +function TWebsiteModules.ModuleAvailable(const AWebsite: String; + var OutIndex: Integer): Boolean; +begin + OutIndex := LocateModule(AWebsite); + Result := OutIndex > -1; +end; + +function TWebsiteModules.ModuleAvailable(const AWebsite: String; + var M: TModuleContainer): Boolean; +begin + M := GetModule(LocateModule(AWebsite)); + Result := M <> nil; +end; + +function TWebsiteModules.BeforeUpdateList(const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnBeforeUpdateList) then + Result := OnBeforeUpdateList(FModuleList[ModuleId]); +end; + +function TWebsiteModules.AfterUpdateList(const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with TModuleContainer(FModuleList[ModuleId]) do + if Assigned(OnAfterUpdateList) then + Result := OnAfterUpdateList(FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetDirectoryPageNumber( + const MangaInfo: TMangaInformation; var Page: Integer; const WorkPtr: Integer; + const ModuleId: Integer): Integer; +begin + Page := 1; + Result := MODULE_NOT_FOUND; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnGetDirectoryPageNumber) then + Result := OnGetDirectoryPageNumber(MangaInfo, Page, WorkPtr, FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetDirectoryPageNumber( + const MangaInfo: TMangaInformation; var Page: Integer; const WorkPtr: Integer; + const AWebsite: String): Integer; +begin + Result := GetDirectoryPageNumber(MangaInfo, Page, WorkPtr, LocateModule(AWebsite)); +end; + +function TWebsiteModules.GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; const ModuleId: Integer + ): Integer; +begin + Result := MODULE_NOT_FOUND; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnGetNameAndLink) then + Result := OnGetNameAndLink(MangaInfo, ANames, ALinks, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL, AWebsite: String): Integer; +begin + Result := GetNameAndLink(MangaInfo, ANames, ALinks, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const ModuleId: Integer): Integer; +begin + Result := MODULE_NOT_FOUND; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnGetInfo) then + Result := OnGetInfo(MangaInfo, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetInfo(const MangaInfo: TMangaInformation; + const AURL, AWebsite: String): Integer; +begin + Result := GetInfo(MangaInfo, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.TaskStart(const Task: TTaskContainer; + const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnTaskStart) then + Result := FModuleList[ModuleId].OnTaskStart( + Task, FModuleList[ModuleId]); +end; + +function TWebsiteModules.TaskStart(const Task: TTaskContainer; + const AWebsite: String): Boolean; +begin + Result := TaskStart(Task, LocateModule(AWebsite)); +end; + +function TWebsiteModules.GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnGetPageNumber) then + Result := OnGetPageNumber(DownloadThread, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetPageNumber(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; +begin + Result := GetPageNumber(DownloadThread, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnGetImageURL) then + Result := OnGetImageURL(DownloadThread, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.GetImageURL(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; +begin + Result := GetImageURL(DownloadThread, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.BeforeDownloadImage( + const DownloadThread: TDownloadThread; var AURL: String; + const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnBeforeDownloadImage) then + Result := OnBeforeDownloadImage(DownloadThread, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.BeforeDownloadImage( + const DownloadThread: TDownloadThread; var AURL, AWebsite: String): Boolean; +begin + Result := BeforeDownloadImage(DownloadThread, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnDownloadImage) then + Result := OnDownloadImage(DownloadThread, AURL, FModuleList[ModuleId]); +end; + +function TWebsiteModules.DownloadImage(const DownloadThread: TDownloadThread; + const AURL, AWebsite: String): Boolean; +begin + Result := DownloadImage(DownloadThread, AURL, LocateModule(AWebsite)); +end; + +function TWebsiteModules.SaveImage(const AHTTP: THTTPSendThread; + const APath, AName: String; const ModuleId: Integer): String; +begin + Result := ''; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnSaveImage) then + Result := OnSaveImage(AHTTP, APath, AName, FModuleList[ModuleId]); +end; + +function TWebsiteModules.SaveImage(const AHTTP: THTTPSendThread; + const APath, AName, AWebsite: String): String; +begin + Result := SaveImage(AHTTP, APath, AName, LocateModule(AWebsite)); +end; + +function TWebsiteModules.AfterImageSaved(const AFilename: String; + const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnAfterImageSaved) then + Result := OnAfterImageSaved(AFilename, FModuleList[ModuleId]); +end; + +function TWebsiteModules.AfterImageSaved(const AFilename, AWebsite: String + ): Boolean; +begin + Result := AfterImageSaved(AFilename, LocateModule(AWebsite)); +end; + +function TWebsiteModules.Login(const AHTTP: THTTPSendThread; + const ModuleId: Integer): Boolean; +begin + Result := False; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if Assigned(OnLogin) then + Result := OnLogin(AHTTP, FModuleList[ModuleId]); +end; + +function TWebsiteModules.Login(const AHTTP: THTTPSendThread; + const AWebsite: String): Boolean; +begin + Result := Login(AHTTP, LocateModule(AWebsite)); +end; + +procedure TWebsiteModules.LockModules; +begin + EnterCriticalsection(FCSModules); +end; + +procedure TWebsiteModules.UnlockModules; +begin + LeaveCriticalsection(FCSModules); +end; + +procedure TWebsiteModules.IncActiveTaskCount(ModuleId: Integer); +begin + if ModuleExist(ModuleId) then + FModuleList[ModuleId].IncActiveTaskCount; +end; + +procedure TWebsiteModules.DecActiveTaskCount(ModuleId: Integer); +begin + if ModuleExist(ModuleId) then + FModuleList[ModuleId].DecActiveTaskCount; +end; + +function TWebsiteModules.CanCreateTask(ModuleId: Integer): Boolean; +begin + Result := True; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if GetMaxTaskLimit > 0 then + Result := ActiveTaskCount < GetMaxTaskLimit; +end; + +procedure TWebsiteModules.IncActiveConnectionCount(ModuleId: Integer); +begin + if ModuleExist(ModuleId) then + FModuleList[ModuleId].IncActiveConnectionCount; +end; + +procedure TWebsiteModules.DecActiveConnectionCount(ModuleId: Integer); +begin + if ModuleExist(ModuleId) then + FModuleList[ModuleId].DecActiveConnectionCount; +end; + +function TWebsiteModules.CanCreateConnection(ModuleId: Integer): Boolean; +begin + Result := True; + if ModuleExist(ModuleId) then + with FModuleList[ModuleId] do + if GetMaxConnectionLimit > 0 then + Result := ActiveConnectionCount < GetMaxConnectionLimit; +end; + +procedure TWebsiteModules.LoadFromFile; +var + i, j, k: Integer; + jd: TJSONDeStreamer; + ja: TJSONArray; + fs: TFileStream; + jp: TJSONParser; + jo, jo2: TJSONObject; +begin + if FModuleList.Count=0 then Exit; + if not FileExists(MODULES_FILE) then Exit; + + ja:=nil; + try + fs:=TFileStream.Create(MODULES_FILE,fmOpenRead or fmShareDenyWrite); + try + jp:=TJSONParser.Create(fs,[joUTF8]); + ja:=TJSONArray(jp.Parse); + finally + jp.Free; + end; + finally + fs.Free; + end; + + if (ja<>nil) and (ja.Count<>0) then + try + jd:=TJSONDeStreamer.Create(nil); + for i:=FModuleList.Count-1 downto 0 do + with FModuleList[i] do + begin + jo:=nil; + for j:=ja.Count-1 downto 0 do + if ja.Objects[j].Get('Website','')=Website then + begin + jo:=ja.Objects[j]; + Break; + end; + if jo<>nil then + begin + jo2:=jo.Get('Settings',TJSONObject(nil)); + if jo2<>nil then + jd.JSONToObject(jo2,Settings); + if Length(OptionList)<>0 then + begin + jo2:=jo.Get('Options',TJSONObject(nil)); + if jo2<>nil then + for k:=Low(OptionList) to High(OptionList) do + with OptionList[k],jo2 do + case OptionType of + woCheckBox:PBoolean(BindValue)^:=Get(Name,PBoolean(BindValue)^); + woEdit:PString(BindValue)^:=Get(Name,PString(BindValue)^); + woSpinEdit,woComboBox:PInteger(BindValue)^:=Get(Name,PInteger(BindValue)^); + end; + end; + if Account<>nil then + begin + jo2:=jo.Get('Account',TJSONObject(nil)); + if jo2<>nil then + jd.JSONToObject(jo2,Account); + end; + ja.Delete(j); + end; + end; + finally + jd.Free; + ja.Free; + end; +end; + +procedure TWebsiteModules.SaveToFile; +var + i, j: Integer; + js: TJSONStreamer; + ja: TJSONArray; + fs: TFileStream; + jo: TJSONObject; + jo2: TJSONObject; +begin + if FModuleList.Count=0 then Exit; + ja:=TJSONArray.Create; + js:=TJSONStreamer.Create(nil); + try + for i:=0 to FModuleList.Count-1 do + with FModuleList[i] do + begin + jo:=TJSONObject.Create; + ja.Add(jo); + jo.Add('Website',Website); + jo.Add('Settings',js.ObjectToJSON(Settings)); + if Length(OptionList) <> 0 then + begin + jo2:=TJSONObject.Create; + jo.Add('Options',jo2); + for j:=Low(OptionList) to High(OptionList) do + with OptionList[j],jo2 do + case OptionType of + woCheckBox:Add(Name,PBoolean(BindValue)^); + woEdit:Add(Name,PString(BindValue)^); + woSpinEdit,woComboBox:Add(Name,PInteger(BindValue)^); + end; + end; + if Account<>nil then + jo.Add('Account',js.ObjectToJSON(Account)); + end; + fs:=TFileStream.Create(MODULES_FILE,fmCreate); + try + ja.DumpJSON(fs); + finally + fs.Free; + end; + finally + ja.Free; + js.Free; + end; +end; + +function TWebsiteModules.GetModule(const ModuleId: Integer): TModuleContainer; +begin + if (ModuleId < 0) or (ModuleId >= FModuleList.Count) then Exit(nil); + Result := FModuleList[ModuleId]; +end; + +function TWebsiteModules.GetCount: Integer; +begin + Result := FModuleList.Count; +end; + +function TWebsiteModules.GetMaxTaskLimit(const ModuleId: Integer): Integer; +begin + if not ModuleExist(ModuleId) then Exit(0); + Result := FModuleList[ModuleId].GetMaxTaskLimit; +end; + +function TWebsiteModules.GetMaxThreadPerTaskLimit(const ModuleId: Integer + ): Integer; +begin + if not ModuleExist(ModuleId) then Exit(0); + Result := FModuleList[ModuleId].Settings.MaxThreadPerTaskLimit; +end; + +function TWebsiteModules.GetMaxConnectionLimit(const ModuleId: Integer): Integer; +begin + if not ModuleExist(ModuleId) then Exit(0); + Result := FModuleList[ModuleId].GetMaxConnectionLimit; +end; + +function TWebsiteModules.GetActiveTaskCount(const ModuleId: Integer): Integer; +begin + if not ModuleExist(ModuleId) then Exit(0); + Result := FModuleList[ModuleId].ActiveTaskCount; +end; + +function TWebsiteModules.GetActiveConnectionLimit(const ModuleId: Integer): Integer; +begin + if not ModuleExist(ModuleId) then Exit(0); + Result := FModuleList[ModuleId].ActiveConnectionCount; +end; + +function TWebsiteModules.GetWebsite(const ModuleId: Integer): String; +begin + if not ModuleExist(ModuleId) then Exit(''); + Result := FModuleList[ModuleId].Website; +end; + +procedure doInitialize; +begin + if Modules = nil then + Modules := TWebsiteModules.Create; +end; + +function AddModule: TModuleContainer; +begin + if Modules = nil then + doInitialize; + Result := Modules.AddModule; +end; + +procedure LockCreateConnection; +begin + EnterCriticalsection(CS_Connection); +end; + +procedure UnlockCreateConnection; +begin + LeaveCriticalsection(CS_Connection); +end; + +initialization + InitCriticalSection(CS_Connection); + doInitialize; + +finalization + if Assigned(Modules) then + FreeAndNil(Modules); + DoneCriticalsection(CS_Connection); + +end. diff --git a/baseunits/WebsiteModulesSettings.pas b/baseunits/WebsiteModulesSettings.pas new file mode 100644 index 000000000..1c84a0654 --- /dev/null +++ b/baseunits/WebsiteModulesSettings.pas @@ -0,0 +1,99 @@ +unit WebsiteModulesSettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + TProxyType = (ptDefault, ptDirect, ptHTTP, ptSOCKS4, ptSOCKS5); + + { TProxySettings } + + TProxySettings = class + private + FProxyHost: String; + FProxyPassword: String; + FProxyPort: String; + FProxyType: TProxyType; + FProxyUsername: String; + published + property ProxyType: TProxyType read FProxyType write FProxyType default ptDefault; + property ProxyHost: String read FProxyHost write FProxyHost; + property ProxyPort: String read FProxyPort write FProxyPort; + property ProxyUsername: String read FProxyUsername write FProxyUsername; + property ProxyPassword: String read FProxyPassword write FProxyPassword; + end; + + { THTTPSettings } + + THTTPSettings = class + private + FCookies: String; + FProxy: TProxySettings; + FUserAgent: String; + public + constructor Create; + destructor Destroy; override; + published + property Cookies: String read FCookies write FCookies; + property UserAgent: String read FUserAgent write FUserAgent; + property Proxy: TProxySettings read FProxy write FProxy; + end; + + { TWebsiteModuleSettings } + + TWebsiteModuleSettings = class + private + FEnabled: Boolean; + FHTTP: THTTPSettings; + FMaxConnectionLimit: Integer; + FMaxTaskLimit: Integer; + FMaxThreadPerTaskLimit: Integer; + FUpdateListDirectoryPageNumber: Integer; + FUpdateListNumberOfThread: Integer; + public + constructor Create; + destructor Destroy; override; + published + property Enabled: Boolean read FEnabled write FEnabled default False; + property MaxTaskLimit: Integer read FMaxTaskLimit write FMaxTaskLimit default 0; + property MaxThreadPerTaskLimit: Integer read FMaxThreadPerTaskLimit write FMaxThreadPerTaskLimit default 0; + property MaxConnectionLimit: Integer read FMaxConnectionLimit write FMaxConnectionLimit default 0; + property UpdateListNumberOfThread: Integer read FUpdateListNumberOfThread write FUpdateListNumberOfThread default 0; + property UpdateListDirectoryPageNumber: Integer read FUpdateListDirectoryPageNumber write FUpdateListDirectoryPageNumber default 0; + property HTTP: THTTPSettings read FHTTP write FHTTP; + end; + +implementation + +{ THTTPSettings } + +constructor THTTPSettings.Create; +begin + Proxy:=TProxySettings.Create; +end; + +destructor THTTPSettings.Destroy; +begin + Proxy.Free; + inherited Destroy; +end; + +{ TWebsiteModuleSettings } + +constructor TWebsiteModuleSettings.Create; +begin + HTTP:=THTTPSettings.Create; +end; + +destructor TWebsiteModuleSettings.Destroy; +begin + HTTP.Free; + inherited Destroy; +end; + +end. + diff --git a/baseunits/XQueryEngineHTML.pas b/baseunits/XQueryEngineHTML.pas new file mode 100644 index 000000000..27d4a802d --- /dev/null +++ b/baseunits/XQueryEngineHTML.pas @@ -0,0 +1,441 @@ +unit XQueryEngineHTML; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, xquery, xquery_json, simplehtmltreeparser; + +type + + { TXQueryEngineHTML } + + TXQueryEngineHTML = class + private + FEngine: TXQueryEngine; + FTreeParser: TTreeParser; + function Eval(const Expression: String; const isCSS: Boolean = False; + const ContextItem: IXQValue = nil; const Tree: TTreeNode = nil): IXQValue; + function EvalString(const Expression: String; const isCSS: Boolean = False; + const ContextItem: IXQValue = nil; const Tree: TTreeNode = nil): String; inline; + function EvalCount(const Expression: String; const isCSS: Boolean = False; + const ContextItem: IXQValue = nil; const Tree: TTreeNode = nil): Integer; inline; + function EvalStringAll(const Expression: String; const isCSS: Boolean; + const Separator: String = ', '; const ContextItem: IXQValue = nil): String; overload; + function EvalStringAll(const Expression: String; const isCSS: Boolean; + const Exc: array of String; const Separator: String = ', '; + const ContextItem: IXQValue = nil): String; overload; + procedure EvalStringAll(const Expression: String; const isCSS: Boolean; + const TheStrings: TStrings; ContextItem: IXQValue = nil); overload; + public + constructor Create(const HTML: String = ''); overload; + constructor Create(const HTMLStream: TStream); overload; + destructor Destroy; override; + procedure ParseHTML(const HTML: String); overload; + procedure ParseHTML(const HTMLStream: TStream); overload; + // xpath + function XPath(const Expression: String; const Tree: TTreeNode = nil): IXQValue; inline; + function XPath(const Expression: String; const ContextItem: IXQValue): IXQValue; inline; + function XPathString(const Expression: String; const Tree: TTreeNode = nil): String; inline; + function XPathString(const Expression: String; const ContextItem: IXQValue): String; inline; + function XPathCount(const Expression: String; const Tree: TTreeNode = nil): Integer; inline; + function XPathCount(const Expression: String; const ContextItem: IXQValue): Integer; inline; + function XPathStringAll(const Expression: String; const Separator: String = ', '; + const ContextItem: IXQValue = nil): String; overload; inline; + function XPathStringAll(const Expression: String; const Exc: array of String; + const Separator: String = ', '; const ContextItem: IXQValue = nil): String; overload; inline; + procedure XPathStringAll(const Expression: String; const TheStrings: TStrings; + const ContextItem: IXQValue = nil); overload; inline; + procedure XPathHREFAll(const Expression: String; const ALinks, ATexts: TStrings; + const ContextItem: IXQValue = nil); + procedure XPathHREFtitleAll(const Expression: String; const ALinks, ATitles: TStrings; + const ContextItem: IXQValue = nil); + // css + function CSS(const Expression: String; const Tree: TTreeNode = nil): IXQValue; inline; + function CSS(const Expression: String; const ContextItem: IXQValue): IXQValue; inline; + function CSSString(const Expression: String; const Tree: TTreeNode = nil): String; inline; + function CSSString(const Expression: String; const ContextItem: IXQValue): String; inline; + function CSSStringAll(const Expression: String; const Separator: String = ', '; + const ContextItem: IXQValue = nil): String; overload; inline; + function CSSStringAll(const Expression: String; const Exc: array of String; + const Separator: String = ', '; const ContextItem: IXQValue = nil): String; overload; inline; + procedure CSSStringAll(const Expression: String; const TheStrings: TStrings; + const ContextItem: IXQValue = nil); overload; inline; + + property Engine: TXQueryEngine read FEngine; + property TreeParser: TTreeParser read FTreeParser; + end; + + IXQValue = xquery.IXQValue; + TTreeNode = simplehtmltreeparser.TTreeNode; + +function XPathString(const Expression, HTMLString: String): String; overload; +function XPathString(const Expression: String; const HTMLStream: TStream): String; overload; inline; +function XPathCount(const Expression: String; const HTMLString: String): Integer; overload; +function XPathCount(const Expression: String; const HTMLStream: TStream): Integer; overload; inline; +procedure XPathStringAll(const Expression: String; const HTMLString: String; const TheStrings: TStrings); overload; +procedure XPathStringAll(const Expression: String; const HTMLStream: TStream; const TheStrings: TStrings); overload; inline; +procedure XPathHREFAll(const Expression: String; const HTMLString: String; const ALinks, ATexts: TStrings); overload; +procedure XPathHREFAll(const Expression: String; const HTMLStream: TStream; const ALinks, ATexts: TStrings); overload; inline; +procedure XPathHREFtitleAll(const Expression: String; const HTMLString: String; const ALinks, ATitles: TStrings); overload; +procedure XPathHREFtitleAll(const Expression: String; const HTMLStream: TStream; const ALinks, ATitles: TStrings); overload; inline; + +implementation + +function StreamToString(const Stream: TStream): String; +var + p, x: Int64; +begin + p := Stream.Position; + Stream.Position := 0; + Setlength(Result, Stream.Size); + x := Stream.Read(PChar(Result)^, Stream.Size); + SetLength(Result, x); + Stream.Position := p; +end; + +procedure AddSeparatorString(var Dest: String; const S: String; const Separator: String = ', '); +begin + if Trim(S) <> '' then + if Trim(Dest) = '' then + Dest := Trim(S) + else + Dest := Trim(Dest) + Separator + Trim(S); +end; + +function StringInArray(const S: String; const SS: array of String): Boolean; +var + i: Integer; +begin + Result := True; + if Length(SS) > 0 then + for i := Low(SS) to High(SS) do + if SameText(S, SS[i]) then + Exit; + Result := False; +end; + +function XPathString(const Expression, HTMLString: String): String; +begin + Result := ''; + with TXQueryEngineHTML.Create(HTMLString) do + try + Result := XPathString(Expression); + finally + Free; + end; +end; + +function XPathString(const Expression: String; const HTMLStream: TStream): String; +begin + Result := XPathString(Expression, StreamToString(HTMLStream)); +end; + +function XPathCount(const Expression: String; const HTMLString: String): Integer; +begin + Result := 0; + with TXQueryEngineHTML.Create(HTMLString) do + try + Result := XPathCount(Expression); + finally + Free; + end; +end; + +function XPathCount(const Expression: String; const HTMLStream: TStream): Integer; +begin + Result := XPathCount(Expression, StreamToString(HTMLStream)); +end; + +procedure XPathStringAll(const Expression: String; const HTMLString: String; + const TheStrings: TStrings); +begin + with TXQueryEngineHTML.Create(HTMLString) do + try + XPathStringAll(Expression, TheStrings); + finally + Free; + end; +end; + +procedure XPathStringAll(const Expression: String; const HTMLStream: TStream; + const TheStrings: TStrings); +begin + XPathStringAll(Expression, StreamToString(HTMLStream), TheStrings); +end; + +procedure XPathHREFAll(const Expression: String; const HTMLString: String; + const ALinks, ATexts: TStrings); +begin + with TXQueryEngineHTML.Create(HTMLString) do + try + XPathHREFAll(Expression, ALinks, ATexts); + finally + Free; + end; +end; + +procedure XPathHREFAll(const Expression: String; const HTMLStream: TStream; + const ALinks, ATexts: TStrings); +begin + XPathHREFAll(Expression, StreamToString(HTMLStream), ALinks, ATexts); +end; + +procedure XPathHREFtitleAll(const Expression: String; const HTMLString: String; + const ALinks, ATitles: TStrings); +begin + with TXQueryEngineHTML.Create(HTMLString) do + try + XPathHREFtitleAll(Expression, ALinks, ATitles); + finally + Free; + end; +end; + +procedure XPathHREFtitleAll(const Expression: String; + const HTMLStream: TStream; const ALinks, ATitles: TStrings); +begin + XPathHREFtitleAll(Expression, StreamToString(HTMLStream), ALinks, ATitles); +end; + +{ TXQueryEngineHTML } + +function TXQueryEngineHTML.Eval(const Expression: String; const isCSS: Boolean; + const ContextItem: IXQValue; const Tree: TTreeNode): IXQValue; +begin + Result := xqvalue(); + try + if Assigned(ContextItem) then + begin + if isCSS then + Result := FEngine.evaluateCSS3(Expression, ContextItem) + else + Result := FEngine.evaluateXPath3(Expression, ContextItem); + end + else if Assigned(Tree) then + begin + if isCSS then + Result := FEngine.evaluateCSS3(Expression, Tree) + else + Result := FEngine.evaluateXPath3(Expression, Tree); + end + else + begin + if isCSS then + Result := FEngine.evaluateCSS3(Expression, FTreeParser.getLastTree) + else + Result := FEngine.evaluateXPath3(Expression, FTreeParser.getLastTree); + end; + except + end; +end; + +function TXQueryEngineHTML.EvalString(const Expression: String; + const isCSS: Boolean; const ContextItem: IXQValue; const Tree: TTreeNode + ): String; +begin + Result := Eval(Expression, isCSS, ContextItem, Tree).toString; +end; + +function TXQueryEngineHTML.EvalCount(const Expression: String; + const isCSS: Boolean; const ContextItem: IXQValue; const Tree: TTreeNode + ): Integer; +begin + Result := Eval(Expression, isCSS, ContextItem, Tree).Count; +end; + +function TXQueryEngineHTML.EvalStringAll(const Expression: String; const isCSS: Boolean; + const Separator: String; const ContextItem: IXQValue): String; +var + v: IXQValue; +begin + Result := ''; + for v in Eval(Expression, isCSS, ContextItem) do + AddSeparatorString(Result, v.toString, Separator); +end; + +function TXQueryEngineHTML.EvalStringAll(const Expression: String; const isCSS: Boolean; + const Exc: array of String; const Separator: String; const ContextItem: IXQValue + ): String; +var + v: IXQValue; +begin + Result := ''; + for v in Eval(Expression, isCSS, ContextItem) do + if not StringInArray(Trim(v.toString), Exc) then + AddSeparatorString(Result, v.toString, Separator); +end; + +procedure TXQueryEngineHTML.EvalStringAll(const Expression: String; const isCSS: Boolean; + const TheStrings: TStrings; ContextItem: IXQValue); +var + v: IXQValue; +begin + for v in Eval(Expression, isCSS, ContextItem) do + TheStrings.Add(Trim(v.toString)); +end; + +constructor TXQueryEngineHTML.Create(const HTML: String); +begin + FEngine := TXQueryEngine.Create; + FTreeParser := TTreeParser.Create; + with FTreeParser do + begin + parsingModel := pmHTML; + repairMissingStartTags := True; + repairMissingEndTags := True; + trimText := False; + readComments := False; + readProcessingInstructions := False; + autoDetectHTMLEncoding := False; + if HTML <> '' then + parseTree(HTML); + end; +end; + +constructor TXQueryEngineHTML.Create(const HTMLStream: TStream); +begin + if Assigned(HTMLStream) then + Create(StreamToString(HTMLStream)) + else + Create(''); +end; + +destructor TXQueryEngineHTML.Destroy; +begin + FEngine.Free; + FTreeParser.Free; + inherited Destroy; +end; + +procedure TXQueryEngineHTML.ParseHTML(const HTML: String); +begin + if HTML <> '' then + FTreeParser.parseTree(HTML); +end; + +procedure TXQueryEngineHTML.ParseHTML(const HTMLStream: TStream); +begin + ParseHTML(StreamToString(HTMLStream)); +end; + +function TXQueryEngineHTML.XPath(const Expression: String; const Tree: TTreeNode): IXQValue; +begin + Result := Eval(Expression, False, nil, Tree); +end; + +function TXQueryEngineHTML.XPath(const Expression: String; const ContextItem: IXQValue + ): IXQValue; +begin + Result := Eval(Expression, False, ContextItem); +end; + +function TXQueryEngineHTML.XPathString(const Expression: String; const Tree: TTreeNode): String; +begin + Result := EvalString(Expression, False, nil, Tree); +end; + +function TXQueryEngineHTML.XPathString(const Expression: String; + const ContextItem: IXQValue): String; +begin + Result := EvalString(Expression, False, ContextItem); +end; + +function TXQueryEngineHTML.XPathCount(const Expression: String; + const Tree: TTreeNode): Integer; +begin + Result := EvalCount(Expression, False, nil, Tree); +end; + +function TXQueryEngineHTML.XPathCount(const Expression: String; + const ContextItem: IXQValue): Integer; +begin + Result := EvalCount(Expression, False, ContextItem); +end; + +function TXQueryEngineHTML.XPathStringAll(const Expression: String; + const Separator: String; const ContextItem: IXQValue): String; +begin + Result := EvalStringAll(Expression, False, Separator, ContextItem); +end; + +function TXQueryEngineHTML.XPathStringAll(const Expression: String; + const Exc: array of String; const Separator: String; const ContextItem: IXQValue + ): String; +begin + Result := EvalStringAll(Expression, False, Exc, Separator, ContextItem); +end; + +procedure TXQueryEngineHTML.XPathStringAll(const Expression: String; + const TheStrings: TStrings; const ContextItem: IXQValue); +begin + EvalStringAll(Expression, False, TheStrings, ContextItem); +end; + +procedure TXQueryEngineHTML.XPathHREFAll(const Expression: String; + const ALinks, ATexts: TStrings; const ContextItem: IXQValue); +var + v: IXQValue; +begin + for v in Eval(Expression, False, ContextItem) do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ATexts.Add(Trim(v.toString)); + end; +end; + +procedure TXQueryEngineHTML.XPathHREFtitleAll(const Expression: String; + const ALinks, ATitles: TStrings; const ContextItem: IXQValue); +var + v: IXQValue; +begin + for v in Eval(Expression, False, ContextItem) do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ATitles.Add(v.toNode.getAttribute('title')); + end; +end; + +function TXQueryEngineHTML.CSS(const Expression: String; const Tree: TTreeNode): IXQValue; +begin + Result := Eval(Expression, True, nil, Tree); +end; + +function TXQueryEngineHTML.CSS(const Expression: String; const ContextItem: IXQValue + ): IXQValue; +begin + Result := Eval(Expression, True, ContextItem); +end; + +function TXQueryEngineHTML.CSSString(const Expression: String; const Tree: TTreeNode): String; +begin + Result := EvalString(Expression, True, nil, Tree); +end; + +function TXQueryEngineHTML.CSSString(const Expression: String; + const ContextItem: IXQValue): String; +begin + Result := EvalString(Expression, True, ContextItem); +end; + +function TXQueryEngineHTML.CSSStringAll(const Expression: String; + const Separator: String; const ContextItem: IXQValue): String; +begin + Result := EvalStringAll(Expression, True, Separator, ContextItem); +end; + +function TXQueryEngineHTML.CSSStringAll(const Expression: String; + const Exc: array of String; const Separator: String; const ContextItem: IXQValue + ): String; +begin + Result := EvalStringAll(Expression, True, Exc, Separator, ContextItem); +end; + +procedure TXQueryEngineHTML.CSSStringAll(const Expression: String; + const TheStrings: TStrings; const ContextItem: IXQValue); +begin + EvalStringAll(Expression, True, TheStrings, ContextItem); +end; + +end. diff --git a/baseunits/animatedgifs/animatedgif.pas b/baseunits/animatedgifs/animatedgif.pas index 7864b4097..7969df351 100644 --- a/baseunits/animatedgifs/animatedgif.pas +++ b/baseunits/animatedgifs/animatedgif.pas @@ -1,1163 +1,1163 @@ -unit AnimatedGif; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Graphics, FPImage, MemBitmap; - -type - TDisposeMode = (dmNone, dmKeep, dmErase, dmRestore); - TGifSubImage = record - Image: TMemBitmap; - Position: TPoint; - Delay: integer; - disposeMode: TDisposeMode; - TransparentColor: TMemPixel; - end; - TGifSubImageArray = array of TGifSubImage; - - TGifBackgroundMode = (gbmSimplePaint, gbmEraseBackground, gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously); - - { TAnimatedGif } - - TAnimatedGif = class(TGraphic) - private - FWidth,FHeight: integer; - FBackgroundColor: TColor; - - FPrevDate: TDateTime; - FPaused: boolean; - FTimeAccumulator: double; - FCurrentImage, FWantedImage: integer; - FPreviousDisposeMode : TDisposeMode; - - FBackgroundImage, FPreviousVirtualScreen, - FStretchedVirtualScreen, FInternalVirtualScreen, FRestoreImage: TMemBitmap; - FImageChanged: boolean; - - function GetCount: integer; - procedure Render(StretchWidth,StretchHeight: integer); - procedure UpdateSimple(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); - procedure UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); - procedure Init; - function GetBitmap: TBitmap; - function GetMemBitmap: TMemBitmap; - procedure SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); - procedure SetCurrentImage(Index: integer); - - protected - FImages: TGifSubImageArray; - procedure LoadImages(stream: TStream); - - {TGraphic} - procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; - function GetEmpty: Boolean; override; - function GetHeight: Integer; override; - function GetTransparent: Boolean; override; - function GetWidth: Integer; override; - procedure SetHeight(Value: Integer); override; - procedure SetTransparent(Value: Boolean); override; - procedure SetWidth(Value: Integer); override; - - public - EraseColor: TColor; - BackgroundMode: TGifBackgroundMode; - - constructor Create(filename: string); - constructor Create(stream: TStream); - constructor Create; override; - function Duplicate: TAnimatedGif; - - {TGraphic} - procedure LoadFromStream(Stream: TStream); override; - procedure SaveToStream(Stream: TStream); override; - class function GetFileExtensions: string; override; - - procedure Clear; override; - destructor Destroy; override; - procedure Pause; - procedure Resume; - - procedure Show(Canvas: TCanvas; ARect: TRect); overload; - procedure Update(Canvas: TCanvas; ARect: TRect); overload; - procedure Hide(Canvas: TCanvas; ARect: TRect); overload; - - property BackgroundColor : TColor read FBackgroundColor; - property Count: Integer read GetCount; - property Width: integer read FWidth; - property Height: integer read FHeight; - property Paused: Boolean read FPaused; - property Bitmap: TBitmap read GetBitmap; - property MemBitmap: TMemBitmap read GetMemBitmap; - property CurrentImage: integer read FCurrentImage write SetCurrentImage; - end; - - { TFPReaderGIF } - - TFPReaderGIF = class (TFPCustomImageReader) - protected - procedure InternalRead (Str:TStream; Img:TFPCustomImage); override; - function InternalCheck (Str:TStream) : boolean; override; - end; - -const - GifBackgroundModeStr : array[TGifBackgroundMode] of string = - ('gbmSimplePaint', 'gbmEraseBackground', 'gbmSaveBackgroundOnce', 'gbmUpdateBackgroundContinuously'); - -implementation - -Const AlphaMask = $FF000000; - -TYPE TGIFSignature=packed array[1..6] of char; - - TGIFScreenDescriptor=packed RECORD - width,height:word; - flags,background,map:byte; - END; - - TGIFImageDescriptor=packed RECORD - x,y,width,height:word; - flags:byte; - END; - - TGIFExtensionBlock=packed RECORD - functioncode:byte; - END; - - TGIFGraphicControlExtension=packed RECORD - flags:byte; - delaytime:word; - transcolor:byte; - END; - -{ TAnimatedGif } - -class function TAnimatedGif.GetFileExtensions: string; -begin - Result := 'gif'; -end; - -procedure TAnimatedGif.Render(StretchWidth,StretchHeight: integer); -var curDate: TDateTime; - previousImage, nextImage: integer; - -begin - if FInternalVirtualScreen = nil then - begin - FInternalVirtualScreen := TMemBitmap.Create(FWidth,FHeight); - if Count = 0 then FInternalVirtualScreen.Fill(BackgroundColor) else FInternalVirtualScreen.Fill(MemPixelTransparent); - FImageChanged := true; - end; - - if Count = 0 then exit; - - previousImage := FCurrentImage; - - curDate := Now; - if FWantedImage <> - 1 then - begin - nextImage := FWantedImage; - FTimeAccumulator:= 0; - FWantedImage := -1; - end else - if FCurrentImage = -1 then - begin - nextImage := 0; - FTimeAccumulator := 0; - FPreviousDisposeMode := dmNone; - end else - begin - if not FPaused then FTimeAccumulator += (curDate-FPrevDate)*24*60*60*1000; - nextImage := FCurrentImage; - while FTimeAccumulator> FImages[nextImage].Delay do - begin - FTimeAccumulator -= FImages[nextImage].Delay; - inc(nextImage); - if nextImage >= Count then nextImage := 0; - - if nextImage = previousImage then - begin - inc(nextImage); - if nextImage >= Count then nextImage := 0; - break; - end; - end; - end; - FPrevDate := curDate; - - while FCurrentImage<>nextImage do - begin - inc(FCurrentImage); - if FCurrentImage >= Count then - begin - FCurrentImage := 0; - FPreviousDisposeMode := dmErase; - end; - - case FPreviousDisposeMode of - dmErase: FInternalVirtualScreen.Fill(MemPixelTransparent); - dmRestore: if FRestoreImage <> nil then FInternalVirtualScreen.PutImage(0,0,FRestoreImage,dmSet); - end; - - with FImages[FCurrentImage] do - begin - If disposeMode = dmRestore then - begin - if FRestoreImage = nil then FRestoreImage := TMemBitmap.Create(FWidth,FHeight); - FRestoreImage.PutImage(0,0,FInternalVirtualScreen,dmSet); - end; - - if Image <> nil then - FInternalVirtualScreen.PutImage(Position.X,Position.Y,Image,dmSetExceptTransparent); - FPreviousDisposeMode := disposeMode; - end; - - FImageChanged := true; - previousImage := FCurrentImage; - FInternalVirtualScreen.InvalidateBitmap; - end; - - if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; - if (FInternalVirtualScreen.Width = StretchWidth) and (FInternalVirtualScreen.Height = StretchHeight) then - FStretchedVirtualScreen := FInternalVirtualScreen.NewReference else - FStretchedVirtualScreen := FInternalVirtualScreen.Resample(StretchWidth,StretchHeight); -end; - -procedure TAnimatedGif.UpdateSimple(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); -begin - if FPreviousVirtualScreen <> nil then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end; - - Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - if FImageChanged then - begin - FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FImageChanged := false; - end else - if not DrawOnlyIfChanged then FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - - FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; -end; - -function TAnimatedGif.GetCount: integer; -begin - result := length(FImages); -end; - -constructor TAnimatedGif.Create(filename: string); -var Stream: TFileStream; -begin - inherited Create; - Init; - Stream := TFileStream.Create(filename,fmOpenRead); - LoadFromStream(Stream); - Stream.Free; -end; - -constructor TAnimatedGif.Create(stream: TStream); -begin - inherited Create; - Init; - LoadFromStream(stream); -end; - -constructor TAnimatedGif.Create; -begin - inherited Create; - Init; - LoadFromStream(nil); -end; - -function TAnimatedGif.Duplicate: TAnimatedGif; -var i: integer; -begin - result := TAnimatedGif.Create; - setlength(result.FImages, length(FImages)); - for i := 0 to high(FImages) do - begin - result.FImages[i] := FImages[i]; - FImages[i].Image.NewReference; - end; - result.FWidth := FWidth; - result.FHeight := FHeight; - result.FBackgroundColor := FBackgroundColor; -end; - -procedure TAnimatedGif.LoadFromStream(Stream: TStream); -begin - FCurrentImage := -1; - FWantedImage := -1; - FTimeAccumulator := 0; - - if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; - if FPreviousVirtualScreen <> nil then FPreviousVirtualScreen.FreeReference; - FInternalVirtualScreen.Free; - FRestoreImage.Free; - FBackgroundImage.Free; - - FInternalVirtualScreen := nil; - FStretchedVirtualScreen := nil; - FRestoreImage := nil; - FBackgroundImage := nil; - FPreviousVirtualScreen := nil; - - EraseColor := clBlack; - FPreviousDisposeMode := dmNone; - - FWidth := 0; - FHeight := 0; - - if Stream<>nil then LoadImages(Stream); -end; - -procedure TAnimatedGif.SaveToStream(Stream: TStream); -begin - //not implemented -end; - -{$HINTS OFF} -procedure TAnimatedGif.LoadImages(stream: TStream); - - PROCEDURE DumpData; - VAR count:byte; - BEGIN - REPEAT - stream.read(count,1); - stream.position := stream.position + count; - UNTIL (count=0) OR (stream.position>=stream.size); - END; - -type - TRGB=packed RECORD - r,g,b:byte; - END; - - TPalette= array of TMemPixel; - - function rgbToColor(rgb: TRGB): TMemPixel; - begin - result.red := rgb.r; - result.green := rgb.g; - result.blue := rgb.b; - result.alpha := 255; - end; - -const GIFScreenDescriptor_GlobalColorTableFlag = $80; - GIFImageDescriptor_LocalColorTableFlag = $80; - GIFImageDescriptor_InterlacedFlag = $40; - GIFGraphicControlExtension_TransparentFlag = $01; - -CONST ilstart:array[1..4] of longint=(0,4,2,1); - ilstep:array[1..4] of longint=(8,8,4,2); - -var NewImages: array of TGifSubImage; - NbImages: integer; - - GIFSignature:TGIFSignature; - GIFScreenDescriptor:TGIFScreenDescriptor; - GIFBlockID:char; - GIFImageDescriptor:TGIFImageDescriptor; - - globalPalette: TPalette; - localPalette: TPalette; - - transcolorIndex: integer; - delay: integer; - disposeMode: TDisposeMode; - - procedure LoadGlobalPalette; - var NbEntries,i: integer; - rgb: TRGB; - begin - NbEntries := 1 SHL (GIFScreenDescriptor.flags AND $07+1); - setlength(globalPalette, NbEntries); - FOR i:=0 TO NbEntries-1 DO - BEGIN - stream.read(rgb,3); - globalPalette[i]:=rgbToColor(rgb); - END; - end; - - procedure LoadLocalPalette; - var NbEntries,i: integer; - rgb: TRGB; - begin - NbEntries := 1 SHL (GIFImageDescriptor.flags AND $07+1); - setlength(localPalette, NbEntries); - FOR i:=0 TO NbEntries-1 DO - BEGIN - stream.read(rgb,3); - localPalette[i]:=rgbToColor(rgb); - END; - end; - - PROCEDURE decodeGIFLZW(image:TMemBitmap;const pal:TPalette;interlaced:boolean); - VAR xd,yd:longint; - CONST tablen=4095; - TYPE Pstr=^Tstr; - Tstr=RECORD - prefix:Pstr; - suffix:longint; - END; - Pstrtab=^Tstrtab; - Tstrtab=array[0..tablen] of Tstr; - - VAR strtab:Pstrtab; - oldcode,curcode,clearcode,endcode:longint; - codesize,codelen,codemask:longint; - stridx:longint; - bitbuf,bitsinbuf:longint; - bytbuf:array[0..255] of byte; - bytinbuf,bytbufidx:byte; - endofsrc:boolean; - xcnt,ycnt,ystep,pass:longint; - - PROCEDURE InitStringTable; - VAR i:longint; - BEGIN - new(strtab); - clearcode:=1 SHL codesize; - endcode:=clearcode+1; - stridx:=endcode+1; - codelen:=codesize+1; - codemask:=(1 SHL codelen)-1; - FOR i:=0 TO clearcode-1 DO - BEGIN - strtab^[i].prefix:=nil; - strtab^[i].suffix:=i; - END; - FOR i:=clearcode TO tablen DO - BEGIN - strtab^[i].prefix:=nil; - strtab^[i].suffix:=0; - END; - END; - - PROCEDURE ClearStringTable; - VAR i:longint; - BEGIN - clearcode:=1 SHL codesize; - endcode:=clearcode+1; - stridx:=endcode+1; - codelen:=codesize+1; - codemask:=(1 SHL codelen)-1; - FOR i:=clearcode TO tablen DO - BEGIN - strtab^[i].prefix:=nil; - strtab^[i].suffix:=0; - END; - END; - - PROCEDURE DoneStringTable; - BEGIN - dispose(strtab); - END; - - FUNCTION GetNextCode:longint; - BEGIN - WHILE (bitsinbufnil) THEN WriteStr(s^.prefix); - IF (ycnt>=yd) THEN - BEGIN - IF interlaced THEN - BEGIN - WHILE (ycnt>=yd) AND (pass<5) DO - BEGIN - inc(pass); - ycnt:=ilstart[pass]; - ystep:=ilstep[pass]; - END; - END; - END; - - colorIndex := s^.suffix; - if (colorIndex <> transcolorIndex) and (colorIndex >=0) and (colorIndex < length(pal)) then - image.setpixel(xcnt,ycnt,pal[colorIndex]); - - inc(xcnt); - IF (xcnt>=xd) THEN - BEGIN - xcnt:=0; - inc(ycnt,ystep); - - IF NOT interlaced THEN - IF (ycnt>=yd) THEN - BEGIN - inc(pass); - END; - - END; - END; - - FUNCTION firstchar(s:Pstr):byte; - BEGIN - WHILE (s^.prefix<>nil) DO s:=s^.prefix; - firstchar:=s^.suffix; - END; - - BEGIN -{DBG('lzw start');} - endofsrc:=FALSE; - xd:=image.width; - yd:=image.height; - xcnt:=0; - IF interlaced THEN - BEGIN - pass:=1; - ycnt:=ilstart[pass]; - ystep:=ilstep[pass]; - END - ELSE - BEGIN - pass:=4; - ycnt:=0; - ystep:=1; - END; - oldcode:=0; - bitbuf:=0; - bitsinbuf:=0; - bytinbuf:=0; - bytbufidx:=0; - codesize:=0; - stream.read(codesize,1); -{DBG(codesize);} - InitStringTable; - curcode:=getnextcode; -{DBG(curcode);} - WHILE (curcode<>endcode) AND (pass<5) AND NOT endofsrc{ AND NOT finished} DO - BEGIN -{DBG('-----'); -DBG(curcode); -DBGw(stridx);} - IF (curcode=clearcode) THEN - BEGIN - ClearStringTable; - REPEAT - curcode:=getnextcode; -{DBG('lzw clear');} - UNTIL (curcode<>clearcode); - IF (curcode=endcode) THEN break; - WriteStr(code2str(curcode)); - oldcode:=curcode; - END - ELSE - BEGIN - IF (curcodestridx) THEN break; - AddStr2Tab(Code2Str(oldcode),firstchar(Code2Str(oldcode))); - WriteStr(Code2Str(stridx-1)); - oldcode:=curcode; - END; - END; - curcode:=getnextcode; - END; - DoneStringTable; -{putimage(0,0,image);} -{DBG('lzw end'); -DBG(bytinbuf);} - IF NOT endofsrc THEN DumpData; -{DBG('lzw finished');} - END; - - procedure LoadImage; - var imgWidth,imgHeight: integer; - img: TMemBitmap; - Interlaced: boolean; - palette: TPalette; - BEGIN - stream.read(GIFImageDescriptor,sizeof(GIFImageDescriptor)); - IF (GIFImageDescriptor.flags AND GIFImageDescriptor_LocalColorTableFlag=GIFImageDescriptor_LocalColorTableFlag) THEN LoadLocalPalette else - localPalette := nil; - - if localPalette <> nil then palette := localPalette else palette := globalPalette; - imgWidth:=GIFImageDescriptor.width; - imgHeight:=GIFImageDescriptor.height; - - if length(NewImages) <= NbImages then setlength(NewImages, length(NewImages)*2+1); - img := TMemBitmap.Create(imgWidth,imgHeight); - img.Fill(MemPixelTransparent); - NewImages[NbImages].Image := img; - NewImages[NbImages].Position := point(GIFImageDescriptor.x,GIFImageDescriptor.y); - NewImages[NbImages].Delay:= Delay; - NewImages[NbImages].disposeMode:= disposeMode; - - if (transcolorIndex >= 0) and (transcolorIndex < length(palette)) then - NewImages[nbImages].TransparentColor:= palette[transcolorIndex] else - NewImages[nbImages].TransparentColor := MemPixelTransparent; - - inc(NbImages); - - Interlaced := GIFImageDescriptor.flags AND GIFImageDescriptor_InterlacedFlag=GIFImageDescriptor_InterlacedFlag; - DecodeGIFLZW(img,palette,Interlaced); - END; - - procedure ChangeImages; - var i: integer; - begin - Clear; - SetLength(FImages,NbImages); - for i:= 0 to Count-1 do - FImages[i] := NewImages[i]; - end; - - procedure ReadExtension; - var - GIFExtensionBlock:TGIFExtensionBlock; - GIFGraphicControlExtension:TGIFGraphicControlExtension; - mincount, count: byte; - - begin - stream.read(GIFExtensionBlock,sizeof(GIFExtensionBlock)); - CASE GIFExtensionBlock.functioncode OF - $F9:BEGIN - stream.read(count,1); - if count < sizeof(GIFGraphicControlExtension) then - mincount := 0 else - begin - mincount := sizeof(GIFGraphicControlExtension); - stream.read(GIFGraphicControlExtension,mincount); - - if GIFGraphicControlExtension.flags and GIFGraphicControlExtension_TransparentFlag = GIFGraphicControlExtension_TransparentFlag then - transcolorIndex:=GIFGraphicControlExtension.transcolor else - transcolorIndex := -1; - if GIFGraphicControlExtension.delaytime <> 0 then Delay := GIFGraphicControlExtension.delaytime*10; - disposeMode := TDisposeMode((GIFGraphicControlExtension.flags shr 2) and 7); - end; - stream.Position:= Stream.Position+count-mincount; - DumpData; - END; - ELSE - BEGIN - DumpData; - END; - END; - end; - -begin - NewImages := nil; - NbImages := 0; - transcolorIndex := -1; - Delay := 100; - FBackgroundColor:= clBlack; - FWidth := 0; - FHeight := 0; - disposeMode := dmErase; - - stream.Read(GIFSignature,sizeof(GIFSignature)); - IF (GIFSignature[1]='G') AND (GIFSignature[2]='I') AND (GIFSignature[3]='F') THEN - BEGIN - stream.read(GIFScreenDescriptor,sizeof(GIFScreenDescriptor)); - FWidth := GIFScreenDescriptor.width; - FHeight := GIFScreenDescriptor.Height; - IF (GIFScreenDescriptor.flags AND GIFScreenDescriptor_GlobalColorTableFlag=GIFScreenDescriptor_GlobalColorTableFlag) THEN - begin - LoadGlobalPalette; - if GIFScreenDescriptor.background < length(globalPalette) then - FBackgroundColor := MemPixelToColor(globalPalette[GIFScreenDescriptor.background]); - end; - REPEAT - stream.read(GIFBlockID,sizeof(GIFBlockID)); - CASE GIFBlockID OF - ';':; - ',': LoadImage; - '!': ReadExtension; - ELSE - begin - raise Exception.Create('TAnimatedGif: unexpected block type'); - break; - end; - END; - UNTIL (GIFBlockID=';') OR (stream.Position>=stream.size); - END else - raise Exception.Create('TAnimatedGif: invalid header'); - ChangeImages; -end; - -procedure TAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect); -begin - if FBackgroundImage <> nil then FreeAndNil(FBackgroundImage); - SaveBackgroundOnce(ACanvas, Rect); - - if FPreviousVirtualScreen <> nil then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end; - - Render(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top); - FStretchedVirtualScreen.Draw(ACanvas,Rect.Left,Rect.Top); - FImageChanged := false; - - FPreviousVirtualScreen := FStretchedVirtualScreen.Duplicate; -end; - -function TAnimatedGif.GetEmpty: Boolean; -begin - Result:= (length(FImages)=0); -end; - -function TAnimatedGif.GetHeight: Integer; -begin - Result:= FHeight; -end; - -function TAnimatedGif.GetTransparent: Boolean; -begin - Result:= true; -end; - -function TAnimatedGif.GetWidth: Integer; -begin - Result:= FWidth; -end; - -procedure TAnimatedGif.SetHeight(Value: Integer); -begin - //not implemented -end; - -procedure TAnimatedGif.SetTransparent(Value: Boolean); -begin - //not implemented -end; - -procedure TAnimatedGif.SetWidth(Value: Integer); -begin - //not implemented -end; - -procedure TAnimatedGif.SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); -begin - if (FBackgroundImage <> nil) and ((FBackgroundImage.Width <> ARect.Right-ARect.Left) or - (FBackgroundImage.Height <> ARect.Bottom-ARect.Top)) then FreeAndNil(FBackgroundImage); - - if (BackgroundMode in [gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously]) and (FBackgroundImage = nil) then - begin - FBackgroundImage := TMemBitmap.Create(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - FBackgroundImage.GetImage(Canvas,ARect.Left,ARect.Top,EraseColor); - end; -end; - -procedure TAnimatedGif.SetCurrentImage(Index: integer); -begin - if (Index >= 0) and (Index < Length(FImages)) then FWantedImage := Index; -end; - -{$HINTS ON} - -procedure TAnimatedGif.Clear; -var i: integer; -begin - inherited Clear; - - for i := 0 to Count-1 do - FImages[i].Image.FreeReference; - FImages := nil; -end; - -destructor TAnimatedGif.Destroy; -begin - Clear; - - if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; - if FPreviousVirtualScreen <> nil then FPreviousVirtualScreen.FreeReference; - FInternalVirtualScreen.Free; - FRestoreImage.Free; - FBackgroundImage.Free; - inherited Destroy; -end; - -procedure TAnimatedGif.Pause; -begin - FPaused := true; -end; - -procedure TAnimatedGif.Resume; -begin - FPaused := false; -end; - -procedure TAnimatedGif.Show(Canvas: TCanvas; ARect: TRect); -begin - Canvas.StretchDraw(ARect,self); -end; - -procedure TAnimatedGif.Update(Canvas: TCanvas; ARect: TRect); -var - n: integer; - PChangePix,PNewPix, PBackground, PNewBackground: PLongWord; - oldpix,newpix,newbackpix: LongWord; - NewBackgroundImage: TMemBitmap; -begin - if (BackgroundMode = gbmUpdateBackgroundContinuously) and (FBackgroundImage = nil) then BackgroundMode := gbmSaveBackgroundOnce; - - SaveBackgroundOnce(Canvas, ARect); - - case BackgroundMode of - gbmSimplePaint: - begin - UpdateSimple(Canvas, ARect); - exit; - end; - gbmEraseBackground: - begin - UpdateEraseBackground(Canvas, ARect); - exit; - end; - gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: - begin - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end - else - FPreviousVirtualScreen := FPreviousVirtualScreen.GetUnique; - end; - - Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - - if FImageChanged then - begin - if BackgroundMode = gbmUpdateBackgroundContinuously then - begin - NewBackgroundImage := TMemBitmap.Create(FStretchedVirtualScreen.Width,FStretchedVirtualScreen.Height); - NewBackgroundImage.GetImage(Canvas,ARect.Left,ARect.Top,EraseColor); - - if FPreviousVirtualScreen=nil then - begin - FPreviousVirtualScreen := TMemBitmap.Create(FWidth,FHeight); - FPreviousVirtualScreen.Fill(MemPixelTransparent); - end; - - PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); - PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); - PBackground := PLongWord(FBackgroundImage.ScanLine[0]); - PNewBackground := PLongWord(NewBackgroundImage.ScanLine[0]); - for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do - begin - oldpix := PChangePix^; - - if (oldpix and AlphaMask = AlphaMask) then //pixel opaque précédent - begin - newbackpix := PNewBackground^; - if (newbackpix <> oldpix) then //stocke nouveau fond - PBackground^ := newbackpix; - end; - - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then - begin - PChangePix^ := newpix; //pixel opaque - if oldpix and AlphaMask = 0 then //pixel transparent précédent - PBackground^ := PNewBackground^; - end - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := PBackground^; - TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent - -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} - - inc(PNewPix); - inc(PChangePix); - inc(PBackground); - inc(PNewBackground); - end; - NewBackgroundImage.Free; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); - end else - begin - if FPreviousVirtualScreen =nil then - begin - FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; - end else - begin - PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); - PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); - PBackground := PLongWord(FBackgroundImage.ScanLine[0]); - for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do - begin - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then PChangePix^ := newpix //pixel opaque - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := PBackground^; - TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent - -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} - - inc(PNewPix); - inc(PChangePix); - inc(PBackground); - end; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); - end; - end; - FImageChanged := false; - end; - end; - end; -end; - -procedure TAnimatedGif.Hide(Canvas: TCanvas; ARect: TRect); -var shape: TMemBitmap; p,pback: PMemPixel; - MemEraseColor : TMemPixel; n: integer; -begin - MemEraseColor := MemPixel(EraseColor); - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end - end; - - case BackgroundMode of - gbmEraseBackground, gbmSimplePaint: - begin - if FPreviousVirtualScreen <> nil then - begin - shape := FPreviousVirtualScreen.Duplicate; - p := shape.ScanLine[0]; - for n := shape.NbPixels-1 downto 0 do - begin - if p^.alpha <> 0 then p^ := MemEraseColor else - p^:= MemPixelTransparent; - inc(p); - end; - shape.Draw(Canvas,ARect.Left,ARect.Top); - shape.FreeReference; - end; - end; - gbmSaveBackgroundOnce,gbmUpdateBackgroundContinuously: - begin - if (FPreviousVirtualScreen <> nil) and (FBackgroundImage <> nil) then - begin - shape := FPreviousVirtualScreen.Duplicate; - p := shape.ScanLine[0]; - pback := FBackgroundImage.ScanLine[0]; - for n := shape.NbPixels-1 downto 0 do - begin - if p^.alpha <> 0 then p^ := pback^ else - p^:= MemPixelTransparent; - inc(p); - inc(pback); - end; - shape.Draw(Canvas,ARect.Left,ARect.Top); - shape.FreeReference; - end; - end; - end; -end; - -procedure TAnimatedGif.UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean); -var - n: integer; - PChangePix,PNewPix: PLongWord; - newpix: LongWord; - MemPixEraseColor : LongWord; -begin - if EraseColor = clNone then - begin - UpdateSimple(Canvas, ARect, DrawOnlyIfChanged); - exit; - end; - - if FPreviousVirtualScreen <> nil then - begin - if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or - (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then - begin - FPreviousVirtualScreen.FreeReference; - FPreviousVirtualScreen := nil; - end - else - FPreviousVirtualScreen := FPreviousVirtualScreen.GetUnique; - end; - - Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); - if FImageChanged then - begin - PMemPixel(@MemPixEraseColor)^ := MemPixel(EraseColor); - if FPreviousVirtualScreen =nil then - begin - FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; - end else - begin - PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); - PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); - for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do - begin - newpix := PNewPix^; - - if newpix and AlphaMask = AlphaMask then PChangePix^ := newpix //pixel opaque - else if newpix and AlphaMask > 0 then - begin - PChangePix^ := MemPixEraseColor; - TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); - end - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent -{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque - else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent} - - inc(PNewPix); - inc(PChangePix); - end; - FPreviousVirtualScreen.InvalidateBitmap; - FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); - FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); - end; - - FImageChanged := false; - end; -end; - -procedure TAnimatedGif.Init; -begin - BackgroundMode := gbmSaveBackgroundOnce; -end; - -function TAnimatedGif.GetBitmap: TBitmap; -begin - Render(FWidth,FHeight); - result := FStretchedVirtualScreen.Bitmap; -end; - -function TAnimatedGif.GetMemBitmap: TMemBitmap; -begin - Render(FWidth,FHeight); - result := FStretchedVirtualScreen; -end; - -{ TFPReaderGIF } - -procedure TFPReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage); -var gif: TAnimatedGif; x,y: integer; Mem: TMemBitmap; -begin - gif := TAnimatedGif.Create(Str); - Mem := gif.MemBitmap; - if Img is TMemBitmap then - begin - TMemBitmap(Img).Assign(Mem); - end else - begin - Img.SetSize(gif.Width,gif.Height); - for y := 0 to gif.height-1 do - for x := 0 to gif.width-1 do - with Mem.GetPixel(x,y) do - Img.Colors[x,y] := FPColor(red*$101,green*$101,blue*$101,alpha*$101); - end; - gif.Free; -end; - -{$HINTS OFF} -function TFPReaderGIF.InternalCheck(Str: TStream): boolean; -var - GIFSignature:TGIFSignature; - savepos: int64; -begin - savepos := str.Position; - try - str.Read(GIFSignature,sizeof(GIFSignature)); - IF (GIFSignature[1]='G') AND (GIFSignature[2]='I') AND (GIFSignature[3]='F') THEN - BEGIN - result := true; - end else - result := false; - except on ex:exception do result := false; - end; - str.Position := savepos; -end; -{$HINTS ON} - -initialization - - //Free Pascal Image - ImageHandlers.RegisterImageReader ('Animated GIF', TAnimatedGif.GetFileExtensions, TFPReaderGIF); - - //Lazarus Picture - TPicture.RegisterFileFormat(TAnimatedGif.GetFileExtensions,'Animated GIF', TAnimatedGif); - -end. - +unit AnimatedGif; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, FPImage, MemBitmap; + +type + TDisposeMode = (dmNone, dmKeep, dmErase, dmRestore); + TGifSubImage = record + Image: TMemBitmap; + Position: TPoint; + Delay: integer; + disposeMode: TDisposeMode; + TransparentColor: TMemPixel; + end; + TGifSubImageArray = array of TGifSubImage; + + TGifBackgroundMode = (gbmSimplePaint, gbmEraseBackground, gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously); + + { TAnimatedGif } + + TAnimatedGif = class(TGraphic) + private + FWidth,FHeight: integer; + FBackgroundColor: TColor; + + FPrevDate: TDateTime; + FPaused: boolean; + FTimeAccumulator: double; + FCurrentImage, FWantedImage: integer; + FPreviousDisposeMode : TDisposeMode; + + FBackgroundImage, FPreviousVirtualScreen, + FStretchedVirtualScreen, FInternalVirtualScreen, FRestoreImage: TMemBitmap; + FImageChanged: boolean; + + function GetCount: integer; + procedure Render(StretchWidth,StretchHeight: integer); + procedure UpdateSimple(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); + procedure UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); + procedure Init; + function GetBitmap: TBitmap; + function GetMemBitmap: TMemBitmap; + procedure SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); + procedure SetCurrentImage(Index: integer); + + protected + FImages: TGifSubImageArray; + procedure LoadImages(stream: TStream); + + {TGraphic} + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; + function GetEmpty: Boolean; override; + function GetHeight: Integer; override; + function GetTransparent: Boolean; override; + function GetWidth: Integer; override; + procedure SetHeight(Value: Integer); override; + procedure SetTransparent(Value: Boolean); override; + procedure SetWidth(Value: Integer); override; + + public + EraseColor: TColor; + BackgroundMode: TGifBackgroundMode; + + constructor Create(filename: string); + constructor Create(stream: TStream); + constructor Create; override; + function Duplicate: TAnimatedGif; + + {TGraphic} + procedure LoadFromStream(Stream: TStream); override; + procedure SaveToStream(Stream: TStream); override; + class function GetFileExtensions: string; override; + + procedure Clear; override; + destructor Destroy; override; + procedure Pause; + procedure Resume; + + procedure Show(Canvas: TCanvas; ARect: TRect); overload; + procedure Update(Canvas: TCanvas; ARect: TRect); overload; + procedure Hide(Canvas: TCanvas; ARect: TRect); overload; + + property BackgroundColor : TColor read FBackgroundColor; + property Count: Integer read GetCount; + property Width: integer read FWidth; + property Height: integer read FHeight; + property Paused: Boolean read FPaused; + property Bitmap: TBitmap read GetBitmap; + property MemBitmap: TMemBitmap read GetMemBitmap; + property CurrentImage: integer read FCurrentImage write SetCurrentImage; + end; + + { TFPReaderGIF } + + TFPReaderGIF = class (TFPCustomImageReader) + protected + procedure InternalRead (Str:TStream; Img:TFPCustomImage); override; + function InternalCheck (Str:TStream) : boolean; override; + end; + +const + GifBackgroundModeStr : array[TGifBackgroundMode] of string = + ('gbmSimplePaint', 'gbmEraseBackground', 'gbmSaveBackgroundOnce', 'gbmUpdateBackgroundContinuously'); + +implementation + +Const AlphaMask = $FF000000; + +TYPE TGIFSignature=packed array[1..6] of char; + + TGIFScreenDescriptor=packed RECORD + width,height:word; + flags,background,map:byte; + END; + + TGIFImageDescriptor=packed RECORD + x,y,width,height:word; + flags:byte; + END; + + TGIFExtensionBlock=packed RECORD + functioncode:byte; + END; + + TGIFGraphicControlExtension=packed RECORD + flags:byte; + delaytime:word; + transcolor:byte; + END; + +{ TAnimatedGif } + +class function TAnimatedGif.GetFileExtensions: string; +begin + Result := 'gif'; +end; + +procedure TAnimatedGif.Render(StretchWidth,StretchHeight: integer); +var curDate: TDateTime; + previousImage, nextImage: integer; + +begin + if FInternalVirtualScreen = nil then + begin + FInternalVirtualScreen := TMemBitmap.Create(FWidth,FHeight); + if Count = 0 then FInternalVirtualScreen.Fill(BackgroundColor) else FInternalVirtualScreen.Fill(MemPixelTransparent); + FImageChanged := true; + end; + + if Count = 0 then exit; + + previousImage := FCurrentImage; + + curDate := Now; + if FWantedImage <> - 1 then + begin + nextImage := FWantedImage; + FTimeAccumulator:= 0; + FWantedImage := -1; + end else + if FCurrentImage = -1 then + begin + nextImage := 0; + FTimeAccumulator := 0; + FPreviousDisposeMode := dmNone; + end else + begin + if not FPaused then FTimeAccumulator += (curDate-FPrevDate)*24*60*60*1000; + nextImage := FCurrentImage; + while FTimeAccumulator> FImages[nextImage].Delay do + begin + FTimeAccumulator -= FImages[nextImage].Delay; + inc(nextImage); + if nextImage >= Count then nextImage := 0; + + if nextImage = previousImage then + begin + inc(nextImage); + if nextImage >= Count then nextImage := 0; + break; + end; + end; + end; + FPrevDate := curDate; + + while FCurrentImage<>nextImage do + begin + inc(FCurrentImage); + if FCurrentImage >= Count then + begin + FCurrentImage := 0; + FPreviousDisposeMode := dmErase; + end; + + case FPreviousDisposeMode of + dmErase: FInternalVirtualScreen.Fill(MemPixelTransparent); + dmRestore: if FRestoreImage <> nil then FInternalVirtualScreen.PutImage(0,0,FRestoreImage,dmSet); + end; + + with FImages[FCurrentImage] do + begin + If disposeMode = dmRestore then + begin + if FRestoreImage = nil then FRestoreImage := TMemBitmap.Create(FWidth,FHeight); + FRestoreImage.PutImage(0,0,FInternalVirtualScreen,dmSet); + end; + + if Image <> nil then + FInternalVirtualScreen.PutImage(Position.X,Position.Y,Image,dmSetExceptTransparent); + FPreviousDisposeMode := disposeMode; + end; + + FImageChanged := true; + previousImage := FCurrentImage; + FInternalVirtualScreen.InvalidateBitmap; + end; + + if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; + if (FInternalVirtualScreen.Width = StretchWidth) and (FInternalVirtualScreen.Height = StretchHeight) then + FStretchedVirtualScreen := FInternalVirtualScreen.NewReference else + FStretchedVirtualScreen := FInternalVirtualScreen.Resample(StretchWidth,StretchHeight); +end; + +procedure TAnimatedGif.UpdateSimple(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean = true); +begin + if FPreviousVirtualScreen <> nil then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end; + + Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + if FImageChanged then + begin + FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FImageChanged := false; + end else + if not DrawOnlyIfChanged then FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + + FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; +end; + +function TAnimatedGif.GetCount: integer; +begin + result := length(FImages); +end; + +constructor TAnimatedGif.Create(filename: string); +var Stream: TFileStream; +begin + inherited Create; + Init; + Stream := TFileStream.Create(filename,fmOpenRead); + LoadFromStream(Stream); + Stream.Free; +end; + +constructor TAnimatedGif.Create(stream: TStream); +begin + inherited Create; + Init; + LoadFromStream(stream); +end; + +constructor TAnimatedGif.Create; +begin + inherited Create; + Init; + LoadFromStream(nil); +end; + +function TAnimatedGif.Duplicate: TAnimatedGif; +var i: integer; +begin + result := TAnimatedGif.Create; + setlength(result.FImages, length(FImages)); + for i := 0 to high(FImages) do + begin + result.FImages[i] := FImages[i]; + FImages[i].Image.NewReference; + end; + result.FWidth := FWidth; + result.FHeight := FHeight; + result.FBackgroundColor := FBackgroundColor; +end; + +procedure TAnimatedGif.LoadFromStream(Stream: TStream); +begin + FCurrentImage := -1; + FWantedImage := -1; + FTimeAccumulator := 0; + + if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; + if FPreviousVirtualScreen <> nil then FPreviousVirtualScreen.FreeReference; + FInternalVirtualScreen.Free; + FRestoreImage.Free; + FBackgroundImage.Free; + + FInternalVirtualScreen := nil; + FStretchedVirtualScreen := nil; + FRestoreImage := nil; + FBackgroundImage := nil; + FPreviousVirtualScreen := nil; + + EraseColor := clBlack; + FPreviousDisposeMode := dmNone; + + FWidth := 0; + FHeight := 0; + + if Stream<>nil then LoadImages(Stream); +end; + +procedure TAnimatedGif.SaveToStream(Stream: TStream); +begin + //not implemented +end; + +{$HINTS OFF} +procedure TAnimatedGif.LoadImages(stream: TStream); + + PROCEDURE DumpData; + VAR count:byte; + BEGIN + REPEAT + stream.read(count,1); + stream.position := stream.position + count; + UNTIL (count=0) OR (stream.position>=stream.size); + END; + +type + TRGB=packed RECORD + r,g,b:byte; + END; + + TPalette= array of TMemPixel; + + function rgbToColor(rgb: TRGB): TMemPixel; + begin + result.red := rgb.r; + result.green := rgb.g; + result.blue := rgb.b; + result.alpha := 255; + end; + +const GIFScreenDescriptor_GlobalColorTableFlag = $80; + GIFImageDescriptor_LocalColorTableFlag = $80; + GIFImageDescriptor_InterlacedFlag = $40; + GIFGraphicControlExtension_TransparentFlag = $01; + +CONST ilstart:array[1..4] of longint=(0,4,2,1); + ilstep:array[1..4] of longint=(8,8,4,2); + +var NewImages: array of TGifSubImage; + NbImages: integer; + + GIFSignature:TGIFSignature; + GIFScreenDescriptor:TGIFScreenDescriptor; + GIFBlockID:char; + GIFImageDescriptor:TGIFImageDescriptor; + + globalPalette: TPalette; + localPalette: TPalette; + + transcolorIndex: integer; + delay: integer; + disposeMode: TDisposeMode; + + procedure LoadGlobalPalette; + var NbEntries,i: integer; + rgb: TRGB; + begin + NbEntries := 1 SHL (GIFScreenDescriptor.flags AND $07+1); + setlength(globalPalette, NbEntries); + FOR i:=0 TO NbEntries-1 DO + BEGIN + stream.read(rgb,3); + globalPalette[i]:=rgbToColor(rgb); + END; + end; + + procedure LoadLocalPalette; + var NbEntries,i: integer; + rgb: TRGB; + begin + NbEntries := 1 SHL (GIFImageDescriptor.flags AND $07+1); + setlength(localPalette, NbEntries); + FOR i:=0 TO NbEntries-1 DO + BEGIN + stream.read(rgb,3); + localPalette[i]:=rgbToColor(rgb); + END; + end; + + PROCEDURE decodeGIFLZW(image:TMemBitmap;const pal:TPalette;interlaced:boolean); + VAR xd,yd:longint; + CONST tablen=4095; + TYPE Pstr=^Tstr; + Tstr=RECORD + prefix:Pstr; + suffix:longint; + END; + Pstrtab=^Tstrtab; + Tstrtab=array[0..tablen] of Tstr; + + VAR strtab:Pstrtab; + oldcode,curcode,clearcode,endcode:longint; + codesize,codelen,codemask:longint; + stridx:longint; + bitbuf,bitsinbuf:longint; + bytbuf:array[0..255] of byte; + bytinbuf,bytbufidx:byte; + endofsrc:boolean; + xcnt,ycnt,ystep,pass:longint; + + PROCEDURE InitStringTable; + VAR i:longint; + BEGIN + new(strtab); + clearcode:=1 SHL codesize; + endcode:=clearcode+1; + stridx:=endcode+1; + codelen:=codesize+1; + codemask:=(1 SHL codelen)-1; + FOR i:=0 TO clearcode-1 DO + BEGIN + strtab^[i].prefix:=nil; + strtab^[i].suffix:=i; + END; + FOR i:=clearcode TO tablen DO + BEGIN + strtab^[i].prefix:=nil; + strtab^[i].suffix:=0; + END; + END; + + PROCEDURE ClearStringTable; + VAR i:longint; + BEGIN + clearcode:=1 SHL codesize; + endcode:=clearcode+1; + stridx:=endcode+1; + codelen:=codesize+1; + codemask:=(1 SHL codelen)-1; + FOR i:=clearcode TO tablen DO + BEGIN + strtab^[i].prefix:=nil; + strtab^[i].suffix:=0; + END; + END; + + PROCEDURE DoneStringTable; + BEGIN + dispose(strtab); + END; + + FUNCTION GetNextCode:longint; + BEGIN + WHILE (bitsinbufnil) THEN WriteStr(s^.prefix); + IF (ycnt>=yd) THEN + BEGIN + IF interlaced THEN + BEGIN + WHILE (ycnt>=yd) AND (pass<5) DO + BEGIN + inc(pass); + ycnt:=ilstart[pass]; + ystep:=ilstep[pass]; + END; + END; + END; + + colorIndex := s^.suffix; + if (colorIndex <> transcolorIndex) and (colorIndex >=0) and (colorIndex < length(pal)) then + image.setpixel(xcnt,ycnt,pal[colorIndex]); + + inc(xcnt); + IF (xcnt>=xd) THEN + BEGIN + xcnt:=0; + inc(ycnt,ystep); + + IF NOT interlaced THEN + IF (ycnt>=yd) THEN + BEGIN + inc(pass); + END; + + END; + END; + + FUNCTION firstchar(s:Pstr):byte; + BEGIN + WHILE (s^.prefix<>nil) DO s:=s^.prefix; + firstchar:=s^.suffix; + END; + + BEGIN +{DBG('lzw start');} + endofsrc:=FALSE; + xd:=image.width; + yd:=image.height; + xcnt:=0; + IF interlaced THEN + BEGIN + pass:=1; + ycnt:=ilstart[pass]; + ystep:=ilstep[pass]; + END + ELSE + BEGIN + pass:=4; + ycnt:=0; + ystep:=1; + END; + oldcode:=0; + bitbuf:=0; + bitsinbuf:=0; + bytinbuf:=0; + bytbufidx:=0; + codesize:=0; + stream.read(codesize,1); +{DBG(codesize);} + InitStringTable; + curcode:=getnextcode; +{DBG(curcode);} + WHILE (curcode<>endcode) AND (pass<5) AND NOT endofsrc{ AND NOT finished} DO + BEGIN +{DBG('-----'); +DBG(curcode); +DBGw(stridx);} + IF (curcode=clearcode) THEN + BEGIN + ClearStringTable; + REPEAT + curcode:=getnextcode; +{DBG('lzw clear');} + UNTIL (curcode<>clearcode); + IF (curcode=endcode) THEN break; + WriteStr(code2str(curcode)); + oldcode:=curcode; + END + ELSE + BEGIN + IF (curcodestridx) THEN break; + AddStr2Tab(Code2Str(oldcode),firstchar(Code2Str(oldcode))); + WriteStr(Code2Str(stridx-1)); + oldcode:=curcode; + END; + END; + curcode:=getnextcode; + END; + DoneStringTable; +{putimage(0,0,image);} +{DBG('lzw end'); +DBG(bytinbuf);} + IF NOT endofsrc THEN DumpData; +{DBG('lzw finished');} + END; + + procedure LoadImage; + var imgWidth,imgHeight: integer; + img: TMemBitmap; + Interlaced: boolean; + palette: TPalette; + BEGIN + stream.read(GIFImageDescriptor,sizeof(GIFImageDescriptor)); + IF (GIFImageDescriptor.flags AND GIFImageDescriptor_LocalColorTableFlag=GIFImageDescriptor_LocalColorTableFlag) THEN LoadLocalPalette else + localPalette := nil; + + if localPalette <> nil then palette := localPalette else palette := globalPalette; + imgWidth:=GIFImageDescriptor.width; + imgHeight:=GIFImageDescriptor.height; + + if length(NewImages) <= NbImages then setlength(NewImages, length(NewImages)*2+1); + img := TMemBitmap.Create(imgWidth,imgHeight); + img.Fill(MemPixelTransparent); + NewImages[NbImages].Image := img; + NewImages[NbImages].Position := point(GIFImageDescriptor.x,GIFImageDescriptor.y); + NewImages[NbImages].Delay:= Delay; + NewImages[NbImages].disposeMode:= disposeMode; + + if (transcolorIndex >= 0) and (transcolorIndex < length(palette)) then + NewImages[nbImages].TransparentColor:= palette[transcolorIndex] else + NewImages[nbImages].TransparentColor := MemPixelTransparent; + + inc(NbImages); + + Interlaced := GIFImageDescriptor.flags AND GIFImageDescriptor_InterlacedFlag=GIFImageDescriptor_InterlacedFlag; + DecodeGIFLZW(img,palette,Interlaced); + END; + + procedure ChangeImages; + var i: integer; + begin + Clear; + SetLength(FImages,NbImages); + for i:= 0 to Count-1 do + FImages[i] := NewImages[i]; + end; + + procedure ReadExtension; + var + GIFExtensionBlock:TGIFExtensionBlock; + GIFGraphicControlExtension:TGIFGraphicControlExtension; + mincount, count: byte; + + begin + stream.read(GIFExtensionBlock,sizeof(GIFExtensionBlock)); + CASE GIFExtensionBlock.functioncode OF + $F9:BEGIN + stream.read(count,1); + if count < sizeof(GIFGraphicControlExtension) then + mincount := 0 else + begin + mincount := sizeof(GIFGraphicControlExtension); + stream.read(GIFGraphicControlExtension,mincount); + + if GIFGraphicControlExtension.flags and GIFGraphicControlExtension_TransparentFlag = GIFGraphicControlExtension_TransparentFlag then + transcolorIndex:=GIFGraphicControlExtension.transcolor else + transcolorIndex := -1; + if GIFGraphicControlExtension.delaytime <> 0 then Delay := GIFGraphicControlExtension.delaytime*10; + disposeMode := TDisposeMode((GIFGraphicControlExtension.flags shr 2) and 7); + end; + stream.Position:= Stream.Position+count-mincount; + DumpData; + END; + ELSE + BEGIN + DumpData; + END; + END; + end; + +begin + NewImages := nil; + NbImages := 0; + transcolorIndex := -1; + Delay := 100; + FBackgroundColor:= clBlack; + FWidth := 0; + FHeight := 0; + disposeMode := dmErase; + + stream.Read(GIFSignature,sizeof(GIFSignature)); + IF (GIFSignature[1]='G') AND (GIFSignature[2]='I') AND (GIFSignature[3]='F') THEN + BEGIN + stream.read(GIFScreenDescriptor,sizeof(GIFScreenDescriptor)); + FWidth := GIFScreenDescriptor.width; + FHeight := GIFScreenDescriptor.Height; + IF (GIFScreenDescriptor.flags AND GIFScreenDescriptor_GlobalColorTableFlag=GIFScreenDescriptor_GlobalColorTableFlag) THEN + begin + LoadGlobalPalette; + if GIFScreenDescriptor.background < length(globalPalette) then + FBackgroundColor := MemPixelToColor(globalPalette[GIFScreenDescriptor.background]); + end; + REPEAT + stream.read(GIFBlockID,sizeof(GIFBlockID)); + CASE GIFBlockID OF + ';':; + ',': LoadImage; + '!': ReadExtension; + ELSE + begin + raise Exception.Create('TAnimatedGif: unexpected block type'); + break; + end; + END; + UNTIL (GIFBlockID=';') OR (stream.Position>=stream.size); + END else + raise Exception.Create('TAnimatedGif: invalid header'); + ChangeImages; +end; + +procedure TAnimatedGif.Draw(ACanvas: TCanvas; const Rect: TRect); +begin + if FBackgroundImage <> nil then FreeAndNil(FBackgroundImage); + SaveBackgroundOnce(ACanvas, Rect); + + if FPreviousVirtualScreen <> nil then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end; + + Render(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top); + FStretchedVirtualScreen.Draw(ACanvas,Rect.Left,Rect.Top); + FImageChanged := false; + + FPreviousVirtualScreen := FStretchedVirtualScreen.Duplicate; +end; + +function TAnimatedGif.GetEmpty: Boolean; +begin + Result:= (length(FImages)=0); +end; + +function TAnimatedGif.GetHeight: Integer; +begin + Result:= FHeight; +end; + +function TAnimatedGif.GetTransparent: Boolean; +begin + Result:= true; +end; + +function TAnimatedGif.GetWidth: Integer; +begin + Result:= FWidth; +end; + +procedure TAnimatedGif.SetHeight(Value: Integer); +begin + //not implemented +end; + +procedure TAnimatedGif.SetTransparent(Value: Boolean); +begin + //not implemented +end; + +procedure TAnimatedGif.SetWidth(Value: Integer); +begin + //not implemented +end; + +procedure TAnimatedGif.SaveBackgroundOnce(Canvas: TCanvas; ARect: TRect); +begin + if (FBackgroundImage <> nil) and ((FBackgroundImage.Width <> ARect.Right-ARect.Left) or + (FBackgroundImage.Height <> ARect.Bottom-ARect.Top)) then FreeAndNil(FBackgroundImage); + + if (BackgroundMode in [gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously]) and (FBackgroundImage = nil) then + begin + FBackgroundImage := TMemBitmap.Create(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + FBackgroundImage.GetImage(Canvas,ARect.Left,ARect.Top,EraseColor); + end; +end; + +procedure TAnimatedGif.SetCurrentImage(Index: integer); +begin + if (Index >= 0) and (Index < Length(FImages)) then FWantedImage := Index; +end; + +{$HINTS ON} + +procedure TAnimatedGif.Clear; +var i: integer; +begin + inherited Clear; + + for i := 0 to Count-1 do + FImages[i].Image.FreeReference; + FImages := nil; +end; + +destructor TAnimatedGif.Destroy; +begin + Clear; + + if FStretchedVirtualScreen <> nil then FStretchedVirtualScreen.FreeReference; + if FPreviousVirtualScreen <> nil then FPreviousVirtualScreen.FreeReference; + FInternalVirtualScreen.Free; + FRestoreImage.Free; + FBackgroundImage.Free; + inherited Destroy; +end; + +procedure TAnimatedGif.Pause; +begin + FPaused := true; +end; + +procedure TAnimatedGif.Resume; +begin + FPaused := false; +end; + +procedure TAnimatedGif.Show(Canvas: TCanvas; ARect: TRect); +begin + Canvas.StretchDraw(ARect,self); +end; + +procedure TAnimatedGif.Update(Canvas: TCanvas; ARect: TRect); +var + n: integer; + PChangePix,PNewPix, PBackground, PNewBackground: PLongWord; + oldpix,newpix,newbackpix: LongWord; + NewBackgroundImage: TMemBitmap; +begin + if (BackgroundMode = gbmUpdateBackgroundContinuously) and (FBackgroundImage = nil) then BackgroundMode := gbmSaveBackgroundOnce; + + SaveBackgroundOnce(Canvas, ARect); + + case BackgroundMode of + gbmSimplePaint: + begin + UpdateSimple(Canvas, ARect); + exit; + end; + gbmEraseBackground: + begin + UpdateEraseBackground(Canvas, ARect); + exit; + end; + gbmSaveBackgroundOnce, gbmUpdateBackgroundContinuously: + begin + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end + else + FPreviousVirtualScreen := FPreviousVirtualScreen.GetUnique; + end; + + Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + + if FImageChanged then + begin + if BackgroundMode = gbmUpdateBackgroundContinuously then + begin + NewBackgroundImage := TMemBitmap.Create(FStretchedVirtualScreen.Width,FStretchedVirtualScreen.Height); + NewBackgroundImage.GetImage(Canvas,ARect.Left,ARect.Top,EraseColor); + + if FPreviousVirtualScreen=nil then + begin + FPreviousVirtualScreen := TMemBitmap.Create(FWidth,FHeight); + FPreviousVirtualScreen.Fill(MemPixelTransparent); + end; + + PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); + PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); + PBackground := PLongWord(FBackgroundImage.ScanLine[0]); + PNewBackground := PLongWord(NewBackgroundImage.ScanLine[0]); + for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do + begin + oldpix := PChangePix^; + + if (oldpix and AlphaMask = AlphaMask) then //pixel opaque précédent + begin + newbackpix := PNewBackground^; + if (newbackpix <> oldpix) then //stocke nouveau fond + PBackground^ := newbackpix; + end; + + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then + begin + PChangePix^ := newpix; //pixel opaque + if oldpix and AlphaMask = 0 then //pixel transparent précédent + PBackground^ := PNewBackground^; + end + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := PBackground^; + TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent + +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} + + inc(PNewPix); + inc(PChangePix); + inc(PBackground); + inc(PNewBackground); + end; + NewBackgroundImage.Free; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); + end else + begin + if FPreviousVirtualScreen =nil then + begin + FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; + end else + begin + PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); + PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); + PBackground := PLongWord(FBackgroundImage.ScanLine[0]); + for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do + begin + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then PChangePix^ := newpix //pixel opaque + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := PBackground^; + TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent + +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := PBackground^; //efface précédent} + + inc(PNewPix); + inc(PChangePix); + inc(PBackground); + end; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); + end; + end; + FImageChanged := false; + end; + end; + end; +end; + +procedure TAnimatedGif.Hide(Canvas: TCanvas; ARect: TRect); +var shape: TMemBitmap; p,pback: PMemPixel; + MemEraseColor : TMemPixel; n: integer; +begin + MemEraseColor := MemPixel(EraseColor); + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end + end; + + case BackgroundMode of + gbmEraseBackground, gbmSimplePaint: + begin + if FPreviousVirtualScreen <> nil then + begin + shape := FPreviousVirtualScreen.Duplicate; + p := shape.ScanLine[0]; + for n := shape.NbPixels-1 downto 0 do + begin + if p^.alpha <> 0 then p^ := MemEraseColor else + p^:= MemPixelTransparent; + inc(p); + end; + shape.Draw(Canvas,ARect.Left,ARect.Top); + shape.FreeReference; + end; + end; + gbmSaveBackgroundOnce,gbmUpdateBackgroundContinuously: + begin + if (FPreviousVirtualScreen <> nil) and (FBackgroundImage <> nil) then + begin + shape := FPreviousVirtualScreen.Duplicate; + p := shape.ScanLine[0]; + pback := FBackgroundImage.ScanLine[0]; + for n := shape.NbPixels-1 downto 0 do + begin + if p^.alpha <> 0 then p^ := pback^ else + p^:= MemPixelTransparent; + inc(p); + inc(pback); + end; + shape.Draw(Canvas,ARect.Left,ARect.Top); + shape.FreeReference; + end; + end; + end; +end; + +procedure TAnimatedGif.UpdateEraseBackground(Canvas: TCanvas; ARect: TRect; DrawOnlyIfChanged: Boolean); +var + n: integer; + PChangePix,PNewPix: PLongWord; + newpix: LongWord; + MemPixEraseColor : LongWord; +begin + if EraseColor = clNone then + begin + UpdateSimple(Canvas, ARect, DrawOnlyIfChanged); + exit; + end; + + if FPreviousVirtualScreen <> nil then + begin + if (FPreviousVirtualScreen.Width <> ARect.Right-ARect.Left) or + (FPreviousVirtualScreen.Height <> ARect.Bottom-ARect.Top) then + begin + FPreviousVirtualScreen.FreeReference; + FPreviousVirtualScreen := nil; + end + else + FPreviousVirtualScreen := FPreviousVirtualScreen.GetUnique; + end; + + Render(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top); + if FImageChanged then + begin + PMemPixel(@MemPixEraseColor)^ := MemPixel(EraseColor); + if FPreviousVirtualScreen =nil then + begin + FStretchedVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FPreviousVirtualScreen := FStretchedVirtualScreen.NewReference; + end else + begin + PChangePix := PLongWord(FPreviousVirtualScreen.ScanLine[0]); + PNewPix := PLongWord(FStretchedVirtualScreen.ScanLine[0]); + for n := FStretchedVirtualScreen.NbPixels-1 downto 0 do + begin + newpix := PNewPix^; + + if newpix and AlphaMask = AlphaMask then PChangePix^ := newpix //pixel opaque + else if newpix and AlphaMask > 0 then + begin + PChangePix^ := MemPixEraseColor; + TMemBitmap.DrawPixel(PMemPixel(PChangePix),PMemPixel(@newpix)^); + end + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent +{ if newpix and AlphaMask > AlphaLimit then PChangePix^ := newpix or AlphaMask //pixel opaque + else if PChangePix^ and AlphaMask <> 0 then PChangePix^ := MemPixEraseColor; //efface précédent} + + inc(PNewPix); + inc(PChangePix); + end; + FPreviousVirtualScreen.InvalidateBitmap; + FPreviousVirtualScreen.Draw(Canvas,ARect.Left,ARect.Top); + FPreviousVirtualScreen.PutImage(0,0,FStretchedVirtualScreen,dmSet); + end; + + FImageChanged := false; + end; +end; + +procedure TAnimatedGif.Init; +begin + BackgroundMode := gbmSaveBackgroundOnce; +end; + +function TAnimatedGif.GetBitmap: TBitmap; +begin + Render(FWidth,FHeight); + result := FStretchedVirtualScreen.Bitmap; +end; + +function TAnimatedGif.GetMemBitmap: TMemBitmap; +begin + Render(FWidth,FHeight); + result := FStretchedVirtualScreen; +end; + +{ TFPReaderGIF } + +procedure TFPReaderGIF.InternalRead(Str: TStream; Img: TFPCustomImage); +var gif: TAnimatedGif; x,y: integer; Mem: TMemBitmap; +begin + gif := TAnimatedGif.Create(Str); + Mem := gif.MemBitmap; + if Img is TMemBitmap then + begin + TMemBitmap(Img).Assign(Mem); + end else + begin + Img.SetSize(gif.Width,gif.Height); + for y := 0 to gif.height-1 do + for x := 0 to gif.width-1 do + with Mem.GetPixel(x,y) do + Img.Colors[x,y] := FPColor(red*$101,green*$101,blue*$101,alpha*$101); + end; + gif.Free; +end; + +{$HINTS OFF} +function TFPReaderGIF.InternalCheck(Str: TStream): boolean; +var + GIFSignature:TGIFSignature; + savepos: int64; +begin + savepos := str.Position; + try + str.Read(GIFSignature,sizeof(GIFSignature)); + IF (GIFSignature[1]='G') AND (GIFSignature[2]='I') AND (GIFSignature[3]='F') THEN + BEGIN + result := true; + end else + result := false; + except on ex:exception do result := false; + end; + str.Position := savepos; +end; +{$HINTS ON} + +initialization + + //Free Pascal Image + ImageHandlers.RegisterImageReader ('Animated GIF', TAnimatedGif.GetFileExtensions, TFPReaderGIF); + + //Lazarus Picture + TPicture.RegisterFileFormat(TAnimatedGif.GetFileExtensions,'Animated GIF', TAnimatedGif); + +end. + diff --git a/baseunits/animatedgifs/membitmap.pas b/baseunits/animatedgifs/membitmap.pas index 7696bb1aa..d0550ffc7 100644 --- a/baseunits/animatedgifs/membitmap.pas +++ b/baseunits/animatedgifs/membitmap.pas @@ -1,1388 +1,1388 @@ -unit MemBitmap; -{ - /*************************************************************************** - membitmap.pas - -------------- - Easy-to-use memory bitmap 32-bit - 8-bit for each channel, transparency - Channels in that order : B G R A - - - Drawing primitives - - Resample - - Reference counter - - Drawing on LCL canvas - - Loading and saving images - - ***************************************************************************/ - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - -} - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, FPImage, Graphics; - -type - PMemPixel = ^TMemPixel; - TMemPixel = packed record blue,green,red,alpha: byte; end; - - TDrawMode = (dmSet, dmSetExceptTransparent, dmDrawWithTransparency); - - { TMemBitmap } - - TMemBitmap = class(TFPCustomImage) - private - FBitmap: TBitmap; //LCL bitmap object - FRefCount: integer; //reference counter - - function CheckEmpty: boolean; - function ResampleLarger(newWidth, newHeight: integer): TMemBitmap; - function ResampleSmaller(newWidth, newHeight: integer): TMemBitmap; - function GetHasTransparentPixels: boolean; - function GetAverageColor: TColor; - protected - {Pixel data} - FData: PMemPixel; - FWidth,FHeight,FNbPixels: integer; - FRebuildBmp: Boolean; //if image has changed - - function GetScanLine(y: integer): PMemPixel; - procedure RebuildBitmap; - function GetBitmap: TBitmap; - procedure Init; - {TFPCustomImage} - procedure SetInternalColor (x,y:integer; const Value:TFPColor); override; - function GetInternalColor (x,y:integer) : TFPColor; override; - procedure SetInternalPixel (x,y:integer; Value:integer); override; - function GetInternalPixel (x,y:integer) : integer; override; - public - {Reference counter functions} - function NewReference: TMemBitmap; - procedure FreeReference; - function GetUnique: TMemBitmap; - - {TFPCustomImage} - constructor Create(AWidth,AHeight: integer); override; - procedure SetSize (AWidth, AHeight : integer); override; - procedure SaveToFile(const filename:String); - - {Loading functions} - procedure Assign(Bitmap: TBitmap); overload; - procedure Assign(MemBitmap: TMemBitmap); overload; - constructor Create(AFilename: string); - destructor Destroy; override; - - {Drawing primitives} - procedure DrawPixels(c: TMemPixel; start,count: integer); overload; - procedure SetPixel(x,y: integer; c: TColor); overload; - procedure SetPixel(x,y: integer; c: TMemPixel); overload; - procedure DrawPixel(x,y: integer; c: TMemPixel); overload; - procedure AlphaPixel(x,y: integer; alpha: byte); - class procedure DrawPixel(dest: PMemPixel; c: TMemPixel); overload; inline; - function GetPixel(x,y: integer): TMemPixel; - function GetPixelCycle(x,y: integer): TMemPixel; - - procedure AlphaHorizLine(x,y,x2: integer; alpha: byte); - procedure SetHorizLine(x,y,x2: integer; c: TMemPixel); - procedure DrawHorizLine(x,y,x2: integer; c: TMemPixel); - procedure SetVertLine(x,y,y2: integer; c: TMemPixel); - procedure DrawVertLine(x,y,y2: integer; c: TMemPixel); - procedure AlphaVertLine(x,y,y2: integer; alpha: byte); - procedure Rectangle(x,y,x2,y2: integer; c: TMemPixel; mode: TDrawMode); - procedure Rectangle(x,y,x2,y2: integer; c: TColor); - - procedure FillRect(x,y,x2,y2: integer; c: TMemPixel; mode: TDrawMode); - procedure FillRect(x,y,x2,y2: integer; c: TColor); - procedure AlphaFillRect(x,y,x2,y2: integer; alpha:byte); - - procedure Fill(c: TColor); overload; - procedure Fill(c: TMemPixel); overload; - procedure Fill(c: TMemPixel; start,count: integer); overload; - procedure AlphaFill(alpha: byte); overload; - procedure AlphaFill(alpha: byte; start,count: integer); overload; - procedure ReplaceColor(before,after: TColor); overload; - procedure ReplaceColor(before,after: TMemPixel); overload; - - {LCL drawing functions} - procedure InvalidateBitmap; - procedure Draw(ACanvas: TCanvas; x,y: integer); - procedure Draw(ACanvas: TCanvas; Rect: TRect); - procedure GetImage(Canvas: TCanvas; x,y: integer; defaultColor: TColor); - procedure DrawPartial(ARect: TRect; Canvas: TCanvas; x,y: integer); - - {Mem bitmap functions} - procedure PutImage(x,y: integer; bmp: TMemBitmap; mode: TDrawMode); - function Duplicate: TMemBitmap; - function Resample(NewWidth, NewHeight: Integer): TMemBitmap; - procedure VerticalFlip; - - property Data: PMemPixel read FData; - property Width: Integer read FWidth; - property Height: Integer read FHeight; - property NbPixels: Integer read FNbPixels; - property Empty: boolean read CheckEmpty; - - property ScanLine[y: integer]: PMemPixel read GetScanLine; - property RefCount: integer read FRefCount; - property Bitmap: TBitmap read GetBitmap; //don't forget to call InvalidateBitmap before - //if you changed something - property HasTransparentPixels: boolean read GetHasTransparentPixels; - property AverageColor: TColor read GetAverageColor; - end; - -const - MemPixelTransparent : TMemPixel = (blue:0; green:0; red:0; alpha:0); - -function MemPixel(red,green,blue,alpha: byte): TMemPixel; overload; -function MemPixel(red,green,blue: byte): TMemPixel; overload; -function MemPixel(color: TColor): TMemPixel; overload; -function MemPixelToColor(c: TMemPixel): TColor; -operator = (const c1,c2:TMemPixel) : boolean; - -implementation - -uses FPWritePng, GraphType, LCLIntf, LCLType -{$IFDEF LCLgtk2} - {$DEFINE gtkbugfix} - ,gdk2,gtk2Def, gtk2Proc -{$ENDIF} -{$IFDEF LCLgtk} - {$DEFINE gtkbugfix} - ,gdk,gtkDef, gtkProc -{$ENDIF} -; - -function MemPixel(red, green, blue, alpha: byte): TMemPixel; -begin - result.red := red; - result.green := green; - result.blue := blue; - result.alpha := alpha; -end; - -function MemPixel(red, green, blue: byte): TMemPixel; overload; -begin - result.red := red; - result.green := green; - result.blue := blue; - result.alpha := 255; -end; - -function MemPixel(color: TColor): TMemPixel; overload; -begin - result.red := color; - result.green := color shr 8; - result.blue := color shr 16; - result.alpha := 255; -end; - -function MemPixelToColor(c: TMemPixel): TColor; -begin - result := c.red + (c.green shl 8) + (c.blue shl 16); -end; - -operator=(const c1, c2: TMemPixel): boolean; -begin - if (c1.alpha=0) and (c2.alpha=0) then result := true else - result := (c1.alpha=c2.alpha) and (c1.red=c2.red) and (c1.green=c2.green) and (c1.blue=c2.blue); -end; - -{ TMemBitmap } - -function TMemBitmap.CheckEmpty: boolean; -var i: integer; p: PMemPixel; -begin - p := data; - for i := NbPixels-1 downto 0 do - begin - if p^.alpha <> 0 then - begin - result := false; - exit; - end; - inc(p); - end; - result := true; -end; - -function TMemBitmap.GetScanLine(y: integer): PMemPixel; -begin - if (y < 0) or (y >= height) then - raise ERangeError.Create('Scanline: out of bounds') else - begin - result := data; - inc(result, width*y); - end; -end; - -constructor TMemBitmap.Create(AWidth, AHeight: integer); -begin - Init; - inherited Create(AWidth,AHeight); -end; - -constructor TMemBitmap.Create(AFilename: string); -begin - LoadFromFile(Afilename); -end; - -procedure TMemBitmap.SetSize(AWidth, AHeight: integer); -begin - if (AWidth = Width) and (AHeight = Height) then exit; - inherited SetSize(AWidth, AHeight); - if AWidth < 0 then AWidth := 0; - if AHeight < 0 then AHeight := 0; - FWidth := AWidth; - FHeight := AHeight; - FNbPixels := AWidth*AHeight; - if FNbPixels<0 then raise EOutOfMemory.Create('Image too big'); - ReAllocMem(FData,NbPixels*sizeof(TMemPixel)); - if (NbPixels>0) and (FData=nil) then - raise EOutOfMemory.Create('TMemBitmap: Not enough memory'); -end; - -procedure TMemBitmap.SaveToFile(const filename:String); -var ext: string; writer: TFPCustomImageWriter; - pngWriter : TFPWriterPNG; -begin - ext := AnsiLowerCase(ExtractFileExt(filename)); - - if ext='.png' then - begin - pngWriter := TFPWriterPNG.Create; - pngWriter.Indexed := false; - pngWriter.UseAlpha := HasTransparentPixels; - writer := pngWriter; - end else - writer := nil; - - if writer<> nil then - begin - inherited SaveToFile(Filename,writer); - writer.free; - end else - inherited SaveToFile(Filename); -end; - -procedure TMemBitmap.Assign(Bitmap: TBitmap); -begin - SetSize(Bitmap.width,bitmap.height); - GetImage(Bitmap.Canvas,0,0,clBlack); -end; - -procedure TMemBitmap.Assign(MemBitmap: TMemBitmap); -begin - SetSize(MemBitmap.Width,MemBitmap.height); - PutImage(0,0,MemBitmap,dmSet); -end; - -destructor TMemBitmap.Destroy; -begin - freemem(FData); - FBitmap.Free; - inherited Destroy; -end; - -procedure TMemBitmap.SetPixel(x, y: integer; c: TMemPixel); -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - (Scanline[y]+x)^ := c; -end; - -procedure TMemBitmap.SetPixel(x, y: integer; c: TColor); -var p: PByte; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - p := PByte(Scanline[y]+x); - p^ := c shr 16; inc(p); - p^ := c shr 8; inc(p); - p^ := c; inc(p); - p^ := 255; -end; - -procedure TMemBitmap.DrawPixel(x, y: integer; c: TMemPixel); -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - DrawPixel(Scanline[y]+x, c); -end; - -procedure TMemBitmap.AlphaPixel(x, y: integer; alpha: byte); -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - (Scanline[y]+x)^.alpha := alpha; -end; - -class procedure TMemBitmap.DrawPixel(dest: PMemPixel; c: TMemPixel); -var p: PByte; a1f, a2f, a12, a12m: cardinal; -begin - if c.alpha = 0 then exit; - - a12 := 65025 - (255-dest^.alpha)*(255-c.alpha); - a12m := a12 shr 1; - - a1f := dest^.alpha*(255-c.alpha); - a2f := c.alpha* 255; - - p := PByte(dest); - p^ := (dest^.blue*a1f + c.blue*a2f + a12m ) div a12; inc(p); - p^ := (dest^.green*a1f + c.green*a2f + a12m ) div a12; inc(p); - p^ := (dest^.red*a1f + c.red*a2f + a12m ) div a12; inc(p); - p^ := (a12 + a12 shr 7) shr 8; -end; -{var p: PByte; a1,r1,g1,b1, a2,r2,g2,b2, a1f, a2f, a12: single; -begin - if c.alpha = 0 then exit; - - a2 := c.alpha/255; - r2 := c.red/255; - g2 := c.green/255; - b2 := c.blue/255; - - a1 := dest^.alpha/255; - r1 := dest^.red/255; - g1 := dest^.green/255; - b1 := dest^.blue/255; - - a12 := 1 - (1-a1)*(1-a2); - - a1f := a1*(1-a2)/a12* 255; - a2f := a2/a12* 255; - - p := PByte(dest); - p^ := round( b1*a1f + b2*a2f ); inc(p); - p^ := round( g1*a1f + g2*a2f ); inc(p); - p^ := round( r1*a1f + r2*a2f ); inc(p); - p^ := round( a12 * 255); -end;} - -function TMemBitmap.GetPixel(x, y: integer): TMemPixel; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then result := MemPixelTransparent else - result := (Scanline[y]+x)^; -end; - -function TMemBitmap.GetPixelCycle(x, y: integer): TMemPixel; -begin - if (Width=0) or (Height=0) then result := MemPixelTransparent else - begin - x := x mod Width; - if x<0 then inc(x,width); - y := y mod Height; - if y<0 then inc(y,height); - result := (Scanline[y]+x)^; - end; -end; - -procedure TMemBitmap.AlphaHorizLine(x, y, x2: integer; alpha: byte); -var temp: integer; -begin - if (x2= width) or (x2 < 0) then exit; - if x < 0 then x := 0; - if x2 >= width then x2 := width-1; - AlphaFill(alpha, y*width+x, x2-x+1); -end; - -procedure TMemBitmap.InvalidateBitmap; -begin - FRebuildBmp := True; -end; - -procedure TMemBitmap.RebuildBitmap; -var RawImage : TRawImage; ABitmap, AMask: HBitmap; -begin - if FBitmap = nil then FBitmap := TBitmap.Create; - - if Empty then - begin - FBitmap.Height := 0; - FBitmap.Width := 0; - end else - begin - RawImage.Init; - RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(Width,Height); - RawImage.Data:= PByte(data); - RawImage.DataSize:= nbPixels*sizeof(TMemPixel); - RawImage_CreateBitmaps(RawImage, ABitmap,AMask,False); - FBitmap.Handle := ABitmap; - FBitmap.MaskHandle := AMask; - end; -end; - -function TMemBitmap.GetBitmap: TBitmap; -begin - if FRebuildBmp or (FBitmap = nil) then - begin - RebuildBitmap; - FRebuildBmp := false; - end; - result := FBitmap; -end; - -procedure TMemBitmap.Init; -begin - FRefCount := 1; - FBitmap := nil; - FData := nil; - FWidth := 0; - FHeight := 0; -end; - -procedure TMemBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); -var p: PByte; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - p := PByte(Scanline[y]+x); - p^ := Value.blue shr 8; inc(p); - p^ := Value.green shr 8; inc(p); - p^ := Value.red shr 8; inc(p); - p^ := Value.alpha shr 8; -end; - -function TMemBitmap.GetInternalColor(x, y: integer): TFPColor; -var p: PByte; v: byte; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - p := PByte(Scanline[y]+x); - v := p^; result.blue := v shl 8+v; inc(p); - v := p^; result.green := v shl 8+v; inc(p); - v := p^; result.red := v shl 8+v; inc(p); - v := p^; result.alpha := v shl 8+v; -end; - -procedure TMemBitmap.SetInternalPixel(x, y: integer; Value: integer); -var p: PByte; c: TFPColor; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - c := Palette.Color[Value]; - p := PByte(Scanline[y]+x); - p^ := c.blue shr 8; inc(p); - p^ := c.green shr 8; inc(p); - p^ := c.red shr 8; inc(p); - p^ := c.alpha shr 8; -end; - -function TMemBitmap.GetInternalPixel(x, y: integer): integer; -var p: PByte; v: byte; c: TFPColor; -begin - if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; - p := PByte(Scanline[y]+x); - v := p^; c.blue := v shl 8+v; inc(p); - v := p^; c.green := v shl 8+v; inc(p); - v := p^; c.red := v shl 8+v; inc(p); - v := p^; c.alpha := v shl 8+v; - result := palette.IndexOf(c); -end; - -function TMemBitmap.NewReference: TMemBitmap; -begin - Inc(FRefCount); - result := self; -end; - -procedure TMemBitmap.FreeReference; -begin - if self=nil then exit; - - if FRefCount > 0 then - begin - Dec(FRefCount); - if FRefCount = 0 then - begin - self.Destroy; - end; - end; -end; - -function TMemBitmap.GetUnique: TMemBitmap; -begin - if FRefCount > 1 then - begin - Dec(FRefCount); - result := self.Duplicate; - end else - result := self; -end; - -procedure TMemBitmap.Draw(ACanvas: TCanvas; x, y: integer); -begin - if self=nil then exit; - ACanvas.Draw(x,y,Bitmap); -end; - -procedure TMemBitmap.Draw(ACanvas: TCanvas; Rect: TRect); -begin - if self=nil then exit; - ACanvas.StretchDraw(Rect,Bitmap); -end; - -procedure TMemBitmap.DrawHorizLine(x, y, x2: integer; c: TMemPixel); -var temp: integer; -begin - if (x2= width) or (x2 < 0) then exit; - if x < 0 then x := 0; - if x2 >= width then x2 := width-1; - DrawPixels(c, y*width+x, x2-x+1); -end; - -procedure TMemBitmap.SetHorizLine(x, y, x2: integer; c: TMemPixel); -var temp: integer; -begin - if (x2= width) or (x2 < 0) then exit; - if x < 0 then x := 0; - if x2 >= width then x2 := width-1; - Fill(c, y*width+x, x2-x+1); -end; - -procedure TMemBitmap.SetVertLine(x, y, y2: integer; c: TMemPixel); -var temp,n: integer; p: PMemPixel; -begin - if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; - if y < 0 then y := 0; - if y2 >= height then y2 := height-1; - p := scanline[y]+x; - for n := y2-y downto 0 do - begin - p^ := c; - inc(p,width); - end; -end; - -procedure TMemBitmap.DrawVertLine(x, y, y2: integer; c: TMemPixel); -var temp,n: integer; p: PMemPixel; -begin - if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; - if y < 0 then y := 0; - if y2 >= height then y2 := height-1; - p := scanline[y]+x; - for n := y2-y downto 0 do - begin - DrawPixel(p,c); - inc(p,width); - end; -end; - -procedure TMemBitmap.AlphaVertLine(x, y, y2: integer; alpha: byte); -var temp,n: integer; p: PMemPixel; -begin - if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; - if y < 0 then y := 0; - if y2 >= height then y2 := height-1; - p := scanline[y]+x; - for n := y2-y downto 0 do - begin - p^.alpha := alpha; - inc(p,width); - end; -end; - -procedure TMemBitmap.Rectangle(x, y, x2, y2: integer; c: TMemPixel; - mode: TDrawMode); -var temp: integer; -begin - if (x>x2) then begin temp := x; x := x2; x2 := temp; end; - if (y>y2) then begin temp := y; y := y2; y2 := temp; end; - if (x2-x<=1) or (y2-y<=1) then exit; - case mode of - dmDrawWithTransparency: - begin - DrawHorizLine(x,y,x2-1, c); - DrawHorizLine(x,y2-1,x2-1, c); - if y2-y > 2 then - begin - DrawVertLine(x,y+1,y2-2, c); - DrawVertLine(x2-1,y+1,y2-2, c); - end; - end; - dmSet: - begin - SetHorizLine(x,y,x2-1, c); - SetHorizLine(x,y2-1,x2-1, c); - if y2-y > 2 then - begin - SetVertLine(x,y+1,y2-2, c); - SetVertLine(x2-1,y+1,y2-2, c); - end; - end; - dmSetExceptTransparent: if (c.alpha <> 0) then Rectangle(x,y,x2,y2,c,dmSet); - end; -end; - -procedure TMemBitmap.Rectangle(x, y, x2, y2: integer; c: TColor); -begin - Rectangle(x,y,x2,y2,MemPixel(c),dmSet); -end; - -procedure TMemBitmap.FillRect(x, y, x2, y2: integer; c: TMemPixel; - mode: TDrawMode); -var temp,yb: integer; -begin - if (x>x2) then begin temp := x; x := x2; x2 := temp; end; - if (y>y2) then begin temp := y; y := y2; y2 := temp; end; - if (x2-x<=0) or (y2-y<=0) then exit; - case mode of - dmDrawWithTransparency: - for yb := y to y2-1 do - DrawHorizLine(x,yb,x2-1, c); - dmSet: - for yb := y to y2-1 do - SetHorizLine(x,yb,x2-1, c); - dmSetExceptTransparent: if (c.alpha <> 0) then FillRect(x,y,x2,y2,c,dmSet); - end; -end; - -procedure TMemBitmap.FillRect(x, y, x2, y2: integer; c: TColor); -begin - FillRect(x,y,x2,y2,MemPixel(c),dmSet); -end; - -procedure TMemBitmap.AlphaFillRect(x, y, x2, y2: integer; alpha: byte); -var temp,yb: integer; -begin - if (x>x2) then begin temp := x; x := x2; x2 := temp; end; - if (y>y2) then begin temp := y; y := y2; y2 := temp; end; - if (x2-x<=0) or (y2-y<=0) then exit; - for yb := y to y2-1 do - AlphaHorizLine(x,yb,x2-1, alpha); -end; - -procedure TMemBitmap.Fill(c: TColor); -begin - Fill(MemPixel(c)); -end; - -procedure TMemBitmap.Fill(c: TMemPixel); -begin - Fill(c, 0, width*height); -end; - -procedure TMemBitmap.Fill(c: TMemPixel; start, count: integer); -var p: PMemPixel; -begin - if start < 0 then - begin - count += start; - start := 0; - end; - if start >= nbPixels then exit; - if start+count > nbPixels then count := nbPixels-start; - p := (Data+start); - while count > 0 do - begin - p^ := c; - inc(p); - dec(count); - end; -end; - -procedure TMemBitmap.AlphaFill(alpha: byte); -begin - AlphaFill(alpha,0,NbPixels); -end; - -procedure TMemBitmap.AlphaFill(alpha: byte; start, count: integer); -var p: PMemPixel; -begin - if start < 0 then - begin - count += start; - start := 0; - end; - if start >= nbPixels then exit; - if start+count > nbPixels then count := nbPixels-start; - p := (Data+start); - while count > 0 do - begin - p^.alpha := alpha; - inc(p); - dec(count); - end; -end; - -procedure TMemBitmap.ReplaceColor(before, after: TColor); -const colorMask = $00FFFFFF; -var p: PLongWord; - n: integer; - beforeBGR, afterBGR: LongWord; -begin - beforeBGR := (before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF); - afterBGR := (after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF); - p := PLongWord(Data); - for n := NbPixels-1 downto 0 do - begin - if p^ and colorMask = beforeBGR then - p^ := (p^ and not ColorMask) or afterBGR; - inc(p); - end; -end; - -procedure TMemBitmap.ReplaceColor(before, after: TMemPixel); -var p: PMemPixel; - n: integer; -begin - p := Data; - for n := NbPixels-1 downto 0 do - begin - if p^ = before then p^ := after; - inc(p); - end; -end; - -procedure TMemBitmap.DrawPixels(c: TMemPixel; start, count: integer); -var p: PMemPixel; -begin - if c.alpha = 0 then exit; - - if start < 0 then - begin - count += start; - start := 0; - end; - if start >= nbPixels then exit; - if start+count > nbPixels then count := nbPixels-start; - p := Data+start; - while count > 0 do - begin - DrawPixel(p,c); - inc(p); - dec(count); - end; -end; - -procedure TMemBitmap.PutImage(x, y: integer; bmp: TMemBitmap; mode: TDrawMode); -var x2,y2,yb,minxb,minyb,maxxb,ignoreleft,copycount,bmpwidth,i: integer; source,dest: PMemPixel; -begin - bmpwidth := bmp.width; - - if (x>= width) or (y>= height) or (x< -bmpwidth) or (y < -bmp.height) then exit; - - x2 := x+bmpwidth-1; - y2 := y+bmp.height-1; - - if y < 0 then minyb := 0 else minyb := y; - if y2 >= height then y2 := height-1; - - if x < 0 then - begin - ignoreleft := -x; - minxb := 0; - end else - begin - ignoreleft := 0; - minxb := x; - end; - if x2 >= width then maxxb := width-1 else maxxb := x2; - - copycount := maxxb-minxb+1; - - source := bmp.ScanLine[minyb-y]+ignoreleft; - dest := Scanline[minyb]+minxb; - - case mode of - dmSet: begin - copycount *= sizeof(TMemPixel); - for yb := minyb to y2 do - begin - move(source^,dest^, copycount); - inc(source, bmpwidth); - inc(dest, width); - end; - end; - dmSetExceptTransparent: - for yb := minyb to y2 do - begin - for i := copycount-1 downto 0 do - begin - if source^.alpha = 255 then dest^ := source^; - inc(dest); - inc(source); - end; - inc(source, bmpwidth-copycount); - inc(dest, width-copycount); - end; - dmDrawWithTransparency: - for yb := minyb to y2 do - begin - for i := copycount-1 downto 0 do - begin - DrawPixel(dest,source^); - inc(dest); - inc(source); - end; - inc(source, bmpwidth-copycount); - inc(dest, width-copycount); - end; - end; -end; - -function TMemBitmap.Duplicate: TMemBitmap; -begin - result := TMemBitmap.Create(width,height); - result.PutImage(0,0,self,dmSet); -end; - -procedure TMemBitmap.GetImage(Canvas: TCanvas; x, y: integer; defaultColor: TColor); -var bmp: TBitmap; xb,yb: integer; - source: PByte; dest: PByte; - {$IFDEF gtkbugfix} - Ofs: TPoint; - dcSource,dcDest : TGtkDeviceContext; - {$ENDIF} - rectSource,rectDest: TRect; - - function ClipRect: boolean; - var delta: integer; - begin - if rectSource.Left < 0 then - begin - delta := -rectSource.left; - inc(rectSource.Left,delta); - inc(rectDest.Left,delta); - end; - if rectSource.Top < 0 then - begin - delta := -rectSource.Top; - inc(rectSource.Top,delta); - inc(rectDest.Top,delta); - end; - if rectSource.Right > Canvas.Width then - begin - delta := rectSource.Right-Canvas.Width; - dec(rectSource.Right,delta); - dec(rectDest.Right,delta); - end; - if rectSource.Bottom > Canvas.Height then - begin - delta := rectSource.Bottom-Canvas.Height; - dec(rectSource.Bottom,delta); - dec(rectDest.Bottom,delta); - end; - result := (rectSource.Right>rectSource.Left) and - (rectSource.Bottom>rectSource.Top) and - (rectDest.Right>rectDest.Left) and - (rectDest.Bottom>rectDest.Top); - end; - -begin - bmp := TBitmap.Create; - bmp.PixelFormat:= pf24bit; - bmp.width := width; - bmp.height := height; - bmp.Canvas.Brush.Color := defaultColor; - bmp.Canvas.FillRect(0,0,width,height); - rectSource := classes.rect(x,y,x+width,y+height); - rectDest := classes.rect(0,0,width,height); - - {$IFDEF gtkbugfix} - dcDest := TGtkDeviceContext(bmp.Canvas.handle); - dcSource := TGtkDeviceContext(Canvas.Handle); - if (dcSource <> nil) and (dcDest <> nil) then - begin - Ofs := dcSource.Offset; - rectSource.Left += Ofs.X; - rectSource.Top += Ofs.Y; - rectSource.Right += Ofs.X; - rectSource.Bottom += Ofs.Y; - if ClipRect then - begin - if (dcDest.Drawable<>nil) and (dcDest.GC <> nil) and (dcSource.Drawable <> nil) then - gdk_window_copy_area(dcDest.Drawable, dcDest.GC, rectDest.Left,rectDest.top, dcSource.Drawable,rectSource.Left,rectSource.Top, rectSource.Right-rectSource.Left,rectSource.Bottom-rectSource.Top); - end; - end; - {$ELSE} - if ClipRect then - bmp.Canvas.CopyRect(rectDest,Canvas,rectSource); - {$ENDIF} - - if bmp.RawImage.Description.BitsPerPixel = 32 then - begin - for yb := 0 to height-1 do - begin - if bmp.rawImage.Description.LineOrder = riloTopToBottom then - source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(yb) else - source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(height-1-yb); - dest := pbyte(ScanLine[yb]); - for xb := 0 to width-1 do - begin - PWord(dest)^ := PWord(source)^; - inc(dest,2); inc(source, 2); - dest^ := source ^; - inc(dest); inc(source, 2); - dest^:= 255; - inc(dest); - end; - end; - end else - if bmp.RawImage.Description.BitsPerPixel = 24 then - begin - for yb := 0 to height-1 do - begin - if bmp.rawImage.Description.LineOrder = riloTopToBottom then - source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(yb) else - source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(height-1-yb); - dest := pbyte(ScanLine[yb]); - for xb := 0 to width-1 do - begin - PWord(dest)^ := PWord(source)^; - inc(dest,2); inc(source, 2); - dest^ := source ^; - inc(dest); inc(source); - dest^:= 255; - inc(dest); - end; - end; - end; - - bmp.Free; -end; - -function TMemBitmap.ResampleSmaller(newWidth, newHeight: integer - ): TMemBitmap; -const maxvalue= 255; -var - x_dest,y_dest : integer; - inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src : integer; - x_src,y_src,prev_x_src,prev_y_src: integer; - x_src2,y_src2: integer; - - xb,yb : integer; - alpha,v1,v2,v3,v4: double; - nb: integer; - c: TMemPixel; - pdest,psrc: PMemPixel; -begin - result := TMemBitmap.Create(NewWidth, NewHeight); - if (newWidth = 0) or (newHeight = 0) or (Width= 0) or (Height = 0) then exit; - inc_x_src := width div newWidth; - mod_x_src := width mod newWidth; - inc_y_src := height div newHeight; - mod_y_src := height mod newHeight; - - y_src := 0; - acc_y_src := 0; - PDest := result.ScanLine[0]; - for y_dest := 0 to newHeight-1 do - begin - prev_y_src := y_src; - inc(y_src,inc_y_src); - inc(acc_y_src,mod_y_src); - if acc_y_src >= newHeight then - begin - dec(acc_y_src,newHeight); - inc(y_src); - end; - - x_src := 0; - acc_x_src := 0; - for x_dest := 0 to newWidth-1 do - begin - prev_x_src := x_src; - inc(x_src,inc_x_src); - inc(acc_x_src,mod_x_src); - if acc_x_src >= newWidth then - begin - dec(acc_x_src,newWidth); - inc(x_src); - end; - - if x_src > prev_x_src then x_src2 := x_src-1 else x_src2 := x_src; - if y_src > prev_y_src then y_src2 := y_src-1 else y_src2 := y_src; - - v1 := 0; - v2 := 0; - v3 := 0; - v4 := 0; - nb := 0; - for yb := prev_y_src to y_src2 do - begin - PSrc := Scanline[yb]+prev_x_src; - for xb := prev_x_src to x_src2 do - begin - c := PSrc^; inc(PSrc); - alpha := c.alpha/maxvalue; - v1 += c.red*alpha; - v2 += c.green*alpha; - v3 += c.blue*alpha; - v4 += alpha; - inc(nb); - end; - end; - - if (v4<>0) and (nb <> 0) then - begin - c.red := round(v1/v4); - c.green := round(v2/v4); - c.blue := round(v3/v4); - c.alpha := round(v4/nb*maxvalue); - end else - begin - c.alpha := 0; - c.red := 0; - c.green := 0; - c.blue := 0; - end; - PDest^ := c; - inc(PDest); - end; - end; -end; - -function TMemBitmap.GetHasTransparentPixels: boolean; -var p: PMemPixel; n: integer; -begin - p := Data; - for n := NbPixels-1 downto 0 do - begin - if p^.alpha <> 255 then - begin - result := true; - exit; - end; - inc(p); - end; - result := false; -end; - -function TMemBitmap.GetAverageColor: TColor; -var n: integer; p: PMemPixel; - r,g,b,sum: double; - alpha: double; -begin - sum := 0; - r := 0; - g := 0; - b := 0; - p := Data; - for n := NbPixels-1 downto 0 do - begin - alpha := p^.alpha/255; - sum += alpha; - r += p^.red*alpha; - g += p^.green*alpha; - b += p^.blue*alpha; - end; - if sum=0 then result := clNone else - result := round(r/sum) + round(g/sum) shl 8 + round(b/sum) shl 16; -end; - -function TMemBitmap.ResampleLarger(newWidth, newHeight: integer): TMemBitmap; -const maxvalue = 255; -var - x_src,y_src : integer; - inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest : integer; - x_dest,y_dest,prev_x_dest,prev_y_dest: integer; - x_dest2,y_dest2,{x_src2,}y_src2: integer; - - xb,yb : integer; - cUpLeft,cUpRight,cLowLeft,cLowRight: TMemPixel; - factX,factY,factAddX,factAddY,factCorrX,factCorrY: single; - factUpLeft,factUpRight,factLowLeft,factLowRight: single; - factUpLeftAlpha,factUpRightAlpha,factLowLeftAlpha,factLowRightAlpha: single; - cur: TMemPixel; - alphaUpLeft, alphaUpRight, alphaLowLeft, alphaLowRight: single; - sumFactAlpha: single; - PDest,PSrc,PSrc2 : PMemPixel; - - temp: TMemBitmap; - -begin - result := TMemBitmap.Create(NewWidth, NewHeight); - if (newWidth = 0) or (newHeight = 0) then exit; - - if (width=1) and (height=1) then - begin - result.Fill(GetPixel(0,0)); - exit; - end else - if width=1 then - begin - temp := TMemBitmap.Create(2,Height); - temp.PutImage(0,0,self,dmSet); - temp.PutImage(1,0,self,dmSet); - result := temp.ResampleLarger(newWidth,newHeight); - temp.Free; - exit; - end else - if height=1 then - begin - temp := TMemBitmap.Create(Width,2); - temp.PutImage(0,0,self,dmSet); - temp.PutImage(0,1,self,dmSet); - result := temp.ResampleLarger(newWidth,newHeight); - temp.Free; - exit; - end; - - inc_x_dest := newwidth div (Width-1); - mod_x_dest := newwidth mod (Width-1); - inc_y_dest := newheight div (Height-1); - mod_y_dest := newheight mod (Height-1); - - y_dest := 0; - acc_y_dest := 0; - for y_src := 0 to Height-2 do - begin - prev_y_dest := y_dest; - inc(y_dest,inc_y_dest); - inc(acc_y_dest,mod_y_dest); - if acc_y_dest >= Height then - begin - dec(acc_y_dest,Height); - inc(y_dest); - end; - - y_src2 := y_src+1; - PSrc := Scanline[y_src]; - PSrc2 := Scanline[y_src2]; - cUpLeft := PSrc^; inc(PSrc); - cLowLeft := PSrc2^; inc(PSrc2); - - x_dest := 0; - acc_x_dest := 0; - for x_src := 0 to Width-2 do - begin - prev_x_dest := x_dest; - inc(x_dest,inc_x_dest); - inc(acc_x_dest,mod_x_dest); - if acc_x_dest >= Width then - begin - dec(acc_x_dest,Width); - inc(x_dest); - end; - - //x_src2 := x_src+1; - if x_src < width-2 then - begin - x_dest2 := x_dest-1; - factAddX := 1/(x_dest2-prev_x_dest+1); - end else - begin - x_dest2 := newWidth-1; - factAddX := 1/(x_dest2-prev_x_dest); - end; - if y_src < height-2 then - begin - y_dest2 := y_dest-1; - factAddY := 1/(y_dest2-prev_y_dest+1); - end else - begin - y_dest2 := newHeight-1; - factAddY := 1/(y_dest2-prev_y_dest); - end; - - cUpRight := PSrc^; inc(PSrc); - cLowRight := PSrc2^; inc(PSrc2); - - factY := 0; - for yb := prev_y_dest to y_dest2 do - begin - factX := 0; - PDest := result.scanline[yb]+prev_x_dest; - for xb := prev_x_dest to x_dest2 do - begin - factCorrX := 0.5-cos(factX*Pi)/2; - factCorrY := 0.5-cos(factY*Pi)/2; - - alphaUpLeft := cUpLeft.alpha/maxvalue; - alphaUpRight := cUpRight.alpha/maxvalue; - alphaLowLeft := cLowLeft.alpha/maxvalue; - alphaLowRight := cLowRight.alpha/maxvalue; - - factUpLeft := (1-factCorrX)*(1-factCorrY); - factUpRight := factCorrX*(1-factCorrY); - factLowLeft := (1-factCorrX)*factCorrY; - factLowRight := factCorrX*factCorrY; - - factUpLeftAlpha := factUpLeft*alphaUpLeft; - factUpRightAlpha := factUpRight*alphaUpRight; - factLowLeftAlpha := factLowLeft*alphaLowLeft; - factLowRightAlpha := factLowRight*alphaLowRight; - - sumFactAlpha := factUpLeftAlpha+factUpRightAlpha+factLowLeftAlpha+factLowRightAlpha; - if sumFactAlpha=0 then - begin - cur.alpha := 0; - cur.red := 0; - cur.green := 0; - cur.blue := 0; - end else - begin - cur.red := round((factUpLeftAlpha*cUpLeft.red + factUpRightAlpha*cUpRight.red + - factLowLeftAlpha*cLowLeft.red + factLowRightAlpha*cLowRight.red)/sumFactAlpha); - cur.green := round((factUpLeftAlpha*cUpLeft.green + factUpRightAlpha*cUpRight.green + - factLowLeftAlpha*cLowLeft.green + factLowRightAlpha*cLowRight.green)/sumFactAlpha); - cur.blue := round((factUpLeftAlpha*cUpLeft.blue + factUpRightAlpha*cUpRight.blue + - factLowLeftAlpha*cLowLeft.blue + factLowRightAlpha*cLowRight.blue)/sumFactAlpha); - cur.alpha := round(sumFactAlpha*maxvalue); - end; - PDest^ := cur; inc(PDest); - factX := factX + factAddX; - end; - factY := factY+factAddY; - end; - cUpLeft := cUpRight; - cLowLeft := cLowRight; - end; - end; -end; - -function TMemBitmap.Resample(NewWidth, NewHeight: Integer): TMemBitmap; -var temp,newtemp: TMemBitmap; -begin - if (NewWidth = Width) and (NewHeight = Height) then - result := Duplicate else - if (NewWidth >= Width) and (NewHeight >= Height) then - result := ResampleLarger(NewWidth,NewHeight) else - if (NewWidth <= Width) and (NewHeight <= Height) then - result := ResampleSmaller(NewWidth,NewHeight) else - begin - temp := self; - - if NewWidth < Width then - begin - newtemp := temp.ResampleSmaller(NewWidth,temp.Height); - if (temp<>self) then temp.free; - temp := newtemp; - end; - - if NewHeight < Height then - begin - newtemp := temp.ResampleSmaller(temp.Width,NewHeight); - if (temp<>self) then temp.free; - temp := newtemp; - end; - - if NewWidth > Width then - begin - newtemp := temp.ResampleLarger(NewWidth,temp.Height); - if (temp<>self) then temp.free; - temp := newtemp; - end; - - if NewHeight > Height then - begin - newtemp := temp.ResampleLarger(temp.Width,NewHeight); - if (temp<>self) then temp.free; - temp := newtemp; - end; - - if temp<>self then result := temp else - result := self.Duplicate; - end; -end; - -procedure TMemBitmap.VerticalFlip; -var yb: integer; - line: PMemPixel; - linesize: integer; -begin - if Data= nil then exit; - - linesize := Width*sizeof(TMemPixel); - line := nil; - getmem(line, linesize); - for yb := 0 to (Height div 2)-1 do - begin - move(Scanline[yb]^, line^, linesize); - move(Scanline[Height-1-yb]^, Scanline[yb]^, linesize); - move(line^, Scanline[Height-1-yb]^, linesize); - end; - freemem(line); -end; - -procedure TMemBitmap.DrawPartial(Arect: TRect; Canvas: TCanvas; x,y: integer); -var partial: TMemBitmap; - copywidth,copyheight,widthleft,heightleft,curxin,curyin,xdest,ydest,tx,ty: integer; -begin - tx := ARect.Right-ARect.Left; - ty := ARect.Bottom-ARect.Top; - - if ARect.Left >= Width then ARect.Left := ARect.Left mod Width else - if ARect.Left < 0 then ARect.Left := Width - ((-ARect.Left) mod Width); - ARect.Right := ARect.Left+tx; - - if ARect.Top >= Height then ARect.Top := ARect.Top mod Height else - if ARect.Top < 0 then ARect.Top := Height - ((-ARect.Top) mod Height); - ARect.Bottom := ARect.Top+ty; - - if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then - begin - Draw(Canvas,x,y); - exit; - end; - - partial := TMemBitmap.Create(tx,ty); - heightleft := partial.height; - curyin := ARect.Top; - ydest := -ARect.Top; - while heightleft > 0 do - begin - if curyin + heightleft > height then copyheight := height-curyin else - copyheight := heightleft; - - widthleft := partial.width; - curxin := ARect.Left; - xdest := -ARect.Left; - while widthleft > 0 do - begin - if curxin + widthleft > width then copywidth := width-curxin else - copywidth := widthleft; - - partial.PutImage(xdest,ydest,self,dmSet); - - curxin := 0; - dec(widthleft, copywidth); - inc(xdest,copywidth); - end; - curyin := 0; - dec(heightleft, copyheight); - inc(ydest,copyheight); - end; - partial.Draw(Canvas,x,y); - partial.Free; -end; - -end. +unit MemBitmap; +{ + /*************************************************************************** + membitmap.pas + -------------- + Easy-to-use memory bitmap 32-bit + 8-bit for each channel, transparency + Channels in that order : B G R A + + - Drawing primitives + - Resample + - Reference counter + - Drawing on LCL canvas + - Loading and saving images + + ***************************************************************************/ + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + +} + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FPImage, Graphics; + +type + PMemPixel = ^TMemPixel; + TMemPixel = packed record blue,green,red,alpha: byte; end; + + TDrawMode = (dmSet, dmSetExceptTransparent, dmDrawWithTransparency); + + { TMemBitmap } + + TMemBitmap = class(TFPCustomImage) + private + FBitmap: TBitmap; //LCL bitmap object + FRefCount: integer; //reference counter + + function CheckEmpty: boolean; + function ResampleLarger(newWidth, newHeight: integer): TMemBitmap; + function ResampleSmaller(newWidth, newHeight: integer): TMemBitmap; + function GetHasTransparentPixels: boolean; + function GetAverageColor: TColor; + protected + {Pixel data} + FData: PMemPixel; + FWidth,FHeight,FNbPixels: integer; + FRebuildBmp: Boolean; //if image has changed + + function GetScanLine(y: integer): PMemPixel; + procedure RebuildBitmap; + function GetBitmap: TBitmap; + procedure Init; + {TFPCustomImage} + procedure SetInternalColor (x,y:integer; const Value:TFPColor); override; + function GetInternalColor (x,y:integer) : TFPColor; override; + procedure SetInternalPixel (x,y:integer; Value:integer); override; + function GetInternalPixel (x,y:integer) : integer; override; + public + {Reference counter functions} + function NewReference: TMemBitmap; + procedure FreeReference; + function GetUnique: TMemBitmap; + + {TFPCustomImage} + constructor Create(AWidth,AHeight: integer); override; + procedure SetSize (AWidth, AHeight : integer); override; + procedure SaveToFile(const filename:String); + + {Loading functions} + procedure Assign(Bitmap: TBitmap); overload; + procedure Assign(MemBitmap: TMemBitmap); overload; + constructor Create(AFilename: string); + destructor Destroy; override; + + {Drawing primitives} + procedure DrawPixels(c: TMemPixel; start,count: integer); overload; + procedure SetPixel(x,y: integer; c: TColor); overload; + procedure SetPixel(x,y: integer; c: TMemPixel); overload; + procedure DrawPixel(x,y: integer; c: TMemPixel); overload; + procedure AlphaPixel(x,y: integer; alpha: byte); + class procedure DrawPixel(dest: PMemPixel; c: TMemPixel); overload; inline; + function GetPixel(x,y: integer): TMemPixel; + function GetPixelCycle(x,y: integer): TMemPixel; + + procedure AlphaHorizLine(x,y,x2: integer; alpha: byte); + procedure SetHorizLine(x,y,x2: integer; c: TMemPixel); + procedure DrawHorizLine(x,y,x2: integer; c: TMemPixel); + procedure SetVertLine(x,y,y2: integer; c: TMemPixel); + procedure DrawVertLine(x,y,y2: integer; c: TMemPixel); + procedure AlphaVertLine(x,y,y2: integer; alpha: byte); + procedure Rectangle(x,y,x2,y2: integer; c: TMemPixel; mode: TDrawMode); + procedure Rectangle(x,y,x2,y2: integer; c: TColor); + + procedure FillRect(x,y,x2,y2: integer; c: TMemPixel; mode: TDrawMode); + procedure FillRect(x,y,x2,y2: integer; c: TColor); + procedure AlphaFillRect(x,y,x2,y2: integer; alpha:byte); + + procedure Fill(c: TColor); overload; + procedure Fill(c: TMemPixel); overload; + procedure Fill(c: TMemPixel; start,count: integer); overload; + procedure AlphaFill(alpha: byte); overload; + procedure AlphaFill(alpha: byte; start,count: integer); overload; + procedure ReplaceColor(before,after: TColor); overload; + procedure ReplaceColor(before,after: TMemPixel); overload; + + {LCL drawing functions} + procedure InvalidateBitmap; + procedure Draw(ACanvas: TCanvas; x,y: integer); + procedure Draw(ACanvas: TCanvas; Rect: TRect); + procedure GetImage(Canvas: TCanvas; x,y: integer; defaultColor: TColor); + procedure DrawPartial(ARect: TRect; Canvas: TCanvas; x,y: integer); + + {Mem bitmap functions} + procedure PutImage(x,y: integer; bmp: TMemBitmap; mode: TDrawMode); + function Duplicate: TMemBitmap; + function Resample(NewWidth, NewHeight: Integer): TMemBitmap; + procedure VerticalFlip; + + property Data: PMemPixel read FData; + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property NbPixels: Integer read FNbPixels; + property Empty: boolean read CheckEmpty; + + property ScanLine[y: integer]: PMemPixel read GetScanLine; + property RefCount: integer read FRefCount; + property Bitmap: TBitmap read GetBitmap; //don't forget to call InvalidateBitmap before + //if you changed something + property HasTransparentPixels: boolean read GetHasTransparentPixels; + property AverageColor: TColor read GetAverageColor; + end; + +const + MemPixelTransparent : TMemPixel = (blue:0; green:0; red:0; alpha:0); + +function MemPixel(red,green,blue,alpha: byte): TMemPixel; overload; +function MemPixel(red,green,blue: byte): TMemPixel; overload; +function MemPixel(color: TColor): TMemPixel; overload; +function MemPixelToColor(c: TMemPixel): TColor; +operator = (const c1,c2:TMemPixel) : boolean; + +implementation + +uses FPWritePng, GraphType, LCLIntf, LCLType +{$IFDEF LCLgtk2} + {$DEFINE gtkbugfix} + ,gdk2,gtk2Def, gtk2Proc +{$ENDIF} +{$IFDEF LCLgtk} + {$DEFINE gtkbugfix} + ,gdk,gtkDef, gtkProc +{$ENDIF} +; + +function MemPixel(red, green, blue, alpha: byte): TMemPixel; +begin + result.red := red; + result.green := green; + result.blue := blue; + result.alpha := alpha; +end; + +function MemPixel(red, green, blue: byte): TMemPixel; overload; +begin + result.red := red; + result.green := green; + result.blue := blue; + result.alpha := 255; +end; + +function MemPixel(color: TColor): TMemPixel; overload; +begin + result.red := color; + result.green := color shr 8; + result.blue := color shr 16; + result.alpha := 255; +end; + +function MemPixelToColor(c: TMemPixel): TColor; +begin + result := c.red + (c.green shl 8) + (c.blue shl 16); +end; + +operator=(const c1, c2: TMemPixel): boolean; +begin + if (c1.alpha=0) and (c2.alpha=0) then result := true else + result := (c1.alpha=c2.alpha) and (c1.red=c2.red) and (c1.green=c2.green) and (c1.blue=c2.blue); +end; + +{ TMemBitmap } + +function TMemBitmap.CheckEmpty: boolean; +var i: integer; p: PMemPixel; +begin + p := data; + for i := NbPixels-1 downto 0 do + begin + if p^.alpha <> 0 then + begin + result := false; + exit; + end; + inc(p); + end; + result := true; +end; + +function TMemBitmap.GetScanLine(y: integer): PMemPixel; +begin + if (y < 0) or (y >= height) then + raise ERangeError.Create('Scanline: out of bounds') else + begin + result := data; + inc(result, width*y); + end; +end; + +constructor TMemBitmap.Create(AWidth, AHeight: integer); +begin + Init; + inherited Create(AWidth,AHeight); +end; + +constructor TMemBitmap.Create(AFilename: string); +begin + LoadFromFile(Afilename); +end; + +procedure TMemBitmap.SetSize(AWidth, AHeight: integer); +begin + if (AWidth = Width) and (AHeight = Height) then exit; + inherited SetSize(AWidth, AHeight); + if AWidth < 0 then AWidth := 0; + if AHeight < 0 then AHeight := 0; + FWidth := AWidth; + FHeight := AHeight; + FNbPixels := AWidth*AHeight; + if FNbPixels<0 then raise EOutOfMemory.Create('Image too big'); + ReAllocMem(FData,NbPixels*sizeof(TMemPixel)); + if (NbPixels>0) and (FData=nil) then + raise EOutOfMemory.Create('TMemBitmap: Not enough memory'); +end; + +procedure TMemBitmap.SaveToFile(const filename:String); +var ext: string; writer: TFPCustomImageWriter; + pngWriter : TFPWriterPNG; +begin + ext := AnsiLowerCase(ExtractFileExt(filename)); + + if ext='.png' then + begin + pngWriter := TFPWriterPNG.Create; + pngWriter.Indexed := false; + pngWriter.UseAlpha := HasTransparentPixels; + writer := pngWriter; + end else + writer := nil; + + if writer<> nil then + begin + inherited SaveToFile(Filename,writer); + writer.free; + end else + inherited SaveToFile(Filename); +end; + +procedure TMemBitmap.Assign(Bitmap: TBitmap); +begin + SetSize(Bitmap.width,bitmap.height); + GetImage(Bitmap.Canvas,0,0,clBlack); +end; + +procedure TMemBitmap.Assign(MemBitmap: TMemBitmap); +begin + SetSize(MemBitmap.Width,MemBitmap.height); + PutImage(0,0,MemBitmap,dmSet); +end; + +destructor TMemBitmap.Destroy; +begin + freemem(FData); + FBitmap.Free; + inherited Destroy; +end; + +procedure TMemBitmap.SetPixel(x, y: integer; c: TMemPixel); +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + (Scanline[y]+x)^ := c; +end; + +procedure TMemBitmap.SetPixel(x, y: integer; c: TColor); +var p: PByte; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + p := PByte(Scanline[y]+x); + p^ := c shr 16; inc(p); + p^ := c shr 8; inc(p); + p^ := c; inc(p); + p^ := 255; +end; + +procedure TMemBitmap.DrawPixel(x, y: integer; c: TMemPixel); +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + DrawPixel(Scanline[y]+x, c); +end; + +procedure TMemBitmap.AlphaPixel(x, y: integer; alpha: byte); +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + (Scanline[y]+x)^.alpha := alpha; +end; + +class procedure TMemBitmap.DrawPixel(dest: PMemPixel; c: TMemPixel); +var p: PByte; a1f, a2f, a12, a12m: cardinal; +begin + if c.alpha = 0 then exit; + + a12 := 65025 - (255-dest^.alpha)*(255-c.alpha); + a12m := a12 shr 1; + + a1f := dest^.alpha*(255-c.alpha); + a2f := c.alpha* 255; + + p := PByte(dest); + p^ := (dest^.blue*a1f + c.blue*a2f + a12m ) div a12; inc(p); + p^ := (dest^.green*a1f + c.green*a2f + a12m ) div a12; inc(p); + p^ := (dest^.red*a1f + c.red*a2f + a12m ) div a12; inc(p); + p^ := (a12 + a12 shr 7) shr 8; +end; +{var p: PByte; a1,r1,g1,b1, a2,r2,g2,b2, a1f, a2f, a12: single; +begin + if c.alpha = 0 then exit; + + a2 := c.alpha/255; + r2 := c.red/255; + g2 := c.green/255; + b2 := c.blue/255; + + a1 := dest^.alpha/255; + r1 := dest^.red/255; + g1 := dest^.green/255; + b1 := dest^.blue/255; + + a12 := 1 - (1-a1)*(1-a2); + + a1f := a1*(1-a2)/a12* 255; + a2f := a2/a12* 255; + + p := PByte(dest); + p^ := round( b1*a1f + b2*a2f ); inc(p); + p^ := round( g1*a1f + g2*a2f ); inc(p); + p^ := round( r1*a1f + r2*a2f ); inc(p); + p^ := round( a12 * 255); +end;} + +function TMemBitmap.GetPixel(x, y: integer): TMemPixel; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then result := MemPixelTransparent else + result := (Scanline[y]+x)^; +end; + +function TMemBitmap.GetPixelCycle(x, y: integer): TMemPixel; +begin + if (Width=0) or (Height=0) then result := MemPixelTransparent else + begin + x := x mod Width; + if x<0 then inc(x,width); + y := y mod Height; + if y<0 then inc(y,height); + result := (Scanline[y]+x)^; + end; +end; + +procedure TMemBitmap.AlphaHorizLine(x, y, x2: integer; alpha: byte); +var temp: integer; +begin + if (x2= width) or (x2 < 0) then exit; + if x < 0 then x := 0; + if x2 >= width then x2 := width-1; + AlphaFill(alpha, y*width+x, x2-x+1); +end; + +procedure TMemBitmap.InvalidateBitmap; +begin + FRebuildBmp := True; +end; + +procedure TMemBitmap.RebuildBitmap; +var RawImage : TRawImage; ABitmap, AMask: HBitmap; +begin + if FBitmap = nil then FBitmap := TBitmap.Create; + + if Empty then + begin + FBitmap.Height := 0; + FBitmap.Width := 0; + end else + begin + RawImage.Init; + RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(Width,Height); + RawImage.Data:= PByte(data); + RawImage.DataSize:= nbPixels*sizeof(TMemPixel); + RawImage_CreateBitmaps(RawImage, ABitmap,AMask,False); + FBitmap.Handle := ABitmap; + FBitmap.MaskHandle := AMask; + end; +end; + +function TMemBitmap.GetBitmap: TBitmap; +begin + if FRebuildBmp or (FBitmap = nil) then + begin + RebuildBitmap; + FRebuildBmp := false; + end; + result := FBitmap; +end; + +procedure TMemBitmap.Init; +begin + FRefCount := 1; + FBitmap := nil; + FData := nil; + FWidth := 0; + FHeight := 0; +end; + +procedure TMemBitmap.SetInternalColor(x, y: integer; const Value: TFPColor); +var p: PByte; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + p := PByte(Scanline[y]+x); + p^ := Value.blue shr 8; inc(p); + p^ := Value.green shr 8; inc(p); + p^ := Value.red shr 8; inc(p); + p^ := Value.alpha shr 8; +end; + +function TMemBitmap.GetInternalColor(x, y: integer): TFPColor; +var p: PByte; v: byte; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + p := PByte(Scanline[y]+x); + v := p^; result.blue := v shl 8+v; inc(p); + v := p^; result.green := v shl 8+v; inc(p); + v := p^; result.red := v shl 8+v; inc(p); + v := p^; result.alpha := v shl 8+v; +end; + +procedure TMemBitmap.SetInternalPixel(x, y: integer; Value: integer); +var p: PByte; c: TFPColor; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + c := Palette.Color[Value]; + p := PByte(Scanline[y]+x); + p^ := c.blue shr 8; inc(p); + p^ := c.green shr 8; inc(p); + p^ := c.red shr 8; inc(p); + p^ := c.alpha shr 8; +end; + +function TMemBitmap.GetInternalPixel(x, y: integer): integer; +var p: PByte; v: byte; c: TFPColor; +begin + if (x<0) or (y<0) or (x>=width) or (y>=height) then exit; + p := PByte(Scanline[y]+x); + v := p^; c.blue := v shl 8+v; inc(p); + v := p^; c.green := v shl 8+v; inc(p); + v := p^; c.red := v shl 8+v; inc(p); + v := p^; c.alpha := v shl 8+v; + result := palette.IndexOf(c); +end; + +function TMemBitmap.NewReference: TMemBitmap; +begin + Inc(FRefCount); + result := self; +end; + +procedure TMemBitmap.FreeReference; +begin + if self=nil then exit; + + if FRefCount > 0 then + begin + Dec(FRefCount); + if FRefCount = 0 then + begin + self.Destroy; + end; + end; +end; + +function TMemBitmap.GetUnique: TMemBitmap; +begin + if FRefCount > 1 then + begin + Dec(FRefCount); + result := self.Duplicate; + end else + result := self; +end; + +procedure TMemBitmap.Draw(ACanvas: TCanvas; x, y: integer); +begin + if self=nil then exit; + ACanvas.Draw(x,y,Bitmap); +end; + +procedure TMemBitmap.Draw(ACanvas: TCanvas; Rect: TRect); +begin + if self=nil then exit; + ACanvas.StretchDraw(Rect,Bitmap); +end; + +procedure TMemBitmap.DrawHorizLine(x, y, x2: integer; c: TMemPixel); +var temp: integer; +begin + if (x2= width) or (x2 < 0) then exit; + if x < 0 then x := 0; + if x2 >= width then x2 := width-1; + DrawPixels(c, y*width+x, x2-x+1); +end; + +procedure TMemBitmap.SetHorizLine(x, y, x2: integer; c: TMemPixel); +var temp: integer; +begin + if (x2= width) or (x2 < 0) then exit; + if x < 0 then x := 0; + if x2 >= width then x2 := width-1; + Fill(c, y*width+x, x2-x+1); +end; + +procedure TMemBitmap.SetVertLine(x, y, y2: integer; c: TMemPixel); +var temp,n: integer; p: PMemPixel; +begin + if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; + if y < 0 then y := 0; + if y2 >= height then y2 := height-1; + p := scanline[y]+x; + for n := y2-y downto 0 do + begin + p^ := c; + inc(p,width); + end; +end; + +procedure TMemBitmap.DrawVertLine(x, y, y2: integer; c: TMemPixel); +var temp,n: integer; p: PMemPixel; +begin + if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; + if y < 0 then y := 0; + if y2 >= height then y2 := height-1; + p := scanline[y]+x; + for n := y2-y downto 0 do + begin + DrawPixel(p,c); + inc(p,width); + end; +end; + +procedure TMemBitmap.AlphaVertLine(x, y, y2: integer; alpha: byte); +var temp,n: integer; p: PMemPixel; +begin + if (y2= height) or (y2 < 0) or (x < 0) or (x >= width) then exit; + if y < 0 then y := 0; + if y2 >= height then y2 := height-1; + p := scanline[y]+x; + for n := y2-y downto 0 do + begin + p^.alpha := alpha; + inc(p,width); + end; +end; + +procedure TMemBitmap.Rectangle(x, y, x2, y2: integer; c: TMemPixel; + mode: TDrawMode); +var temp: integer; +begin + if (x>x2) then begin temp := x; x := x2; x2 := temp; end; + if (y>y2) then begin temp := y; y := y2; y2 := temp; end; + if (x2-x<=1) or (y2-y<=1) then exit; + case mode of + dmDrawWithTransparency: + begin + DrawHorizLine(x,y,x2-1, c); + DrawHorizLine(x,y2-1,x2-1, c); + if y2-y > 2 then + begin + DrawVertLine(x,y+1,y2-2, c); + DrawVertLine(x2-1,y+1,y2-2, c); + end; + end; + dmSet: + begin + SetHorizLine(x,y,x2-1, c); + SetHorizLine(x,y2-1,x2-1, c); + if y2-y > 2 then + begin + SetVertLine(x,y+1,y2-2, c); + SetVertLine(x2-1,y+1,y2-2, c); + end; + end; + dmSetExceptTransparent: if (c.alpha <> 0) then Rectangle(x,y,x2,y2,c,dmSet); + end; +end; + +procedure TMemBitmap.Rectangle(x, y, x2, y2: integer; c: TColor); +begin + Rectangle(x,y,x2,y2,MemPixel(c),dmSet); +end; + +procedure TMemBitmap.FillRect(x, y, x2, y2: integer; c: TMemPixel; + mode: TDrawMode); +var temp,yb: integer; +begin + if (x>x2) then begin temp := x; x := x2; x2 := temp; end; + if (y>y2) then begin temp := y; y := y2; y2 := temp; end; + if (x2-x<=0) or (y2-y<=0) then exit; + case mode of + dmDrawWithTransparency: + for yb := y to y2-1 do + DrawHorizLine(x,yb,x2-1, c); + dmSet: + for yb := y to y2-1 do + SetHorizLine(x,yb,x2-1, c); + dmSetExceptTransparent: if (c.alpha <> 0) then FillRect(x,y,x2,y2,c,dmSet); + end; +end; + +procedure TMemBitmap.FillRect(x, y, x2, y2: integer; c: TColor); +begin + FillRect(x,y,x2,y2,MemPixel(c),dmSet); +end; + +procedure TMemBitmap.AlphaFillRect(x, y, x2, y2: integer; alpha: byte); +var temp,yb: integer; +begin + if (x>x2) then begin temp := x; x := x2; x2 := temp; end; + if (y>y2) then begin temp := y; y := y2; y2 := temp; end; + if (x2-x<=0) or (y2-y<=0) then exit; + for yb := y to y2-1 do + AlphaHorizLine(x,yb,x2-1, alpha); +end; + +procedure TMemBitmap.Fill(c: TColor); +begin + Fill(MemPixel(c)); +end; + +procedure TMemBitmap.Fill(c: TMemPixel); +begin + Fill(c, 0, width*height); +end; + +procedure TMemBitmap.Fill(c: TMemPixel; start, count: integer); +var p: PMemPixel; +begin + if start < 0 then + begin + count += start; + start := 0; + end; + if start >= nbPixels then exit; + if start+count > nbPixels then count := nbPixels-start; + p := (Data+start); + while count > 0 do + begin + p^ := c; + inc(p); + dec(count); + end; +end; + +procedure TMemBitmap.AlphaFill(alpha: byte); +begin + AlphaFill(alpha,0,NbPixels); +end; + +procedure TMemBitmap.AlphaFill(alpha: byte; start, count: integer); +var p: PMemPixel; +begin + if start < 0 then + begin + count += start; + start := 0; + end; + if start >= nbPixels then exit; + if start+count > nbPixels then count := nbPixels-start; + p := (Data+start); + while count > 0 do + begin + p^.alpha := alpha; + inc(p); + dec(count); + end; +end; + +procedure TMemBitmap.ReplaceColor(before, after: TColor); +const colorMask = $00FFFFFF; +var p: PLongWord; + n: integer; + beforeBGR, afterBGR: LongWord; +begin + beforeBGR := (before and $FF shl 16) + (before and $FF00) + (before shr 16 and $FF); + afterBGR := (after and $FF shl 16) + (after and $FF00) + (after shr 16 and $FF); + p := PLongWord(Data); + for n := NbPixels-1 downto 0 do + begin + if p^ and colorMask = beforeBGR then + p^ := (p^ and not ColorMask) or afterBGR; + inc(p); + end; +end; + +procedure TMemBitmap.ReplaceColor(before, after: TMemPixel); +var p: PMemPixel; + n: integer; +begin + p := Data; + for n := NbPixels-1 downto 0 do + begin + if p^ = before then p^ := after; + inc(p); + end; +end; + +procedure TMemBitmap.DrawPixels(c: TMemPixel; start, count: integer); +var p: PMemPixel; +begin + if c.alpha = 0 then exit; + + if start < 0 then + begin + count += start; + start := 0; + end; + if start >= nbPixels then exit; + if start+count > nbPixels then count := nbPixels-start; + p := Data+start; + while count > 0 do + begin + DrawPixel(p,c); + inc(p); + dec(count); + end; +end; + +procedure TMemBitmap.PutImage(x, y: integer; bmp: TMemBitmap; mode: TDrawMode); +var x2,y2,yb,minxb,minyb,maxxb,ignoreleft,copycount,bmpwidth,i: integer; source,dest: PMemPixel; +begin + bmpwidth := bmp.width; + + if (x>= width) or (y>= height) or (x< -bmpwidth) or (y < -bmp.height) then exit; + + x2 := x+bmpwidth-1; + y2 := y+bmp.height-1; + + if y < 0 then minyb := 0 else minyb := y; + if y2 >= height then y2 := height-1; + + if x < 0 then + begin + ignoreleft := -x; + minxb := 0; + end else + begin + ignoreleft := 0; + minxb := x; + end; + if x2 >= width then maxxb := width-1 else maxxb := x2; + + copycount := maxxb-minxb+1; + + source := bmp.ScanLine[minyb-y]+ignoreleft; + dest := Scanline[minyb]+minxb; + + case mode of + dmSet: begin + copycount *= sizeof(TMemPixel); + for yb := minyb to y2 do + begin + move(source^,dest^, copycount); + inc(source, bmpwidth); + inc(dest, width); + end; + end; + dmSetExceptTransparent: + for yb := minyb to y2 do + begin + for i := copycount-1 downto 0 do + begin + if source^.alpha = 255 then dest^ := source^; + inc(dest); + inc(source); + end; + inc(source, bmpwidth-copycount); + inc(dest, width-copycount); + end; + dmDrawWithTransparency: + for yb := minyb to y2 do + begin + for i := copycount-1 downto 0 do + begin + DrawPixel(dest,source^); + inc(dest); + inc(source); + end; + inc(source, bmpwidth-copycount); + inc(dest, width-copycount); + end; + end; +end; + +function TMemBitmap.Duplicate: TMemBitmap; +begin + result := TMemBitmap.Create(width,height); + result.PutImage(0,0,self,dmSet); +end; + +procedure TMemBitmap.GetImage(Canvas: TCanvas; x, y: integer; defaultColor: TColor); +var bmp: TBitmap; xb,yb: integer; + source: PByte; dest: PByte; + {$IFDEF gtkbugfix} + Ofs: TPoint; + dcSource,dcDest : TGtkDeviceContext; + {$ENDIF} + rectSource,rectDest: TRect; + + function ClipRect: boolean; + var delta: integer; + begin + if rectSource.Left < 0 then + begin + delta := -rectSource.left; + inc(rectSource.Left,delta); + inc(rectDest.Left,delta); + end; + if rectSource.Top < 0 then + begin + delta := -rectSource.Top; + inc(rectSource.Top,delta); + inc(rectDest.Top,delta); + end; + if rectSource.Right > Canvas.Width then + begin + delta := rectSource.Right-Canvas.Width; + dec(rectSource.Right,delta); + dec(rectDest.Right,delta); + end; + if rectSource.Bottom > Canvas.Height then + begin + delta := rectSource.Bottom-Canvas.Height; + dec(rectSource.Bottom,delta); + dec(rectDest.Bottom,delta); + end; + result := (rectSource.Right>rectSource.Left) and + (rectSource.Bottom>rectSource.Top) and + (rectDest.Right>rectDest.Left) and + (rectDest.Bottom>rectDest.Top); + end; + +begin + bmp := TBitmap.Create; + bmp.PixelFormat:= pf24bit; + bmp.width := width; + bmp.height := height; + bmp.Canvas.Brush.Color := defaultColor; + bmp.Canvas.FillRect(0,0,width,height); + rectSource := classes.rect(x,y,x+width,y+height); + rectDest := classes.rect(0,0,width,height); + + {$IFDEF gtkbugfix} + dcDest := TGtkDeviceContext(bmp.Canvas.handle); + dcSource := TGtkDeviceContext(Canvas.Handle); + if (dcSource <> nil) and (dcDest <> nil) then + begin + Ofs := dcSource.Offset; + rectSource.Left += Ofs.X; + rectSource.Top += Ofs.Y; + rectSource.Right += Ofs.X; + rectSource.Bottom += Ofs.Y; + if ClipRect then + begin + if (dcDest.Drawable<>nil) and (dcDest.GC <> nil) and (dcSource.Drawable <> nil) then + gdk_window_copy_area(dcDest.Drawable, dcDest.GC, rectDest.Left,rectDest.top, dcSource.Drawable,rectSource.Left,rectSource.Top, rectSource.Right-rectSource.Left,rectSource.Bottom-rectSource.Top); + end; + end; + {$ELSE} + if ClipRect then + bmp.Canvas.CopyRect(rectDest,Canvas,rectSource); + {$ENDIF} + + if bmp.RawImage.Description.BitsPerPixel = 32 then + begin + for yb := 0 to height-1 do + begin + if bmp.rawImage.Description.LineOrder = riloTopToBottom then + source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(yb) else + source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(height-1-yb); + dest := pbyte(ScanLine[yb]); + for xb := 0 to width-1 do + begin + PWord(dest)^ := PWord(source)^; + inc(dest,2); inc(source, 2); + dest^ := source ^; + inc(dest); inc(source, 2); + dest^:= 255; + inc(dest); + end; + end; + end else + if bmp.RawImage.Description.BitsPerPixel = 24 then + begin + for yb := 0 to height-1 do + begin + if bmp.rawImage.Description.LineOrder = riloTopToBottom then + source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(yb) else + source := bmp.rawImage.Data+ bmp.rawImage.Description.BytesPerLine*cardinal(height-1-yb); + dest := pbyte(ScanLine[yb]); + for xb := 0 to width-1 do + begin + PWord(dest)^ := PWord(source)^; + inc(dest,2); inc(source, 2); + dest^ := source ^; + inc(dest); inc(source); + dest^:= 255; + inc(dest); + end; + end; + end; + + bmp.Free; +end; + +function TMemBitmap.ResampleSmaller(newWidth, newHeight: integer + ): TMemBitmap; +const maxvalue= 255; +var + x_dest,y_dest : integer; + inc_x_src, mod_x_src, acc_x_src, inc_y_src, mod_y_src, acc_y_src : integer; + x_src,y_src,prev_x_src,prev_y_src: integer; + x_src2,y_src2: integer; + + xb,yb : integer; + alpha,v1,v2,v3,v4: double; + nb: integer; + c: TMemPixel; + pdest,psrc: PMemPixel; +begin + result := TMemBitmap.Create(NewWidth, NewHeight); + if (newWidth = 0) or (newHeight = 0) or (Width= 0) or (Height = 0) then exit; + inc_x_src := width div newWidth; + mod_x_src := width mod newWidth; + inc_y_src := height div newHeight; + mod_y_src := height mod newHeight; + + y_src := 0; + acc_y_src := 0; + PDest := result.ScanLine[0]; + for y_dest := 0 to newHeight-1 do + begin + prev_y_src := y_src; + inc(y_src,inc_y_src); + inc(acc_y_src,mod_y_src); + if acc_y_src >= newHeight then + begin + dec(acc_y_src,newHeight); + inc(y_src); + end; + + x_src := 0; + acc_x_src := 0; + for x_dest := 0 to newWidth-1 do + begin + prev_x_src := x_src; + inc(x_src,inc_x_src); + inc(acc_x_src,mod_x_src); + if acc_x_src >= newWidth then + begin + dec(acc_x_src,newWidth); + inc(x_src); + end; + + if x_src > prev_x_src then x_src2 := x_src-1 else x_src2 := x_src; + if y_src > prev_y_src then y_src2 := y_src-1 else y_src2 := y_src; + + v1 := 0; + v2 := 0; + v3 := 0; + v4 := 0; + nb := 0; + for yb := prev_y_src to y_src2 do + begin + PSrc := Scanline[yb]+prev_x_src; + for xb := prev_x_src to x_src2 do + begin + c := PSrc^; inc(PSrc); + alpha := c.alpha/maxvalue; + v1 += c.red*alpha; + v2 += c.green*alpha; + v3 += c.blue*alpha; + v4 += alpha; + inc(nb); + end; + end; + + if (v4<>0) and (nb <> 0) then + begin + c.red := round(v1/v4); + c.green := round(v2/v4); + c.blue := round(v3/v4); + c.alpha := round(v4/nb*maxvalue); + end else + begin + c.alpha := 0; + c.red := 0; + c.green := 0; + c.blue := 0; + end; + PDest^ := c; + inc(PDest); + end; + end; +end; + +function TMemBitmap.GetHasTransparentPixels: boolean; +var p: PMemPixel; n: integer; +begin + p := Data; + for n := NbPixels-1 downto 0 do + begin + if p^.alpha <> 255 then + begin + result := true; + exit; + end; + inc(p); + end; + result := false; +end; + +function TMemBitmap.GetAverageColor: TColor; +var n: integer; p: PMemPixel; + r,g,b,sum: double; + alpha: double; +begin + sum := 0; + r := 0; + g := 0; + b := 0; + p := Data; + for n := NbPixels-1 downto 0 do + begin + alpha := p^.alpha/255; + sum += alpha; + r += p^.red*alpha; + g += p^.green*alpha; + b += p^.blue*alpha; + end; + if sum=0 then result := clNone else + result := round(r/sum) + round(g/sum) shl 8 + round(b/sum) shl 16; +end; + +function TMemBitmap.ResampleLarger(newWidth, newHeight: integer): TMemBitmap; +const maxvalue = 255; +var + x_src,y_src : integer; + inc_x_dest, mod_x_dest, acc_x_dest, inc_y_dest, mod_y_dest, acc_y_dest : integer; + x_dest,y_dest,prev_x_dest,prev_y_dest: integer; + x_dest2,y_dest2,{x_src2,}y_src2: integer; + + xb,yb : integer; + cUpLeft,cUpRight,cLowLeft,cLowRight: TMemPixel; + factX,factY,factAddX,factAddY,factCorrX,factCorrY: single; + factUpLeft,factUpRight,factLowLeft,factLowRight: single; + factUpLeftAlpha,factUpRightAlpha,factLowLeftAlpha,factLowRightAlpha: single; + cur: TMemPixel; + alphaUpLeft, alphaUpRight, alphaLowLeft, alphaLowRight: single; + sumFactAlpha: single; + PDest,PSrc,PSrc2 : PMemPixel; + + temp: TMemBitmap; + +begin + result := TMemBitmap.Create(NewWidth, NewHeight); + if (newWidth = 0) or (newHeight = 0) then exit; + + if (width=1) and (height=1) then + begin + result.Fill(GetPixel(0,0)); + exit; + end else + if width=1 then + begin + temp := TMemBitmap.Create(2,Height); + temp.PutImage(0,0,self,dmSet); + temp.PutImage(1,0,self,dmSet); + result := temp.ResampleLarger(newWidth,newHeight); + temp.Free; + exit; + end else + if height=1 then + begin + temp := TMemBitmap.Create(Width,2); + temp.PutImage(0,0,self,dmSet); + temp.PutImage(0,1,self,dmSet); + result := temp.ResampleLarger(newWidth,newHeight); + temp.Free; + exit; + end; + + inc_x_dest := newwidth div (Width-1); + mod_x_dest := newwidth mod (Width-1); + inc_y_dest := newheight div (Height-1); + mod_y_dest := newheight mod (Height-1); + + y_dest := 0; + acc_y_dest := 0; + for y_src := 0 to Height-2 do + begin + prev_y_dest := y_dest; + inc(y_dest,inc_y_dest); + inc(acc_y_dest,mod_y_dest); + if acc_y_dest >= Height then + begin + dec(acc_y_dest,Height); + inc(y_dest); + end; + + y_src2 := y_src+1; + PSrc := Scanline[y_src]; + PSrc2 := Scanline[y_src2]; + cUpLeft := PSrc^; inc(PSrc); + cLowLeft := PSrc2^; inc(PSrc2); + + x_dest := 0; + acc_x_dest := 0; + for x_src := 0 to Width-2 do + begin + prev_x_dest := x_dest; + inc(x_dest,inc_x_dest); + inc(acc_x_dest,mod_x_dest); + if acc_x_dest >= Width then + begin + dec(acc_x_dest,Width); + inc(x_dest); + end; + + //x_src2 := x_src+1; + if x_src < width-2 then + begin + x_dest2 := x_dest-1; + factAddX := 1/(x_dest2-prev_x_dest+1); + end else + begin + x_dest2 := newWidth-1; + factAddX := 1/(x_dest2-prev_x_dest); + end; + if y_src < height-2 then + begin + y_dest2 := y_dest-1; + factAddY := 1/(y_dest2-prev_y_dest+1); + end else + begin + y_dest2 := newHeight-1; + factAddY := 1/(y_dest2-prev_y_dest); + end; + + cUpRight := PSrc^; inc(PSrc); + cLowRight := PSrc2^; inc(PSrc2); + + factY := 0; + for yb := prev_y_dest to y_dest2 do + begin + factX := 0; + PDest := result.scanline[yb]+prev_x_dest; + for xb := prev_x_dest to x_dest2 do + begin + factCorrX := 0.5-cos(factX*Pi)/2; + factCorrY := 0.5-cos(factY*Pi)/2; + + alphaUpLeft := cUpLeft.alpha/maxvalue; + alphaUpRight := cUpRight.alpha/maxvalue; + alphaLowLeft := cLowLeft.alpha/maxvalue; + alphaLowRight := cLowRight.alpha/maxvalue; + + factUpLeft := (1-factCorrX)*(1-factCorrY); + factUpRight := factCorrX*(1-factCorrY); + factLowLeft := (1-factCorrX)*factCorrY; + factLowRight := factCorrX*factCorrY; + + factUpLeftAlpha := factUpLeft*alphaUpLeft; + factUpRightAlpha := factUpRight*alphaUpRight; + factLowLeftAlpha := factLowLeft*alphaLowLeft; + factLowRightAlpha := factLowRight*alphaLowRight; + + sumFactAlpha := factUpLeftAlpha+factUpRightAlpha+factLowLeftAlpha+factLowRightAlpha; + if sumFactAlpha=0 then + begin + cur.alpha := 0; + cur.red := 0; + cur.green := 0; + cur.blue := 0; + end else + begin + cur.red := round((factUpLeftAlpha*cUpLeft.red + factUpRightAlpha*cUpRight.red + + factLowLeftAlpha*cLowLeft.red + factLowRightAlpha*cLowRight.red)/sumFactAlpha); + cur.green := round((factUpLeftAlpha*cUpLeft.green + factUpRightAlpha*cUpRight.green + + factLowLeftAlpha*cLowLeft.green + factLowRightAlpha*cLowRight.green)/sumFactAlpha); + cur.blue := round((factUpLeftAlpha*cUpLeft.blue + factUpRightAlpha*cUpRight.blue + + factLowLeftAlpha*cLowLeft.blue + factLowRightAlpha*cLowRight.blue)/sumFactAlpha); + cur.alpha := round(sumFactAlpha*maxvalue); + end; + PDest^ := cur; inc(PDest); + factX := factX + factAddX; + end; + factY := factY+factAddY; + end; + cUpLeft := cUpRight; + cLowLeft := cLowRight; + end; + end; +end; + +function TMemBitmap.Resample(NewWidth, NewHeight: Integer): TMemBitmap; +var temp,newtemp: TMemBitmap; +begin + if (NewWidth = Width) and (NewHeight = Height) then + result := Duplicate else + if (NewWidth >= Width) and (NewHeight >= Height) then + result := ResampleLarger(NewWidth,NewHeight) else + if (NewWidth <= Width) and (NewHeight <= Height) then + result := ResampleSmaller(NewWidth,NewHeight) else + begin + temp := self; + + if NewWidth < Width then + begin + newtemp := temp.ResampleSmaller(NewWidth,temp.Height); + if (temp<>self) then temp.free; + temp := newtemp; + end; + + if NewHeight < Height then + begin + newtemp := temp.ResampleSmaller(temp.Width,NewHeight); + if (temp<>self) then temp.free; + temp := newtemp; + end; + + if NewWidth > Width then + begin + newtemp := temp.ResampleLarger(NewWidth,temp.Height); + if (temp<>self) then temp.free; + temp := newtemp; + end; + + if NewHeight > Height then + begin + newtemp := temp.ResampleLarger(temp.Width,NewHeight); + if (temp<>self) then temp.free; + temp := newtemp; + end; + + if temp<>self then result := temp else + result := self.Duplicate; + end; +end; + +procedure TMemBitmap.VerticalFlip; +var yb: integer; + line: PMemPixel; + linesize: integer; +begin + if Data= nil then exit; + + linesize := Width*sizeof(TMemPixel); + line := nil; + getmem(line, linesize); + for yb := 0 to (Height div 2)-1 do + begin + move(Scanline[yb]^, line^, linesize); + move(Scanline[Height-1-yb]^, Scanline[yb]^, linesize); + move(line^, Scanline[Height-1-yb]^, linesize); + end; + freemem(line); +end; + +procedure TMemBitmap.DrawPartial(Arect: TRect; Canvas: TCanvas; x,y: integer); +var partial: TMemBitmap; + copywidth,copyheight,widthleft,heightleft,curxin,curyin,xdest,ydest,tx,ty: integer; +begin + tx := ARect.Right-ARect.Left; + ty := ARect.Bottom-ARect.Top; + + if ARect.Left >= Width then ARect.Left := ARect.Left mod Width else + if ARect.Left < 0 then ARect.Left := Width - ((-ARect.Left) mod Width); + ARect.Right := ARect.Left+tx; + + if ARect.Top >= Height then ARect.Top := ARect.Top mod Height else + if ARect.Top < 0 then ARect.Top := Height - ((-ARect.Top) mod Height); + ARect.Bottom := ARect.Top+ty; + + if (ARect.Left = 0) and (ARect.Top = 0) and (ARect.Right = Width) and (ARect.Bottom = Height) then + begin + Draw(Canvas,x,y); + exit; + end; + + partial := TMemBitmap.Create(tx,ty); + heightleft := partial.height; + curyin := ARect.Top; + ydest := -ARect.Top; + while heightleft > 0 do + begin + if curyin + heightleft > height then copyheight := height-curyin else + copyheight := heightleft; + + widthleft := partial.width; + curxin := ARect.Left; + xdest := -ARect.Left; + while widthleft > 0 do + begin + if curxin + widthleft > width then copywidth := width-curxin else + copywidth := widthleft; + + partial.PutImage(xdest,ydest,self,dmSet); + + curxin := 0; + dec(widthleft, copywidth); + inc(xdest,copywidth); + end; + curyin := 0; + dec(heightleft, copyheight); + inc(ydest,copyheight); + end; + partial.Draw(Canvas,x,y); + partial.Free; +end; + +end. \ No newline at end of file diff --git a/baseunits/extras/MangaFoxWatermark.pas b/baseunits/extras/MangaFoxWatermark.pas new file mode 100644 index 000000000..d09df90bf --- /dev/null +++ b/baseunits/extras/MangaFoxWatermark.pas @@ -0,0 +1,496 @@ +{ MangaFoxWatermark.pas + + Copyright (C) 2016 + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library General Public License as published by + the Free Software Foundation; either version 2 of the License, or (at your + option) any later version with the following modification: + + As a special exception, the copyright holders of this library give you + permission to link this library with independent modules to produce an + executable, regardless of the license terms of these independent modules,and + to copy and distribute the resulting executable under terms of your choice, + provided that you also meet, for each linked independent module, the terms + and conditions of the license of that module. An independent module is a + module which is not derived from or based on this library. If you modify + this library, you may extend this exception to your version of the library, + but you are not obligated to do so. If you do not wish to do so, delete this + exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} + +unit MangaFoxWatermark; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, LazFileUtils, LazUTF8Classes, Math, FPimage, FPReadJPEG, FPWriteJPEG, + FPWritePNG, ImgInfos; + +procedure SetTemplateDirectory(const Directory: String); +function LoadTemplate(const Directory: String = ''): Integer; +procedure ClearTemplate; +function RemoveWatermark(const FileName: String; const SaveAsPNG: Boolean = False): Boolean; inline; + +implementation + +type + POneBitImage = ^TOneBitImage; + TOneBitImage = record + Width: Integer; + Heigth: Integer; + Bits: Pointer; + BitsLength: Integer; + end; + + { TWatermarkRemover } + + TWatermarkRemover = class + private + FCS_Templates: TRTLCriticalSection; + FCS_RemoveWatermark: TRTLCriticalSection; + FTemplates: array of TOneBitImage; + FTemplateDirectory: String; + FCleared: Boolean; + procedure AddTemplate(const Image: TOneBitImage); + function GetTemplate(const Index: Integer): POneBitImage; + function GetTemplateCount: Integer; + protected + function AddFileToTemplates(const FileName: String): Boolean; + public + MinPSNR: Single; + MinWhiteBorder: Integer; + constructor Create; + destructor Destroy; override; + function LoadTemplate(const ADirectory: String = ''): Integer; + procedure ClearTemplate; + function RemoveWatermark(const AFileName: String; const SaveAsPNG: Boolean = False): Boolean; + property TemplateDirectory: String read FTemplateDirectory write FTemplateDirectory; + property TemplateCount: Integer read GetTemplateCount; + property Template[const Index: Integer]: POneBitImage read GetTemplate; + end; + +var + WatermarkRemover: TWatermarkRemover; + +procedure SetTemplateDirectory(const Directory: String); +begin + if WatermarkRemover = nil then + WatermarkRemover := TWatermarkRemover.Create; + WatermarkRemover.TemplateDirectory := Directory; +end; + +function LoadTemplate(const Directory: String): Integer; +begin + if WatermarkRemover = nil then + WatermarkRemover := TWatermarkRemover.Create; + Result := WatermarkRemover.LoadTemplate(Directory); +end; + +procedure ClearTemplate; +begin + if Assigned(WatermarkRemover) then + begin + WatermarkRemover.ClearTemplate; + FreeAndNil(WatermarkRemover); + end; +end; + +function RemoveWatermark(const FileName: String; const SaveAsPNG: Boolean): Boolean; +begin + Result := False; + if Assigned(WatermarkRemover) then + Result := WatermarkRemover.RemoveWatermark(FileName, SaveAsPNG); +end; + +{ TWatermarkTemplates } + +procedure TWatermarkRemover.AddTemplate(const Image: TOneBitImage); +var + i: Integer; +begin + i := Length(FTemplates); + SetLength(FTemplates, i + 1); + FTemplates[i] := Image; +end; + +function TWatermarkRemover.GetTemplate(const Index: Integer): POneBitImage; +begin + Result := @FTemplates[Index]; +end; + +function TWatermarkRemover.GetTemplateCount: Integer; +begin + Result := Length(FTemplates); +end; + +procedure OtsuThresholding(const Image: TOneBitImage); +var + histogram: array[0..255] of Integer; + threshold: Byte; + meanTotal, variance, maxVariance, zerothCumuMoment, firstCumuMoment: Single; + i: Integer; + bit: PByte; +begin + FillChar(histogram, SizeOf(histogram), 0); + bit := Image.Bits; + for i := 0 to Image.BitsLength - 1 do + begin + Inc(histogram[bit^]); + Inc(bit); + end; + threshold := 0; + meanTotal := 0; + maxVariance := 0; + firstCumuMoment := 0; + zerothCumuMoment := 0; + for i := 0 to 255 do + meanTotal := meanTotal + (i * histogram[i] / Image.BitsLength); + for i := 0 to 255 do + begin + zerothCumuMoment := zerothCumuMoment + histogram[i] / Image.BitsLength; + firstCumuMoment := firstCumuMoment + (i * histogram[i] / Image.BitsLength); + variance := meanTotal * zerothCumuMoment - firstCumuMoment; + variance := variance * variance; + if ((zerothCumuMoment <> 0) and (zerothCumuMoment <> 1)) then + begin + variance := variance / (zerothCumuMoment * (1 - zerothCumuMoment)); + if (maxVariance < variance) then + begin + maxVariance := variance; + threshold := i; + end; + end; + end; + + bit := Image.Bits; + for i := 0 to Image.BitsLength - 1 do + begin + if bit^ > threshold then + bit^ := 255 + else + bit^ := 0; + Inc(bit); + end; +end; + +procedure BuildImageToOneBit(const Image: TFPCustomImage; + var OutImage: TOneBitImage; + const Left: Integer = -1; + const Top: Integer = -1; + const Right: Integer = -1; + const Bottom: Integer = -1); +var + X, Y, L, R, T, B: Integer; + Bit: PByte; + ML, MT: Integer; +begin + L := Left; + T := Top; + R := Right; + B := Bottom; + if (L < 0) or (L > Image.Width) then L := 0; + if (T < 0) or (T > Image.Height) then T := 0; + if (R < 0) or (R <= L) then R := Image.Width; + if (B < 0) or (B <= T) then B := Image.Height; + OutImage.Width := R - L; + OutImage.Heigth := B - T; + OutImage.BitsLength := OutImage.Width * OutImage.Heigth; + Getmem(OutImage.Bits, OutImage.BitsLength); + Bit := OutImage.Bits; + if (R <= Image.Width) and (B <= Image.Height) then + begin + for Y := T to B - 1 do + for X := L to R - 1 do + begin + Bit^ := CalculateGray(Image.Colors[X, Y]) shr 8; + Inc(Bit); + end; + end + else + begin + FillChar(OutImage.Bits^, OutImage.BitsLength, $ff); + ML := (R - Image.Width) div 2; + MT := ((B - Image.Height) div 2) * OutImage.Width; + if MT > 0 then + Inc(Bit, MT); + if ML > 0 then + begin + Inc(Bit, ML); + ML := ML + (R - Image.Width - ML); + end; + for Y := T to B - 1 do + begin + for X := L to Image.Width - 1 do + begin + Bit^ := CalculateGray(Image.Colors[X, Y]) shr 8; + Inc(Bit); + end; + if ML > 0 then + Inc(Bit, ML); + end; + end; + OtsuThresholding(OutImage); +end; + +function TWatermarkRemover.AddFileToTemplates(const FileName: String): Boolean; +var + FS: TFileStreamUTF8; + IMG: TFPCustomImage; + H: TFPCustomImageReaderClass; + R: TFPCustomImageReader; + BIMG: TOneBitImage; +begin + Result := False; + H := GetImageFileReaderClass(FileName); + if H = nil then Exit; + IMG := TFPMemoryImage.Create(0, 0); + try + try + R := H.Create; + FS := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); + IMG.LoadFromStream(FS, R); + finally + R.Free; + FS.Free; + end; + FillChar(BIMG, SizeOf(BIMG), 0); + BuildImageToOneBit(IMG, BIMG); + AddTemplate(BIMG); + Result := True; + finally + IMG.Free; + end; +end; + +constructor TWatermarkRemover.Create; +begin + InitCriticalSection(FCS_Templates); + InitCriticalSection(FCS_RemoveWatermark); + FCleared := True; + MinPSNR := 9.0; + MinWhiteBorder := 4; +end; + +destructor TWatermarkRemover.Destroy; +begin + ClearTemplate; + DoneCriticalsection(FCS_Templates); + DoneCriticalsection(FCS_RemoveWatermark); +end; + +function TWatermarkRemover.LoadTemplate(const ADirectory: String): Integer; +var + Files: TStrings; + D: String; + I: Integer; +begin + Result := 0; + FCleared := False; + if (ADirectory <> '') and (ADirectory <> FTemplateDirectory) then + FTemplateDirectory := ADirectory; + if FTemplateDirectory = '' then Exit; + D := CleanAndExpandDirectory(FTemplateDirectory); + if not DirectoryExistsUTF8(D) then Exit; + if TryEnterCriticalsection(FCS_Templates) <> 0 then + try + Files := TStringList.Create; + ClearTemplate; + FCleared := False; + FindAllFiles(Files, CleanAndExpandDirectory(D), '*.*', False); + if Files.Count = 0 then Exit; + for I := 0 to Files.Count - 1 do + if AddFileToTemplates(Files[I]) then + Inc(Result); + finally + Files.Free; + LeaveCriticalsection(FCS_Templates); + end; +end; + +procedure TWatermarkRemover.ClearTemplate; +var + i: Integer; +begin + for i := Low(FTemplates) to High(FTemplates) do + Freemem(FTemplates[i].Bits); + SetLength(FTemplates, 0); + FCleared := True; +end; + +function CalculatePSNR(const Image1, Image2: TOneBitImage): Single; +var + MSE: Single; + i: Integer; + bit1, bit2: PByte; +begin + Result := 0.0; + if Image1.BitsLength <> Image2.BitsLength then + Exit; + MSE := 0.0; + bit1 := Image1.Bits; + bit2 := Image2.Bits; + for i := 0 to Image1.BitsLength - 1 do + begin + if bit1^ <> bit2^ then + MSE := MSE + sqr(abs(bit2^ - bit1^)); + Inc(bit1); + Inc(bit2); + end; + MSE := MSE / Image1.BitsLength; + if Sqrt(MSE) < 0.0001 then + Result := 1e06 + else + Result := 10 * log10(sqr(255) / MSE); +end; + +function TWatermarkRemover.RemoveWatermark(const AFileName: String; + const SaveAsPNG: Boolean): Boolean; +var + Handler: TImageHandlerRec; + Reader: TFPCustomImageReader; + Writer: TFPCustomImageWriter; + Image, ImageTemp: TFPCustomImage; + FileStream: TFileStreamUTF8; + BestIndex, I, L, T, R, B: Integer; + BestValue, PSNR: Single; + TIMG: TOneBitImage; + NewFileName: String; + GrayScale: Boolean; + InvalidBorder: Boolean; + Bit: PByte; +begin + Result := False; + EnterCriticalsection(FCS_RemoveWatermark); + try + if TemplateCount = 0 then + begin + if not FCleared then Exit; + LoadTemplate; + end; + if TemplateCount = 0 then Exit; + Handler := GetImageHandlerByFile(AFileName); + if Handler.Ext = '' then Exit; + Image := TFPMemoryImage.Create(0, 0); + try + GrayScale := False; + try + Reader := Handler.ReaderClass.Create; + FileStream := TFileStreamUTF8.Create(AFileName, fmOpenRead or fmShareDenyWrite); + Image.LoadFromStream(FileStream, Reader); + if Reader is TFPReaderJPEG then + GrayScale := TFPReaderJPEG(Reader).GrayScale; + finally + Reader.Free; + FileStream.Free; + end; + BestIndex := -1; + BestValue := 0.0; + FillChar(TIMG, SizeOf(TIMG), 0); + for I := 0 to TemplateCount - 1 do + if Image.Height >= FTemplates[i].Heigth then + begin + if Image.Width > FTemplates[i].Width then + L := (Image.Width - FTemplates[i].Width) div 2 + else + L := 0; + R := L + FTemplates[i].Width; + T := Image.Height - FTemplates[i].Heigth; + B := Image.Height; + BuildImageToOneBit(Image, TIMG, L, T, R, B); + try + InvalidBorder := False; + if MinWhiteBorder > 0 then + begin + Bit := TIMG.Bits; + R := MinWhiteBorder * TIMG.Width; + for L := 0 to R - 1 do + begin + if Bit^ = 0 then + begin + InvalidBorder := True; + Break; + end; + Inc(Bit); + end; + end; + if not InvalidBorder then + begin + PSNR := CalculatePSNR(TIMG, FTemplates[I]); + if PSNR > BestValue then + begin + BestValue := PSNR; + BestIndex := I; + end; + Bit := TIMG.Bits; + end; + finally + Freemem(TIMG.Bits); + end; + end; + if (BestValue >= MinPSNR) and (BestIndex <> -1) then + try + ImageTemp := TFPMemoryImage.Create(Image.Width, Image.Height - FTemplates[BestIndex].Heigth); + for T := 0 to ImageTemp.Height - 1 do + for L := 0 to ImageTemp.Width - 1 do + ImageTemp.Colors[L, T] := Image.Colors[L, T]; + if SaveAsPNG then + begin + Handler.WriterClass := TFPWriterPNG; + Handler.WExt := 'png'; + end; + NewFileName := ExtractFileNameWithoutExt(AFileName) + '.' + Handler.WExt; + if FileExistsUTF8(AFileName) then + DeleteFileUTF8(AFileName); + if FileExistsUTF8(NewFileName) then + DeleteFileUTF8(NewFileName); + if not FileExistsUTF8(NewFileName) then + begin + try + Writer := Handler.WriterClass.Create; + FileStream := TFileStreamUTF8.Create(NewFileName, fmCreate); + {$IF (FPC_FULLVERSION >= 30101)} + if Writer is TFPWriterJPEG then + TFPWriterJPEG(Writer).GrayScale := GrayScale + else + {$ENDIF} + if Writer is TFPWriterPNG then + begin + if GrayScale then + TFPWriterPNG(Writer).Indexed := True; + end; + ImageTemp.SaveToStream(FileStream, Writer); + finally + Writer.Free; + FileStream.Free; + end; + Result := FileExistsUTF8(NewFileName); + end; + finally + ImageTemp.Free; + end; + finally + Image.Free; + end; + finally + LeaveCriticalsection(FCS_RemoveWatermark); + end; +end; + +initialization + +finalization + if Assigned(WatermarkRemover) then WatermarkRemover.Free; + +end. diff --git a/baseunits/fasthtmlparser/jsFastHTMLParser.pas b/baseunits/fasthtmlparser/jsFastHTMLParser.pas deleted file mode 100644 index b916e9658..000000000 --- a/baseunits/fasthtmlparser/jsFastHTMLParser.pas +++ /dev/null @@ -1,376 +0,0 @@ -{$MODE Delphi} -{ - This is a FastHTMLParser unit to parse HTML - (disect html into its tags and text.) - - - Modified for use as a pure command line unit (no dialogs) for freepascal. - - Also added UPPERCASE tags so that when you check for it returns all - tags like and and - - Regards, - Lars aka L505 - http://z505.com - - - Use it to: - -Make your own web browsers, - -make your own text web browsers (something like Lynx for linux maybe) - -Parse websites - -Grab content from websites -without- using regular expressions - -Seems to be MUCH MUCH FASTER than regular expressions, from what I tested. - -convert website tables into spreadsheets (you have to do the work after parsing it) - -convert websites into text files (you have to do the work after parsing it) - -convert website tables into CSV/Database (you have to do the work after parsing it) - -find certain info from a web page.. i.e. all the table cells, all the bold text. - -Parse websites remotely from a CGI app using something like Synapse and SynWrap - to first get the HTML site, then parse it with these fasthtmlparse units. - This would allow you to dynamically parse info from websites and display - data on your site in real time. -} - -//////////////////////////////////////////////////////////////////////////////// -// // -// TITLE : Fast HTML Parser // -// CLASS : TjsFastHTMLParser // -// VERSION : 0.4 // -// AUTHOR : James Azarja // -// WEBSITE : http://www.jazarsoft.com/ // -// LEGAL : Copyright (C) 2004 Jazarsoft, All Rights Reserved. // -// // -//////////////////////////////////////////////////////////////////////////////// -// // -// This code may be used and modified by anyone so long as this header and // -// copyright information remains intact. // -// // -// The code is provided "AS-IS" and without WARRANTY OF ANY KIND, // -// expressed, implied or otherwise, including and without limitation, any // -// warranty of merchantability or fitness for a particular purpose. // -// // -// In no event shall the author be liable for any special, incidental, // -// indirect or consequential damages whatsoever (including, without // -// limitation, damages for loss of profits, business interruption, loss // -// of information, or any other loss), whether or not advised of the // -// possibility of damage, and on any theory of liability, arising out of // -// or in connection with the use or inability to use this software. // -// // -//////////////////////////////////////////////////////////////////////////////// -// // -// HISTORY: // -// 0.1 - [o] Initial Development // -// mostly based on Peter Irlam works & ideas // -// 0.2 - [*] Some minor bug has fixed // -// 0.3 - [*] Some jsHTMLUtil function bug has been fixed // -// 0.4 - [*] jsHTMLUtil Tag Attributes bug has been fixed // -// thanks to Dmitry [mail@vader.ru] // -// // -// LEGEND: // -// [o] : Information // -// [+] : Add something // -// [-] : Remove something // -// [*] : Fix // -// // -//////////////////////////////////////////////////////////////////////////////// -{ $Id: jsFastHTMLParser.pas,v 1.2 2004/09/10 02:25:56 jazar Exp $ } - -unit jsFastHTMLParser; - -interface - -Uses SysUtils; - -type - TOnFoundTag = procedure(Tag: string) of object; - TOnFoundText = procedure(Text: string) of object; - - TjsFastHTMLParser = class(TObject) - public - OnFoundTag : TOnFoundTag; - OnFoundText : TOnFoundText; - Raw : Pchar; - constructor Create(sRaw:String);overload; - constructor Create(pRaw:PChar);overload; - destructor Destroy; override; - procedure Exec; - procedure SlowExec; - procedure ExecUpCase; //same as Exec, but all tags are now converted to UPPERCASE (consistent) - end; - -implementation - -function CopyBuffer(StartIndex: PChar;Length:Integer):String; -Var - S : String; -begin - SetLength(S, Length); - StrLCopy(@S[1], StartIndex, Length); - Result := S; - S:= ''; -end; - -constructor TjsFastHTMLParser.Create(sRaw:String); -begin - inherited Create; - Raw := Pchar(sRaw); -end; - -constructor TjsFastHTMLParser.Create(pRaw:Pchar); -begin - inherited Create; - Raw := pRaw; -end; - -destructor TjsFastHTMLParser.Destroy; -begin - Raw:= ''; - inherited Destroy; -end; - -procedure TjsFastHTMLParser.Exec; -Var - L : Integer; - TL : Integer; - I : Integer; - Done : Boolean; - TagStart, - TextStart, - P : PChar; // Pointer to current char. - C : Char; -begin - TL := StrLen(Raw); - I := 0; - P := Raw; - Done := False; - if P<>nil then - begin - TagStart := nil; - repeat - TextStart := P; - { Get next tag position } - while Not (P^ in [ '<', #0 ]) do - begin - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - - { Is there any text before ? } - if (TextStart<>nil) and (P>TextStart) then - begin - - L := P-TextStart; - { Yes, copy to buffer } - - if (assigned(OnFoundText)) then - OnFoundText(CopyBuffer( TextStart, L )); - - end else - begin - TextStart:=nil; - end; - { No } - - TagStart := P; - while Not (P^ in [ '>', #0]) do - begin - - // Find string in tag - if (P^='"') or (P^='''') then - begin - C:= P^; - Inc(P);Inc(I); // Skip current char " or ' - - // Skip until string end - while Not (P^ in [C, #0]) do - begin - Inc(P);Inc(I); - end; - end; - - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - { Copy this tag to buffer } - L := P-TagStart+1; - - if (Assigned(OnFoundTag)) then - OnFoundTag(CopyBuffer( TagStart, L )); - - Inc(P);Inc(I); - if I>=TL then Break; - - until (Done); - end; -end; - -procedure TjsFastHTMLParser.SlowExec; -Var - L : Integer; - TL : Integer; - I : Integer; - Done : Boolean; - TagStart, - TextStart, - P : PChar; // Pointer to current char. -begin - TL := StrLen(Raw); - I := 0; - P := Raw; - Done := False; - if P<>nil then - begin - TagStart := nil; - repeat - TextStart := P; - { Get next tag position } - while Not (P^ in [ '<', #0 ]) do - begin - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - - { Is there any text before ? } - if (TextStart<>nil) and (P>TextStart) then - begin - - L := P-TextStart; - { Yes, copy to buffer } - - if (assigned(OnFoundText)) then - OnFoundText(CopyBuffer( TextStart, L )); - - end else - begin - TextStart:=nil; - end; - { No } - - TagStart := P; - while Not (P^ in [ '>', #0]) do - begin - - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - { Copy this tag to buffer } - L := P-TagStart+1; - - if (Assigned(OnFoundTag)) then - OnFoundTag(CopyBuffer( TagStart, L )); - - Inc(P);Inc(I); - if I>=TL then Break; - - until (Done); - end; -end; - - -{L505: Added this function so we can parse HTML converting alltags to UPPERCASE - This makes it easier in those cases where an html file has mixed and - and and } -procedure TjsFastHTMLParser.ExecUpCase; -Var - L : Integer; - TL : Integer; - I : Integer; - Done : Boolean; - TagStart, - TextStart, - P : PChar; // Pointer to current char. - C : Char; -begin - TL := StrLen(Raw); - I := 0; - P := Raw; - Done := False; - if P<>nil then - begin - TagStart := nil; - repeat - TextStart := P; - { Get next tag position } - while Not (P^ in [ '<', #0 ]) do - begin - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - - { Is there any text before ? } - if (TextStart<>nil) and (P>TextStart) then - begin - - L := P-TextStart; - { Yes, copy to buffer } - - if (assigned(OnFoundText)) then - OnFoundText(CopyBuffer( TextStart, L )); - - end else - begin - TextStart:=nil; - end; - { No } - - TagStart := P; - while Not (P^ in [ '>', #0]) do - begin - - // Find string in tag - if (P^='"') or (P^='''') then - begin - C:= P^; - Inc(P);Inc(I); // Skip current char " or ' - - // Skip until string end - while Not (P^ in [C, #0]) do - begin - Inc(P);Inc(I); - end; - end; - - Inc(P);Inc(I); - if I>=TL then - begin - Done := True; - Break; - end; - end; - if Done then Break; - { Copy this tag to buffer } - L := P-TagStart+1; - - if (Assigned(OnFoundTag)) then - OnFoundTag(uppercase(CopyBuffer( TagStart, L )));//L505: added upppercase - - Inc(P);Inc(I); - if I>=TL then Break; - - until (Done); - end; -end; - -end. diff --git a/baseunits/fasthtmlparser/jsHTMLUtil.pas b/baseunits/fasthtmlparser/jsHTMLUtil.pas deleted file mode 100644 index 778336928..000000000 --- a/baseunits/fasthtmlparser/jsHTMLUtil.pas +++ /dev/null @@ -1,174 +0,0 @@ -{$MODE Delphi} -{ $Id: jsHTMLUtil.pas,v 1.2 2004/09/10 02:25:56 jazar Exp $ } -unit jsHTMLUtil; - -interface - -Uses SysUtils; - -Function GetTagName(Tag:String):String; - { Return tag name in upper/lowercase! } - -Function GetTagAttribute(Tag, Attribute: String):String; - -Function GetTagAttributei(Tag, Attribute: String):String; - -Function GetAttributeValue(Attribute: String):String; - { Get value of attribute, e.g WIDTH=36 -return-> 36 } - - -implementation - -Function CopyBuffer(StartIndex: PChar;Length:Integer):String; -Var - S : String; -Begin - SetLength(S, Length); - StrLCopy(@S[1], StartIndex, Length); - Result := S; -End; - -Function GetTagName(Tag:String):String; -Var - P : Pchar; - S : Pchar; -Begin - P := Pchar(Tag); - While P^ in ['<',' ',#9] do Inc(P); - S := P; - While Not (P^ in [' ','>',#0]) do Inc(P); - If P > S then - Result := CopyBuffer( S, P-S) - else - Result := ''; -End; - -Function GetTagAttribute(Tag, Attribute: String):String; -Var - P : Pchar; - S : Pchar; - C : Char; -Begin - P := Pchar(Tag); - S := StrPos(P, Pchar(Attribute)); - If S<>nil then - Begin - P := S; - - // Skip attribute name - While not (P^ in ['=',' ','>',#0]) do - Inc(P); - - If (P^='=') then inc(P); - - While not (P^ in [' ','>',#0]) do - Begin - - If (P^ in ['"','''']) then - Begin - C:= P^; - Inc(P); { Skip current character } - End else - C:= ' '; - - { thanks to Dmitry [mail@vader.ru] } - While not (P^ in [C, '>', #0]) do - Inc(P); - - If (P^<>'>') then Inc(P); { Skip current character, except '>' } - Break; - End; - - If P > S then - Result := CopyBuffer(S, P-S) else - Result := ''; - End; -End; - -Function GetTagAttributei(Tag, Attribute: String):String; -Var - P : Pchar; - S : Pchar; - UT, - UA : String; - Start: Integer; - L : Integer; - C : Char; -Begin - UA := Uppercase(Attribute); - UT := Uppercase(Tag); - P := Pchar(UT); - S := StrPos(P, Pchar(UA)); - If S<>nil then - Begin - - P := S; - - // Skip attribute name - While not (P^ in ['=',' ','>',#0]) do - Inc(P); - - If (P^='=') then inc(P); - - While not (P^ in [' ','>',#0]) do - Begin - - If (P^ in ['"','''']) then - Begin - C:= P^; - Inc(P); { Skip current character } - End else - C:= ' '; - - { thanks to Dmitry [mail@vader.ru] } - While not (P^ in [C, '>', #0]) do - Inc(P); - - If (P^<>'>') then Inc(P); { Skip current character, except '>' } - Break; - End; - - L := P-S; - Start := S - Pchar(UT); - P := Pchar(Tag); - S := P; - Inc(S,Start); - Result := CopyBuffer(S, L); - End; -End; - -Function GetAttributeValue(Attribute: String):String; -Var - P : Pchar; - S : Pchar; - C : Char; -Begin - P := Pchar(Attribute); - S := StrPos(P, '='); - If S<>nil then - Begin - - Inc(S); - P := S; // set P to a character after = - - If (P^ in ['"','''']) then - Begin - C := P^; - Inc(P); { Skip current character } - End else - C := ' '; - - S := P; - While not (P^ in [C, #0]) do - Inc(P); - - If (P<>S) then { Thanks to Dave Keighan (keighand@yahoo.com) } - Result := CopyBuffer(S, P-S) else - Result := ''; - - End; - -End; - - -end. diff --git a/baseunits/httpsendthread.pas b/baseunits/httpsendthread.pas new file mode 100644 index 000000000..377cbfc6e --- /dev/null +++ b/baseunits/httpsendthread.pas @@ -0,0 +1,740 @@ +unit httpsendthread; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, httpsend, synautil, synacode, ssl_openssl, blcksock, + GZIPUtils, BaseThread, dateutils, strutils; + +const + + HTTPFormatSettings :TFormatSettings = ( + CurrencyFormat :1; + NegCurrFormat :5; + ThousandSeparator :','; + DecimalSeparator :'.'; + CurrencyDecimals :2; + DateSeparator :'/'; + TimeSeparator :':'; + ListSeparator :','; + CurrencyString :'$'; + ShortDateFormat :'m/d/y'; + LongDateFormat :'dd" "mmmm" "yyyy'; + TimeAMString :'AM'; + TimePMString :'PM'; + ShortTimeFormat :'hh:nn'; + LongTimeFormat :'hh:nn:ss'; + ShortMonthNames :('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', + 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); + LongMonthNames :('January', 'February', 'March', 'April', 'May', + 'June', 'July', 'August', 'September', 'October', + 'November', 'December'); + ShortDayNames :('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); + LongDayNames :('Sunday', 'Monday', 'Tuesday', 'Wednesday', + 'Thursday', 'Friday', 'Saturday'); + TwoDigitYearCenturyWindow :50; + ); + + // https://tools.ietf.org/html/rfc2616#section-3.3.1 + HTTPCookieExpiresFormat = 'ddd, dd-mmm-yy hh:nn:ss'; + +type + + THTTPSendThread = class; + + THTTPMethodEvent = procedure(const AHTTP: THTTPSendThread; var Method, URL: String); + + THTTPRequestEvent = function(const AHTTP: THTTPSendThread; const Method, URL: String; const Response: TObject = nil): Boolean of object; + + THTTPMethodRedirectEvent = procedure(const AHTTP: THTTPSendThread; const URL: String) of object; + + { THTTPSendThread } + + THTTPSendThread = class(THTTPSend) + private + FURL: String; + FOwner: TBaseThread; + FRetryCount: Integer; + FGZip: Boolean; + FFollowRedirection: Boolean; + FMaxRedirect: Integer; + FAllowServerErrorResponse: Boolean; + FCookiesExpires: TDateTime; + procedure SetTimeout(AValue: Integer); + procedure OnOwnerTerminate(Sender: TObject); + protected + procedure ParseCookiesExpires; + function InternalHTTPRequest(const Method, URL: String; const Response: TObject = nil): Boolean; + public + constructor Create(AOwner: TBaseThread = nil); + destructor Destroy; override; + function HTTPMethod(const Method, URL: string): Boolean; + function HTTPRequest(const Method, URL: String; const Response: TObject = nil): Boolean; + function HEAD(const URL: String; const Response: TObject = nil): Boolean; + function GET(const URL: String; const Response: TObject = nil): Boolean; + function POST(const URL: String; const POSTData: String = ''; const Response: TObject = nil): Boolean; + function XHR(const URL: String; const Response: TObject = nil): Boolean; + function GetCookies: String; + function ThreadTerminated: Boolean; + procedure RemoveCookie(const CookieName: String); + procedure SetProxy(const ProxyType, Host, Port, User, Pass: String); + procedure GetProxy(var ProxyType, Host, Port, User, Pass: String); + procedure SetNoProxy; + procedure SetDefaultProxy; + procedure Reset; + property Timeout: Integer read FTimeout write SetTimeout; + property RetryCount: Integer read FRetryCount write FRetryCount; + property GZip: Boolean read FGZip write FGZip; + property FollowRedirection: Boolean read FFollowRedirection write FFollowRedirection; + property AllowServerErrorResponse: Boolean read FAllowServerErrorResponse write FAllowServerErrorResponse; + property Thread: TBaseThread read FOwner; + property CookiesExpires: TDateTime read FCookiesExpires; + property MaxRedirect: Integer read FMaxRedirect write FMaxRedirect; + public + BeforeHTTPMethod: THTTPMethodEvent; + AfterHTTPMethod: THTTPMethodEvent; + OnHTTPRequest: THTTPRequestEvent; + OnRedirected: THTTPMethodRedirectEvent; + property LastURL: String read FURL; + end; + + TKeyValuePair = array[0..1] of String; + +function KeyVal(const AKey, AValue: String): TKeyValuePair; +function QueryString(KeyValuePairs: array of TKeyValuePair): String; +function SetDefaultProxy(const ProxyType, Host, Port, User, Pass: String): Boolean; +procedure SetDefaultProxyAndApply(const ProxyType, Host, Port, User, Pass: String); +procedure SetDefaultTimeoutAndApply(const ATimeout: Integer); +procedure SetDefaultRetryCountAndApply(const ARetryCount: Integer); + +function MaybeEncodeURL(const AValue: String): String; +procedure SplitURL(const AURL: String; const AHost, APath: PString; + const AIncludeProtocol: Boolean = True; const AIncludePort: Boolean = True); + +function FormatByteSize(const ABytes: Integer; AShowPerSecond: Boolean = False): String; + +const + UserAgentSynapse = 'Mozilla/4.0 (compatible; Synapse)'; + UserAgentCURL = 'curl/7.58.0'; + UserAgentGooglebot = 'Mozilla/5.0 (compatible; Googlebot/2.1; http://www.google.com/bot.html)'; + UserAgentMSIE = 'Mozilla/5.0 (Windows NT 10.0; Win64; Trident/7.0; rv:11.0) like Gecko'; + UserAgentFirefox = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:58.0) Gecko/20100101 Firefox/58.0'; + UserAgentChrome = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/57.0.2987.110 Safari/537.36'; + UserAgentVivaldi = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.90 Safari/537.36 Vivaldi/1.91.867.3'; + UserAgentOpera = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/58.0.3029.110 Safari/537.36 OPR/45.0.2552.888'; + UserAgentEdge = 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.79 Safari/537.36 Edge/14.14393'; + +var + DefaultUserAgent: String = UserAgentFirefox; + DefaultRetryCount: Integer = 0; + DefaultTimeout: Integer = 15000; + DefaultProxyType: String = ''; + DefaultProxyHost: String = ''; + DefaultProxyPort: String = ''; + DefaultProxyUser: String = ''; + DefaultProxyPass: String = ''; + +implementation + +var + ALLHTTPSendThread: TFPList; + CS_ALLHTTPSendThread: TRTLCriticalSection; + +function poschar(const c:char;const s:string;const offset:cardinal=1):integer; +var + i:integer; +begin + for i:=offset to length(s) do + if s[i]=c then Exit(i); + Result:=0; +end; + +procedure SplitURL(const AURL: String; const AHost, APath: PString; + const AIncludeProtocol: Boolean; const AIncludePort: Boolean); + +procedure cleanuri(var u:string); +begin + while (Length(u)<>0) and (u[1] in ['.',':','/']) do + Delete(u,1,1); +end; + +var + iurl,ihost,ipath,iproto,iport: String; + p,q: Integer; +begin + if (AHost=nil) and (APath=nil) then Exit; + if Assigned(AHost) then AHost^:=''; + if Assigned(APath) then APath^:=''; + iurl:=Trim(AURL); + if iurl='' then Exit; + ihost:=''; + ipath:=''; + iproto:=''; + iport:=''; + if iurl[1]='/' then + if Length(iurl)=1 then Exit + else + if iurl[2]<>'/' then + begin + if Assigned(APath) then APath^:=iurl; + Exit; + end; + p:=poschar(':',iurl); + if (p<>0) and (p0) and (p0) and (p0) and (q'') and ((iproto<>'') or (iport<>'')) then + begin + ihost:=iurl; + iurl:=''; + end; + if ihost<>'' then + begin + if AIncludeProtocol then + begin + if iproto<>'' then ihost:=iproto+'://'+ihost + else ihost:='http://'+ihost; + end; + if AIncludePort and (iport<>'') then + ihost:=ihost+':'+iport; + end; + if iurl<>'' then + ipath:='/'+iurl; + if Assigned(AHost) then AHost^:=ihost; + if Assigned(APath) then APath^:=ipath; +end; + +function FormatByteSize(const ABytes: Integer; AShowPerSecond: Boolean): String; +const + B = 1; + KB = 1024 * B; + MB = 1024 * KB; + GB = 1024 * MB; +begin + if ABytes > GB then + Result := FormatFloat('#.## GB', ABytes / GB) + else + if ABytes > MB then + Result := FormatFloat('#.## MB', ABytes / MB) + else + if ABytes > KB then + Result := FormatFloat('#.## KB', ABytes / KB) + else + if ABytes = 0 then + begin + if AShowPerSecond then + Result := '0 B' + else + Result := '0 Bytes'; + end + else + begin + if AShowPerSecond then + Result := FormatFloat('#.## B', ABytes) + else + Result := FormatFloat('#.## Bytes', ABytes); + end; + if AShowPerSecond then + Result := Result + 'ps'; +end; + +function KeyVal(const AKey, AValue: String): TKeyValuePair; +begin + Result[0] := AKey; + Result[1] := AValue; +end; + +function QueryString(KeyValuePairs: array of TKeyValuePair): String; +var + i: Integer; +begin + Result := ''; + if Length(KeyValuePairs) > 0 then + for i := Low(KeyValuePairs) to High(KeyValuePairs) do + begin + if Result <> '' then + Result := Result + '&'; + Result := Result + EncodeURL(KeyValuePairs[i, 0]) + '=' + EncodeURL(KeyValuePairs[i, 1]); + end; +end; + +function SetDefaultProxy(const ProxyType, Host, Port, User, Pass: String): Boolean; +begin + Result := (ProxyType <> DefaultProxyType) or + (Host <> DefaultProxyHost) or + (Port <> DefaultProxyPort) or + (User <> DefaultProxyUser) or + (Pass <> DefaultProxyPass); + if not Result then Exit; + DefaultProxyType := ProxyType; + DefaultProxyHost := Host; + DefaultProxyPort := Port; + DefaultProxyUser := User; + DefaultProxyPass := Pass; +end; + +procedure SetDefaultProxyAndApply(const ProxyType, Host, Port, User, Pass: String); +var + i: SizeInt; +begin + if not SetDefaultProxy(ProxyType, Host, Port, User, Pass) then Exit; + EnterCriticalsection(CS_ALLHTTPSendThread); + try + if ALLHTTPSendThread.Count > 0 then + for i := 0 to ALLHTTPSendThread.Count - 1 do + THTTPSendThread(ALLHTTPSendThread[i]).SetProxy(ProxyType, Host, Port, User, Pass); + finally + LeaveCriticalsection(CS_ALLHTTPSendThread); + end; +end; + +procedure SetDefaultTimeoutAndApply(const ATimeout: Integer); +var + i: SizeInt; +begin + if ATimeout = DefaultTimeout then Exit; + DefaultTimeout := ATimeout; + EnterCriticalsection(CS_ALLHTTPSendThread); + try + if ALLHTTPSendThread.Count > 0 then + for i := 0 to ALLHTTPSendThread.Count - 1 do + THTTPSendThread(ALLHTTPSendThread[i]).Timeout := ATimeout; + finally + LeaveCriticalsection(CS_ALLHTTPSendThread); + end; +end; + +procedure SetDefaultRetryCountAndApply(const ARetryCount: Integer); +var + i: SizeInt; +begin + if ARetryCount = DefaultRetryCount then Exit; + DefaultRetryCount := ARetryCount; + EnterCriticalsection(CS_ALLHTTPSendThread); + try + if ALLHTTPSendThread.Count > 0 then + for i := 0 to ALLHTTPSendThread.Count - 1 do + THTTPSendThread(ALLHTTPSendThread[i]).RetryCount := ARetryCount; + finally + LeaveCriticalsection(CS_ALLHTTPSendThread); + end; +end; + +function MaybeEncodeURL(const AValue: String): String; +begin + Result := Trim(AValue); + if Result = '' then Exit; + if Length(DecodeURL(Result)) >= Length(Result) then + Result := EncodeURL(Result); +end; + +{ THTTPSendThread } + +procedure THTTPSendThread.SetTimeout(AValue: Integer); +begin + if FTimeout = AValue then Exit; + FTimeout := AValue; + Sock.ConnectionTimeout := FTimeout; + Sock.SocksTimeout := FTimeout; + Sock.SetTimeout(FTimeout); +end; + +procedure THTTPSendThread.OnOwnerTerminate(Sender: TObject); +begin + Sock.Tag := 1; + Sock.AbortSocket; +end; + +procedure THTTPSendThread.ParseCookiesExpires; +var + i, p: Integer; + c: TDateTime; + s: String; +begin + FCookiesExpires := 0.0; + for i := 0 to FHeaders.Count-1 do + if Pos('set-cookie', LowerCase(FHeaders[i])) = 1 then + begin + s := SeparateRight(FHeaders[i], ':'); + p := Pos('expires', lowercase(s)); + if p <> 0 then + begin + s := Copy(s, p, Length(s)); + s := SeparateLeft(SeparateRight(s,'='),';'); + s := Trim(SeparateLeft(s, 'GMT')); + c := DecodeRfcDateTime(s); + if (FCookiesExpires = 0.0) or (c < FCookiesExpires) then + FCookiesExpires := c; + end; + end; + write +end; + +function THTTPSendThread.InternalHTTPRequest(const Method, URL: String; + const Response: TObject): Boolean; +begin + if Assigned(OnHTTPRequest) then + Result := OnHTTPRequest(Self, Method, URL, Response) + else + Result := HTTPRequest(Method, URL, Response); +end; + +constructor THTTPSendThread.Create(AOwner: TBaseThread); +begin + inherited Create; + KeepAlive := True; + if Trim(DefaultUserAgent) <> '' then + UserAgent := DefaultUserAgent; + Protocol := '1.1'; + Headers.NameValueSeparator := ':'; + Cookies.NameValueSeparator := '='; + FGZip := True; + FFollowRedirection := True; + FAllowServerErrorResponse := False; + FRetryCount := DefaultRetryCount; + FMaxRedirect := 5; + SetTimeout(DefaultTimeout); + SetProxy(DefaultProxyType, DefaultProxyHost, DefaultProxyPort, DefaultProxyUser, DefaultProxyPass); + Reset; + if Assigned(AOwner) then + begin + FOwner := AOwner; + FOwner.OnCustomTerminate := @OnOwnerTerminate; + end; + BeforeHTTPMethod := nil; + AfterHTTPMethod := nil; + OnHTTPRequest := nil; + EnterCriticalsection(CS_ALLHTTPSendThread); + try + ALLHTTPSendThread.Add(Self); + finally + LeaveCriticalsection(CS_ALLHTTPSendThread); + end; +end; + +destructor THTTPSendThread.Destroy; +begin + If Assigned(FOwner) then + FOwner.OnCustomTerminate := nil; + EnterCriticalsection(CS_ALLHTTPSendThread); + try + ALLHTTPSendThread.Remove(Self); + finally + LeaveCriticalsection(CS_ALLHTTPSendThread); + end; + inherited Destroy; +end; + +function THTTPSendThread.HTTPMethod(const Method, URL: string): Boolean; +var + amethod, aurl: String; +begin + amethod:=Method; + aurl:=URL; + if Assigned(BeforeHTTPMethod) then + BeforeHTTPMethod(Self, amethod, aurl); + FCookiesExpires := 0.0; + Result := inherited HTTPMethod(amethod, aurl); + ParseCookiesExpires; + if Assigned(AfterHTTPMethod) then + AfterHTTPMethod(Self, amethod, aurl); +end; + +function THTTPSendThread.HTTPRequest(const Method, URL: String; const Response: TObject): Boolean; + + function CheckTerminate: Boolean; + begin + Result := Sock.Tag = 1; + if Result then Sock.Tag := 0; + end; + +var + counter: Integer = 0; + redirectcounter: Integer = 0; + s, h, p: String; + HTTPHeader: TStringList; + mstream: TMemoryStream; +begin + Result := False; + FURL := TrimRight(TrimLeftSet(URL, [':', '/', #0..' '])); + if FURL = '' then Exit; + FURL := MaybeEncodeURL(FURL); + if Pos('HTTP/', Headers.Text) = 1 then Reset; + HTTPHeader := TStringList.Create; + HTTPHeader.Assign(Headers); + try + // first request + while (not HTTPMethod(Method, FURL)) or + ((not FAllowServerErrorResponse) and (ResultCode > 500)) do begin + if CheckTerminate then Exit; + if (FRetryCount > -1) and (FRetryCount <= counter) then Exit; + Inc(Counter); + Headers.Assign(HTTPHeader); + end; + + { redirection + 300 Multiple Choices + 301 Moved Permanently + 302 Found (aka Object Moved aka Moved Temporarily) + 303 See Other + 304 Not Modified + 305 Use Proxy + 306 Switch Proxy + 307 Temporary Redirect + who have location 301, 302, 303, 307? + } + if FFollowRedirection then + while (ResultCode-300) in [1, 2, 3, 7] do begin + if CheckTerminate then Exit; + // break too many redirect + if redirectcounter >= FMaxRedirect then Exit + else Inc(redirectcounter); + HTTPHeader.Values['Referer'] := ' ' + FURL; + s := Trim(Headers.Values['Location']); + if s<>'' then + begin + SplitURL(s,@h,@p); + s:=p; + if h='' then + SplitURL(FURL,@h,@p); + FURL:=h+s; + end; + + if OnRedirected<>nil then + OnRedirected(Self, FURL); + + Clear; + Headers.Assign(HTTPHeader); + counter := 0; + while (not HTTPMethod('GET', FURL)) or + ((not FAllowServerErrorResponse) and (ResultCode > 500)) do begin + if checkTerminate then Exit; + if (FRetryCount > -1) and (FRetryCount <= counter) then Exit; + Inc(counter); + Clear; + Headers.Assign(HTTPHeader); + end; + end; + + // response + // decompress data + s := LowerCase(Headers.Values['Content-Encoding']); + if (Pos('gzip', s) <> 0) or (Pos('deflate', s) <> 0) then + begin + mstream := TMemoryStream.Create; + try + ZUncompressStream(Document, mstream); + Document.Clear; + Document.LoadFromStream(mstream); + except + end; + mstream.Free; + end; + if Assigned(Response) then + begin + if Response is TStringList then + TStringList(Response).LoadFromStream(Document) + else + if Response is TStream then + Document.SaveToStream(TStream(Response)); + end; + Result := Document.Size > 0; + finally + HTTPHeader.Free; + end; +end; + +function THTTPSendThread.HEAD(const URL: String; const Response: TObject): Boolean; +begin + Result := InternalHTTPRequest('HEAD', URL, Response); +end; + +function THTTPSendThread.GET(const URL: String; const Response: TObject): Boolean; +begin + Result := InternalHTTPRequest('GET', URL, Response); +end; + +function THTTPSendThread.POST(const URL: String; const POSTData: String; const Response: TObject): Boolean; +begin + if POSTData <> '' then begin + Document.Clear; + WriteStrToStream(Document, POSTData); + end; + if (MimeType = 'text/html') or (MimeType = '') then + MimeType := 'application/x-www-form-urlencoded'; + Result := InternalHTTPRequest('POST', URL, Response); +end; + +function THTTPSendThread.XHR(const URL: String; const Response: TObject + ): Boolean; +begin + if Pos('HTTP/', Headers.Text) = 1 then Reset; + Headers.Add('X-Requested-With: XMLHttpRequest'); + Result := GET(URL, Response); +end; + +function THTTPSendThread.GetCookies: String; +var + i: Integer; +begin + Result := ''; + if Cookies.Count > 0 then + for i := 0 to Cookies.Count - 1 do begin + if Result = '' then Result := Cookies.Strings[i] + else Result := Result + '; ' + Cookies.Strings[i]; + end; +end; + +function THTTPSendThread.ThreadTerminated: Boolean; +begin + if Assigned(FOwner) then + Result := FOwner.IsTerminated + else + Result := False; +end; + +procedure THTTPSendThread.RemoveCookie(const CookieName: String); +var + i: Integer; +begin + if CookieName = '' then Exit; + if Cookies.Count > 0 then begin + i := Cookies.IndexOfName(CookieName); + if i > -1 then Cookies.Delete(i); + end; +end; + +procedure THTTPSendThread.SetProxy(const ProxyType, Host, Port, User, Pass: String); +var + pt: String; +begin + pt := AnsiUpperCase(ProxyType); + with Sock do begin + ProxyHost := ''; + ProxyPort := ''; + ProxyUser := ''; + ProxyPass := ''; + SocksIP := ''; + SocksPort := '1080'; + SocksType := ST_Socks5; + SocksUsername := ''; + SocksPassword := ''; + if pt = 'HTTP' then + begin + ProxyHost := Host; + ProxyPort := Port; + ProxyUser := User; + ProxyPass := Pass; + end + else + if (pt = 'SOCKS4') or (pt = 'SOCKS5') then + begin + if pt = 'SOCKS4' then + SocksType := ST_Socks4 + else + if pt = 'SOCKS5' then + SocksType := ST_Socks5; + SocksIP := Host; + SocksPort := Port; + SocksUsername := User; + SocksPassword := Pass; + end; + end; +end; + +procedure THTTPSendThread.GetProxy(var ProxyType, Host, Port, User, Pass: String); +begin + if ProxyHost <> '' then + begin + ProxyType := 'HTTP'; + Host := ProxyHost; + Port := ProxyPort; + User := ProxyUser; + Pass := ProxyPass; + end + else + if Sock.SocksIP <> '' then + with Sock do + begin + if SocksType = ST_Socks5 then + ProxyType := 'SOCKS5' + else + ProxyType := 'SOCKS4'; + Host := SocksIP; + Port := SocksPort; + User := SocksUsername; + Pass := SocksPassword; + end + else + begin + ProxyType := ''; + Host := ''; + Port := ''; + User := ''; + Pass := ''; + end; +end; + +procedure THTTPSendThread.SetNoProxy; +begin + SetProxy('', '', '', '', ''); +end; + +procedure THTTPSendThread.SetDefaultProxy; +begin + SetProxy(DefaultProxyType, DefaultProxyHost, DefaultProxyPort, DefaultProxyUser, DefaultProxyPass); +end; + +procedure THTTPSendThread.Reset; +begin + Clear; + Headers.Values['DNT'] := ' 1'; + Headers.Values['Accept'] := ' text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; + Headers.Values['Accept-Charset'] := ' utf8'; + Headers.Values['Accept-Language'] := ' en-US,en;q=0.8'; + if FGZip then Headers.Values['Accept-Encoding'] := ' gzip, deflate'; +end; + +initialization + InitCriticalSection(CS_ALLHTTPSendThread); + ALLHTTPSendThread := TFPList.Create; + +finalization + ALLHTTPSendThread.Free; + DoneCriticalsection(CS_ALLHTTPSendThread); + +end. diff --git a/baseunits/includes/AcademyVN/chapter_page_number.inc b/baseunits/includes/AcademyVN/chapter_page_number.inc deleted file mode 100644 index 82ceef1d6..000000000 --- a/baseunits/includes/AcademyVN/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetAcademyVNPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(ACADEMYVN_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (Pos('img-responsive', GetVal(parse[i], 'class')) > 0) then - manager.container.PageLinks.Add(GetVal(parse[i], 'src')); - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/AcademyVN/directory_page_number.inc b/baseunits/includes/AcademyVN/directory_page_number.inc deleted file mode 100644 index 201088aa1..000000000 --- a/baseunits/includes/AcademyVN/directory_page_number.inc +++ /dev/null @@ -1,47 +0,0 @@ - function GetAcademyVNDirectoryPageNumber: Byte; - var - i, p: Integer; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ACADEMYVN_ID, 1] + - '/manga/all', 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - Page := 0; - regx := TRegExpr.Create; - try - regx.Expression := '^.*/manga/all\?page=(\d+)$'; - regx.ModifierI := True; - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'a') and (Pos('/manga/all?page=', parse[i]) > 0 ) then - begin - s := GetVal(parse[i], 'href'); - s := regx.Replace(s, '$1', True); - p := StrToIntDef(s, 0); - if p > Page then - Page := p; - end; - finally - regx.Free; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/AcademyVN/manga_information.inc b/baseunits/includes/AcademyVN/manga_information.inc deleted file mode 100644 index 80bb2cfe6..000000000 --- a/baseunits/includes/AcademyVN/manga_information.inc +++ /dev/null @@ -1,105 +0,0 @@ - function GetAcademyVNInfoFromURL: Byte; - var - s: String; - i, j: Integer; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[ACADEMYVN_ID, 0]; - mangaInfo.url := FillMangaSiteHost(ACADEMYVN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetVal(parse[i], 'class') = '__name' then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //cover - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = '__image') then - if GetTagName(parse[i + 2]) = 'img' then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - if GetTagName(parse[i]) = 'strong' then - begin - //genre - if Pos('Thể loại:', parse[i + 1]) > 0 then - begin - for j := i + 2 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/p' then - Break; - if Pos('<', parse[j]) = 0 then - mangaInfo.genres := mangaInfo.genres + parse[j]; - end; - mangaInfo.genres := Trim(mangaInfo.genres); - end; - - //author - if Pos('Tác giả:', parse[i + 1]) > 0 then - mangaInfo.authors := CommonStringFilter(TrimLeftChar(parse[i + 5], [':'])); - - //status - if Pos('Tình trạng:', parse[i + 1]) > 0 then - begin - s := Trim(TrimLeftChar(parse[i + 3], [':'])); - if (s = 'Đang tiến hành') or (s = 'Ngưng') then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - end; - //summary - if GetVal(parse[i], 'class') = '__description' then - for j := i + 3 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/div' then - Break; - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + CommonStringFilter(parse[j]); - end; - - //chapters - if GetVal(parse[i], 'class') = 'table-scroll' then - isExtractChapters := True; - if isExtractChapters then - begin - if GetTagName(parse[i]) = '/table' then - isExtractChapters := False - else - if GetTagName(parse[i]) = 'a' then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - mangaInfo.chapterName.Add(Trim(parse[i + 2])); - end; - end; - end; - Result := NO_ERROR; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 1 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - end; diff --git a/baseunits/includes/AcademyVN/names_and_links.inc b/baseunits/includes/AcademyVN/names_and_links.inc deleted file mode 100644 index 5107b706d..000000000 --- a/baseunits/includes/AcademyVN/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function AcademyVNGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ACADEMYVN_ID, 1] + - '/manga/all?page=' + IntToStr(StrToInt(URL) + 1), 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(FixHTMLTagQuote(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'a') and - (GetVal(parse[i], 'class') = 'ajax-title text-ellipsis') then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter(GetVal(parse[i], 'title'))); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/AnimExtremist/chapter_page_number.inc b/baseunits/includes/AnimExtremist/chapter_page_number.inc deleted file mode 100644 index a81d34667..000000000 --- a/baseunits/includes/AnimExtremist/chapter_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetAnimeExtremistPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - StringReplace(FillMangaSiteHost(ANIMEEXTREMIST_ID, URL), - '.html', '', []) + '-1.html', - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if Pos('', parse.Strings[i]) > 0 then - begin - manager.container.PageNumber := - StrToInt(GetString(TrimLeft(TrimRight(parse.Strings[i - 3] + '~!@')), 'Pagina ', '~!@')); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/AnimExtremist/image_url.inc b/baseunits/includes/AnimExtremist/image_url.inc deleted file mode 100644 index a456808e7..000000000 --- a/baseunits/includes/AnimExtremist/image_url.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetAnimeExtremistImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(StringReplace(FillMangaSiteHost(ANIMEEXTREMIST_ID, URL), - '.html', '', []) + '-' + IntToStr(workCounter + 1) + '.html'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('id="photo"', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - manager.container.pageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/AnimExtremist/manga_information.inc b/baseunits/includes/AnimExtremist/manga_information.inc deleted file mode 100644 index 671199845..000000000 --- a/baseunits/includes/AnimExtremist/manga_information.inc +++ /dev/null @@ -1,103 +0,0 @@ - function GetAnimeExtremistInfoFromURL: Byte; - var - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(ANIMEEXTREMIST_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[ANIMEEXTREMIST_ID, 0]; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos(' Manga - Animextremist', parse.Strings[i]) > 0) then - mangaInfo.title := GetString('~!@' + parse.Strings[i], '~!@', - ' Manga - Animextremist'); - - // get cover link - if (mangaInfo.coverLink = '') and - (GetTagName(parse.Strings[i]) = 'img') then - if Pos('src="../', parse.Strings[i]) > 0 then - mangaInfo.coverLink := WebsiteRoots[ANIMEEXTREMIST_ID, 1] + - GetString(parse.Strings[i], 'src="..', '"'); - - // get summary - if (Pos('align="justify" class="style33"', parse.Strings[i])) <> 0 then - begin - j := i + 1; - mangaInfo.summary := ''; - while (Pos(' '') and (s[1] <> '<') then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j] + '\n\r'; - end; - Inc(j); - end; - end; - - // get chapter name and links - if (Pos('/mangas-online/', parse.Strings[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[ANIMEEXTREMIST_ID, 1], '', [rfReplaceAll])); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #10, '', [rfReplaceAll]); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #13, '', [rfReplaceAll]); - parse.Strings[i + 1] := TrimLeft(parse.Strings[i + 1]); - parse.Strings[i + 1] := TrimRight(parse.Strings[i + 1]); - mangaInfo.chapterName.Add(HTMLEntitiesFilter( - StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 1]))))); - end; - - { // get authors - if (Pos('Autor(s):', parse.Strings[i])<>0) then - mangaInfo.authors:= parse.Strings[i+3]; - - // get artists - if (Pos('Artist(s):', parse.Strings[i])<>0) then - mangaInfo.artists:= parse.Strings[i+3]; } - - // get genres - if (Pos('ord=genero&id', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := mangaInfo.genres + - (HTMLEntitiesFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))) + ', '); - end; - - // get status - if (Pos('class="manga_estado"', parse.Strings[i]) <> 0) then - begin - if Pos('Completo', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/AnimExtremist/names_and_links.inc b/baseunits/includes/AnimExtremist/names_and_links.inc deleted file mode 100644 index af696c532..000000000 --- a/baseunits/includes/AnimExtremist/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function AnimeExtremistGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ANIMEEXTREMIST_ID, 1] + - ANIMEEXTREMIST_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('id="manga" style="margin', parse.Strings[i]) <> 0 then - begin - Result := NO_ERROR; - names.Add(TrimLeft(TrimRight(parse.Strings[i + 4]))); - links.Add(StringReplace(GetString(parse.Strings[i + 3], 'href="', '">'), - WebsiteRoots[ANIMEEXTREMIST_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/AnimeA/chapter_page_number.inc b/baseunits/includes/AnimeA/chapter_page_number.inc deleted file mode 100644 index b63973389..000000000 --- a/baseunits/includes/AnimeA/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetAnimeAPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - isPage: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - Result := GetPage(TObject(l), FillMangaSiteHost(ANIMEA_ID, - StringReplace(URL, '.html', '', [])) + - '.html', manager.container.Manager.retryConnect); - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos(' 0) and - (Pos('class="mangaselecter pageselect"', parse[i]) > 0) then - isPage := True; - if isPage and (Pos(' 0) then - begin - isPage := False; - Break; - end; - if isPage and (Pos(' 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/AnimeA/directory_page_number.inc b/baseunits/includes/AnimeA/directory_page_number.inc deleted file mode 100644 index a87ea93b4..000000000 --- a/baseunits/includes/AnimeA/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetAnimeADirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ANIMEA_ID, 1] + ANIMEA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'a') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')) = - 'http://manga.animea.net/browse.html?page=1') and - (Pos('Next', parse.Strings[i + 1]) > 0) then - begin - Page := StrToInt(TrimRight(TrimLeft(parse.Strings[i - 4]))); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/AnimeA/image_url.inc b/baseunits/includes/AnimeA/image_url.inc deleted file mode 100644 index f862d4930..000000000 --- a/baseunits/includes/AnimeA/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetAnimeAImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(ANIMEA_ID, - StringReplace(URL, '.html', '', []) + - '-page-' + IntToStr(workCounter + 1) + '.html'), - manager.container.Manager.retryConnect); - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos(' 0) and - (Pos('class="scanmr"', parse[i]) > 0) and - (Pos('id="scanmr"', parse[i])> 0) then - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/AnimeA/manga_information.inc b/baseunits/includes/AnimeA/manga_information.inc deleted file mode 100644 index dab00aaa0..000000000 --- a/baseunits/includes/AnimeA/manga_information.inc +++ /dev/null @@ -1,110 +0,0 @@ - function GetAnimeAInfoFromURL: Byte; - var - i, j: Cardinal; - isExtractGenres: Boolean = False; - s: String; - begin - mangaInfo.website := WebsiteRoots[ANIMEA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(ANIMEA_ID, URL + ANIMEA_SKIP); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i + 1], 'Manga - Read ', ' Manga Scans'); - - // get cover link - if Pos('class="cover_mp"', parse[i]) > 0 then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - // get authors - if (Pos('Author(s):', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimRight(TrimLeft(parse.Strings[i + 3])); - - // get artists - if (Pos('Artist(s):', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimRight(TrimLeft(parse.Strings[i + 2])); - - // get genres - if (Pos('Genre(s):', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := ''; - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if GetTagName(parse.Strings[i]) <> 'a' then - for j := 0 to 37 do - if Pos(LowerCase(defaultGenres[j]), LowerCase(parse.Strings[i])) <> 0 then - mangaInfo.genres := mangaInfo.genres + (defaultGenres[j] + ', '); - if Pos('</li>', parse.Strings[i]) > 0 then - isExtractGenres := False; - end; - - // get summary - if Pos('Upload a chapter', parse.Strings[i]) > 0 then - begin - j := i + 8; - mangaInfo.summary := ''; - while (j < parse.Count - 4) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - mangaInfo.summary := StringFilter(mangaInfo.summary + parse.Strings[j]); - Inc(j); - end; - mangaInfo.summary := StringFilter(mangaInfo.summary); - end; - - // get status - if (Pos('Status:', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - - // get chapter name and links - if (Pos('<a', parse[i]) > 0) and (Pos('id="ch_', parse[i]) > 0) and - (i + 3 < parse.Count - 1) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - s := ''; - if (parse[i + 3] <> '') and (Pos('<', parse[i + 3]) = 0) then - begin - s := Trim(TrimLeftChar(parse[i + 3], [':'])); - end; - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]) + ' ' + s))); - mangaInfo.chapterName.Add(s); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/AnimeA/names_and_links.inc b/baseunits/includes/AnimeA/names_and_links.inc deleted file mode 100644 index 0180f5abc..000000000 --- a/baseunits/includes/AnimeA/names_and_links.inc +++ /dev/null @@ -1,23 +0,0 @@ - function AnimeAGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ANIMEA_ID, 1] + - ANIMEA_BROWSER + URL, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - for i := 0 to Source.Count - 1 do - begin - if Pos('manga_img', Source.Strings[i]) <> 0 then - begin - Result := NO_ERROR; - links.Add(GetString(Source.Strings[i], '"', '"')); - names.Add(GetString(Source.Strings[i], 'title="', ' Manga"')); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/AnimeStory/chapter_page_number.inc b/baseunits/includes/AnimeStory/chapter_page_number.inc deleted file mode 100644 index ba000e827..000000000 --- a/baseunits/includes/AnimeStory/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetAnimeStoryPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(ANIMESTORY_ID, URL) + '1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('data-page=', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i]; - manager.container.pageNumber := - StrToInt(GetAttributeValue(GetTagAttribute(s, 'data-page='))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/AnimeStory/image_url.inc b/baseunits/includes/AnimeStory/image_url.inc deleted file mode 100644 index 01426dfb3..000000000 --- a/baseunits/includes/AnimeStory/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetAnimeStoryImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(ANIMESTORY_ID, URL) + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('id="chpimg"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - DecodeURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/AnimeStory/manga_information.inc b/baseunits/includes/AnimeStory/manga_information.inc deleted file mode 100644 index b1d0c1e87..000000000 --- a/baseunits/includes/AnimeStory/manga_information.inc +++ /dev/null @@ -1,130 +0,0 @@ - function GetAnimeStoryInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[ANIMESTORY_ID, 0]; - mangaInfo.url := FillMangaSiteHost(ANIMESTORY_ID, '/' + URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - { if (mangaInfo.coverLink = '') AND - (Pos('imageanchor="1"', parse.Strings[i])>0) then - mangaInfo.coverLink:= CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href='))); - } - // get title - if (Pos('<title>', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft( - TrimRight(HTMLEntitiesFilter(GetString('~!@' + parse.Strings[i + 1], - '~!@', ' | Anime-Story')))); - - if (not isExtractChapter) and (Pos('Liste des Chapitres', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('href=', parse.Strings[i]) > 0) and - (Pos('Lecture', parse.Strings[i + 1]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[ANIMESTORY_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft( - TrimRight(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'title='))))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('class=''comments''', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get summary - if (Pos('Synopsis', parse.Strings[i]) <> 0) and - (Pos('<h2>', parse.Strings[i - 1]) <> 0) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get authors - if (i + 5 < parse.Count) and (Pos('Auteur :', parse.Strings[i]) <> 0) then - mangaInfo.authors := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 5]))); - - // get artists - if (i + 5 < parse.Count) and (Pos('Illustrateur :', parse.Strings[i]) <> 0) then - mangaInfo.artists := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 5]))); - - // get genres - if (Pos('Sous-genre(s) :', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('search?subgenre', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</td>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 5 < parse.Count) and (Pos('Statut :', parse.Strings[i]) <> 0) then - begin - if (Pos('terminé', parse.Strings[i + 5]) <> 0) or - (Pos('one shot', parse.Strings[i + 5]) <> 0) then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/AnimeStory/names_and_links.inc b/baseunits/includes/AnimeStory/names_and_links.inc deleted file mode 100644 index 0db9238cf..000000000 --- a/baseunits/includes/AnimeStory/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function AnimeStoryGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ANIMESTORY_ID, 1] + - ANIMESTORY_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="left"', parse.Strings[i]) > 0) and - (Pos('href=', parse.Strings[i + 1]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 2]); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Batoto/chapter_page_number.inc b/baseunits/includes/Batoto/chapter_page_number.inc deleted file mode 100644 index 30358a317..000000000 --- a/baseunits/includes/Batoto/chapter_page_number.inc +++ /dev/null @@ -1,69 +0,0 @@ - function GetBatotoPageNumber: Boolean; - var - isWebtoon: Boolean = True; - i, j: Cardinal; - l: TStringList; - s: String; - begin - l := TStringList.Create; - parse := TStringList.Create; - - parse.Clear; - l.Clear; - s := FillMangaSiteHost(BATOTO_ID, URL); - Result := GetPage(TObject(l), s + '/1', manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - manager.container.PageNumber := 0; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (Pos('page_select', parse.Strings[i]) > 0) then - begin - isWebtoon := False; - Break; - end; - end; - - if isWebtoon then - begin - //grab image directly - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('<img ', parse.Strings[i]) > 0 then - if Pos('<br/>', parse.Strings[i + 1]) > 0 then - manager.container.pageLinks.Add(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - end; - end; - if manager.container.PageLinks.Count > 0 then - manager.container.PageNumber := manager.container.PageLinks.Count - 1; - end - else - begin - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if Pos('page_select', parse.Strings[i]) <> 0 then - begin - j := i + 2; - while GetTagName(parse.Strings[j]) = 'option' do - begin - Inc(manager.container.PageNumber); - Inc(j, 3); - end; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Batoto/directory_page_number.inc b/baseunits/includes/Batoto/directory_page_number.inc deleted file mode 100644 index 68b3b372e..000000000 --- a/baseunits/includes/Batoto/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetBatotoDirectoryPageNumber: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[BATOTO_ID, 1] + - BATOTO_BROWSER + '?per_page=750&st=0', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('Page 1 of ', parse.Strings[i]) > 0) then - begin - s := GetString(parse.Strings[i] + '~!@', 'Page 1 of ', '~!@'); - Page := StrToInt(TrimLeft(TrimRight(s))); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Batoto/image_url.inc b/baseunits/includes/Batoto/image_url.inc deleted file mode 100644 index de9afa768..000000000 --- a/baseunits/includes/Batoto/image_url.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetBatotoImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(BATOTO_ID, URL); - Result := GetPage(TObject(l), s + '/' + IntToStr(workCounter + 1), - manager.container.manager.retryConnect); - - if l.Count > 0 then - begin - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - end; - - if Self.Terminated then - begin - parse.Free; - l.Free; - Exit; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', parse.Strings[i]) > 0) and - (Pos('id="comic_page"', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - manager.container.PageLinks.Strings[workCounter] := s; - Break; - end; - end; - end; - - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Batoto/manga_information.inc b/baseunits/includes/Batoto/manga_information.inc deleted file mode 100644 index 7b1bcab1c..000000000 --- a/baseunits/includes/Batoto/manga_information.inc +++ /dev/null @@ -1,198 +0,0 @@ - function GetBatotoInfoFromURL: Byte; - var - patchURL, s: String; - i, j: Cardinal; - - begin - patchURL := URL; - //if Pos('comic/_/comics', patchURL) = 0 then - //patchURL:= StringReplace(URL, 'comic/_', 'comic/_/comics', []); - mangaInfo.url := FillMangaSiteHost(BATOTO_ID, patchURL); - - Source.Clear; - if not GetPage(TObject(Source), TrimLeft(TrimRight(mangaInfo.url)), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source using our own HTML parser - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - Source.Free; - mangaInfo.website := WebsiteRoots[BATOTO_ID, 0]; - - mangaInfo.genres := ''; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover link - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('max-height:500px', parse.Strings[i]) > 0) then - begin - mangaInfo.coverLink := - CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - end; - - // get title - if (Pos('ipsType_pagetitle', parse[i]) > 0) then - mangaInfo.title := Trim(StringFilter(Trim(parse[i + 1]))); - - // get summary - if (Pos('Description:', parse.Strings[i]) <> 0) then - begin - j := i + 3; - mangaInfo.summary := ''; - while (Pos('</td>', parse.Strings[j]) = 0) and (j < parse.Count - 1) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := StringFilter(parse.Strings[j] + #10#13); - parse.Strings[j] := - StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := - StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + StringFilter(parse.Strings[j]); - end; - Inc(j); - end; - end; - - // get chapter name and links (bad code) - //mulai - if OptionShowAllLang then - begin - if (GetTagName(parse.Strings[i]) = 'a') and - (Pos('/read/_/', parse.Strings[i]) > 0) and - (i + 8 < parse.Count - 1) and - (Pos('title=', parse.Strings[i + 8]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - (StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[BATOTO_ID, 1], '', [rfReplaceAll]))); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #10, '', [rfReplaceAll]); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #13, '', [rfReplaceAll]); - parse.Strings[i + 2] := StringFilter(TrimLeft(parse.Strings[i + 2])); - s := StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 2]))); - if OptionShowBatotoSG then - s := s + ' [by ' + StringFilter( - TrimRight(RemoveSymbols(parse.Strings[i + 15]))) + ']' + ' [' + - GetAttributeValue(GetTagAttribute(parse.Strings[i + 8], 'title=')) + ']'; - mangaInfo.chapterName.Add(s); - end - else - if (GetTagName(parse.Strings[i]) = 'a') and - (Pos('/read/_/', parse.Strings[i]) > 0) and - (i + 2 < parse.Count - 1) and - (Pos('title=', parse.Strings[i - 3]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - (StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[BATOTO_ID, 1], '', [rfReplaceAll]))); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #10, '', [rfReplaceAll]); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #13, '', [rfReplaceAll]); - parse.Strings[i + 2] := StringFilter(TrimLeft(parse.Strings[i + 2])); - mangaInfo.chapterName.Add(TrimRight(RemoveSymbols(parse.Strings[i + 2]))); - end; - end - else - begin - if (GetTagName(parse.Strings[i]) = 'a') and - (Pos('/read/_/', parse.Strings[i]) > 0) and - (i + 8 < parse.Count - 1) and - (Pos('English', parse.Strings[i + 8]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - (StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[BATOTO_ID, 1], '', [rfReplaceAll]))); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #10, '', [rfReplaceAll]); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #13, '', [rfReplaceAll]); - parse.Strings[i + 2] := StringFilter(TrimLeft(parse.Strings[i + 2])); - s := StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 2]))); - if OptionShowBatotoSG then - s := s + ' [by ' + StringFilter( - TrimRight(RemoveSymbols(parse.Strings[i + 15]))) + ']'; - mangaInfo.chapterName.Add(s); - end - else - if (GetTagName(parse.Strings[i]) = 'a') and - (Pos('/read/_/', parse.Strings[i]) > 0) and - (i + 2 < parse.Count - 1) and - (Pos('English', parse.Strings[i - 3]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - (StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[BATOTO_ID, 1], '', [rfReplaceAll]))); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #10, '', [rfReplaceAll]); - parse.Strings[i + 2] := - StringReplace(parse.Strings[i + 2], #13, '', [rfReplaceAll]); - parse.Strings[i + 2] := StringFilter(TrimLeft(parse.Strings[i + 2])); - mangaInfo.chapterName.Add(TrimRight(RemoveSymbols(parse.Strings[i + 2]))); - end; - end; - - // get authors - if (i + 5 < parse.Count - 1) and - (Pos('Author:', parse.Strings[i]) > 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 5]); - - // get artists - if (i + 5 < parse.Count - 1) and - (Pos('Artist:', parse.Strings[i]) > 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 5]); - - // get genres - if Pos('/search?genres=', parse.Strings[i]) > 0 then - begin - if Pos('</span', parse.Strings[i + 4]) > 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse.Strings[i + 3]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + parse.Strings[i + 3]; - end; - - // get status - if (Pos('Status:', parse.Strings[i]) > 0) then - begin - if (i + 4 < parse.Count - 1) and - (Pos('Ongoing', parse.Strings[i + 4]) > 0) then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterName.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Batoto/names_and_links.inc b/baseunits/includes/Batoto/names_and_links.inc deleted file mode 100644 index 1a08e08a0..000000000 --- a/baseunits/includes/Batoto/names_and_links.inc +++ /dev/null @@ -1,58 +0,0 @@ - function BatotoGetNamesAndLinks: Byte; - var - i: Cardinal; - //s : String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[BATOTO_ID, 1] + - BATOTO_BROWSER + '?per_page=750&st=' + IntToStr(StrToInt(URL) * 750), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - regx := TRegExpr.Create; - regx.ModifierI := True; - //regx.Expression:='^.*(/comics?/_/\w+/[^''"\?]+).*$'; - regx.Expression := '^.*(/comics?/_/(sp|comics?)/[^''"\?]+).*$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) > 0) then - if regx.Exec(Trim(parse[i])) then - begin - links.Add(regx.Replace(Trim(parse[i]), '$1', True)); - names.Add(Trim(StringFilter(Trim(parse[i + 1])))); - end; - //if (GetTagName(parse.Strings[i]) = 'a') AND - // (Pos('/comic/', parse.Strings[i])>0) AND - // (Pos('/comics/''', parse.Strings[i])=0) AND - // (Pos('/comics/"', parse.Strings[i])=0) AND - // (Pos('/comics/?', parse.Strings[i])=0) then - //begin - // Result:= NO_ERROR; - // s:= StringFilter(TrimLeft(TrimRight(parse.Strings[i+1]))); - // if (Pos('bloody-rose-r8162', parse.Strings[i]) = 0) AND - // (Pos('dragon-and-weed-origins-outbreak-r6901', parse.Strings[i]) = 0) AND - // (Pos('dragon-and-weed-origins-the-fallen-r8180', parse.Strings[i]) = 0) then - // begin - // names.Add(s); - // s:= GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - // links.Add(StringReplace(s, WebsiteRoots[BATOTO_ID,1], '', [])); - // end; - //end; - end; - regx.Free; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/BlogTruyen/directory_page_number.inc b/baseunits/includes/BlogTruyen/directory_page_number.inc deleted file mode 100644 index 902f67da4..000000000 --- a/baseunits/includes/BlogTruyen/directory_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetBlogTruyenDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[BLOGTRUYEN_ID, 1] + - BLOGTRUYEN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('[cuối]', parse.Strings[i]) > 0) then - begin - s := TrimRight(TrimLeft(GetString(parse.Strings[i - 1], 'LoadPage(', ')'))); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/BlogTruyen/image_url.inc b/baseunits/includes/BlogTruyen/image_url.inc deleted file mode 100644 index 3cfac417c..000000000 --- a/baseunits/includes/BlogTruyen/image_url.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetBlogTruyenImageURL: Boolean; - var - isExtrackLink: Boolean = False; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(BLOGTRUYEN_ID, URL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if not (isExtrackLink) and (Pos('id="content"', parse.Strings[i]) > 0) then - isExtrackLink := True; - if (isExtrackLink) and (GetTagName(parse.Strings[i]) = 'img') then - manager.container.PageLinks.Add( - EncodeUrl(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')))) - else - if (isExtrackLink) and (Pos('</article>', parse.Strings[i]) > 0) then - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/BlogTruyen/manga_information.inc b/baseunits/includes/BlogTruyen/manga_information.inc deleted file mode 100644 index a3303f813..000000000 --- a/baseunits/includes/BlogTruyen/manga_information.inc +++ /dev/null @@ -1,129 +0,0 @@ - function GetBlogTruyenInfoFromURL: Byte; - var - s: String; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = True; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[BLOGTRUYEN_ID, 0]; - mangaInfo.url := FillMangaSiteHost(BLOGTRUYEN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('div class="thumbnail"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i + 2], 'src='))); - - // get summary - if (Pos('class="content"', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 1; - while (j < parse.Count) and (Pos('</div>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - Break; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get title - if (Pos('class="entry-title"', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 3]))); - - // get chapter name and links - if (isExtractChapter) and - (Pos('class="publishedDate"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i - 5], 'href=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(Trim(parse.Strings[i - 4])); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('class="al-c social-button"', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get authors - if (i + 2 < parse.Count) and (Pos('Tác giả:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(TrimRight(parse.Strings[i + 2])); - - // get artists - //if (i+1<parse.Count) AND (Pos('/search/artist/', parse.Strings[i])<>0) then - // mangaInfo.artists:= TrimLeft(parse.Strings[i+1]); - - // get genres - if (not isExtractGenres) and (Pos('class="category"', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - s := TrimLeft(TrimRight(parse.Strings[i])); - if Pos('Đăng bởi:', s) <> 0 then - isExtractGenres := False - else - if (s <> '') and (s[1] <> '<') and - (Pos('class="category"', parse.Strings[i - 2]) <> 0) then - mangaInfo.genres := mangaInfo.genres + s + ', '; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Trạng thái:', parse.Strings[i]) <> 0) then - begin - if (Pos('Đang tiến hành', parse.Strings[i + 2]) <> 0) or - (Pos('Tạm ngưng', parse.Strings[i + 2]) <> 0) then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/BlogTruyen/names_and_links.inc b/baseunits/includes/BlogTruyen/names_and_links.inc deleted file mode 100644 index 3bd449e40..000000000 --- a/baseunits/includes/BlogTruyen/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function BlogTruyenGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - stream: TStringStream; - begin - Result := INFORMATION_NOT_FOUND; - stream := TStringStream.Create(''); - s := WebsiteRoots[BLOGTRUYEN_ID, 1] + BLOGTRUYEN_JS_BROWSER; - s := BLOGTRUYEN_POST_FORM + IntToStr(StrToInt(URL) + 1); - while not HttpPostURL(WebsiteRoots[BLOGTRUYEN_ID, 1] + BLOGTRUYEN_JS_BROWSER, - BLOGTRUYEN_POST_FORM + IntToStr(StrToInt(URL) + 1), stream) do - Sleep(32); - Source.Text := stream.DataString; - stream.Free; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="tiptip', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft( - TrimRight(GetString(parse.Strings[i + 2], 'title="truyện tranh ', '">')))); - names.Add(HTMLEntitiesFilter(s)); - links.Add(GetAttributeValue(GetTagAttribute(parse.Strings[i + 2], 'href="'))); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/CentralDeMangas/directory_page_number.inc b/baseunits/includes/CentralDeMangas/directory_page_number.inc deleted file mode 100644 index 7ec245d59..000000000 --- a/baseunits/includes/CentralDeMangas/directory_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetCentralDeMangasDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[CENTRALDEMANGAS_ID, 1] + - CENTRALDEMANGAS_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('/mangas/list/*/', parse.Strings[i]) > 0) then - begin - s := TrimRight(TrimLeft(GetString(parse.Strings[i], '/mangas/list/*/', '">'))); - page := StrToInt(s); - Result := NO_ERROR; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/CentralDeMangas/image_url.inc b/baseunits/includes/CentralDeMangas/image_url.inc deleted file mode 100644 index 636c7c9be..000000000 --- a/baseunits/includes/CentralDeMangas/image_url.inc +++ /dev/null @@ -1,40 +0,0 @@ - function GetCentralDeMangasImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := EncodeUrl(FillMangaSiteHost(CENTRALDEMANGAS_ID, URL)); - // + IntToStr(workCounter+1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('var pages = ', parse.Strings[i]) > 0 then - begin - s := StringReplace(parse.Strings[i], '\/', '/', [rfReplaceAll]); - repeat - j := Pos('http://', s); - manager.container.PageLinks.Add(EncodeURL(GetString(s, '"', '"'))); - s := StringReplace(s, '"', '', []); - s := StringReplace(s, '"', '', []); - Delete(s, j, 10); - j := Pos('http://', s); - until j = 0; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/CentralDeMangas/manga_information.inc b/baseunits/includes/CentralDeMangas/manga_information.inc deleted file mode 100644 index e687948dc..000000000 --- a/baseunits/includes/CentralDeMangas/manga_information.inc +++ /dev/null @@ -1,106 +0,0 @@ - function GetCentralDeMangasInfoFromURL: Byte; - var - isExtractGenres: Boolean = False; - i: Cardinal; - begin - mangaInfo.website := WebsiteRoots[CENTRALDEMANGAS_ID, 0]; - mangaInfo.url := FillMangaSiteHost(CENTRALDEMANGAS_ID, URL); - if not GetPage(TObject(Source), EncodeURL(mangaInfo.url), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // convert charset - // source.Text:= ISO_8859_1ToUTF8(source.Text); - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('class="img-thumbnail"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('class="img-thumbnail"', parse.Strings[i]) > 0) then - mangaInfo.summary := parse.Strings[i + 6]; - - // get title - if (mangaInfo.title = '') and - (Pos('<title>', parse.Strings[i]) <> 0) then - mangaInfo.title := TrimLeft(HTMLEntitiesFilter( - StringFilter(GetString('~!@' + parse.Strings[i + 1], '~!@', ' || Central de Mangás')))); - - // get chapter name and links - if Pos('class="col-xs-1 col-sm-1 col-md-1 col-lg-1"', parse.Strings[i]) > 0 then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'href'))); - mangaInfo.chapterName.Add(RemoveSymbols(Trim(parse.Strings[i + 1]))); - end; - - // get authors - if (i + 12 < parse.Count) and - (Pos('Autor', parse.Strings[i]) <> 0) and - (Pos('<h4>', parse.Strings[i - 1]) <> 0) then - mangaInfo.authors := TrimLeft(TrimRight(parse.Strings[i + 12])); - - // get artists - if (i + 12 < parse.Count) and - (Pos('Arte', parse.Strings[i]) <> 0) and - (Pos('<h4>', parse.Strings[i - 1]) <> 0) then - mangaInfo.artists := TrimLeft(TrimRight(parse.Strings[i + 12])); - - // get genres - if (i + 1 < parse.Count) and - (Pos('Gênero', parse.Strings[i]) <> 0) and - (Pos('</h4>', parse.Strings[i + 1]) <> 0) and - (Pos('<h4>', parse.Strings[i - 1]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if (Pos('<h4>', parse.Strings[i]) > 0) and - (Pos('Scantrad', parse.Strings[i + 1]) > 0) and - (Pos('</h4>', parse.Strings[i + 2]) > 0) then - isExtractGenres := False; - - if Pos('class="btn btn-xs btn-primary"', parse.Strings[i]) > 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := parse.Strings[i + 1] - else - mangaInfo.genres := mangaInfo.genres + ', ' + parse.Strings[i + 1]; - end; - - // get status - if (i + 12 < parse.Count) and - (Pos('Status', parse.Strings[i]) <> 0) and - (Pos('<h4>', parse.Strings[i - 1]) <> 0) then - begin - if (Pos('Completo', parse.Strings[i + 12]) <> 0) then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/CentralDeMangas/names_and_links.inc b/baseunits/includes/CentralDeMangas/names_and_links.inc deleted file mode 100644 index b607df104..000000000 --- a/baseunits/includes/CentralDeMangas/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function CentralDeMangasGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[CENTRALDEMANGAS_ID, 1] + - CENTRALDEMANGAS_BROWSER + '/' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/mangas/info/', parse.Strings[i]) > 0) and - (Pos('<td>', parse.Strings[i - 1]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 1]); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetString(parse.Strings[i], 'href="', '"'), - WebsiteRoots[CENTRALDEMANGAS_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/CentrumMangi_PL/chapter_page_number.inc b/baseunits/includes/CentrumMangi_PL/chapter_page_number.inc deleted file mode 100644 index 56f0c721c..000000000 --- a/baseunits/includes/CentrumMangi_PL/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetCentrumMangi_PLPageNumber: Boolean; - var - s: String; - Count: Cardinal = 0; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(CENTRUMMANGI_PL_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('</select>', parse.Strings[i]) > 0) then - if Count > 0 then - begin - s := parse.Strings[i - 2]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end - else - Inc(Count); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/CentrumMangi_PL/image_url.inc b/baseunits/includes/CentrumMangi_PL/image_url.inc deleted file mode 100644 index 52c5728b1..000000000 --- a/baseunits/includes/CentrumMangi_PL/image_url.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetCentrumMangi_PLImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(CENTRUMMANGI_PL_ID, '/' + - StringReplace(URL, '-1.html', '.html', [])); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - if (Pos('<img alt=', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - s := StringReplace(s, 'https://', 'http://', [rfReplaceAll]); - s := StringReplace(s, 'mangas/', WebsiteRoots[CENTRUMMANGI_PL_ID, 1] + - '/mangas/', [rfReplaceAll]); - manager.container.PageLinks.Add(EncodeURL(s)); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/CentrumMangi_PL/manga_information.inc b/baseunits/includes/CentrumMangi_PL/manga_information.inc deleted file mode 100644 index 091a25a69..000000000 --- a/baseunits/includes/CentrumMangi_PL/manga_information.inc +++ /dev/null @@ -1,127 +0,0 @@ - function GetCentrumMangi_PLInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[CENTRUMMANGI_PL_ID, 0]; - mangaInfo.url := FillMangaSiteHost(CENTRUMMANGI_PL_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - //get infos - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - //get cover - if Pos('class="image"', parse[i]) > 0 then - if Pos('<img ', parse[i + 2]) > 0 then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - //get title - if Pos('Informacje ::', parse[i]) > 0 then - if Pos('<h2', parse[i - 1]) > 0 then - mangaInfo.title := - Trim(HTMLEntitiesFilter(StringFilter( - Trim(ReplaceRegExpr('Informacje\s\:\:\s', parse[i], '', False))))); - - //get author - if Pos('Autor:', parse[i]) > 0 then - if Pos('</strong', parse[i + 1]) > 0 then - mangaInfo.authors := - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2])))); - - //get summary - if Pos('Recenzja', parse[i]) > 0 then - if Pos('</h3', parse[i + 1]) > 0 then - mangaInfo.summary := - Trim(BreaksString(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 4]))))); - - //get status - if Pos('Status:', parse[i]) > 0 then - if Pos('</strong', parse[i + 1]) > 0 then - if Pos('Zlicencjonowana', parse[i + 4]) > 0 then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - - //get genres - if Pos('Gatunki:', parse[i]) > 0 then - if Pos('</strong', parse[i + 1]) > 0 then - isExtractGenres := True; - if isExtractGenres and - (Pos('</div', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres then - begin - if Pos('<a ', parse[i]) > 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))) - else - mangaInfo.genres := - Trim(mangaInfo.genres + ', ' + - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - - //get chapters - if Pos('class="chapter"', parse[i]) > 0 then - isExtractChapter := True; - if Pos('</tbody', parse[i]) > 0 then - isExtractChapter := False; - if isExtractChapter then - begin - if Pos('class="c"', parse[i]) > 0 then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetVal(parse[i + 1], 'href'), - WebsiteRoots[CENTRUMMANGI_PL_ID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2])))); - mangaInfo.chapterName.Add(s); - end; - if (Pos('class="t"', parse[i]) > 0) and - (mangaInfo.chapterName.Count > 0) then - begin - s := mangaInfo.chapterName[mangaInfo.chapterName.Count - 1] + ' '; - mangaInfo.chapterName[mangaInfo.chapterName.Count - 1] := - Trim(s + (Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))))); - end; - end; - end; - end; - - // invert chapters - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/CentrumMangi_PL/names_and_links.inc b/baseunits/includes/CentrumMangi_PL/names_and_links.inc deleted file mode 100644 index 83fd8ee4b..000000000 --- a/baseunits/includes/CentrumMangi_PL/names_and_links.inc +++ /dev/null @@ -1,52 +0,0 @@ - function CentrumMangi_PLGetNamesAndLinks: Byte; - var - i: Cardinal; - //isExtractItem :boolean = True; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[CENTRUMMANGI_PL_ID, 1] + - CENTRUMMANGI_PL_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - //if (Pos('<div ', parse[i]) > 0) and - // (Pos('class="box-max"', parse[i]) > 0) then - // isExtractItem := True; - //if isExtractItem and - // (Pos('</table', parse[i]) > 0) then - // isExtractItem := False; - - if (Pos('<td style="width:45%;text-align: left;">', parse[i]) > 0) then - begin - Result := NO_ERROR; - links.Add(StringReplace(GetVal(parse[i + 1], 'href'), - WebsiteRoots[CENTRUMMANGI_PL_ID, 1], '', [rfIgnoreCase])); - names.Add(Trim(HTMLEntitiesFilter(StringFilter(parse[i + 2])))); - end; - - //if isExtractItem then - //begin - // if (Pos('<a ', parse[i]) > 0) and - // (Pos('/spis/', parse[i]) = 0) then - // begin - // Result := NO_ERROR; - // links.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[CENTRUMMANGI_PL_ID, 1], '', [rfIgnoreCase])); - // names.Add(Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1])))); - // end; - //end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/DM5/directory_page_number.inc b/baseunits/includes/DM5/directory_page_number.inc deleted file mode 100644 index 9902dfb41..000000000 --- a/baseunits/includes/DM5/directory_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetDM5DirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; // - if not GetPage(TObject(Source), WebsiteRoots[DM5_ID, 1] + DM5_BROWSER + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('/mangas/list/*/', parse.Strings[i]) > 0) then - begin - s := TrimRight(TrimLeft(GetString(parse.Strings[i], '/mangas/list/*/', '">'))); - page := StrToInt(s); - Result := NO_ERROR; - Exit; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/Dynasty-Scans/chapter_page_number.inc b/baseunits/includes/Dynasty-Scans/chapter_page_number.inc deleted file mode 100644 index f859020a9..000000000 --- a/baseunits/includes/Dynasty-Scans/chapter_page_number.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetDynastyScansPageNumber: Boolean; - var - i: Integer; - l: TStringList; - imgs_: string; - begin - l := TStringList.Create; - - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(DYNASTYSCANS_ID, URL)), - manager.container.manager.retryConnect); - - imgs_ := ''; - if l.Count > 0 then - begin - for i := 0 to l.Count-1 do - if Pos('var pages = [', l[i]) > 0 then - begin - imgs_ := l[i]; - imgs_ := StringReplace(imgs_, 'var pages =', '', [rfIgnoreCase]); - imgs_ := Trim(TrimChar(imgs_, [';', ' '])); - Break; - end; - end; - l.Free; - - with manager.container do - begin - if imgs_ <> '' then - begin - PageLinks.Clear; - ParseJSONArray(imgs_, 'image', PageLinks); - PageNumber := PageLinks.Count; - end; - - if PageLinks.Count > 0 then - for i := 0 to PageLinks.Count-1 do - begin - if Length(PageLinks[i]) > 0 then - if PageLinks[i][1] = '/' then - PageLinks[i] := WebsiteRoots[DYNASTYSCANS_ID, 1] + PageLinks[i]; - end; - end; - end; diff --git a/baseunits/includes/Dynasty-Scans/directory_page_number.inc b/baseunits/includes/Dynasty-Scans/directory_page_number.inc deleted file mode 100644 index 0fa3abcdf..000000000 --- a/baseunits/includes/Dynasty-Scans/directory_page_number.inc +++ /dev/null @@ -1,6 +0,0 @@ - function GetDynastyScansDirectoryPageNumber: Byte; - begin - Source.Free; - Page := Length(DYNASTYSCANS_BROWSER); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Dynasty-Scans/manga_information.inc b/baseunits/includes/Dynasty-Scans/manga_information.inc deleted file mode 100644 index f7615aef9..000000000 --- a/baseunits/includes/Dynasty-Scans/manga_information.inc +++ /dev/null @@ -1,101 +0,0 @@ - function GetDynastyScansInfoFromURL: Byte; - var - i, j: Integer; - hs: String = ''; - begin - mangaInfo.website := WebsiteRoots[DYNASTYSCANS_ID, 0]; - mangaInfo.url := FillMangaSiteHost(DYNASTYSCANS_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - for i := 0 to parse.Count-1 do - begin - //title - if mangaInfo.title = '' then - if GetVal(parse[i], 'class') = 'tag-title' then - mangaInfo.title := CommonStringFilter(parse[i+2]); - - //cover - if mangaInfo.coverLink = '' then - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'class') = 'thumbnail') then - begin - mangaInfo.coverLink := GetVal(parse[i], 'src'); - if Length(mangaInfo.coverLink) > 0 then - if mangaInfo.coverLink[1] = '/' then - mangaInfo.coverLink := WebsiteRoots[DYNASTYSCANS_ID, 1] + - mangaInfo.coverLink; - end; - - if (GetTagName(parse[i]) = 'a') then - begin - //authors - if Pos('/authors/', parse[i]) <> 0 then - mangaInfo.authors := CommonStringFilter(parse[i+1]); - - //genre/tags - if GetVal(parse[i], 'class') = 'label' then - AddCommaString(mangaInfo.genres, CommonStringFilter(parse[i+1])); - end; - - //status - if GetTagName(parse[i]) = 'small' then - if Pos('ongoing', LowerCase(parse[i+1])) <> 0 then - mangaInfo.status := '1' - else - if Pos('completed', LowerCase(parse[i+1])) <> 0 then - mangaInfo.status := '0'; - - //genre/tags - if GetVal(parse[i], 'class') = 'doujin_tags' then - AddCommaString(mangaInfo.genres, CommonStringFilter(parse[i+2])); - - //summary - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = 'description') then - begin - mangaInfo.summary := ''; - for j := i+1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/div' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + LineEnding + CommonStringFilter(parse[j]); - end; - mangaInfo.summary := Trim(mangaInfo.summary); - end; - - //chapters - if (GetTagName(parse[i]) = 'dl') and - (GetVal(parse[i], 'class') = 'chapter-list') then - begin - for j := i+1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/dl' then - Break - else - if (GetTagName(parse[j]) = 'a') and - (GetVal(parse[j], 'class') = 'name') then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[j], 'href')); - mangaInfo.chapterName.Add(Trim(hs + CommonStringFilter(parse[j+1]))); - end - else - if GetTagName(parse[j]) = 'dt' then - hs := CommonStringFilter(parse[j+1]) + ' '; - end; - end; - end; - Result := NO_ERROR; - end; - end; diff --git a/baseunits/includes/Dynasty-Scans/names_and_links.inc b/baseunits/includes/Dynasty-Scans/names_and_links.inc deleted file mode 100644 index c38287f2c..000000000 --- a/baseunits/includes/Dynasty-Scans/names_and_links.inc +++ /dev/null @@ -1,34 +0,0 @@ - function DynastyScansGetNamesAndLinks: Byte; - var - i: Integer; - s: string; - begin - Result := INFORMATION_NOT_FOUND; - i := StrToIntDef(URL, 0); - if i >= Length(DYNASTYSCANS_BROWSER) then - begin - Source.Free; - Exit; - end; - - s := WebsiteRoots[DYNASTYSCANS_ID, 1] + DYNASTYSCANS_BROWSER[i]; - if not GetPage(TObject(Source), s, 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if GetTagName(parse[i]) = 'dd' then - if GetTagName(parse[i+1]) = 'a' then - begin - links.Add(GetVal(parse[i+1], 'href')); - names.Add(CommonStringFilter(parse[i+2])); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/EGScans/chapter_page_number.inc b/baseunits/includes/EGScans/chapter_page_number.inc deleted file mode 100644 index e12a990a9..000000000 --- a/baseunits/includes/EGScans/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetEGScansPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(EGSCANS_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('</span>', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 4]; - manager.container.PageNumber := - StrToInt(TrimLeft(TrimRight(GetString(s + ' ', 'of ', ' ')))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/EGScans/image_url.inc b/baseunits/includes/EGScans/image_url.inc deleted file mode 100644 index 71ef5bd13..000000000 --- a/baseunits/includes/EGScans/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetEGScansImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(EGSCANS_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - if (Pos('<img ondragstart', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Add(WebsiteRoots[EGSCANS_ID, 1] + - '/' + EncodeURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')))); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/EGScans/manga_information.inc b/baseunits/includes/EGScans/manga_information.inc deleted file mode 100644 index 1626c4868..000000000 --- a/baseunits/includes/EGScans/manga_information.inc +++ /dev/null @@ -1,69 +0,0 @@ - function GetEGScansInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i: Cardinal; - begin - mangaInfo.website := WebsiteRoots[EGSCANS_ID, 0]; - mangaInfo.url :=FillMangaSiteHost(EGSCANS_ID, '/' + URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (not isExtractChapter) and - (Pos('<span>', parse.Strings[i]) > 0) and - (Pos('Chapter', parse.Strings[i + 1]) > 0) then - isExtractChapter := True; - - if (isExtractChapter) and - (Pos('</span>', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get manga name - if (mangaInfo.title = '') and (Pos('content="Read ', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i], '~!@content="Read ', - ' Manga Online"'); - - { if (isExtractChapter) AND (Pos('</select>', parse.Strings[i])>0) then - break; } - - if (isExtractChapter) and - (Pos('<option value="', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := '/' + URL + '/' + StringReplace(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'value=')), WebsiteRoots[EGSCANS_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/EGScans/names_and_links.inc b/baseunits/includes/EGScans/names_and_links.inc deleted file mode 100644 index f2c4542bc..000000000 --- a/baseunits/includes/EGScans/names_and_links.inc +++ /dev/null @@ -1,42 +0,0 @@ - function EGScansGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[EGSCANS_ID, 1] + - EGSCANS_BROWSER + '/' + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('<option value="', parse.Strings[i]) > 0) and - (Pos('="0"', parse.Strings[i]) = 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], - 'value="')), - WebsiteRoots[S2SCAN_ID, 1], '', []); - links.Add(s); - end; - if Pos('<select name="manga"', parse.Strings[i]) > 0 then - Break; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/EHentai/chapter_page_number.inc b/baseunits/includes/EHentai/chapter_page_number.inc deleted file mode 100644 index 3438541a1..000000000 --- a/baseunits/includes/EHentai/chapter_page_number.inc +++ /dev/null @@ -1,148 +0,0 @@ - function GetEHentaiPageNumber: Boolean; - var - s: String; - i, j, g, p: Cardinal; - l: TStringList; - regx: TRegExpr; - cw: Boolean; - begin - regx := TRegExpr.Create; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(EHENTAI_ID, URL); - regx.Expression := '^(.*)/\?p=\d.*$'; - s := regx.Replace(s, '$1', True); - s := ReplaceRegExpr('\?nw=.+$', s, '', False); - if not ExecRegExpr('/$', s) then - s := s + '/'; - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - // check if content warning - cw := False; - if l.Count > 0 then - begin - for i := 0 to l.Count - 1 do - begin - if Pos('>Content Warning</', l[i]) > 0 then - begin - cw := True; - Break; - end; - end; - if cw then - begin - s := s + '?nw=session'; - //s := s + '?nw=always'; - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - end; - end; - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - g := 0; - p := 0; - //get images page count method 1 - regx.Expression := '^.*onclick="sp\((\d+)\).*$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('onclick="sp(', parse.Strings[i]) > 0) then - begin - g := StrToIntDef(regx.Replace(parse.Strings[i], '$1', True), 0); - if g > p then - p := g; - end; - end; - - {//get images page count method 2 - for i := 0 to parse.Count - 1 do - begin - if (Pos('Images:', parse.Strings[i])>0) then - if (Pos('class="gdt1"', parse.Strings[i-1])>0) AND - (Pos('</td>', parse.Strings[i+1])>0) AND - (Pos('class="gdt2"', parse.Strings[i+2])>0) then //to make sure not getting false line - begin - g := Pos('@', parse.Strings[i+3]); - if (g>0) then - begin - try - s := Trim(Copy(parse.Strings[i+3], 1, g-1)); - g := StrToInt(s); - p := g div 40; // per pages contain max 40 images - if g mod 40 > 0 then - p := p+1; - except - p := 2; - end; - end - else - p := 2; - - Dec(p); //1 is page 2 - Break; - end; - end; } - - //manager.container.PageNumber := 0; - //manager.container.PageContainerLinks.Clear; - - //get images page in first page container - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="gdtm"', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 2], 'href=')); - s := StringReplace(s, WebsiteRoots[EHENTAI_ID, 1] + '/s/', '', []); - manager.container.PageContainerLinks.Add(s); - end; - end; - - //get all images page for the rest of page container - if p > 0 then - begin - for i := 1 to p do - begin - parse.Clear; - l.Clear; - s := StringReplace(URL, WebsiteRoots[EHENTAI_ID, 1], '', []); - s := StringReplace(s, '?nw=session', '', [rfReplaceAll]); - s := StringReplace(s, '?nw=always', '', [rfReplaceAll]); - s := WebsiteRoots[EHENTAI_ID, 1] + s; - //if s[Length(s)]='/' then - //SetLength(s, Length(s)-1); - if s[Length((s))] <> '/' then - s := s + '/'; - s := s + '?p=' + IntToStr(i); - //s:= s+'?nw=session'; - - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for j := 0 to parse.Count - 1 do - if (Pos('class="gdtm"', parse.Strings[j]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[j + 2], 'href=')); - s := StringReplace(s, WebsiteRoots[EHENTAI_ID, 1] + '/s/', '', []); - manager.container.PageContainerLinks.Add(s); - end; - end; - end; - manager.container.PageNumber := manager.container.PageContainerLinks.Count; - manager.container.PageLinks.Clear; - while manager.container.PageLinks.Count < manager.container.PageContainerLinks.Count do - manager.container.PageLinks.Add('G') - end; - parse.Free; - l.Free; - regx.Free; - end; diff --git a/baseunits/includes/EHentai/directory_page_number.inc b/baseunits/includes/EHentai/directory_page_number.inc deleted file mode 100644 index bd911103a..000000000 --- a/baseunits/includes/EHentai/directory_page_number.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetEHentaiDirectoryPageNumber: Byte; - var - i, g: Cardinal; - regx: TRegExpr; - begin - - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[EHENTAI_ID, 1] + '/?' + EHENTAI_BROWSER; - //s:= s+'?nw=session'; - - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - Page := 0; - g := 0; - regx := TRegExpr.Create; - regx.Expression := '^.*onclick="sp\((\d+)\).*$'; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (Pos('onclick="sp(', parse.Strings[i]) > 0) then - begin - g := StrToIntDef(regx.Replace(parse.Strings[i], '$1', True), 0); - if g > Page then - Page := g; - end; - end; - regx.Free; - - Page := Page + 1; //page1=0 - - Source.Free; - Result := NO_ERROR; - end; \ No newline at end of file diff --git a/baseunits/includes/EHentai/image_url.inc b/baseunits/includes/EHentai/image_url.inc deleted file mode 100644 index 784e2b500..000000000 --- a/baseunits/includes/EHentai/image_url.inc +++ /dev/null @@ -1,98 +0,0 @@ - function getEHentaiImageURL: Boolean; - var - i, RetryCount: Cardinal; - prs: TStringList; - hparser: THTMLParser; - {s, }purl, iurl, base_url, startkey, gid, startpage, nl: String; - begin - Result := False; - - //Result := 'W'; - //s := manager.container.DownloadInfo.SaveTo + - // '/' + manager.container.ChapterName.Strings[ - // manager.container.CurrentDownloadChapterPtr] + '/' + - // Format('%.3d', [workCounter + 1]); - // Check to see if a file with similar name was already exist. If so then we - // skip the download process. - //if (FileExists(s + '.jpg')) or - // (FileExists(s + '.png')) or - // (FileExists(s + '.gif')) then - //begin - // Result := 'D'; - // Exit; - //end; - - purl := manager.container.PageContainerLinks[workCounter]; - purl := FillMangaSiteHost(EHENTAI_ID, '/s/' + purl); - RetryCount := 0; - while not Result do - begin - iurl := ''; - prs := TStringList.Create; - GetPage(TObject(prs), purl, - manager.container.Manager.retryConnect); - if Self.Terminated then - begin - prs.Free; - Exit; - end; - - parse := TStringList.Create; - hparser := THTMLParser.Create(PChar(prs.Text)); - hparser.OnFoundTag := OnTag; - hparser.OnFoundText := OnText; - hparser.Exec; - hparser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img ', parse[i]) > 0) and - ((Pos(' style=', parse[i]) > 0) or - (Pos(' id="img"', parse[i]) > 0) or - (Pos('/keystamp=', parse.Strings[i]) > 0)) then - begin - iurl := GetAttributeValue(GetTagAttribute(parse[i], 'src=')); - iurl := StringReplace(iurl, '&', '&', [rfReplaceAll, rfIgnoreCase]); - end; - if Pos('onclick="return nl(', parse[i]) > 0 then - nl := ReplaceRegExpr('^.*nl\((\d+)\).*$', parse[i], '$1', True); - end; - - //new reload link - if prs.Count > 0 then - begin - for i := 0 to prs.Count - 1 do - begin - if Pos('var base_url=', prs[i]) > 0 then - base_url := GetValuesFromString(prs[i], '='); - if Pos('var startkey=', prs[i]) > 0 then - startkey := GetValuesFromString(prs[i], '='); - if Pos('var gid=', prs[i]) > 0 then - gid := GetValuesFromString(prs[i], '='); - if Pos('var startpage=', prs[i]) > 0 then - startpage := GetValuesFromString(prs[i], '='); - end; - if nl <> '' then - purl := base_url + '/s/' + startkey + '/' + gid + '-' + startpage + '?nl=' + nl; - end; - parse.Free; - prs.Free; - - //save image - Result := SaveImage( - manager.container.MangaSiteID, - iurl, - lpath, - Format('%.3d', [workCounter + 1]), - prefix, - 1); - - if (manager.container.Manager.retryConnect <> 0) and - (manager.container.Manager.retryConnect <= RetryCount) then - Break; - - if not Result then - Inc(RetryCount); - end; - end; diff --git a/baseunits/includes/EHentai/manga_information.inc b/baseunits/includes/EHentai/manga_information.inc deleted file mode 100644 index 29e8833ab..000000000 --- a/baseunits/includes/EHentai/manga_information.inc +++ /dev/null @@ -1,156 +0,0 @@ - function GetEHentaiInfoFromURL: Byte; - var - i: Cardinal; - s: String; - rgex: TRegExpr; - ava: Boolean = False; - cw: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[EHENTAI_ID, 0]; - mangaInfo.url := FillMangaSiteHost(EHENTAI_ID, URL); - mangaInfo.url := ReplaceRegExpr('\?nw=.+$', mangaInfo.url, '', False); - if not ExecRegExpr('/$', mangaInfo.url) then - mangaInfo.url := mangaInfo.url + '/'; - s := mangaInfo.url; - mangaInfo.summary := ''; - if not GetPage(TObject(Source), s, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - if Source.Count > 0 then - begin - // check if banned - if Source.Count = 1 then - begin - //if mangaInfo.genres = '' then - mangaInfo.summary := Source.Text; - Result := NO_ERROR; - Source.Free; - Exit; - end; - - // check if content warning - cw := False; - for i := 0 to Source.Count - 1 do - begin - if Pos('>Content Warning</', Source[i]) > 0 then - begin - cw := True; - Break; - end; - end; - if cw then - begin - s := s + '?nw=session'; - //s := s + '?nw=always'; - if not GetPage(TObject(Source), s, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - end; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count < 1 then - begin - Result := INFORMATION_NOT_FOUND; - Exit; - end - else - begin - // check availability - for i := 0 to parse.Count - 1 do - begin - if Pos('id="gn"', parse.Strings[i]) > 0 then - begin - ava := True; - Break; - end; - end; - // not available - if not ava then - begin - for i := 0 to parse.Count - 1 do - if Pos('<p>', parse.Strings[i]) > 0 then - begin - mangaInfo.summary := Trim(parse.Strings[i + 1]); - Break; - end; - mangaInfo.status := '0'; - parse.Clear; - Result := NO_ERROR; - Exit; - end; - end; - - mangaInfo.title := ''; - mangaInfo.authors :=' '; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - if parse.Count > 1 then - begin - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('id="gd1"', parse.Strings[i]) > 0) and - (Pos('<img', parse.Strings[i + 1]) > 0) then - mangaInfo.coverLink := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'src=')); - - // get title - if (Pos('id="gn"', parse.Strings[i]) <> 0) then - begin - s := Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 1]))); - if s <> '' then - mangaInfo.title := s; - end; - - // get artists - if (Pos('id="td_artist:', parse.Strings[i]) > 0) then - if mangaInfo.artists = '' then - mangaInfo.artists := parse.Strings[i + 2] - else - mangaInfo.artists := mangaInfo.artists + ', ' + parse.Strings[i + 2]; - - // get misc genres (language, parodi, character, etc) - if (Pos('id="td_', parse.Strings[i]) > 0) and - (Pos('id="td_artist:', parse.Strings[i]) = 0) then //exclude artist - if mangaInfo.genres = '' then - mangaInfo.genres := parse.Strings[i + 2] - else - mangaInfo.genres := mangaInfo.genres + ', ' + parse.Strings[i + 2]; - end; - end; - parse.Clear; - mangaInfo.numChapter := 1; - mangaInfo.chapterName.Add(mangaInfo.title); - mangaInfo.chapterLinks.Add(mangaInfo.url); - - //status - rgex := TRegExpr.Create; - rgex.ModifierI := True; - rgex.Expression := '[\[\(\{](wip|ongoing)[\}\)\]]'; - if rgex.Exec(LowerCase(mangaInfo.title)) then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - rgex.Free; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/EHentai/names_and_links.inc b/baseunits/includes/EHentai/names_and_links.inc deleted file mode 100644 index 71e8d7bfe..000000000 --- a/baseunits/includes/EHentai/names_and_links.inc +++ /dev/null @@ -1,61 +0,0 @@ - function EHentaiGetNamesAndLinks: Byte; - var - i: Cardinal; - s, posc: String; - isThumbnailsON: Boolean = False; - - begin - - Result := INFORMATION_NOT_FOUND; - //s:='http://g.e-hentai.org/?page=5377&f_doujinshi=on&f_manga=on&f_western=on&f_search=Search+Keywords&f_apply=Apply+Filter'; - if URL = '0' then - s := WebsiteRoots[EHENTAI_ID, 1] + '/?' + EHENTAI_BROWSER - else - s := WebsiteRoots[EHENTAI_ID, 1] + '/?page=' + URL + '&' + EHENTAI_BROWSER; - - //s:= s+'?nw=session'; - - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('/?inline_set=dm_l', parse.Strings[i]) > 0) then - begin - isThumbnailsON := True; - Break; - end; - end; - - if isThumbnailsON then - posc := 'class="id2"' - else - posc := 'class="it5"'; - - for i := 0 to parse.Count - 1 do - begin - if (Pos(posc, parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 2]); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - s := StringReplace(s, WebsiteRoots[EHENTAI_ID, 1], '', []); - links.Add(s); - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/EatManga/chapter_page_number.inc b/baseunits/includes/EatManga/chapter_page_number.inc deleted file mode 100644 index 7be00bb0f..000000000 --- a/baseunits/includes/EatManga/chapter_page_number.inc +++ /dev/null @@ -1,43 +0,0 @@ - function GetEatMangaPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - try - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(EATMANGA_ID, URL)), - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and (GetVal(parse[i], 'id') = 'pages') then - isGetPageNumber := True; - if isGetPageNumber then - begin - if GetTagName(parse[i]) = '/select' then - Break - else if GetTagName(parse[i]) = 'option' then - Inc(manager.container.PageNumber); - end; - end; - end; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/EatManga/image_url.inc b/baseunits/includes/EatManga/image_url.inc deleted file mode 100644 index 9c81d7f62..000000000 --- a/baseunits/includes/EatManga/image_url.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetEatMangaImageURL: Boolean; - var - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(EATMANGA_ID, URL) + 'page-' + IntToStr(workCounter + 1)), - manager.container.Manager.retryConnect); - - parse := TStringList.Create; - try - Parser := THTMLParser.Create(PChar(l.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'id') = 'eatmanga_image') then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/EatManga/manga_information.inc b/baseunits/includes/EatManga/manga_information.inc deleted file mode 100644 index 1a12f427a..000000000 --- a/baseunits/includes/EatManga/manga_information.inc +++ /dev/null @@ -1,111 +0,0 @@ - function GetEatMangaInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[EATMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(EATMANGA_ID, URL);// + '&confirm=yes'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('border="0" align="center"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos(' manga about ?', parse.Strings[i]) <> 0) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get title - if (Pos(', Read ', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft(StringFilter(GetString(parse.Strings[i], - ', Read ', ' English Scan Online'))); - - // get chapter name and links - if (Pos('<th class="title">', parse.Strings[i]) > 0) and - (Pos('/upcoming/', parse.Strings[i + 1]) = 0) then - begin - Inc(mangaInfo.numChapter); - s := GetString(parse.Strings[i + 1], 'href="', '"'); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 2]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Author:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and (Pos('Artist:', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 4]); - - // get genres - if (Pos('Genre:', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := ''; - s := parse.Strings[i + 4]; - if s[1] <> '<' then - mangaInfo.genres := s; - end; - - // get status - if (i + 4 < parse.Count) and (Pos('Chapters:', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/EatManga/names_and_links.inc b/baseunits/includes/EatManga/names_and_links.inc deleted file mode 100644 index c2c8902b0..000000000 --- a/baseunits/includes/EatManga/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function EatMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[EATMANGA_ID, 1] + - EATMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 5 do - begin - if (Pos(' Online">', parse.Strings[i]) > 0) and - (Pos('<th>', parse.Strings[i - 1]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href="')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/EsMangaHere/chapter_page_number.inc b/baseunits/includes/EsMangaHere/chapter_page_number.inc deleted file mode 100644 index e72aae7fc..000000000 --- a/baseunits/includes/EsMangaHere/chapter_page_number.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetEsMangaHerePageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(ESMANGAHERE_ID, URL), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := parse.Count - 1 downto 4 do - begin - if Pos('</select>', parse.Strings[i]) > 0 then - begin - manager.container.PageNumber := - StrToInt(TrimLeft(TrimRight(parse.Strings[i - 3]))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/EsMangaHere/image_url.inc b/baseunits/includes/EsMangaHere/image_url.inc deleted file mode 100644 index 49eb62c79..000000000 --- a/baseunits/includes/EsMangaHere/image_url.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetEsMangaHereImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - if workCounter > 0 then - Result := GetPage(TObject(l), - FillMangaSiteHost(ESMANGAHERE_ID, URL) + - IntToStr(workCounter + 1) + '.html', - manager.container.manager.retryConnect) - else - Result := GetPage(TObject(l), - WebsiteRoots[ESMANGAHERE_ID, 1] + URL, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="read_img"', parse.Strings[i]) <> 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 6], 'src=')); - parse.Free; - l.Free; - Exit; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/EsMangaHere/manga_information.inc b/baseunits/includes/EsMangaHere/manga_information.inc deleted file mode 100644 index 788dcb580..000000000 --- a/baseunits/includes/EsMangaHere/manga_information.inc +++ /dev/null @@ -1,119 +0,0 @@ - function GetEsMangaHereInfoFromURL: Byte; - var - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[ESMANGAHERE_ID, 0]; - mangaInfo.url := FillMangaSiteHost(ESMANGAHERE_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.status := '1'; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i + 1], 'Manga - Leer ', - ' manga en Español'); - - // get cover link - if GetTagName(parse.Strings[i]) = 'img' then - if (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'img') then - mangaInfo.coverLink := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src')); - - // get summary - if (Pos('id="show"', parse.Strings[i])) <> 0 then - begin - parse.Strings[i + 1] := StringFilter(parse.Strings[i + 1]); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #10, '\n', [rfReplaceAll]); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := parse.Strings[i + 1]; - end; - - // get chapter name and links - if (GetTagName(parse.Strings[i]) = 'a') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'color_0077') and - (Pos('/manga/', GetAttributeValue(GetTagAttribute(parse.Strings[i], - 'href='))) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[ESMANGAHERE_ID, 1], '', [rfReplaceAll])); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #10, '', [rfReplaceAll]); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #13, '', [rfReplaceAll]); - parse.Strings[i + 1] := TrimLeft(parse.Strings[i + 1]); - parse.Strings[i + 1] := TrimRight(parse.Strings[i + 1]); - mangaInfo.chapterName.Add( - StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 1])))); - end; - - // get authors - if (Pos('Autor(s):', parse.Strings[i]) <> 0) then - mangaInfo.authors := parse.Strings[i + 3]; - - // get artists - if (Pos('Artist(s):', parse.Strings[i]) <> 0) then - mangaInfo.artists := parse.Strings[i + 3]; - - // get genres - if (Pos('Género(s):', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := ''; - for j := 0 to 37 do - if Pos(LowerCase(defaultGenres[j]), LowerCase(parse.Strings[i + 2])) <> 0 then - mangaInfo.genres := mangaInfo.genres + (defaultGenres[j] + ', '); - end; - - { // get status - if (Pos('Status:', parse.Strings[i])<>0) then - begin - if Pos('Ongoing', parse.Strings[i+2])<>0 then - mangaInfo.status:= '1' // ongoing - else - mangaInfo.status:= '0'; // completed - end; } - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterName.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - - // Delete 'latest' chapter because it isnt exist - { if (mangaInfo.status = '1') AND (mangainfo.ChapterName.Count > 0) then - begin - Dec(mangaInfo.numChapter); - mangainfo.ChapterName.Delete(mangainfo.ChapterName.Count-1); - mangainfo.chapterLinks.Delete(mangainfo.chapterLinks.Count-1); - end; } - Result := NO_ERROR; - end; diff --git a/baseunits/includes/EsMangaHere/names_and_links.inc b/baseunits/includes/EsMangaHere/names_and_links.inc deleted file mode 100644 index e4df10267..000000000 --- a/baseunits/includes/EsMangaHere/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function EsMangaHereGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ESMANGAHERE_ID, 1] + - ESMANGAHERE_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('manga_info', parse.Strings[i]) <> 0 then - begin - Result := NO_ERROR; - names.Add(StringFilter(GetString(parse.Strings[i], 'rel="', '" href'))); - links.Add(StringReplace(GetString(parse.Strings[i], 'href="', '">'), - WebsiteRoots[ESMANGAHERE_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/ExtremeMangas/chapter_page_number.inc b/baseunits/includes/ExtremeMangas/chapter_page_number.inc deleted file mode 100644 index 338ca58d5..000000000 --- a/baseunits/includes/ExtremeMangas/chapter_page_number.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetExtremeMangasPageNumber: Boolean; - var - i, j: Integer; - l: TStringList; - s: String; - //isExtractPageNumber: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(EXTREMEMANGAS_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - l.Text := FixHTMLTagQuote(l.Text); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('addpage(', parse[i]) > 0) then - begin - l.Clear; - if ExtractStrings([','], [], PChar(Trim(parse[i])), l) > 0 then - for j := l.Count - 1 downto 0 do - if (Pos('addpage(', l[j]) = 0) or (Pos('/extrememangas.gif', l[j]) > 0) then - l.Delete(j) - else - l[j] := Trim(TrimChar(StringReplace(l[j], 'addpage(', '', [rfIgnoreCase]), [',', ''''])); - manager.container.PageLinks.AddStrings(l); - manager.container.PageNumber := manager.container.PageLinks.Count; - Break; - end; - end; - - end; - l.Free; - parse.Free; - end; diff --git a/baseunits/includes/ExtremeMangas/manga_information.inc b/baseunits/includes/ExtremeMangas/manga_information.inc deleted file mode 100644 index 162d73ad8..000000000 --- a/baseunits/includes/ExtremeMangas/manga_information.inc +++ /dev/null @@ -1,83 +0,0 @@ - function GetExtremeMangasInfoFromURL: Byte; - var - i: Integer; - isExtractChapters: Boolean = False; - regxp: TRegExpr; - begin - mangaInfo.website := WebsiteRoots[EXTREMEMANGAS_ID, 0]; - mangaInfo.url := FillMangaSiteHost(EXTREMEMANGAS_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - //replace ' with " - Source.Text := FixHTMLTagQuote(Source.Text); - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.coverLink := ''; - mangaInfo.title := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - mangaInfo.status := '1'; - - regxp := TRegExpr.Create; - regxp.ModifierI := True; - for i := 0 to parse.Count - 1 do - begin - //cover - if i + 1 < parse.Count - 1 then - if (Pos('imageanchor="1"', parse[i]) > 0) and (Pos('<img', parse[i + 1]) > 0) then - mangaInfo.coverLink := GetVal(parse[i + 1], 'src'); - - //title - if i + 3 < parse.Count - 1 then - if Pos('class="post-title entry-title"', parse[i]) > 0 then - begin - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 3])))); - regxp.Expression := '\smang..?s$'; mangaInfo.title := Trim(regxp.Replace(mangaInfo.title, '', False)); - end; - - //sinopsis - if i + 3 < parse.Count - 1 then - if (Pos('<img border="0"', parse[i]) > 0) and (Pos('<', parse[i + 3]) = 0) then - mangaInfo.summary := Trim(BreaksString(HTMLEntitiesFilter(StringFilter( - Trim(parse[i + 3]))))); - - //chapters - if Pos('class="post-body entry-content"', parse[i]) > 0 then - isExtractChapters := True; - if isExtractChapters and (Pos('class="post-footer"', parse[i]) > 0) then - isExtractChapters := False; - if (i + 1 < parse.Count - 1) then - if isExtractChapters and (Pos('<a', parse[i]) > 0) then - begin - regxp.Expression := '-\d+\.html?'; - if (regxp.Exec(parse[i])) then - begin - Inc(mangaInfo.numChapter); - s := Trim(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[EXTREMEMANGAS_ID, 1], '', [rfIgnoreCase])); - regxp.Expression := '^https?://.*\.com/'; s := Trim(regxp.Replace(s, '', False)); - mangaInfo.chapterLinks.Add(s); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - end; - regxp.Free; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/ExtremeMangas/names_and_links.inc b/baseunits/includes/ExtremeMangas/names_and_links.inc deleted file mode 100644 index 51aea709b..000000000 --- a/baseunits/includes/ExtremeMangas/names_and_links.inc +++ /dev/null @@ -1,51 +0,0 @@ - function ExtremeMangasNamesAndLinks: Byte; - var - i: Integer; - s: String; - isExtractNames: Boolean = False; - regxp: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[EXTREMEMANGAS_ID, 1] + EXTREMEMANGAS_BROWSER; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Source.Text := FixHTMLTagQuote(Source.Text); - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - - regxp := TRegExpr.Create; - regxp.ModifierI := True; - regxp.Expression := '^https?://.*\.com/'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<div', parse[i]) > 0) and (Pos('id="content"', parse[i]) > 0) then - isExtractNames := True; - if isExtractNames and (Pos('<center', parse[i]) > 0) then - begin - isExtractNames := False; - Break; - end; - if i + 1 < parse.Count - 1 then - if isExtractNames and (Pos('<a', parse[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - s := Trim(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[EXTREMEMANGAS_ID, 1], '', [rfIgnoreCase])); - s := Trim(regxp.Replace(s, '/', False)); - links.Add(s); - end; - end; - regxp.Free; - end; diff --git a/baseunits/includes/Fakku/directory_page_number.inc b/baseunits/includes/Fakku/directory_page_number.inc deleted file mode 100644 index 147e4c660..000000000 --- a/baseunits/includes/Fakku/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetFakkuDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[FAKKU_ID, 1] + FAKKU_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'a') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'title=')) = - 'Last Page') then - begin - s := TrimRight(TrimLeft(GetString(parse.Strings[i], '/page/', '"'))); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Fakku/image_url.inc b/baseunits/includes/Fakku/image_url.inc deleted file mode 100644 index 40aba5a77..000000000 --- a/baseunits/includes/Fakku/image_url.inc +++ /dev/null @@ -1,67 +0,0 @@ - function GetFakkuImageURL: Boolean; - var - i, totalPages: Cardinal; - l: TStringList; - imgURL, imgExt, s: String; - - begin - totalPages := 0; - manager.container.PageLinks.Clear; - l := TStringList.Create; - s := FillMangaSiteHost(FAKKU_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - if l.Count > 0 then - begin - //Get total pages - for i := 0 to l.Count - 1 do - begin - if (Pos('window.params.thumbs = ', l.strings[i]) > 0) then - begin - s := GetString(l.Strings[i], '= [', '];'); - with TStringList.Create do - try - DelimitedText := s; - totalPages := Count; - finally - Free; - end; - Break; - end; - end; - - if totalPages = 0 then - begin - Result := False; - end; - - //Get imgurl - for i := 0 to l.Count - 1 do - begin - if (Pos('return ''//', l.Strings[i]) > 0) then - begin - imgURL := GetString(l.Strings[i], 'return ''//', ''' +'); - imgExt := GetString(l.Strings[i], 'x + ''', ''';'); - Break; - end; - end; - - //Build image links - if imgExt = '' then - imgExt := '.jpg'; - - if imgURL <> '' then - begin - imgURL := TrimLeftChar(imgURL, ['/', '\', ':']); - imgURL := 'http://' + imgURL; - for i := 1 to totalPages do - begin - s := IntToStr(i); - while Length(s) < 3 do - s := '0' + s; - manager.container.PageLinks.Add(imgURL + s + imgExt); - end; - end; - end; - l.Free; - end; diff --git a/baseunits/includes/Fakku/manga_information.inc b/baseunits/includes/Fakku/manga_information.inc deleted file mode 100644 index fdd9c231c..000000000 --- a/baseunits/includes/Fakku/manga_information.inc +++ /dev/null @@ -1,101 +0,0 @@ - function GetFakkuInfoFromURL: Byte; - var - s: String; - isExtractSummary: Boolean = False; - i: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(FAKKU_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[FAKKU_ID, 0]; - if parse.Count = 0 then - Exit; - - mangaInfo.status := '0'; - mangaInfo.genres := ''; - // using parser (cover link, summary, chapter name and link) - for i := 0 to parse.Count - 1 do - begin - // get manga title - if GetVal(parse[i], 'property') = 'og:title' then - mangaInfo.title := CommonStringFilter(GetVal(parse[i], 'content')); - - // get cover - if (Pos('<img ', parse[i]) > 0) and (Pos('class="cover"', parse[i]) > 0) then - begin - s := GetVal(parse[i], 'src'); - if ExecRegExpr('^//', s) then - mangaInfo.coverLink := 'https:' + s - else - mangaInfo.coverLink := s - end; - - // get read/chapter - if GetVal(parse[i], 'class') = 'button green' then - begin - Inc(mangaInfo.numChapter); - if mangaInfo.title = '' then - mangaInfo.title := 'Unknown'; - mangaInfo.chapterName.Add(mangaInfo.title); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - end; - - // get series/authors - if (Pos('div class="left"', parse.Strings[i]) > 0) and - (Pos('Series', parse.Strings[i + 1]) > 0) then - begin - mangaInfo.authors := parse.Strings[i + 6]; - mangaInfo.genres := mangaInfo.authors; - end; - - // get artists - if (Pos('div class="left"', parse.Strings[i]) > 0) and - (Pos('Artist', parse.Strings[i + 1]) > 0) then - begin - mangaInfo.artists := parse.Strings[i + 6]; - mangaInfo.genres := mangaInfo.genres + ', ' + mangaInfo.artists; - end; - - // get language - if (Pos('div class="left"', parse.Strings[i]) > 0) and - (Pos('Language', parse.Strings[i + 1]) > 0) then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse.Strings[i + 7]); - - // get descriptions - if (Pos('div class="left"', parse.Strings[i]) > 0) and - (Pos('Description', parse.Strings[i + 1]) > 0) then - isExtractSummary := True; - - if isExtractSummary then - begin - if (Pos('</div>', parse.Strings[i + 5]) > 0) then - isExtractSummary := False - else if (not (Pos('<', parse.Strings[i + 5]) > 0)) then - mangaInfo.summary := Trim(mangaInfo.summary) + ' ' + Trim(parse.Strings[i + 5]); - end; - - // get genres - if (Pos('"/tags/', parse.Strings[i]) > 0) then - begin - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse.Strings[i + 1]); - end; - end; - - //last correction - mangaInfo.summary := BreaksString(StringFilter(mangaInfo.summary)); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Fakku/names_and_links.inc b/baseunits/includes/Fakku/names_and_links.inc deleted file mode 100644 index 2b979d06d..000000000 --- a/baseunits/includes/Fakku/names_and_links.inc +++ /dev/null @@ -1,48 +0,0 @@ - function FakkuGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - i := StrToInt(URL); - if i = 0 then - begin - if not GetPage(TObject(Source), WebsiteRoots[FAKKU_ID, 1] + FAKKU_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - end - else - begin - if not GetPage(TObject(Source), WebsiteRoots[FAKKU_ID, 1] + - FAKKU_BROWSER + '/page/' + IntToStr(i + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="content-title"', parse[i]) > 0 then - begin - Result := NO_ERROR; - names.Add(Trim(GetAttributeValue(GetTagAttribute(parse[i], 'title=')))); - links.Add(StringReplace(GetAttributeValue(GetTagAttribute(parse[i], 'href=')), - WebsiteRoots[FAKKU_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/HakiHome/chapter_page_number.inc b/baseunits/includes/HakiHome/chapter_page_number.inc deleted file mode 100644 index fbea7abb1..000000000 --- a/baseunits/includes/HakiHome/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetHakiHomePageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - isExtractPageNumber: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(HAKIHOME_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - l.Text := FixHTMLTagQuote(l.Text); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('onchange="javascript:if', parse[i]) > 0) then - isExtractPageNumber := True; - if isExtractPageNumber and (Pos('</select', parse[i]) > 0) then - begin - isExtractPageNumber := False; - Break; - end; - if isExtractPageNumber and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/HakiHome/directory_page_number.inc b/baseunits/includes/HakiHome/directory_page_number.inc deleted file mode 100644 index 354d61cfb..000000000 --- a/baseunits/includes/HakiHome/directory_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetHakiHomeDirectoryPageNumber: Byte; - var - i: Integer; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[HAKIHOME_ID, 1] + HAKIHOME_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - Source.Text := FixHTMLTagQuote(Source.Text); - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - if i + 1 < parse.Count - 1 then - if (Pos('class="inbut"', parse[i]) > 0) and (Pos('<a', parse[i]) > 0) and - (Pos('Last', parse[i + 1]) > 0) then - begin - Result := NO_ERROR; - Page := StrToIntDef(ReplaceRegExpr('^.*/(\d+)/$', Trim(GetVal(parse[i], 'href')), '$1', True), 1); - Break; - end; - end; - end; diff --git a/baseunits/includes/HakiHome/image_url.inc b/baseunits/includes/HakiHome/image_url.inc deleted file mode 100644 index 525f3d15d..000000000 --- a/baseunits/includes/HakiHome/image_url.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetHakiHomeImageURL: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(HAKIHOME_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(QWord(workCounter) + 1) + '.html'; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - l.Text := FixHTMLTagQuote(l.Text); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if i + 2 < parse.Count - 1 then - if (Pos('id="con"', parse[i]) > 0) and (Pos('<img', parse[i + 2]) > 0) then - begin - manager.container.PageLinks[workCounter] := Trim(GetVal(parse[i + 2], 'src')); - Break; - end; - parse.Free; - end; diff --git a/baseunits/includes/HakiHome/manga_information.inc b/baseunits/includes/HakiHome/manga_information.inc deleted file mode 100644 index c8791cdc0..000000000 --- a/baseunits/includes/HakiHome/manga_information.inc +++ /dev/null @@ -1,105 +0,0 @@ - function GetHakiHomeInfoFromURL: Byte; - var - i: Integer; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[HAKIHOME_ID, 0]; - mangaInfo.url := FillMangaSiteHost(HAKIHOME_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - //replace ' with " - Source.Text := FixHTMLTagQuote(Source.Text); - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.coverLink := ''; - mangaInfo.title := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.status := '0'; - - for i := 0 to parse.Count - 1 do - begin - //cover - if (Pos('<img', parse[i]) > 0) and (Pos('style="display', parse[i]) > 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //title - if (i + 2 < parse.Count - 1) then - if (Pos('class="tuade"', parse[i]) > 0) then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2])))); - - //artist - if (i + 1 < parse.Count - 1) then - if (Pos('<a ', parse[i]) > 0) and (Pos('/art/', parse[i]) > 0) then - if Pos('<', parse[i + 1]) = 0 then - if mangaInfo.artists = '' then - mangaInfo.artists := Trim(parse[i + 1]) - else - mangaInfo.artists := mangaInfo.artists + ', ' + Trim(parse[i + 1]); - - //genres/tag - if (i + 1 < parse.Count - 1) then - if (Pos('/tag/', parse[i]) > 0) and - (Pos('<a ', parse[i]) > 0) and (Pos('title=', parse[i]) > 0) then - if Pos('<', parse[i + 1]) = 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]); - //genres/series/language - if (i + 2 < parse.Count - 1) then - if ((Pos('Series:', parse[i]) > 0) or ((Pos('Language:', parse[i]) > 0))) and - (Pos('<a ', parse[i + 1]) > 0) then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 2]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 2]); - - //chapters - if (Pos('<table', parse[i]) > 0) and (Pos('class="listing"', parse[i]) > 0) then - isExtractChapters := True; - if isExtractChapters and (Pos('</table', parse[i]) > 0) then - isExtractChapters := False; - if (i + 1 < parse.Count - 1) then - if isExtractChapters and (Pos('class="readchap"', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(Trim(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[HAKIHOME_ID, 1], '', [rfIgnoreCase]))); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - - // invert chapters - if mangaInfo.chapterName.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - - if mangaInfo.chapterName.Count = 1 then - mangaInfo.chapterName[0] := mangaInfo.title - else - if mangaInfo.chapterName.Count > 1 then - for i := 0 to mangaInfo.chapterName.Count - 1 do - if Pos(LowerCase(mangaInfo.title), LowerCase(mangaInfo.chapterName[i])) = 0 then - mangaInfo.chapterName[i] := mangaInfo.title + ' ' + mangaInfo.chapterName[i]; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/HakiHome/names_and_links.inc b/baseunits/includes/HakiHome/names_and_links.inc deleted file mode 100644 index 9d484b910..000000000 --- a/baseunits/includes/HakiHome/names_and_links.inc +++ /dev/null @@ -1,49 +0,0 @@ - function HakiHomeNamesAndLinks: Byte; - var - i: Integer; - s: String; - isExtractNames: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[HAKIHOME_ID, 1] + HAKIHOME_BROWSER + '/pagel/'+ - IntToStr(StrToInt(URL) + 1) + '/'; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Source.Text := FixHTMLTagQuote(Source.Text); - //correcting some broken tag - Source.Text := StringReplace(Source.Text, '>" href=', '><a href=', [rfReplaceAll, rfIgnoreCase]); - Source.Text := StringReplace(Source.Text, '="<', '=""><', [rfReplaceAll, rfIgnoreCase]); - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<table', parse[i]) > 0) and (Pos('class="listing"', parse[i]) > 0) then - isExtractNames := True; - if isExtractNames and (Pos('</table', parse[i]) > 0) then - begin - isExtractNames := False; - Break; - end; - if i + 1 < parse.Count - 1 then - if isExtractNames and (Pos('<a', parse[i]) > 0) and - (Pos('class="tuade"', parse[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - links.Add(Trim(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[HAKIHOME_ID, 1], '', [rfIgnoreCase]))); - end; - end; - end; diff --git a/baseunits/includes/Hentai2Read/chapter_page_number.inc b/baseunits/includes/Hentai2Read/chapter_page_number.inc deleted file mode 100644 index 735da9b19..000000000 --- a/baseunits/includes/Hentai2Read/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetHentai2ReadPageNumber: Boolean; - var - i, j: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(HENTAI2READ_ID, URL), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'select') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = - 'cbo_wpm_pag') then - begin - j := i + 1; - while GetTagName(parse.Strings[j]) = 'option' do - begin - Inc(manager.container.PageNumber); - Inc(j, 3); - end; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Hentai2Read/directory_page_number.inc b/baseunits/includes/Hentai2Read/directory_page_number.inc deleted file mode 100644 index 77ee7dcba..000000000 --- a/baseunits/includes/Hentai2Read/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetHentai2ReadDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), HENTAI2READ_ROOT + HENTAI2READ_BROWSER + - '?text-ver', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'img') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'alt=')) = 'Next Page') then - begin - s := TrimRight(TrimLeft(parse.Strings[i - 5])); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Hentai2Read/image_url.inc b/baseunits/includes/Hentai2Read/image_url.inc deleted file mode 100644 index 536490d18..000000000 --- a/baseunits/includes/Hentai2Read/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetHentai2ReadImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(HENTAI2READ_ID, URL) + IntToStr(workCounter + 1) + '/', - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse.Strings[i]) = 'img') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'id=')) = - 'img_mng_enl') then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Hentai2Read/manga_information.inc b/baseunits/includes/Hentai2Read/manga_information.inc deleted file mode 100644 index 718b711d1..000000000 --- a/baseunits/includes/Hentai2Read/manga_information.inc +++ /dev/null @@ -1,165 +0,0 @@ - function GetHentai2ReadInfoFromURL: Byte; - var - s: String; - isExtractChapters: Boolean = False; - isExtractGenres: Boolean = False; - isExtractSummary: Boolean = True; - i, j: Cardinal; - regx: TRegExpr; - begin - mangaInfo.url := FillMangaSiteHost(HENTAI2READ_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[HENTAI2READ_ID, 0]; - - regx := TRegExpr.Create; - regx.ModifierI := True; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get title - if (Pos('class="head_det_title"', parse[i]) > 0) then - begin - s := Trim(StringFilter(parse[i + 1])); - regx.Expression := '^.+\sdj\s[-_]\s(.+)$'; - mangaInfo.title := regx.Replace(s, '$1', True); - end; - //if (mangaInfo.title = '') AND - //(Pos('meta name="description" content="', parse.Strings[i])>0) then - //mangaInfo.title:= GetString(parse.Strings[i], 'meta name="description" content="', ' hentai chapters'); - - // get cover link - if (GetTagName(parse.Strings[i]) = 'div') and - (i < parse.Count - 3) then - if (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'cover') then - begin - mangaInfo.coverLink := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 2], 'src=')); - if mangaInfo.coverLink = - 'http://hentai2read.com/wp-content/hentai/cover/tbn/001_1535_233x0.jpg' then - mangaInfo.coverLink := ''; - end; - - // get chapter name and links - if isExtractChapters then - begin - if (GetTagName(parse.Strings[i]) = 'a') and (i < parse.Count - 2) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'href=')), - HENTAI2READ_ROOT, '', [rfReplaceAll]); - s := StringReplace(s, HENTAI2READ_MROOT, '', [rfReplaceAll]); - mangaInfo.chapterLinks.Add(s); - //s:= StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), HENTAI2READ_ROOT, '', [rfReplaceAll]); - //parse.Strings[i+1]:= StringReplace(parse.Strings[i+1], #10, '', [rfReplaceAll]); - //parse.Strings[i+1]:= StringReplace(parse.Strings[i+1], #13, '', [rfReplaceAll]); - //parse.Strings[i+1]:= TrimLeft(parse.Strings[i+1]); - //parse.Strings[i+1]:= TrimRight(parse.Strings[i+1]); - //s:= RemoveSymbols(parse.Strings[i+1]); - regx.Expression := '^\d+\s[-_]\s'; - s := regx.Replace(Trim(parse[i + 1]), '', False); - mangaInfo.chapterName.Add(Trim(StringFilter(RemoveSymbols(s)))); - //mangaInfo.chapterName.Add(StringFilter(TrimRight(RemoveSymbols(parse.Strings[i+1])))); - end - else - if (GetTagName(parse.Strings[i]) = 'div') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'right') then - isExtractChapters := False; - end; - - // get summary - if (Pos('Hentai Summary', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 5; - mangaInfo.summary := ''; - while (j < parse.Count) and (Pos('<div class="box">', parse.Strings[j]) = 0) and - (j < parse.Count - 1) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - s := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - s := Trim(BreaksString(s)); - mangaInfo.summary := Trim(mangaInfo.summary + s); - end; - Inc(j); - end; - isExtractSummary := False; - end; - - if Pos('Hentai Chapters', parse.Strings[i]) > 0 then - isExtractChapters := True; - - // get authors - if (Pos('Author(s):', parse.Strings[i]) <> 0) and (i < parse.Count - 6) then - mangaInfo.authors := parse.Strings[i + 5]; - - // get artists - if (Pos('Artist(s):', parse.Strings[i]) <> 0) and (i < parse.Count - 6) then - mangaInfo.artists := parse.Strings[i + 5]; - - // get genres - if (Pos('Genre(s):', parse.Strings[i]) <> 0) and (i < parse.Count - 6) then - begin - mangaInfo.genres := ''; - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if GetTagName(parse.Strings[i]) = 'a' then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]); - end - else - if (GetTagName(parse.Strings[i]) = 'div') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'box') then - isExtractGenres := False; - end; - - // get status - if (Pos('Status:', parse.Strings[i]) <> 0) and (i <= parse.Count - 5) then - begin - if Pos('Ongoing', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - regx.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterName.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Hentai2Read/names_and_links.inc b/baseunits/includes/Hentai2Read/names_and_links.inc deleted file mode 100644 index 9695a1777..000000000 --- a/baseunits/includes/Hentai2Read/names_and_links.inc +++ /dev/null @@ -1,47 +0,0 @@ - function Hentai2ReadGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), HENTAI2READ_ROOT + HENTAI2READ_BROWSER + - IntToStr(StrToInt(URL) + 1) + '/?text-ver', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - regx := TRegExpr.Create; - regx.ModifierI := True; - regx.Expression := '^.+\sdj\s[-_]\s(.+)$'; - for i := 0 to parse.Count - 1 do - begin - //if Pos('class="lst-anm-ifo"', parse.Strings[i])>0 then - if Pos('class="mng_det_pop"', parse[i]) > 0 then - begin - begin - Result := NO_ERROR; - s := Trim(StringFilter(GetAttributeValue( - GetTagAttribute(parse[i], 'title=')))); - s := regx.Replace(s, '$1', True); - names.Add(s); - links.Add(StringReplace(GetAttributeValue(GetTagAttribute(parse[i], 'href=')), - HENTAI2READ_ROOT, '', [])); - end; - end; - end; - regx.Free; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/HugeManga/chapter_page_number.inc b/baseunits/includes/HugeManga/chapter_page_number.inc deleted file mode 100644 index 57908d955..000000000 --- a/baseunits/includes/HugeManga/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetHugeMangaPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(HUGEMANGA_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('</option>', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 2]; - manager.container.pageNumber := - StrToInt(GetAttributeValue(GetTagAttribute(s, 'value='))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/HugeManga/image_url.inc b/baseunits/includes/HugeManga/image_url.inc deleted file mode 100644 index b546ff14b..000000000 --- a/baseunits/includes/HugeManga/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetHugeMangaImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(HUGEMANGA_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="picture"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - EncodeURL(WebsiteRoots[HUGEMANGA_ID, 1] + HUGEMANGA_BROWSER + - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/HugeManga/manga_information.inc b/baseunits/includes/HugeManga/manga_information.inc deleted file mode 100644 index 08e951a5d..000000000 --- a/baseunits/includes/HugeManga/manga_information.inc +++ /dev/null @@ -1,75 +0,0 @@ - function GetHugeMangaInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[HUGEMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(HUGEMANGA_ID, HUGEMANGA_BROWSER + URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (Pos('select name="chapter"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get manga name - if (mangaInfo.title = '') and (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i + 1], 'indonesia online - ', - ' - Chapter'); - - if (isExtractChapter) and (Pos('</select>', parse.Strings[i]) > 0) then - Break; - - if (isExtractChapter) and (Pos('option value=', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := '/' + URL + '/' + GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'value=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/HugeManga/names_and_links.inc b/baseunits/includes/HugeManga/names_and_links.inc deleted file mode 100644 index 4e3e592c8..000000000 --- a/baseunits/includes/HugeManga/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function HugeMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[HUGEMANGA_ID, 1] + - HUGEMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('option value="', parse.Strings[i]) > 0) and - (Pos('value="0"', parse.Strings[i]) = 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 1]); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/IKomik/chapter_page_number.inc b/baseunits/includes/IKomik/chapter_page_number.inc deleted file mode 100644 index 49d725529..000000000 --- a/baseunits/includes/IKomik/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetIKomikPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isExtractPage: Boolean = False; - s: String; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(IKOMIK_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('class="cbo_wp_manga_page"', parse[i]) > 0) then - isExtractPage := True; - if isExtractPage and (Pos('</select', parse[i]) > 0) then - begin - isExtractPage := False; - Break; - end; - if isExtractPage and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/IKomik/directory_page_number.inc b/baseunits/includes/IKomik/directory_page_number.inc deleted file mode 100644 index 60e9b807b..000000000 --- a/baseunits/includes/IKomik/directory_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetIKomikDirectoryPageNumber: Byte; - var - i: Integer; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[IKOMIK_ID, 1] + IKOMIK_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if i + 1 < parse.Count - 1 then - if (Pos('/page-', parse[i]) > 0) and (Pos('last', parse[i + 1]) > 0) then - begin - Result := NO_ERROR; - Page := StrToIntDef(ReplaceRegExpr('^.*\/page-(\d+)\/.*$', GetVal(parse[i], 'href'), '$1', True), 1); - Break; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/IKomik/image_url.inc b/baseunits/includes/IKomik/image_url.inc deleted file mode 100644 index 78400ee5b..000000000 --- a/baseunits/includes/IKomik/image_url.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetIKomikImageURL: Boolean; - var - i, j: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(IKOMIK_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(QWord(workCounter) + 1); - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<div', parse[i]) > 0) and (Pos('style="overflow', parse[i]) > 0) then - begin - for j := i + 1 to parse.Count - 1 do - begin - if Pos('<img', parse[j]) > 0 then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[j], 'src'); - Break; - end; - end; - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/IKomik/manga_information.inc b/baseunits/includes/IKomik/manga_information.inc deleted file mode 100644 index 2999d620c..000000000 --- a/baseunits/includes/IKomik/manga_information.inc +++ /dev/null @@ -1,88 +0,0 @@ - function GetIKomikInfoFromURL: Byte; - var - s: String; - i: Integer; - begin - mangaInfo.website := WebsiteRoots[IKOMIK_ID, 0]; - mangaInfo.url := FillMangaSiteHost(IKOMIK_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if (i + 1 < parse.Count - 1) then - if (Pos('<h1', parse[i]) > 0) and (Pos('class="title"', parse[i]) > 0) then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1]))); - - //cover - if (i + 2 < parse.Count - 1) then - if (Pos('class="cover_area"', parse[i]) > 0) and (Pos('<img', parse[i + 2]) > 0) then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - //authors - if (i + 2 < parse.Count - 1) then - if (Pos('Author', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - s := TrimLeftChar(parse[i + 2], [':']); - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(s)))); - mangaInfo.authors := s; - end; - - //category/genre - if (i + 2 < parse.Count - 1) then - if (Pos('Category', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - s := TrimLeftChar(parse[i + 2], [':']); - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(s)))); - mangaInfo.genres := s; - end; - - //status - if (i + 2 < parse.Count - 1) then - if (Pos('Status', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - if Pos('Completed', parse[i + 2]) > 0 then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end; - - //chapters - if (i + 1 < parse.Count - 1) then - if (Pos('class="list"', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[IKOMIK_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - - if mangaInfo.chapterName.Count > 1 then - begin - // invert chapter - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/IKomik/names_and_links.inc b/baseunits/includes/IKomik/names_and_links.inc deleted file mode 100644 index b7a720e13..000000000 --- a/baseunits/includes/IKomik/names_and_links.inc +++ /dev/null @@ -1,34 +0,0 @@ - function IKomikNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[IKOMIK_ID, 1] + IKOMIK_BROWSER + - 'page-' + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="list"', parse[i]) > 0) and (Pos('<a', parse[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - links.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[IKOMIK_ID, 1], '', [rfIgnoreCase])); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/Imanhua/names_and_links.inc b/baseunits/includes/Imanhua/names_and_links.inc deleted file mode 100644 index 69f461538..000000000 --- a/baseunits/includes/Imanhua/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function imanhuaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; // - if not GetPage(TObject(Source), WebsiteRoots[IMANHUA_ID, 1] + IMANHUA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('href="/comic/', parse.Strings[i]) > 0) and - (Pos('/list_', parse.Strings[i]) = 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 1]); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - links.Add(s); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/JapanShin/chapter_page_number.inc b/baseunits/includes/JapanShin/chapter_page_number.inc deleted file mode 100644 index 29763e83d..000000000 --- a/baseunits/includes/JapanShin/chapter_page_number.inc +++ /dev/null @@ -1,27 +0,0 @@ - function GetJapanShinPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(JAPANSHIN_ID, URL), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - //class="tbtitle dropdown_parent dropdown_right - for i := 0 to parse.Count - 1 do - if (Pos('onClick="changePage', parse.Strings[i]) > 0) and - (Pos('return false', parse.Strings[i]) > 0) then - Inc(manager.container.PageNumber); - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/JapanShin/directory_page_number.inc b/baseunits/includes/JapanShin/directory_page_number.inc deleted file mode 100644 index 8ff20c3c0..000000000 --- a/baseunits/includes/JapanShin/directory_page_number.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetJapanShinDirectoryPageNumber: Byte; - var - i, p: Cardinal; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[JAPANSHIN_ID, 1] + - JAPANSHIN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - Page := 0; - regx := TRegExpr.Create; - regx.Expression := '^.*/reader/list/(\d+)/.*$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="gbutton fright"', parse[i]) > 0) and - (Pos('/reader/list/', parse[i]) > 0) then - begin - Result := NO_ERROR; - p := StrToIntDef(regx.Replace(parse[i], '$1', True), 0); - if p > Page then - Page := p; - end; - end; - regx.Free; - Source.Free; - Result := NO_ERROR; - end; \ No newline at end of file diff --git a/baseunits/includes/JapanShin/image_url.inc b/baseunits/includes/JapanShin/image_url.inc deleted file mode 100644 index 08d5a94b8..000000000 --- a/baseunits/includes/JapanShin/image_url.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetJapanShinImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(JAPANSHIN_ID, URL) + '/page/' + IntToStr(workCounter), - manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse.Strings[i]) > 0) and - (Pos('class="open"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/JapanShin/manga_information.inc b/baseunits/includes/JapanShin/manga_information.inc deleted file mode 100644 index e5bf9c04f..000000000 --- a/baseunits/includes/JapanShin/manga_information.inc +++ /dev/null @@ -1,81 +0,0 @@ - function GetJapanShinInfoFromURL: Byte; - var - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[JAPANSHIN_ID, 0]; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), FillMangaSiteHost(JAPANSHIN_ID, URL), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - mangaInfo.numChapter := 0; - for i := 0 to parse.Count - 1 do - begin - //get title - if (Pos('h1 class="title"', parse.Strings[i]) > 0) then - mangaInfo.title := Trim(parse.Strings[i + 1]); - - //get coverlink - if (Pos('class="thumbnail"', parse.Strings[i]) > 0) then - begin - j := i + 1; - while (Pos('<img', parse.Strings[j]) = 0) do - Inc(j); - mangaInfo.coverLink := GetAttributeValue(GetTagAttribute(parse.Strings[j], 'src=')); - end; - - //get authors - if (Pos('Auteur :', parse.Strings[i]) > 0) then - mangaInfo.authors := parse.Strings[i + 2]; - - //get genre - if (Pos('Genre :', parse.Strings[i]) > 0) then - mangaInfo.genres := parse.Strings[i + 2]; - - //get summary - if (Pos('Synopsis :', parse.Strings[i]) > 0) then - mangaInfo.summary := parse.Strings[i + 2]; - - //get chapter name and links - if (Pos('href="', parse.Strings[i]) > 0) and - (Pos('title="', parse.Strings[i]) > 0) and - (Pos('/reader/read/', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[JAPANSHIN_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(Trim(parse.Strings[i + 1])); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/JapanShin/names_and_links.inc b/baseunits/includes/JapanShin/names_and_links.inc deleted file mode 100644 index 0ffdd6f80..000000000 --- a/baseunits/includes/JapanShin/names_and_links.inc +++ /dev/null @@ -1,41 +0,0 @@ - function JapanShinGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), - WebsiteRoots[JAPANSHIN_ID, 1] + JAPANSHIN_BROWSER + - IntToStr(StrToInt(URL) + 1) + '/', - 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse.Strings[i]) > 0) and - (Pos('/reader/series/', parse.Strings[i]) > 0) and - (Pos('title="', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - links.Add(StringReplace(s, WebsiteRoots[JAPANSHIN_ID, 1], '', [rfIgnoreCase])); - s := Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 1]))); - names.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Japscan/chapter_page_number.inc b/baseunits/includes/Japscan/chapter_page_number.inc deleted file mode 100644 index 6a9b5d06c..000000000 --- a/baseunits/includes/Japscan/chapter_page_number.inc +++ /dev/null @@ -1,55 +0,0 @@ - function GetJapscanPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - regx: TRegExpr; - isGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(JAPSCAN_ID, URL)); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - CleanHTMLComments(l); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - manager.container.PageNumber := 0; - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.Expression := '^.*/(\d+)\.html?.*$'; - regx.ModifierI := True; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'nav') and - (GetVal(parse[i], 'id') = 'pagination') then - isGetPageNumber := True; - if isGetPageNumber and ((GetTagName(parse[i]) = '/nav') or - (GetVal(parse[i], 'id') = 'next_link') or - (GetVal(parse[i], 'id') = 'next_chapter')) then - Break; - if isGetPageNumber and (GetTagName(parse[i]) = 'a') then - begin - s := GetVal(parse[i], 'href'); - s := regx.Replace(s, '$1', True); - if manager.container.PageNumber < StrToIntDef(s, 0) then - manager.container.PageNumber := StrToIntDef(s, 0); - end; - end; - finally - regx.Free; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Japscan/image_url.inc b/baseunits/includes/Japscan/image_url.inc deleted file mode 100644 index 84744f801..000000000 --- a/baseunits/includes/Japscan/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetJapscanImageURL: Boolean; - var - s: string; - i: Integer; - l: TStringList; - begin - s := DecodeUrl(FillMangaSiteHost(JAPSCAN_ID, URL)); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - s := s + '/' + IntToStr(workCounter + 1) + '.html'; - l := TStringList.Create; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'id') = 'imgscan') then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Japscan/manga_information.inc b/baseunits/includes/Japscan/manga_information.inc deleted file mode 100644 index e97e8328b..000000000 --- a/baseunits/includes/Japscan/manga_information.inc +++ /dev/null @@ -1,110 +0,0 @@ - function GetJapscanInfoFromURL: Byte; - var - s: String; - i: Cardinal; - row: TStringList; - isRow: Boolean = False; - isExtractChapter: Boolean = False; - regx: TRegExpr; - - begin - mangaInfo.url := FillMangaSiteHost(JAPSCAN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[JAPSCAN_ID, 0]; - - mangaInfo.coverLink := ''; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - row := TStringList.Create; - for i := 0 to parse.Count - 1 do - begin - //get title - if Pos('<h1 class="bg-header"', parse[i]) > 0 then - begin - regx := TRegExpr.Create; - regx.ModifierI := True; - regx.Expression := '^Manga\s(.+)\sVF$'; - s := regx.Replace(Trim(parse[i + 2]), '$1', True); - mangaInfo.title := s; - regx.Free; - end; - - // author, year, genres, fansubs and status respectively - if (Pos('<div class="row"', parse[i]) > 0) then - isRow := True; - if isRow and (Pos('<h2', parse[i]) > 0) then - isRow := False; - - if isRow and (Pos('class="cell"', parse[i]) > 0) then - begin - if Pos('href="', parse[i + 1]) > 0 then - row.Add(Trim(parse[i + 2])) - else - row.Add(Trim(parse[i + 1])); - end; - - //get status - if isRow and (Pos('class="cell"', parse[i]) > 0) then - begin - if Trim(parse[i + 1]) = 'En Cours' then - mangaInfo.status := '1' - else - if Trim(parse[i + 1]) = 'Terminé' then - mangaInfo.status := '0'; - end; - - //get summary - if Pos('id="synopsis"', parse[i]) > 0 then - mangaInfo.summary := Trim(parse[i + 1]); - - // get chapter name and links - if Pos('id="liste_chapitres"', parse[i]) > 0 then - isExtractChapter := True; - if isExtractChapter and (Pos('</div', parse[i]) > 0) then - isExtractChapter := False; - - if (isExtractChapter) and (Pos('<a href="', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetVal(parse[i], 'href'); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(Trim(parse.Strings[i + 1])); - mangaInfo.chapterName.Add(CommonStringFilter(s)); - end; - end; - - //author, year, genres, fansubs and status respectively - if row.Count >= 5 then - begin - mangaInfo.authors := row[0]; - mangaInfo.genres := row[2]; - if mangaInfo.genres = '' then - mangaInfo.genres := row[3] - else - mangaInfo.genres := mangaInfo.genres + ', ' + row[3]; - end; - row.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Japscan/names_and_links.inc b/baseunits/includes/Japscan/names_and_links.inc deleted file mode 100644 index 5f351194e..000000000 --- a/baseunits/includes/Japscan/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function JapscanNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[JAPSCAN_ID, 1] + - JAPSCAN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - - links.Clear; - names.Clear; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="cell', parse[i]) > 0) then - if (Pos(' href="/mangas/', parse[i + 1]) > 0) then - begin - Result := NO_ERROR; - links.Add(GetAttributeValue(GetTagAttribute(parse[i + 1], 'href='))); - names.Add(Trim(parse[i + 2])); - end; - end; - end; \ No newline at end of file diff --git a/baseunits/includes/KissManga/chapter_page_number.inc b/baseunits/includes/KissManga/chapter_page_number.inc deleted file mode 100644 index f3e740018..000000000 --- a/baseunits/includes/KissManga/chapter_page_number.inc +++ /dev/null @@ -1,42 +0,0 @@ -function GetKissMangaPageNumber: Boolean; -var - s, imageURL: String; - j, i: Integer; - l: TStringList; -begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(KISSMANGA_ID, URL), - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('lstImages.push("', parse.Strings[i]) > 0 then - begin - s := parse.Strings[i]; - repeat - j := Pos('lstImages.push("', s); - imageURL := DecodeUrl(GetString(s, 'lstImages.push("', '");')); - if (Pos('googleusercontent', imageURL) > 0) and - (Pos('proxy?', imageURL) > 0) then - begin - imageURL := GetString(imageURL + '<~>', '*&url=', '<~>'); - end; - manager.container.PageLinks.Add(EncodeUrl(imageURL)); - Delete(s, Pos('lstImages.push("', s), 16); - j := Pos('lstImages.push("', s); - until j = 0; - end; - end; - end; - parse.Free; - l.Free; -end; diff --git a/baseunits/includes/KissManga/directory_page_number.inc b/baseunits/includes/KissManga/directory_page_number.inc deleted file mode 100644 index 3effccf70..000000000 --- a/baseunits/includes/KissManga/directory_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetKissMangaDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[KISSMANGA_ID, 1] + - KISSMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('» Last', parse.Strings[i]) > 0) then - begin - Page := StrToInt(StringReplace( - TrimRight(TrimLeft(GetAttributeValue(GetTagAttribute(parse.Strings[i - 1], 'page=')))), - '"', '', [rfReplaceAll])); - Result := NO_ERROR; - Break; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/KissManga/manga_information.inc b/baseunits/includes/KissManga/manga_information.inc deleted file mode 100644 index 53752510d..000000000 --- a/baseunits/includes/KissManga/manga_information.inc +++ /dev/null @@ -1,137 +0,0 @@ - function GetKissMangaInfoFromURL: Byte; - var - i, j: Integer; - s: string; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[KISSMANGA_ID, 0]; - mangaInfo.url := EncodeURL(FillMangaSiteHost(KISSMANGA_ID, URL + '?confirm=yes')); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - ParseHTML(Source.Text, parse); - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - //get manga title - if mangaInfo.title = '' then - if GetTagName(parse[i]) = 'title' then - begin - s := Trim(parse[i+1]); - j := Pos(#13#10, s); - if j <> 0 then - Delete(s, j, Length(s)); - mangaInfo.title := CommonStringFilter(s); - end; - - // get cover link - if GetTagName(parse.Strings[i]) = 'img' then - if (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'width=')) = '190px') then - mangaInfo.coverLink := - EncodeURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src'))); - - // get summary - if (Pos('Summary:', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 4; - mangaInfo.summary := ''; - while (Pos('</p>', parse.Strings[j]) = 0) and (j < parse.Count - 1) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := StringFilter(parse.Strings[j]); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - if (not isExtractChapter) and (Pos('Chapter Name', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (GetTagName(parse.Strings[i]) = 'a') and - (Pos('?id=', parse.Strings[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[KISSMANGA_ID, 1], '', [rfReplaceAll])); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #10, '', [rfReplaceAll]); - parse.Strings[i + 1] := StringReplace(parse.Strings[i + 1], #13, '', [rfReplaceAll]); - parse.Strings[i + 1] := TrimLeft(parse.Strings[i + 1]); - parse.Strings[i + 1] := TrimRight(parse.Strings[i + 1]); - mangaInfo.chapterName.Add( - StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 1])))); - end; - - if (isExtractChapter) and - (Pos('fb-comments', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get authors - if (Pos('Author:', parse.Strings[i]) <> 0) then - mangaInfo.authors := parse.Strings[i + 4]; - - // get artists - if (Pos('Artist:', parse.Strings[i]) <> 0) then - mangaInfo.artists := parse.Strings[i + 4]; - - // get genres - if (Pos('Genres:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if (i + 1 < parse.Count) and (Pos('"/Genre/', parse.Strings[i]) > 0) then - mangaInfo.genres := mangaInfo.genres + - (TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '); - if Pos('</p>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (Pos('Status:', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterName.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/KissManga/names_and_links.inc b/baseunits/includes/KissManga/names_and_links.inc deleted file mode 100644 index 460a605a6..000000000 --- a/baseunits/includes/KissManga/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function KissMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[KISSMANGA_ID, 1] + - KISSMANGA_BROWSER + '?page=' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/Manga/', parse.Strings[i]) > 0) and - (Pos('title=', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringReplace(parse.Strings[i + 3], #10, '', [rfReplaceAll]); - s := Trim(StringReplace(s, #13, '', [rfReplaceAll])); - names.Add(s); - links.Add(StringReplace(GetAttributeValue(GetTagAttribute( - parse.Strings[i + 2], 'href=')), WebsiteRoots[KISSMANGA_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Kivmanga/chapter_page_number.inc b/baseunits/includes/Kivmanga/chapter_page_number.inc deleted file mode 100644 index 3b8ac8e7f..000000000 --- a/baseunits/includes/Kivmanga/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetKivmangaPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(KIVMANGA_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('title="Next Page"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 6]; - manager.container.PageNumber := StrToInt(GetString(s, '"', '"')); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Kivmanga/image_url.inc b/baseunits/includes/Kivmanga/image_url.inc deleted file mode 100644 index e89d51717..000000000 --- a/baseunits/includes/Kivmanga/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetKivmangaImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(KIVMANGA_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="picture"', parse.Strings[i]) > 0) then - begin - s := WebsiteRoots[KIVMANGA_ID, 1] + KIVMANGA_BROWSER + - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - manager.container.PageLinks.Strings[workCounter] := EncodeURL(s); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Kivmanga/manga_information.inc b/baseunits/includes/Kivmanga/manga_information.inc deleted file mode 100644 index d99947a32..000000000 --- a/baseunits/includes/Kivmanga/manga_information.inc +++ /dev/null @@ -1,78 +0,0 @@ - function GetKivmangaInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(KIVMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.website := WebsiteRoots[KIVMANGA_ID, 0]; - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (Pos('select name="chapter"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get manga name - if (mangaInfo.title = '') and (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := TrimLeft(TrimRight(GetString(parse.Strings[i + 1], - 'Read Free Manga Online - ', '-'))); - - if (isExtractChapter) and (Pos('option value=', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := URL + '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - if (isExtractChapter) and - (Pos('</select>', parse.Strings[i]) > 0) then - begin - isExtractChapter := False; - Break; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Kivmanga/names_and_links.inc b/baseunits/includes/Kivmanga/names_and_links.inc deleted file mode 100644 index 6b9a9045f..000000000 --- a/baseunits/includes/Kivmanga/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function KivmangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[KIVMANGA_ID, 1], 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('option value="', parse.Strings[i]) > 0) and - (Pos('value="0"', parse.Strings[i]) = 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Komikid/chapter_page_number.inc b/baseunits/includes/Komikid/chapter_page_number.inc deleted file mode 100644 index bcbff46d4..000000000 --- a/baseunits/includes/Komikid/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetKomikidPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(KOMIKID_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('title="Next Page"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 6]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Komikid/image_url.inc b/baseunits/includes/Komikid/image_url.inc deleted file mode 100644 index a4ce8aea1..000000000 --- a/baseunits/includes/Komikid/image_url.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetKomikidImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - regx: TRegExpr; - begin - l := TStringList.Create; - s := EncodeURL(FillMangaSiteHost(KOMIKID_ID, URL) + '/' + - IntToStr(workCounter + 1) + '/'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', LowerCase(parse.Strings[i])) > 0) and - (Pos('class="picture"', LowerCase(parse.Strings[i])) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - regx := TRegExpr.Create; - try - regx.Expression := 'https?://'; - if not regx.Exec(s) then - s := WebsiteRoots[KOMIKID_ID, 1] + '/' + s; - s := EncodeURL(s); - manager.container.PageLinks.Strings[workCounter] := s; - finally - regx.Free; - end; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Komikid/manga_information.inc b/baseunits/includes/Komikid/manga_information.inc deleted file mode 100644 index 1e12adf47..000000000 --- a/baseunits/includes/Komikid/manga_information.inc +++ /dev/null @@ -1,73 +0,0 @@ - function GetKomikidInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[KOMIKID_ID, 0]; - mangaInfo.url := FillMangaSiteHost(KOMIKID_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (Pos('select name="chapter"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get manga name - if (mangaInfo.title = '') and (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i - 2], 'content="', ' Chapter'); - - if (isExtractChapter) and (Pos('</select>', parse.Strings[i]) > 0) then - Break; - - if (isExtractChapter) and (Pos('option value=', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := URL + '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Komikid/names_and_links.inc b/baseunits/includes/Komikid/names_and_links.inc deleted file mode 100644 index 13c270dfe..000000000 --- a/baseunits/includes/Komikid/names_and_links.inc +++ /dev/null @@ -1,41 +0,0 @@ - function KomikidGetNamesAndLinks: Byte; - var - i: Cardinal; - isFound: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[KOMIKID_ID, 1] + KOMIKID_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="series_col"', LowerCase(parse.Strings[i])) > 0 then - isFound := True; - if isFound and (Pos('</html>', LowerCase(parse.Strings[i])) > 0) then - isFound := False; - if isFound and (Pos('<a ', parse.Strings[i]) > 0) then - if (Pos('<li>', parse.Strings[i - 1]) > 0) then - begin - Result := NO_ERROR; - links.Add('/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href="'))); - names.Add(Trim(RemoveStringBreaks(HTMLEntitiesFilter( - StringFilter(parse.Strings[i + 1]))))); - end; - end; - parse.Clear; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/LectureEnLigne/chapter_page_number.inc b/baseunits/includes/LectureEnLigne/chapter_page_number.inc deleted file mode 100644 index 5d2a7837c..000000000 --- a/baseunits/includes/LectureEnLigne/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetLectureEnLignePageNumber: Boolean; - var - s: string; - i: Integer; - l: TStringList; - isGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(LECTUREENLIGNE_ID, URL)); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - s := s + '/1.html'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and - (GetVal(parse[i], 'class') = 'pages') then - isGetPageNumber := True; - if isGetPageNumber and (GetTagName(parse[i]) = '/select') then - Break; - if isGetPageNumber and (GetTagName(parse[i]) = 'option') then - Inc(manager.container.PageNumber); - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/LectureEnLigne/directory_page_number.inc b/baseunits/includes/LectureEnLigne/directory_page_number.inc deleted file mode 100644 index 4dc9deaf8..000000000 --- a/baseunits/includes/LectureEnLigne/directory_page_number.inc +++ /dev/null @@ -1,43 +0,0 @@ - function GetLectureEnLigneDirectoryPageNumber: Byte; - var - i, p: Cardinal; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[LECTUREENLIGNE_ID, 1] + - LECTUREENLIGNE_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - Page := 0; - regx := TRegExpr.Create; - regx.Expression := '^.*\?page=liste.*ordre=.*p=(\d+)\".*$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('href="', parse.Strings[i]) > 0) and - (Pos('?page=liste', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - p := StrToIntDef(regx.Replace(parse.Strings[i], '$1', True), 0); - if p > Page then - Page := p; - end; - end; - regx.Free; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/LectureEnLigne/image_url.inc b/baseunits/includes/LectureEnLigne/image_url.inc deleted file mode 100644 index fb209be44..000000000 --- a/baseunits/includes/LectureEnLigne/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GeLectureEnligneImageURL: Boolean; - var - s: string; - i: Integer; - l: TStringList; - begin - s := DecodeUrl(FillMangaSiteHost(LECTUREENLIGNE_ID, URL)); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - s := s + '/' + IntToStr(workCounter + 1) + '.html'; - l := TStringList.Create; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'id') = 'image') then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/LectureEnLigne/manga_information.inc b/baseunits/includes/LectureEnLigne/manga_information.inc deleted file mode 100644 index 68f14a9b8..000000000 --- a/baseunits/includes/LectureEnLigne/manga_information.inc +++ /dev/null @@ -1,111 +0,0 @@ - function GetLectureEnLigneInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Integer; - begin - mangaInfo.url := FillMangaSiteHost(LECTUREENLIGNE_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[LECTUREENLIGNE_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('class="imagemanga"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(WebsiteRoots[LECTUREENLIGNE_ID, 1] + - '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - - // get title - if (Pos('<title>', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft( - TrimRight(HTMLEntitiesFilter(GetString('~!@' + parse.Strings[i + 1], - '~!@', ' - Lecture-en-ligne.com')))); - - // get chapter name and links - if (Pos('class="table"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - '../..', '', []); - if Pos('.htm', s) > 0 then - s := ReplaceRegExpr('/\d+\.html?$', s, '', False); - mangaInfo.chapterLinks.Add(s); - j := i - 1; - while (Pos('<', parse.Strings[j]) > 0) or (Trim(parse.Strings[j]) = '') do - Dec(j); - s := RemoveSymbols(Trim(parse.Strings[j])); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('class=''comments''', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get summary - if (Pos('Résumé :', parse.Strings[i]) <> 0) and - (Pos('<p', parse.Strings[i - 1]) <> 0) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get authors - if (i + 3 < parse.Count) and (Pos('Auteur :', parse.Strings[i]) <> 0) then - mangaInfo.authors := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 3]))); - - // get artists - if (i + 3 < parse.Count) and (Pos('Dessinateur :', parse.Strings[i]) <> 0) then - mangaInfo.artists := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 3]))); - - // get genres - if (i + 3 < parse.Count) and (Pos('Genres :', parse.Strings[i]) <> 0) then - mangaInfo.genres := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 3]))); - - - // get status - if (i + 5 < parse.Count) and (Pos('Statut :', parse.Strings[i]) <> 0) then - begin - if (Pos('Terminé', parse.Strings[i + 3]) <> 0) or - (Pos('one shot', parse.Strings[i + 3]) <> 0) then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/LectureEnLigne/names_and_links.inc b/baseunits/includes/LectureEnLigne/names_and_links.inc deleted file mode 100644 index 0284d80c9..000000000 --- a/baseunits/includes/LectureEnLigne/names_and_links.inc +++ /dev/null @@ -1,43 +0,0 @@ - function LectureEnLigneGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[LECTUREENLIGNE_ID, 1] + - LECTUREENLIGNE_BROWSER + '&p=' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - { - if (Pos('option value=', parse[i]) > 0) then - begin - Result:= NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(parse[i+1])))); - links.Add(StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')), WebsiteRoots[LECTUREENLIGNE_ID,1], '', [])); - end; - } - if (Pos('class="infoImages"', parse.Strings[i]) > 0) and - (Pos('href="', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 1])))); - links.Add('/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href='))); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/LoneManga/chapter_page_number.inc b/baseunits/includes/LoneManga/chapter_page_number.inc deleted file mode 100644 index d06d82cb8..000000000 --- a/baseunits/includes/LoneManga/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetLoneMangaPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - - s := 'showAll=true&design=Show+in+Long+Strip+Mode'; - FHTTP.Sock.Tag := 100; //POST - FHTTP.Document.Clear; - FHTTP.Document.Write(PChar(s)^, Length(s)); - - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(LONEMANGA_ID, URL)), - manager.container.manager.retryConnect); - - ParseHTML(l.Text, parse); - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count-1 do - begin - if GetVal(parse[i], 'class') = 'imageWrapper' then - if GetTagName(parse[i+2]) = 'img' then - manager.container.PageLinks.Add(GetVal(parse[i+2], 'src')); - end; - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/LoneManga/manga_information.inc b/baseunits/includes/LoneManga/manga_information.inc deleted file mode 100644 index 57e16e377..000000000 --- a/baseunits/includes/LoneManga/manga_information.inc +++ /dev/null @@ -1,88 +0,0 @@ - function GetLoneMangaInfoFromURL: Byte; - var - s: String; - i, j: Integer; - begin - mangaInfo.website := WebsiteRoots[LONEMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(LONEMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count-1 do - begin - //title - if mangaInfo.title = '' then - if GetVal(parse[i], 'class') = 'kommiku-bread' then - mangaInfo.title := CommonStringFilter(parse[i+2]); - - //cover - if mangaInfo.coverLink = '' then - if (GetTagName(parse[i]) = 'img') and - (Pos('float:', parse[i]) <> 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - if (GetTagName(parse[i]) = 'td') and - (GetVal(parse[i], 'class') = 'infoTabOne') then - begin - //genre - if Pos('Type:', parse[i+2]) > 0 then - mangaInfo.genres := Trim(parse[i+6]); - - //status - if Pos('Status:', parse[i+2]) > 0 then - begin - s := LowerCase(Trim(parse[i+6])); - if s = 'ongoing' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - - //summary - if Pos('Summary:', parse[i+2]) <> 0 then - begin - mangaInfo.summary := ''; - for j := i + 5 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/td' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + LineEnding + CommonStringFilter(parse[j]); - end; - mangaInfo.summary := Trim(mangaInfo.summary); - end; - end; - - //chapters - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = 'column') then - begin - for j := i+2 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/table' then - Break - else - if GetTagName(parse[j]) = 'a' then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[j], 'href')); - mangaInfo.chapterName.Add(CommonStringFilter(parse[j+1])); - end; - end; - end; - end; - Result := NO_ERROR; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 1 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - end; diff --git a/baseunits/includes/LoneManga/names_and_links.inc b/baseunits/includes/LoneManga/names_and_links.inc deleted file mode 100644 index d28229fcc..000000000 --- a/baseunits/includes/LoneManga/names_and_links.inc +++ /dev/null @@ -1,26 +0,0 @@ - function LoneMangaGetNamesAndLinks: Byte; - var - i: Integer; - s: string; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[LONEMANGA_ID, 1] + '/mangas/'; - if not GetPage(TObject(Source), s, 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetVal(parse[i], 'class') = 'grid-entry-title entry-title') then - begin - links.Add(GetVal(parse[i+1], 'href')); - names.Add(CommonStringFilter(parse[i+2])); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Mabuns/image_url.inc b/baseunits/includes/Mabuns/image_url.inc deleted file mode 100644 index f470354d6..000000000 --- a/baseunits/includes/Mabuns/image_url.inc +++ /dev/null @@ -1,43 +0,0 @@ - function GetMabunsImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MABUNS_ID, URL); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('addpage(''', parse.Strings[i]) > 0 then - begin - s := parse.Strings[i]; - s := StringReplace(s, 'https://', 'http://', [rfReplaceAll]); - repeat - j := Pos('addpage(''', s); - if Pos('googleusercontent', s) > 0 then - manager.container.PageLinks.Add( - EncodeUrl(GetString(s, 'addpage(''', ''','))) - else - manager.container.PageLinks.Add( - EncodeUrl(GetString(s, 'addpage(''', ');'))); - Delete(s, Pos('addpage(''', s), 16); - j := Pos('addpage(''', s); - until j = 0; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Mabuns/manga_information.inc b/baseunits/includes/Mabuns/manga_information.inc deleted file mode 100644 index 1e17240e6..000000000 --- a/baseunits/includes/Mabuns/manga_information.inc +++ /dev/null @@ -1,92 +0,0 @@ - function GetMabunsInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MABUNS_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MABUNS_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('rel="image_src"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'href='))); - - // get title - if (Pos('Judul :', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft( - TrimRight(HTMLEntitiesFilter(StringFilter(GetString(parse.Strings[i] + '~!@', - 'Judul :', '~!@'))))); - - if (not isExtractChapter) and (Pos('Baca Online:', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('<a href', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[MABUNS_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('</table>', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get authors - if (i + 8 < parse.Count) and (Pos('Author :', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft( - TrimRight(GetString(parse.Strings[i] + '~!@', 'Author :', '~!@'))); - - // get artists - if (i + 1 < parse.Count) and (Pos('Artist :', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft( - TrimRight(GetString(parse.Strings[i] + '~!@', 'Artist :', '~!@'))); - - // get genres - if (Pos('Genre :', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := TrimLeft( - TrimRight(GetString(parse.Strings[i] + '~!@', 'Genre :', '~!@'))); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Mabuns/names_and_links.inc b/baseunits/includes/Mabuns/names_and_links.inc deleted file mode 100644 index 8ed618b12..000000000 --- a/baseunits/includes/Mabuns/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function MabunsGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MABUNS_ID, 1] + MABUNS_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="manga"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 3]))); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute( - parse.Strings[i + 6], 'href=')), - WebsiteRoots[MABUNS_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Madokami/chapter_page_number.inc b/baseunits/includes/Madokami/chapter_page_number.inc deleted file mode 100644 index b93fef5ff..000000000 --- a/baseunits/includes/Madokami/chapter_page_number.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetMadokamiPageNumber: Boolean; - var - i: Integer; - l: TStringList; - datapath_, datafiles_: string; - begin - l := TStringList.Create; - - Result := GetPage(TObject(l), - FillMangaSiteHost(MADOKAMI_ID, URL), - manager.container.manager.retryConnect); - - parse := TStringList.Create; - ParseHTML(l.Text, parse); - l.Free; - datapath_ := ''; - datafiles_ := ''; - if parse.Count > 0 then - begin - for i := 0 to parse.Count-1 do - if GetVal(parse[i], 'id') = 'reader' then - begin - datapath_ := GetVal(parse[i], 'data-path'); - datafiles_ := GetVal(parse[i], 'data-files'); - Break; - end; - end; - parse.Free; - - if (datapath_ <> '') and (datafiles_ <> '') then - begin - datafiles_ := Trim(TrimChar(datafiles_, ['[', ']'])); - datafiles_ := StringReplace(datafiles_, '"', '"', [rfIgnoreCase, rfReplaceAll]); - datafiles_ := StringReplace(datafiles_, '\', '', [rfReplaceAll]); - with manager.container do - begin - PageLinks.Delimiter := ','; - PageLinks.DelimitedText := datafiles_; - if PageLinks.Count > 0 then - for i := 0 to PageLinks.Count-1 do - PageLinks[i] := EncodeURL(WebsiteRoots[MADOKAMI_ID, 1] + '/reader/image?path=' + - datapath_ + '&file=' + PageLinks[i]); - end; - end; - end; diff --git a/baseunits/includes/Madokami/directory_page_number.inc b/baseunits/includes/Madokami/directory_page_number.inc deleted file mode 100644 index 8cce97d8d..000000000 --- a/baseunits/includes/Madokami/directory_page_number.inc +++ /dev/null @@ -1,6 +0,0 @@ - function GetMadokamiDirectoryPageNumber: Byte; - begin - Source.Free; - Page := Length(MADOKAMI_BROWSER); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Madokami/manga_information.inc b/baseunits/includes/Madokami/manga_information.inc deleted file mode 100644 index 29751680d..000000000 --- a/baseunits/includes/Madokami/manga_information.inc +++ /dev/null @@ -1,93 +0,0 @@ - function GetMadokamiInfoFromURL: Byte; - var - i, j: Integer; - s: String = ''; - regx: TRegExpr; - begin - mangaInfo.website := WebsiteRoots[MADOKAMI_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MADOKAMI_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.authors := ''; - - //title - if mangaInfo.title = '' then - for i := parse.Count-1 downto 0 do - if GetVal(parse[i], 'itemprop') = 'title' then - begin - mangaInfo.title := CommonStringFilter(parse[i+1]); - Break; - end; - - regx := TRegExpr.Create; - regx.Expression := '^(.+)\.\w+$'; - for i := 0 to parse.Count-1 do - begin - //cover - if mangaInfo.coverLink = '' then - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'itemprop') = 'image') then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //authors - if GetVal(parse[i], 'itemprop') = 'author' then - AddCommaString(mangaInfo.authors, CommonStringFilter(parse[i+1])); - - //genre - if (GetTagName(parse[i]) = 'span') and - (GetVal(parse[i], 'itemprop') = 'title') then - begin - s := CommonStringFilter(parse[i+1]); - s := TrimLeftChar(s, ['_']); - if AnsiIndexText(s, [mangaInfo.title, '/', 'Manga','# - F', 'G - M', 'N - Z', - 'Non-English', 'AutoUploads']) = -1 then - AddCommaString(mangaInfo.genres, s); - end; - if AnsiIndexStr(GetVal(parse[i], 'class'), ['tag', 'tag tag-category']) > -1 then - AddCommaString(mangaInfo.genres, CommonStringFilter(parse[i+1])); - - //summary - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = 'description') then - begin - mangaInfo.summary := ''; - for j := i+1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/div' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + LineEnding + CommonStringFilter(parse[j]); - end; - mangaInfo.summary := Trim(mangaInfo.summary); - end; - - //chapters - if (GetTagName(parse[i]) = 'a') and - (Pos('/reader/', parse[i]) <> 0) then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - for j := i-10 downto 0 do - if GetTagName(parse[j]) = 'a' then - begin - s := CommonStringFilter(parse[j+1]); - s := regx.Replace(s, '$1', True); - mangaInfo.chapterName.Add(s); - Break; - end; - end; - end; - regx.Free; - Result := NO_ERROR; - end; - end; diff --git a/baseunits/includes/Madokami/names_and_links.inc b/baseunits/includes/Madokami/names_and_links.inc deleted file mode 100644 index 3e92f48c3..000000000 --- a/baseunits/includes/Madokami/names_and_links.inc +++ /dev/null @@ -1,46 +0,0 @@ - function MadokamiGetNamesAndLinks: Byte; - var - i: Integer; - s: string; - j: Integer; - begin - Result := INFORMATION_NOT_FOUND; - i := StrToIntDef(URL, 0); - if i >= Length(MADOKAMI_BROWSER) then - begin - Source.Free; - Exit; - end; - - s := WebsiteRoots[MADOKAMI_ID, 1] + MADOKAMI_BROWSER[i]; - if not GetPage(TObject(Source), s, 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'tr') and - (Pos('data-record=', parse[i]) <> 0)then - begin - for j := i+2 to parse.Count-1 do - if GetTagName(parse[j]) = 'a' then - begin - s := Trim(parse[j+1]); - if RightStr(s, 1) = '/' then - Delete(s, Length(s), 1); - if AnsiIndexText(s, ['', '</span>', '_Unsorted']) = -1 then - begin - names.Add(CommonStringFilter(s)); - links.Add(GetVal(parse[j], 'href')); - end; - Break; - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Manga24h/directory_page_number.inc b/baseunits/includes/Manga24h/directory_page_number.inc deleted file mode 100644 index 7372f7306..000000000 --- a/baseunits/includes/Manga24h/directory_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetManga24hDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGA24H_ID, 1] + - MANGA24H_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('Pages (', parse.Strings[i]) > 0) then - begin - s := GetString(parse.Strings[i], 'Pages (', ')'); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Manga24h/image_url.inc b/baseunits/includes/Manga24h/image_url.inc deleted file mode 100644 index 32b6c4387..000000000 --- a/baseunits/includes/Manga24h/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetManga24hImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGA24H_ID, URL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('style="border:3px', parse.Strings[i]) <> 0) then - // (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'm_picture') then - begin - manager.container.PageLinks.Add(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Manga24h/manga_information.inc b/baseunits/includes/Manga24h/manga_information.inc deleted file mode 100644 index 67b26b44a..000000000 --- a/baseunits/includes/Manga24h/manga_information.inc +++ /dev/null @@ -1,138 +0,0 @@ - function GetManga24hInfoFromURL: Byte; - var - // patchURL, - s: String; - i, j: Cardinal; - isExtractChapters: Boolean = False; - isExtractSummary: Boolean = False; - begin - // patchURL:= UTF8ToANSI(URL); - // Insert('comics/', patchURL, 10); - mangaInfo.url := FillMangaSiteHost(MANGA24H_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGA24H_ID, 0]; - mangaInfo.summary := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover link - if (Pos('class="img-rounded', parse.Strings[i]) > 0) then - begin - mangaInfo.coverLink := EncodeURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - s := mangaInfo.coverLink; - end; - - // get summary - if (Pos('"clearfix"', parse.Strings[i]) > 0) and - (Pos('<p>', parse.Strings[i + 3]) > 0) then - begin - j := i + 5; - mangaInfo.summary := ''; - while (Pos('$(document).ready(function()', parse.Strings[j]) = 0) and - (j < parse.Count - 1) do - begin - s := parse.Strings[j]; - if (Length(s) > 0) and (s[1] <> '<') then - begin - parse.Strings[j] := StringFilter(HTMLEntitiesFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + - StringFilter(TrimRight(TrimLeft(parse.Strings[j]))); - end; - Inc(j); - end; - end; - - if (Pos('<tbody>', parse.Strings[i]) <> 0) and (not isExtractSummary) then - isExtractChapters := True; - - if (Pos('</tbody>', parse.Strings[i]) <> 0) and (isExtractSummary) then - isExtractChapters := False; - - - // get chapter name and links - if (isExtractChapters) and - (Pos('<td>', parse.Strings[i]) <> 0) and - (GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')) <> '') and - (Pos('</a>', parse.Strings[i + 3]) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - CorrectURL('/' + StringReplace(GetAttributeValue( - GetTagAttribute(parse.Strings[i + 1], 'href=')), WebsiteRoots[MANGA24H_ID, 1], - '', [rfReplaceAll]))); - parse.Strings[i + 2] := HTMLEntitiesFilter(parse.Strings[i + 2]); - parse.Strings[i + 2] := StringReplace(parse.Strings[i + 2], #10, '', [rfReplaceAll]); - parse.Strings[i + 2] := StringReplace(parse.Strings[i + 2], #13, '', [rfReplaceAll]); - parse.Strings[i + 2] := TrimLeft(parse.Strings[i + 2]); - mangaInfo.chapterName.Add( - StringFilter(TrimRight(RemoveSymbols(parse.Strings[i + 2])))); - end; - - // get title - if (Pos('<title>', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft( - StringFilter(GetString('~!@' + parse.Strings[i + 1], '~!@', ' - Truyen Tranh Online'))); - - // get authors - if (Pos('Tác giả :', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(StringFilter(parse.Strings[i + 3])); - - // get artists - if (Pos('Họa sỹ :', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(StringFilter(parse.Strings[i + 3])); - - // get genres - if (Pos('Thể loại :', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := ''; - for j := 0 to 37 do - if Pos(LowerCase(defaultGenres[j]), LowerCase(parse.Strings[i + 4])) <> 0 then - mangaInfo.genres := mangaInfo.genres + (defaultGenres[j] + ', '); - end; - - // get status - if (Pos('Tình Trạng:', parse.Strings[i]) <> 0) then - begin - if Pos('Hoàn Thành', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '0' // ongoing - else - mangaInfo.status := '1'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterName.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterName.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Manga24h/names_and_links.inc b/baseunits/includes/Manga24h/names_and_links.inc deleted file mode 100644 index c750fe4bd..000000000 --- a/baseunits/includes/Manga24h/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function Manga24hGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGA24H_ID, 1] + - MANGA24H_BROWSER + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 3 do - begin - if (Pos('<b>', parse.Strings[i]) <> 0) and - (Pos('</b>', parse.Strings[i + 2]) <> 0) and - (GetAttributeValue(GetTagAttribute(parse.Strings[i - 1], 'href=')) <> '') then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(s); - links.Add('/' + StringReplace(GetAttributeValue( - GetTagAttribute(parse.Strings[i - 1], 'href=')), WebsiteRoots[MANGA24H_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Manga2u/chapter_page_number.inc b/baseunits/includes/Manga2u/chapter_page_number.inc deleted file mode 100644 index efbb62329..000000000 --- a/baseunits/includes/Manga2u/chapter_page_number.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetManga2uPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - isStartGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGA2U_ID, URL) + '1/'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="cbo_wpm_pag"', parse.Strings[i]) > 0) then - isStartGetPageNumber := True; - - if (isStartGetPageNumber) and - (Pos('</select>', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 3]; - manager.container.PageNumber := - StrToInt(GetAttributeValue(GetTagAttribute(s, 'value='))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Manga2u/directory_page_number.inc b/baseunits/includes/Manga2u/directory_page_number.inc deleted file mode 100644 index ba764cada..000000000 --- a/baseunits/includes/Manga2u/directory_page_number.inc +++ /dev/null @@ -1,28 +0,0 @@ - function GetManga2uDirectoryPageNumber: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGA2U_ID, 1] + MANGA2U_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count > 0 then - for i := parse.Count - 1 downto 2 do - if (Pos('<a', parse[i]) > 0) and (Pos(MANGA2U_BROWSER, parse[i]) > 0) - and (Pos('Last', parse[i + 1]) > 0) then - begin - page := StrToIntDef(ReplaceRegExpr('^.*/(\d+)/$', GetVal(parse[i], 'href'), '$1', True), 1); - Result := NO_ERROR; - Break; - end; - end; diff --git a/baseunits/includes/Manga2u/image_url.inc b/baseunits/includes/Manga2u/image_url.inc deleted file mode 100644 index d2adf0aa1..000000000 --- a/baseunits/includes/Manga2u/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetManga2uImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGA2U_ID, URL) + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="manga-page', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - EncodeURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Manga2u/manga_information.inc b/baseunits/includes/Manga2u/manga_information.inc deleted file mode 100644 index d273b51ba..000000000 --- a/baseunits/includes/Manga2u/manga_information.inc +++ /dev/null @@ -1,172 +0,0 @@ - function GetManga2uInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - i, j, n: Cardinal; - numberOfPage: Cardinal = 1; - - procedure ExtractChapter; - begin - if (not isExtractChapter) and (Pos('name="IL_IN_TAG', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('class="val', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i - 2], 'href')), - WebsiteRoots[MANGA2U_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('sct_wid_bot', parse.Strings[i]) > 0) then - isExtractChapter := False; - end; - - begin - mangaInfo.url := FillMangaSiteHost(MANGA2U_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - mangaInfo.website := WebsiteRoots[MANGA2U_ID, 0]; - mangaInfo.status := ''; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="sel', parse.Strings[i]) > 0 then - numberOfPage := StrToInt(GetString(parse.Strings[i + 10], '-list/', '/">')); - - // get cover - if (mangaInfo.coverLink = '') and - (Pos('class="cvr_ara', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i + 2], 'src='))); - - // get title - if (Pos('class="cvr_ara', parse.Strings[i]) > 0) then - mangaInfo.title := GetAttributeValue(GetTagAttribute(parse.Strings[i + 2], 'alt=')); - - ExtractChapter; - - // get summary - if (Pos('Author', parse.Strings[i]) <> 0) then - begin - j := i - 6; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter( - StringFilter(TrimLeft(parse.Strings[j]))); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - Break; - end; - Inc(j); - end; - end; - - // get authors - if (Pos('Author', parse.Strings[i]) <> 0) then - mangaInfo.authors := StringReplace(TrimLeft(StringFilter(parse.Strings[i + 2])), - ': ', '', []); - - // get artists - if (Pos('Author', parse.Strings[i]) <> 0) then - mangaInfo.artists := StringReplace(TrimLeft(StringFilter(parse.Strings[i + 2])), - ': ', '', []); - - // get genres - if (Pos('Category', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('list/category/', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</p>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - if numberOfPage > 1 then - begin - for n := 2 to numberOfPage do - begin - Source.Clear; - s := mangaInfo.url + 'chapter-list/' + IntToStr(n); - if not GetPage(TObject(Source), mangaInfo.url + 'chapter-list/' + - IntToStr(n), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - isExtractChapter := False; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - ExtractChapter; - end; - end; - Source.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Manga2u/names_and_links.inc b/baseunits/includes/Manga2u/names_and_links.inc deleted file mode 100644 index b2b171752..000000000 --- a/baseunits/includes/Manga2u/names_and_links.inc +++ /dev/null @@ -1,31 +0,0 @@ - function Manga2uGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGA2U_ID, 1] + - MANGA2U_BROWSER + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if i + 3 < parse.Count - 1 then - if (Pos('class="det"', parse[i]) > 0) and (Pos('<a', parse[i + 2]) > 0) - and (Pos('<', parse[i + 3]) = 0) then - begin - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 3]))))); - links.Add(Trim(StringReplace(GetVal(parse[i + 2], 'href'), - WebsiteRoots[MANGA2U_ID, 1], '', [rfIgnoreCase]))); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaAe/chapter_page_number.inc b/baseunits/includes/MangaAe/chapter_page_number.inc deleted file mode 100644 index d89eef3fe..000000000 --- a/baseunits/includes/MangaAe/chapter_page_number.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetMangaAePageNumber: Boolean; - var - s: String; - i, p: LongInt; - l: TStringList; - isExtractPage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAAE_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) <> 0) and (Pos('class="active"', parse[i]) <> 0) then - isExtractPage := True; - if isExtractPage and (Pos('</div', parse[i]) <> 0) then - Break; - if isExtractPage and - (Pos('<a', parse[i]) <> 0) and (Pos(URL, parse[i]) <> 0) then - begin - p := StrToIntDef(Trim(parse[i + 1]), 0); - if p > manager.container.PageNumber then - manager.container.PageNumber := p; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaAe/directory_page_number.inc b/baseunits/includes/MangaAe/directory_page_number.inc deleted file mode 100644 index b660d8dd7..000000000 --- a/baseunits/includes/MangaAe/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMangaAeDirectoryPageNumber: Byte; - var - i, p: LongInt; - isExtractPage: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAAE_ID, 1] + MANGAAE_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Page := 1; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (Pos('<div', parse[i]) <> 0 ) and (Pos('class="pagination', parse[i]) <> 0) then - isExtractPage := True; - if isExtractPage and (Pos('</div', parse[i]) <> 0) then - Break; - if isExtractPage and (Pos('<a', parse[i]) <> 0) then - begin - s := ReplaceRegExpr('^.*/page\:(\d+)$', GetVal(parse[i], 'href'), '$1', True); - p := StrToIntDef(s, 0); - if p > Page then - Page := p; - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaAe/image_url.inc b/baseunits/includes/MangaAe/image_url.inc deleted file mode 100644 index 56cb354e8..000000000 --- a/baseunits/includes/MangaAe/image_url.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetMangaAeImageURL: Boolean; - var - s: String; - i: LongInt; - l: TStringList; - isImageURL: Boolean = False; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAAE_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('id="showchaptercontainer', parse[i]) <> 0) then - isImageURL := True; - if isImageURL and (Pos('<img', parse[i]) <> 0) then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaAe/manga_information.inc b/baseunits/includes/MangaAe/manga_information.inc deleted file mode 100644 index 54ebc1068..000000000 --- a/baseunits/includes/MangaAe/manga_information.inc +++ /dev/null @@ -1,117 +0,0 @@ - function GetMangaAeInfoFromURL: Byte; - var - i: LongInt; - regx: TRegExpr; - isExtractChapter: Boolean = False; - isExtractGenres : Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAAE_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAAE_ID, URL); - if not GetPage(TObject(Source), EncodeURL(mangaInfo.url), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.genres := ''; - - regx := TRegExpr.Create; - try - regx.Expression := '/1/?$'; - for i := 0 to parse.Count - 1 do - begin - // cover - if (Pos('<img', parse[i]) <> 0) and (Pos('class="manga-cover', parse[i]) <> 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - // title - if (mangaInfo.title = '') and (Pos('class="EnglishName', parse[i]) <> 0) then - begin - parse[i] := Trim(parse[i + 1]); - if Length(parse[i]) > 2 then - begin - if (parse[i][1] = '(') and (parse[i][Length(parse[i])] = ')') then - parse[i] := Copy(parse[i], 2, Length(parse[i]) - 2); - end; - mangaInfo.title := Trim(parse[i]); - end; - - // author - if (Pos('class="manga-details-author', parse[i]) <> 0) then - if (Pos('<', parse[i + 21]) = 0) then - mangaInfo.authors := Trim(parse[i + 21]); - - // status - if (i + 4 < parse.Count) and - (Pos('الحالة :', parse.Strings[i]) <> 0) and - (Pos('</h3', parse.Strings[i + 1]) <> 0) then - begin - if (Pos('مستمرة', parse.Strings[i + 4]) <> 0) then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - - // genres - if Pos('التصنيف:', parse[i]) <> 0 then - isExtractGenres := True; - if isExtractChapter and (Pos('</ul', parse[i]) <> 0) then - isExtractGenres := False; - if isExtractGenres and - (Pos('<a', parse[i]) <> 0) and (Pos('/manga/cats', parse[i]) <> 0) then - begin - if mangaInfo.genres <> '' then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]) - else - mangaInfo.genres := Trim(parse[i + 1]); - end; - - // summary - if (Pos('نبذة عن المانجا', parse[i]) <> 0) and (Pos('</h3', parse[i + 1]) <> 0) then - if Pos('<', parse[i + 4]) = 0 then - mangaInfo.summary := CommonStringFilter(parse[i + 4]); - - //chapters - if (Pos('<ul', parse[i]) <> 0) and (Pos('class="new-manga-chapters', parse[i]) <> 0) then - isExtractChapter := True; - if isExtractChapter and (Pos('</ul', parse[i]) <> 0) then - isExtractChapter := False; - if isExtractChapter and - (Pos('<a', parse[i]) <> 0) and (Pos('class="chapter', parse[i]) <> 0) then - begin - parse[i] := GetVal(parse[i], 'href'); - if regx.Exec(parse[i]) then - parse[i] := regx.Replace(parse[i], '', False); - mangaInfo.chapterLinks.Add(parse[i]); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - finally - regx.Free; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaAe/names_and_links.inc b/baseunits/includes/MangaAe/names_and_links.inc deleted file mode 100644 index b8d74874c..000000000 --- a/baseunits/includes/MangaAe/names_and_links.inc +++ /dev/null @@ -1,50 +0,0 @@ - function MangaAeGetNamesAndLinks: Byte; - var - i: LongInt; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAAE_ID, 1] + - MANGAAE_BROWSER + 'page:' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.Expression := '[^/]*\w+\.\w+(\:\d+)?/.+'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) <> 0) and (Pos('class="manga"', parse[i]) <> 0) then - begin - s := GetVal(parse[i], 'href'); - if regx.Exec(s) then - begin - links.Add(s); - names.Add(CommonStringFilter(parse[i + 1])); - end; - end; - end; - finally - regx.Free; - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaAr/chapter_page_number.inc b/baseunits/includes/MangaAr/chapter_page_number.inc deleted file mode 100644 index 32ba05c07..000000000 --- a/baseunits/includes/MangaAr/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetMangaArPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGAAR_ID, URL) + '/1'; - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - if l.Count > 0 then - try - for i := 0 to l.Count - 1 do - if Pos('var pages = [', l[i]) > 0 then - begin - s := l[i]; - s := StringReplace(s, 'var pages =', '', [rfIgnoreCase]); - s := Trim(TrimChar(s, [';', ' '])); - Break; - end; - if s <> '' then - begin - manager.container.PageLinks.Clear; - ParseJSONArray(s, 'url', manager.container.PageLinks); - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/MangaAr/image_url.inc b/baseunits/includes/MangaAr/image_url.inc deleted file mode 100644 index 31d3dc71c..000000000 --- a/baseunits/includes/MangaAr/image_url.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetMangaArImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l, ts: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGAAR_ID, URL) + '/1'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - manager.container.PageLinks.Clear; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('var pages =', parse.Strings[i]) > 0) then - begin - ts := TStringList.Create; - s := GetString(parse.Strings[i], '[{', '}];'); - s := StringReplace(s, '":', '",', [rfReplaceAll]); - s := StringReplace(s, '\', '', [rfReplaceAll]); - ts.DelimitedText := s; - for j := 0 to ts.Count - 1 do - begin - if (Pos('url', ts.Strings[j]) > 0) then - begin - s := ts.Strings[j + 1]; - s := 'http' + GetString(s, 'http', '?w='); //original resolution - manager.container.PageLinks.Add(s); - end; - end; - ts.Free; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaAr/manga_information.inc b/baseunits/includes/MangaAr/manga_information.inc deleted file mode 100644 index 6c3585232..000000000 --- a/baseunits/includes/MangaAr/manga_information.inc +++ /dev/null @@ -1,130 +0,0 @@ - function GetMangaArInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGAAR_ID, URL); - if not GetPage(TObject(Source), EncodeURL(mangaInfo.url), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGAAR_ID, 0]; - - mangaInfo.numChapter := 0; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('class=" thumbnail"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := - CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i + 2], 'src='))); - - // get summary - if (i + 4 < parse.Count) and (Pos('القصة', parse.Strings[i]) > 0) then - if (Pos('</span>', parse.Strings[i - 1]) > 0) and - (Pos('</dt>', parse.Strings[i + 1]) > 0) then - begin - mangaInfo.summary := ''; - j := i + 4; - while (j < parse.Count) and (not (Pos('</dd>', parse.Strings[j]) > 0)) do - begin - s := Trim(parse.Strings[j]); - s := HTMLEntitiesFilter(StringFilter(s)); - mangaInfo.summary := mangaInfo.summary + s; - Inc(j); - end; - mangaInfo.summary := StringReplace(mangaInfo.summary, '<p>', - '\r\n', [rfReplaceAll]); - mangaInfo.summary := StringReplace(mangaInfo.summary, '</p>', '', [rfReplaceAll]); - mangaInfo.summary := StringReplace(mangaInfo.summary, '\r\n\r\n', - '\r\n', [rfReplaceAll]); - mangaInfo.summary := StringReplace(mangaInfo.summary, '\r\n\r\n', - '\r\n', [rfReplaceAll]); - mangaInfo.summary := StringReplace(mangaInfo.summary, '\r\n\r\n', - '\r\n', [rfReplaceAll]); - end; - - // get title - if (mangaInfo.title = '') and - (Pos('http-equiv="description" content="', parse.Strings[i]) <> 0) then - mangaInfo.title := Trim(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'content='))); - - // get chapter name and links - if (Pos('class="tit ajaxify {title:', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - s := StringReplace(s, WebsiteRoots[MANGAAR_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(Trim(parse.Strings[i + 1])); - s := StringFilter(HTMLEntitiesFilter(s)); - mangaInfo.chapterName.Add(s); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('اسم المؤلف', parse.Strings[i]) > 0) then - if (Pos('</span>', parse.Strings[i - 1]) > 0) and - (Pos('</dt>', parse.Strings[i + 1]) > 0) then - mangaInfo.authors := Trim(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and (Pos('اسم الرسام', parse.Strings[i]) > 0) then - if (Pos('</span>', parse.Strings[i - 1]) > 0) and - (Pos('</dt>', parse.Strings[i + 1]) > 0) then - mangaInfo.artists := Trim(parse.Strings[i + 4]); - - // get genres - if (i + 4 < parse.Count) and (Pos('التصنيف', parse.Strings[i]) > 0) then - if (Pos('</span>', parse.Strings[i - 1]) > 0) and - (Pos('</dt>', parse.Strings[i + 1]) > 0) then - begin - mangaInfo.genres := Trim(parse.Strings[i + 4]); - mangaInfo.genres := StringReplace(mangaInfo.genres, sLineBreak, - '', [rfReplaceAll]); - mangaInfo.genres := StringReplace(mangaInfo.genres, ' ', '', [rfReplaceAll]); - mangaInfo.genres := StringReplace(mangaInfo.genres, ',', ', ', [rfReplaceAll]); - end; - - // get status - if (i + 4 < parse.Count) and (Pos('حالة الترجمة', parse.Strings[i]) > 0) then - if (Pos('</span>', parse.Strings[i - 1]) > 0) and - (Pos('</dt>', parse.Strings[i + 1]) > 0) then - begin - if Trim(parse.Strings[i + 4]) = 'مكتملة' then - mangaInfo.status := '1' // Ongoing - else - mangaInfo.status := '0'; // Completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaAr/names_and_links.inc b/baseunits/includes/MangaAr/names_and_links.inc deleted file mode 100644 index 03e7eba30..000000000 --- a/baseunits/includes/MangaAr/names_and_links.inc +++ /dev/null @@ -1,45 +0,0 @@ - function MangaArGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - isExtractMangaList: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAAR_ID, 1] + MANGAAR_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<tbody>', parse.Strings[i]) > 0) then - isExtractMangaList := True; - if (Pos('</tbody>', parse.Strings[i]) > 0) then - begin - isExtractMangaList := False; - Break; - end; - - if isExtractMangaList and (Pos('href=', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - s := StringReplace(s, WebsiteRoots[MANGAAR_ID, 1], '', []); - links.Add(s); - s := Trim(StringFilter(parse.Strings[i + 1])); - s := HTMLEntitiesFilter(s); - names.Add(s); - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaAt/chapter_page_number.inc b/baseunits/includes/MangaAt/chapter_page_number.inc deleted file mode 100644 index aa4c97152..000000000 --- a/baseunits/includes/MangaAt/chapter_page_number.inc +++ /dev/null @@ -1,40 +0,0 @@ - function GetMangaAtPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - isExtractPage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAAT_ID, URL + '/1/')); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'active') then - isExtractPage := True; - if isExtractPage and (GetTagName(parse[i]) = 'a') then - if GetVal(parse[i], 'class') = 'chapter' then - Break - else - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaAt/directory_page_number.inc b/baseunits/includes/MangaAt/directory_page_number.inc deleted file mode 100644 index 0f7ef5944..000000000 --- a/baseunits/includes/MangaAt/directory_page_number.inc +++ /dev/null @@ -1,47 +0,0 @@ - function GetMangaAtDirectoryPageNumber: Byte; - var - i, p: Integer; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAAT_ID, 1] + - '/manga', 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - Page := 0; - regx := TRegExpr.Create; - try - regx.Expression := '^.*/manga/page\:(\d+)$'; - regx.ModifierI := True; - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'a') and (Pos('/manga/page:', parse[i]) > 0 ) then - begin - s := GetVal(parse[i], 'href'); - s := regx.Replace(s, '$1', True); - p := StrToIntDef(s, 0); - if p > Page then - Page := p; - end; - finally - regx.Free; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaAt/image_url.inc b/baseunits/includes/MangaAt/image_url.inc deleted file mode 100644 index f1a18eb71..000000000 --- a/baseunits/includes/MangaAt/image_url.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetMangaAtImageURL: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGAAT_ID, URL) + - '/' + IntToStr(workCounter + 1) + '/'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if GetVal(parse[i], 'id') = 'showchaptercontainer' then - if (GetTagName(parse[i + 3]) = 'img') then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i + 3], 'src'); - Break; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaAt/manga_information.inc b/baseunits/includes/MangaAt/manga_information.inc deleted file mode 100644 index 0918f12c0..000000000 --- a/baseunits/includes/MangaAt/manga_information.inc +++ /dev/null @@ -1,108 +0,0 @@ - function GetMangaAtInfoFromURL: Byte; - var - s: String; - i, j: Integer; - begin - mangaInfo.website := WebsiteRoots[MANGAAT_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAAT_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetVal(parse[i], 'class') = 'EnglishName' then - begin - mangaInfo.title := CommonStringFilter(parse[i + 1]); - if Length(mangaInfo.title) > 2 then - if (mangaInfo.title[1] = '(') and - (mangaInfo.title[Length(mangaInfo.title)] = ')') then - begin - Delete(mangaInfo.title, 1, 1); - Delete(mangaInfo.title, Length(mangaInfo.title), 1); - end; - end; - - //cover - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'class') = 'manga-cover') then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - if GetTagName(parse[i]) = 'h3' then - begin - //genre - if Pos('التصنيف:', parse[i + 1]) > 0 then - begin - for j := i + 2 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/ul' then - Break; - if Pos('<', parse[j]) = 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[j]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[j]); - end; - mangaInfo.genres := Trim(mangaInfo.genres); - end; - - //author - if Pos('اسم المؤلف بالأنجليزية', parse[i + 1]) > 0 then - mangaInfo.authors := CommonStringFilter(TrimLeftChar(parse[i + 5], [':'])); - - //status - if Pos('الحالة :', parse[i + 1]) > 0 then - begin - s := Trim(TrimLeftChar(parse[i + 5], [':'])); - if s = 'مستمرة' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - - //summary - if Pos('نبذة عن المانجا', parse[i + 1]) > 0 then - mangaInfo.summary := CommonStringFilter(parse[i + 5]); - end; - - //chapters - if (GetTagName(parse[i]) = 'a') and - (GetVal(parse[i], 'class') = 'chapter') then - begin - Inc(mangaInfo.numChapter); - s := GetVal(parse[i], 'href'); - if Length(s) > 3 then - if RightStr(s, 3) = '/1/' then - SetLength(s, Length(s) - 3); - mangaInfo.chapterLinks.Add(s); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - Result := NO_ERROR; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 0 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - end; diff --git a/baseunits/includes/MangaAt/names_and_links.inc b/baseunits/includes/MangaAt/names_and_links.inc deleted file mode 100644 index fbea1a8b6..000000000 --- a/baseunits/includes/MangaAt/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function MangaAtGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAAT_ID, 1] + - '/manga/page:' + IntToStr(StrToInt(URL) + 1), 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(FixHTMLTagQuote(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - finally - Parser.Exec; - end; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'a') and - (GetVal(parse[i], 'class') = 'manga') then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter(parse[i + 1])); - end; - end; - - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaEden/chapter_page_number.inc b/baseunits/includes/MangaEden/chapter_page_number.inc deleted file mode 100644 index 81e9678ad..000000000 --- a/baseunits/includes/MangaEden/chapter_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetMangaEdenPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - if manager.container.MangaSiteID = MANGAEDEN_ID then - s := FillMangaSiteHost(MANGAEDEN_ID, URL) + '1/' - else - s := FillMangaSiteHost(PERVEDEN_ID, URL) + '1/'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('span class="next"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 3]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaEden/directory_page_number.inc b/baseunits/includes/MangaEden/directory_page_number.inc deleted file mode 100644 index 3814c9043..000000000 --- a/baseunits/includes/MangaEden/directory_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetMangaEdenDirectoryPageNumber(const root: String): Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), root + MANGAEDEN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'span') and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'class=')) = 'next') then - begin - s := TrimRight(TrimLeft(parse.Strings[i - 4])); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaEden/image_url.inc b/baseunits/includes/MangaEden/image_url.inc deleted file mode 100644 index 205aacece..000000000 --- a/baseunits/includes/MangaEden/image_url.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetMangaEdenImageURL: Boolean; - var - s, imgURL: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - if manager.container.MangaSiteID = MANGAEDEN_ID then - s := FillMangaSiteHost(MANGAEDEN_ID, URL) + IntToStr(workCounter + 1) + '/' - else - s := FillMangaSiteHost(PERVEDEN_ID, URL) + IntToStr(workCounter + 1) + '/'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := parse.Count - 1 downto 0 do - if (Pos('"mainImg"', parse.Strings[i]) > 0) then - begin - imgURL := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - if Copy(imgURL, 1, 2) = '//' then - imgURL := 'http:' + imgURL; - manager.container.PageLinks.Strings[workCounter] := imgURL; - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaEden/manga_information.inc b/baseunits/includes/MangaEden/manga_information.inc deleted file mode 100644 index ed050e745..000000000 --- a/baseunits/includes/MangaEden/manga_information.inc +++ /dev/null @@ -1,135 +0,0 @@ - function GetMangaEdenInfoFromURL(const root: String): Byte; - var - s: String; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - i, j: Cardinal; - begin - if Pos('http', LowerCase(URL)) = 0 then - mangaInfo.url := root + URL;// + '&confirm=yes'; - if Pos('/en-manga/', URL) > 0 then - mangaInfo.genres := 'English, ' - else - mangaInfo.genres := 'Italian, '; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - if root = WebsiteRoots[MANGAEDEN_ID, 1] then - mangaInfo.website := WebsiteRoots[MANGAEDEN_ID, 0] - else - mangaInfo.website := WebsiteRoots[PERVEDEN_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (GetTagName(parse.Strings[i]) = 'div') and - (Pos('class="mangaImage2"', parse.Strings[i]) > 0) then - begin - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i + 1], 'src='))); - if Copy(mangaInfo.coverLink, 1, 2) = '//' then - mangaInfo.coverLink := 'http:' + mangaInfo.coverLink; - end; - - // get summary - if (Pos('hr style="margin-top:0;', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 2; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get title - if ((Pos('enIcon', parse.Strings[i]) <> 0) or (Pos('itIcon', parse.Strings[i]) <> 0)) and - (mangaInfo.title = '') then - begin - mangaInfo.title := StringFilter(TrimRight(TrimLeft(parse.Strings[i + 1]))); - mangaInfo.title := GetString('~!@' + mangaInfo.title, '~!@', ' Manga'); - end; - - // get chapter name and links - if (i + 7 < parse.Count) and (Pos('class="chapterLink"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetString(parse.Strings[i], 'href="', '1/"'); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 3]))) + - ' ' + RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 7]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 1 < parse.Count) and (Pos('/?author', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 1]); - - // get artists - if (i + 1 < parse.Count) and (Pos('/?artist', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 1]); - - // get genres - if (Pos('Genres', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('/?categories', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('<br />', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if parse.Strings[i] = 'Status' then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaEden/names_and_links.inc b/baseunits/includes/MangaEden/names_and_links.inc deleted file mode 100644 index 648ca9307..000000000 --- a/baseunits/includes/MangaEden/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function MangaEdenGetNamesAndLinks(const root: String): Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), root + MANGAEDEN_BROWSER + '?page=' + - IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if ((Pos('class="openManga"', parse.Strings[i]) > 0) or - (Pos('class="closedManga"', parse.Strings[i]) > 0)) then - begin - Result := NO_ERROR; - s := TrimLeft(TrimRight(StringFilter(parse.Strings[i + 1]))); - names.Add(s); - links.Add(StringReplace(GetAttributeValue(GetTagAttribute( - parse.Strings[i], 'href=')), root, '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaEsta/image_url.inc b/baseunits/includes/MangaEsta/image_url.inc deleted file mode 100644 index 44e57b0c0..000000000 --- a/baseunits/includes/MangaEsta/image_url.inc +++ /dev/null @@ -1,43 +0,0 @@ - function GetMangaEstaImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGAESTA_ID, URL); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('addpage(''', parse.Strings[i]) > 0 then - begin - s := parse.Strings[i]; - s := StringReplace(s, 'https://', 'http://', [rfReplaceAll]); - repeat - j := Pos('addpage(''', s); - if Pos('googleusercontent', s) > 0 then - manager.container.PageLinks.Add( - EncodeUrl(GetString(s, 'addpage(''', ''','))) - else - manager.container.PageLinks.Add( - EncodeUrl(GetString(s, 'addpage(''', ');'))); - Delete(s, Pos('addpage(''', s), 16); - j := Pos('addpage(''', s); - until j = 0; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaEsta/manga_information.inc b/baseunits/includes/MangaEsta/manga_information.inc deleted file mode 100644 index d18b973d1..000000000 --- a/baseunits/includes/MangaEsta/manga_information.inc +++ /dev/null @@ -1,116 +0,0 @@ - function GetMangaEstaInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGAESTA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGAESTA_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('imageanchor="1"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'href='))); - - // get title - if (Pos('Nama :', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft(TrimRight(HTMLEntitiesFilter(parse.Strings[i + 2]))); - - if (not isExtractChapter) and (Pos('ONLINE INDONESIAN', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('href="http://www.mangaesta.net/', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[MANGAESTA_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('class=''comments''', parse.Strings[i]) > 0) then - isExtractChapter := False; - - // get summary - if (Pos('Sinopsis :', parse.Strings[i]) <> 0) then - begin - j := i + 6; - while (j < parse.Count) and (Pos('</div>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get authors - if (i + 8 < parse.Count) and (Pos('Author :', parse.Strings[i]) <> 0) then - mangaInfo.authors := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - - // get artists - if (i + 1 < parse.Count) and (Pos('Artist :', parse.Strings[i]) <> 0) then - mangaInfo.artists := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - - // get genres - if (Pos('Genre :', parse.Strings[i]) <> 0) then - begin - mangaInfo.genres := StringReplace( - StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))), ' |', ',', [rfReplaceAll]); - mangaInfo.genres := StringReplace(mangaInfo.genres, '|', ',', [rfReplaceAll]); - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status :', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaEsta/names_and_links.inc b/baseunits/includes/MangaEsta/names_and_links.inc deleted file mode 100644 index cbdbdc0c1..000000000 --- a/baseunits/includes/MangaEsta/names_and_links.inc +++ /dev/null @@ -1,40 +0,0 @@ - function MangaEstaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAESTA_ID, 1] + - MANGAESTA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="gallery-icon"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft( - TrimRight(GetAttributeValue(GetTagAttribute(parse.Strings[i + 3], 'title='))))); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute( - parse.Strings[i + 2], 'href=')), - WebsiteRoots[MANGAESTA_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaFox/chapter_page_number.inc b/baseunits/includes/MangaFox/chapter_page_number.inc deleted file mode 100644 index 7e7250359..000000000 --- a/baseunits/includes/MangaFox/chapter_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetMangaFoxPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(URL + '/1.html'); - s := FillMangaSiteHost(MANGAFOX_ID, s); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('option value="0"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 3]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaFox/directory_page_number.inc b/baseunits/includes/MangaFox/directory_page_number.inc deleted file mode 100644 index 296f2551d..000000000 --- a/baseunits/includes/MangaFox/directory_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetMangaFoxDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAFOX_ID, 1] + - MANGAFOX_BROWSER + '?az', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := parse.Count - 1 downto 0 do - begin - if (GetTagName(parse.Strings[i]) = 'span') and - (i <= parse.Count) and - (Pos('span class="next"', parse.Strings[i]) <> 0) then - begin - s := GetString(parse.Strings[i - 6], 'href="', '.htm'); - Page := StrToInt(s); - Result := NO_ERROR; - Break; - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaFox/image_url.inc b/baseunits/includes/MangaFox/image_url.inc deleted file mode 100644 index 01b575095..000000000 --- a/baseunits/includes/MangaFox/image_url.inc +++ /dev/null @@ -1,30 +0,0 @@ - function GetMangaFoxImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(URL + '/' + IntToStr(workCounter + 1) + '.html'); - s := FillMangaSiteHost(MANGAFOX_ID, s); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('onclick="return enlarge()"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaFox/manga_information.inc b/baseunits/includes/MangaFox/manga_information.inc deleted file mode 100644 index 469c5aa4a..000000000 --- a/baseunits/includes/MangaFox/manga_information.inc +++ /dev/null @@ -1,117 +0,0 @@ -function GetMangaFoxInfoFromURL: Byte; -var - i, j: Integer; - s: String; - isAvailable: Boolean = True; -begin - mangaInfo.website := WebsiteRoots[MANGAFOX_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAFOX_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count = 0 then - Exit; - - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetVal(parse[i], 'property') = 'og:title' then - mangaInfo.title := CommonStringFilter(ReplaceRegExpr( - '^(.+)\s(Manga|Manhwa)$', GetVal(parse[i], 'content'), '$1', True)); - - //cover - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = 'cover') then - mangaInfo.coverLink := CorrectURL(GetVal(parse[i + 2], 'src')); - - //author - if Pos('/search/author/', parse[i]) > 0 then - mangaInfo.authors := Trim(parse[i + 1]); - - //artist - if Pos('/search/artist/', parse[i]) > 0 then - mangaInfo.artists := Trim(parse[i + 1]); - - //genres - if (GetTagName(parse[i]) = 'td') and (GetVal(parse[i], 'valign') = 'top') then - if Pos('/genres/', parse[i + 2]) > 0 then - begin - mangaInfo.genres := ''; - for j := i + 1 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/td' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.genres := mangaInfo.genres + parse[j]; - end; - end; - - //summary - if (GetTagName(parse[i]) = 'p') and (GetVal(parse[i], 'class') = 'summary') then - begin - mangaInfo.summary := ''; - for j := i + 1 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/p' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + #13#10 + CommonStringFilter(parse[j]); - end; - end; - - //status - if GetTagName(parse[i]) = 'h5' then - if UpperCase(Trim(parse[i + 1])) = 'STATUS:' then - begin - if Pos('ONGOING', UpperCase(parse[i + 5])) > 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - - - //check if it's licensed - if GetVal(parse[i], 'class') = 'warning' then - if Pos('it is not available in', parse[i + 1]) > 0 then - begin - isAvailable := False; - mangaInfo.numChapter := 0; - mangaInfo.chapterName.Clear; - mangaInfo.chapterLinks.Clear; - end; - - //chapters - if isAvailable then - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'tips') then - begin - Inc(mangaInfo.numChapter); - s := Trim(parse[i + 1]) + ' ' + Trim(parse[i + 5]); - mangaInfo.chapterName.Add(CommonStringFilter(s)); - s := GetVal(parse[i], 'href'); - if RightStr(s, 6) = '1.html' then - SetLength(s, Length(s) - 6); - mangaInfo.chapterLinks.Add(s); - end; - end; - - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; -end; diff --git a/baseunits/includes/MangaFox/names_and_links.inc b/baseunits/includes/MangaFox/names_and_links.inc deleted file mode 100644 index c35a70393..000000000 --- a/baseunits/includes/MangaFox/names_and_links.inc +++ /dev/null @@ -1,36 +0,0 @@ - function MangaFoxGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - //if NOT GetPage(TObject(source), WebsiteRoots[MANGAFOX_ID,1] + MANGAFOX_BROWSER + IntToStr(StrToInt(URL)+1) + '.htm?az', 0) then - if not GetPage(TObject(Source), WebsiteRoots[MANGAFOX_ID, 1] + - MANGAFOX_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a ', parse[i]) > 0) and - (Pos('class="series_preview manga_', parse[i]) > 0) then - begin - Result := NO_ERROR; - links.Add(StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[MANGAFOX_ID, 1], '', [rfIgnoreCase])); - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - end; - - end; \ No newline at end of file diff --git a/baseunits/includes/MangaFrame/chapter_page_number.inc b/baseunits/includes/MangaFrame/chapter_page_number.inc deleted file mode 100644 index 129ec0307..000000000 --- a/baseunits/includes/MangaFrame/chapter_page_number.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetMangaFramePageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - isExtractPageNumber: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGAFRAME_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - l.Text := FixHTMLTagQuote(l.Text); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="tbtitle dropdown_parent dropdown_right"', parse[i]) > 0 then - isExtractPageNumber := True; - if isExtractPageNumber and (Pos('</ul', parse[i]) > 0) then - begin - isExtractPageNumber := False; - Break; - end; - if isExtractPageNumber and (Pos('<a', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/MangaFrame/directory_page_number.inc b/baseunits/includes/MangaFrame/directory_page_number.inc deleted file mode 100644 index af5ab336c..000000000 --- a/baseunits/includes/MangaFrame/directory_page_number.inc +++ /dev/null @@ -1,30 +0,0 @@ - function GetMangaFrameDirectoryPageNumber: Byte; - var - i: Integer; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAFRAME_ID, 1] + MANGAFRAME_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if i + 1 < parse.Count - 1 then - if (Pos('class="gbutton fright"', parse[i]) > 0) and (Pos('<a', parse[i]) > 0) and - (Pos('Last', parse[i + 1]) > 0) then - begin - Page := StrToIntDef(ReplaceRegExpr('^.*/(\d+)/$', Trim(GetVal(parse[i], 'href')), '$1', True), 1); - Break; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaFrame/image_url.inc b/baseunits/includes/MangaFrame/image_url.inc deleted file mode 100644 index b48f170bd..000000000 --- a/baseunits/includes/MangaFrame/image_url.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetMangaFrameImageURL: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGAFRAME_ID, URL); - if not ExecRegExpr('/$', s) then - s := s + '/'; - s := s + 'page/' + IntToStr(QWord(workCounter) + 1); - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - l.Text := FixHTMLTagQuote(l.Text); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - //if i + 2 < parse.Count - 1 then - if (Pos('class="open"', parse[i]) > 0) and (Pos('<img', parse[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := Trim(GetVal(parse[i], 'src')); - Break; - end; - parse.Free; - end; diff --git a/baseunits/includes/MangaFrame/manga_information.inc b/baseunits/includes/MangaFrame/manga_information.inc deleted file mode 100644 index 5563f098a..000000000 --- a/baseunits/includes/MangaFrame/manga_information.inc +++ /dev/null @@ -1,82 +0,0 @@ - function GetMangaFrameInfoFromURL: Byte; - var - i: Integer; - begin - mangaInfo.website := WebsiteRoots[MANGAFRAME_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAFRAME_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit(INFORMATION_NOT_FOUND); - - mangaInfo.coverLink := ''; - mangaInfo.title := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.status := '1'; - - for i := 0 to parse.Count - 1 do - begin - //cover - if (i + 2 < parse.Count - 1) then - if (Pos('class="thumbnail"', parse[i]) > 0) and (Pos('<img', parse[i + 2]) > 0) then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - //title - if (i + 1 < parse.Count - 1) then - if (Pos('class="title"', parse[i]) > 0) and (Pos('<h1', parse[i]) > 0) then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))); - - //author - if (i + 3 < parse.Count - 1) then - if (Pos('Author', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) - and (Pos('<', parse[i + 2]) = 0) then - mangaInfo.authors := Trim(TrimLeftChar(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))), [':'])); - - //artist - if (i + 3 < parse.Count - 1) then - if (Pos('Artist', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) - and (Pos('<', parse[i + 2]) = 0) then - mangaInfo.artists := Trim(TrimLeftChar(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))), [':'])); - - //synopsis - if (i + 3 < parse.Count - 1) then - if (Pos('Synopsis', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) - and (Pos('<', parse[i + 2]) = 0) then - mangaInfo.summary := Trim(TrimLeftChar(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))), [':'])); - - //chapters - if (i + 2 < parse.Count - 1) then - if (Pos('class="title"', parse[i]) > 0) and (Pos('<a', parse[i + 1]) > 0) - and (Pos('/okuyucu/read', parse[i + 1]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(Trim(StringReplace(GetVal(parse[i + 1], 'href'), WebsiteRoots[MANGAFRAME_ID, 1], '', [rfIgnoreCase]))); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))))); - end; - end; - - // invert chapters - if mangaInfo.chapterName.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaFrame/names_and_links.inc b/baseunits/includes/MangaFrame/names_and_links.inc deleted file mode 100644 index 6e186a6b3..000000000 --- a/baseunits/includes/MangaFrame/names_and_links.inc +++ /dev/null @@ -1,32 +0,0 @@ - function MangaFrameNamesAndLinks: Byte; - var - i: Integer; - s: String; - //isExtractNames: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[MANGAFRAME_ID, 1] + MANGAFRAME_BROWSER + IntToStr(StrToInt(URL) + 1) + '/'; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if i + 2 < parse.Count - 1 then - if (Pos('class="title"', parse[i]) > 0) and (Pos('<a', parse[i + 1]) > 0) and - (Pos('/okuyucu/series/', parse[i + 1]) > 0) then - begin - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))))); - links.Add(Trim(StringReplace(GetVal(parse[i + 1], 'href'), WebsiteRoots[MANGAFRAME_ID, 1], '', [rfIgnoreCase]))); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaGo/chapter_page_number.inc b/baseunits/includes/MangaGo/chapter_page_number.inc deleted file mode 100644 index 615915dfe..000000000 --- a/baseunits/includes/MangaGo/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaGoPageNumber: Boolean; - var - i: Cardinal; - s: String; - l: TStringList; - regx: TRegExpr; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGAGO_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - if Pos('total_pages=', parse.Strings[i]) > 0 then - begin - regx := TRegExpr.Create; - regx.Expression := '^.*total_pages=(\d+)\b.*$'; - manager.container.PageNumber := - StrToIntDef(regx.Replace(parse.Strings[i], '$1', True), 0); - regx.Free; - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaGo/directory_page_number.inc b/baseunits/includes/MangaGo/directory_page_number.inc deleted file mode 100644 index a6a2f75bc..000000000 --- a/baseunits/includes/MangaGo/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMangaGoDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAGO_ID, 1] + - MANGAGO_BROWSER + '1/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="pagination"', parse.Strings[i]) <> 0) then - begin - s := TrimLeft(TrimRight(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'total=')))); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaGo/image_url.inc b/baseunits/includes/MangaGo/image_url.inc deleted file mode 100644 index 81cff3c4e..000000000 --- a/baseunits/includes/MangaGo/image_url.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetMangaGoImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - regx: TRegExpr; - s: String; - begin - l := TStringList.Create; - regx := TRegExpr.Create; - regx.Expression := '^(.*/pg-)\d+/$'; - s := regx.Replace(URL, '$1', True); - //regx.Expression := '\.html?$'; - regx.Expression := '\-$'; - if (not regx.Exec(s)) and (s[Length(s)] <> '/') then - s := s + '/'; - s := FillMangaSiteHost(MANGAGO_ID, s); - Result := GetPage(TObject(l), s + IntToStr(workCounter + 1) + '/', - manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - regx.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('imgReady(''', parse[i]) > 0) then - begin - regx.Expression := '^.*imgReady\(''([^'']*)''.*$'; - manager.container.PageLinks[workCounter] := regx.Replace(parse[i], '$1', True); - Break; - end; - end; - regx.Free; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaGo/manga_information.inc b/baseunits/includes/MangaGo/manga_information.inc deleted file mode 100644 index 0ce409b32..000000000 --- a/baseunits/includes/MangaGo/manga_information.inc +++ /dev/null @@ -1,103 +0,0 @@ - function GetMangaGoInfoFromURL: Byte; - var - i: Integer; - isExtractGenres: Boolean = False; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAGO_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAGO_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get title - if (i + 3 < parse.Count - 1) then - if (Pos('name="description"', parse.Strings[i]) > 0) and (mangaInfo.title = '') then - mangaInfo.title := StringReplace(TrimLeft(StringFilter(parse.Strings[i + 3])), - ' manga - Mangago', '', []); - - // get status - if (i + 5 < parse.Count - 1) then - if (Pos('<label>', parse.Strings[i]) > 0) and - (Pos('Status:', parse.Strings[i + 1]) > 0) and - (Pos('Completed', parse.Strings[i + 5]) > 0) then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - - // get cover - if (Pos('<meta', parse.Strings[i]) > 0) and - (Pos('property="og:image"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'content='))); - - // get authors - if (i + 1 < parse.Count - 1) then - if (Pos('<label>', parse.Strings[i]) > 0) and - (Pos('Author:', parse.Strings[i + 1]) > 0) then - mangaInfo.authors := Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 5]))); - - // get genres - if (i + 1 < parse.Count - 1) then - if (Pos('<label>', parse.Strings[i]) > 0) and - (Pos('Genre(s)', parse.Strings[i + 1]) > 0) then - isExtractGenres := True; - - if (i + 1 < parse.Count - 1) then - if isExtractGenres then - begin - if Pos('</td>', parse.Strings[i]) > 0 then - isExtractGenres := False; - if Pos('/genre/', parse.Strings[i]) > 0 then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse.Strings[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse.Strings[i + 1]); - end; - end; - - // get summary - if (i + 1 < parse.Count - 1) then - if Pos('class="manga_summary"', parse.Strings[i]) > 0 then - mangaInfo.summary := Trim(HTMLEntitiesFilter(StringFilter(parse.Strings[i + 1]))); - - //get chapter links and names - if (GetTagName(parse[i]) = 'table') and - ((GetVal(parse[i], 'id') = 'chapter_table') or (GetVal(parse[i], 'id') = 'raws_table')) then - isExtractChapters := True; - if isExtractChapters then - begin - if GetTagName(parse[i]) = '/table' then - isExtractChapters := False; - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'chico') then - begin - Inc(mangaInfo.numChapter); - mangaInfo.ChapterLinks.Add(GetVal(parse[i], 'href')); - mangaInfo.ChapterName.Add(CommonStringFilter(Trim(parse[i + 1]) + ' ' + - Trim(parse[i + 3]) + ' ' + Trim(parse[i + 5]))); - end; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - InvertStrings([mangaInfo.ChapterName, mangaInfo.ChapterLinks]); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaGo/names_and_links.inc b/baseunits/includes/MangaGo/names_and_links.inc deleted file mode 100644 index 5fae35393..000000000 --- a/baseunits/includes/MangaGo/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function MangaGoGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAGO_ID, 1] + - MANGAGO_BROWSER + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('h3 class="title"', parse.Strings[i]) > 0 then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - s := StringReplace(s, WebsiteRoots[MANGAGO_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaHere/chapter_page_number.inc b/baseunits/includes/MangaHere/chapter_page_number.inc deleted file mode 100644 index 494ba9677..000000000 --- a/baseunits/includes/MangaHere/chapter_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetMangaHerePageNumber: Boolean; - var - i, j: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAHERE_ID, URL), - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if GetTagName(parse.Strings[i]) = 'option' then - begin - j := i; - while GetTagName(parse.Strings[j]) = 'option' do - begin - Inc(manager.container.pageNumber); - Inc(j, 4); - end; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaHere/image_url.inc b/baseunits/includes/MangaHere/image_url.inc deleted file mode 100644 index 95e2ef991..000000000 --- a/baseunits/includes/MangaHere/image_url.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetMangaHereImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - if workCounter > 0 then - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAHERE_ID, URL) + - IntToStr(workCounter + 1) + '.html', - manager.container.Manager.retryConnect) - else - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAHERE_ID, URL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if Pos('class="read_img"', parse.Strings[i]) <> 0 then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 4], 'src')); - parse.Free; - l.Free; - Exit; - end; - //for c:= 'a' to 'z' do - // if (Pos('http://'+c+'.mhcdn.net/store/', parse.Strings[i])<>0) then - // begin - // manager.container.PageLinks.Strings[workCounter]:= GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - // parse.Free; - // l.Free; - // exit; - // end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaHere/manga_information.inc b/baseunits/includes/MangaHere/manga_information.inc deleted file mode 100644 index 5cc5f3413..000000000 --- a/baseunits/includes/MangaHere/manga_information.inc +++ /dev/null @@ -1,100 +0,0 @@ - function GetMangaHereInfoFromURL: Byte; - var - i, j: LongInt; - isGetChapters: Boolean = False; - begin - mangaInfo.url := FillMangaSiteHost(MANGAHERE_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGAHERE_ID, 0]; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('<title>', parse[i]) > 0) then - mangaInfo.title := GetString(parse[i + 1], 'Manga - Read ', ' Online at '); - - // get cover link - if GetTagName(parse[i]) = 'img' then - if (GetAttributeValue(GetTagAttribute(parse[i], 'class=')) = 'img') then - mangaInfo.coverLink := - GetAttributeValue(GetTagAttribute(parse[i], 'src')); - - // get summary - if (Pos('id="show"', parse[i])) <> 0 then - begin - parse[i + 1] := StringFilter(parse[i + 1]); - parse[i + 1] := StringReplace(parse[i + 1], #10, '\n', [rfReplaceAll]); - parse[i + 1] := StringReplace(parse[i + 1], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := parse[i + 1]; - end; - - // get authors - if (Pos('Author(s):', parse[i]) <> 0) then - mangaInfo.authors := parse[i + 3]; - - // get artists - if (Pos('Artist(s):', parse[i]) <> 0) then - mangaInfo.artists := parse[i + 3]; - - // get genres - if (Pos('Genre(s):', parse[i]) <> 0) then - mangaInfo.genres := Trim(parse[i + 2]); - - // get status - if (Pos('Status:', parse[i]) <> 0) then - begin - if Pos('Ongoing', parse[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - if Pos('Completed', parse[i + 2]) <> 0 then - mangaInfo.status := '0'; // completed - end; - - // get chapters - if (Pos('<div', parse[i]) <> 0) and (Pos('class="detail_list', parse[i]) <> 0) then - isGetChapters := True; - if isGetChapters and (Pos('class="tab_comment clearfix', parse[i]) <> 0) then - isGetChapters := False; - if isGetChapters and - (Pos('<a', parse[i]) <> 0) and (Pos('class="color_', parse[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - for j := i + 2 to parse.Count - 1 do - begin - if (Pos('class="right', parse[j]) <> 0) or (Pos('class="new', parse[j]) <> 0) then - Break; - if Pos('<', parse[j]) = 0 then - parse[i + 1] := Trim(parse[i + 1]) + ' ' + Trim(parse[j]); - end; - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - - // invert chapters - if mangainfo.ChapterName.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaHere/names_and_links.inc b/baseunits/includes/MangaHere/names_and_links.inc deleted file mode 100644 index 25ff05685..000000000 --- a/baseunits/includes/MangaHere/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function MangaHereGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAHERE_ID, 1] + - MANGAHERE_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('manga_info', parse.Strings[i]) <> 0 then - begin - Result := NO_ERROR; - names.Add(StringFilter(GetString(parse.Strings[i], 'rel="', '" href'))); - links.Add(StringReplace(GetString(parse.Strings[i], 'href="', '">'), - WebsiteRoots[MANGAHERE_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaHost/chapter_page_number.inc b/baseunits/includes/MangaHost/chapter_page_number.inc deleted file mode 100644 index d7a29749d..000000000 --- a/baseunits/includes/MangaHost/chapter_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetMangaHostPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(MANGAHOST_ID, URL)), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('class="viewerPage', parse[i]) > 0) then - isGetPageNumber := True; - if isGetPageNumber and (Pos('</select', parse[i]) > 0) then - Break; - if isGetPageNumber and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaHost/directory_page_number.inc b/baseunits/includes/MangaHost/directory_page_number.inc deleted file mode 100644 index bd86b03ef..000000000 --- a/baseunits/includes/MangaHost/directory_page_number.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetMangaHostDirectoryPageNumber: Byte; - var - i, p: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAHOST_ID, 1] + - MANGAHOST_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - Page := 1; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('<a', parse[i]) > 0) and (Pos('class="last', parse[i]) > 0) then - begin - p := StrToIntDef(ReplaceRegExpr('^.*/(\d+)$', GetVal(parse[i], 'href'), '$1', True), 0); - if Page < p then - Page := p; - Break; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaHost/image_url.inc b/baseunits/includes/MangaHost/image_url.inc deleted file mode 100644 index 8efdacda8..000000000 --- a/baseunits/includes/MangaHost/image_url.inc +++ /dev/null @@ -1,28 +0,0 @@ - function GetMangaHostImageURL: Boolean; - var - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(MANGAHOST_ID, URL) + '/' + IntToStr(workCounter + 1)), - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) > 0) and (Pos('class="open', parse[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaHost/manga_information.inc b/baseunits/includes/MangaHost/manga_information.inc deleted file mode 100644 index d36520e2f..000000000 --- a/baseunits/includes/MangaHost/manga_information.inc +++ /dev/null @@ -1,101 +0,0 @@ - function GetMangaHostInfoFromURL: Byte; - var - i: Integer; - isExtractGenres: Boolean = False; - isExtractSummary: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAHOST_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAHOST_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - - mangaInfo.genres := ''; - mangaInfo.summary := ''; - - for i := 0 to parse.Count - 1 do - begin - //cover - if (Pos('<img', parse[i]) > 0) and (Pos('class="pull-left thumbnail', parse[i]) > 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //title - if (Pos('<h1' , parse[i]) > 0) and (Pos('class="entry-title', parse[i]) > 0) then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //author(s) - if Pos('Autor:', parse[i]) > 0 then - mangaInfo.authors := CommonStringFilter(parse[i + 2]); - - //artist(s) - if Pos('Desenho (Art):', parse[i]) > 0 then - mangaInfo.artists := CommonStringFilter(parse[i + 2]); - - //status - if Pos('Status:', parse[i]) > 0 then - if (Trim(LowerCase(parse[i + 2])) = 'completo') then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - - //genres - if Pos('Categoria(s):', parse[i]) > 0 then - isExtractGenres := True; - if isExtractGenres and (Pos('</li', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('<', parse[i]) = 0) and - (Pos('Categoria(s):', parse[i]) = 0) then - begin - parse[i] := Trim(parse[i]); - if parse[i] = ',' then - parse[i] := ', '; - mangaInfo.genres := mangaInfo.genres + parse[i]; - end; - - //summary - if (Pos('<div', parse[i]) > 0) and (Pos('id="divSpdInText', parse[i]) > 0) then - isExtractSummary := True; - if isExtractSummary and (Pos('</div', parse[i]) > 0) then - isExtractSummary := False; - if isExtractSummary then - begin - if Trim(parse[i]) = '<p>' then - mangaInfo.summary := mangaInfo.summary + LineEnding; - if (Pos('<', parse[i]) = 0) then - mangaInfo.summary := mangaInfo.summary + Trim(parse[i]); - end; - - //chapter(s) - if Pos('class="capitulo"', parse[i]) > 0 then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[MANGAHOST_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - - //invert chapter(s) - if mangaInfo.chapterLinks.Count > 1 then - begin - InvertStrings(mangaInfo.chapterLinks); - InvertStrings(mangaInfo.chapterName); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaHost/names_and_links.inc b/baseunits/includes/MangaHost/names_and_links.inc deleted file mode 100644 index 93430f0b4..000000000 --- a/baseunits/includes/MangaHost/names_and_links.inc +++ /dev/null @@ -1,36 +0,0 @@ - function MangaHostGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAHOST_ID, 1] + - MANGAHOST_BROWSER + '/page/' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) > 0) and (Pos('class="pull-left', parse[i]) > 0) and - (Pos('title=', parse[i]) > 0) then - begin - links.Add(GetVal(parse[i], 'href')); - //names.Add(CommonStringFilter(GetVal(parse[i], 'title'))); - names.Add(CommonStringFilter(parse[i + 6])); - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaInn/chapter_page_number.inc b/baseunits/includes/MangaInn/chapter_page_number.inc deleted file mode 100644 index 38450cc74..000000000 --- a/baseunits/includes/MangaInn/chapter_page_number.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetMangaInnPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAINN_ID, URL), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - for i := parse.Count - 1 downto 5 do - begin - if Pos('</select>', parse.Strings[i]) <> 0 then - begin - try - manager.container.PageNumber := StrToInt(Trim(parse.Strings[i - 3])); - except - manager.container.PageNumber := 0; - end; - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaInn/image_url.inc b/baseunits/includes/MangaInn/image_url.inc deleted file mode 100644 index 968463a0d..000000000 --- a/baseunits/includes/MangaInn/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetMangaInnImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAINN_ID, URL) + - '/page_' + IntToStr(workCounter + 1), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if GetTagName(parse.Strings[i]) = 'img' then - if GetAttributeValue(GetTagAttribute(parse.Strings[i], 'id=')) = 'imgPage' then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaInn/manga_information.inc b/baseunits/includes/MangaInn/manga_information.inc deleted file mode 100644 index ff281779a..000000000 --- a/baseunits/includes/MangaInn/manga_information.inc +++ /dev/null @@ -1,122 +0,0 @@ - function GetMangaInnInfoFromURL: Byte; - var - i, j: Cardinal; - s: String; - isExtractChapters: Boolean = False; - begin - mangaInfo.url := FillMangaSiteHost(MANGAINN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGAINN_ID, 0]; - - if parse.Count = 0 then - Exit; - - // using parser - mangaInfo.genres := ''; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i + 1], ' - Read ', ' Online For Free'); - - // get cover link - if GetTagName(parse.Strings[i]) = 'img' then - if Pos('/mangas/logos/', parse.Strings[i]) <> 0 then - mangaInfo.coverLink := - CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('Summary', parse.Strings[i])) <> 0 then - begin - j := i; - while Pos('</td>', parse.Strings[j]) = 0 do - begin - Inc(j); - if (GetTagName(parse.Strings[j]) = 'span') and - (GetTagAttribute(parse.Strings[j], 'class=') <> '') then - begin - parse.Strings[j + 1] := StringFilter(parse.Strings[j + 1]); - parse.Strings[j + 1] := - StringReplace(parse.Strings[j + 1], #10, '\n', [rfReplaceAll]); - parse.Strings[j + 1] := - StringReplace(parse.Strings[j + 1], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := Trim(parse.Strings[j + 1]); - end; - end; - end; - - // get authors - if (Pos('Author(s)', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(TrimRight(parse.Strings[i + 4])); - - // get artists - if (Pos('Artist(s)', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(TrimRight(parse.Strings[i + 4])); - - // get genres - if (Pos('class="RedHeadLabel"', parse[i]) > 0) then - if (Pos('Genre(s)', parse[i + 1]) > 0) then - if mangaInfo.genres <> '' then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 5]) - else - mangaInfo.genres := Trim(parse[i + 5]); - - // get type(genres) - if (Pos('class="RedHeadLabel"', parse[i]) > 0) then - if (Pos('Type', parse[i + 1]) > 0) then - if mangaInfo.genres <> '' then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 6]) - else - mangaInfo.genres := Trim(parse[i + 6]); - - // get status - if (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '1' // ongoing - else - if Pos('Completed', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '0'; // completed - end; - - if Pos('class="m"', parse[i]) > 0 then - if Pos('Chapter Name', parse[i + 1]) > 0 then - isExtractChapters := True; - //if isExtractChapters and - //(Pos('</table', parse[i]) > 0) then - //isExtractChapters := False; - // get chapter name and links - if isExtractChapters and - (Pos('/manga/chapter/', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - CorrectURL(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[MANGAINN_ID, 1], - '', [rfReplaceAll]))); - s := Trim(parse[i + 2]); - if Length(s) > 0 then - if s[Length(s)] = ':' then - Delete(s, Length(s), 1); - s := Trim(s); - if Trim(parse[i + 4]) <> '' then - s := s + ' ' + Trim(parse[i + 4]); - mangaInfo.chapterName.Add(Trim(StringFilter(RemoveSymbols(s)))); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaInn/names_and_links.inc b/baseunits/includes/MangaInn/names_and_links.inc deleted file mode 100644 index 677ce62b2..000000000 --- a/baseunits/includes/MangaInn/names_and_links.inc +++ /dev/null @@ -1,41 +0,0 @@ - function MangaInnGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAINN_ID, 1] + - MANGAINN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<li ', parse[i]) > 0) and - (Pos('class="mangalistItems"', parse[i]) > 0) then - begin - Result := NO_ERROR; - s := GetVal(parse[i + 1], 'href'); - s := StringReplace(s, WebsiteRoots[MANGAINN_ID, 1], '', - [rfIgnoreCase, rfReplaceAll]); - s := StringReplace(s, 'http://www.mangainn.com', '', - [rfIgnoreCase, rfReplaceAll]); - links.Add(s); - names.Add(Trim(StringFilter(parse[i + 2]))); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaKu/chapter_page_number.inc b/baseunits/includes/MangaKu/chapter_page_number.inc deleted file mode 100644 index d388e06eb..000000000 --- a/baseunits/includes/MangaKu/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetMangaKuPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAKU_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'imageanchor') = '1') then - if GetTagName(parse[i + 1]) = 'img' then - manager.container.PageLinks.Add(GetVal(parse[i + 1], 'src')); - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaKu/manga_information.inc b/baseunits/includes/MangaKu/manga_information.inc deleted file mode 100644 index 35f0923b2..000000000 --- a/baseunits/includes/MangaKu/manga_information.inc +++ /dev/null @@ -1,103 +0,0 @@ - function GetMangaKuInfoFromURL: Byte; - var - s: String; - i: Integer; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAKU_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAKU_ID, URL); - if mangaInfo.url <> '' then - if mangaInfo.url[Length(mangaInfo.url)] <> '/' then - mangaInfo.url := mangaInfo.url + '/'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - s := FixCommonBrokenHTML(Source.Text); - Source.Free; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(s); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetTagName(parse[i]) = 'title' then - begin - s := Trim(parse[i + 1]); - if s <> '' then - begin - s := StringReplace(s, '–', '-', [rfReplaceAll]); - s := StringReplace(s, 'Baca', '', [rfIgnoreCase]); - s := StringReplace(s, 'Online Komik', '', [rfIgnoreCase]); - s := StringReplace(s, 'Komik -', '', [rfIgnoreCase]); - s := StringReplace(s, 'Komik', '', [rfIgnoreCase]); - s := StringReplace(s, 'Manga -', '', [rfIgnoreCase]); - s := StringReplace(s, 'Manga', '', [rfIgnoreCase]); - s := StringReplace(s, 'Online -', '', [rfIgnoreCase]); - s := StringReplace(s, 'Terbaru', '', [rfIgnoreCase]); - s := StringReplace(s, 'Bahasa Indonesia', '', [rfIgnoreCase]); - s := TrimLeftChar(Trim(s), ['-', ':', ' ']); - mangaInfo.title := CommonStringFilter(s); - end; - end; - - //cover - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'imageanchor') = '1') then - if GetTagName(parse[i + 1]) = 'img' then - mangaInfo.coverLink := GetVal(parse[i + 1], 'src'); - - //authors/artists/genre/status - if GetTagName(parse[i]) = 'b' then - begin - if Pos('Author(s)', parse[i + 1]) > 0 then - mangaInfo.authors := CommonStringFilter(TrimLeftChar(parse[i + 3], [':'])); - if Pos('Artist(s)', parse[i + 1]) > 0then - mangaInfo.artists := CommonStringFilter(TrimLeftChar(parse[i + 3], [':'])); - if Pos('Genre', parse[i + 1]) > 0 then - mangaInfo.genres := CommonStringFilter(TrimLeftChar(parse[i + 3], [':'])); - if Pos('Episodes', parse[i + 1]) > 0 then - begin - s := Trim(TrimLeftChar(parse[i + 3], [':'])); - if LowerCase(s) = 'ongoing' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - end; - - //chapters - if (GetTagName(parse[i]) = 'div') and (Pos('-moz-border-radius', parse[i]) > 0) then - isExtractChapter := True; - if isExtractChapter then - if GetTagName(parse[i]) = '/div' then - isExtractChapter := False - else - if GetTagName(parse[i]) = 'a' then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 0 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaKu/names_and_links.inc b/baseunits/includes/MangaKu/names_and_links.inc deleted file mode 100644 index 9555930cc..000000000 --- a/baseunits/includes/MangaKu/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function MangaKuGetNamesAndLinks: Byte; - var - i: Integer; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAKU_ID, 1] + - '/daftar-komik-bahasa-indonesia/', 3) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - s := FixCommonBrokenHTML(Source.Text); - Source.Free; - - parse.Clear; - Parser := THTMLParser.Create(s); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - finally - Parser.Exec; - end; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'screenshot') then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter(parse[i + 1])); - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaLib_PL/chapter_page_number.inc b/baseunits/includes/MangaLib_PL/chapter_page_number.inc deleted file mode 100644 index 6c9ab337d..000000000 --- a/baseunits/includes/MangaLib_PL/chapter_page_number.inc +++ /dev/null @@ -1,72 +0,0 @@ - function GetMangaLib_PLPageNumber: Boolean; - var - s: String; - i: Cardinal = 0; - l: TStringList; - cf: Boolean = False; - isExtractPage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGALIB_PL_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - //check confirm - if l.Count > 0 then - begin - for i := 0 to l.Count - 1 do - begin - if (Pos('<form ', l[i]) > 0) and - (Pos('name="confirm_', l[i]) > 0) then - begin - if (Length(URL) > 1) and - (URL[1] = '/') then - s := Copy(URL, 2, Length(URL) - 1) - else - s := URL; - s := FillMangaSiteHost(MANGALIB_PL_ID, '/page/' + GetVal(l[i], 'name') + - '?backlink=' + s); - cf := True; - Break; - end; - end; - if cf then - begin - MANGALIB_PL_COOKIES := FHTTP.Cookies.Text; - l.Clear; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - end; - end; - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - manager.container.PageNumber := 0; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select ', parse[i]) > 0) and - (Pos('class="ch_page"', parse[i]) > 0) then - isExtractPage := True; - if isExtractPage and - (Pos('</select', parse[i]) > 0) then - begin - isExtractPage := False; - Break; - end; - if isExtractPage and - (Pos('<option ', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaLib_PL/image_url.inc b/baseunits/includes/MangaLib_PL/image_url.inc deleted file mode 100644 index 2964b5437..000000000 --- a/baseunits/includes/MangaLib_PL/image_url.inc +++ /dev/null @@ -1,62 +0,0 @@ - function GetMangaLib_PLImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - cf: Boolean = False; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGALIB_PL_ID, URL) + ',' + IntToStr(workCounter + 1); - - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - //check confirm - if l.Count > 0 then - begin - for i := 0 to l.Count - 1 do - begin - if (Pos('<form ', l[i]) > 0) and - (Pos('name="confirm_', l[i]) > 0) then - begin - if (Length(URL) > 1) and - (URL[1] = '/') then - s := Copy(URL, 2, Length(URL) - 1) - else - s := URL; - s := FillMangaSiteHost(MANGALIB_PL_ID, '/page/' + - GetVal(l[i], 'name') + '?backlink=' + s); - cf := True; - Break; - end; - end; - if cf then - begin - MANGALIB_PL_COOKIES := FHTTP.Cookies.Text; - l.Clear; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - end; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img ', parse[i]) > 0) and - (Pos('id="img_curr"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaLib_PL/manga_information.inc b/baseunits/includes/MangaLib_PL/manga_information.inc deleted file mode 100644 index 0c2c1cb59..000000000 --- a/baseunits/includes/MangaLib_PL/manga_information.inc +++ /dev/null @@ -1,162 +0,0 @@ - function GetMangaLib_PLInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - cf: Boolean = False; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGALIB_PL_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGALIB_PL_ID, URL); - s := mangaInfo.url; - - if not GetPage(TObject(Source), s, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - //check confirm - if Source.Count > 0 then - begin - for i := 0 to Source.Count - 1 do - begin - if (Pos('<form ', Source[i]) > 0) and - (Pos('name="confirm_', Source[i]) > 0) then - begin - if (Length(URL) > 1) and - (URL[1] = '/') then - s := Copy(URL, 2, Length(URL) - 1) - else - s := URL; - s := WebsiteRoots[MANGALIB_PL_ID, 1] + '/page/' + - GetVal(Source[i], 'name') + '?backlink=' + s; - cf := True; - Break; - end; - end; - if cf then - begin - MANGALIB_PL_COOKIES := FHTTP.Cookies.Text; - Source.Clear; - if not GetPage(TObject(Source), s, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - end; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - - //get infos - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - //get cover - if Pos('itemprop="image"', parse[i]) > 0 then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //get title - if (Pos('<strong', parse[i]) > 0) and - (Pos('itemprop="name"', parse[i]) > 0) then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))); - - //get author - if (Pos('<td', parse[i]) > 0) and - (Pos('itemprop="author"', parse[i]) > 0) then - mangaInfo.authors := - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 4])))); - - //get artist - if (Pos('<td', parse[i]) > 0) and - (Pos('itemprop="illustrator"', parse[i]) > 0) then - mangaInfo.artists := - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 4])))); - - //get summary - if Pos('itemprop="description"', parse[i]) > 0 then - mangaInfo.summary := - Trim(BreaksString(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - - //get status - if Pos('Status:', parse[i]) > 0 then - if Pos('</th', parse[i + 1]) > 0 then - if Pos('trwa', parse[i + 4]) > 0 then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - - //get genres - if Pos('Kategorie:', parse[i]) > 0 then - if Pos('</th', parse[i + 1]) > 0 then - isExtractGenres := True; - if isExtractGenres and - (Pos('</tr', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres then - begin - if Pos('<a ', parse[i]) > 0 then - if mangaInfo.genres = '' then - mangaInfo.genres := - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))) - else - mangaInfo.genres := - Trim(mangaInfo.genres + ', ' + - Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - - //get chapters - if (Pos('<table ', parse[i]) > 0) and - (Pos('class="chapters_list"', parse[i]) > 0) then - isExtractChapter := True; - if Pos('</tbody', parse[i]) > 0 then - isExtractChapter := False; - if isExtractChapter then - begin - if (Pos('<a ', parse[i]) > 0) and - (Pos('/manga/online/', parse[i]) > 0) then - if Pos('<tr', parse[i - 3]) > 0 then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[MANGALIB_PL_ID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(EncodeURL(s)); - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))); - mangaInfo.chapterName.Add(s); - end; - end; - end; - end; - - // invert chapters - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaLib_PL/names_and_links.inc b/baseunits/includes/MangaLib_PL/names_and_links.inc deleted file mode 100644 index 970c1202c..000000000 --- a/baseunits/includes/MangaLib_PL/names_and_links.inc +++ /dev/null @@ -1,33 +0,0 @@ - function MangaLib_PLGetNamesAndLinks: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGALIB_PL_ID, 1] + - MANGALIB_PL_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('itemprop="name"', parse[i]) > 0) then - begin - Result := NO_ERROR; - links.Add(StringReplace(GetVal(parse[i - 1], 'href'), - WebsiteRoots[MANGALIB_PL_ID, 1], '', [rfIgnoreCase])); - names.Add(Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1])))); - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaMint/chapter_page_number.inc b/baseunits/includes/MangaMint/chapter_page_number.inc deleted file mode 100644 index 5ff33abfb..000000000 --- a/baseunits/includes/MangaMint/chapter_page_number.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetMangaMintPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isExtractPage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - try - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(MANGAMINT_ID, URL)), - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and (GetVal(parse[i], 'name') = 'manga_page') then - isExtractPage := True; - if isExtractPage then - begin - if GetTagName(parse[i]) = '/select' then - Break - else - if GetTagName(parse[i]) = 'option' then - Inc(manager.container.PageNumber); - end; - end; - end; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/MangaMint/directory_page_number.inc b/baseunits/includes/MangaMint/directory_page_number.inc deleted file mode 100644 index 8d266c5ce..000000000 --- a/baseunits/includes/MangaMint/directory_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetMangaMintDirectoryPageNumber: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAMINT_ID, 1] + - '/directory', 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - for i := parse.Count - 1 downto 0 do - if (GetTagName(parse[i]) = 'li') and (GetVal(parse[i], 'class') = 'pager-last last') then - begin - Page := StrToIntDef( - ReplaceRegExpr('^.*\?page=(\d+)$', GetVal(parse[i + 1], 'href'), '$1', True), 1); - Break; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaMint/image_url.inc b/baseunits/includes/MangaMint/image_url.inc deleted file mode 100644 index fe4842fe0..000000000 --- a/baseunits/includes/MangaMint/image_url.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetMangaMintImageURL: Boolean; - var - s: String; - i: Integer; - l: TStringList; - isExtractImage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - try - s := FillMangaSiteHost(MANGAMINT_ID, URL); - if workCounter > 0 then - s := s + '?page=' + IntToStr(workCounter); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'id') = 'images') then - isExtractImage := True; - if isExtractImage and (GetTagName(parse[i]) = 'img') then - begin - if Pos('src =', parse[i]) > 0 then - parse[i] := StringReplace(parse[i], 'src =', 'src=', []); - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/MangaMint/manga_information.inc b/baseunits/includes/MangaMint/manga_information.inc deleted file mode 100644 index aa7436e8a..000000000 --- a/baseunits/includes/MangaMint/manga_information.inc +++ /dev/null @@ -1,141 +0,0 @@ - function GetMangaMintInfoFromURL: Byte; - var - i, j, p: Integer; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAMINT_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAMINT_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - - if parse.Count > 0 then - begin - p := 0; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetTagName(parse[i]) = 'h2' then - mangaInfo.title := CommonStringFilter( - ReplaceRegExpr('\sManga$', Trim(parse[i + 1]), '', False)); - - //cover - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'class') = 'imagefield imagefield-field_image2') then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - if GetVal(parse[i], 'class') = 'field-label' then - begin - //status - if Pos('Status:', parse[i + 1]) > 0 then - begin - if (LowerCase(Trim(parse[i + 7])) = 'complete') then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end; - - //author - if Pos('Author:', parse[i + 1]) > 0 then - mangaInfo.authors := CommonStringFilter(parse[i + 7]); - - //artits - if Pos('Artist:', parse[i + 1]) > 0 then - mangaInfo.artists := CommonStringFilter(parse[i + 7]); - - //genre - if Pos('Type:', parse[i + 1]) > 0 then - mangaInfo.genres := Trim(parse[i + 7]); - end; - - //summary - if GetTagName(parse[i]) = '/fieldset' then - if GetTagName(parse[i + 2]) = 'p' then - mangaInfo.summary := CommonStringFilter(parse[i + 3]); - - //chapters - if (GetTagName(parse[i]) = 'thead') then - isExtractChapters := True; - if isExtractChapters then - begin - if GetTagName(parse[i]) = '/tbody' then - isExtractChapters := False - else - if GetTagName(parse[i]) = 'a' then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - - //morechapterspage - if (p = 0) and - (GetTagName(parse[i]) = 'li') and (GetVal(parse[i], 'class') = 'pager-last last') then - if GetTagName(parse[i + 1]) = 'a' then - p := StrToIntDef(ReplaceRegExpr('^.*\?page=(\d+)$', GetVal(parse[i + 1], 'href'), '$1', True), 0); - end; - Result := NO_ERROR; - end; - - //fetch chapters pages - if p > 0 then - for j := 1 to p do - begin - isExtractChapters := False; - Source.Clear; - if GetPage(TObject(Source), mangaInfo.url + '?page=' + IntToStr(j), Reconnect) then - begin - parse.Clear; - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'thead') then - isExtractChapters := True; - if isExtractChapters then - begin - if GetTagName(parse[i]) = '/tbody' then - isExtractChapters := False - else - if GetTagName(parse[i]) = 'a' then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - end; - finally - Parser.Free; - end; - Result := NO_ERROR; - end - else - Result := NET_PROBLEM; - end; - - //invert chapters - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Source.Free; - end; diff --git a/baseunits/includes/MangaMint/names_and_links.inc b/baseunits/includes/MangaMint/names_and_links.inc deleted file mode 100644 index 1ad7aba98..000000000 --- a/baseunits/includes/MangaMint/names_and_links.inc +++ /dev/null @@ -1,56 +0,0 @@ - function MangaMintGetNamesAndLinks: Byte; - var - i: Integer; - isExtractNames: Boolean = False; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAMINT_ID, 1] + - '/directory?page=' + IntToStr(StrToInt(URL) + 1), 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.Expression := '\sManga$'; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'table') and (GetVal(parse[i], 'class') = 'sticky-enabled') then - isExtractNames := True; - if isExtractNames then - begin - if GetTagName(parse[i]) = '/table' then - Break - else - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'cover') then - if GetTagName(parse[i + 1]) = 'img' then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter( - regx.Replace(Trim(GetVal(parse[i + 1], 'title')), '', False))); - end; - end; - end; - finally - regx.Free; - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaOku/chapter_page_number.inc b/baseunits/includes/MangaOku/chapter_page_number.inc deleted file mode 100644 index 2101b92e1..000000000 --- a/baseunits/includes/MangaOku/chapter_page_number.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetMangaOkuPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - isExtractPage: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGAOKU_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('name="page"', parse[i]) > 0) then - isExtractPage := True; - if isExtractPage and (Pos('</select', parse[i]) > 0) then - begin - isExtractPage := False; - Break; - end; - if isExtractPage and (Pos('<option', parse[i]) > 0) then - begin - Inc(manager.container.PageNumber); - end; - end; - end; - - l.Free; - parse.Free; - end; diff --git a/baseunits/includes/MangaOku/image_url.inc b/baseunits/includes/MangaOku/image_url.inc deleted file mode 100644 index e05afbaa0..000000000 --- a/baseunits/includes/MangaOku/image_url.inc +++ /dev/null @@ -1,44 +0,0 @@ - function GetMangaOkuImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGAOKU_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(workCounter + 1) + '/'; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', parse[i]) > 0) and (Pos('id="manga_img"', parse[i]) > 0) then - begin - s := GetVal(parse[i], 'src'); - if Pos(WebsiteRoots[MANGAOKU_ID, 1], s) = 0 then - s := WebsiteRoots[MANGAOKU_ID, 1] + '/' + s; - manager.container.PageLinks[workCounter] := s; - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/MangaOku/manga_information.inc b/baseunits/includes/MangaOku/manga_information.inc deleted file mode 100644 index 0492b657f..000000000 --- a/baseunits/includes/MangaOku/manga_information.inc +++ /dev/null @@ -1,56 +0,0 @@ - function GetMangaOkuInfoFromURL: Byte; - var - s: String; - i: Cardinal; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGAOKU_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAOKU_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - - for i := 0 to parse.Count - 1 do - begin - //get chapters - if (Pos('<select', parse[i]) > 0) and (Pos('name="chapter', parse[i]) > 0) then - isExtractChapters := True; - if isExtractChapters and (Pos('</select', parse[i]) > 0) then - begin - isExtractChapters := False; - Break; - end; - if isExtractChapters and (Pos('<option', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1]))); - s := Trim(TrimChar(s, ['-'])); - mangaInfo.chapterName.Add(s); - s := TrimChar(GetVal(parse[i], 'value'), ['/']); - s := URL + s + '/'; - mangaInfo.chapterLinks.Add(s); - end; - end; - - if mangaInfo.chapterName.Count > 1 then - begin - // invert chapter - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaOku/names_and_links.inc b/baseunits/includes/MangaOku/names_and_links.inc deleted file mode 100644 index a196b60ad..000000000 --- a/baseunits/includes/MangaOku/names_and_links.inc +++ /dev/null @@ -1,51 +0,0 @@ - function MangaOkuGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - isExtractMangas: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAOKU_ID, 1] + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('name="manga"', parse[i]) > 0) then - begin - Result := NO_ERROR; - isExtractMangas := True; - end; - if isExtractMangas and (Pos('</select', parse[i]) > 0) then - begin - isExtractMangas := False; - Break; - end; - if isExtractMangas and (Pos('<option', parse[i]) > 0) then - begin - s := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1]))); - names.Add(s); - s := TrimChar(GetVal(parse[i], 'value'), ['/']); - s := '/' + s + '/'; - links.Add(s); - end; - end; - // index 0 isn't manga - if links.Count > 0 then - if links[0] = '/0/' then - begin - links.Delete(0); - names.Delete(0); - end; - end; diff --git a/baseunits/includes/MangaPanda/chapter_page_number.inc b/baseunits/includes/MangaPanda/chapter_page_number.inc deleted file mode 100644 index 68ace6b10..000000000 --- a/baseunits/includes/MangaPanda/chapter_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetMangaPandaPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAPANDA_ID, URL)); - if (Pos('.html', URL) > 0) and (Pos(SEPERATOR2, URL) > 0) then - s := StringReplace(s, SEPERATOR2, '-1/', []); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 1 to parse.Count - 1 do - begin - if (Pos(' of ', parse.Strings[i]) > 0) and - (Pos('select', parse.Strings[i - 1]) > 0) then - begin - s := GetString(parse.Strings[i] + '~!@', ' of ', '~!@'); - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaPanda/image_url.inc b/baseunits/includes/MangaPanda/image_url.inc deleted file mode 100644 index df18cef09..000000000 --- a/baseunits/includes/MangaPanda/image_url.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetMangaPandaImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - - if (Pos('.html', URL) > 0) and (Pos(SEPERATOR2, URL) > 0) then - begin - s := DecodeUrl(FillMangaSiteHost(MANGAPANDA_ID, URL)); - s := StringReplace(s, SEPERATOR2, '-' + IntToStr(workCounter + 1) + '/', []); - end - else - s := DecodeUrl(FillMangaSiteHost(MANGAPANDA_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img ', parse[i]) > 0) and - (Pos('id="img"', parse[i]) > 0) and - (Pos('name="img"', parse[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaPanda/manga_information.inc b/baseunits/includes/MangaPanda/manga_information.inc deleted file mode 100644 index f5e9440c8..000000000 --- a/baseunits/includes/MangaPanda/manga_information.inc +++ /dev/null @@ -1,113 +0,0 @@ - function GetMangaPandaInfoFromURL: Byte; - var - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - s: String; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGAPANDA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGAPANDA_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (GetTagName(parse.Strings[i]) = 'img') and - (Pos('div id="mangaimg"', parse.Strings[i - 1]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('div id="readmangasum"', parse.Strings[i]) <> 0) then - begin - j := i + 7; - mangaInfo.title := TrimLeft(StringFilter(GetString(parse.Strings[i + 3], - 'Read ', ' Manga Online'))); - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get title - // if (Pos(', Read ', parse.Strings[i])<>0) AND (mangaInfo.title = '') then - // mangaInfo.title:= TrimLeft(StringFilter(GetString(parse.Strings[i], ', Read ', ' English Scan Online'))); - - if (not isExtractChapter) and - (Pos('Chapter Name', parse.Strings[i]) > 0) and - (Pos('class="leftgap"', parse.Strings[i - 1]) > 0) then - isExtractChapter := True; - - if (isExtractChapter) and - (Pos('class="chico_manga"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetString(parse.Strings[i + 3], 'href="', '"'); - if (Pos('.html', s) > 0) and (Pos('-1/', s) > 0) then - s := StringReplace(s, '-1/', SEPERATOR2, []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 4])) + - Trim(parse.Strings[i + 6])); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Author:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and (Pos('Artist:', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 4]); - - // get genres - if (Pos('Genre:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('class="genretags"', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</tr>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 4 < parse.Count) and (Pos('Status:', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaPanda/names_and_links.inc b/baseunits/includes/MangaPanda/names_and_links.inc deleted file mode 100644 index 0ba213c74..000000000 --- a/baseunits/includes/MangaPanda/names_and_links.inc +++ /dev/null @@ -1,48 +0,0 @@ - function MangaPandaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - isExtractInfo: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAPANDA_ID, 1] + - MANGAPANDA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (not isExtractInfo) and - (Pos('ul class="series_alpha"', parse.Strings[i]) > 0) then - isExtractInfo := True; - if (isExtractInfo) and - (Pos('<li>', parse.Strings[i]) > 0) and - (Pos('<a', parse.Strings[i + 1]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href="')); - s := StringReplace(s, WebsiteRoots[MANGAPANDA_ID, 1], '', []); - links.Add(s); - end - else - if (isExtractInfo) and - (Pos('div id="wrapper_footer"', parse.Strings[i]) > 0) then - Break; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaPark/chapter_page_number.inc b/baseunits/includes/MangaPark/chapter_page_number.inc deleted file mode 100644 index 4abd2a417..000000000 --- a/baseunits/includes/MangaPark/chapter_page_number.inc +++ /dev/null @@ -1,29 +0,0 @@ - function GetMangaParkPageNumber: Boolean; - var - i: LongInt; - s: String; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := URL; - if RightStr(s, 2) = '/1' then - SetLength(s, Length(s) - 2); - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAPARK_ID, s), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) <> 0) and (Pos('id="img-', parse[i]) <> 0) then - begin - Inc(manager.container.PageNumber); - manager.container.PageLinks.Add(GetVal(parse[i], 'src')); - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaPark/directory_page_number.inc b/baseunits/includes/MangaPark/directory_page_number.inc deleted file mode 100644 index 9cedf1253..000000000 --- a/baseunits/includes/MangaPark/directory_page_number.inc +++ /dev/null @@ -1,42 +0,0 @@ - function GetMangaParkDirectoryPageNumber: Byte; - var - i: LongInt; - isExtractPage: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAPARK_ID, 1] + - '/search?orderby=add', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and (GetVal(parse[i], 'onchange') = - 'javascript:window.location.href=this.options[this.selectedIndex].value;') then - isExtractPage := True; - if isExtractPage then - begin - if GetTagName(parse[i]) = '/select' then - Break - else if GetTagName(parse[i]) = 'option' then - Inc(Page); - end; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaPark/image_url.inc b/baseunits/includes/MangaPark/image_url.inc deleted file mode 100644 index 899039e1d..000000000 --- a/baseunits/includes/MangaPark/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetMangaParkImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(MANGAPARK_ID, URL) + - 'all',//IntToStr(workCounter+1), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - // if GetTagName(parse.Strings[i]) = 'img' then - if (Pos('a target="_blank"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Add(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'href='))); - // break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaPark/manga_information.inc b/baseunits/includes/MangaPark/manga_information.inc deleted file mode 100644 index 77a06ee5a..000000000 --- a/baseunits/includes/MangaPark/manga_information.inc +++ /dev/null @@ -1,143 +0,0 @@ - function GetMangaParkInfoFromURL: Byte; - var - s, sver: String; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - i, j: Cardinal; - tnames, tlinks: TStringList; - begin - mangaInfo.website := WebsiteRoots[MANGAPARK_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAPARK_ID, URL);// + '&confirm=yes'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count > 0 then - begin - tnames:= TStringList.Create; - tlinks:= TStringList.Create; - try - sver := ''; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('property="og:title"', parse[i]) <> 0) then - begin - mangaInfo.title := CommonStringFilter(GetVal(parse[i], 'content')); - mangaInfo.title := ReplaceRegExpr('\sManga$', mangaInfo.title, '', False); - end; - - // get cover - if (GetTagName(parse.Strings[i]) = 'meta') and - (Pos('property="og:image"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'content='))); - - // get summary - if (Pos('<h2>', parse.Strings[i]) <> 0) and - (Pos('Summary', parse.Strings[i + 1]) <> 0) and - (isExtractSummary) then - begin - j := i + 3; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get chapter name and links - if (Pos('<a', parse[i]) <> 0) and (Pos('class="st st', parse[i]) <> 0) then - begin - if tlinks.Count > 0 then - begin - InvertStrings([tnames, tlinks]); - mangaInfo.chapterName.AddStrings(tnames); - mangaInfo.chapterLinks.AddStrings(tlinks); - tnames.Clear; - tlinks.Clear; - end; - sver := Trim(parse[i + 1]); - end; - if (Pos('<a', parse[i]) <> 0) and (Pos('class="ch sts sts', parse[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - s := GetVal(parse[i], 'href'); - if RightStr(s, 2) = '/1' then - SetLength(s, Length(s) - 2); - tlinks.Add(s); - tnames.Add(CommonStringFilter( - Format('%s %s %s', [sver, Trim(parse[i + 1]), Trim(parse[i + 3])]))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Author(s)', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 6]); - - // get artists - if (i + 4 < parse.Count) and (Pos('Artist(s)', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 6]); - - // get genres - if (Pos('Genre(s)', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if Pos('/genre/', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</td>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - finally - if tlinks.Count > 0 then - begin - InvertStrings([tnames, tlinks]); - mangaInfo.chapterName.AddStrings(tnames); - mangaInfo.chapterLinks.AddStrings(tlinks); - end; - tnames.Free; - tlinks.Free; - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaPark/names_and_links.inc b/baseunits/includes/MangaPark/names_and_links.inc deleted file mode 100644 index 20422d78f..000000000 --- a/baseunits/includes/MangaPark/names_and_links.inc +++ /dev/null @@ -1,34 +0,0 @@ - function MangaParkGetNamesAndLinks: Byte; - var - i: LongInt; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAPARK_ID, 1] + - '/search?orderby=add&page=' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'em') and (GetVal(parse[i], 'class') = 'icon') then - begin - links.Add(GetVal(parse[i + 3], 'href')); - names.Add(CommonStringFilter(GetVal(parse[i + 3], 'title'))); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaREADER_POR/image_url.inc b/baseunits/includes/MangaREADER_POR/image_url.inc deleted file mode 100644 index 5573a0124..000000000 --- a/baseunits/includes/MangaREADER_POR/image_url.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetMangaREADER_PORImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAREADER_POR_ID, URL) + '/#1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - manager.container.pageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('function Proxima()', parse.Strings[i]) > 0 then - begin - //s:= GetString(parse.Strings[i], 'new Array("",', 'function Proxima'); - s := GetString(parse.Strings[i], 'new Array("",', ');'); - s := StringReplace(s, sLineBreak, '', [rfReplaceAll]); - manager.container.PageLinks.DelimitedText := s; - Break; - //repeat - // j:= Pos('http://', s); - // manager.container.PageLinks.Add(EncodeURL(GetString(s, '"', '"'))); - // s:= StringReplace(s, '"', '', []); - // s:= StringReplace(s, '"', '', []); - // Delete(s, j, 7); - // j:= Pos('http://', s); - //until j = 0; - end; - end; - end; - - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaREADER_POR/manga_information.inc b/baseunits/includes/MangaREADER_POR/manga_information.inc deleted file mode 100644 index d2c004db0..000000000 --- a/baseunits/includes/MangaREADER_POR/manga_information.inc +++ /dev/null @@ -1,191 +0,0 @@ - function GetMangaREADER_PORInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j, n: Cardinal; - numberOfPage: Cardinal = 1; - - procedure ExtractChapter; - begin - if (not isExtractChapter) and (Pos('id="listagemCaps', parse.Strings[i]) > 0) then - isExtractChapter := True; - - if (isExtractChapter) and - (Pos('paginacao', parse.Strings[i]) > 0) then - isExtractChapter := False; //bermasalah - - // get chapter name and links - if (isExtractChapter) and - (Pos('</em>', parse.Strings[i]) > 0) and - (i + 6 < parse.Count - 1) then - begin - Inc(mangaInfo.numChapter); - //s:= StringReplace(GetString(parse.Strings[i+6], 'href="', '"'), WebsiteRoots[MANGAREADER_POR_ID,1], '', []); - //mangaInfo.chapterLinks.Add(s); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 6], 'href')); - s := StringReplace(s, WebsiteRoots[MANGAREADER_POR_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - end; - - begin - mangaInfo.url := FillMangaSiteHost(MANGAREADER_POR_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - //weird stuff - if Source.Count > 1 then - Source.Text := StringReplace(Source.Text, '<3', '❤', [rfReplaceAll, rfIgnoreCase]); - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - mangaInfo.website := WebsiteRoots[MANGAREADER_POR_ID, 0]; - mangaInfo.status := '0'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - - isExtractChapter := False; - for i := 0 to parse.Count - 1 do - begin - // Get number of page. - if Pos('Última Página', parse.Strings[i]) > 0 then - numberOfPage := StrToInt(GetString(parse.Strings[i - 1], '/page/', '">')); - - // get cover - //if (mangaInfo.coverLink='') AND - // (Pos('img src="', parse.Strings[i])>0) AND - // (Pos('class="imgClass"', parse.Strings[i])>0) then - // mangaInfo.coverLink:=GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src')); - - {if (mangaInfo.coverLink = '') AND - (Pos('class="cvr', parse.Strings[i])>0) then - mangaInfo.coverLink:= CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')));} - - // get title - if (Pos('Título:', parse.Strings[i]) > 0) then - mangaInfo.title := parse.Strings[i + 2]; - - ExtractChapter; - - //Not available - // get summary - //if (Pos('class="text', parse.Strings[i]) <> 0) then - //begin - // j:= i+9; - // while (j<parse.Count) AND (Pos('</div>', parse.Strings[j])=0) do - // begin - // s:= parse.Strings[j]; - // if s[1] <> '<' then - // begin - // parse.Strings[j]:= HTMLEntitiesFilter(StringFilter(TrimLeft(parse.Strings[j]))); - // parse.Strings[j]:= StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - // parse.Strings[j]:= StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - // mangaInfo.summary:= mangaInfo.summary + parse.Strings[j]; - // break; - // end; - // Inc(j); - // end; - // isExtractSummary:= FALSE; - //end; - - // get authors - if (Pos('Autor:', parse.Strings[i]) > 0) then - mangaInfo.authors := Trim(StringFilter(parse.Strings[i + 2])); - - // get artists - if (Pos('Artista:', parse.Strings[i]) > 0) then - mangaInfo.artists := Trim(StringFilter(parse.Strings[i + 2])); - - // get genres - if Pos('Categoria:', parse.Strings[i]) > 0 then - mangaInfo.genres := parse.Strings[i + 4]; - //if (Pos('class="cat', parse.Strings[i])<>0) then - //begin - // isExtractGenres:= TRUE; - //end; - - //if isExtractGenres then - //begin - // if Pos('', parse.Strings[i]) <> 0 then - // mangaInfo.genres:= mangaInfo.genres + TrimLeft(TrimRight(parse.Strings[i+1])) + ', '; - // if Pos('</br>', parse.Strings[i]) <> 0 then - // isExtractGenres:= FALSE; - //end; - - // not available - // get status - //if (i+2<parse.Count) AND (Pos('Status', parse.Strings[i])<>0) then - //begin - // if Pos('Ongoing', parse.Strings[i+3])<>0 then - // mangaInfo.status:= '1' // ongoing - // else - // mangaInfo.status:= '0'; // completed - //end; - end; - - // If there're more than 1 page, we need to continue to scrape for chapters ... - if numberOfPage > 1 then - begin - for n := 2 to numberOfPage do - begin - Source.Clear; - s := mangaInfo.url + '/' + IntToStr(n); - if not GetPage(TObject(Source), mangaInfo.url + '/page/' + - IntToStr(n), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - //weird stuff - if Source.Count > 1 then - Source.Text := StringReplace(Source.Text, '<3', '❤', [rfReplaceAll, rfIgnoreCase]); - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - isExtractChapter := False; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - ExtractChapter; - end; - end; - Source.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaREADER_POR/names_and_links.inc b/baseunits/includes/MangaREADER_POR/names_and_links.inc deleted file mode 100644 index 9774236ed..000000000 --- a/baseunits/includes/MangaREADER_POR/names_and_links.inc +++ /dev/null @@ -1,51 +0,0 @@ - function MangaREADER_PORGetNamesAndLinks: Byte; - var - i: LongInt; - s: String; - parser: TJSONParser; - Data: TJSONData; - jobject: TJSONObject; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(source), - WebsiteRoots[MANGAREADER_POR_ID, 1] + '/AJAX/listaMangas/all', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - //UTF8BOM:string=#$EF#$BB#$BF - //Remove BOM header, jsonparser can't deal with BOM - s := Source.Text; - if Length(s) > 3 then - begin - if Copy(s, 1, 3) = UTF8BOM then - Delete(s, 1, 3); - end; - parser := TJSONParser.Create(s); - try - Data := parser.Parse; - try - if Assigned(Data) then - begin - if Data.JSONType = jtArray then - begin - for i := 0 to Data.Count - 1 do - begin - jobject := TJSONObject(Data.Items[i]); - names.Add(jobject.Strings['title']); - links.Add(StringReplace(jobject.Strings['serie_url'], - WebsiteRoots[MANGAREADER_POR_ID, 1], '', [])); - end; - end; - end; - finally - Data.Free; - end; - finally - parser.Free; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaReader/chapter_page_number.inc b/baseunits/includes/MangaReader/chapter_page_number.inc deleted file mode 100644 index d10218e21..000000000 --- a/baseunits/includes/MangaReader/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaReaderPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGAREADER_ID, URL); - Result := GetPage(TObject(l), s, manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('</select>', parse.Strings[i]) > 0) and - (Pos('</div>', parse.Strings[i + 2]) > 0) then - begin - s := parse.Strings[i + 1]; - Delete(s, Pos(' of ', s), 4); - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaReader/image_url.inc b/baseunits/includes/MangaReader/image_url.inc deleted file mode 100644 index 76d5205c4..000000000 --- a/baseunits/includes/MangaReader/image_url.inc +++ /dev/null @@ -1,78 +0,0 @@ - function GetMangaReaderImageURL: Boolean; - var - realURL: String; - i: Cardinal; - l: TStringList; - - procedure BreakURL; - var - isSlashed: Boolean = False; - i, oldI: Cardinal; - begin - if Pos('.html', URL) = 0 then - begin - realURL := URL + '/' + IntToStr(workCounter + 1); - Exit; - end; - i := 2; - realURL := '/'; - while i <= Length(URL) do - begin - if (not isSlashed) and (URL[i] = '/') then - begin - isSlashed := True; - oldI := i; - for i := i - 1 downto 1 do - begin - if URL[i] <> '-' then - begin - SetLength(realURL, Length(realURL) - 1); - end - else - begin - realURL := realURL + IntToStr(workCounter + 1); - Break; - end; - end; - i := oldI; - // realURL:= realURL + '/'; - end - else - begin - realURL := realURL + URL[i]; - Inc(i); - end; - end; - end; - - begin - l := TStringList.Create; - BreakURL; - Result := GetPage(TObject(l), FillMangaSiteHost(MANGAREADER_ID, realURL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - // manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if GetTagName(parse.Strings[i]) = 'img' then - begin - if //(Pos(realURL, parse.Strings[i])>0) AND - (Pos('alt=', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaReader/manga_information.inc b/baseunits/includes/MangaReader/manga_information.inc deleted file mode 100644 index 598b18072..000000000 --- a/baseunits/includes/MangaReader/manga_information.inc +++ /dev/null @@ -1,120 +0,0 @@ - function GetMangaReaderInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[MANGAREADER_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGAREADER_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('<title>', parse.Strings[i]) > 0) then - mangaInfo.title := TrimLeft(TrimRight(GetString(parse.Strings[i + 1], - ' Manga - Read ', ' Online For '))); - - // get cover - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('alt=', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('<h2>', parse.Strings[i]) <> 0) and - (Pos('Read ', parse.Strings[i + 1]) <> 0) and - (isExtractSummary) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // allow get chapter name and links - if (Pos('Chapter Name', parse.Strings[i]) > 0) and - (Pos('leftgap', parse.Strings[i - 1]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (i + 1 < parse.Count) and - (isExtractChapter) and - (Pos('<a href=', parse.Strings[i]) > 0) and - (Pos(' : ', parse.Strings[i + 3]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - EncodeUrl(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')))); - parse.Strings[i + 1] := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))) + - RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 3]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(parse.Strings[i + 1]))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Author:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and (Pos('Artist:', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 4]); - - // get genres - if (Pos('Genre:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if Pos('"genretags"', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</tr>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status:', parse.Strings[i]) <> 0) then - begin - if (Pos('Ongoing', parse.Strings[i + 2]) <> 0) or - (Pos('Ongoing', parse.Strings[i + 4]) <> 0) then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaReader/names_and_links.inc b/baseunits/includes/MangaReader/names_and_links.inc deleted file mode 100644 index d46c9b9b4..000000000 --- a/baseunits/includes/MangaReader/names_and_links.inc +++ /dev/null @@ -1,43 +0,0 @@ - function MangaReaderGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAREADER_ID, 1] + - MANGAREADER_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<li>', parse.Strings[i]) > 0) and - (Pos('</a>', parse.Strings[i + 3]) > 0) and - (Length(GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href='))) > - 2) then - begin - Result := NO_ERROR; - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - links.Add(s); - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - names.Add(HTMLEntitiesFilter(s)); - end; - if Pos('Network', parse.Strings[i]) > 0 then - Break; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaSee/chapter_page_number.inc b/baseunits/includes/MangaSee/chapter_page_number.inc deleted file mode 100644 index 1c6e61c82..000000000 --- a/baseunits/includes/MangaSee/chapter_page_number.inc +++ /dev/null @@ -1,41 +0,0 @@ - function GetMangaSeePageNumber: Boolean; - var - s: String; - i: LongInt; - l: TStringList; - regx: TRegExpr; - begin - l := TStringList.Create; - - s := DecodeUrl(URL); - if RightStr(s, 7) = '&page=1' then - SetLength(s, Length(s) - 7); - s := FillMangaSiteHost(manager.container.MangaSiteID, s); - - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.Expression := '^.*src="([^"]+)".*$'; - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) <> 0) and (Pos('this.onerror=null', parse[i]) <> 0) then - begin - Inc(manager.container.PageNumber); - manager.container.PageLinks.Add(regx.Replace(parse[i], '$1', True)); - end; - finally - regx.Free; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaSee/directory_page_number.inc b/baseunits/includes/MangaSee/directory_page_number.inc deleted file mode 100644 index 33bddf35a..000000000 --- a/baseunits/includes/MangaSee/directory_page_number.inc +++ /dev/null @@ -1,6 +0,0 @@ - function GetMangaSeeDirectoryPageNumber: Byte; - begin - Source.Free; - Result := NO_ERROR; - Page := 27; //# to Z - end; diff --git a/baseunits/includes/MangaSee/manga_information.inc b/baseunits/includes/MangaSee/manga_information.inc deleted file mode 100644 index 03928679e..000000000 --- a/baseunits/includes/MangaSee/manga_information.inc +++ /dev/null @@ -1,102 +0,0 @@ - function GetMangaSeeInfoFromURL: Byte; - var - i: LongInt; - s: String; - isExtractGenres : Boolean = False; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGASEE_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGASEE_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.genres := ''; - - if parse.Count = 0 then - Exit; - - for i := 0 to parse.Count - 1 do - begin - //title - if Pos('<h1', parse[i]) <> 0 then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //cover - if (Pos('<img', parse[i]) <> 0) and (Pos('/cover/', parse[i]) <> 0) then - mangaInfo.coverLink := GetMangaSiteRoot(MANGASEE_ID) + TrimLeftChar(GetVal(parse[i], 'src'), ['.']); - - if i + 2 < parse.Count - 1 then - if Pos('</b', parse[i + 1]) <> 0 then - begin - //author - if (Pos('Author:', parse[i]) <> 0) then - mangaInfo.authors := CommonStringFilter(parse[i + 3]); - - //status - if (Pos('Scanlation Status:', parse[i]) <> 0) then - if Trim(LowerCase(parse[i + 2])) = 'ongoing' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - - //summary - if (Pos('Description:', parse[i]) <> 0) then - mangaInfo.summary := CommonStringFilter(parse[i + 4]); - - //genres - if (Pos('Genre:', parse[i]) <> 0) then - isExtractGenres := True; - end; - - //genres - if isExtractGenres and (Pos('</div', parse[i]) <> 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('<a', parse[i]) <> 0) then - if (Pos('<', parse[i + 1]) = 0) then - if mangaInfo.genres = '' then - mangaInfo.genres := parse[i + 1] - else - mangaInfo.genres := mangaInfo.genres + ', ' + parse[i + 1]; - - //chapters - if (not isExtractChapters) and (Pos('<!--Chapter Row-->', parse[i]) <> 0) then - isExtractChapters := True; - if isExtractChapters and (Pos('<!-- Divider -->', parse[i]) <> 0) then - Break; - if isExtractChapters and - (Pos('<a', parse[i]) <> 0) and (Pos('chapter_link', parse[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - s := TrimLeftChar(GetVal(parse[i], 'href'), ['.']); - if RightStr(s, 7) = '&page=1' then - SetLength(s, Length(s) - 7); - mangaInfo.chapterLinks.Add(s); - s := Trim(parse[i + 1]); - if Pos('<gray', parse[i + 3]) <> 0 then - s := s + ' ' + Trim(parse[i + 4]); - mangaInfo.chapterName.Add(CommonStringFilter(s)); - end; - end; - - //invert - if mangainfo.ChapterLinks.Count > 1 then - begin - InvertStrings(mangaInfo.chapterLinks); - InvertStrings(mangaInfo.chapterName); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaSee/names_and_links.inc b/baseunits/includes/MangaSee/names_and_links.inc deleted file mode 100644 index 678f340d8..000000000 --- a/baseunits/includes/MangaSee/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function MangaSeeGetNamesAndLinks: Byte; - var - i: LongInt; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[MANGASEE_ID, 1] + '/directory.php'; - i := StrToIntDef(URL, 0); - if i > 0 then - s := s + '?c=' + chr(i + 64); - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (Pos('<a', parse[i]) <> 0) and (Pos('id=', parse[i]) <> 0) and - (GetVal(parse[i], 'class') = 'directory_link') then - begin - s := GetVal(parse[i], 'href'); - s := TrimLeftChar(s, ['.']); - links.Add(s); - names.Add(CommonStringFilter(parse[i + 1])); - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/MangaStream/chapter_page_number.inc b/baseunits/includes/MangaStream/chapter_page_number.inc deleted file mode 100644 index 8dea08457..000000000 --- a/baseunits/includes/MangaStream/chapter_page_number.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetMangaStreamPageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGASTREAM_ID, URL); - if RightStr(s, 2) = '/1' then - s := ReplaceRegExpr('(/\d+)/1$', s, '$1', True); - Result := GetPage(TObject(l), - s + '/1', - manager.container.manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free - end; - - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - if Pos('Last Page (', parse[i]) > 0 then - begin - manager.container.PageNumber := StrToIntDef(ReplaceRegExpr( - '^.*Last\s*Page\s*\((\d+)\).*$', parse[i], '$1', True), 1); - Break; - end; - end; - - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaStream/image_url.inc b/baseunits/includes/MangaStream/image_url.inc deleted file mode 100644 index d29829c84..000000000 --- a/baseunits/includes/MangaStream/image_url.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMangaStreamImageURL: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - s := URL; - if Pos('http', LowerCase(s)) <> 1 then - s := MANGASTREAM_ROOT2 + s; - if RightStr(s, 2) = '/1' then - s := ReplaceRegExpr('(/\d+)/1$', s, '$1', True); - s := s + '/' + IntToStr(QWord(workCounter) + 1); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - parse := TStringList.Create; - try - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and (GetVal(parse[i], 'id') = 'manga-page') then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaStream/manga_information.inc b/baseunits/includes/MangaStream/manga_information.inc deleted file mode 100644 index 781e2a0f2..000000000 --- a/baseunits/includes/MangaStream/manga_information.inc +++ /dev/null @@ -1,65 +0,0 @@ - function GetMangaStreamInfoFromURL: Byte; - var - i: Integer; - s: String; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MANGASTREAM_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGASTREAM_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.status := '1'; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if GetTagName(parse[i]) = 'h1' then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //chapters - if (GetTagName(parse[i]) = 'table') and (GetVal(parse[i], 'class') = 'table table-striped') then - isExtractChapter := True; - if isExtractChapter then - begin - if GetTagName(parse[i]) = '/table' then - Break - else - if GetTagName(parse[i]) = 'a' then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterName.Add(parse[i + 1]); - s := GetVal(parse[i], 'href'); - if Pos('http', LowerCase(s)) <> 1 then - s := MANGASTREAM_ROOT2 + s; - if RightStr(s, 2) = '/1' then - s := ReplaceRegExpr('(/\d+)/1$', s, '$1', True); - mangaInfo.chapterLinks.Add(s); - end; - end; - end; - - // invert chapters - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaStream/names_and_links.inc b/baseunits/includes/MangaStream/names_and_links.inc deleted file mode 100644 index d6c2602a9..000000000 --- a/baseunits/includes/MangaStream/names_and_links.inc +++ /dev/null @@ -1,43 +0,0 @@ - function MangaStreamGetNamesAndLinks: Byte; - var - i: Integer; - isExtractNames: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), MANGASTREAM_ROOT + '/manga', 3) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'table') and (GetVal(parse[i], 'class') = 'table table-striped') then - isExtractNames := True; - if isExtractNames then - begin - if GetTagName(parse[i]) = '/table' then - Break - else - if GetTagName(parse[i]) = 'a' then - if GetVal(parse[i], 'class') <> 'chapter-link' then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter(parse[i + 1])); - end; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaStreamTo/chapter_page_number.inc b/baseunits/includes/MangaStreamTo/chapter_page_number.inc deleted file mode 100644 index 2c66f08c6..000000000 --- a/baseunits/includes/MangaStreamTo/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMangaStreamToPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGASTREAMTO_ID, URL); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := parse.Count - 1 downto 0 do - begin - if (Pos('option value=', parse.Strings[i]) > 0) then - begin - try - manager.container.PageNumber := - StrToInt(Trim(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')))); - except - manager.container.PageNumber := 0; - end; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaStreamTo/image_url.inc b/baseunits/includes/MangaStreamTo/image_url.inc deleted file mode 100644 index fe22e4b96..000000000 --- a/baseunits/includes/MangaStreamTo/image_url.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaStreamToImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := StringReplace(URL, '.html', '', []); - s := s + '-page-' + IntToStr(workCounter + 1) + '.html'; - s := FillMangaSiteHost(MANGASTREAMTO_ID, s); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="manga-page"', parse.Strings[i]) > 0) and - (Pos('<img', parse.Strings[i]) > 0) then - begin - if not Terminated then - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaStreamTo/manga_information.inc b/baseunits/includes/MangaStreamTo/manga_information.inc deleted file mode 100644 index cf139cb6c..000000000 --- a/baseunits/includes/MangaStreamTo/manga_information.inc +++ /dev/null @@ -1,57 +0,0 @@ - function GetMangaStreamToInfoFromURL: Byte; - var - isExtractChapter: Boolean = False; - i: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGASTREAMTO_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGASTREAMTO_ID, 0]; - - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.status := ''; - - if parse.Count = 0 then - Exit; - - // mangastream.to only has chapter list - - // get current_topic - for i := 0 to parse.Count - 1 do - begin - //title - if Pos('<h1>', parse[i]) > 0 then - if Pos('</h1>', parse[i + 2]) > 0 then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))); - - //names and links - if (Pos('<td ', parse[i]) > 0) and (Pos('class="ch-subject"', parse[i]) > 0) then - isExtractChapter := True; - if isExtractChapter and (Pos('</td', parse[i]) > 0) then - isExtractChapter := False; - if isExtractChapter and (Pos('<a ', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(Trim(GetVal(parse[i], 'href'))); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaStreamTo/names_and_links.inc b/baseunits/includes/MangaStreamTo/names_and_links.inc deleted file mode 100644 index c8e7f4d5a..000000000 --- a/baseunits/includes/MangaStreamTo/names_and_links.inc +++ /dev/null @@ -1,40 +0,0 @@ - function MangaStreamToGetNamesAndLinks: Byte; - var - i: Cardinal; - isExtractNamesAndLinks: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGASTREAMTO_ID, 1] + - MANGASTREAMTO_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (Pos('<table', parse.Strings[i]) > 0) and - (Pos('id="page-list"', parse.Strings[i]) > 0) then - isExtractNamesAndLinks := True; - - if isExtractNamesAndLinks and - (Pos('</table', parse.Strings[i]) > 0) then - isExtractNamesAndLinks := False; - - if isExtractNamesAndLinks and - (Pos('href="/', parse.Strings[i]) > 0) then - begin - names.Add(HTMLEntitiesFilter(StringFilter(Trim(parse.Strings[i + 1])))); - links.Add(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href='))); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangaTown/chapter_page_number.inc b/baseunits/includes/MangaTown/chapter_page_number.inc deleted file mode 100644 index 74995897a..000000000 --- a/baseunits/includes/MangaTown/chapter_page_number.inc +++ /dev/null @@ -1,40 +0,0 @@ - function GetMangaTownPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - isExtractPage: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGATOWN_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and - (Pos('onchange="javascript:location.href=this.value;"', parse[i]) > 0) then - isExtractPage := True; - if isExtractPage and - (Pos('</select', parse[i]) > 0) then - begin - isExtractPage := False; - Break; - end; - if isExtractPage and - (Pos('<option', parse[i]) > 0) then - begin - Inc(manager.container.PageNumber); - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/MangaTown/directory_page_number.inc b/baseunits/includes/MangaTown/directory_page_number.inc deleted file mode 100644 index 7e9f6db10..000000000 --- a/baseunits/includes/MangaTown/directory_page_number.inc +++ /dev/null @@ -1,41 +0,0 @@ - function GetMangaTownDirectoryPageNumber: Byte; - var - i: Cardinal; - isExtractPage: Boolean = False; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGATOWN_ID, 1] + - MANGATOWN_BROWSER + '?name.az', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('<select onchange="javascript:location.href=this.value;">', parse[i]) > 0 then - isExtractPage := True; - if isExtractPage and - (Pos('</select', parse[i]) > 0) then - isExtractPage := False; - if isExtractPage and - (Pos('<option', parse[i]) > 0) then - begin - Inc(Page); - Result := NO_ERROR; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaTown/image_url.inc b/baseunits/includes/MangaTown/image_url.inc deleted file mode 100644 index 8293fdff2..000000000 --- a/baseunits/includes/MangaTown/image_url.inc +++ /dev/null @@ -1,41 +0,0 @@ - function GetMangaTownImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGATOWN_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(workCounter + 1) + '.html'; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', parse[i]) > 0) and (Pos('onerror=', parse[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/MangaTown/manga_information.inc b/baseunits/includes/MangaTown/manga_information.inc deleted file mode 100644 index f88fa57a9..000000000 --- a/baseunits/includes/MangaTown/manga_information.inc +++ /dev/null @@ -1,109 +0,0 @@ - function GetMangaTownInfoFromURL: Byte; - var - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - s: String; - i: Cardinal; - begin - mangaInfo.website := WebsiteRoots[MANGATOWN_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGATOWN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - - mangaInfo.genres := ''; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (i + 2 < parse.Count - 1) then - if (Pos('class="detail_info clearfix"', parse[i]) > 0) and (Pos('<img', parse[i + 2]) > 0) then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - // get title - if (i + 1 < parse.Count - 1) then - if (Pos('class="title-top"', parse.Strings[i]) > 0) and (mangaInfo.title = '') then - mangaInfo.title := Trim(StringFilter(parse[i + 1])); - - // get genres - if (i + 1 < parse.Count - 1) then - if ((Pos('Demographic:', parse[i]) > 0) or (Pos('Genre(s):', parse[i]) > 0)) and - (Pos('</b', parse[i + 1]) > 0) then - isExtractGenres := True; - if isExtractGenres and - (Pos('</li', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('<a ', parse[i]) > 0) then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]); - if (i + 3 < parse.Count - 1) then - if (Pos('Type:', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 3]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 3]); - end; - - // get authors - if (i + 3 < parse.Count - 1) then - if (Pos('Author(s):', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - mangaInfo.authors := Trim(parse[i + 3]); - if Pos(';', mangaInfo.authors) > 0 then - begin - mangaInfo.authors := StringReplace(mangaInfo.authors, ' ; ', ', ', [rfReplaceAll]); - mangaInfo.authors := StringReplace(mangaInfo.authors, '; ', ', ', [rfReplaceAll]); - end; - end; - - // get summary - if (i + 1 < parse.Count - 1) then - if (Pos('<span', parse.Strings[i]) > 0) and (Pos('id="show"', parse[i]) > 0) then - mangaInfo.summary := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1]))); - - //get chapter links and names - if (Pos('<ul', parse[i]) > 0) and - (Pos('class="chapter_list"', parse[i]) > 0) then - isExtractChapter := True; - if isExtractChapter and (Pos('</ul', parse[i]) > 0) then - isExtractChapter := False; - if isExtractChapter and - (i + 9 < parse.Count - 1) then - if (Pos('<a ', parse[i]) > 0) then - begin - s := GetVal(parse[i], 'href'); - s := StringReplace(s, WebsiteRoots[MANGATOWN_ID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - s := Trim(RemoveSymbols(parse[i + 1])); - //if Pos('class="', parse[i + 4]) = 0 then - if Pos('<span>', parse[i + 4]) > 0 then - s := s + ' ' + Trim(RemoveSymbols(parse[i + 5])); - //if Pos('class="', parse[i + 8]) = 0 then - if Pos('<span>', parse[i + 8]) > 0 then - s := s + ' ' + Trim(RemoveSymbols(parse[i + 9])); - mangaInfo.chapterName.Add(Trim(s)); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaTown/names_and_links.inc b/baseunits/includes/MangaTown/names_and_links.inc deleted file mode 100644 index a03e72055..000000000 --- a/baseunits/includes/MangaTown/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function MangaTownGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGATOWN_ID, 1] + - MANGATOWN_BROWSER + IntToStr(StrToInt(URL) + 1) + '.htm?name.az', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<P class="title"', parse[i]) > 0) and - (i + 2 < parse.Count - 1) then - begin - Result := NO_ERROR; - s := Trim(HTMLEntitiesFilter(StringFilter(GetVal(parse[i + 2], 'title')))); - names.Add(s); - s := GetVal(parse[i + 2], 'href'); - s := StringReplace(s, WebsiteRoots[MANGATOWN_ID, 1], '', [rfIgnoreCase]); - links.Add(s); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaTraders/chapter_page_number.inc b/baseunits/includes/MangaTraders/chapter_page_number.inc deleted file mode 100644 index d72c58f55..000000000 --- a/baseunits/includes/MangaTraders/chapter_page_number.inc +++ /dev/null @@ -1,36 +0,0 @@ - function GetMangaTradersPageNumber: Boolean; - var - isGetPageNumber: Boolean = False; - i: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MANGATRADERS_ID, URL); - s := s + '/page-1'; - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if Pos('<select', parse[i]) > 0 then - isGetPageNumber := True; - if isGetPageNumber and (Pos('</select', parse[i]) > 0) then - begin - isGetPageNumber := False; - Break; - end; - if isGetPageNumber and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaTraders/image_url.inc b/baseunits/includes/MangaTraders/image_url.inc deleted file mode 100644 index fd18e51de..000000000 --- a/baseunits/includes/MangaTraders/image_url.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaTradersImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGATRADERS_ID, URL); - s := s + '/page-' + IntToStr(workCounter + 1); - Result := GetPage(TObject(l), s, manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) > 0) and (Pos('onerror=', parse[i]) > 0) then - begin - //fix line - parse[i] := RemoveBreaks(parse[i]); - if Pos(#9, parse[i]) > 0 then - parse[i] := StringReplace(parse[i], #9, ' ', [rfReplaceAll, rfIgnoreCase]); - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaTraders/manga_information.inc b/baseunits/includes/MangaTraders/manga_information.inc deleted file mode 100644 index 6e6dfde63..000000000 --- a/baseunits/includes/MangaTraders/manga_information.inc +++ /dev/null @@ -1,112 +0,0 @@ - function GetMangaTradersInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - i: Integer; - regx: TRegExpr; - begin - mangaInfo.website := WebsiteRoots[MANGATRADERS_ID, 0]; - // fixing url - mangaInfo.url := FillMangaSiteHost(MANGATRADERS_ID, URL); - regx := TRegExpr.Create; - try - regx.Expression := '\/manga\/\?series\=(.*)$'; - if regx.Exec(mangaInfo.url) then - mangaInfo.url := regx.Replace(mangaInfo.url, '/read-online/$1', True); - finally - regx.Free; - end; - - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - begin - Parser.Free; - Source.Free; - Exit; - end; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.summary := ''; - - regx := TRegExpr.Create; - regx.Expression := '\/page\-\d+$'; - for i := 0 to parse.Count - 1 do - begin - //title - if Pos('<h1', parse[i]) > 0 then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //cover - if Pos('property="og:image:url"', parse[i]) > 0 then - mangaInfo.coverLink := GetVal(parse[i], 'content'); - - //author - if Pos('<b', parse[i]) > 0 then - if Pos('Author:', parse[i + 1]) > 0 then - mangaInfo.authors := CommonStringFilter(parse[i + 4]); - - //status - if Pos('<b', parse[i]) > 0 then - if Pos('Publishing Status:', parse[i + 1]) > 0 then - begin - if LowerCase(Trim(parse[i + 3])) = 'ongoing' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - - //genres - if Pos('Genre:', parse[i]) > 0 then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - if isExtractGenres and (Pos('</div', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('Genre:', parse[i]) = 0) and - (Pos('<', parse[i]) = 0) then - mangaInfo.genres := mangaInfo.genres + parse[i]; - - //description - if Pos('Description:', parse[i]) > 0 then - mangaInfo.summary := BreaksString(CommonStringFilter(parse[i + 4])); - - //chapters - if (Pos('<a', parse[i]) > 0) and (Pos('/chapter-', parse[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetVal(parse[i], 'href'); - if regx.Exec(s) then - s := regx.Replace(s, '', False); - mangaInfo.chapterLinks.Add(s); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 1])); - end; - end; - regx.Free; - - //remove duplicate links - RemoveDuplicateStrings([mangaInfo.chapterLinks, mangaInfo.chapterName]); - //inverts - InvertStrings(mangaInfo.chapterLinks); - InvertStrings(mangaInfo.chapterName); - - Parser.Free; - Source.Free; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaTraders/names_and_links.inc b/baseunits/includes/MangaTraders/names_and_links.inc deleted file mode 100644 index c30c3809a..000000000 --- a/baseunits/includes/MangaTraders/names_and_links.inc +++ /dev/null @@ -1,46 +0,0 @@ - function MangaTradersGetNamesAndLinks: Byte; - var - i: Integer; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGATRADERS_ID, 1] + - MANGATRADERS_BROWSER , 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - regx := TRegExpr.Create; - try - regx.Expression := '\/manga\/\?series\=(.*)$'; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="seriesList', parse[i]) > 0 then - begin - Result := NO_ERROR; - names.Add(CommonStringFilter(parse[i + 3])); - s := TrimLeftChar(GetVal(parse[i + 2], 'href'), ['.']); - if regx.Exec(s) then - s := regx.Replace(s, '/read-online/$1', True); - links.Add(s); - end; - end; - finally - regx.Free; - end; - Source.Free; - end; diff --git a/baseunits/includes/MangaVadisi/chapter_page_number.inc b/baseunits/includes/MangaVadisi/chapter_page_number.inc deleted file mode 100644 index fbe621132..000000000 --- a/baseunits/includes/MangaVadisi/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaVadisiPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAVADISI_ID, MANGAVADISI_BROWSER + URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('title="Sonraki Sayfa"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 6]; - manager.container.PageNumber := StrToInt(GetString(s, '"', '"')); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaVadisi/image_url.inc b/baseunits/includes/MangaVadisi/image_url.inc deleted file mode 100644 index 06745a518..000000000 --- a/baseunits/includes/MangaVadisi/image_url.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangaVadisiImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGAVADISI_ID, MANGAVADISI_BROWSER + URL) - + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="picture"', parse.Strings[i]) > 0) then - begin - manager.container.pageLinks.Strings[workCounter] := - EncodeURL(WebsiteRoots[MANGAVADISI_ID, 1] + MANGAVADISI_BROWSER + - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangaVadisi/manga_information.inc b/baseunits/includes/MangaVadisi/manga_information.inc deleted file mode 100644 index cef04d8dd..000000000 --- a/baseunits/includes/MangaVadisi/manga_information.inc +++ /dev/null @@ -1,61 +0,0 @@ - function GetMangaVadisiInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGAVADISI_ID, MANGAVADISI_BROWSER + URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.website := WebsiteRoots[MANGAVADISI_ID, 0]; - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (Pos('select name="chapter"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get manga name - if (mangaInfo.title = '') and (Pos('Manga Vadisi - ', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i], 'Manga Vadisi - ', ' - Chapter'); - - if (isExtractChapter) and (Pos('</select>', parse.Strings[i]) > 0) then - Break; - - if (isExtractChapter) and (Pos('option value=', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := URL + '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangaVadisi/names_and_links.inc b/baseunits/includes/MangaVadisi/names_and_links.inc deleted file mode 100644 index df305379c..000000000 --- a/baseunits/includes/MangaVadisi/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function MangaVadisiGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGAVADISI_ID, 1] + - MANGAVADISI_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('<option value="', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Mangacan/image_url.inc b/baseunits/includes/Mangacan/image_url.inc deleted file mode 100644 index d7492ca5c..000000000 --- a/baseunits/includes/Mangacan/image_url.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetMangacanImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(MANGACAN_ID, '/' + StringReplace(URL, '-1.html', '.html', [])); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - if (Pos('<img alt=', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - s := StringReplace(s, 'https://', 'http://', [rfReplaceAll]); - s := StringReplace(s, 'mangas/', WebsiteRoots[MANGACAN_ID, 1] + - '/mangas/', [rfReplaceAll]); - manager.container.PageLinks.Add(EncodeURL(s)); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Mangacan/manga_information.inc b/baseunits/includes/Mangacan/manga_information.inc deleted file mode 100644 index c92559d43..000000000 --- a/baseunits/includes/Mangacan/manga_information.inc +++ /dev/null @@ -1,133 +0,0 @@ - function GetMangacanInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(MANGACAN_ID, '/' + URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MANGACAN_ID, 0]; - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - {if (mangaInfo.coverLink = '') AND - (Pos('class="cvr', parse.Strings[i])>0) then - mangaInfo.coverLink:= CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')));} - - // get title - if (Pos('<title>', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft( - TrimRight(HTMLEntitiesFilter(GetString('~!@' + parse.Strings[i + 1], - '~!@', ' - Indonesia Online Terbaru|Baca Manga Komik Indonesia|Mangacan!')))); - - if (not isExtractChapter) and (Pos('latestchapters', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('class="chaptersrec', parse.Strings[i]) > 0) then //asli class="lng - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetString(parse.Strings[i], 'href="', '"'), - WebsiteRoots[MANGACAN_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); //ASLI 5 - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - - if (isExtractChapter) and - (Pos('seemore', parse.Strings[i]) > 0) then - isExtractChapter := False; //bermasalah - - // get summary - if (Pos('<div class="det">', parse.Strings[i]) <> 0) then - begin - j := i + 2; - while (j < parse.Count) and (Pos('<b>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter( - StringFilter(TrimLeft(parse.Strings[j]))); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - Break; - end; - Inc(j); - end; - end; - - // get authors - if (Pos('Author', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(StringFilter(parse.Strings[i + 2])); - - // get artists - if (Pos('Artist', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(StringFilter(parse.Strings[i + 2])); - - // get genres - if (Pos('Category', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('manga-list/category/', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</p>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Mangacan/names_and_links.inc b/baseunits/includes/Mangacan/names_and_links.inc deleted file mode 100644 index 99cd08cb6..000000000 --- a/baseunits/includes/Mangacan/names_and_links.inc +++ /dev/null @@ -1,40 +0,0 @@ - function MangacanGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGACAN_ID, 1] + - MANGACAN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse.Strings[i]) = 'a') and - (Pos('baca-komik-', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 1]); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[MANGACAN_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Mangacow/chapter_page_number.inc b/baseunits/includes/Mangacow/chapter_page_number.inc deleted file mode 100644 index 0f982e66f..000000000 --- a/baseunits/includes/Mangacow/chapter_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetMangaCowPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - regx: TRegExpr; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGACOW_ID, URL) + '1/'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.Expression := '^.*\.push\("([^"]+)"\);.*$'; - regx.ModifierI := True; - for i := 0 to parse.Count - 1 do - if Pos('arr_img.push(', parse[i]) > 0 then - manager.container.PageLinks.Add(regx.Replace(parse[i], '$1', True)); - finally - regx.Free - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Mangacow/directory_page_number.inc b/baseunits/includes/Mangacow/directory_page_number.inc deleted file mode 100644 index 69d42fd6f..000000000 --- a/baseunits/includes/Mangacow/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMangaCowDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MANGACOW_ID, 1] + - MANGACOW_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a ', parse[i]) > 0) then - if (Trim(parse[i + 1]) = 'Last') then - if (Pos('</a', parse[i + 2]) > 0) then - begin - Result := NO_ERROR; - Page := StrToIntDef(ReplaceRegExpr('^.*\/(\d+)\/$', - GetVal(parse[i], 'href'), '$1', True), 1); - Break; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Mangacow/image_url.inc b/baseunits/includes/Mangacow/image_url.inc deleted file mode 100644 index e5f6e5796..000000000 --- a/baseunits/includes/Mangacow/image_url.inc +++ /dev/null @@ -1,31 +0,0 @@ - function GetMangaCowImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGACOW_ID, URL) + IntToStr(workCounter + 1) + '/'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'style') = 'width:0px; height:0px') then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Mangacow/manga_information.inc b/baseunits/includes/Mangacow/manga_information.inc deleted file mode 100644 index 9a35ad999..000000000 --- a/baseunits/includes/Mangacow/manga_information.inc +++ /dev/null @@ -1,206 +0,0 @@ - function GetMangaCowInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - isExtractInfo: Boolean = False; - isExtractGenres: Boolean = False; - chapterPage: Cardinal; - begin - mangaInfo.website := WebsiteRoots[MANGACOW_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MANGACOW_ID, URL); - - if mangaInfo.url[Length(mangaInfo.url)] <> '/' then - mangaInfo.url := mangaInfo.url + '/'; - - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - chapterPage := 0; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (GetTagName(parse[i]) = 'img') and (GetVal(parse[i], 'class') = 'cvr') then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - // get title - if (Pos('<h1 ', parse[i]) > 0) and - (Pos('class="ttl"', parse[i]) > 0) then - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 1]))); - - // get chapter name and links - if Pos('class="lst"', parse[i]) > 0 then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[MANGACOW_ID, 1], - '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - s := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 3]))); - mangaInfo.chapterName.Add(s); - end; - - if (Pos('<a ', parse[i]) > 0) and (Pos('/chapter-list/', parse[i]) > 0) then - if Trim(parse[i + 1]) = 'Last' then - chapterPage := StrToIntDef(ReplaceRegExpr('^.*/(\d+)/$', - GetVal(parse[i], 'href'), '$1', True), 0); - - if (Pos('class="mng_ifo"', parse[i]) > 0) then - isExtractInfo := True; - if isExtractInfo and - (Pos('class="lst mng_chp"', parse[i]) > 0) then - isExtractInfo := False; - - if isExtractInfo then - begin - // get summary - if (Pos('Subscribe', parse[i]) > 0) then - if (Pos('</b>', parse[i + 1]) > 0) then - mangaInfo.summary := - Trim(BreaksString(HTMLEntitiesFilter(StringFilter(parse[i + 12])))); - - // get authors - if (mangaInfo.authors = '') and - (Trim(parse[i]) = 'Author') then - begin - j := i + 1; - while j < parse.Count - 1 do - begin - if Pos('</p', parse[j]) > 0 then - Break; - if Pos('<', parse[j]) = 0 then - begin - if Trim(parse[j]) = ',' then - mangaInfo.authors := mangaInfo.authors + ', ' - else - mangaInfo.authors := mangainfo.authors + Trim(parse[j]); - end; - Inc(j); - end; - mangaInfo.authors := Trim(RemoveStringBreaks(StringFilter(mangaInfo.authors))); - mangaInfo.authors := Trim(ReplaceRegExpr('^[\:|\-]', - Trim(mangaInfo.authors), '', False)); - mangaInfo.authors := Trim(ReplaceRegExpr('^[\:|\-]', - Trim(mangaInfo.authors), '', False)); - end; - - // get artists - if (mangaInfo.artists = '') and - (Trim(parse[i]) = 'Artist') then - begin - j := i + 1; - while j < parse.Count - 1 do - begin - if Pos('</p', parse[j]) > 0 then - Break; - if Pos('<', parse[j]) = 0 then - begin - if Trim(parse[j]) = ',' then - mangaInfo.artists := mangaInfo.artists + ', ' - else - mangaInfo.artists := mangainfo.artists + Trim(parse[j]); - end; - Inc(j); - end; - mangaInfo.artists := Trim(RemoveStringBreaks(StringFilter(mangaInfo.artists))); - mangaInfo.artists := Trim(ReplaceRegExpr('^[\:|\-]', - Trim(mangaInfo.artists), '', False)); - mangaInfo.artists := Trim(ReplaceRegExpr('^[\:|\-]', - Trim(mangaInfo.artists), '', False)); - end; - - // get genres - if (Pos('Category', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('manga-list/category/', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</p>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - end; - - // get the rest of chapter list - if chapterPage > 1 then - begin - for j := 2 to chapterPage do - begin - if GetPage(TObject(Source), mangaInfo.url + 'chapter-list/' + - IntToStr(j) + '/', Reconnect) then - begin - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if Pos('class="lst"', parse[i]) > 0 then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[MANGACOW_ID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - s := Trim(HTMLEntitiesFilter(StringFilter(parse[i + 3]))); - mangaInfo.chapterName.Add(s); - end; - end; - end; - end; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/Mangacow/names_and_links.inc b/baseunits/includes/Mangacow/names_and_links.inc deleted file mode 100644 index 8a5e51369..000000000 --- a/baseunits/includes/Mangacow/names_and_links.inc +++ /dev/null @@ -1,53 +0,0 @@ - function MangaCowGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - //if Trim(URL) = '0' then - //s := '' - //else - s := IntToStr(StrToInt(URL) + 1) + '/'; - if not GetPage(TObject(Source), WebsiteRoots[MANGACOW_ID, 1] + - MANGACOW_BROWSER + s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a ', parse[i]) > 0) and (Pos('class="mng_det_pop"', parse[i]) > 0) then - if Pos('<br', parse[i + 3]) > 0 then - begin - Result := NO_ERROR; - s := Trim(HTMLEntitiesFilter(StringFilter(GetVal(parse[i], 'title')))); - names.Add(S); - s := StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[MANGACOW_ID, 1], - '', [rfIgnoreCase]); - links.Add(S); - end; - //if (Pos('class="img_wrp', parse.Strings[i]) > 0) then - //begin - // Result:= NO_ERROR; - // s:= StringFilter(GetAttributeValue(GetTagAttribute(parse.Strings[i+1], 'title='))); - // names.Add(HTMLEntitiesFilter(s)); - // s:= StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i+1], 'href=')), WebsiteRoots[MANGACOW_ID,1], '', []); - // links.Add(s); - //end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MangasPROJECT/image_url.inc b/baseunits/includes/MangasPROJECT/image_url.inc deleted file mode 100644 index d81be40f4..000000000 --- a/baseunits/includes/MangasPROJECT/image_url.inc +++ /dev/null @@ -1,46 +0,0 @@ - function GetMangasPROJECTImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l, ts: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MANGASPROJECT_ID, URL) + '/#1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('{ path: ', parse.Strings[i]) > 0 then - begin - s := GetString(parse.Strings[i], 'new Array({ path: ', '});'); - s := StringReplace(s, sLineBreak, '', [rfReplaceAll]); - ts := TStringList.Create; - try - ts.DelimitedText := s; - for j := 0 to ts.Count - 1 do - begin - if Pos('http', ts.Strings[j]) > 0 then - manager.container.PageLinks.Add(ts.Strings[j]); - end; - finally - ts.Free; - end; - Break; - end; - end; - end; - - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MangasPROJECT/manga_information.inc b/baseunits/includes/MangasPROJECT/manga_information.inc deleted file mode 100644 index 61b64598e..000000000 --- a/baseunits/includes/MangasPROJECT/manga_information.inc +++ /dev/null @@ -1,179 +0,0 @@ - function GetMangasPROJECTInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - i, j, n: Cardinal; - numberOfPage: Cardinal = 1; - - procedure ExtractChapter; - begin - if (not isExtractChapter) and (Pos('class="chapter_cont', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get chapter name and links - if (isExtractChapter) and - (Pos('class="nome', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetString(parse.Strings[i + 22], 'href="', '"'), - WebsiteRoots[MANGASPROJECT_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - s := StringFilter(HTMLEntitiesFilter(s)); - if Length(s) >= 3 then - begin - s := Copy(s, 1, Length(s) - 2); - s := StringReplace(s, '- ' + #39, '- ', []); - end; - mangaInfo.chapterName.Add(s); - end; - - if (isExtractChapter) and - (Pos('paginacao', parse.Strings[i]) > 0) then - isExtractChapter := False; //bermasalah - end; - - begin - mangaInfo.url := FillMangaSiteHost(MANGASPROJECT_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - mangaInfo.website := WebsiteRoots[MANGASPROJECT_ID, 0]; - mangaInfo.status := '0'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - //Get number of pages - //Don't know why unicode pos not work here - if (Pos('tima', parse.Strings[i]) > 0) and - (Pos('gina', parse.Strings[i]) > 0) then - numberOfPage := StrToInt(GetString(parse.Strings[i - 1], '/page/', '">')); - - // get cover - if Pos('class="side"', parse.Strings[i]) > 0 then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i + 2], 'src='))); - - // get title - if (Pos('class="text', parse.Strings[i]) > 0) then - mangaInfo.title := parse.Strings[i + 3]; - - // get summary - if (Pos('class="text', parse.Strings[i]) <> 0) then - begin - j := i + 9; - while (j < parse.Count) and (Pos('</div>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter( - StringFilter(TrimLeft(parse.Strings[j]))); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - Break; - end; - Inc(j); - end; - end; - - ExtractChapter; - - // get authors - if (Pos('class="text', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(StringFilter(parse.Strings[i + 7])); - - // get artists - if (Pos('class="text', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(StringFilter(parse.Strings[i + 7])); - - // get genres - if (Pos('class="cat', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</br>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 3]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - //Extract chapter - if numberOfPage > 1 then - begin - for n := 2 to numberOfPage do - begin - Source.Clear; - s := mangaInfo.url + '/' + IntToStr(n); - if not GetPage(TObject(Source), mangaInfo.url + '/page/' + - IntToStr(n), Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - isExtractChapter := False; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - ExtractChapter; - end; - end; - Source.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MangasPROJECT/names_and_links.inc b/baseunits/includes/MangasPROJECT/names_and_links.inc deleted file mode 100644 index 8e44d525a..000000000 --- a/baseunits/includes/MangasPROJECT/names_and_links.inc +++ /dev/null @@ -1,42 +0,0 @@ - function MangasPROJECTGetNamesAndLinks: Byte; - var - i: Cardinal; - url: String; - sstream: TStringStream; - parser: TJSONParser; - Data: TJSONData; - begin - Result := INFORMATION_NOT_FOUND; - url := 'http://www.mangasproject.net/AJAX/listaMangas/all'; - if not GetPage(TObject(Source), url, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - sstream := TStringStream.Create(Source.Text); - parser := TJSONParser.Create(sstream); - try - Data := Parser.Parse; - if Data <> nil then - begin - if Data.Count > 0 then - begin - Result := NO_ERROR; - for i := 0 to Data.Count - 1 do - begin - names.Add(Data.Items[i].Items[0].AsString); - links.Add(StringReplace(Data.Items[i].Items[2].AsString, - WebsiteRoots[MangasPROJECT_ID, 1], '', [])); - end; - end; - Data.Free; - end; - except - on E: Exception do - MessageDlg('Exception occured: ', E.Message, mtConfirmation, [mbYes], 0); - end; - sstream.Free; - parser.Free; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MeinManga/chapter_page_number.inc b/baseunits/includes/MeinManga/chapter_page_number.inc deleted file mode 100644 index 6eaf62bc9..000000000 --- a/baseunits/includes/MeinManga/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetMeinMangaPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MEINMANGA_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - manager.container.PageLinks.Clear; - for i := parse.Count - 1 downto 0 do - begin - if (Pos('</select>', parse.Strings[i]) > 0) then - begin - manager.container.PageNumber := - StrToInt(TrimLeft(TrimRight(parse.Strings[i - 3]))); - Break; - end; - end; - if manager.container.PageNumber > 0 then - for i := 0 to manager.container.PageNumber - 1 do - manager.container.pageLinks.Add(s + IntToStr(i + 1) + '.html'); - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MeinManga/image_url.inc b/baseunits/includes/MeinManga/image_url.inc deleted file mode 100644 index a40c02b38..000000000 --- a/baseunits/includes/MeinManga/image_url.inc +++ /dev/null @@ -1,91 +0,0 @@ - function GetMeinMangaImageURL: Boolean; - var - s, imageName: String; - prefix: Cardinal = 0; - i: Cardinal; - l: TStringList; - Parser: THTMLParser; - begin - s := manager.container.DownloadInfo.SaveTo + - '/' + manager.container.ChapterName.Strings[ - manager.container.CurrentDownloadChapterPtr] + '/' + - Format('%.3d', [workCounter + 1]); - // Check to see if a file with similar name was already exist. If so then we - // skip the download process. - if (FileExists(s + '.jpg')) or - (FileExists(s + '.png')) or - (FileExists(s + '.gif')) then - begin - Result := True; - Exit; - end; - - l := TStringList.Create; - - FHTTP.Headers.Values['Accept'] := ' image/png,image/*;q=0.8,*/*;q=0.5'; - FHTTP.Headers.Values['Accept-Encoding'] := ' gzip, deflate'; - FHTTP.Headers.Values['Accept-Language'] := ' en-US,en;q=0.5'; - - Result := GetPage(TObject(l), - manager.container.PageLinks.Strings[workCounter], - manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - FHTTP.Free; - Exit; - end; - - parse := TStringList.Create; - try - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="pic_fragment"', parse.Strings[i]) > 0) then - begin - FHTTP.Clear; - - SaveImage( - manager.container.MangaSiteID, - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')), - CorrectPathSys(manager.container.DownloadInfo.SaveTo + - manager.container.ChapterName.Strings[ - manager.container.CurrentDownloadChapterPtr]), - Format('%.3d', [workCounter + 1]), - '_' + IntToStr(prefix), - manager.container.Manager.retryConnect); - - Inc(prefix); - - if Self.Terminated then - begin - l.Free; - parse.Free; - //HTTP.Free; - Exit; - end; - end; - end; - // If prefix = 2 then there're 2 separate images. We need to merge them into one ... - if prefix = 2 then - begin - imageName := Format('%.3d', [workCounter + 1]); - Merge2Images( - CorrectPathSys(manager.container.DownloadInfo.SaveTo + '/' + - manager.container.ChapterName.Strings[manager.container.CurrentDownloadChapterPtr]), - imageName + '_' + IntToStr(prefix - 2) + '.jpg', - imageName + '_' + IntToStr(prefix - 1) + '.jpg', - imageName + '.jpg'); - end; // Merging. - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/MeinManga/manga_information.inc b/baseunits/includes/MeinManga/manga_information.inc deleted file mode 100644 index c2c5cc494..000000000 --- a/baseunits/includes/MeinManga/manga_information.inc +++ /dev/null @@ -1,170 +0,0 @@ - function GetMeinMangaInfoFromURL: Byte; - var - s: String; - isExtractSummary: Boolean = True; - i, j: Cardinal; - URLs: TStringList; - - procedure GetChapterTitleAndChapterURL; - begin - if (Pos('/default/images/book.jpg', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetString(parse.Strings[i + 2], 'href="', '">'), - WebsiteRoots[MEINMANGA_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(Trim(parse.Strings[i + 3])); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - end; - - begin - mangaInfo.url := FillMangaSiteHost(MEINMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[MEINMANGA_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - URLs := TStringList.Create; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('/pic/logo/', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('Kurzbeschreibung', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 6; - while (j < parse.Count) and (Pos('</div>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if (s[1] <> '<') then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get title - if (mangaInfo.title = '') and (Pos('class="chrname"', parse.Strings[i]) <> 0) then - mangaInfo.title := Trim(StringFilter(parse.Strings[i + 1])); - - // Get chapter title and url - GetChapterTitleAndChapterURL; - - // get authors - if (i + 4 < parse.Count) and - (Pos('Autor', parse.Strings[i]) <> 0) and - (Pos('valign="top"', parse.Strings[i - 1]) <> 0) then - mangaInfo.authors := Trim(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and - (Pos('Zeichner', parse.Strings[i]) <> 0) and - (Pos('valign="top"', parse.Strings[i - 1]) <> 0) then - mangaInfo.artists := Trim(parse.Strings[i + 4]); - - // get genres - if (i + 4 < parse.Count) and - (Pos('Genre', parse.Strings[i]) <> 0) and - (Pos('valign="top"', parse.Strings[i - 1]) <> 0) then - mangaInfo.genres := Trim(parse.Strings[i + 4]); - - // get status - if (i + 4 < parse.Count) and - (Pos('Status', parse.Strings[i]) <> 0) and - (Pos('valign="top"', parse.Strings[i - 1]) <> 0) then - begin - if Pos('ongoing', parse.Strings[i + 4]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - - // Get number of page - if (URLs.Count = 0) and - (Pos('class="gotopage"', parse.Strings[i]) <> 0) and - (Pos('class="hover"', parse.Strings[i + 2]) <> 0) then - begin - j := i + 3; - while (j < parse.Count) and - ((Pos('class="next"', parse.Strings[j]) = 0) and - (Pos('</div>', parse.Strings[j]) = 0)) do - begin - if (Pos('<a', parse.Strings[j]) <> 0) then - begin - URLs.Add(GetString(parse.Strings[j], 'href="', '">')); - end; - Inc(j); - end; - end; - end; - - // Repeat until we get all chapter information - if URLs.Count > 0 then - begin - for j := 0 to URLs.Count - 1 do - begin - Source := TStringList.Create; - if not GetPage(TObject(Source), URLs.Strings[j], Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - GetChapterTitleAndChapterURL; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - URLs.Free; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MeinManga/names_and_links.inc b/baseunits/includes/MeinManga/names_and_links.inc deleted file mode 100644 index 214731d93..000000000 --- a/baseunits/includes/MeinManga/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function MeinMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MEINMANGA_ID, 1] + - MEINMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/manga/', parse.Strings[i]) > 0) and - (Pos('<img', parse.Strings[i - 2]) > 0) then - begin - Result := NO_ERROR; - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - links.Add(s); - s := StringFilter(Trim(parse.Strings[i + 1])); - s := StringReplace(s, WebsiteRoots[MEINMANGA_ID, 1], '', []); - names.Add(HTMLEntitiesFilter(s)); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/MyReadingMangaInfo/chapter_page_number.inc b/baseunits/includes/MyReadingMangaInfo/chapter_page_number.inc deleted file mode 100644 index 2a36b9b71..000000000 --- a/baseunits/includes/MyReadingMangaInfo/chapter_page_number.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetMyReadingMangaInfoPageNumber: Boolean; - var - i: Integer; - //j: Integer; - l: TStringList; - s: String; - isExtractImg: Boolean = False; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(MYREADINGMANGAINFO_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - //if (Pos('class="separator"', parse[i]) > 0) and - // (Pos('style="clear: both; text-align: center;"', parse[i]) > 0) then - // for j := i + 1 to parse.Count - 1 do - // if (Pos('<img', parse[j]) > 0) then - // begin - // manager.container.PageLinks.Add(GetVal(parse[j], 'src')); - // Break; - // end; - if isExtractImg and (Pos('<footer', parse[i]) > 0) and - (Pos('class="entry-footer"', parse[i]) > 0) then - begin - isExtractImg := False; - Break; - end; - if (Pos('<div', parse[i]) > 0) and - (Pos('class="entry-content"', parse[i]) > 0) then - isExtractImg := True; - if isExtractImg and (Pos('<img', parse[i]) > 0) then - manager.container.PageLinks.Add(GetVal(parse[i], 'src')); - end; - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - end; diff --git a/baseunits/includes/MyReadingMangaInfo/directory_page_number.inc b/baseunits/includes/MyReadingMangaInfo/directory_page_number.inc deleted file mode 100644 index 5dd607f70..000000000 --- a/baseunits/includes/MyReadingMangaInfo/directory_page_number.inc +++ /dev/null @@ -1,46 +0,0 @@ - function GetMyReadingMangaInfoDirectoryPageNumber: Byte; - var - i, j: Cardinal; - isGetLastPage: Boolean = False; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MYREADINGMANGAINFO_ID, 1] + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="pagination-omission"', parse[i]) > 0 then - begin - j := i + 1; - while j < parse.Count - 1 do - begin - if (Pos('<a', parse[j]) > 0) and (Pos('/page/', parse[j]) > 0) then - begin - Result := NO_ERROR; - Page := StrToIntDef(Trim(parse[j + 1]), 1); - isGetLastPage := True; - Break; - end; - if isGetLastPage then - Break; - Inc(j); - end; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/MyReadingMangaInfo/manga_information.inc b/baseunits/includes/MyReadingMangaInfo/manga_information.inc deleted file mode 100644 index a42400267..000000000 --- a/baseunits/includes/MyReadingMangaInfo/manga_information.inc +++ /dev/null @@ -1,127 +0,0 @@ - function GetMyReadingMangaInfoInfoFromURL: Byte; - var - s: String; - i, j: Integer; - isCategories: Boolean = False; - isTags: Boolean = False; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MYREADINGMANGAINFO_ID, 0]; - mangaInfo.url := FillMangaSiteHost(MYREADINGMANGAINFO_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if (GetTagName(parse[i]) = 'h1') and - (GetVal(parse[i], 'class') = 'entry-title') then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - - //author - if (Pos('<strong>', parse[i]) <> 0) and (Pos('Author:', parse[i + 1]) <> 0) then - begin - s := StringReplace(parse[i + 1], 'Author:', '', []); - s := StringReplace(s, #194#160, '', [rfReplaceAll]); //space - mangaInfo.authors := Trim(s); - end; - - //genres - if (Pos('class="entry-categories"', parse[i]) > 0) and (isCategories = False) then - begin - j := i + 2; - s := ''; - while (j < parse.Count - 1) do - begin - if (Pos('</span', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) then - s := s + parse[j]; - Inc(j); - end; - s := StringFilter(Trim(s)); - if (mangaInfo.genres <> '') and (s <> '') then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(s) - else - if s <> '' then - mangaInfo.genres := Trim(s); - isCategories := True; - end; - if (Pos('class="entry-tags"', parse[i]) > 0) and (isTags = False) then - begin - j := i + 2; - s := ''; - while (j < parse.Count - 1) do - begin - if (Pos('</span', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) then - s := s + parse[j]; - Inc(j); - end; - s := StringFilter(Trim(s)); - if (mangaInfo.genres <> '') and (s <> '') then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(s) - else - if s <> '' then - mangaInfo.genres := Trim(s); - isTags := True; - end; - if (i + 1 < parse.Count - 1) then - if (Pos('Pairing:', parse[i]) > 0) and (Pos('</strong', parse[i + 1]) > 0) then - begin - s := StringReplace(parse[i], 'Pairing:', '', []); - s := StringReplace(s, #194#160, #32, [rfReplaceAll]); - if (mangaInfo.genres <> '') and (s <> '') then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(s) - else - if s <> '' then - mangaInfo.genres := Trim(s); - end; - - //chapters - if Pos('class="entry-pagination pagination', parse[i]) <> 0 then - isExtractChapters := True; - if isExtractChapters and (Pos('</div', parse[i]) <> 0) then - isExtractChapters := False; - if isExtractChapters and (Pos('<a', parse[i]) <> 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(RemoveHostFromURL(GetVal(parse[i], 'href'))); - mangaInfo.chapterName.Add(mangaInfo.title + ' Ch. ' + IntToStr(mangaInfo.numChapter + 1)); - end; - end; - - //chapter 1 - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Insert(0, URL); - if mangaInfo.numChapter = 1 then - mangaInfo.chapterName.Insert(0, mangaInfo.title) - else - mangaInfo.chapterName.Insert(0, mangaInfo.title + ' Ch. 1'); - - //no status = completed - mangaInfo.status := '0'; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/MyReadingMangaInfo/names_and_links.inc b/baseunits/includes/MyReadingMangaInfo/names_and_links.inc deleted file mode 100644 index 7b9f7cd06..000000000 --- a/baseunits/includes/MyReadingMangaInfo/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function MyReadingMangaInfoNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[MYREADINGMANGAINFO_ID, 1] + - '/page/' + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="entry-title"', parse[i]) > 0 then - begin - Result := NO_ERROR; - s := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2])))); - names.Add(s); - s := GetVal(parse[i + 1], 'href'); - s := StringReplace(s, WebsiteRoots[MYREADINGMANGAINFO_ID, 1], '', [rfIgnoreCase]); - links.Add(s); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/NHentai/chapter_page_number.inc b/baseunits/includes/NHentai/chapter_page_number.inc deleted file mode 100644 index f2e99e7ab..000000000 --- a/baseunits/includes/NHentai/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetNHentaiPageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(NHENTAI_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - Result := GetPage(TObject(l), s + '1/', manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) > 0) and (Pos('class="last"', parse[i]) > 0) and - (Pos('/g/', parse[i]) > 0) then - begin - manager.container.PageNumber := - StrToIntDef(ReplaceRegExpr('^.*\/(\d+)\/.*$', GetVal(parse[i], 'href'), '$1', True), 1); - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/NHentai/directory_page_number.inc b/baseunits/includes/NHentai/directory_page_number.inc deleted file mode 100644 index 3b30b3670..000000000 --- a/baseunits/includes/NHentai/directory_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetNHentaiDirectoryPageNumber: Byte; - var - i: Integer; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[NHENTAI_ID, 1] + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) > 0) and (Pos('?page=', parse[i]) > 0) and - (Pos('class="last"', parse[i]) > 0) then - begin - Result := NO_ERROR; - Page := StrToIntDef(ReplaceRegExpr('^.*\?page=(\d+).*$', GetVal(parse[i], 'href'), '$1', True), 1); - Break; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/NHentai/image_url.inc b/baseunits/includes/NHentai/image_url.inc deleted file mode 100644 index 2faa7f6b7..000000000 --- a/baseunits/includes/NHentai/image_url.inc +++ /dev/null @@ -1,54 +0,0 @@ - function GetNHentaiImageURL: Boolean; - var - i, j: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(NHENTAI_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(QWord(workCounter) + 1) + '/'; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<div', parse[i]) > 0) and (Pos('id="image-container"', parse[i]) > 0) then - begin - for j := i + 1 to parse.Count - 1 do - begin - if Pos('<img', parse[j]) > 0 then - begin - s := GetVal(parse[j], 'src'); - if (s <> '') and (Pos('http', s) = 0) then - begin - s := TrimLeftChar(s, ['/', ':']); - s := 'http://' + s; - end; - manager.container.PageLinks[workCounter] := s; - Break; - end; - end; - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/NHentai/manga_information.inc b/baseunits/includes/NHentai/manga_information.inc deleted file mode 100644 index c35e59705..000000000 --- a/baseunits/includes/NHentai/manga_information.inc +++ /dev/null @@ -1,93 +0,0 @@ - function GetNHentaiInfoFromURL: Byte; - var - i: Integer; - begin - mangaInfo.website := WebsiteRoots[NHENTAI_ID, 0]; - mangaInfo.url := FillMangaSiteHost(NHENTAI_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //cover - if (Pos('/cover', parse[i]) > 0) and (Pos('<img', parse[i]) > 0) then - begin - mangaInfo.coverLink := GetVal(parse[i], 'src'); - if (mangaInfo.coverLink <> '') and (Pos('http', mangainfo.coverLink) = 0) then - begin - mangaInfo.coverLink := TrimLeftChar(mangaInfo.coverLink, ['/', ':']); - mangaInfo.coverLink := 'http://' + mangaInfo.coverLink; - end; - end; - - //title - if (i + 1 < parse.Count - 1) then - if (Pos('<h1', parse[i]) > 0) then - mangaInfo.title := Trim(StringFilter(parse[i + 1])); - - //artist - if (i + 1 < parse.Count - 1) then - if ((Pos('<a', parse[i]) > 0) and (Pos('class="tagbutton"', parse[i]) > 0)) and - (Pos('/artist/', parse[i]) > 0) then - if mangaInfo.artists = '' then - mangaInfo.artists := Trim(parse[i + 1]) - else - mangaInfo.artists := mangaInfo.artists + ', ' + Trim(parse[i + 1]); - - //tag/genre - if (i + 1 < parse.Count - 1) then - if ((Pos('<a', parse[i]) > 0) and (Pos('class="tagbutton"', parse[i]) > 0)) and - ((Pos('/parody/', parse[i]) > 0) or - (Pos('/character/', parse[i]) > 0) or - (Pos('/tagged/', parse[i]) > 0) or - (Pos('/group/', parse[i]) > 0)) then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]); - - //language/genre - if (i + 1 < parse.Count - 1) then - if ((Pos('class="field-name"', parse[i]) > 0) and (Pos('Language:', parse[i + 1]) > 0)) then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(StringReplace(parse[i + 1], 'Language:', '', [rfIgnoreCase])) - else - mangaInfo.genres := mangaInfo.genres + ', ' + - Trim(StringReplace(parse[i + 1], 'Language:', '', [rfIgnoreCase]));; - end; - end; - - mangaInfo.status := '0'; - mangaInfo.numChapter := 1; - mangaInfo.chapterLinks.Add(URL); - mangaInfo.chapterName.Add(mangaInfo.title); - - if mangaInfo.chapterName.Count > 1 then - begin - // invert chapter - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/NHentai/names_and_links.inc b/baseunits/includes/NHentai/names_and_links.inc deleted file mode 100644 index 2d5c18cb5..000000000 --- a/baseunits/includes/NHentai/names_and_links.inc +++ /dev/null @@ -1,34 +0,0 @@ - function NHentaiNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[NHENTAI_ID, 1] + - '/?page=' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/g/', parse[i]) > 0) and (Pos('<a', parse[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - links.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[NHENTAI_ID, 1], '', [rfIgnoreCase])); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/NineManga/chapter_page_number.inc b/baseunits/includes/NineManga/chapter_page_number.inc deleted file mode 100644 index a2381d3e9..000000000 --- a/baseunits/includes/NineManga/chapter_page_number.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetNineMangaPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - isExtractPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - - Result := GetPage(TObject(l), - FillMangaSiteHost(manager.container.MangaSiteID, URL), - manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse.Strings[i]) > 0) and - (Pos('name="page"', parse.Strings[i]) > 0) and - (Pos('id="page"', parse.Strings[i]) > 0) then - isExtractPageNumber := True; - if isExtractPageNumber and (Pos('</select', parse.Strings[i]) > 0) then - begin - isExtractPageNumber := False; - Break; - end; - if isExtractPageNumber and (Pos('<option', parse.Strings[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/NineManga/directory_page_number.inc b/baseunits/includes/NineManga/directory_page_number.inc deleted file mode 100644 index e67808db8..000000000 --- a/baseunits/includes/NineManga/directory_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetNineMangaDirectoryPageNumber: Byte; - var - SiteID: Cardinal; - iniadv: TIniFile; - p: Integer; - begin - Source.Free; - Result := 0; - BROWSER_INVERT := True; - //I can't get manga directory total pages. Its not available on any page - //The only option to get total pages is just checking manually with browser :( - iniadv := TIniFile.Create(CONFIG_FOLDER + CONFIG_ADVANCED); - p := iniadv.ReadInteger('UpdateListDirectoryPageNumber', website, -1); - iniadv.Free; - if p > 0 then - Page := p - else - begin - SiteID := GetMangaSiteID(website); - case SiteID of - NINEMANGA_ID: Page := 520; //latest check = 513 (01-11-2014) - NINEMANGA_ES_ID: Page := 596; - NINEMANGA_CN_ID: Page := 778; - NINEMANGA_RU_ID: Page := 205; - NINEMANGA_BR_ID: Page := 56; - NINEMANGA_IT_ID: Page := 50; - NINEMANGA_DE_ID: Page := 30; - else - Page := 500; //not checked yet = 500 default - end; - end; - end; diff --git a/baseunits/includes/NineManga/image_url.inc b/baseunits/includes/NineManga/image_url.inc deleted file mode 100644 index fde89a654..000000000 --- a/baseunits/includes/NineManga/image_url.inc +++ /dev/null @@ -1,42 +0,0 @@ - function GetNineMangaImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(manager.container.MangaSiteID, URL); - s := StringReplace(s, '.html', '', []); - s := StringReplace(s, '.htm', '', []); - s := s + '-' + IntToStr(workCounter + 1) + '.html'; - - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - if Self.Terminated then - begin - l.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse.Strings[i]) > 0) and - (Pos('class="manga_pic', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/NineManga/manga_information.inc b/baseunits/includes/NineManga/manga_information.inc deleted file mode 100644 index 17b8a1ddf..000000000 --- a/baseunits/includes/NineManga/manga_information.inc +++ /dev/null @@ -1,125 +0,0 @@ - function GetNineMangaInfoFromURL: Byte; - var - isExtractGenres: Boolean = False; - i, j, SiteID: Cardinal; - s: String; - begin - SiteID := GetMangaSiteID(website); - mangaInfo.website := WebsiteRoots[SiteID, 0]; - mangaInfo.url := StringReplace(FillMangaSiteHost(SiteID, URL), '?waring=1', '', - [rfIgnoreCase, rfReplaceAll]); - - if not GetPage(TObject(Source), mangaInfo.url + '?waring=1', Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.numChapter := 0; - - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - //manga title - if {(mangaInfo.title = '') and} - (Pos('itemprop="name"', parse.Strings[i]) > 0) then - begin - mangaInfo.title := HTMLEntitiesFilter(StringFilter(Trim(parse.Strings[i + 1]))); - mangaInfo.title := ReplaceRegExpr('\sManga$', mangaInfo.title, '', False); - end; - - //coverlink - if Pos('itemprop="image"', parse.Strings[i]) > 0 then - mangaInfo.coverLink := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - - //genres - if Pos('itemprop="genre"', parse.Strings[i]) > 0 then - isExtractGenres := True; - if isExtractGenres and (Pos('</li>', parse.Strings[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('href="', parse.Strings[i]) > 0) then - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse.Strings[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse.Strings[i + 1]); - - //author - if Pos('itemprop="author"', parse.Strings[i]) > 0 then - mangaInfo.authors := Trim(parse.Strings[i + 1]); - - //status - if Pos('class="red" href="/category/', parse.Strings[i]) > 0 then - if Pos('/category/updated', parse.Strings[i]) > 0 then - mangaInfo.status := '1' //ongoing - else - if Pos('/category/completed', parse.Strings[i]) > 0 then - mangaInfo.status := '0'; //completed - - //summary - if Pos('itemprop="description"', parse.Strings[i]) > 0 then - //mangaInfo.summary:= mangaInfo.summary+#13#10+Trim(parse.Strings[i+5]); - mangaInfo.summary := HTMLEntitiesFilter(StringFilter(Trim(parse.Strings[i + 5]))); - - ////chapter name and links - //if Pos('class="chapter_list_', parse.Strings[i]) > 0 then - //begin - // Inc(mangaInfo.numChapter); - // mangaInfo.chapterLinks.Add( - // StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - // WebsiteRoots[SiteID, 1], '', [rfIgnoreCase])); - // mangaInfo.chapterName.Add(HTMLEntitiesFilter( - // StringFilter(Trim(parse.Strings[i + 1])))); - //end; - end; - - // chapter list direct - if Source.Count > 1 then - begin - for i := 0 to Source.Count - 1 do - begin - if (Pos('<a ', Source[i]) > 0) and - (Pos('class="chapter_list_', Source.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetVal(Source[i], 'href'), WebsiteRoots[SiteID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - s := Trim(ReplaceRegExpr('^.*\>(.*)\<\/a.*$', Source[i], '$1', True)); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(s)))); - end; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/NineManga/names_and_links.inc b/baseunits/includes/NineManga/names_and_links.inc deleted file mode 100644 index e9e72de8d..000000000 --- a/baseunits/includes/NineManga/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function NineMangaGetNamesAndLinks: Byte; - var - SiteID, i: Cardinal; - - begin - Result := INFORMATION_NOT_FOUND; - SiteID := GetMangaSiteID(website); - if not GetPage(TObject(Source), WebsiteRoots[SiteID, 1] + - NINEMANGA_BROWSER + '&page=' + IntToStr(StrToIntDef(URL, 0) + 1) + '.html', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="bookname"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - links.Add( - StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[SiteID, 1], '', [rfReplaceAll])); - names.Add(HTMLEntitiesFilter(StringFilter(Trim(parse.Strings[i + 1])))); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/OneManga/chapter_page_number.inc b/baseunits/includes/OneManga/chapter_page_number.inc deleted file mode 100644 index 4ab49d02e..000000000 --- a/baseunits/includes/OneManga/chapter_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetOneMangaPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - isGetPage: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(ONEMANGA_ID, URL); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - manager.container.PageNumber := 0; - if parse.Count > 0 then - for i := 1 to parse.Count - 1 do - begin - - if (Pos('<select ', parse.Strings[i]) > 0) and - (Pos('class="cbo_wpm_pag"', parse.Strings[i]) > 0) then - isGetPage := True; - if isGetPage and (Pos('</select', parse[i]) > 0) then - begin - isGetPage := False; - Break; - end; - if isGetPage and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/OneManga/directory_page_number.inc b/baseunits/includes/OneManga/directory_page_number.inc deleted file mode 100644 index 3b25af833..000000000 --- a/baseunits/includes/OneManga/directory_page_number.inc +++ /dev/null @@ -1,34 +0,0 @@ - function GetOneMangaDirectoryPageNumber: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ONEMANGA_ID, 1] + - ONEMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - if Pos('Last', parse[i]) > 0 then - if (Pos('<a ', parse[i - 1]) > 0) and (Pos('</a', parse[i + 1]) > 0) then - begin - Page := StrToIntDef(ReplaceRegExpr('^.*\/(\d+)\/$', - GetVal(parse[i - 1], 'href'), '$1', True), 1); - Result := NO_ERROR; - Break; - end; - Source.Free; - end; diff --git a/baseunits/includes/OneManga/image_url.inc b/baseunits/includes/OneManga/image_url.inc deleted file mode 100644 index a2b9659ba..000000000 --- a/baseunits/includes/OneManga/image_url.inc +++ /dev/null @@ -1,30 +0,0 @@ - function GetOneMangaImageURL: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(ONEMANGA_ID, URL); - s := s + IntToStr(workCounter + 1) + '/'; - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (Pos('<img ', parse[i]) > 0) and - (Pos('class="manga-page"', parse[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/OneManga/manga_information.inc b/baseunits/includes/OneManga/manga_information.inc deleted file mode 100644 index bdad5e939..000000000 --- a/baseunits/includes/OneManga/manga_information.inc +++ /dev/null @@ -1,97 +0,0 @@ - function GetOneMangaInfoFromURL: Byte; - var - i: Integer; - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[ONEMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(ONEMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.title := ''; - mangaInfo.authors := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - //get title - if (Pos('<h1 ', parse[i]) > 0) and (Pos('class="ttl"', parse[i]) > 0) then - mangaInfo.title := Trim(parse[i + 1]); - - //get cover - if (Pos('<img ', parse[i]) > 0) and (Pos('class="cvr"', parse[i]) > 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //get authors - if Pos('Author', parse[i]) > 0 then - if Pos('</b>', parse[i + 1]) > 0 then - mangaInfo.authors := Trim(RemoveSymbols(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 2]))))); - - //get summary - if Pos('class="det"', parse[i]) > 0 then - if Pos('<p>', parse[i + 2]) > 0 then - mangaInfo.summary := Trim(BreaksString(HTMLEntitiesFilter(StringFilter(parse[i + 3])))); - - //get genres - if Pos('Category', parse[i]) > 0 then - if Pos('</b>', parse[i + 1]) > 0 then - isExtractGenres := True; - if isExtractGenres and (Pos('</p>', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('<a ', parse[i]) > 0) then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(RemoveSymbols(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(RemoveSymbols(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - - //get status - if Pos('Status', parse[i]) > 0 then - if Pos('</b>', parse[i + 1]) > 0 then - begin - if Pos('Ongoing', parse[i + 2]) > 0 then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - - //get chapters name and link - if (Pos('<ul ', parse[i]) > 0) and (Pos('class="lst"', parse[i]) > 0) then - isExtractChapter := True; - if isExtractChapter and (Pos('</ul>', parse[i]) > 0) then - isExtractChapter := False; - if isExtractChapter and - ((Pos('<a ', parse[i]) > 0) and (Pos('class="lst"', parse[i]) > 0)) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[ONEMANGA_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(Trim(RemoveSymbols(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 3])))))); - end; - end; - - //invert chapter list - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/OneManga/names_and_links.inc b/baseunits/includes/OneManga/names_and_links.inc deleted file mode 100644 index 6f72b1117..000000000 --- a/baseunits/includes/OneManga/names_and_links.inc +++ /dev/null @@ -1,36 +0,0 @@ - function OneMangaGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[ONEMANGA_ID, 1] + - ONEMANGA_BROWSER + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if Pos('class="det"', parse[i]) > 0 then - if Pos('<a ', parse[i + 2]) > 0 then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 3]))))); - links.Add(StringReplace(GetVal(parse[i + 2], 'href'), - WebsiteRoots[ONEMANGA_ID, 1], '', [rfIgnoreCase])); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/PecintaKomik/chapter_page_number.inc b/baseunits/includes/PecintaKomik/chapter_page_number.inc deleted file mode 100644 index 35c134750..000000000 --- a/baseunits/includes/PecintaKomik/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetPecintaKomikPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(PECINTAKOMIK_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('</option>', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 1]; - manager.container.pageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/PecintaKomik/image_url.inc b/baseunits/includes/PecintaKomik/image_url.inc deleted file mode 100644 index ee222d0d5..000000000 --- a/baseunits/includes/PecintaKomik/image_url.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetPecintaKomikImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(PECINTAKOMIK_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('mangas/', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - if Pos('/manga/', s) = 0 then - s := WebsiteRoots[PECINTAKOMIK_ID, 1] + '/manga/' + s - else - s := WebsiteRoots[PECINTAKOMIK_ID, 1] + PECINTAKOMIK_BROWSER + s; - manager.container.PageLinks.Strings[workCounter] := EncodeURL(s); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/PecintaKomik/manga_information.inc b/baseunits/includes/PecintaKomik/manga_information.inc deleted file mode 100644 index da5626be9..000000000 --- a/baseunits/includes/PecintaKomik/manga_information.inc +++ /dev/null @@ -1,132 +0,0 @@ - function GetPecintaKomikInfoFromURL: Byte; - var - isExtractGenres: Boolean = False; - isExtractChapter: Boolean = False; - s: String; - i, j: Cardinal; - k: Integer; - begin - mangaInfo.url := FillMangaSiteHost(PECINTAKOMIK_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[PECINTAKOMIK_ID, 0]; - mangaInfo.status := '1'; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - if Pos('/manga/', URL) = 0 then - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('id="mangaimg"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := WebsiteRoots[PECINTAKOMIK_ID, 1] + - CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'src='))); - - // get summary - if (Pos('Himbauan:', parse.Strings[i]) <> 0) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</tr>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get title - if (Pos('Nama:', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := StringFilter(TrimRight(TrimLeft(parse.Strings[i + 6]))); - - // get chapter name and links - if (not isExtractChapter) and - (Pos('id="chapterlist"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - if (isExtractChapter) and - (Pos('/manga/', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetString(parse.Strings[i], 'href="', '"'); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Autor:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimRight(TrimLeft(parse.Strings[i + 4])); - - // get artists - if (i + 4 < parse.Count) and (Pos('Artist:', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimRight(TrimLeft(parse.Strings[i + 4])); - - // get genres - if (Pos('Genre:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - end; - - if isExtractGenres then - begin - if Pos('class="genretags"', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</tr>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - end - else - for i := 0 to parse.Count - 1 do - begin - if Pos('name="chapter"', parse.Strings[i]) > 0 then - begin - if TryStrToInt(TrimRight(TrimLeft(parse.Strings[i + 2])), k) then - for j := k downto 1 do - begin - Inc(mangaInfo.numChapter); - s := URL + IntToStr(j); - mangaInfo.chapterLinks.Add(s); - s := 'Chapter ' + IntToStr(j); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - Break; - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/PecintaKomik/names_and_links.inc b/baseunits/includes/PecintaKomik/names_and_links.inc deleted file mode 100644 index 006b63ccc..000000000 --- a/baseunits/includes/PecintaKomik/names_and_links.inc +++ /dev/null @@ -1,50 +0,0 @@ - function PecintaKomikGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[PECINTAKOMIK_ID, 1] + - PECINTAKOMIK_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class=''screenshot''', parse.Strings[i]) > 0) or - (Pos('class="screenshot"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'title='))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - if s[Length(s)] <> '/' then - s := s + '/'; - links.Add(s); - end; - if (Pos('/manga/', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - if s[Length(s)] <> '/' then - s := s + '/'; - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/PornComix/chapter_page_number.inc b/baseunits/includes/PornComix/chapter_page_number.inc deleted file mode 100644 index e51c1aba4..000000000 --- a/baseunits/includes/PornComix/chapter_page_number.inc +++ /dev/null @@ -1,95 +0,0 @@ - function GetPornComixPageNumber(MangaID: Cardinal): Boolean; - var - i: LongInt; - s: String; - l: TStringList; - regx: TRegExpr; - isGetImageURL: Boolean = False; - RepeatGet: Boolean = True; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(MangaID, URL)); - while RepeatGet do - begin - RepeatGet := False; - l.Clear; - parse.Clear; - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - manager.container.PageNumber := 0; - manager.container.PageLinks.Clear; - manager.container.PageContainerLinks.Clear; - if parse.Count > 0 then - begin - regx := TRegExpr.Create; - try - isGetImageURL := False; - regx.Expression := '^^(.*)/img-(\w+)\..*$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<div', parse[i]) <> 0) and (Pos('class="single-post', parse[i]) <> 0) then - isGetImageURL := True; - if isGetImageURL and (Pos('</div', parse[i]) <> 0) then - Break; - if isGetImageURL and - (Pos('<a', parse[i]) <> 0) and - ((Pos('target="_blank', parse[i]) <> 0) or - (Pos('rel="nofollow', parse[i]) <> 0)) then - begin - Inc(manager.container.PageNumber); - s := GetVal(parse[i], 'href'); - if (Pos('<img', parse[i + 1]) <> 0) and - (Pos('/upload/small/', parse[i + 1]) <> 0) then - begin - s := GetVal(parse[i + 1], 'src'); - s := StringReplace(s, '/small/', '/big/', [rfIgnoreCase]); - manager.container.PageLinks.Add(s); - manager.container.PageContainerLinks.Add('W'); - end - else if (Pos('imagetwist.', s) <> 0) or - (Pos('imgmega.', s) <> 0) or - (Pos('imgchili.', s) <> 0) then - begin - manager.container.PageContainerLinks.Add(s); - manager.container.PageLinks.Add('W'); - end - else if regx.Exec(s) then - begin - s := regx.Replace(s, '$1/dlimg.php?id=$2', True); - manager.container.PageLinks.Add(s); - manager.container.PageContainerLinks.Add('W'); - end - else if (Pos('/category/', s) = 0) and - ((Pos(WebsiteRoots[PORNCOMIX_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[XXCOMICS_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[XXCOMICSMT_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[XXCOMICS3D_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[PORNCOMIXRE_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[PORNCOMIXIC_ID, 1], s) <> 0) or - (Pos(WebsiteRoots[PORNXXXCOMICS_ID, 1], s) <> 0) or - (Pos('.xxcomics.', s) <> 0) or - (Pos('.porncomix.', s) <> 0)) then - begin - RepeatGet := True; - if Assigned(FHTTP) then - FHTTP.Cookies.Clear; - Break; - end - else - Dec(manager.container.PageNumber); - end; - end; - finally - regx.Free; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/PornComix/directory_page_number.inc b/baseunits/includes/PornComix/directory_page_number.inc deleted file mode 100644 index 051861434..000000000 --- a/baseunits/includes/PornComix/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetPornComixDirectoryPageNumber(MangaID: Cardinal): Byte; - var - i, p: LongInt; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[MangaID, 1]; - if MangaID = PORNCOMIXRE_ID then - s := s + '/online/'; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - for i := 0 to parse.Count - 1 do - if (Pos('<a', parse[i]) > 0) and (Pos('/page/', parse[i]) > 0) then - begin - p := StrToIntDef(ReplaceRegExpr('^.*/(\d+)/$', GetVal(parse[i], 'href'), '$1', True), 0); - if Page < p then - Page := p; - end; - Source.Free; - end; diff --git a/baseunits/includes/PornComix/image_url.inc b/baseunits/includes/PornComix/image_url.inc deleted file mode 100644 index a73fabf39..000000000 --- a/baseunits/includes/PornComix/image_url.inc +++ /dev/null @@ -1,64 +0,0 @@ - function GetPornComixImageURL: Boolean; - var - i: LongInt; - s, surl: String; - l: TStringList; - begin - surl := manager.container.PageContainerLinks[workCounter]; - if not ((Pos('imagetwist.', surl) <> 0) or - (Pos('imgmega.', surl) <> 0) or - (Pos('imgchili.', surl) <> 0)) then - Exit(False); - l := TStringList.Create; - Result := GetPage(TObject(l), DecodeUrl(surl), manager.container.manager.retryConnect); - - //broken source - if l.Count > 0 then - if (Pos('imgmega.', surl) <> 0) or - (Pos('imagetwist.', surl) <> 0) then - begin - for i := 0 to l.Count - 1 do - if (Pos('<img', l[i]) <> 0) and (Pos('class="pic', l[i]) <> 0) then - begin - s := l[i]; - Break; - end; - if s <> '' then - l.Text := s; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - // imgmega, imgaetwist - if (Pos('imgmega.', surl) <> 0) or - (Pos('imagetwist.', surl) <> 0) then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) <> 0) and (Pos('class="pic', parse[i]) <> 0) then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end - else - // imgchili - if Pos('imgchili.', surl) <> 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) <> 0) and (Pos('id="show_image', parse[i]) <> 0) then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/PornComix/manga_information.inc b/baseunits/includes/PornComix/manga_information.inc deleted file mode 100644 index bb57c8334..000000000 --- a/baseunits/includes/PornComix/manga_information.inc +++ /dev/null @@ -1,72 +0,0 @@ - function GetPornComixInfoFromURL(MangaID: Cardinal): Byte; - var - i: LongInt; - isExtractCover: Boolean = False; - isExtractGenres: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[MangaID, 0]; - mangaInfo.url := FillMangaSiteHost(MangaID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - // using parser - if parse.Count = 0 then - Exit; - - mangaInfo.coverLink := ''; - - for i := 0 to parse.Count - 1 do - begin - //cover - if Pos('class="single-post', parse[i]) <> 0 then - isExtractCover := True; - if isExtractCover and (Pos('<img', parse[i]) <> 0) and - (Pos('alt="download comic"', parse[i]) = 0) then - begin - mangaInfo.coverLink := GetVal(parse[i], 'src'); - isExtractCover := False; - end; - - //title - if (mangaInfo.title = '') and (Pos('class="posts', parse[i]) <> 0) then - if (Pos('<h2' , parse[i + 2]) <> 0) and - (Pos('class="post-title', parse[i + 2]) <> 0) then - mangaInfo.title := CommonStringFilter(parse[i + 3]); - - //genres/tags - if (Pos('class="video-tags', parse[i]) <> 0) then - isExtractGenres := True; - if isExtractGenres and (Pos('</div', parse[i]) <> 0) then - isExtractGenres := False; - if isExtractGenres and - (Pos('<a', parse[i]) <> 0) and (Pos('/tag/', parse[i]) <> 0) then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[i + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[i + 1]) - end; - end; - if mangaInfo.title = '' then - mangaInfo.title := 'Untitled_' + IntToStr(Random(99999)); - mangaInfo.status := '0'; - - //single chapter - mangaInfo.chapterLinks.Add(URL); - mangaInfo.chapterName.Add(mangaInfo.title); - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/PornComix/names_and_links.inc b/baseunits/includes/PornComix/names_and_links.inc deleted file mode 100644 index cd39e3832..000000000 --- a/baseunits/includes/PornComix/names_and_links.inc +++ /dev/null @@ -1,52 +0,0 @@ - function PornComixGetNamesAndLinks(MangaID: Cardinal): Byte; - var - i: LongInt; - s: String; - regx: TRegExpr; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[MangaID, 1] + '/'; - if MangaID = PORNCOMIXRE_ID then - s := s + 'online/'; - if URL <> '0' then - s := s + 'page/' + IntToStr(StrToInt(URL) + 1) + '/'; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - regx := TRegExpr.Create; - try - regx.Expression := '\w+\.\w+/.+$'; - for i := 0 to parse.Count - 1 do - begin - if (Pos('id="post-', parse[i]) <> 0) then - begin - s := GetVal(parse[i + 2], 'href'); - if regx.Exec(s) then - begin - links.Add(s); - names.Add(CommonStringFilter(GetVal(parse[i + 2], 'title'))); - if names[names.Count - 1] = '' then - names[names.Count - 1] := 'Untitled_' + IntToStr(Random(99999)); - end; - end; - end; - finally - regx.Free; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/Pururin/chapter_page_number.inc b/baseunits/includes/Pururin/chapter_page_number.inc deleted file mode 100644 index d61a02fc4..000000000 --- a/baseunits/includes/Pururin/chapter_page_number.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetPururinPageNumber: Boolean; - var - s: String; - i, g: Cardinal; - l: TStringList; - isStartGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(PURURIN_ID, URL); - s := StringReplace(s, '_1.html', '.html', []); - s := StringReplace(s, '/view/', '/gallery/', []); - s := DecodeUrl(StringReplace(s, '/00/', '/', [])); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="square"', parse.Strings[i]) > 0) then - isStartGetPageNumber := True; - - if (isStartGetPageNumber) and - (Pos('class="square"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i + 1]; - g := length(s); - Delete(s, g - 10, g - 3); - Delete(s, 1, 9); - g := StrToInt(s); - manager.container.PageNumber := g; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Pururin/directory_page_number.inc b/baseunits/includes/Pururin/directory_page_number.inc deleted file mode 100644 index 307565181..000000000 --- a/baseunits/includes/Pururin/directory_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetPururinDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[PURURIN_ID, 1], 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 2 do - begin - if (Pos('/browse/0/11/2.html', parse.Strings[i]) > 0) then - begin - Page := StrToInt(Trim(parse.Strings[i - 2])); - Break; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Pururin/image_url.inc b/baseunits/includes/Pururin/image_url.inc deleted file mode 100644 index 0ec24b528..000000000 --- a/baseunits/includes/Pururin/image_url.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetPururinImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := FillMangaSiteHost(PURURIN_ID, URL); - s := StringReplace(s, '_1.html', '_', []); - s := DecodeUrl(StringReplace(s, '/00', '/0' + IntToStr(workCounter + 0), []) + - IntToStr(workCounter + 1) + '.html'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := parse.Count - 1 downto 4 do - if (Pos('class="b"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - EncodeURL(WebsiteRoots[PURURIN_ID, 1] + - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Pururin/manga_information.inc b/baseunits/includes/Pururin/manga_information.inc deleted file mode 100644 index fac6f8d48..000000000 --- a/baseunits/includes/Pururin/manga_information.inc +++ /dev/null @@ -1,155 +0,0 @@ - function GetPururinInfoFromURL: Byte; - var - s, readURL: String; - i, j: Integer; - isExtractArtists: Boolean = False; - isExtractParodies: Boolean = False; - isExtractGenres: Boolean = False; - isExtractCharacters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[PURURIN_ID, 0]; - mangaInfo.url := FillMangaSiteHost(PURURIN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.status := '0'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - readURL := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - //for i:=0 to parse.Count-1 do - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and (Pos('class="gallery-cover', parse[i]) > 0) then - mangaInfo.coverLink := CorrectURL(WebsiteRoots[PURURIN_ID, 1] + - GetVal(parse[i + 4], 'src')); - - // get title - //if (Pos('class="otitle"', parse[i])<>0) AND (mangaInfo.title = '') then - if Pos('<title>', parse[i]) > 0 then - begin - mangaInfo.title := Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1])))); - if Pos('- Pururin', mangaInfo.title) <> 0 then - mangaInfo.title := ReplaceRegExpr( - '^(.*)\s\-.*\s-\sPururin,\sFree\sOnline\sHentai\sManga.*$', - mangaInfo.title, '$1', True); - end; - - // get summary - if (Pos('class="gallery-description', parse[i]) <> 0) then - begin - j := i + 1; - while (j < parse.Count) and (Pos('</div>', parse[j]) = 0) do - begin - s := parse[j]; - if s[1] <> '<' then - begin - parse[j] := HTMLEntitiesFilter( - StringFilter(TrimLeft(parse[j]))); - parse[j] := StringReplace(parse[j], #10, '\n', [rfReplaceAll]); - parse[j] := StringReplace(parse[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse[j]; - Break; - end; - Inc(j); - end; - end; - - // get authors - if (Pos('Circle', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - mangaInfo.authors := parse[i + 6]; - - // get category - if (Pos('Category', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - mangaInfo.genres := mangaInfo.genres + parse[i + 6]; - - // get artists - if (Pos('Artist', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - isExtractArtists := True; - if isExtractArtists and (Pos('</ul', parse[i]) <> 0) then - isExtractArtists := False; - if isExtractArtists and (Pos('/browse/', parse[i]) <> 0) then - begin - if mangaInfo.artists = '' then - mangaInfo.artists := Trim(parse[i + 1]) - else - mangaInfo.artists := mangaInfo.artists + ', ' + Trim(parse[i + 1]); - end; - - // get parody - if ((Pos('Parody', parse[i]) <> 0) or - (Pos('Parodies', parse[i]) <> 0)) and - (Pos('</td>', parse[i + 1]) <> 0) then - isExtractParodies := True; - if isExtractParodies and (Pos('</ul', parse[i]) <> 0) then - isExtractParodies := False; - if isExtractParodies and (Pos('/browse/', parse[i]) <> 0) then - mangaInfo.genres := mangaInfo.genres + Trim(parse[i + 1]) + ', '; - - // get language - if (Pos('Language', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - mangaInfo.genres := mangaInfo.genres + parse[i + 6] + ', '; - - // get convention - if (Pos('Convention', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - mangaInfo.genres := mangaInfo.genres + parse[i + 6] + ', '; - - // get character - if (Pos('Character', parse[i]) <> 0) and - (Pos('</td>', parse[i + 1]) <> 0) then - isExtractCharacters := True; - if isExtractCharacters and (Pos('</ul', parse[i]) <> 0) then - isExtractCharacters := False; - if isExtractCharacters and (Pos('/browse/', parse[i]) <> 0) then - mangaInfo.genres := mangaInfo.genres + Trim(parse[i + 1]) + ', '; - - // get genres - if (Pos('Contents', parse[i]) <> 0) then - isExtractGenres := True; - if isExtractGenres and (Pos('</ul', parse[i]) <> 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('/browse/', parse[i]) <> 0) then - mangaInfo.genres := mangaInfo.genres + Trim(parse[i + 1]) + ', '; - - // get chapters - if (Pos('<a', parse[i]) <> 0) and (Pos('class="btn link-next', parse[i]) <> 0) then - readURL := GetVal(parse[i], 'href'); - end; - mangaInfo.artists := StringReplace(mangaInfo.artists, '</tr>, ', '', []); - mangaInfo.genres := StringReplace(mangaInfo.genres, '</tr>, ', '', []); - //only 1 chapter - if readURL <> '' then - begin - mangaInfo.numChapter := 1; - if not ExecRegExpr('^https?\://', readURL) then - readURL := WebsiteRoots[PURURIN_ID, 1] + readURL; - mangaInfo.chapterName.Add(mangaInfo.title); - mangaInfo.chapterLinks.Add(readURL); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Pururin/names_and_links.inc b/baseunits/includes/Pururin/names_and_links.inc deleted file mode 100644 index 87e157dda..000000000 --- a/baseunits/includes/Pururin/names_and_links.inc +++ /dev/null @@ -1,47 +0,0 @@ - function PururinGetNamesAndLinks: Byte; - var - numPage: Integer; - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - numPage := StrToIntDef(URL, 0); - if numPage = 0 then - s := WebsiteRoots[PURURIN_ID, 1] + '/' - else - s := WebsiteRoots[PURURIN_ID, 1] + PURURIN_BROWSER + '0/1' + - IntToStr(numPage) + '/' + IntToStr(numPage + 1) + '.html'; - - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="overlay', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(parse.Strings[i + 7]); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute( - parse.Strings[i - 2], 'href=')), - WebsiteRoots[PURURIN_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/ReadHentaiManga/chapter_page_number.inc b/baseunits/includes/ReadHentaiManga/chapter_page_number.inc deleted file mode 100644 index dfa623527..000000000 --- a/baseunits/includes/ReadHentaiManga/chapter_page_number.inc +++ /dev/null @@ -1,68 +0,0 @@ - function GetReadHentaiMangaPageNumber: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - isExtractPage: Boolean = False; - isGetDirect: Boolean = True; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(READHENTAIMANGA_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - if isGetDirect then - begin - if l.Count > 0 then - begin - for i := 0 to l.Count - 1 do - begin - if Pos('var wpm_mng_rdr_img_lst', l[i]) > 0 then - begin - s := Trim(l[i]); - s := GetString(s, '(''', ''')'); - s := Trim(URLDecode(s)); - s := TrimChar(s, ['[', ']', '"']); - s := StringReplace(s, '\', '' , [rfReplaceAll]); - s := StringReplace(s, '","', '\', [rfReplaceAll]); - manager.container.PageLinks.Clear; - manager.container.PageLinks.Delimiter := '\'; - manager.container.PageLinks.DelimitedText := s; - manager.container.PageNumber := manager.container.PageLinks.Count; - Break; - end; - end; - end; - end - else - begin - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and - (Pos('class="cbo_wpm_pag"', parse[i]) > 0) then - isExtractPage := True; - if isExtractPage and - (Pos('</select', parse[i]) > 0) then - begin - isExtractPage := False; - Break; - end; - if isExtractPage and - (Pos('<option', parse[i]) > 0) then - begin - Inc(manager.container.PageNumber); - end; - end; - end; - end; - l.Free; - parse.Free; - end; diff --git a/baseunits/includes/ReadHentaiManga/directory_page_number.inc b/baseunits/includes/ReadHentaiManga/directory_page_number.inc deleted file mode 100644 index 09db3c175..000000000 --- a/baseunits/includes/ReadHentaiManga/directory_page_number.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetReadHentaiMangaDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Page := 0; - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[READHENTAIMANGA_ID, 1] + - READHENTAIMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos(READHENTAIMANGA_BROWSER, parse[i]) > 0) and (i + 1 < parse.Count -1) then - if Pos('Last', parse[i + 1]) > 0 then - begin - s := GetVal(parse[i], 'href'); - s := ReplaceRegExpr('^.*\/(\d+)\/$', s, '$1', True); - Page := StrToIntDef(s, 1); - Result := NO_ERROR; - Break; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/ReadHentaiManga/image_url.inc b/baseunits/includes/ReadHentaiManga/image_url.inc deleted file mode 100644 index dec2bf4ee..000000000 --- a/baseunits/includes/ReadHentaiManga/image_url.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetReadHentaiMangaImageURL: Boolean; - var - i: Cardinal; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := FillMangaSiteHost(READHENTAIMANGA_ID, URL); - if Length(s) > 0 then - if s[Length(s)] <> '/' then - s := s + '/'; - s := s + IntToStr(workCounter + 1) + '/'; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', parse[i]) > 0) and (Pos('id="main_img"', parse[i]) > 0) then - begin - s := GetVal(parse[i], 'src'); - if (s <> '') and (Pos('&#x', parse[i]) > 0) then - begin - s := StringReplace(s, '&#x', '%', [rfIgnoreCase, rfReplaceAll]); - s := StringReplace(s, ';', '', [rfReplaceAll]); - end; - s := URLDecode(s); - manager.container.PageLinks[workCounter] := s; - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/ReadHentaiManga/manga_information.inc b/baseunits/includes/ReadHentaiManga/manga_information.inc deleted file mode 100644 index e9c87507a..000000000 --- a/baseunits/includes/ReadHentaiManga/manga_information.inc +++ /dev/null @@ -1,142 +0,0 @@ - function GetReadHentaiMangaInfoFromURL: Byte; - var - s: String; - i, j: Cardinal; - begin - mangaInfo.website := WebsiteRoots[READHENTAIMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(READHENTAIMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - - if parse.Count = 0 then - Exit; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (Pos('class="cvr"', parse[i]) > 0) and (Pos('<img', parse[i]) > 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - // get title - if (i + 1 < parse.Count - 1) then - if (Pos('class="ttl"', parse[i]) > 0) and (Pos('<h1 ', parse[i]) > 0) then - mangaInfo.title := Trim(StringFilter(parse[i + 1])); - - //get authors - if (i + 1 < parse.Count - 1) then - if (Pos('Author', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - j := i + 1; - while j < parse.Count do - begin - if (Pos('</p', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) and (Trim(parse[j]) <> ':') then - mangaInfo.authors := mangaInfo.authors + parse[j]; - Inc(j); - end; - end; - - //get artists - if (i + 1 < parse.Count - 1) then - if (Pos('Artist', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - j := i + 1; - while j < parse.Count do - begin - if (Pos('</p', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) and (Trim(parse[j]) <> ':') then - mangaInfo.artists := mangaInfo.artists + parse[j]; - Inc(j); - end; - end; - - //get genres - if (i + 1 < parse.Count - 1) then - if (Pos('Category', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - j := i + 1; - s := ''; - while j < parse.Count do - begin - if (Pos('</p', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) and (Trim(parse[j]) <> ':') then - s := s + parse[j]; - Inc(j); - end; - if (mangaInfo.genres <> '') and (s <> '') then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(s) - else - if s <> '' then - mangaInfo.genres := Trim(s); - end; - if (i + 1 < parse.Count - 1) then - if (Pos('Tagged as', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - j := i + 1; - s := ''; - while j < parse.Count do - begin - if (Pos('</p', parse[j]) > 0) then - Break; - if (Pos('<', parse[j]) = 0) and (Trim(parse[j]) <> ':') then - s := s + parse[j]; - Inc(j); - end; - if (mangaInfo.genres <> '') and (s <> '') then - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(s) - else - if s <> '' then - mangaInfo.genres := Trim(s); - end; - - //get status - if (i + 4 < parse.Count - 1) then - if (Pos('Status', parse[i]) > 0) and (Pos('</b', parse[i + 1]) > 0) then - begin - if Pos('Completed', parse[i + 4]) > 0 then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end; - - //get chapters - if (Pos('<a ', parse[i]) > 0) and (Pos('class="lst"', parse[i]) > 0) then - begin - mangaInfo.chapterName.Add(Trim(GetVal(parse[i], 'title'))); - s := GetVal(parse[i], 'href'); - s := StringReplace(s, WebsiteRoots[READHENTAIMANGA_ID, 1], '', [rfIgnoreCase]); - mangaInfo.chapterLinks.Add(s); - end; - end; - - if mangaInfo.chapterName.Count = 1 then - mangaInfo.chapterName[0] := mangaInfo.title - else if mangaInfo.chapterName.Count > 1 then - begin - // invert chapter - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/ReadHentaiManga/names_and_links.inc b/baseunits/includes/ReadHentaiManga/names_and_links.inc deleted file mode 100644 index 1956a127f..000000000 --- a/baseunits/includes/ReadHentaiManga/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function ReadHentaiMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[READHENTAIMANGA_ID, 1] + - READHENTAIMANGA_BROWSER + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a ', parse[i]) > 0) and (Pos('class="lst mng_det_pop"', parse[i]) > 0) then - begin - Result := NO_ERROR; - s := Trim(HTMLEntitiesFilter(StringFilter(GetVal(parse[i], 'title')))); - names.Add(s); - s := GetVal(parse[i], 'href'); - s := StringReplace(s, WebsiteRoots[READHENTAIMANGA_ID, 1], '', [rfIgnoreCase]); - links.Add(s); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/ReadMangaToday/chapter_page_number.inc b/baseunits/includes/ReadMangaToday/chapter_page_number.inc deleted file mode 100644 index 379b6fcc6..000000000 --- a/baseunits/includes/ReadMangaToday/chapter_page_number.inc +++ /dev/null @@ -1,26 +0,0 @@ - function GetReadMangaTodayPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(READMANGATODAY_ID, URL)+'/all-pages'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - - ParseHTML(l.Text, parse); - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count-1 do - if (GetTagName(parse[i]) = 'img') and - (Pos('img-responsive-2', GetVal(parse[i], 'class')) <> 0) then - manager.container.PageLinks.Add(GetVal(parse[i], 'src')); - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/ReadMangaToday/directory_page_number.inc b/baseunits/includes/ReadMangaToday/directory_page_number.inc deleted file mode 100644 index 614d3cc90..000000000 --- a/baseunits/includes/ReadMangaToday/directory_page_number.inc +++ /dev/null @@ -1,6 +0,0 @@ - function GetReadMangaTodayDirectoryPageNumber: Byte; - begin - Source.Free; - Page := Length(ALPHA_LIST); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/ReadMangaToday/manga_information.inc b/baseunits/includes/ReadMangaToday/manga_information.inc deleted file mode 100644 index 6f5bfb1a0..000000000 --- a/baseunits/includes/ReadMangaToday/manga_information.inc +++ /dev/null @@ -1,115 +0,0 @@ - function GetReadMangaTodayInfoFromURL: Byte; - var - s: String; - i, j: Integer; - begin - mangaInfo.website := WebsiteRoots[READMANGATODAY_ID, 0]; - mangaInfo.url := FillMangaSiteHost(READMANGATODAY_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count-1 do - begin - //title - if mangaInfo.title = '' then - if GetTagName(parse[i]) = 'h1' then - mangaInfo.title := CommonStringFilter(parse[i+1]); - - //cover - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'class') = 'img-responsive') then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - if GetTagName(parse[i]) = 'dt' then - begin - //genre - if Pos('Categories:', parse[i+1]) > 0 then - begin - mangaInfo.genres := ''; - for j := i+2 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/dd' then - Break - else - if GetTagName(parse[j]) = 'a' then - if mangaInfo.genres = '' then - mangaInfo.genres := GetVal(parse[j], 'title') - else - mangaInfo.genres := mangaInfo.genres + ', ' + GetVal(parse[j], 'title'); - end; - end; - - //status - if Pos('Status:', parse[i+1]) > 0 then - begin - s := LowerCase(Trim(parse[i+6])); - if s = 'ongoing' then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - end; - end; - - //summary - if GetVal(parse[i], 'class') = 'list-group-item movie-detail' then - begin - mangaInfo.summary := ''; - for j := i + 1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/li' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := mangaInfo.summary + LineEnding + CommonStringFilter(parse[j]); - end; - mangaInfo.summary := Trim(mangaInfo.summary); - end; - - //author - if Trim(parse[i]) = 'Author' then - for j := i downto 0 do - if GetTagName(parse[j]) = 'a' then - begin - mangaInfo.authors := CommonStringFilter(parse[j+1]); - Break; - end; - - //artist - if Trim(parse[i]) = 'Artist' then - for j := i downto 0 do - if GetTagName(parse[j]) = 'a' then - begin - mangaInfo.artists := CommonStringFilter(parse[j+1]); - Break; - end; - - //chapters - if (GetTagName(parse[i]) = 'ul') and - (GetVal(parse[i], 'class') = 'chp_lst') then - for j := i+1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/ul' then - Break - else - if GetTagName(parse[j]) = 'a' then - mangaInfo.chapterLinks.Add(GetVal(parse[j], 'href')) - else - if GetVal(parse[j], 'class') = 'icon-arrow-2' then - mangaInfo.chapterName.Add(Trim(parse[j+2])); - end; - end; - Result := NO_ERROR; - end; - - //invert chapters - if mangaInfo.chapterLinks.Count > 1 then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - end; diff --git a/baseunits/includes/ReadMangaToday/names_and_links.inc b/baseunits/includes/ReadMangaToday/names_and_links.inc deleted file mode 100644 index 0376b7fd4..000000000 --- a/baseunits/includes/ReadMangaToday/names_and_links.inc +++ /dev/null @@ -1,30 +0,0 @@ - function ReadMangaTodayGetNamesAndLinks: Byte; - var - i: Integer; - s: string; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[READMANGATODAY_ID, 1] + '/manga-list'; - i := StrToIntDef(URL, 0); - if i > 0 then - s := s + '/' + ALPHA_LIST[i+1]; - if not GetPage(TObject(Source), s, 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'span') and - (GetVal(parse[i], 'class') = 'manga-item') then - begin - links.Add(GetVal(parse[i+4], 'href')); - names.Add(CommonStringFilter(parse[i+5])); - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/RedHawkScans/chapter_page_number.inc b/baseunits/includes/RedHawkScans/chapter_page_number.inc deleted file mode 100644 index 5bcff0140..000000000 --- a/baseunits/includes/RedHawkScans/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetRedHawkScansPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(REDHAWKSCANS_ID, URL) + 'page/1'); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 1 to parse.Count - 1 do - begin - if (Pos('class="topbar_right"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i + 4]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/RedHawkScans/directory_page_number.inc b/baseunits/includes/RedHawkScans/directory_page_number.inc deleted file mode 100644 index 881393194..000000000 --- a/baseunits/includes/RedHawkScans/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetRedHawkScansDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[REDHAWKSCANS_ID, 1] + - REDHAWKSCANS_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('Last ', parse.Strings[i]) > 0) and - (Pos('class="gbutton', parse.Strings[i - 1]) > 0) then - begin - s := TrimRight(TrimLeft(GetString(parse.Strings[i - 1], '/list/', '/"'))); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/RedHawkScans/image_url.inc b/baseunits/includes/RedHawkScans/image_url.inc deleted file mode 100644 index 4cc09c97c..000000000 --- a/baseunits/includes/RedHawkScans/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetRedHawkScansImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(REDHAWKSCANS_ID, URL) + 'page/' + - IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="open"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src=')); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/RedHawkScans/manga_information.inc b/baseunits/includes/RedHawkScans/manga_information.inc deleted file mode 100644 index 4f648bafd..000000000 --- a/baseunits/includes/RedHawkScans/manga_information.inc +++ /dev/null @@ -1,117 +0,0 @@ - function GetRedHawkScansInfoFromURL: Byte; - var - isExtractChapter: Boolean = False; - s: String; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(REDHAWKSCANS_ID, URL);// + '&confirm=yes'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[REDHAWKSCANS_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (GetTagName(parse.Strings[i]) = 'img') and - (Pos('class="thumbnail"', parse.Strings[i - 2]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('Description', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) then - begin - j := i + 2; - while (j < parse.Count) and (Pos('</li>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get title - if (Pos('Title', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) and - (mangaInfo.title = '') then - mangaInfo.title := StringReplace(TrimLeft(StringFilter(parse.Strings[i + 2])), - ': ', '', []); - - if (not isExtractChapter) and - (Pos('All chapters available for', parse.Strings[i]) > 0) then - isExtractChapter := True; - - if (isExtractChapter) and - (Pos('class="element"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetString(parse.Strings[i + 3], 'href="', '"'), - WebsiteRoots[REDHAWKSCANS_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 4]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 2 < parse.Count) and (Pos('Author', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) then - mangaInfo.authors := StringReplace(TrimLeft(parse.Strings[i + 2]), ': ', '', []); - - // get artists - if (i + 2 < parse.Count) and (Pos('Artist', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) then - mangaInfo.artists := StringReplace(TrimLeft(parse.Strings[i + 2]), ': ', '', []); - - // get genres - if (Pos('Genre', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) then - mangaInfo.genres := StringReplace(TrimLeft(parse.Strings[i + 2]), ': ', '', []); - - // get status - if (i + 2 < parse.Count) and (Pos('Status', parse.Strings[i]) <> 0) and - (Pos('<b', parse.Strings[i - 1]) <> 0) then - begin - if Pos('Ongoing', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/RedHawkScans/names_and_links.inc b/baseunits/includes/RedHawkScans/names_and_links.inc deleted file mode 100644 index 1c8e9301a..000000000 --- a/baseunits/includes/RedHawkScans/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function RedHawkScansGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[REDHAWKSCANS_ID, 1] + - REDHAWKSCANS_BROWSER + '/' + IntToStr(StrToInt(URL) + 1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="title"', parse.Strings[i]) > 0) and - (Pos('<a', parse.Strings[i + 1]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - names.Add(HTMLEntitiesFilter(s)); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], - 'href="')), WebsiteRoots[REDHAWKSCANS_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/S2Scans/chapter_page_number.inc b/baseunits/includes/S2Scans/chapter_page_number.inc deleted file mode 100644 index 7b99b4476..000000000 --- a/baseunits/includes/S2Scans/chapter_page_number.inc +++ /dev/null @@ -1,30 +0,0 @@ - function GetS2scanPageNumber: Boolean; - var - s: String; - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - try - Result := GetPage(TObject(l), - FillMangaSiteHost(S2SCAN_ID, URL) + 'page/1', - manager.container.Manager.retryConnect); - - if l.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to l.Count - 1 do - begin - if Pos('var pages = [', l[i]) > 0 then - begin - s := StringReplace(l[i], 'var pages = [', '[', []); - s := Trim(TrimChar(s, [';'])); - ParseJSONArray(s, 'url', manager.container.PageLinks); - Break; - end; - end; - end; - finally - l.Free; - end; - end; diff --git a/baseunits/includes/S2Scans/directory_page_number.inc b/baseunits/includes/S2Scans/directory_page_number.inc deleted file mode 100644 index 13ed80ee8..000000000 --- a/baseunits/includes/S2Scans/directory_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetS2ScanDirectoryPageNumber: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[S2SCAN_ID, 1] + '/directory/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if Pos('Last »»', parse[i]) > 0 then - if GetTagName(parse[i - 1]) = 'a' then - begin - Page := StrToIntDef(ReplaceRegExpr( - '^.*/(\d+)/$', GetVal(parse[i - 1], 'href'), '$1', True), 1); - Break; - end; - Source.Free; - end; diff --git a/baseunits/includes/S2Scans/manga_information.inc b/baseunits/includes/S2Scans/manga_information.inc deleted file mode 100644 index f452be48f..000000000 --- a/baseunits/includes/S2Scans/manga_information.inc +++ /dev/null @@ -1,74 +0,0 @@ - function GetS2scanInfoFromURL: Byte; - var - i: Integer; - isExtractChapter: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[S2SCAN_ID, 0]; - mangaInfo.url := FillMangaSiteHost(S2SCAN_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - //no status = ongoing - mangaInfo.status := '1'; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - //cover - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'class') = 'thumbnail') then - if GetTagName(parse[i + 2]) = 'img' then - mangaInfo.coverLink := GetVal(parse[i + 2], 'src'); - - //title - if mangaInfo.title = '' then - if (GetTagName(parse[i]) = 'h1') and (GetVal(parse[i], 'class') = 'title') then - mangaInfo.title := parse[i + 1]; - - if GetTagName(parse[i]) = 'b' then - begin - //author - if Trim(parse[i + 1]) = 'Author' then - mangaInfo.authors := TrimLeft(TrimLeftChar(parse[i + 3], [':'])); - //artist - if Trim(parse[i + 1]) = 'Artist' then - mangaInfo.artists := TrimLeft(TrimLeftChar(parse[i + 3], [':'])); - //author - if Trim(parse[i + 1]) = 'Synopsis' then - mangaInfo.summary := TrimLeft(TrimLeftChar(parse[i + 3], [':'])); - end; - - //chapters - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'class') = 'list') then - isExtractChapter := True; - if isExtractChapter then - begin - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'class') = 'title') then - if GetTagName(parse[i + 1]) = 'a' then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterName.Add(GetVal(parse[i + 1], 'title')); - mangaInfo.chapterLinks.Add(GetVal(parse[i + 1], 'href')); - end; - end; - end; - - // invert chapters - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end; diff --git a/baseunits/includes/S2Scans/names_and_links.inc b/baseunits/includes/S2Scans/names_and_links.inc deleted file mode 100644 index 52a4b5297..000000000 --- a/baseunits/includes/S2Scans/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function S2ScanGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[S2SCAN_ID, 1] + - '/directory/' + '/' + IntToStr(StrToInt(URL)+1) + '/', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'class') = 'group') then - if GetTagName(parse[i + 5]) = 'a' then - begin - names.Add(GetVal(parse[i + 5], 'title')); - links.Add(GetVal(parse[i + 5], 'href')); - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/ScanManga/image_url.inc b/baseunits/includes/ScanManga/image_url.inc deleted file mode 100644 index 2f861226a..000000000 --- a/baseunits/includes/ScanManga/image_url.inc +++ /dev/null @@ -1,45 +0,0 @@ - function GetScanMangaImageURL: Boolean; - var - s, h: String; - i, j: Cardinal; - l, t: TStringList; - - begin - l := TStringList.Create; - t := TStringList.Create; - - s := DecodeUrl(FillMangaSiteHost(SCANMANGA_ID, URL)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - - for i := 0 to l.Count - 1 do - begin - if (Pos('$(''#image_lel'')', l.strings[i]) > 0) and - (Pos('[id_page]', l.Strings[i]) > 0) then - begin - s := Trim(l.Strings[i]); - s := GetString(s, '''src'',''', '''+'); - h := s; - Break; - end; - end; - manager.container.PageLinks.Clear; - for i := 0 to l.Count - 1 do - begin - if (Pos('var c = new Array;', l.strings[i]) > 0) and - (Pos(';check = false;', l.Strings[i]) > 0) then - begin - s := Trim(l.Strings[i]); - s := GetString(s, 'var c = new Array;', ';check = false;'); - t.Delimiter := ';'; - t.DelimitedText := s; - for j := 0 to t.Count - 1 do - if Pos(']="', t.Strings[j]) > 0 then - manager.container.PageLinks.Add(h + GetString(t.Strings[j], '="', '"')); - Break; - end; - end; - t.Free; - l.Free; - end; diff --git a/baseunits/includes/ScanManga/manga_information.inc b/baseunits/includes/ScanManga/manga_information.inc deleted file mode 100644 index a41ef9c99..000000000 --- a/baseunits/includes/ScanManga/manga_information.inc +++ /dev/null @@ -1,129 +0,0 @@ - function GetScanMangaInfoFromURL: Byte; - var - s: String; - isExtractGenres: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(SCANMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[SCANMANGA_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (mangaInfo.coverLink = '') and - (Pos('<img itemprop="image"', parse.Strings[i]) > 0) then - begin - mangaInfo.coverLink := - CorrectURL(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - //mangaInfo.coverLink:= StringReplace(mangaInfo.coverLink, ':8080/', '/', []); - end; - - // get title - if (Pos('id=''ambubble''', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := TrimLeft(TrimRight(HTMLEntitiesFilter(parse.Strings[i]))); - - // get chapter name and links - if (Pos('class=''chapitre_nom''', parse.Strings[i]) > 0) and - (Pos('<strong>', parse.Strings[i + 1]) > 0) then - begin - s := Trim(RemoveSymbols(parse.Strings[i + 2])); - if (Pos('<', parse.Strings[i + 6]) = 0) and (Pos('>', parse.Strings[i + 6]) = 0) then - s := s + ' ' + Trim(RemoveSymbols(parse.Strings[i + 6])); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(s))); - end; - if (Pos('/lecture-en-ligne/', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := StringReplace(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')), - WebsiteRoots[SCANMANGA_ID, 1], '', []); - s := StringReplace(TrimLeft(TrimRight(s)), '"', '', [rfReplaceAll]); - mangaInfo.chapterLinks.Add(s); - end; - - // get summary - if (Pos('itemprop="description">', parse.Strings[i]) <> 0) then - begin - j := i + 1; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - end; - - // get authors - if (i + 2 < parse.Count) and - (Pos('itemprop="author"', parse.Strings[i]) <> 0) then - mangaInfo.authors := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - - // get artists - //if (i+5<parse.Count) AND (Pos('Illustrateur :', parse.Strings[i])<>0) then - // mangaInfo.artists:= StringFilter(TrimLeft(TrimRight(parse.Strings[i+5]))); - - // get genres - if (Pos('itemprop="genre"', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := mangaInfo.genres + HTMLEntitiesFilter( - TrimLeft(TrimRight(parse.Strings[i + 1]))) + ', '; - end; - - if isExtractGenres then - begin - if Pos('class=''tTip''>', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - HTMLEntitiesFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))) + ', '; - if Pos('itemprop="editor"', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 11 < parse.Count) and (Pos('itemprop="editor"', parse.Strings[i]) <> 0) then - begin - if (Pos('Termin', parse.Strings[i + 5]) <> 0) or - (Pos('One Shot', parse.Strings[i + 5]) <> 0) then - mangaInfo.status := '0' // completed - else - mangaInfo.status := '1'; // ongoing - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/ScanManga/names_and_links.inc b/baseunits/includes/ScanManga/names_and_links.inc deleted file mode 100644 index 93c8f6a58..000000000 --- a/baseunits/includes/ScanManga/names_and_links.inc +++ /dev/null @@ -1,47 +0,0 @@ - function ScanMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[SCANMANGA_ID, 1] + - SCANMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (i + 4 < parse.Count - 1) and - (Pos('<li>', parse.Strings[i]) > 0) and - (Pos('</a>', parse.Strings[i + 3]) > 0) and - (Pos('</li>', parse.Strings[i + 4]) > 0) then - begin - Result := NO_ERROR; - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - if (Length(s) > 1) and - (Pos('/scanlation/Shonen.html', s) = 0) and - (Pos('/scanlation/Shojo.html', s) = 0) and - (Pos('/scanlation/Josei.html', s) = 0) and - (Pos('/scanlation/Seinen.html', s) = 0) then - begin - links.Add(StringReplace(s, WebsiteRoots[SCANMANGA_ID, 1], '', [])); - s := StringFilter(parse.Strings[i + 2]); - names.Add(HTMLEntitiesFilter(s)); - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/SenManga/chapter_page_number.inc b/baseunits/includes/SenManga/chapter_page_number.inc deleted file mode 100644 index 982262947..000000000 --- a/baseunits/includes/SenManga/chapter_page_number.inc +++ /dev/null @@ -1,43 +0,0 @@ - function GetSenMangaPageNumber: Boolean; - var - s: String; - i: LongInt; - l: TStringList; - isStartGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(URL); - s := FillMangaSiteHost(SENMANGA_ID, s); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - if Result then - begin - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - manager.container.PageNumber := 0; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and (Pos('cbo_wpm_pag', parse[i]) > 0) then - isStartGetPageNumber := True; - if isStartGetPageNumber then - begin - if GetTagName(parse[i]) = '/select' then - Break - else - if GetTagName(parse[i]) = 'option' then - Inc(manager.container.PageNumber); - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/SenManga/directory_page_number.inc b/baseunits/includes/SenManga/directory_page_number.inc deleted file mode 100644 index 85ccd6a25..000000000 --- a/baseunits/includes/SenManga/directory_page_number.inc +++ /dev/null @@ -1,35 +0,0 @@ - function GetSenMangaDirectoryPageNumber: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[SENMANGA_ID, 1] + - '/directory/all/any/last-added/', 3) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - for i := parse.Count - 1 downto 0 do - if (GetTagName(parse[i]) = 'a') and - (Pos('/directory/all/any/last-added/', parse[i]) > 0) then - begin - Page := StrToIntDef(ReplaceRegExpr('^.*/last-added/(\d+)/?$', - GetVal(parse[i], 'href'), '$1', True), 1); - Result := NO_ERROR; - Break; - end; - end; diff --git a/baseunits/includes/SenManga/image_url.inc b/baseunits/includes/SenManga/image_url.inc deleted file mode 100644 index 112afb0aa..000000000 --- a/baseunits/includes/SenManga/image_url.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetSenMangaImageURL: Boolean; - var - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - try - Result := GetPage(TObject(l), - FillMangaSiteHost(SENMANGA_ID, URL + '/' + IntToStr(workCounter + 1) + '/'), - manager.container.Manager.retryConnect); - if Result then - begin - parse := TStringList.Create; - try - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'img') and - (GetVal(parse[i], 'id') = 'img_mng_enl') then - begin - manager.container.PageLinks[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - finally - parse.Free; - end; - end; - finally - l.Free; - end; - end; diff --git a/baseunits/includes/SenManga/manga_information.inc b/baseunits/includes/SenManga/manga_information.inc deleted file mode 100644 index 6b1491bfa..000000000 --- a/baseunits/includes/SenManga/manga_information.inc +++ /dev/null @@ -1,132 +0,0 @@ - function GetSenMangaInfoFromURL: Byte; - var - i, j, p: Integer; - - procedure GetChapters(const ln: Integer); - begin - if (GetTagName(parse[ln]) = 'a') and (GetVal(parse[ln], 'class') = 'lst') then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[ln], 'href')); - mangaInfo.chapterName.Add(parse[ln + 3]); - end; - end; - - begin - mangaInfo.website := WebsiteRoots[SENMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(SENMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.status := ''; - p := 0; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if (GetTagName(parse[i]) = 'h1') and (GetVal(parse[i], 'class') = 'ttl') then - mangaInfo.title := CommonStringFilter(parse[i + 1]); - //cover - if (GetTagName(parse[i]) = 'img') and (GetVal(parse[i], 'class') = 'cvr') then - mangaInfo.coverLink := FixURL(GetVal(parse[i], 'src')); - //summary - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'class') = 'det') then - mangaInfo.summary := parse[i + 3]; - - if (GetTagName(parse[i]) = 'b') then - begin - //author - if Trim(parse[i + 1]) = 'Author' then - mangaInfo.authors := parse[i + 5]; - //artist - if Trim(parse[i + 1]) = 'Artist' then - mangaInfo.artists := parse[i + 5]; - //status - if mangaInfo.status = '' then - if Trim(parse[i + 1]) = 'Status' then - begin - mangaInfo.status := Trim(parse[i + 5]); - if mangaInfo.status = 'Completed' then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end; - //genres - if Trim(parse[i + 1]) = 'Category' then - for j := i + 3 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = '/p' then - Break - else - if GetTagName(parse[j]) = 'a' then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[j + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[j + 1]); - end; - end; - end; - - //chapters - GetChapters(i); - - //chapterpage - if (GetTagName(parse[i]) = 'a') and (Pos('/chapter-list/', parse[i]) > 0) then - if Trim(parse[i + 1]) = 'Last' then - begin - j := StrToIntDef(ReplaceRegExpr( - '^.*/chapter-list/(\d+)/?$', GetVal(parse[i], 'href'), '$1', True), 0); - if j > p then p := j; - end; - end; - - //get the rest of chapters from another page - if p > 1 then - begin - for i := 2 to p do - begin - s := mangaInfo.url; - if s[Length(s)] <> '/' then s := s + '/'; - s := s + 'chapter-list/' + IntToStr(i) + '/'; - if GetPage(TObject(Source), s, Reconnect) then - begin - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - if parse.Count > 0 then - for j := 0 to parse.Count - 1 do - GetChapters(j); - end; - end; - end; - Source.Free; - - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end - else - Result := INFORMATION_NOT_FOUND; - end; diff --git a/baseunits/includes/SenManga/names_and_links.inc b/baseunits/includes/SenManga/names_and_links.inc deleted file mode 100644 index f388627b1..000000000 --- a/baseunits/includes/SenManga/names_and_links.inc +++ /dev/null @@ -1,35 +0,0 @@ - function SenMangaGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[SENMANGA_ID, 1] + - '/directory/all/any/last-added/' + IntToStr(StrToInt(URL) + 1) + '/', 3) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (GetTagName(parse[i]) = 'a') and (GetVal(parse[i], 'class') = 'lst mng_det_pop') then - begin - links.Add(GetVal(parse[i], 'href')); - names.Add(CommonStringFilter(GetVal(parse[i], 'title'))); - end; - Result := NO_ERROR; - end; - end; diff --git a/baseunits/includes/SenMangaRAW/chapter_page_number.inc b/baseunits/includes/SenMangaRAW/chapter_page_number.inc deleted file mode 100644 index ab9c676fc..000000000 --- a/baseunits/includes/SenMangaRAW/chapter_page_number.inc +++ /dev/null @@ -1,48 +0,0 @@ - function GetSenMangaRAWPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isExtractPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - try - if GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(SENMANGARAW_ID, URL + '/1')), - manager.container.manager.retryConnect) then - begin - Result := True; - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'select') and (GetVal(parse[i], 'name') = 'page') then - isExtractPageNumber := True; - if isExtractPageNumber then - begin - if GetTagName(parse[i]) = '/select' then - Break - else - if GetTagName(parse[i]) = 'option' then - manager.container.PageLinks.Add('G'); - end; - end; - end; - end - else - Result := False; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/SenMangaRAW/image_url.inc b/baseunits/includes/SenMangaRAW/image_url.inc deleted file mode 100644 index cede60a50..000000000 --- a/baseunits/includes/SenMangaRAW/image_url.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetSenMangaRAWImageURL: Boolean; - var - i: Integer; - s: String; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - try - s := manager.container.ChapterLinks[manager.container.CurrentDownloadChapterPtr] + - '/' + IntToStr(QWord(workCounter) + 1); - s := FillMangaSiteHost(SENMANGARAW_ID, s); - if GetPage(TObject(l), s, manager.container.Manager.retryConnect) then - begin - TURL := ''; - if l.Count > 0 then - for i := 0 to l.Count - 1 do - begin - if Pos('var new_image =', l[i]) <> 0 then - begin - TURL := StringReplace(l[i], 'var new_image = ''', '', [rfIgnoreCase]); - TURL := Trim(TrimChar(TURL, ['''', ';'])); - if (Length(TURL) > 0) and (TURL[1] = '/') then - TURL := WebsiteRoots[SENMANGARAW_ID, 1] + TURL; - Break; - end; - end; - Result := (TURL <> ''); - FHTTP.Clear; - FHTTP.Headers.Values['Referer'] := ' ' + s; - FHTTP.UserAgent := RandomString(10, True) + RandomString(25 + Random(65), True, False, True); - end - else - Result := False; - finally - parse.Free; - l.Free; - end; - end; diff --git a/baseunits/includes/SenMangaRAW/manga_information.inc b/baseunits/includes/SenMangaRAW/manga_information.inc deleted file mode 100644 index 6523228c9..000000000 --- a/baseunits/includes/SenMangaRAW/manga_information.inc +++ /dev/null @@ -1,115 +0,0 @@ -function GetSenMangaRAWInfoFromURL: Byte; -var - i, j: Integer; - isExtractChapters: Boolean = False; -begin - mangaInfo.website := WebsiteRoots[SENMANGARAW_ID, 0]; - mangaInfo.url := FillMangaSiteHost(SENMANGARAW_ID, URL); - if GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Parser := THTMLParser.Create(Source.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - parse.Clear; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if mangaInfo.title = '' then - if (GetTagName(parse[i]) = 'h1') then - if (GetTagName(parse[i + 1]) = 'a') then - mangaInfo.title := parse[i + 2]; - //cover - if mangaInfo.coverLink = '' then - if (GetTagName(parse[i]) = 'img') and (Pos('this.src =''/no_preview.jpg'';', parse[i]) > 0) then - begin - mangaInfo.coverLink := FixURL(GetVal(parse[i], 'src')); - if Pos('http', mangaInfo.coverLink) <> 1 then - begin - if LeftStr(mangaInfo.coverLink, 1) <> '/' then - mangaInfo.coverLink := '/' + mangaInfo.coverLink; - mangaInfo.coverLink := WebsiteRoots[SENMANGARAW_ID, 1] + mangaInfo.coverLink; - end; - end; - - if (GetTagName(parse[i]) = 'strong') and (GetVal(parse[i], 'class') = 'data') then - begin - //author - if Trim(parse[i + 1]) = 'Author:' then - mangaInfo.authors := parse[i + 5]; - //artist - if Trim(parse[i + 1]) = 'Artist:' then - mangaInfo.artists := parse[i + 5]; - //status - if Trim(parse[i + 1]) = 'Status:' then - begin - mangaInfo.status := Trim(parse[i + 5]); - if mangaInfo.status = 'Complete' then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end; - //genres - if Trim(parse[i + 1]) = 'Categorize in:' then - for j := i + 3 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = 'strong' then - Break - else - if GetTagName(parse[j]) = 'a' then - begin - if mangaInfo.genres = '' then - mangaInfo.genres := Trim(parse[j + 1]) - else - mangaInfo.genres := mangaInfo.genres + ', ' + Trim(parse[j + 1]); - end; - end; - //summary - if Trim(parse[i + 1]) = 'Summary:' then - for j := i + 3 to parse.Count - 1 do - begin - if GetTagName(parse[j]) = 'div' then - Break - else - if LeftStr(Trim(parse[j]), 1) <> '<' then - mangaInfo.summary := mangaInfo.summary + LineEnding + Trim(parse[j]); - end; - end; - - //chapters - if (GetTagName(parse[i]) = 'table') and (GetVal(parse[i], 'width') = '100%') then - isExtractChapters := True; - if isExtractChapters then - begin - if GetTagName(parse[i]) = '/table' then - isExtractChapters := False - else - if GetTagName(parse[i]) = 'a' then - begin - s := GetVal(parse[i], 'href'); - if RightStr(s, 2) = '/1' then - SetLength(s, Length(s) - 2); - mangaInfo.chapterLinks.Add(s); - mangaInfo.chapterName.Add(parse[i + 1]); - end; - end; - end; - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end - else - Result := INFORMATION_NOT_FOUND; - end - else - Result := NET_PROBLEM; -end; diff --git a/baseunits/includes/SenMangaRAW/names_and_links.inc b/baseunits/includes/SenMangaRAW/names_and_links.inc deleted file mode 100644 index 26a6c8247..000000000 --- a/baseunits/includes/SenMangaRAW/names_and_links.inc +++ /dev/null @@ -1,47 +0,0 @@ - function SenMangaRAWGetNamesAndLinks: Byte; - var - i: Integer; - isExtractNames: Boolean = False; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[SENMANGARAW_ID, 1] + - '/Manga/?order=text-version', 3) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(FixHTMLTagQuote(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - Source.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (GetTagName(parse[i]) = 'div') and (GetVal(parse[i], 'id') = 'content') then - isExtractNames := True; - if isExtractNames then - begin - if (GetTagName(parse[i]) = 'div') and - (GetVal(parse[i], 'class') = 'col-xm-12 col-sm-4 col-md-4') then - Break - else - if GetTagName(parse[i]) = 'a' then - if GetTagName(parse[i + 4]) = 'td' then - begin - names.Add(parse[i + 1]); - links.Add(GetVal(parse[i], 'href')); - end; - end; - end; - - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Starkana/chapter_page_number.inc b/baseunits/includes/Starkana/chapter_page_number.inc deleted file mode 100644 index 63b3ded51..000000000 --- a/baseunits/includes/Starkana/chapter_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetStarkanaPageNumber: Boolean; - var - i: Integer; - l: TStringList; - isGetPageNumber: Boolean = False; - begin - l := TStringList.Create; - parse := TStringList.Create; - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(STARKANA_ID, URL)), - manager.container.Manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<select', parse[i]) > 0) and (Pos('id="page_switch', parse[i]) > 0) then - isGetPageNumber := True; - if isGetPageNumber and (Pos('</select', parse[i]) > 0) then - Break; - if isGetPageNumber and (Pos('<option', parse[i]) > 0) then - Inc(manager.container.PageNumber); - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Starkana/image_url.inc b/baseunits/includes/Starkana/image_url.inc deleted file mode 100644 index 0f7c072b7..000000000 --- a/baseunits/includes/Starkana/image_url.inc +++ /dev/null @@ -1,29 +0,0 @@ - function GetStarkanaImageURL: Boolean; - var - i: Integer; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - DecodeUrl(FillMangaSiteHost(STARKANA_ID, URL) + '/' + IntToStr(workCounter + 1)), - manager.container.manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('<img', parse[i]) > 0) and (Pos('class="dyn', parse[i]) > 0) and - (Pos('style="cursor: pointer', parse[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Starkana/manga_information.inc b/baseunits/includes/Starkana/manga_information.inc deleted file mode 100644 index 0870821d3..000000000 --- a/baseunits/includes/Starkana/manga_information.inc +++ /dev/null @@ -1,93 +0,0 @@ - function GetStarkanaInfoFromURL: Byte; - var - i: Integer; - isExtractGenres: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[STARKANA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(STARKANA_ID, URL) + '?mature_confirm=1'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - - mangaInfo.genres := ''; - - for i := 0 to parse.Count - 1 do - begin - //cover - if (Pos('<a', parse[i]) > 0) and (Pos('class="olol', parse[i]) > 0) then - if (Pos('<img', parse[i + 1]) > 0) then - mangaInfo.coverLink := GetVal(parse[i + 1], 'src'); - - //title - if Pos('Title(s):', parse[i]) > 0 then - mangaInfo.title := CommonStringFilter(parse[i + 5]); - - //author(s) - if Pos('Author(s):', parse[i]) > 0 then - mangaInfo.authors := CommonStringFilter(parse[i + 7]); - - //artist(s) - if Pos('Artist(s):', parse[i]) > 0 then - mangaInfo.artists := CommonStringFilter(parse[i + 7]); - - //status - if Pos('Status:', parse[i]) > 0 then - if (Trim(LowerCase(parse[i + 7])) = 'ongoing') then - mangaInfo.status := '1' - else - mangaInfo.status := '0'; - - //summary - if Pos('Summary:', parse[i]) > 0 then - if Pos('valign="top"', parse[i - 2]) > 0 then - mangaInfo.summary := BreaksString(CommonStringFilter(parse[i + 7])); - - //genres - if Pos('Genres:', parse[i]) > 0 then - isExtractGenres := True; - if isExtractGenres and (Pos('</tr', parse[i]) > 0) then - isExtractGenres := False; - if isExtractGenres and (Pos('<', parse[i]) = 0) and - (Pos('Genres:', parse[i]) = 0) then - begin - parse[i] := Trim(parse[i]); - if parse[i] = ',' then - parse[i] := ', '; - mangaInfo.genres := mangaInfo.genres + parse[i]; - end; - - //chapter(s) - if Pos('class="download-link', parse[i]) > 0 then - begin - Inc(mangaInfo.numChapter); // 1, 3, 7 - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i], 'href'), - WebsiteRoots[STARKANA_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(CommonStringFilter( - Trim(parse[i + 1]) + ' ' + Trim(parse[i + 3]) + ' ' + Trim(parse[i + 7]))); - end; - end; - - //invert chapter(s) - if mangaInfo.chapterLinks.Count > 1 then - begin - InvertStrings(mangaInfo.chapterLinks); - InvertStrings(mangaInfo.chapterName); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Starkana/names_and_links.inc b/baseunits/includes/Starkana/names_and_links.inc deleted file mode 100644 index 70cfb6cc3..000000000 --- a/baseunits/includes/Starkana/names_and_links.inc +++ /dev/null @@ -1,34 +0,0 @@ - function StarkanaGetNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[STARKANA_ID, 1] + - STARKANA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('style="float:right;', parse[i]) > 0) then - begin - links.Add(GetVal(parse[i + 2], 'href')); - names.Add(CommonStringFilter(parse[i + 3])); - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/SubManga/chapter_page_number.inc b/baseunits/includes/SubManga/chapter_page_number.inc deleted file mode 100644 index be8bb2bb8..000000000 --- a/baseunits/includes/SubManga/chapter_page_number.inc +++ /dev/null @@ -1,54 +0,0 @@ - function GetSubMangaPageNumber: Boolean; - var - surl: String; - i: Integer; - l: TStringList; - nextPage: Boolean = True; - pageNum: Cardinal; - begin - pageNum := 1; - surl := FillMangaSiteHost(SUBMANGA_ID, URL); - l := TStringList.Create; - parse := TStringList.Create; - try - manager.container.PageLinks.Clear; - while nextPage do - begin - nextPage := False; - l.Clear; - parse.Clear; - Result := GetPage(TObject(l), surl, manager.container.manager.retryConnect); - Parser := THTMLParser.Create(l.Text); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - begin - if (not nextPage) and - ((GetTagName(parse[i]) = 'a') and - (GetTagName(parse[i + 1]) = 'span') and - (GetVal(parse[i + 1], 'class') = 'glyphicon glyphicon-chevron-right')) then - if Pos('/c/', GetVal(parse[i], 'href')) <> 0 then - begin - nextPage := True; - Inc(pageNum); - surl := FillMangaSiteHost(SUBMANGA_ID, URL) + '/' + IntToStr(pageNum); - end; - if GetTagName(parse[i]) = 'img' then - begin - manager.container.PageLinks.Add(GetVal(parse[i], 'src')); - Break; - end; - end; - end; - finally - parse.Free; - l.Free; - end; - manager.container.PageNumber := manager.container.PageLinks.Count; - end; diff --git a/baseunits/includes/SubManga/image_url.inc b/baseunits/includes/SubManga/image_url.inc deleted file mode 100644 index 831bf50d9..000000000 --- a/baseunits/includes/SubManga/image_url.inc +++ /dev/null @@ -1,30 +0,0 @@ - function GetSubMangaImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(SUBMANGA_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if GetTagName(parse[i]) = 'img' then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[i], 'src'); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/SubManga/manga_information.inc b/baseunits/includes/SubManga/manga_information.inc deleted file mode 100644 index 9872d12e5..000000000 --- a/baseunits/includes/SubManga/manga_information.inc +++ /dev/null @@ -1,133 +0,0 @@ - function GetSubMangaInfoFromURL: Byte; - var - s: String; - i, j: Integer; - isGetChapters: Boolean = False; - begin - mangaInfo.url := FillMangaSiteHost(SUBMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - mangaInfo.website := WebsiteRoots[SUBMANGA_ID, 0]; - - mangaInfo.genres := ''; - mangaInfo.status := '1'; - - // using 1st parser (cover link, summary) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('content="Leer ', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i], 'content="Leer ', ' manga online'); - - if Pos('class="suscripcion', parse.Strings[i]) > 0 then - begin - // get cover link - if Pos('<img', parse.Strings[i + 5]) > 0 then - mangaInfo.coverLink := - GetAttributeValue(GetTagAttribute(parse.Strings[i + 5], 'src')); - // get summary - j := i + 8; - while (j < parse.Count - 1) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - Inc(j); - s := parse.Strings[j]; - if (s <> '') and - (s[1] <> '<') then - begin - parse.Strings[j] := StringFilter(parse.Strings[j]); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - end; - end; - - // get authors/artists - if (Pos('Creado por', parse.Strings[i]) <> 0) then - begin - if Pos('/autor/', parse.Strings[i + 1]) > 0 then - mangaInfo.authors := parse.Strings[i + 2]; - if Pos('/mangaka/', parse.Strings[i + 5]) > 0 then - mangaInfo.authors := parse.Strings[i + 6]; - end; - - // get genres - if (Pos('submanga.com/genero/', parse.Strings[i]) <> 0) then - mangaInfo.genres := mangaInfo.genres + parse.Strings[i + 1] + ', '; - end; - - // get chapters - Source.Clear; - if not GetPage(TObject(Source), mangaInfo.url + '/completa', Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - try - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - finally - Parser.Free; - end; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - // get chapters - if (GetTagName(parse[i]) = 'table') and - (GetVal(parse[i], 'class') = 'table table-striped table-hover') then - isGetChapters := True; - if isGetChapters and (GetTagName(parse[i]) = '/table') then - Break; - if isGetChapters and - ((GetTagName(parse[i]) = 'a') and (GetTagName(parse[i - 1]) = 'td') and - (GetTagName(parse[i - 2]) = 'tr')) then - if Length(GetVal(parse[i], 'href')) > 3 then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterName.Add(CommonStringFilter( - Trim(parse[i + 1]) + ' ' + Trim(parse[i + 3]))); - mangaInfo.chapterLinks.Add(GetVal(parse[i], 'href')); - end; - end; - end; - Source.Free; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - // replace urls - with TRegExpr.Create do - try - Expression := '^.*(/\d+)$'; - for i := 0 to mangaInfo.chapterLinks.Count - 1 do - mangaInfo.chapterLinks[i] := Replace(mangaInfo.chapterLinks[i], '/c/$1', True); - finally - Free; - end; - Result := NO_ERROR; - end; - end; diff --git a/baseunits/includes/SubManga/names_and_links.inc b/baseunits/includes/SubManga/names_and_links.inc deleted file mode 100644 index 048ed1ae4..000000000 --- a/baseunits/includes/SubManga/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function SubMangaGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[SUBMANGA_ID, 1] + - SUBMANGA_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="xs"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 3]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i - 1], 'href=')); - links.Add(StringReplace(s, WebsiteRoots[SUBMANGA_ID, 1], '', [])); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/TruyenTranhTuan/image_url.inc b/baseunits/includes/TruyenTranhTuan/image_url.inc deleted file mode 100644 index 0140064fb..000000000 --- a/baseunits/includes/TruyenTranhTuan/image_url.inc +++ /dev/null @@ -1,39 +0,0 @@ - function GetTruyenTranhTuanImageURL: Boolean; - var - s, s2: String; - j, i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(TRUYENTRANHTUAN_ID, URL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('var slides_page = ["', parse.Strings[i]) > 0 then - begin - s := parse.Strings[i]; - repeat - j := Pos('"/manga/', s); - s2 := EncodeUrl(WebsiteRoots[TRUYENTRANHTUAN_ID, 1] + '/manga/' + - GetString(s, '"/manga/', '"')); - manager.container.PageLinks.Add(s2); - Delete(s, Pos('"/manga/', s), 10); - j := Pos('"/manga/', s); - until j = 0; - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/TruyenTranhTuan/manga_information.inc b/baseunits/includes/TruyenTranhTuan/manga_information.inc deleted file mode 100644 index ff81ec909..000000000 --- a/baseunits/includes/TruyenTranhTuan/manga_information.inc +++ /dev/null @@ -1,121 +0,0 @@ - function GetTruyenTranhTuanInfoFromURL: Byte; - var - s: String; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(TRUYENTRANHTUAN_ID, URL);// + '&confirm=yes'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[TRUYENTRANHTUAN_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get cover - if (GetTagName(parse.Strings[i]) = 'meta') and - (Pos('property="og:image"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'content='))); - - // get summary - if (Pos('id="manga-summary"', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := mangaInfo.summary + parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get title - if (Pos('<title>', parse.Strings[i]) <> 0) and (mangaInfo.title = '') then - mangaInfo.title := Trim(StringFilter(GetString('~!@' + parse.Strings[i + 1], - '~!@', ' - Truyện tranh online - truyentranhtuan.com'))); - - // get chapter name and links - if (Pos('class="chapter-name"', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := GetString(parse.Strings[i + 2], 'href="', '"'); - s := StringReplace(s, WebsiteRoots[TRUYENTRANHTUAN_ID, 1], '', []); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(Trim(parse.Strings[i + 3])); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - - // get authors - if (i + 1 < parse.Count) and (Pos('Tác giả:', parse.Strings[i]) <> 0) then - mangaInfo.authors := Trim(parse.Strings[i + 2]); - - // get artists - //if (i+1<parse.Count) AND (Pos('/search/artist/', parse.Strings[i])<>0) then - // mangaInfo.artists:= TrimLeft(parse.Strings[i+1]); - - // get genres - if (Pos('Thể loại:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if Pos('<a href=', parse.Strings[i]) <> 0 then - mangaInfo.genres := mangaInfo.genres + - TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '; - if Pos('</span>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 5 < parse.Count) and (Pos('Chương mới nhất', parse.Strings[i]) <> 0) then - begin - if Pos('dang-tien-hanh', parse.Strings[i + 1]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/TruyenTranhTuan/names_and_links.inc b/baseunits/includes/TruyenTranhTuan/names_and_links.inc deleted file mode 100644 index 56a215e72..000000000 --- a/baseunits/includes/TruyenTranhTuan/names_and_links.inc +++ /dev/null @@ -1,38 +0,0 @@ - function TruyenTranhTuanGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[TRUYENTRANHTUAN_ID, 1] + - TRUYENTRANHTUAN_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('class="manga"', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 2]))); - names.Add(HTMLEntitiesFilter(s)); - s := GetAttributeValue(GetTagAttribute(parse.Strings[i + 1], 'href=')); - s := StringReplace(s, WebsiteRoots[TRUYENTRANHTUAN_ID, 1], '', []); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/Turkcraft/chapter_page_number.inc b/baseunits/includes/Turkcraft/chapter_page_number.inc deleted file mode 100644 index acdeb6a4f..000000000 --- a/baseunits/includes/Turkcraft/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetTurkcraftPageNumber: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - parse := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(TURKCRAFT_ID, URL) + '/1'); - Result := GetPage(TObject(l), - s, - manager.container.manager.retryConnect); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.pageNumber := 0; - for i := 0 to parse.Count - 1 do - begin - if (Pos('title="Next Page"', parse.Strings[i]) > 0) then - begin - s := parse.Strings[i - 5]; - manager.container.PageNumber := StrToInt(TrimLeft(TrimRight(s))); - Break; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Turkcraft/image_url.inc b/baseunits/includes/Turkcraft/image_url.inc deleted file mode 100644 index 000925d8c..000000000 --- a/baseunits/includes/Turkcraft/image_url.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetTurkcraftImageURL: Boolean; - var - s: String; - i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - s := DecodeUrl(FillMangaSiteHost(TURKCRAFT_ID, URL) + '/' + IntToStr(workCounter + 1)); - Result := GetPage(TObject(l), - s, - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - if (Pos('class="picture"', parse.Strings[i]) > 0) then - begin - manager.container.PageLinks.Strings[workCounter] := - EncodeURL(WebsiteRoots[TURKCRAFT_ID, 1] + TURKCRAFT_BROWSER + - GetAttributeValue(GetTagAttribute(parse.Strings[i], 'src='))); - Break; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/Turkcraft/manga_information.inc b/baseunits/includes/Turkcraft/manga_information.inc deleted file mode 100644 index d58537fca..000000000 --- a/baseunits/includes/Turkcraft/manga_information.inc +++ /dev/null @@ -1,73 +0,0 @@ - function GetTurkcraftInfoFromURL: Byte; - var - s: String; - isExtractChapter: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(TURKCRAFT_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - - mangaInfo.website := WebsiteRoots[TURKCRAFT_ID, 0]; - mangaInfo.status := '1'; - mangaInfo.coverLink := ''; - mangaInfo.summary := ''; - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get chapter name and links - if (Pos('select name="chapter"', parse.Strings[i]) > 0) then - isExtractChapter := True; - - // get manga name - if (mangaInfo.title = '') and (Pos('Mangaturk - ', parse.Strings[i]) > 0) then - mangaInfo.title := GetString(parse.Strings[i], 'Mangaturk - ', ' - Chapter'); - - if (isExtractChapter) and (Pos('</select>', parse.Strings[i]) > 0) then - Break; - - if (isExtractChapter) and (Pos('option value=', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - s := URL + '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - mangaInfo.chapterLinks.Add(s); - s := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(StringFilter(HTMLEntitiesFilter(s)))); - end; - end; - - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/Turkcraft/names_and_links.inc b/baseunits/includes/Turkcraft/names_and_links.inc deleted file mode 100644 index ee4662003..000000000 --- a/baseunits/includes/Turkcraft/names_and_links.inc +++ /dev/null @@ -1,37 +0,0 @@ - function TurkcraftGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[TURKCRAFT_ID, 1] + - TURKCRAFT_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := parse.Count - 1 downto 5 do - begin - if (Pos('<option value="', parse.Strings[i]) > 0) then - begin - Result := NO_ERROR; - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - s := '/' + GetAttributeValue(GetTagAttribute(parse.Strings[i], 'value=')); - links.Add(s); - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/UnionMangas/chapter_page_number.inc b/baseunits/includes/UnionMangas/chapter_page_number.inc deleted file mode 100644 index 28ee69d2a..000000000 --- a/baseunits/includes/UnionMangas/chapter_page_number.inc +++ /dev/null @@ -1,33 +0,0 @@ - function GetUnionMangasPageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(UNIONMANGAS_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - CleanHTMLComments(l); - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if (Pos('<img', parse[i]) > 0) and (Pos('class="real', parse[i]) > 0) and - (Pos('data-lazy', parse[i]) > 0) then - manager.container.PageLinks.Add(GetVal(parse[i], 'data-lazy')); - end; - manager.container.PageNumber := manager.container.PageLinks.Count; - end; - parse.Free; - end; diff --git a/baseunits/includes/UnionMangas/directory_page_number.inc b/baseunits/includes/UnionMangas/directory_page_number.inc deleted file mode 100644 index 176e1176e..000000000 --- a/baseunits/includes/UnionMangas/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetUnionMangasDirectoryPageNumber: Byte; - var - i, p: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[UNIONMANGAS_ID, 1] + - UNIONMANGAS_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - CleanHTMLComments(Source); - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - Page := 1; - for i := parse.Count - 1 downto 2 do - begin //http://unionmangas.com.br/mangas/a-z/2/* - if (Pos('<a', parse[i]) > 0) and (Pos('/mangas/a-z/', parse[i]) > 0) then - begin - p := StrToIntDef(ReplaceRegExpr('^.*/a-z/(\d+)/.*$', GetVal(parse[i], 'href'), '$1', True), 0); - if Page < p then - Page := p; - end; - end; - Source.Free; - end; diff --git a/baseunits/includes/UnionMangas/manga_information.inc b/baseunits/includes/UnionMangas/manga_information.inc deleted file mode 100644 index 3600f145b..000000000 --- a/baseunits/includes/UnionMangas/manga_information.inc +++ /dev/null @@ -1,86 +0,0 @@ - function GetUnionMangasInfoFromURL: Byte; - var - i: Integer; - begin - mangaInfo.website := WebsiteRoots[UNIONMANGAS_ID, 0]; - mangaInfo.url := FillMangaSiteHost(UNIONMANGAS_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Source.Free; - Exit; - end; - - CleanHTMLComments(Source); - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - mangaInfo.authors := ''; - mangaInfo.artists := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count - 1 do - begin - //title - if (i + 1 < parse.Count - 1) then - if (Pos(' - Union Mang', parse[i]) > 0) then - mangaInfo.title := CommonStringFilter(ReplaceRegExpr('\s-\sUnion\sMang.*$', parse[i], '', False)); - - //cover - if (Pos('<img', parse[i]) > 0) and (Pos('class="img-thumbnail', parse[i]) > 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - - //authors - if (i + 2 < parse.Count - 1) then - if (Pos('Autor:', parse[i]) > 0) and (Pos('</label', parse[i + 1]) > 0) then - mangaInfo.authors := CommonStringFilter(parse[i + 2]); - - //artists - if (i + 2 < parse.Count - 1) then - if (Pos('Artista:', parse[i]) > 0) and (Pos('</label', parse[i + 1]) > 0) then - mangaInfo.artists := CommonStringFilter(parse[i + 2]); - - //category/genre - if (i + 2 < parse.Count - 1) then - if (Pos('Gênero(s):', parse[i]) > 0) and (Pos('</label', parse[i + 1]) > 0) then - mangaInfo.genres := CommonStringFilter(parse[i + 2]); - - //status - if (i + 1 < parse.Count - 1) then - if (Pos('class="label label-info"', parse[i]) > 0) then - if Trim(LowerCase(parse[i + 1])) = 'completo' then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - - //sinopsis - if (i + 1 < parse.Count - 1) then - if (Pos('class="panel-body"', parse[i]) > 0)then - mangaInfo.summary := BreaksString(CommonStringFilter(parse[i + 1])); - - //chapters - if (i + 7 < parse.Count - 1) then - if Pos('class="row lancamento-linha', parse[i]) > 0 then - begin - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i + 6], 'href'), - WebsiteRoots[UNIONMANGAS_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(CommonStringFilter(parse[i + 7])); - end; - end; - - if mangaInfo.chapterName.Count > 1 then - begin - // invert chapter - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/UnionMangas/names_and_links.inc b/baseunits/includes/UnionMangas/names_and_links.inc deleted file mode 100644 index 9cfb549d2..000000000 --- a/baseunits/includes/UnionMangas/names_and_links.inc +++ /dev/null @@ -1,39 +0,0 @@ - function UnionMangasNamesAndLinks: Byte; - var - i: Integer; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), - WebsiteRoots[UNIONMANGAS_ID, 1] + UNIONMANGAS_BROWSER + '/a-z/' + - IntToStr(StrToInt(URL) + 1) + '/*', 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - CleanHTMLComments(Source); - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - - for i := 0 to parse.Count - 1 do - begin - if (Pos('<a', parse[i]) > 0) and (Pos('class="capa_', parse[i]) > 0) and - (i + 6 < parse.Count - 1) then - begin - names.Add(CommonStringFilter(parse[i + 6])); - links.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[UNIONMANGAS_ID, 1], '', [rfIgnoreCase])); - end; - end; - Result := NO_ERROR; - Source.Free; - end; diff --git a/baseunits/includes/UnixManga/chapter_page_number.inc b/baseunits/includes/UnixManga/chapter_page_number.inc deleted file mode 100644 index 310d4899f..000000000 --- a/baseunits/includes/UnixManga/chapter_page_number.inc +++ /dev/null @@ -1,32 +0,0 @@ - function GetUnixMangaPageNumber: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - manager.container.PageNumber := 0; - l := TStringList.Create; - parse := TStringList.Create; - s := FillMangaSiteHost(UNIXMANGA_ID, URL); - Result := GetPage(TObject(l), s, manager.container.Manager.retryConnect); - - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - manager.container.PageNumber := 0; - manager.container.PageLinks.Clear; - manager.container.PageContainerLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if (Pos('class="td2"', parse[i]) > 0) and (Pos('<A', parse[i]) > 0) then - manager.container.PageContainerLinks.Add(EncodeURL(GetVal(parse[i], 'HREF'))); - end; - manager.container.PageNumber := manager.container.PageContainerLinks.Count; - end; - parse.Free; - end; diff --git a/baseunits/includes/UnixManga/image_url.inc b/baseunits/includes/UnixManga/image_url.inc deleted file mode 100644 index 9f7090fae..000000000 --- a/baseunits/includes/UnixManga/image_url.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetUnixMangaImageURL: Boolean; - var - i: Integer; - l: TStringList; - s: String; - begin - l := TStringList.Create; - s := manager.container.PageContainerLinks[workCounter]; - Result := GetPage(TObject(l), s , manager.container.Manager.retryConnect); - - if Self.Terminated then - begin - l.Free; - parse.Free; - Exit; - end; - - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - l.Free; - if parse.Count > 0 then - begin - for i := 0 to parse.Count - 1 do - begin - if (Pos('STYLE="border', parse[i]) > 0) and (Pos('<IMG', parse[i]) > 0) then - begin - manager.container.PageLinks[workCounter] := Trim(GetVal(parse[i], 'SRC')); - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/UnixManga/manga_information.inc b/baseunits/includes/UnixManga/manga_information.inc deleted file mode 100644 index 842d5a44e..000000000 --- a/baseunits/includes/UnixManga/manga_information.inc +++ /dev/null @@ -1,52 +0,0 @@ - function GetUnixMangaInfoFromURL: Byte; - var - i: Integer; - isExtractChapters: Boolean = False; - begin - mangaInfo.website := WebsiteRoots[UNIXMANGA_ID, 0]; - mangaInfo.url := FillMangaSiteHost(UNIXMANGA_ID, URL); - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - - if parse.Count = 0 then - Exit; - - for i := 0 to parse.Count - 1 do - begin - //chapters - if (Pos('<table', parse[i]) > 0) and (Pos('class="snif"', parse[i]) > 0) then - isExtractChapters := True; - if isExtractChapters and (Pos('</table', parse[i]) > 0) then - isExtractChapters := False; - if (i + 1 < parse.Count - 1) then - if isExtractChapters and (Pos('/onlinereading/', parse[i]) > 0) and - (Pos('title=', parse[i]) > 0) and (Pos('<a ', parse[i]) > 0) and - (Pos('/index.php', parse[i]) = 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[UNIXMANGA_ID, 1], '', [rfIgnoreCase])); - mangaInfo.chapterName.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - end; - end; - - // invert chapters - if mangaInfo.chapterName.Count > 1 then - begin - InvertStrings(mangaInfo.chapterName); - InvertStrings(mangaInfo.chapterLinks); - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/UnixManga/names_and_links.inc b/baseunits/includes/UnixManga/names_and_links.inc deleted file mode 100644 index 0c5dc6c72..000000000 --- a/baseunits/includes/UnixManga/names_and_links.inc +++ /dev/null @@ -1,33 +0,0 @@ - function UnixMangaNamesAndLinks: Byte; - var - i: Integer; - s: String; - begin - Result := INFORMATION_NOT_FOUND; - s := WebsiteRoots[UNIXMANGA_ID, 1] + UNIXMANGA_BROWSER; - if not GetPage(TObject(Source), s, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - Source.Free; - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/onlinereading/', parse[i]) > 0) and - (Pos('title=', parse[i]) > 0) and (Pos('<a ', parse[i]) > 0) then - begin - Result := NO_ERROR; - names.Add(Trim(HTMLEntitiesFilter(StringFilter(Trim(parse[i + 1]))))); - links.Add(Trim(StringReplace(GetVal(parse[i], 'href'), WebsiteRoots[UNIXMANGA_ID, 1], '', [rfIgnoreCase]))); - end; - end; - end; diff --git a/baseunits/includes/VnSharing/directory_page_number.inc b/baseunits/includes/VnSharing/directory_page_number.inc deleted file mode 100644 index a04a26e3a..000000000 --- a/baseunits/includes/VnSharing/directory_page_number.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetVnSharingDirectoryPageNumber: Byte; - var - i: Cardinal; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[VNSHARING_ID, 1] + - VNSHARING_BROWSER, 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('»', parse.Strings[i]) > 0) then - begin - s := GetAttributeValue(GetTagAttribute(parse.Strings[i - 1], 'page=')); - SetLength(s, Length(s) - 1); - Page := StrToInt(s); - Result := NO_ERROR; - Source.Free; - Exit; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/VnSharing/image_url.inc b/baseunits/includes/VnSharing/image_url.inc deleted file mode 100644 index 51588fc7a..000000000 --- a/baseunits/includes/VnSharing/image_url.inc +++ /dev/null @@ -1,37 +0,0 @@ - function GetVnSharingImageURL: Boolean; - var - s: String; - j, i: Cardinal; - l: TStringList; - begin - l := TStringList.Create; - Result := GetPage(TObject(l), - FillMangaSiteHost(VNSHARING_ID, URL), - manager.container.Manager.retryConnect); - parse := TStringList.Create; - Parser := THTMLParser.Create(PChar(l.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count > 0 then - begin - manager.container.PageLinks.Clear; - for i := 0 to parse.Count - 1 do - begin - if Pos('lstImages.push("', parse.Strings[i]) > 0 then - begin - s := parse.Strings[i]; - repeat - j := Pos('lstImages.push("', s); - manager.container.PageLinks.Add( - EncodeUrl(GetString(s, 'lstImages.push("', '");'))); - Delete(s, Pos('lstImages.push("', s), 16); - j := Pos('lstImages.push("', s); - until j = 0; - end; - end; - end; - parse.Free; - l.Free; - end; diff --git a/baseunits/includes/VnSharing/manga_information.inc b/baseunits/includes/VnSharing/manga_information.inc deleted file mode 100644 index 67cd59a0b..000000000 --- a/baseunits/includes/VnSharing/manga_information.inc +++ /dev/null @@ -1,130 +0,0 @@ - function GetVnSharingInfoFromURL: Byte; - var - s: String; - isExtractSummary: Boolean = True; - isExtractGenres: Boolean = False; - i, j: Cardinal; - begin - mangaInfo.url := FillMangaSiteHost(VNSHARING_ID, URL) + '&confirm=yes'; - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - // parsing the HTML source - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - - Parser.Free; - Source.Free; - mangaInfo.website := WebsiteRoots[VNSHARING_ID, 0]; - // using parser (cover link, summary, chapter name and link) - if parse.Count = 0 then - Exit; - for i := 0 to parse.Count - 1 do - begin - // get manga title - if (mangaInfo.title = '') and - (Pos('name="title"', parse.Strings[i]) > 0) then - mangaInfo.title := TrimLeft(TrimRight(GetString(parse.Strings[i], - '"Truyện ', ' | Đọc online'))); - - // get cover - if (GetTagName(parse.Strings[i]) = 'img') and - (Pos('img width="190px" height="250px"', parse.Strings[i]) > 0) then - mangaInfo.coverLink := CorrectURL(GetAttributeValue( - GetTagAttribute(parse.Strings[i], 'src='))); - - // get summary - if (Pos('Sơ lược:', parse.Strings[i]) <> 0) and - (isExtractSummary) then - begin - j := i + 4; - while (j < parse.Count) and (Pos('</p>', parse.Strings[j]) = 0) do - begin - s := parse.Strings[j]; - if s[1] <> '<' then - begin - parse.Strings[j] := HTMLEntitiesFilter(StringFilter(parse.Strings[j])); - parse.Strings[j] := StringReplace(parse.Strings[j], #10, '\n', [rfReplaceAll]); - parse.Strings[j] := StringReplace(parse.Strings[j], #13, '\r', [rfReplaceAll]); - mangaInfo.summary := parse.Strings[j]; - end; - Inc(j); - end; - isExtractSummary := False; - end; - - // get chapter name and links - if (i + 1 < parse.Count) and - (GetTagName(parse.Strings[i]) = 'a') and - (Pos('/Truyen/', parse.Strings[i]) > 0) and - (Pos('title="Đọc', parse.Strings[i]) > 0) then - begin - Inc(mangaInfo.numChapter); - mangaInfo.chapterLinks.Add( - EncodeUrl(GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')))); - parse.Strings[i + 1] := RemoveSymbols(TrimLeft(TrimRight(parse.Strings[i + 1]))); - mangaInfo.chapterName.Add(StringFilter(HTMLEntitiesFilter(parse.Strings[i + 1]))); - end; - - // get authors - if (i + 4 < parse.Count) and (Pos('Tác giả:', parse.Strings[i]) <> 0) then - mangaInfo.authors := TrimLeft(parse.Strings[i + 4]); - - // get artists - if (i + 4 < parse.Count) and (Pos('Họa sỹ:', parse.Strings[i]) <> 0) then - mangaInfo.artists := TrimLeft(parse.Strings[i + 4]); - - // get genres - if (Pos('Thể loại:', parse.Strings[i]) <> 0) then - begin - isExtractGenres := True; - mangaInfo.genres := ''; - end; - - if isExtractGenres then - begin - if (i + 1 < parse.Count) and (Pos('"/TheLoai/', parse.Strings[i]) > 0) then - mangaInfo.genres := mangaInfo.genres + - (TrimLeft(TrimRight(parse.Strings[i + 1])) + ', '); - if Pos('</p>', parse.Strings[i]) <> 0 then - isExtractGenres := False; - end; - - // get status - if (i + 2 < parse.Count) and (Pos('Tình trạng:', parse.Strings[i]) <> 0) then - begin - if Pos('Đang tiến hành', parse.Strings[i + 2]) <> 0 then - mangaInfo.status := '1' // ongoing - else - mangaInfo.status := '0'; // completed - end; - end; - - if (mangaInfo.status = '1') and (mangainfo.ChapterName.Count > 0) then - begin - Dec(mangaInfo.numChapter); - mangainfo.ChapterName.Delete(mangainfo.ChapterName.Count - 1); - mangainfo.ChapterLinks.Delete(mangainfo.ChapterLinks.Count - 1); - end; - // Since chapter name and link are inverted, we need to invert them - if mangainfo.ChapterLinks.Count > 1 then - begin - i := 0; - j := mangainfo.ChapterLinks.Count - 1; - while (i < j) do - begin - mangainfo.ChapterName.Exchange(i, j); - mangainfo.chapterLinks.Exchange(i, j); - Inc(i); - Dec(j); - end; - end; - Result := NO_ERROR; - end; diff --git a/baseunits/includes/VnSharing/names_and_links.inc b/baseunits/includes/VnSharing/names_and_links.inc deleted file mode 100644 index 8c337856f..000000000 --- a/baseunits/includes/VnSharing/names_and_links.inc +++ /dev/null @@ -1,48 +0,0 @@ - function VnSharingGetNamesAndLinks: Byte; - var - i: Cardinal; - s: String; - - begin - Result := INFORMATION_NOT_FOUND; - // bad code - if not GetPage(TObject(Source), WebsiteRoots[VNSHARING_ID, 1] + - VNSHARING_BROWSER + '?page=' + IntToStr(StrToInt(URL) + 1), 0) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - parse.Clear; - Parser := THTMLParser.Create(PChar(Source.Text)); - Parser.OnFoundTag := OnTag; - Parser.OnFoundText := OnText; - Parser.Exec; - Parser.Free; - if parse.Count = 0 then - begin - Source.Free; - Exit; - end; - for i := 0 to parse.Count - 1 do - begin - if (Pos('/Truyen/', parse.Strings[i]) > 0) and - (GetAttributeValue(GetTagAttribute(parse.Strings[i], 'width=')) <> '') then - begin - { if NOT isGetNamesAndLinks then - isGetNamesAndLinks:= TRUE - else - begin } - Result := NO_ERROR; - s := GetAttributeValue(GetTagAttribute(parse.Strings[i], 'href=')); - // if s <> '/Truyen/Tenki-Yohou-no-Koibito?id=506' then - if s <> '/Truyen/Bakuman-Fantasy-Weirdos?id=6238' then - begin - links.Add(s); - s := StringFilter(TrimLeft(TrimRight(parse.Strings[i + 1]))); - names.Add(HTMLEntitiesFilter(s)); - end; - end; - end; - Source.Free; - end; \ No newline at end of file diff --git a/baseunits/includes/WPManga/chapter_page_number.inc b/baseunits/includes/WPManga/chapter_page_number.inc deleted file mode 100644 index 42bb51f82..000000000 --- a/baseunits/includes/WPManga/chapter_page_number.inc +++ /dev/null @@ -1,46 +0,0 @@ - function GetWPMangaPageNumber: Boolean; - var - s: String; - i, j: Integer; - Source: TStringList; - begin - s := FillMangaSiteHost(manager.container.MangaSiteID, URL); - if RightStr(s, 1) <> '/' then - s += '/'; - s += '1/'; - - Source := TStringList.Create; - Result := GetPage(TObject(Source), s, manager.container.manager.retryConnect); - - if not Result then - begin - Source.Free; - Exit; - end; - - parse := TStringList.Create; - ParseHTML(Source.Text, parse); - Source.Free; - - if parse.Count > 0 then - begin - for i := 0 to parse.Count-1 do - begin - if (GetTagName(parse[i]) = 'select') and - (GetVal(parse[i], 'class') = 'cbo_wpm_pag') then - begin - for j := i+1 to parse.Count-1 do - begin - s := GetTagName(parse[j]); - if s = '/select' then - Break - else - if s = 'option' then - Inc(manager.container.PageNumber); - end; - Break; - end; - end; - end; - parse.Free; - end; diff --git a/baseunits/includes/WPManga/directory_page_number.inc b/baseunits/includes/WPManga/directory_page_number.inc deleted file mode 100644 index 49343d4ba..000000000 --- a/baseunits/includes/WPManga/directory_page_number.inc +++ /dev/null @@ -1,27 +0,0 @@ - function GetWPMangaDirectoryPageNumber: Byte; - var - i: Integer; - const - dirURL = '/manga-list/all/any/last-added/'; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[WebsiteID, 1] + - dirURL, 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - - if parse.Count > 0 then - for i := parse.Count-1 downto 0 do - if Pos(dirURL, parse[i]) <> 0 then - begin - Page := StrToIntDef(ReplaceRegExpr('^.*'+dirURL+'(\d+)/$', - GetVal(parse[i], 'href'), '$1', True), 1); - Break; - end; - end; diff --git a/baseunits/includes/WPManga/image_url.inc b/baseunits/includes/WPManga/image_url.inc deleted file mode 100644 index 08b024371..000000000 --- a/baseunits/includes/WPManga/image_url.inc +++ /dev/null @@ -1,38 +0,0 @@ - function GetWPMangaImageURL: Boolean; - var - s: String; - i, j: Integer; - Source: TStringList; - begin - s := FillMangaSiteHost(manager.container.MangaSiteID, URL); - if RightStr(s, 1) <> '/' then - s += '/'; - s += IntToStr(QWord(workCounter)+1) + '/'; - - Source := TStringList.Create; - Result := GetPage(TObject(Source), s, manager.container.Manager.retryConnect); - - if not Result then - begin - Source.Free; - Exit; - end; - - parse := TStringList.Create; - ParseHTML(Source.Text, parse); - Source.Free; - - if parse.Count > 0 then - for i := 0 to parse.Count - 1 do - if (GetVal(parse[i], 'class') = 'wpm_pag mng_rdr') then - begin - for j := i+1 to parse.Count-1 do - if GetTagName(parse[j]) = 'img' then - begin - manager.container.PageLinks.Strings[workCounter] := GetVal(parse[j], 'src'); - Break; - end; - Break; - end; - parse.Free; - end; diff --git a/baseunits/includes/WPManga/manga_information.inc b/baseunits/includes/WPManga/manga_information.inc deleted file mode 100644 index e66003fcd..000000000 --- a/baseunits/includes/WPManga/manga_information.inc +++ /dev/null @@ -1,210 +0,0 @@ - function GetWPMangaInfoFromURL: Byte; - var - s: String; - i, j: Integer; - isSummaryDone: Boolean = False; - isInfo: Boolean = False; - isInvertChapters: Boolean = True; - pnumber: Integer = 1; - - procedure FindChapters; - var - x, y: Integer; - StartFindPage: Boolean = False; - begin - if parse.Count > 0 then - for x := 0 to parse.Count-1 do - begin - s := LowerCase(GetVal(parse[x], 'class')); - if (GetTagName(parse[x]) = 'ul') and - (AnsiIndexText(s, ['lst', 'chp_lst']) > -1) then - begin - StartFindPage := True; - if s = 'chp_lst' then - isInvertChapters := False; - end; - if StartFindPage then - begin - if GetTagName(parse[x]) = '/ul' then - Break - else - if GetTagName(parse[x]) = 'a' then - begin - if Pos('class="c4', parse[x]) = 0 then - begin - mangaInfo.chapterLinks.Add(GetVal(parse[x], 'href')); - s := ''; - for y := x+1 to parse.Count-1 do - begin - s := Trim(parse[y]); - if (s <> '') and (Pos('<', s) <> 1) then - Break; - end; - mangaInfo.chapterName.Add(CommonStringFilter(s)); - end; - end; - end; - end; - end; - - begin - mangaInfo.website := WebsiteRoots[WebsiteID, 0]; - mangaInfo.url := FillMangaSiteHost(WebsiteID, URL); - - if RightStr(mangaInfo.url, 1) <> '/' then - mangaInfo.url += '/'; - - if not GetPage(TObject(Source), mangaInfo.url, Reconnect) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - - if parse.Count > 0 then - begin - mangaInfo.genres := ''; - mangaInfo.summary := ''; - for i := 0 to parse.Count-1 do - begin - //cover - if mangaInfo.coverLink = '' then - begin - if (Pos('<img ', parse[i]) <> 0) and - (Pos('class="cvr', parse[i]) <> 0) then - mangaInfo.coverLink := GetVal(parse[i], 'src'); - end; - - //title - if mangaInfo.title = '' then - begin - if (Pos('class="ttl"', parse[i]) <> 0) or - (Pos('itemprop="itemreviewed"', parse[i]) <> 0) - then - mangaInfo.title := CommonStringFilter(parse[i+1]) - end; - - //details - s := GetVal(parse[i], 'class'); - if (GetTagName(parse[i]) = 'div') and - (AnsiIndexText(s, ['det', 'lts_chp fr', 'mng_ifo']) > -1) then - isInfo := True; - if isInfo then - begin - if GetTagName(parse[i]) = 'h2' then - isInfo := False - else - begin - s := Trim(parse[i]); - //author - if s = 'Author' then - mangaInfo.authors := CommonStringFilter( - TrimLeftChar(parse[i+2], [':', ' '])) - else - if Pos('/author/', s) <> 0 then - mangaInfo.authors := CommonStringFilter(parse[i+1]) - //artist - else - if s = 'Artist' then - mangaInfo.artists := CommonStringFilter( - TrimLeftChar(parse[i+2], [':', ' '])) - //status - else - if s = 'Status' then - begin - if Pos('completed', LowerCase(parse[i+2])) <> 0 then - mangaInfo.status := '0' - else - mangaInfo.status := '1'; - end - //genres - else - if (s = 'Category') or (s = 'Genres') then - begin - for j := i+3 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/p' then - Break - else - if Pos('<', parse[j]) = 0 then - AddCommaString(mangaInfo.genres, CommonStringFilter(parse[j])); - end; - end - else - if s = 'Type' then - AddCommaString(mangaInfo.genres, - CommonStringFilter(TrimLeftChar(parse[i+2], [':', ' ']))) - else - //summary - if (not isSummaryDone) and (s = 'Summary') then - begin - isSummaryDone := True; - for j := i+2 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/p' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := Trim(mangaInfo.summary + LineEnding + - CommonStringFilter(parse[j])); - end; - end; - //summary - if (not isSummaryDone) and (GetTagName(parse[i]) = 'p') then - begin - s := Trim(parse[i+1]); - if (s <> '') and (Pos('<', s) = 0) then - begin - isSummaryDone := True; - for j := i+1 to parse.Count-1 do - begin - if GetTagName(parse[j]) = '/p' then - Break - else - if Pos('<', parse[j]) = 0 then - mangaInfo.summary := Trim(mangaInfo.summary + LineEnding + - CommonStringFilter(parse[j])); - end; - end; - end; - end; - end; - end; - - //chapters - FindChapters; - for i := parse.Count-1 downto 0 do - begin - if (Pos('<a', parse[i]) <> 0) and - (Pos('/chapter-list/', parse[i]) <> 0) then - begin - s := GetVal(parse[i], 'href'); - pnumber := StrToIntDef( - ReplaceRegExpr('^.*/chapter-list/(\d+)/$', s, '$1', True), 1); - Break; - end; - end; - if pnumber > 1 then - begin - Source := TStringList.Create; - for i := 2 to pnumber do - begin - if GetPage(TObject(Source), - mangaInfo.url+IntToStr(i)+'/', Reconnect) then - begin - ParseHTML(Source.Text, parse); - FindChapters; - end; - end; - Source.Free; - end; - - //invert chapters - if isInvertChapters then - InvertStrings([mangaInfo.chapterName, mangaInfo.chapterLinks]); - Result := NO_ERROR; - end; - end; diff --git a/baseunits/includes/WPManga/names_and_links.inc b/baseunits/includes/WPManga/names_and_links.inc deleted file mode 100644 index c9596d202..000000000 --- a/baseunits/includes/WPManga/names_and_links.inc +++ /dev/null @@ -1,60 +0,0 @@ - function GetWPMangaNamesAndLinks: Byte; - var - i, j, k: Integer; - s: String; - const - dirURL = '/manga-list/all/any/last-added/'; - begin - Result := INFORMATION_NOT_FOUND; - if not GetPage(TObject(Source), WebsiteRoots[WebsiteID, 1] + dirURL + - IntToStr(StrToIntDef(URL, -1) + 1) + '/', 1) then - begin - Result := NET_PROBLEM; - Source.Free; - Exit; - end; - - ParseHTML(Source.Text, parse); - Source.Free; - - if WebsiteID = EYEONMANGA_ID then - begin - for i := 0 to parse.Count-1 do - if GetVal(parse[i], 'class') = 'cvr' then try - if GetTagName(parse[i-4]) = 'a' then - begin - names.Add(CommonStringFilter(parse[i-3])); - links.Add(GetVal(parse[i-4], 'href')); - end; - except - end; - end - else - for i := 0 to parse.Count-1 do - begin - //thumbnail mode - if GetVal(parse[i], 'id') = 'sct_content' then - begin - for j := i+1 to parse.Count-1 do - begin - s := GetTagName(parse[j]); - if (s = 'sct_sidebar') or (s = 'sct_wid_bot') then - Break - else - if GetVal(parse[j], 'class') = 'det' then - begin - for k := j+1 to parse.Count-1 do - begin - if GetTagName(parse[k]) = 'a' then - begin - links.Add(GetVal(parse[k], 'href')); - names.Add(CommonStringFilter(parse[k+1])); - Break; - end; - end; - end; - end; - Break; - end; - end; - end; diff --git a/baseunits/lua/LuaBase.pas b/baseunits/lua/LuaBase.pas new file mode 100644 index 000000000..14b087b19 --- /dev/null +++ b/baseunits/lua/LuaBase.pas @@ -0,0 +1,177 @@ +unit LuaBase; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Lua53, LuaClass; + +procedure LuaBaseRegister(L: Plua_State); +procedure luaPushObject(L: Plua_State; Obj: TObject; Name: String; + AddMetaTable: TluaClassAddMetaTable = nil; AutoFree: Boolean = False); inline; + +function LuaDoFile(AFilename: String; AFuncName: String = ''): Plua_State; +function LuaNewBaseState: Plua_State; +procedure LuaCallFunction(L: Plua_State; AFuncName: String); +function LuaGetReturnString(const ReturnCode: Integer): String; + +function LuaDumpFileToStream(L: Plua_State; AFilename: String; + AStripDebug: Boolean = False): TMemoryStream; +function LuaLoadFromStream(L: Plua_State; AStream: TMemoryStream; AName: PAnsiChar): Integer; + +implementation + +uses + LuaStrings, LuaBaseUnit, LuaRegExpr, LuaSynaUtil, LuaSynaCode, MultiLog, + LuaCrypto, LuaImagePuzzle, LuaDuktape; + +function luabase_print(L: Plua_State): Integer; cdecl; +var + i: Integer; +begin + Result := 0; + for i := 1 to lua_gettop(L) do + case lua_type(L, i) of + LUA_TBOOLEAN: + Logger.Send(BoolToStr(lua_toboolean(L, i), 'true', 'false')); + else + Logger.Send(lua_tostring(L, i)); + end; +end; + +function luabase_sleep(L: Plua_State): Integer; cdecl; +begin + Result := 0; + Sleep(lua_tointeger(L, 1)); +end; + +procedure LuaBaseRegister(L: Plua_State); +begin + lua_register(L, 'print', @luabase_print); + lua_register(L, 'Sleep', @luabase_sleep); + + luaBaseUnitRegister(L); + luaRegExprRegister(L); + luaSynaUtilRegister(L); + luaSynaCodeRegister(L); + luaCryptoRegister(L); + luaDuktapeRegister(L); + + luaClassRegisterAll(L); +end; + +procedure luaPushObject(L: Plua_State; Obj: TObject; Name: String; + AddMetaTable: TluaClassAddMetaTable; AutoFree: Boolean); +begin + luaClassPushObject(L, Obj, Name, AutoFree, AddMetaTable); +end; + +function LuaDoFile(AFilename: String; AFuncName: String): Plua_State; +begin + Result := nil; + if not FileExists(AFilename) then + Exit; + Result := luaL_newstate; + try + luaL_openlibs(Result); + LuaBaseRegister(Result); + if luaL_dofile(Result, PChar(AFilename)) <> 0 then + raise Exception.Create(''); + LuaCallFunction(Result, AFuncName); + except + Logger.SendError('LuaDoFile.Error ' + lua_tostring(Result, -1)); + end; +end; + +function LuaNewBaseState: Plua_State; +begin + Result := nil; + Result := luaL_newstate; + try + luaL_openlibs(Result); + LuaBaseRegister(Result); + except + Logger.SendError(lua_tostring(Result, -1)); + end; +end; + +procedure LuaCallFunction(L: Plua_State; AFuncName: String); +var + r: Integer; +begin + if lua_getglobal(L, PChar(AFuncName)) = 0 then + raise Exception.Create('No function name ' + QuotedStr(AFuncName)); + r := lua_pcall(L, 0, LUA_MULTRET, 0); + if r <> 0 then + raise Exception.Create(LuaGetReturnString(r)); +end; + +function LuaGetReturnString(const ReturnCode: Integer): String; +begin + case ReturnCode of + LUA_OK: Result := 'LUA_OK'; + LUA_YIELD_: Result := 'LUA_YIELD_'; + LUA_ERRRUN: Result := 'LUA_ERRRUN'; + LUA_ERRSYNTAX: Result := 'LUA_ERRSYNTAX'; + LUA_ERRMEM: Result := 'LUA_ERRMEM'; + LUA_ERRGCMM: Result := 'LUA_ERRGCMM'; + LUA_ERRERR: Result := 'LUA_ERRERR'; + LUA_ERRFILE: Result := 'LUA_ERRFILE'; + else + Result := IntToStr(ReturnCode); + end; +end; + +function _luawriter(L: Plua_State; const p: Pointer; sz: size_t; ud: Pointer): Integer; cdecl; +begin + if TMemoryStream(ud).Write(p^, sz) <> sz then + Result := 1 + else + Result := 0; +end; + +function LuaDumpFileToStream(L: Plua_State; AFilename: String; + AStripDebug: Boolean): TMemoryStream; +var + strip: Integer; +begin + if not FileExists(AFilename) then + Exit; + Result := TMemoryStream.Create; + try + if luaL_loadfile(L, PChar(AFilename)) <> 0 then + raise Exception.Create(''); + if AStripDebug then + strip := 0 + else + strip := 1; + if lua_dump(L, @_luawriter, Result, strip) <> 0 then + raise Exception.Create(''); + except + Result.Free; + Result := nil; + Logger.SendError(lua_tostring(L, -1)); + end; +end; + +function _luareader(L: Plua_State; ud: Pointer; sz: Psize_t): PAnsiChar; cdecl; +var + m: TMemoryStream; +begin + m := TMemoryStream(ud); + if m.Size = 0 then + begin + Result := nil; + Exit; + end; + Result := PAnsiChar(m.Memory); + sz^ := m.Size; +end; + +function LuaLoadFromStream(L: Plua_State; AStream: TMemoryStream; AName: PAnsiChar): Integer; +begin + Result := lua_load(L, @_luareader, AStream, AName, 'b'); +end; + +end. diff --git a/baseunits/lua/LuaBaseUnit.pas b/baseunits/lua/LuaBaseUnit.pas new file mode 100644 index 000000000..74480e510 --- /dev/null +++ b/baseunits/lua/LuaBaseUnit.pas @@ -0,0 +1,170 @@ +unit LuaBaseUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, uBaseUnit; + +procedure luaBaseUnitRegister(L: Plua_State); + +implementation + +uses + LuaUtils, MultiLog, htmlelements, dateutils; + +function lua_pos(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, Pos(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_trim(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, Trim(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_maybefillhost(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, MaybeFillHost(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_invertstrings(L: Plua_State): Integer; cdecl; +var + i: Integer; +begin + Result := 0; + for i := 1 to lua_gettop(L) do + InvertStrings(TStringList(luaGetUserData(L, i))); +end; + +function lua_mangainfostatusifpos(L: Plua_State): Integer; cdecl; +begin + case lua_gettop(L) of + 3: lua_pushstring(L, MangaInfoStatusIfPos(lua_tostring(L, 1), + lua_tostring(L, 2), lua_tostring(L, 3))); + 2: lua_pushstring(L, MangaInfoStatusIfPos(lua_tostring(L, 1), lua_tostring(L, 2))); + 1: lua_pushstring(L, MangaInfoStatusIfPos(lua_tostring(L, 1))); + else + Exit(0); + end; + Result := 1; +end; + +function lua_appendurldelim(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, AppendURLDelim(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_removeurldelim(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, RemoveURLDelim(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_appendurldelimleft(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, AppendURLDelimLeft(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_removeurldelimleft(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, RemoveURLDelimLeft(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_regexprgetmatch(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, RegExprGetMatch(lua_tostring(L, 1), lua_tostring(L, 2), lua_tointeger(L, 3))); + Result := 1; +end; + +function lua_htmldecode(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, HTMLDecode(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_htmlencode(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, EscapeHTML(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_urldecode(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, URLDecode(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_incstr(L: Plua_State): Integer; cdecl; +var + n: Integer; +begin + n := 1; + if (lua_gettop(L) = 2) and lua_isinteger(L, 2) then + n := lua_tointeger(L, 2); + if lua_isinteger(L, 1) then + lua_pushstring(L, IncStr(lua_tointeger(L, 1), n)) + else + lua_pushstring(L, IncStr(lua_tostring(L, 1), n)); + Result := 1; +end; + +function lua_streamtostring(L: Plua_State): Integer; cdecl; +begin + if lua_isuserdata(L, 1) then + begin + lua_pushstring(L, StreamToString(TStream(luaGetUserData(L,1)))); + Result := 1; + end + else + Result := 0; +end; + +function lua_round(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, round(lua_tonumber(L, 1))); + Result := 1; +end; + +function lua_trimstrings(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TrimStrings(TStrings(luaGetUserData(L, 1))); +end; + +function lua_getcurrenttime(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, MilliSecondsBetween(Now, 0)); + Result := 1; +end; + +procedure luaBaseUnitRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'Pos', @lua_pos); + luaPushFunctionGlobal(L, 'Trim', @lua_trim); + luaPushFunctionGlobal(L, 'MaybeFillHost', @lua_maybefillhost); + luaPushFunctionGlobal(L, 'InvertStrings', @lua_invertstrings); + luaPushFunctionGlobal(L, 'MangaInfoStatusIfPos', @lua_mangainfostatusifpos); + luaPushFunctionGlobal(L, 'AppendURLDelim', @lua_appendurldelim); + luaPushFunctionGlobal(L, 'AppendURLDelimleft', @lua_appendurldelimleft); + luaPushFunctionGlobal(L, 'RemoveURLDelim', @lua_removeurldelim); + luaPushFunctionGlobal(L, 'RemoveURLDelimLeft', @lua_removeurldelimleft); + luaPushFunctionGlobal(L, 'RegExprGetMatch', @lua_regexprgetmatch); + luaPushFunctionGlobal(L, 'HTMLDecode', @lua_htmldecode); + luaPushFunctionGlobal(L, 'HTMLEncode', @lua_htmlencode); + luaPushFunctionGlobal(L, 'URLDecode', @lua_urldecode); + luaPushFunctionGlobal(L, 'IncStr', @lua_incstr); + luaPushFunctionGlobal(L, 'StreamToString', @lua_streamtostring); + luaPushFunctionGlobal(L, 'Round', @lua_round); + luaPushFunctionGlobal(L, 'TrimStrings', @lua_trimstrings); + luaPushFunctionGlobal(L, 'GetCurrentTime', @lua_getcurrenttime); +end; + +end. diff --git a/baseunits/lua/LuaClass.pas b/baseunits/lua/LuaClass.pas new file mode 100644 index 000000000..59cef5d62 --- /dev/null +++ b/baseunits/lua/LuaClass.pas @@ -0,0 +1,573 @@ +unit LuaClass; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +type + PObject = ^TObject; + + luaL_Reg_prop = packed record + name: PAnsiChar; + funcget: lua_CFunction; + funcset: lua_CFunction; + end; + PluaL_Reg_prop = ^luaL_Reg_prop; + + TluaClassAddMetaTable = procedure(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + TLuaClassRegisterLib = procedure(L: Plua_State); + +procedure luaClassNewLib(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); + +procedure luaClassRegisterAll(L: Plua_State); + +procedure luaClassRegister(C: TClass; AddMetaTable: TluaClassAddMetaTable; + AddLib: TLuaClassRegisterLib = nil); + +procedure luaClassNewUserData(L: Plua_State; var MetaTable, UserData: Integer; + Obj: Pointer; AutoFree: Boolean = False); + +function luaClassGetClosure(L: Plua_State): Pointer; +function luaClassGetObject(L: Plua_State): Pointer; inline; + +procedure luaClassPushUserData(L: Plua_State; Obj: Pointer; Name: String; + AutoFree: Boolean; AddMetaTable: TluaClassAddMetaTable); +procedure luaClassPushObject(L: Plua_State; Obj: TObject; Name: String; + AutoFree: Boolean = False; AddMetaTable: TluaClassAddMetaTable = nil); + +procedure luaClassAddFunction(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; Func: lua_CFunction); overload; inline; +procedure luaClassAddFunction(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg); overload; +procedure luaClassAddProperty(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; FuncGet, FuncSet: lua_CFunction); overload; +procedure luaClassAddProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); overload; +procedure luaClassAddArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; FuncGet, FuncSet: lua_CFunction); overload; +procedure luaClassAddArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); overload; +procedure luaClassAddDefaultArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncGet, FuncSet: lua_CFunction); overload; +procedure luaClassAddDefaultArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); overload; inline; +procedure luaClassAddStringProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); overload; +procedure luaClassAddIntegerProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); overload; +procedure luaClassAddBooleanProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); overload; +procedure luaClassAddObject(L: Plua_State; MetaTable: Integer; Obj: TObject; + Name: String; AddMetaTable: TluaClassAddMetaTable = nil); +procedure luaClassAddUserData(L: Plua_State; MetaTable: Integer; Obj: TObject; + Name: String); + +implementation + +uses LuaUtils; + +type + + { TluaClassList } + + TluaClassList = class + FClassList, FAddMetaTableList, FClassLibList: TFPList; + public + constructor Create; + destructor Destroy; override; + procedure Add(C: TClass; AddMetaTable: TluaClassAddMetaTable; + AddLib: TLuaClassRegisterLib); + function FindAddMetaTable(C: TClass): TluaClassAddMetaTable; + property Libs: TFPList read FClassLibList; + end; + +var + classlist: TluaClassList; + +function __index(L: Plua_State): Integer; cdecl; +begin + Result := 0; + if lua_gettop(L) < 2 then + Exit; + + lua_getmetatable(L, 1); // 1 should be userdata + lua_pushstring(L, AnsiLowerCase(lua_tostring(L, 2))); // 2 should be the key + lua_rawget(L, -2); // get metatable[key] + + if lua_istable(L, -1) then + begin + lua_getfield(L, -1, '__get'); + if lua_iscfunction(L, -1) then + lua_call(L, 0, 1); + end + else + if lua_isnil(L, -1) then + begin + lua_pop(L, 1); + lua_getfield(L, -1, '__defaultget'); // default get[] from metatable + if lua_iscfunction(L, -1) then + begin + lua_pushvalue(L, 2); // key + lua_call(L, 1, 1); + end + else + if lua_isnil(L, -1) then // no default get + lua_pop(L, 1); + end; + Result := 1; +end; + +function __newindex(L: Plua_State): Integer; cdecl; +begin + if lua_gettop(L) < 2 then + Exit(0); + + lua_getmetatable(L, 1); + lua_pushstring(L, AnsiLowerCase(lua_tostring(L, 2))); + lua_rawget(L, -2); + + if lua_istable(L, -1) then + begin + lua_getfield(L, -1, '__set'); + if lua_iscfunction(L, -1) then + begin + lua_pushvalue(L, 3); // data + lua_call(L, 1, 0); + end; + end + else + if lua_isnil(L, -1) then + begin + lua_pop(L, 1); + lua_getfield(L, -1, '__defaultset'); // default get from metatable + if lua_iscfunction(L, -1) then + begin + lua_pushvalue(L, 2); // key + lua_pushvalue(L, 3); // data + lua_call(L, 2, 1); + end + else + if lua_isnil(L, -1) then // no default get + lua_pop(L, 1); + end; + Result := 1; +end; + +function __indexarray(L: Plua_State): Integer; cdecl; +begin + Result := 1; + + if lua_tostring(L, 2) = '__get' then + begin + lua_pushvalue(L, 1); + Exit; + end; + + lua_pushvalue(L, lua_upvalueindex(2)); // cfunc + lua_pushvalue(L, lua_upvalueindex(1)); // userdata + lua_pushvalue(L, 2); + lua_call(L, 2, 1); +end; + +function __newindexarray(L: Plua_State): Integer; cdecl; +begin + Result := 1; + + if lua_tostring(L, 2) = '__set' then + begin + lua_pushvalue(L, 1); + Exit; + end; + lua_pushvalue(L, lua_upvalueindex(2)); // cfunc + lua_pushvalue(L, lua_upvalueindex(1)); // userdata + lua_pushvalue(L, 2); + lua_pushvalue(L, 3); + lua_call(L, 3, 0); +end; + +function __gc(L: Plua_State): Integer; cdecl; +var + autodestroy: Boolean; +begin + Result := 0; + if not lua_isuserdata(L, 1) then + Exit; + + autodestroy := False; + lua_getmetatable(L, 1); + lua_getfield(L, -1, '__autodestroy'); + if lua_isboolean(L, -1) then + autodestroy := lua_toboolean(L, -1); + if not autodestroy then + Exit; + + lua_getfield(L, -2, 'destroy'); + if lua_iscfunction(L, -1) then + begin + lua_pushvalue(L, 1); + lua_call(L, 1, 0); + end + else + try + PObject(lua_touserdata(L, 1))^.Free; + except + end; +end; + +function __self(L: Plua_State): Integer; cdecl; +begin + lua_pushlightuserdata(L, PPointer(luaClassGetObject(L))^); + Result := 1; +end; + +function firstUpcase(s: String): String; +begin + Result := s; + if Result <> '' then + Result[1] := AnsiUpperCase(Result[1])[1]; +end; + +procedure luaClassNewLib(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); +var + t: Integer; +begin + lua_newtable(L); + t := lua_gettop(L); + while lr^.name <> nil do + begin + luaAddCFunctionToTable(L, t, PAnsiChar(LowerCase(lr^.name)), lr^.func); + luaAddCFunctionToTable(L, t, PAnsiChar(firstUpcase(lr^.name)), lr^.func); + Inc(lr); + end; + if n <> '' then + lua_setglobal(L, n); +end; + +procedure luaClassRegisterAll(L: Plua_State); +var + i: Integer; +begin + for i := 0 to classlist.Libs.Count - 1 do + if classlist.Libs[i] <> nil then + TLuaClassRegisterLib(classlist.Libs[i])(L); +end; + +procedure luaClassRegister(C: TClass; AddMetaTable: TluaClassAddMetaTable; + AddLib: TLuaClassRegisterLib); +begin + classlist.Add(C, AddMetaTable, AddLib); +end; + +procedure luaClassNewUserData(L: Plua_State; var MetaTable, UserData: Integer; + Obj: Pointer; AutoFree: Boolean); +begin + luaPushUserData(L, Obj, UserData); + lua_newtable(L); + MetaTable := lua_gettop(L); + luaClassAddFunction(L, MetaTable, UserData, 'self', @__self); + luaAddCFunctionToTable(L, MetaTable, '__index', @__index); + luaAddCFunctionToTable(L, MetaTable, '__newindex', @__newindex); + luaAddCFunctionToTable(L, MetaTable, '__gc', @__gc); + luaAddBooleanToTable(L, MetaTable, '__autodestroy', AutoFree); +end; + +function luaClassGetClosure(L: Plua_State): Pointer; +begin + Result := nil; + if lua_isuserdata(L, lua_upvalueindex(1)) then + Result := lua_touserdata(L, lua_upvalueindex(1)) + else + if lua_gettop(L) > 0 then + if lua_isuserdata(L, 1) then + begin + Result := lua_touserdata(L, 1); + lua_remove(L, 1); + end; +end; + +function luaClassGetObject(L: Plua_State): Pointer; +begin + Result := PPointer(luaClassGetClosure(L))^; +end; + +procedure luaClassPushUserData(L: Plua_State; Obj: Pointer; Name: String; + AutoFree: Boolean; AddMetaTable: TluaClassAddMetaTable); +var + m, u: Integer; +begin + if Obj = nil then + Exit; + luaClassNewUserData(L, m, u, Obj, AutoFree); + AddMetaTable(L, Obj, m, u); + lua_setmetatable(L, u); + if Name <> '' then + lua_setglobal(L, PAnsiChar(Name)); +end; + +procedure luaClassPushObject(L: Plua_State; Obj: TObject; Name: String; + AutoFree: Boolean; AddMetaTable: TluaClassAddMetaTable); +begin + if Obj = nil then + Exit; + if AddMetaTable = nil then + AddMetaTable := classlist.FindAddMetaTable(Obj.ClassType); + if AddMetaTable = nil then + Exit; + luaClassPushUserData(L, Obj, Name, AutoFree, AddMetaTable); +end; + +procedure luaClassAddFunction(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; Func: lua_CFunction); +begin + luaAddCClosureToTable(L, MetaTable, UserData, PAnsiChar(AnsiLowerCase(Name)), Func); +end; + +procedure luaClassAddFunction(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg); +var + p: PluaL_Reg; +begin + p := FuncArr; + while p^.name <> nil do + begin + luaClassAddFunction(L, MetaTable, UserData, p^.name, p^.func); + Inc(p); + end; +end; + +procedure luaClassAddProperty(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; FuncGet, FuncSet: lua_CFunction); +var + t: Integer; +begin + lua_pushstring(L, PAnsiChar(LowerCase(Name))); + lua_newtable(L); + t := lua_gettop(L); + + if FuncGet <> nil then + luaAddCClosureToTable(L, t, UserData, '__get', FuncGet); + if FuncSet <> nil then + luaAddCClosureToTable(L, t, UserData, '__set', FuncSet); + + lua_rawset(L, MetaTable); +end; + +procedure luaClassAddProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); +var + p: PluaL_Reg_prop; +begin + p := FuncArr; + while p^.name <> nil do + begin + luaClassAddProperty(L, MetaTable, UserData, p^.name, p^.funcget, p^.funcset); + Inc(p); + end; +end; + +procedure luaClassAddArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + Name: PAnsiChar; FuncGet, FuncSet: lua_CFunction); +var + t, m: Integer; +begin + lua_pushstring(L, PAnsiChar(AnsiLowerCase(Name))); + lua_newtable(L); + t := lua_gettop(L); + + lua_newtable(L); + m := lua_gettop(L); + + lua_pushstring(L, '__index'); + lua_pushvalue(L, UserData); + lua_pushcfunction(L, FuncGet); + lua_pushcclosure(L, @__indexarray, 2); + lua_rawset(L, m); + + if FuncSet <> nil then + begin + lua_pushstring(L, '__newindex'); + lua_pushvalue(L, UserData); + lua_pushcfunction(L, FuncSet); + lua_pushcclosure(L, @__newindexarray, 2); + lua_rawset(L, m); + end; + + lua_setmetatable(L, t); + lua_rawset(L, MetaTable); +end; + +procedure luaClassAddArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); +var + p: PluaL_Reg_prop; +begin + p := FuncArr; + while p^.name <> nil do + begin + luaClassAddArrayProperty(L, MetaTable, UserData, p^.name, p^.funcget, p^.funcset); + Inc(p); + end; +end; + +procedure luaClassAddDefaultArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncGet, FuncSet: lua_CFunction); +begin + if FuncGet <> nil then + luaAddCClosureToTable(L, MetaTable, UserData, '__defaultget', FuncGet); + if FuncSet <> nil then + luaAddCClosureToTable(L, MetaTable, UserData, '__defaultset', FuncSet); +end; + +procedure luaClassAddDefaultArrayProperty(L: Plua_State; MetaTable, UserData: Integer; + FuncArr: PluaL_Reg_prop); +begin + luaClassAddDefaultArrayProperty(L, MetaTable, UserData, FuncArr^.funcget, + FuncArr^.funcset); +end; + +function luaclass_string_get(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, String(luaClassGetClosure(L)^)); + Result := 1; +end; + +function luaclass_string_set(L: Plua_State): Integer; cdecl; +begin + Result := 0; + String(luaClassGetClosure(L)^) := lua_tostring(L, -1); +end; + +function luaclass_int_get(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, Integer(luaClassGetClosure(L)^)); + Result := 1; +end; + +function luaclass_int_set(L: Plua_State): Integer; cdecl; +begin + Result := 0; + Integer(luaClassGetClosure(L)^) := lua_tointeger(L, -1); +end; + +function luaclass_bool_get(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, Boolean(luaClassGetClosure(L)^)); + Result := 1; +end; + +function luaclass_bool_set(L: Plua_State): Integer; cdecl; +begin + Result := 0; + Boolean(luaClassGetClosure(L)^) := lua_toboolean(L, -1); +end; + +procedure luaClassAddVariable(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer; FuncGet, FuncSet: lua_CFunction); +var + t: Integer; +begin + lua_pushstring(L, PAnsiChar(LowerCase(Name))); + lua_newtable(L); + t := lua_gettop(L); + + luaAddCClosureToTable(L, t, P, '__get', FuncGet); + luaAddCClosureToTable(L, t, P, '__set', FuncSet); + + lua_rawset(L, MetaTable); +end; + +procedure luaClassAddStringProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); +begin + luaClassAddVariable(L, MetaTable, Name, P, @luaclass_string_get, @luaclass_string_set); +end; + +procedure luaClassAddIntegerProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); +begin + luaClassAddVariable(L, MetaTable, Name, P, @luaclass_int_get, @luaclass_int_set); +end; + +procedure luaClassAddBooleanProperty(L: Plua_State; MetaTable: Integer; + Name: PAnsiChar; P: Pointer); +begin + luaClassAddVariable(L, MetaTable, Name, P, @luaclass_bool_get, @luaclass_bool_set); +end; + +procedure luaClassAddObject(L: Plua_State; MetaTable: Integer; Obj: TObject; Name: String; + AddMetaTable: TluaClassAddMetaTable); +var + m, u: Integer; +begin + if AddMetaTable = nil then + AddMetaTable := classlist.FindAddMetaTable(Obj.ClassType); + if AddMetaTable = nil then + Exit; + lua_pushstring(L, PAnsiChar(AnsiLowerCase(Name))); + luaClassNewUserData(L, m, u, Obj, False); + AddMetaTable(L, Obj, m, u); + lua_setmetatable(L, u); + lua_rawset(L, MetaTable); +end; + +procedure luaClassAddUserData(L: Plua_State; MetaTable: Integer; Obj: TObject; + Name: String); +begin + lua_pushstring(L, PAnsiChar(AnsiLowerCase(Name))); + luaPushUserData(L, Obj); + lua_rawset(L, MetaTable); +end; + +{ TluaClassList } + +constructor TluaClassList.Create; +begin + FClassList := TFPList.Create; + FAddMetaTableList := TFPList.Create; + FClassLibList := TFPList.Create; +end; + +destructor TluaClassList.Destroy; +begin + FClassList.Free; + FAddMetaTableList.Free; + FClassLibList.Free; + inherited Destroy; +end; + +procedure TluaClassList.Add(C: TClass; AddMetaTable: TluaClassAddMetaTable; + AddLib: TLuaClassRegisterLib); +begin + FClassList.Add(C); + FAddMetaTableList.Add(AddMetaTable); + FClassLibList.Add(AddLib); +end; + +function TluaClassList.FindAddMetaTable(C: TClass): TluaClassAddMetaTable; +var + i, p: Integer; +begin + Result := nil; + p := FClassList.IndexOf(C); + if p = -1 then + for i := 0 to FClassList.Count - 1 do + if C.InheritsFrom(TClass(FClassList[i])) then + begin + p := i; + Break; + end; + if p <> -1 then + Result := TluaClassAddMetaTable(FAddMetaTableList[p]); +end; + +initialization + classlist := TluaClassList.Create; + +finalization + classlist.Free; + +end. diff --git a/baseunits/lua/LuaCrypto.pas b/baseunits/lua/LuaCrypto.pas new file mode 100644 index 000000000..ca3b65fbb --- /dev/null +++ b/baseunits/lua/LuaCrypto.pas @@ -0,0 +1,50 @@ +unit LuaCrypto; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, BaseCrypto; + +procedure luaCryptoRegister(L: Plua_State); + +implementation + +uses + LuaUtils; + +function crypto_hextostr(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, HexToStr(lua_tostring(L, 1))); + Result := 1; +end; + +function crypto_strtohexstr(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, StrToHexStr(lua_tostring(L, 1))); + Result := 1; +end; + +function crypto_md5hex(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, MD5Hex(lua_tostring(L, 1))); + Result := 1; +end; + +function crypto_aesdecryptcbc(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, AESDecryptCBC(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3))); + Result := 1; +end; + +procedure luaCryptoRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'HexToStr', @crypto_hextostr); + luaPushFunctionGlobal(L, 'StrToHexStr', @crypto_strtohexstr); + luaPushFunctionGlobal(L, 'MD5Hex', @crypto_md5hex); + luaPushFunctionGlobal(L, 'AESDecryptCBC', @crypto_aesdecryptcbc); +end; + +end. + diff --git a/baseunits/lua/LuaDownloadTask.pas b/baseunits/lua/LuaDownloadTask.pas new file mode 100644 index 000000000..85e1ab8d1 --- /dev/null +++ b/baseunits/lua/LuaDownloadTask.pas @@ -0,0 +1,34 @@ +unit LuaDownloadTask; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaDownloadTaskMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses + LuaClass, uDownloadsManager; + +procedure luaDownloadTaskMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + with TTaskContainer(Obj) do + begin + luaClassAddObject(L, MetaTable, PageLinks, 'PageLinks'); + luaClassAddObject(L, MetaTable, PageContainerLinks, 'PageContainerLinks'); + luaClassAddIntegerProperty(L, MetaTable, 'PageNumber', @PageNumber); + luaClassAddStringProperty(L, MetaTable, 'Link', @DownloadInfo.Link); + end; +end; + +initialization + luaClassRegister(TTaskContainer, @luaDownloadTaskMetaTable); + +end. + diff --git a/baseunits/lua/LuaDuktape.pas b/baseunits/lua/LuaDuktape.pas new file mode 100644 index 000000000..bb0e50f9e --- /dev/null +++ b/baseunits/lua/LuaDuktape.pas @@ -0,0 +1,28 @@ +unit LuaDuktape; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, uBaseUnit; + +procedure luaDuktapeRegister(L: Plua_State); + +implementation + +uses JSUtils, LuaUtils; + +function lua_execjs(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, ExecJS(lua_tostring(L, 1))); + Result := 1; +end; + +procedure luaDuktapeRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'ExecJS', @lua_execjs); +end; + +end. + diff --git a/baseunits/lua/LuaHTTPSend.pas b/baseunits/lua/LuaHTTPSend.pas new file mode 100644 index 000000000..bbccc9aee --- /dev/null +++ b/baseunits/lua/LuaHTTPSend.pas @@ -0,0 +1,126 @@ +unit LuaHTTPSend; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaHTTPSendThreadAddMetaTable(L: Plua_State; Obj: Pointer; MetaTable, + UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses + uBaseUnit, httpsendthread, LuaClass; + +type + TUserData = THTTPSendThread; + +function http_get(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TUserData(luaClassGetObject(L)).GET(lua_tostring(L, 1))); + Result := 1; +end; + +function http_post(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TUserData(luaClassGetObject(L)).POST(lua_tostring(L, 1), + lua_tostring(L, 2))); + Result := 1; +end; + +function http_head(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TUserData(luaClassGetObject(L)).head(lua_tostring(L, 1))); + Result := 1; +end; + +function http_xhr(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TUserData(luaClassGetObject(L)).XHR(lua_tostring(L, 1))); + Result := 1; +end; + +function http_reset(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Reset; +end; + +function http_getcookies(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).GetCookies; +end; + +function http_threadterminated(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TUserData(luaClassGetObject(L)).ThreadTerminated); + Result := 1; +end; + +function http_setproxy(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).SetProxy(lua_tostring(L, 1), lua_tostring(L, 2), + lua_tostring(L, 3), lua_tostring(L, 4), lua_tostring(L, 5)); +end; + +function http_threadlasturl(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).LastURL); + Result := 1; +end; + +function http_threadresultcode(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).ResultCode); + Result := 1; +end; + +function http_threadresultstring(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).ResultString); + Result := 1; +end; + +const + methods: packed array [0..7] of luaL_Reg = ( + (name: 'GET'; func: @http_get), + (name: 'POST'; func: @http_post), + (name: 'HEAD'; func: @http_head), + (name: 'XHR'; func: @http_xhr), + (name: 'Reset'; func: @http_reset), + (name: 'GetCookies'; func: @http_getcookies), + (name: 'SetProxy'; func: @http_setproxy), + (name: nil; func: nil) + ); + props: packed array[0..4] of luaL_Reg_prop = ( + (name: 'Terminated'; funcget: @http_threadterminated; funcset: nil), + (name: 'LastURL'; funcget: @http_threadlasturl; funcset: nil), + (name: 'ResultCode'; funcget: @http_threadresultcode; funcset: nil), + (name: 'ResultString'; funcget: @http_threadresultstring; funcset: nil), + (name: nil; funcget: nil; funcset: nil) + ); + +procedure luaHTTPSendThreadAddMetaTable(L: Plua_State; Obj: Pointer; MetaTable, + UserData: Integer; AutoFree: Boolean = False); +begin + with TUserData(Obj) do + begin + luaClassAddFunction(L, MetaTable, UserData, methods); + luaClassAddProperty(L, MetaTable, UserData, props); + luaClassAddObject(L, MetaTable, Headers, 'Headers'); + luaClassAddObject(L, MetaTable, Cookies, 'Cookies'); + luaClassAddStringProperty(L, MetaTable, 'MimeType', @TUserData(Obj).MimeType); + luaClassAddStringProperty(L, MetaTable, 'UserAgent', @TUserData(Obj).UserAgent); + luaClassAddUserData(L, MetaTable, TUserData(Obj).Document, 'Document'); + end; +end; + +initialization + luaClassRegister(THTTPSendThread, @luaHTTPSendThreadAddMetaTable); + +end. diff --git a/baseunits/lua/LuaIXQValue.pas b/baseunits/lua/LuaIXQValue.pas new file mode 100644 index 000000000..486393fb4 --- /dev/null +++ b/baseunits/lua/LuaIXQValue.pas @@ -0,0 +1,88 @@ +unit LuaIXQValue; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, xquery; + +type + { TLuaIXQValue } + + TLuaIXQValue = class + public + FIXQValue: IXQValue; + constructor Create(const AIX: IXQValue); + end; + +procedure luaIXQValuePush(L: Plua_State; Obj: TLuaIXQValue); inline; + +implementation + +uses + LuaClass; + +type + TUserData = TLuaIXQValue; + +{ TLuaIXQValue } + +constructor TLuaIXQValue.Create(const AIX: IXQValue); +begin + FIXQValue := AIX; +end; + +function ixqvalue_tostring(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).FIXQValue.toString); + Result := 1; +end; + +function ixqvalue_getattribute(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).FIXQValue.toNode.getAttribute( + lua_tostring(L, 1))); + Result := 1; +end; + +function ixqvalue_count(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).FIXQValue.Count); + Result := 1; +end; + +function ixqvalue_get(L: Plua_State): Integer; cdecl; +begin + luaIXQValuePush(L, TUserData.Create(TUserData(luaClassGetObject(L)).FIXQValue.get(lua_tointeger(L, 1)))); + Result := 1; +end; + +const + methods: packed array [0..2] of luaL_Reg = ( + (name: 'GetAttribute'; func: @ixqvalue_getattribute), + (name: 'Get'; func: @ixqvalue_get), + (name: nil; func: nil) + ); + props: packed array [0..2] of luaL_Reg_prop = ( + (name: 'Count'; funcget: @ixqvalue_count; funcset: nil), + (name: 'ToString'; funcget: @ixqvalue_tostring; funcset: nil), + (name: nil; funcget: nil; funcset: nil) + ); + +procedure luaIXQValueAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddFunction(L, MetaTable, UserData, methods); + luaClassAddProperty(L, MetaTable, UserData, props); +end; + +procedure luaIXQValuePush(L: Plua_State; Obj: TLuaIXQValue); +begin + luaClassPushObject(L, Obj, '', True, @luaIXQValueAddMetaTable); +end; + +initialization + luaClassRegister(TLuaIXQValue, @luaIXQValueAddMetaTable); + +end. diff --git a/baseunits/lua/LuaImagePuzzle.pas b/baseunits/lua/LuaImagePuzzle.pas new file mode 100644 index 000000000..43afc43de --- /dev/null +++ b/baseunits/lua/LuaImagePuzzle.pas @@ -0,0 +1,104 @@ +unit LuaImagePuzzle; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, ImagePuzzle; + +procedure luaImagePuzzlePush(L: Plua_State; Obj: TImagePuzzle; Name: String = ''; + AutoFree: Boolean = False); inline; + +implementation + +uses LuaClass, LuaUtils; + +type + TUserData = TImagePuzzle; + +function imagepuzzle_create(L: Plua_State): Integer; cdecl; +begin + if lua_gettop(L) = 2 then + if lua_isinteger(L, 1) and lua_isinteger(L, 2) then + luaImagePuzzlePush(L, TImagePuzzle.Create(lua_tointeger(L, 1), lua_tointeger(L, 2)), '', True); + Result := 1; +end; + +function imagepuzzle_descramble(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).DeScramble( + TStream(luaGetUserData(L, 1)), + TStream(luaGetUserData(L, 2))); +end; + +function imagepuzzle_matrixget(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).Matrix[lua_tointeger(L, 1)]); + Result := 1; +end; + +function imagepuzzle_matrixset(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Matrix[lua_tointeger(L, 1)] := lua_tointeger(L, 2); +end; + +function imagepuzzle_gethorblock(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).HorBlock); + Result := 1; +end; + +function imagepuzzle_getverblock(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).VerBlock); + Result := 1; +end; + +const + constructs: packed array [0..2] of luaL_Reg = ( + (name: 'New'; func: @imagepuzzle_create), + (name: 'Create'; func: @imagepuzzle_create), + (name: nil; func: nil) + ); + props: packed array[0..2] of lual_Reg_prop = ( + (name: 'HorBlock'; funcget: @imagepuzzle_gethorblock; funcset: nil), + (name: 'VerBlock'; funcget: @imagepuzzle_getverblock; funcset: nil), + (name: nil; funcget: nil; funcset: nil) + ); + arrprops: packed array[0..1] of luaL_Reg_prop = ( + (name: 'Matrix'; funcget: @imagepuzzle_matrixget; funcset: @imagepuzzle_matrixset), + (name: nil; funcget: nil; funcset: nil) + ); + methods: packed array [0..1] of luaL_Reg = ( + (name: 'DeScramble'; func: @imagepuzzle_descramble), + (name: nil; func: nil) + ); + +procedure luaImagePuzzleAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddFunction(L, MetaTable, UserData, methods); + luaClassAddProperty(L, MetaTable, UserData, props); + luaClassAddArrayProperty(L, MetaTable, UserData, arrprops); + luaClassAddIntegerProperty(L, MetaTable, 'Multiply', @TUserData(Obj).Multiply); +end; + +procedure luaImagePuzzlePush(L: Plua_State; Obj: TImagePuzzle; Name: String; + AutoFree: Boolean); +begin + luaClassPushObject(L, Obj, Name, AutoFree, @luaImagePuzzleAddMetaTable); +end; + +procedure luaImagePuzzleRegister(L: Plua_State); +begin + luaClassNewLib(L, 'TImagePuzzle', constructs); +end; + +initialization + luaClassRegister(TUserData, @luaImagePuzzleAddMetaTable, @luaImagePuzzleRegister); + +end. + diff --git a/baseunits/lua/LuaMangaInfo.pas b/baseunits/lua/LuaMangaInfo.pas new file mode 100644 index 000000000..7d4ef6678 --- /dev/null +++ b/baseunits/lua/LuaMangaInfo.pas @@ -0,0 +1,44 @@ +unit LuaMangaInfo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaMangaInfoAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses + uBaseUnit, LuaClass; + +procedure luaMangaInfoAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + with TMangaInfo(Obj) do + begin + luaClassAddStringProperty(L, MetaTable, 'url', @url); + luaClassAddStringProperty(L, MetaTable, 'title', @title); + luaClassAddStringProperty(L, MetaTable, 'link', @link); + luaClassAddStringProperty(L, MetaTable, 'website', @website); + luaClassAddStringProperty(L, MetaTable, 'coverLink', @coverLink); + luaClassAddStringProperty(L, MetaTable, 'authors', @authors); + luaClassAddStringProperty(L, MetaTable, 'artists', @artists); + luaClassAddStringProperty(L, MetaTable, 'genres', @genres); + luaClassAddStringProperty(L, MetaTable, 'status', @status); + luaClassAddStringProperty(L, MetaTable, 'summary', @summary); + luaClassAddStringProperty(L, MetaTable, 'summary', @summary); + luaClassAddIntegerProperty(L, MetaTable, 'numChapter', @numChapter); + luaClassAddObject(L, MetaTable, chapterName, 'chapterNames'); + luaClassAddObject(L, MetaTable, chapterLinks, 'chapterLinks'); + end; +end; + +initialization + luaClassRegister(TMangaInfo, @luaMangaInfoAddMetaTable); + +end. + diff --git a/baseunits/lua/LuaRegExpr.pas b/baseunits/lua/LuaRegExpr.pas new file mode 100644 index 000000000..ec3910ff8 --- /dev/null +++ b/baseunits/lua/LuaRegExpr.pas @@ -0,0 +1,35 @@ +unit LuaRegExpr; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, RegExpr; + +procedure luaRegExprRegister(L: Plua_State); + +implementation + +uses + LuaUtils; + +function re_exec(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, ExecRegExpr(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function re_replace(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, ReplaceRegExpr(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3), True)); + Result := 1; +end; + +procedure luaRegExprRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'ExecRegExpr', @re_exec); + luaPushFunctionGlobal(L, 'ReplaceRegExpr', @re_replace); +end; + +end. diff --git a/baseunits/lua/LuaStrings.pas b/baseunits/lua/LuaStrings.pas new file mode 100644 index 000000000..23b52c7dc --- /dev/null +++ b/baseunits/lua/LuaStrings.pas @@ -0,0 +1,211 @@ +unit LuaStrings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaStringsPush(L: Plua_State; Obj: TStrings; Name: String = ''; + AutoFree: Boolean = False); inline; + +procedure luaStringsAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses LuaClass, LuaUtils; + +type + TUserData = TStrings; + +function strings_create(L: Plua_State): Integer; cdecl; +begin + luaStringsPush(L, TStringList.Create, '', True); + Result := 1; +end; + +function strings_loadfromfile(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).LoadFromFile(lua_tostring(L, 1)); +end; + +function strings_loadfromstream(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).LoadFromStream(TStream(luaGetUserData(L, 1))); +end; + +function strings_settext(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Text := lua_tostring(L, 1); +end; + +function strings_gettext(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).Text); + Result := 1; +end; + +function strings_setcommatext(L: Plua_State): Integer; cdecl; +begin + TUserData(luaClassGetObject(L)).CommaText := lua_tostring(L, 1); + Result := 0; +end; + +function strings_getcommatext(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).CommaText); + Result := 1; +end; + +function strings_add(L: Plua_State): Integer; cdecl; +begin + TUserData(luaClassGetObject(L)).Add(lua_tostring(L, 1)); + Result := 0; +end; + +function strings_addtext(L: Plua_State): Integer; cdecl; +begin + TUserData(luaClassGetObject(L)).AddText(lua_tostring(L, 1)); + Result := 0; +end; + +function strings_get(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, PAnsiChar( + TUserData(luaClassGetObject(L)).Strings[lua_tointeger(L, 1)])); + Result := 1; +end; + +function strings_set(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Strings[lua_tointeger(L, 1)] := lua_tostring(L, 2); +end; + +function strings_namevalueseparatorget(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, PAnsiChar( + String(TUserData(luaClassGetObject(L)).NameValueSeparator))); + Result := 1; +end; + +function strings_namevalueseparatorset(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).NameValueSeparator := String(lua_tostring(L, 1))[1]; +end; + +function strings_valuesget(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, PAnsiChar( + TUserData(luaClassGetObject(L)).Values[lua_tostring(L, 1)])); + Result := 1; +end; + +function strings_valuesset(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Values[lua_tostring(L, 1)] := lua_tostring(L, 2); +end; + +function strings_getcount(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).Count); + Result := 1; +end; + +function strings_sort(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TStringList(TUserData(luaClassGetObject(L))).Sort; +end; + +function strings_clear(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Clear; +end; + +function strings_delete(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Delete(lua_tointeger(L, 1)); +end; + +function strings_indexof(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).IndexOf(lua_tostring(L, 1))); + Result := 1; +end; + +function strings_indexofname(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUserData(luaClassGetObject(L)).IndexOfName(lua_tostring(L, 1))); + Result := 1; +end; + +const + constructs: packed array [0..2] of luaL_Reg = ( + (name: 'New'; func: @strings_create), + (name: 'Create'; func: @strings_create), + (name: nil; func: nil) + ); + methods: packed array [0..14] of luaL_Reg = ( + (name: 'LoadFromFile'; func: @strings_loadfromfile), + (name: 'LoadFromStream'; func: @strings_loadfromstream), + (name: 'SetText'; func: @strings_settext), + (name: 'GetText'; func: @strings_gettext), + (name: 'Add'; func: @strings_add), + (name: 'AddText'; func: @strings_addtext), + (name: 'Get'; func: @strings_get), + (name: 'Set'; func: @strings_set), + (name: 'GetCount'; func: @strings_getcount), + (name: 'Sort'; func: @strings_sort), + (name: 'Clear'; func: @strings_clear), + (name: 'Delete'; func: @strings_delete), + (name: 'IndexOf'; func: @strings_indexof), + (name: 'IndexOfName'; func: @strings_indexofname), + (name: nil; func: nil) + ); + props: packed array[0..4] of lual_Reg_prop = ( + (name: 'Text'; funcget: @strings_gettext; funcset: @strings_settext), + (name: 'CommaText'; funcget: @strings_getcommatext; funcset: @strings_setcommatext), + (name: 'Count'; funcget: @strings_getcount; funcset: nil), + (name: 'NameValueSeparator'; funcget: @strings_namevalueseparatorget; + funcset: @strings_namevalueseparatorset), + (name: nil; funcget: nil; funcset: nil) + ); + arrprops: packed array[0..2] of lual_Reg_prop = ( + (name: 'Strings'; funcget: @strings_get; funcset: @strings_set), + (name: 'Values'; funcget: @strings_valuesget; funcset: @strings_valuesset), + (name: nil; funcget: nil; funcset: nil) + ); + +procedure luaStringsAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddFunction(L, MetaTable, UserData, methods); + luaClassAddProperty(L, MetaTable, UserData, props); + luaClassAddArrayProperty(L, MetaTable, UserData, arrprops); + luaClassAddDefaultArrayProperty(L, MetaTable, UserData, @strings_get, @strings_set); +end; + +procedure luaStringsPush(L: Plua_State; Obj: TStrings; Name: String; AutoFree: Boolean); +begin + luaClassPushObject(L, Obj, Name, AutoFree, @luaStringsAddMetaTable); +end; + +procedure luaStringsRegister(L: Plua_State); +begin + luaClassNewLib(L, PAnsiChar(String(TUserData.ClassName)), constructs); +end; + +initialization + luaClassRegister(TUserData, @luaStringsAddMetaTable, @luaStringsRegister); + +end. diff --git a/baseunits/lua/LuaStringsStorage.pas b/baseunits/lua/LuaStringsStorage.pas new file mode 100644 index 000000000..23949907d --- /dev/null +++ b/baseunits/lua/LuaStringsStorage.pas @@ -0,0 +1,189 @@ +unit LuaStringsStorage; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +type + + { TStringsStorage } + + TStringsStorage = class + private + FStrings: TStringList; + FCS: TRTLCriticalSection; + function GetValues(const AName: String): String; + procedure SetValues(const AName: String; AValue: String); + function GetText: String; + procedure SetText(AValue: String); + public + Tag: Integer; + Enable: Boolean; + Status: String; + constructor Create; + destructor Destroy; override; + procedure Remove(const AName: String); + property Values[const AName: String]: String read GetValues write SetValues; default; + property Text: String read GetText write SetText; + end; + +procedure luaStringsStoragePush(L: Plua_State; Obj: TStringsStorage; + Name: PAnsiChar = nil; AutoFree: Boolean = False); inline; + +procedure luaStringsStorageAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses LuaClass; + +{ TStringsStorage } + +function TStringsStorage.GetValues(const AName: String): String; +begin + Result := FStrings.Values[AName]; +end; + +function TStringsStorage.GetText: String; +begin + Result := FStrings.Text; +end; + +procedure TStringsStorage.SetText(AValue: String); +begin + FStrings.Text := AValue; +end; + +procedure TStringsStorage.SetValues(const AName: String; AValue: String); +begin + EnterCriticalsection(FCS); + try + FStrings.Values[AName] := AValue; + finally + LeaveCriticalsection(FCS); + end; +end; + +constructor TStringsStorage.Create; +begin + FStrings := TStringList.Create; + InitCriticalSection(FCS); + Tag := 0; + Enable := True; + Status := 'my status of ' + Self.ClassName; +end; + +destructor TStringsStorage.Destroy; +begin + FStrings.Free; + DoneCriticalsection(FCS); + inherited Destroy; +end; + +procedure TStringsStorage.Remove(const AName: String); +var + i: Integer; +begin + i := FStrings.IndexOfName(AName); + if (i < 0) or (i >= FStrings.Count) then + Exit; + EnterCriticalsection(FCS); + try + FStrings.Delete(i); + finally + LeaveCriticalsection(FCS); + end; +end; + +type + TUserData = TStringsStorage; + +function strings_create(L: Plua_State): Integer; cdecl; +begin + luaStringsStoragePush(L, TStringsStorage.Create, nil, True); + Result := 1; +end; + +function strings_destroy(L: Plua_State): Integer; cdecl; +begin + TUserData(luaClassGetObject(L)).Free; + Result := 0; +end; + +function strings_getvalue(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).GetValues(lua_tostring(L, 1))); + Result := 1; +end; + +function strings_setvalue(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).SetValues(lua_tostring(L, 1), lua_tostring(L, 2)); +end; + +function strings_remove(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Remove(lua_tostring(L, 1)); +end; + +function strings_gettext(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, TUserData(luaClassGetObject(L)).Text); + Result := 1; +end; + +function strings_settext(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUserData(luaClassGetObject(L)).Text := lua_tostring(L, 1); +end; + +const + constructs: packed array [0..4] of luaL_Reg = ( + (name: 'New'; func: @strings_create), + (name: 'Create'; func: @strings_Create), + (name: 'new'; func: @strings_create), + (name: 'create'; func: @strings_create), + (name: nil; func: nil) + ); + methods: packed array [0..3] of luaL_Reg = ( + (name: 'Remove'; func: @strings_remove), + (name: 'Free'; func: @strings_destroy), + (name: 'Destroy'; func: @strings_destroy), + (name: nil; func: nil) + ); + +procedure luaStringsStorageAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddFunction(L, MetaTable, UserData, methods); + luaClassAddDefaultArrayProperty(L, MetaTable, UserData, @strings_getvalue, + @strings_setvalue); + luaClassAddProperty(L, MetaTable, UserData, 'Text', @strings_gettext, + @strings_settext); + luaClassAddIntegerProperty(L, MetaTable, 'Tag', @TUserData(Obj).Tag); + luaClassAddBooleanProperty(L, MetaTable, 'Enable', @TUserData(Obj).Enable); + luaClassAddStringProperty(L, MetaTable, 'Status', @TUserData(Obj).Status); +end; + +procedure luaStringsStoragePush(L: Plua_State; Obj: TStringsStorage; + Name: PAnsiChar; AutoFree: Boolean); +begin + luaClassPushObject(L, Obj, Name, AutoFree, @luaStringsStorageAddMetaTable); +end; + +procedure luaStringsStorageRegister(L: Plua_State); +begin + luaClassNewLib(L, PAnsiChar(String(TUserData.ClassName)), constructs); +end; + +initialization + luaClassRegister(TUserData, @luaStringsStorageAddMetaTable, + @luaStringsStorageRegister); + +end. diff --git a/baseunits/lua/LuaSynaCode.pas b/baseunits/lua/LuaSynaCode.pas new file mode 100644 index 000000000..e41284791 --- /dev/null +++ b/baseunits/lua/LuaSynaCode.pas @@ -0,0 +1,134 @@ +unit LuaSynaCode; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, synacode; + +procedure luaSynaCodeRegister(L: Plua_State); + +implementation + +uses + LuaUtils; + +function lua_decodeurl(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, DecodeURL(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_encodeurl(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, EncodeURL(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_decodeuu(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, DecodeUU(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_encodeuu(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, EncodeUU(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_encodeurlelement(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, EncodeURLElement(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_decodebase64(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, DecodeBase64(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_encodebase64(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, EncodeBase64(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_crc16(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, Crc16(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_crc32(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, Crc32(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_md4(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, MD4(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_md5(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, MD5(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_hmac_md5(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, HMAC_MD5(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_md5longhash(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, MD5LongHash(lua_tostring(L, 1), lua_tointeger(L, 2))); + Result := 1; +end; + +function lua_sha1(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, SHA1(lua_tostring(L, 1))); + Result := 1; +end; + +function lua_hmac_sha1(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, HMAC_SHA1(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_sha1longhash(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, SHA1LongHash(lua_tostring(L, 1), lua_tointeger(L, 2))); + Result := 1; +end; + +procedure luaSynaCodeRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'DecodeURL', @lua_decodeurl); + luaPushFunctionGlobal(L, 'EncodeURL', @lua_encodeurl); + luaPushFunctionGlobal(L, 'DecodeUU', @lua_decodeuu); + luaPushFunctionGlobal(L, 'EncodeUU', @lua_encodeuu); + luaPushFunctionGlobal(L, 'EncodeURLElement', @lua_encodeurlelement); + luaPushFunctionGlobal(L, 'DecodeBase64', @lua_decodebase64); + luaPushFunctionGlobal(L, 'EncodeBase64', @lua_encodebase64); + luaPushFunctionGlobal(L, 'CRC16', @lua_crc16); + luaPushFunctionGlobal(L, 'CRC32', @lua_crc32); + luaPushFunctionGlobal(L, 'MD4', @lua_md4); + luaPushFunctionGlobal(L, 'MD5', @lua_md5); + luaPushFunctionGlobal(L, 'HMAC_MD5', @lua_hmac_md5); + luaPushFunctionGlobal(L, 'MD5LongHash', @lua_md5longhash); + luaPushFunctionGlobal(L, 'SHA1', @lua_sha1); + luaPushFunctionGlobal(L, 'HMAC_SHA1', @lua_hmac_sha1); + luaPushFunctionGlobal(L, 'SHA1LongHash', @lua_sha1longhash); +end; + +end. + diff --git a/baseunits/lua/LuaSynaUtil.pas b/baseunits/lua/LuaSynaUtil.pas new file mode 100644 index 000000000..5e6917940 --- /dev/null +++ b/baseunits/lua/LuaSynaUtil.pas @@ -0,0 +1,50 @@ +unit LuaSynaUtil; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, synautil; + +procedure luaSynaUtilRegister(L: Plua_State); + +implementation + +uses + LuaUtils; + +function lua_getbetween(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, GetBetween(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3))); + Result := 1; +end; + +function lua_separateleft(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, SeparateLeft(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_separateright(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, SeparateRight(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; +end; + +function lua_replacestring(L: Plua_State): Integer; cdecl; +begin + lua_pushstring(L, ReplaceString(lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3))); + Result := 1; +end; + +procedure luaSynaUtilRegister(L: Plua_State); +begin + luaPushFunctionGlobal(L, 'GetBetween', @lua_getbetween); + luaPushFunctionGlobal(L, 'SeparateLeft', @lua_separateleft); + luaPushFunctionGlobal(L, 'SeparateRight', @lua_separateright); + luaPushFunctionGlobal(L, 'ReplaceString', @lua_replacestring); +end; + +end. + diff --git a/baseunits/lua/LuaUpdateListManager.pas b/baseunits/lua/LuaUpdateListManager.pas new file mode 100644 index 000000000..f1e0a377e --- /dev/null +++ b/baseunits/lua/LuaUpdateListManager.pas @@ -0,0 +1,40 @@ +unit LuaUpdateListManager; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaUpdateListManagerAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +implementation + +uses + LuaClass, uUpdateThread; + +function lua_GetCurrentDirectoryPageNumber(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TUpdateListManagerThread(luaClassGetObject(L)).CurrentDirectoryPageNumber); + Result := 1; +end; + +function lua_SetCurrentDirectoryPageNumber(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TUpdateListManagerThread(luaClassGetObject(L)).CurrentDirectoryPageNumber := lua_tointeger(L, 1); +end; + +procedure luaUpdateListManagerAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddProperty(L, MetaTable, UserData, 'CurrentDirectoryPageNumber', @lua_GetCurrentDirectoryPageNumber, @lua_SetCurrentDirectoryPageNumber); +end; + +initialization + luaClassRegister(TUpdateListManagerThread, @luaUpdateListManagerAddMetaTable); + +end. + diff --git a/baseunits/lua/LuaUtils.pas b/baseunits/lua/LuaUtils.pas new file mode 100644 index 000000000..61fe06d39 --- /dev/null +++ b/baseunits/lua/LuaUtils.pas @@ -0,0 +1,200 @@ +unit LuaUtils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53; + +procedure luaAddCFunctionToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Func: lua_CFunction); +procedure luaAddCClosureToTable(L: Plua_State; Table, Value: Integer; + Name: PAnsiChar; Func: lua_CFunction); overload; +procedure luaAddCClosureToTable(L: Plua_State; Table: Integer; + Value: Pointer; Name: PAnsiChar; Func: lua_CFunction); overload; +procedure luaAddStringToTable(L: Plua_State; Table: Integer; Name, Value: PAnsiChar); +procedure luaAddIntegerToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Value: lua_Integer); +procedure luaAddBooleanToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Value: Boolean); + +procedure luaPushFunctionGlobal(L: Plua_State; Name: PAnsiChar; Func: lua_CFunction); + +procedure luaPushStringGlobal(L: Plua_State; Name: PAnsiChar; S: String); +procedure luaPushIntegerGlobal(L: Plua_State; Name: PAnsiChar; I: Integer); +procedure luaPushBooleanGlobal(L: Plua_State; Name: PAnsiChar; B: Boolean); + +procedure luaPushUserData(L: Plua_State; U: Pointer); overload; inline; +procedure luaPushUserData(L: Plua_State; U: Pointer; var UIndex: Integer); overload; inline; +function luaGetUserData(L: Plua_State; idx: Integer): Pointer; inline; + +function LuaToString(L: Plua_State; Idx: Integer): String; +function LuaStackToString(L: Plua_State): String; + +procedure luaL_newlib(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); overload; inline; + +// deprecated since 5.2 +procedure luaL_openlib(L: Plua_State; n: PansiChar; lr: PluaL_Reg; + {%H-}nup: Integer); inline; +procedure luaL_register(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); inline; + +implementation + +procedure luaAddCFunctionToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Func: lua_CFunction); +begin + lua_pushstring(L, Name); + lua_pushcfunction(L, Func); + lua_rawset(L, Table); +end; + +procedure luaAddCClosureToTable(L: Plua_State; Table, Value: Integer; + Name: PAnsiChar; Func: lua_CFunction); +begin + lua_pushstring(L, Name); + lua_pushvalue(L, Value); + lua_pushcclosure(L, Func, 1); + lua_rawset(L, Table); +end; + +procedure luaAddCClosureToTable(L: Plua_State; Table: Integer; + Value: Pointer; Name: PAnsiChar; Func: lua_CFunction); +begin + lua_pushstring(L, Name); + lua_pushlightuserdata(L, Value); + lua_pushcclosure(L, Func, 1); + lua_rawset(L, Table); +end; + +procedure luaAddStringToTable(L: Plua_State; Table: Integer; Name, Value: PAnsiChar); +begin + lua_pushstring(L, Name); + lua_pushstring(L, Value); + lua_rawset(L, Table); +end; + +procedure luaAddIntegerToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Value: lua_Integer); +begin + lua_pushstring(L, Name); + lua_pushinteger(L, Value); + lua_rawset(L, Table); +end; + +procedure luaAddBooleanToTable(L: Plua_State; Table: Integer; + Name: PAnsiChar; Value: Boolean); +begin + lua_pushstring(L, Name); + lua_pushboolean(L, Value); + lua_rawset(L, Table); +end; + +procedure luaPushFunctionGlobal(L: Plua_State; Name: PAnsiChar; Func: lua_CFunction); +begin + lua_pushcfunction(L, Func); + lua_setglobal(L, Name); +end; + +procedure luaPushStringGlobal(L: Plua_State; Name: PAnsiChar; S: String); +begin + lua_pushstring(L, S); + lua_setglobal(L, Name); +end; + +procedure luaPushIntegerGlobal(L: Plua_State; Name: PAnsiChar; I: Integer); +begin + lua_pushinteger(L, I); + lua_setglobal(L, Name); +end; + +procedure luaPushBooleanGlobal(L: Plua_State; Name: PAnsiChar; B: Boolean); +begin + lua_pushboolean(L, B); + lua_setglobal(L, Name); +end; + +procedure luaPushUserData(L: Plua_State; U: Pointer); +begin + PPointer(lua_newuserdata(L, SizeOf(PPointer)))^ := U; +end; + +procedure luaPushUserData(L: Plua_State; U: Pointer; var UIndex: Integer); +begin + luaPushUserData(L, U); + UIndex := lua_gettop(L); +end; + +function luaGetUserData(L: Plua_State; idx: Integer): Pointer; +begin + Result := PPointer(lua_touserdata(L, idx))^; +end; + +function LuaToString(L: Plua_State; Idx: Integer): String; +begin + if lua_isuserdata(L, Idx) then + Result := 'userdata: ' + hexStr(lua_touserdata(L, Idx)) + else + if lua_isstring(L, Idx) then + Result := 'string: ' + lua_tostring(L, Idx) + else + if lua_isinteger(L, Idx) then + Result := 'integer: ' + IntToStr(lua_tointeger(L, Idx)) + else + if lua_iscfunction(L, Idx) then + Result := 'cfunc: ' + hexStr(lua_topointer(L, Idx)) + else + if lua_isfunction(L, Idx) then + Result := 'func: ' + hexStr(lua_topointer(L, Idx)) + else + if lua_isnoneornil(L, Idx) then + Result := 'nil' + else + if lua_isboolean(L, Idx) then + Result := 'boolean: ' + BoolToStr(lua_toboolean(L, Idx), True) + else + if lua_isnumber(L, Idx) then + Result := 'number: ' + FloatToStr(lua_tonumber(L, Idx)) + else + if lua_istable(L, Idx) then + Result := 'table: ' + hexStr(lua_topointer(L, Idx)) + else + if lua_islightuserdata(L, Idx) then + Result := 'ligthuserdata: ' + hexStr(lua_topointer(L, Idx)) + else + Result := 'unknown: ' + hexStr(lua_topointer(L, Idx)); +end; + +function LuaStackToString(L: Plua_State): String; +var + i: Integer; +begin + Result := ''; + i := lua_gettop(L); + if i = 0 then + Exit; + for i := 1 to i do + Result := Result + IntToStr(i) + '=' + LuaToString(L, i) + LineEnding; + SetLength(Result, Length(Result) - Length(LineEnding)); +end; + +procedure luaL_newlib(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); +begin + luaL_newlib(L, lr); + if n <> '' then + lua_setglobal(L, n); +end; + +procedure luaL_openlib(L: Plua_State; n: PansiChar; lr: PluaL_Reg; nup: Integer); +begin + luaL_setfuncs(L, lr, 0); + if n <> '' then + lua_setglobal(L, n); +end; + +procedure luaL_register(L: Plua_State; n: PAnsiChar; lr: PluaL_Reg); +begin + luaL_openlib(L, n, lr, 0); +end; + +end. diff --git a/baseunits/lua/LuaWebsiteModules.pas b/baseunits/lua/LuaWebsiteModules.pas new file mode 100644 index 000000000..65bbe4e73 --- /dev/null +++ b/baseunits/lua/LuaWebsiteModules.pas @@ -0,0 +1,881 @@ +unit LuaWebsiteModules; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fgl, lua53, LuaStringsStorage, WebsiteModules; + +type + TLuaWebsiteModulesContainer = class; + + { TLuaWebsiteModule } + + TLuaWebsiteModule = class + private + public + Module: TModuleContainer; + OnBeforeUpdateList: String; + OnAfterUpdateList: String; + OnGetDirectoryPageNumber: String; + OnGetNameAndLink: String; + OnGetInfo: String; + OnTaskStart: String; + OnGetPageNumber: String; + OnGetImageURL: String; + OnBeforeDownloadImage: String; + OnDownloadImage: String; + OnSaveImage: String; + OnAfterImageSaved: String; + OnLogin: String; + Storage: TStringsStorage; + LastUpdated: String; + Container: TLuaWebsiteModulesContainer; + + Options: TStringList; + + constructor Create; + destructor Destroy; override; + + function AddOption(const AName, ACaption: String; const AClass: TClass): Integer; + procedure AddOptionCheckBox(const AName, ACaption: String; const ADefault: Boolean); + procedure AddOptionEdit(const AName, ACaption: String; const ADefault: String); + procedure AddOptionSpinEdit(const AName, ACaption: String; const ADefault: Integer); + procedure AddOptionComboBox(const AName, ACaption, AItems: String; const ADefault: Integer); + + procedure LuaPushMe(L: Plua_State); + procedure LuaDoMe(L: Plua_State); + end; + + TLuaWebsiteModules = specialize TFPGList<TLuaWebsiteModule>; + + { TLuaWebsiteModulesContainer } + + TLuaWebsiteModulesContainer = class + public + Modules: TLuaWebsiteModules; + FileName: String; + ByteCode: TMemoryStream; + constructor Create; + destructor Destroy; override; + end; + + TLuaWebsiteModulesContainers = specialize TFPGList<TLuaWebsiteModulesContainer>; + + { TLuaWebsiteModulesManager } + + TLuaWebsiteModulesManager = class + public + Containers: TLuaWebsiteModulesContainers; + TempModuleList: TLuaWebsiteModules; + constructor Create; + destructor Destroy; override; + end; + + TOptionItem = class + Caption: String; + end; + + TOptionItemCheckBox = class(TOptionItem) + Value: Boolean; + end; + + TOptionItemEdit = class(TOptionItem) + Value: String; + end; + + TOptionItemSpinEdit = class(TOptionItem) + Value: Integer; + end; + + TOptionItemComboBox = class(TOptionItem) + Items: String; + Value: Integer; + end; + +procedure ScanLuaWebsiteModulesFile; + +procedure luaWebsiteModuleAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); + +var + LuaWebsiteModulesManager: TLuaWebsiteModulesManager; + AlwaysLoadLuaFromFile: Boolean = {$ifdef DEVBUILD}True{$else}False{$endif}; + +implementation + +uses + FMDOptions, FileUtil, MultiLog, LuaClass, LuaBase, LuaMangaInfo, LuaHTTPSend, + LuaXQuery, LuaUtils, LuaDownloadTask, LuaUpdateListManager, LuaStrings, uData, + uDownloadsManager, xquery, httpsendthread, FMDVars; + +function DoBeforeUpdateList(const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, updateList, 'updatelist', @luaUpdateListManagerAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnBeforeUpdateList); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoAfterUpdateList(const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, updateList, 'updatelist', @luaUpdateListManagerAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnAfterUpdateList); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoGetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + l: Plua_State; +begin + Result := INFORMATION_NOT_FOUND; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushIntegerGlobal(l, 'page', Page); + luaPushIntegerGlobal(l, 'workptr', WorkPtr); + luaPushObject(l, MangaInfo.mangaInfo, 'mangainfo', @luaMangaInfoAddMetaTable); + luaPushObject(l, MangaInfo.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushObject(l, updateList, 'updatelist', @luaUpdateListManagerAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnGetDirectoryPageNumber); + Result := lua_tointeger(l, -1); + if lua_getglobal(l, 'page') <> 0 then + Page := lua_tointeger(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoGetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + l: Plua_State; +begin + Result := INFORMATION_NOT_FOUND; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, MangaInfo.mangaInfo, 'mangainfo', @luaMangaInfoAddMetaTable); + luaPushObject(l, MangaInfo.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushStringGlobal(L, 'url', AURL); + luaPushObject(l, ANames, 'names', @luaStringsAddMetaTable); + luaPushObject(l, ALinks, 'links', @luaStringsAddMetaTable); + luaPushObject(l, updateList, 'updatelist', @luaUpdateListManagerAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnGetNameAndLink); + Result := lua_tointeger(L, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoGetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + l: Plua_State; +begin + Result := INFORMATION_NOT_FOUND; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushStringGlobal(l, 'url', AURL); + luaPushObject(l, MangaInfo.mangaInfo, 'mangainfo', @luaMangaInfoAddMetaTable); + luaPushObject(l, MangaInfo.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnGetInfo); + Result := lua_tointeger(L, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoTaskStart(const Task: TTaskContainer; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, Task, 'task', @luaDownloadTaskMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnTaskStart); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoGetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(L, DownloadThread.Task.Container, 'task', @luaDownloadTaskMetaTable); + luaPushObject(l, DownloadThread.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushStringGlobal(l, 'url', AURL); + + LuaDoMe(l); + LuaCallFunction(l, OnGetPageNumber); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoGetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(L, DownloadThread.Task.Container, 'task', @luaDownloadTaskMetaTable); + luaPushObject(l, DownloadThread.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushIntegerGlobal(l, 'workid', DownloadThread.WorkId); + luaPushStringGlobal(l, 'url', AURL); + + LuaDoMe(l); + LuaCallFunction(l, OnGetImageURL); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoBeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(L, DownloadThread.Task.Container, 'task', @luaDownloadTaskMetaTable); + luaPushObject(l, DownloadThread.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushIntegerGlobal(l, 'workid', DownloadThread.WorkId); + luaPushStringGlobal(l, 'url', AURL); + + LuaDoMe(l); + LuaCallFunction(l, OnBeforeDownloadImage); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoDownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(L, DownloadThread.Task.Container, 'task', @luaDownloadTaskMetaTable); + luaPushObject(l, DownloadThread.FHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushIntegerGlobal(l, 'workid', DownloadThread.WorkId); + luaPushStringGlobal(l, 'url', AURL); + + LuaDoMe(l); + LuaCallFunction(l, OnDownloadImage); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoSaveImage(const AHTTP: THTTPSendThread; const APath, AName: String; + const Module: TModuleContainer): String; +var + l: Plua_State; +begin + Result := ''; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, AHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + luaPushStringGlobal(l, 'path', APath); + luaPushStringGlobal(l, 'name', AName); + + LuaDoMe(l); + LuaCallFunction(l, OnSaveImage); + Result := lua_tostring(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoAfterImageSaved(const AFilename: String; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushStringGlobal(l, 'filename', AFilename); + + LuaDoMe(l); + LuaCallFunction(l, OnAfterImageSaved); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function DoLogin(const AHTTP: THTTPSendThread; const Module: TModuleContainer): Boolean; +var + l: Plua_State; +begin + Result := False; + with TLuaWebsiteModule(Module.TagPtr) do + begin + l := LuaNewBaseState; + try + LuaPushMe(l); + luaPushObject(l, AHTTP, 'http', @luaHTTPSendThreadAddMetaTable); + + LuaDoMe(l); + LuaCallFunction(l, OnLogin); + Result := lua_toboolean(l, -1); + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(l, -1)); + end; + lua_close(l); + end; +end; + +function LoadLuaToWebsiteModules(AFilename: String): Boolean; +var + l: Plua_State; + c: TLuaWebsiteModulesContainer; + m: TMemoryStream; + i: Integer; + s: String; +begin + Result := False; + Logger.Send('Load lua website module', AFilename); + try + l := LuaNewBaseState; + try + m := LuaDumpFileToStream(l, AFilename); + if m <> nil then + begin + i := lua_pcall(l, 0, 0, 0); + if i <> 0 then + raise Exception.Create(LuaGetReturnString(i)); + LuaCallFunction(l, 'Init'); + end; + except + on E: Exception do + Logger.SendError(E.Message + ': ' + lua_tostring(L, -1)); + end; + finally + lua_close(l); + end; + + if LuaWebsiteModulesManager.TempModuleList.Count <> 0 then + with LuaWebsiteModulesManager do + begin + c := TLuaWebsiteModulesContainer.Create; + c.FileName := AFilename; + c.ByteCode := m; + m := nil; + s := ''; + Containers.Add(c); + for i := 0 to TempModuleList.Count - 1 do + with TempModuleList[i] do + begin + s += Module.Website + ', '; + c.Modules.Add(TempModuleList[i]); + Container := c; + if OnBeforeUpdateList <> '' then + Module.OnBeforeUpdateList := @DoBeforeUpdateList; + if OnAfterUpdateList <> '' then + Module.OnAfterUpdateList := @DoAfterUpdateList; + if OnGetDirectoryPageNumber <> '' then + Module.OnGetDirectoryPageNumber := @DoGetDirectoryPageNumber; + if OnGetNameAndLink <> '' then + Module.OnGetNameAndLink := @DoGetNameAndLink; + if OnGetInfo <> '' then + Module.OnGetInfo := @DoGetInfo; + if OnTaskStart <> '' then + Module.OnTaskStart := @DoTaskStart; + if OnGetPageNumber <> '' then + Module.OnGetPageNumber := @DoGetPageNumber; + if OnGetImageURL <> '' then + Module.OnGetImageURL := @DoGetImageURL; + if OnBeforeDownloadImage <> '' then + Module.OnBeforeDownloadImage := @DoBeforeDownloadImage; + if OnDownloadImage <> '' then + Module.OnDownloadImage := @DoDownloadImage; + if OnSaveImage <> '' then + Module.OnSaveImage := @DoSaveImage; + if OnAfterImageSaved <> '' then + Module.OnAfterImageSaved := @DoAfterImageSaved; + if OnLogin <> '' then + Module.OnLogin := @DoLogin; + end; + TempModuleList.Clear; + SetLength(s, Length(s) - 2); + Logger.Send('Loaded modules from ' + ExtractFileName(AFilename), s); + s := ''; + end; + if m <> nil then + m.Free; +end; + +procedure ScanLuaWebsiteModulesFile; +var + d: String; + f: TStringList; + i: Integer; +begin + d := LUA_WEBSITEMODULE_FOLDER; + try + f := FindAllFiles(d, '*.lua;*.luac', False, faAnyFile); + if f.Count > 0 then + for i := 0 to f.Count - 1 do + LoadLuaToWebsiteModules(f[i]); + finally + f.Free; + end; +end; + +{ TLuaWebsiteModulesManager } + +constructor TLuaWebsiteModulesManager.Create; +begin + Containers := TLuaWebsiteModulesContainers.Create; + TempModuleList := TLuaWebsiteModules.Create; +end; + +destructor TLuaWebsiteModulesManager.Destroy; +var + i: Integer; +begin + for i := 0 to TempModuleList.Count - 1 do + TempModuleList[i].Free; + TempModuleList.Free; + for i := 0 to Containers.Count - 1 do + Containers[i].Free; + Containers.Free; + inherited Destroy; +end; + +{ TLuaWebsiteModulesContainer } + +constructor TLuaWebsiteModulesContainer.Create; +begin + Modules := TLuaWebsiteModules.Create; + ByteCode := nil; +end; + +destructor TLuaWebsiteModulesContainer.Destroy; +var + i: Integer; +begin + if Assigned(ByteCode) then + ByteCode.Free; + for i := 0 to Modules.Count - 1 do + Modules[i].Free; + Modules.Free; + inherited Destroy; +end; + + +{ TLuaWebsiteModule } + +constructor TLuaWebsiteModule.Create; +begin + LuaWebsiteModulesManager.TempModuleList.Add(Self); + Storage := TStringsStorage.Create; + Options := TStringList.Create; + Options.OwnsObjects := True; + Options.Duplicates := dupIgnore; + Options.Sorted := True; + Module := Modules.AddModule; + Module.TagPtr := Self; +end; + +destructor TLuaWebsiteModule.Destroy; +begin + Options.Free; + Storage.Free; + inherited Destroy; +end; + +function TLuaWebsiteModule.AddOption(const AName, ACaption: String; const AClass: TClass): Integer; +var + o: TOptionItem; +begin + Result := Options.Add(AName); + if Result = -1 then Exit; + o := TOptionItem(AClass.Create); + o.Caption := ACaption; + Options.Objects[Result] := o; +end; + +procedure TLuaWebsiteModule.AddOptionCheckBox(const AName, ACaption: String; + const ADefault: Boolean); +var + o: TOptionItemCheckBox; + i: Integer; +begin + i := AddOption(AName, ACaption, TOptionItemCheckBox); + if i = -1 then Exit; + o := TOptionItemCheckBox(Options.Objects[i]); + o.Value := ADefault; + Module.AddOptionCheckBox(@o.Value, Options[i], @o.Caption); +end; + +procedure TLuaWebsiteModule.AddOptionEdit(const AName, ACaption: String; const ADefault: String); +var + o: TOptionItemEdit; + i: Integer; +begin + i := AddOption(AName, ACaption, TOptionItemEdit); + if i = -1 then Exit; + o := TOptionItemEdit(Options.Objects[i]); + o.Value := ADefault; + Module.AddOptionEdit(@o.Value, Options[i], @o.Caption); +end; + +procedure TLuaWebsiteModule.AddOptionSpinEdit(const AName, ACaption: String; + const ADefault: Integer); +var + o: TOptionItemSpinEdit; + i: Integer; +begin + i := AddOption(AName, ACaption, TOptionItemSpinEdit); + if i = -1 then Exit; + o := TOptionItemSpinEdit(Options.Objects[i]); + o.Value := ADefault; + Module.AddOptionSpinEdit(@o.Value, Options[i], @o.Caption); +end; + +procedure TLuaWebsiteModule.AddOptionComboBox(const AName, ACaption, AItems: String; + const ADefault: Integer); +var + o: TOptionItemComboBox; + i: Integer; +begin + i := AddOption(AName, ACaption, TOptionItemComboBox); + if i = -1 then Exit; + o := TOptionItemComboBox(Options.Objects[i]); + o.Items := AItems; + o.Value := ADefault; + Module.AddOptionComboBox(@o.Value, Options[i], @o.Caption, @o.Items); +end; + +procedure TLuaWebsiteModule.LuaPushMe(L: Plua_State); +begin + luaPushObject(L, Self, 'module', @luaWebsiteModuleAddMetaTable); + luaPushIntegerGlobal(L, 'no_error', NO_ERROR); + luaPushIntegerGlobal(L, 'net_problem', NET_PROBLEM); + luaPushIntegerGlobal(L, 'information_not_found', INFORMATION_NOT_FOUND); + + // account status + luaPushIntegerGlobal(L, 'asUnknown', Integer(asUnknown)); + luaPushIntegerGlobal(L, 'asChecking', Integer(asChecking)); + luaPushIntegerGlobal(L, 'asValid', Integer(asValid)); + luaPushIntegerGlobal(L, 'asInvalid', Integer(asInvalid)); +end; + +procedure TLuaWebsiteModule.LuaDoMe(L: Plua_State); +var + r: Integer; +begin + if AlwaysLoadLuaFromFile then + r := luaL_loadfile(L, PChar(Container.FileName)) + else + r := LuaLoadFromStream(L, Container.ByteCode, PChar(Container.FileName)); + if r = 0 then + r := lua_pcall(L, 0, 0, 0); + if r <> 0 then + raise Exception.Create(LuaGetReturnString(r)); +end; + +// ----------------------------------------------------------------------------- +// ----------------------------------------------------------------------------- + +function lua_addoptioncheckbox(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).AddOptionCheckBox( + lua_tostring(L, 1), lua_tostring(L, 2), lua_toboolean(L, 3)); +end; + +function lua_addoptionedit(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).AddOptionEdit( + lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3)); +end; + +function lua_addoptionspinedit(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).AddOptionSpinEdit( + lua_tostring(L, 1), lua_tostring(L, 2), lua_tointeger(L, 3)); +end; + +function lua_addoptioncombobox(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).AddOptionComboBox( + lua_tostring(L, 1), lua_tostring(L, 2), lua_tostring(L, 3), lua_tointeger(L, 4)); +end; + +function lua_gettotaldirectory(L: Plua_State): Integer; cdecl; +begin + lua_pushinteger(L, TLuaWebsiteModule(luaClassGetObject(L)).Module.TotalDirectory); + Result := 1; +end; + +function lua_settotaldirectory(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).Module.TotalDirectory := lua_tointeger(L, 1); +end; + +function lua_getoption(L: Plua_State): Integer; cdecl; +var + m: TLuaWebsiteModule; + i: Integer; + o: TObject; +begin + m := TLuaWebsiteModule(luaClassGetObject(L)); + i:=m.Options.IndexOf(lua_tostring(L, 1)); + Result := 1; + if i = -1 then + lua_pushnil(L) + else + begin + o := m.Options.Objects[i]; + if o is TOptionItemCheckBox then + lua_pushboolean(L, TOptionItemCheckBox(o).Value) + else + if o is TOptionItemEdit then + lua_pushstring(L, TOptionItemEdit(o).Value) + else + if o is TOptionItemSpinEdit then + lua_pushinteger(L, TOptionItemSpinEdit(o).Value) + else + if o is TOptionItemComboBox then + lua_pushinteger(L, TOptionItemComboBox(o).Value) + else + lua_pushnil(L); + end; +end; + +function lua_getaccountsupport(L: Plua_State): Integer; cdecl; +begin + lua_pushboolean(L, TLuaWebsiteModule(luaClassGetObject(L)).Module.AccountSupport); + Result := 1; +end; + +function lua_setaccountsupport(L: Plua_State): Integer; cdecl; +begin + Result := 0; + TLuaWebsiteModule(luaClassGetObject(L)).Module.AccountSupport := lua_toboolean(L, 1); +end; + +const + methods: packed array [0..5] of luaL_Reg = ( + (name: 'AddOptionCheckBox'; func: @lua_addoptioncheckbox), + (name: 'AddOptionEdit'; func: @lua_addoptionedit), + (name: 'AddOptionSpinEdit'; func: @lua_addoptionspinedit), + (name: 'AddOptionCombobox'; func: @lua_addoptioncombobox), + (name: 'GetOption'; func: @lua_getoption), + (name: nil; func: nil) + ); + +procedure luaWebsiteModuleAccountAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + with TWebsiteModuleAccount(Obj) do + begin + luaClassAddBooleanProperty(L, MetaTable, 'Enabled', @Enabled); + luaClassAddStringProperty(L, MetaTable, 'Username', @Username); + luaClassAddStringProperty(L, MetaTable, 'Password', @Password); + luaClassAddStringProperty(L, MetaTable, 'Cookies', @Cookies); + luaClassAddIntegerProperty(L, MetaTable, 'Status', @Status); + end; +end; + +procedure luaWebsiteModuleAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + with TLuaWebsiteModule(Obj) do + begin + luaClassAddStringProperty(L, MetaTable, 'Website', @Module.Website); + luaClassAddStringProperty(L, MetaTable, 'RootURL', @Module.RootURL); + luaClassAddStringProperty(L, MetaTable, 'Category', @Module.Category); + luaClassAddIntegerProperty(L, MetaTable, 'MaxTaskLimit', @Module.MaxTaskLimit); + luaClassAddIntegerProperty(L, MetaTable, 'MaxThreadPerTaskLimit', @Module.MaxThreadPerTaskLimit); + luaClassAddIntegerProperty(L, MetaTable, 'MaxConnectionLimit', + @Module.MaxConnectionLimit); + luaClassAddIntegerProperty(L, MetaTable, 'ActiveTaskCount', @Module.ActiveTaskCount); + luaClassAddIntegerProperty(L, MetaTable, 'ActiveConnectionCount', + @Module.ActiveConnectionCount); + luaClassAddBooleanProperty(L, MetaTable, 'SortedList', @Module.SortedList); + luaClassAddBooleanProperty(L, MetaTable, 'InformationAvailable', + @Module.InformationAvailable); + luaClassAddBooleanProperty(L, MetaTable, 'FavoriteAvailable', + @Module.FavoriteAvailable); + luaClassAddBooleanProperty(L, MetaTable, 'DynamicPageLink', @Module.DynamicPageLink); + luaClassAddBooleanProperty(L, MetaTable, 'CloudflareEnabled', + @Module.CloudflareEnabled); + luaClassAddStringProperty(L, MetaTable, 'OnBeforeUpdateList', @OnBeforeUpdateList); + luaClassAddStringProperty(L, MetaTable, 'OnAfterUpdateList', @OnAfterUpdateList); + luaClassAddStringProperty(L, MetaTable, 'OnGetDirectoryPageNumber', + @OnGetDirectoryPageNumber); + luaClassAddStringProperty(L, MetaTable, 'OnGetNameAndLink', @OnGetNameAndLink); + luaClassAddStringProperty(L, MetaTable, 'OnGetInfo', @OnGetInfo); + luaClassAddStringProperty(L, MetaTable, 'OnTaskStart', @OnTaskStart); + luaClassAddStringProperty(L, MetaTable, 'OnGetPageNumber', @OnGetPageNumber); + luaClassAddStringProperty(L, MetaTable, 'OnGetImageURL', @OnGetImageURL); + luaClassAddStringProperty(L, MetaTable, 'OnBeforeDownloadImage', + @OnBeforeDownloadImage); + luaClassAddStringProperty(L, MetaTable, 'OnDownloadImage', @OnDownloadImage); + luaClassAddStringProperty(L, MetaTable, 'OnSaveImage', @OnSaveImage); + luaClassAddStringProperty(L, MetaTable, 'OnAfterImageSaved', @OnAfterImageSaved); + luaClassAddStringProperty(L, MetaTable, 'OnLogin', @OnLogin); + luaClassAddStringProperty(L, MetaTable, 'LastUpdated', @LastUpdated); + luaClassAddIntegerProperty(L, MetaTable, 'CurrentDirectoryIndex', @Module.CurrentDirectoryIndex); + + luaClassAddProperty(L, MetaTable, UserData, 'TotalDirectory', @lua_gettotaldirectory, @lua_settotaldirectory); + luaClassAddProperty(L, MetaTable, UserData, 'AccountSupport', @lua_getaccountsupport, @lua_setaccountsupport); + + luaClassAddFunction(L, MetaTable, UserData, methods); + + luaClassAddObject(L, MetaTable, Storage, 'Storage', @luaStringsStorageAddMetaTable); + + if Module.Account<>nil then + luaClassAddObject(L, MetaTable, Module.Account, 'Account', @luaWebsiteModuleAccountAddMetaTable); + + luaClassAddIntegerProperty(L, MetaTable, 'Tag', @Module.Tag); + end; +end; + +function _create(L: Plua_State): Integer; cdecl; +begin + luaClassPushObject(L, TLuaWebsiteModule.Create, '', False, + @luaWebsiteModuleAddMetaTable); + Result := 1; +end; + +procedure luaWebsiteModuleRegister(L: Plua_State); +begin + lua_register(L, 'NewModule', @_create); +end; + +initialization + luaClassRegister(TLuaWebsiteModule, @luaWebsiteModuleAddMetaTable, + @luaWebsiteModuleRegister); + LuaWebsiteModulesManager := TLuaWebsiteModulesManager.Create; + +finalization + LuaWebsiteModulesManager.Free; + +end. diff --git a/baseunits/lua/LuaXQuery.pas b/baseunits/lua/LuaXQuery.pas new file mode 100644 index 000000000..2d53ce9af --- /dev/null +++ b/baseunits/lua/LuaXQuery.pas @@ -0,0 +1,197 @@ +unit LuaXQuery; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, lua53, XQueryEngineHTML, xquery; + +procedure luaXQueryPush(L: Plua_State; Obj: TXQueryEngineHTML; Name: String = ''; + AutoFree: Boolean = False); inline; + +implementation + +uses + LuaClass, LuaIXQValue, LuaUtils; + +type + TUserData = TXQueryEngineHTML; + +function xquery_create(L: Plua_State): Integer; cdecl; +begin + if lua_gettop(L) = 1 then + begin + if lua_isstring(L, 1) then + luaXQueryPush(L, TXQueryEngineHTML.Create(lua_tostring(L, 1)), '', True) + else + if lua_isuserdata(L, 1) then + luaXQueryPush(L, TXQueryEngineHTML.Create(TStream(luaGetUserData(L, 1))), + '', True); + end + else + luaXQueryPush(L, TXQueryEngineHTML.Create, '', True); + Result := 1; +end; + +function xquery_parsehtml(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + Result := 0; + u := TUserData(luaClassGetObject(L)); + if lua_isstring(L, 1) then + u.ParseHTML(lua_tostring(L, 1)) + else + if lua_isuserdata(L, 1) then + u.ParseHTML(TStream(luaGetUserData(L, 1))); +end; + +function xquery_xpath(L: Plua_State): Integer; cdecl; +var + u: TUserData; + x: IXQValue; +begin + u := TUserData(luaClassGetObject(L)); + if lua_gettop(L) = 2 then + x := u.XPath(lua_tostring(L, 1), TLuaIXQValue(luaGetUserData(L, 2)).FIXQValue) + else + x := u.XPath(lua_tostring(L, 1)); + luaIXQValuePush(L, TLuaIXQValue.Create(x)); + Result := 1; +end; + +function xquery_xpathstring(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + u := TUserData(luaClassGetObject(L)); + if lua_gettop(L) = 2 then + lua_pushstring(L, u.XPathString(lua_tostring(L, 1), + TLuaIXQValue(luaGetUserData(L, 2)).FIXQValue)) + else + lua_pushstring(L, u.XPathString(lua_tostring(L, 1))); + Result := 1; +end; + +function xquery_xpathstringall(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + Result := 0; + u := TUserData(luaClassGetObject(L)); + case lua_gettop(L) of + 1: begin + lua_pushstring(L, u.XPathStringAll(lua_tostring(L, 1))); + Result := 1; + end; + 2: begin + if lua_isstring(L, 2) then + begin + lua_pushstring(L, u.XPathStringAll(lua_tostring(L, 1), lua_tostring(L, 2))); + Result := 1; + end + else + if lua_isuserdata(L, 2) then + begin + u.XPathStringAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2))); + Result := 0; + end; + end; + 3: begin + if lua_isstring(L, 2) then + begin + lua_pushstring(L, u.XPathStringAll(lua_tostring(L, 1), lua_tostring(L, 2), + TLuaIXQValue(luaGetUserData(L, 3)).FIXQValue)); + Result := 1; + end + else + if lua_isuserdata(L, 2) then + begin + u.XPathStringAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2)), + TLuaIXQValue(luaGetUserData(L, 3)).FIXQValue); + Result := 0; + end; + end; + end; +end; + +function xquery_xpathhrefall(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + u := TUserData(luaClassGetObject(L)); + case lua_gettop(L) of + 3: u.XPathHREFAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2)), + TStrings(luaGetUserData(L, 3))); + 4: u.XPathHREFAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2)), + TStrings(luaGetUserData(L, 3)), TLuaIXQValue(luaGetUserData(L, 4)).FIXQValue) + end; + Result := 0; +end; + +function xquery_xpathhreftitleall(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + u := TUserData(luaClassGetObject(L)); + case lua_gettop(L) of + 3: u.XPathHREFtitleAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2)), + TStrings(luaGetUserData(L, 3))); + 4: u.XPathHREFtitleAll(lua_tostring(L, 1), TStrings(luaGetUserData(L, 2)), + TStrings(luaGetUserData(L, 3)), TLuaIXQValue(luaGetUserData(L, 4)).FIXQValue) + end; + Result := 0; +end; + +function xquery_xpathcount(L: Plua_State): Integer; cdecl; +var + u: TUserData; +begin + u := TUserData(luaClassGetObject(L)); + if lua_gettop(L) = 2 then + lua_pushinteger(L, u.XPathCount(lua_tostring(L, 1), + TLuaIXQValue(luaGetUserData(L, 2)).FIXQValue)) + else + lua_pushinteger(L, u.XPathCount(lua_tostring(L, 1))); + Result := 1; +end; + +const + constructs: packed array [0..2] of luaL_Reg = ( + (name: 'New'; func: @xquery_create), + (name: 'Create'; func: @xquery_create), + (name: nil; func: nil) + ); + methods: packed array [0..7] of luaL_Reg = ( + (name: 'ParseHTML'; func: @xquery_parsehtml), + (name: 'XPath'; func: @xquery_xpath), + (name: 'XPathString'; func: @xquery_xpathstring), + (name: 'XpathStringAll'; func: @xquery_xpathstringall), + (name: 'XpathHREFAll'; func: @xquery_xpathhrefall), + (name: 'XpathHREFTitleAll'; func: @xquery_xpathhreftitleall), + (name: 'XPathCount'; func: @xquery_xpathcount), + (name: nil; func: nil) + ); + +procedure luaXQueryAddMetaTable(L: Plua_State; Obj: Pointer; + MetaTable, UserData: Integer; AutoFree: Boolean = False); +begin + luaClassAddFunction(L, MetaTable, UserData, methods); +end; + +procedure luaXQueryPush(L: Plua_State; Obj: TXQueryEngineHTML; Name: String; + AutoFree: Boolean); +begin + luaClassPushObject(L, Obj, Name, AutoFree, @luaXQueryAddMetaTable); +end; + +procedure luaXQueryRegister(L: Plua_State); +begin + luaClassNewLib(L, 'TXQuery', constructs); +end; + +initialization + luaClassRegister(TXQueryEngineHTML, @luaXQueryAddMetaTable, @luaXQueryRegister); + +end. diff --git a/baseunits/lua/lua53.pas b/baseunits/lua/lua53.pas new file mode 100644 index 000000000..ab293cd3c --- /dev/null +++ b/baseunits/lua/lua53.pas @@ -0,0 +1,920 @@ +(****************************************************************************** + * * + * File: lua53.pas * + * * + * Authors: TeCGraf (C headers + actual Lua libraries) * + * Lavergne Thomas (original translation to Pascal) * + * Bram Kuijvenhoven (update to Lua 5.1.1 for FreePascal) * + * Egor Skriptunoff (update to Lua 5.2.1 for FreePascal) * + * Vladimir Klimov (Delphi compatibility) * + * Malcome@Japan (update to Lua 5.3.0 for FreePascal) * + * * + * Description: Basic Lua library * + * Lua auxiliary library * + * Standard Lua libraries * + * This is 3-in-1 replacement for FPC modules lua.pas,lauxlib.pas,lualib.pas * + * * + ******************************************************************************) + +(* +** $Id: lua.h,v 1.325 2014/12/26 17:24:27 roberto Exp $ +** $Id: lauxlib.h,v 1.128 2014/10/29 16:11:17 roberto Exp $ +** $Id: lualib.h,v 1.44 2014/02/06 17:32:33 roberto Exp $ +** Lua - A Scripting Language +** Lua.org, PUC-Rio, Brazil (http://www.lua.org) +** See Copyright Notice at the end of this file +*) +(* +** Translated to pascal by Lavergne Thomas +** Notes : +** - Pointers type was prefixed with 'P' +** - lua_upvalueindex constant was transformed to function +** - Some compatibility function was isolated because with it you must have +** lualib. +** - LUA_VERSION was suffixed by '_' for avoiding name collision. +** Bug reports : +** - thomas.lavergne@laposte.net +** In french or in english +*) +(* +** Updated to Lua 5.1.1 by Bram Kuijvenhoven (bram at kuijvenhoven dot net), +** Hexis BV (http://www.hexis.nl), the Netherlands +** Notes: +** - Only tested with FPC (FreePascal Compiler) +** - Using LuaBinaries styled DLL/SO names, which include version names +** - LUA_YIELD was suffixed by '_' for avoiding name collision +*) +(* +** Updated to Lua 5.2.1 by Egor Skriptunoff +** Notes: +** - Only tested with FPC (FreePascal Compiler) +** - Functions dealing with luaL_Reg were overloaded to accept pointer +** or open array parameter. In any case, do not forget to terminate +** your array with "sentinel". +** - All floating-point exceptions were forcibly disabled in Windows +** to overcome well-known bug +** Bug reports: +** - egor.skriptunoff at gmail.com +** In russian or in english +*) +(* +** Delphi compatibility by Vladimir Klimov +** Notes: +** - fixed luaL_error syntax +** - PChar replaced with PAnsiChar, String with AnsiString due to since +** D2009 both PChar and String are unicode +** Bug reports: +** - wintarif@narod.ru +** russian or english +*) +(* +** Updated to Lua 5.3.0 by Malcome@Japan +** Notes: +** - Only tested with FPC (FreePascal Compiler) +** - Needs Delphi with Int64 supported. +*) + + +//-------------------------- +// What was not translated: +//-------------------------- +// macro +// #define luaL_opt(L,f,n,d) (lua_isnoneornil(L,(n)) ? (d) : f(L,(n))) + +// Generic Buffer manipulation functions and macros were not translated. +// They are not required in Pascal programs due to powerful String type. +// luaL_addchar, luaL_addsize, luaL_buffinit, luaL_prepbuffsize, +// luaL_addlstring, luaL_addstring, luaL_addvalue, luaL_pushresult, +// luaL_pushresultsize, luaL_buffinitsize, luaL_prepbuffer + +// Functions defined with LUA_COMPAT_MODULE are deprecated. +// They were translated but commented intentionally. +// Uncomment them if you really need. +// luaL_pushmodule, luaL_openlib, luaL_register + + +{$IFDEF FPC}{$MODE OBJFPC}{$H+}{$ENDIF} + +unit lua53; + +interface + +const +{$IFDEF MSWINDOWS} + LUA_LIB_NAME = 'lua53.dll'; +{$ELSE} + LUA_LIB_NAME = 'liblua5.3.so'; +{$ENDIF} + +const + LUA_VERSION_MAJOR = '5'; + LUA_VERSION_MINOR = '3'; + LUA_VERSION_NUM = 503; + LUA_VERSION_RELEASE = '0'; + LUA_VERSION_ = 'Lua 5.3'; // LUA_VERSION was suffixed by '_' for avoiding name collision + LUA_RELEASE = 'Lua 5.3.0'; + LUA_COPYRIGHT = 'Lua 5.3.0 Copyright (C) 1994-2015 Lua.org, PUC-Rio'; + LUA_AUTHORS = 'R. Ierusalimschy, L. H. de Figueiredo, W. Celes'; + LUA_SIGNATURE = #27'Lua'; // mark for precompiled code '<esc>Lua' + LUA_MULTRET = -1; // option for multiple returns in 'lua_pcall' and 'lua_call' + + // pseudo-indices + LUA_REGISTRYINDEX = -1001000; + +function lua_upvalueindex(I: Integer): Integer; inline; + +// thread status +const + LUA_OK = 0; + LUA_YIELD_ = 1; // LUA_YIELD was suffixed by '_' for avoiding name collision + LUA_ERRRUN = 2; + LUA_ERRSYNTAX = 3; + LUA_ERRMEM = 4; + LUA_ERRGCMM = 5; + LUA_ERRERR = 6; + LUA_ERRFILE = LUA_ERRERR + 1; // extra error code for `luaL_load' + +type + // Type of Numbers in Lua +{$IFDEF FPC} + lua_Integer = Int64; + lua_Unsigned = UInt64; +{$ELSE} // Delphi + {$IF CompilerVersion < 18} + lua_Integer = Int64; + lua_Unsigned = Int64; + {$ELSE} + lua_Integer = Int64; + lua_Unsigned = UInt64; + {$IFEND} +{$ENDIF} + + Plua_Integer = ^lua_Integer; + Plua_Unsigned = ^lua_Unsigned; + + lua_Number = Double; + Plua_Number = ^lua_Number; + + size_t = Cardinal; + Psize_t = ^size_t; + + Plua_State = Pointer; + + // type for continuation-function contexts + lua_KContext = Pointer; + + lua_CFunction = function(L: Plua_State): Integer; cdecl; + + // Type for continuation functions + lua_KFunction = function(L: Plua_State; status: Integer; ctx: lua_KContext): Integer; cdecl; + + // functions that read/write blocks when loading/dumping Lua chunks + lua_Reader = function(L: Plua_State; ud: Pointer; sz: Psize_t): PAnsiChar; cdecl; + lua_Writer = function(L: Plua_State; const p: Pointer; sz: size_t; ud: Pointer): Integer; cdecl; + + // prototype for memory-allocation functions + lua_Alloc = function(ud, ptr: Pointer; osize, nsize: size_t): Pointer; cdecl; + +const + // basic types + LUA_TNONE = -1; + LUA_TNIL = 0; + LUA_TBOOLEAN = 1; + LUA_TLIGHTUSERDATA = 2; + LUA_TNUMBER = 3; + LUA_TSTRING = 4; + LUA_TTABLE = 5; + LUA_TFUNCTION = 6; + LUA_TUSERDATA = 7; + LUA_TTHREAD = 8; + LUA_NUMTAGS = 9; + + // minimum Lua stack available to a C function + LUA_MINSTACK = 20; + + // predefined values in the registry */ + LUA_RIDX_MAINTHREAD = 1; + LUA_RIDX_GLOBALS = 2; + LUA_RIDX_LAST = LUA_RIDX_GLOBALS; + +// state manipulation +function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_state; cdecl; +procedure lua_close(L: Plua_State); cdecl; +function lua_newthread(L: Plua_State): Plua_State; cdecl; +function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; +function lua_version(L: Plua_State): Plua_Number; cdecl; + +// basic stack manipulation +function lua_absindex(L: Plua_State; idx: Integer): Integer; cdecl; +function lua_gettop(L: Plua_State): Integer; cdecl; +procedure lua_settop(L: Plua_State; idx: Integer); cdecl; +procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; +procedure lua_rotate(L: Plua_State; idx, n: Integer); cdecl; +procedure lua_remove(L: Plua_State; idx: Integer); inline; +procedure lua_insert(L: Plua_State; idx: Integer); inline; +procedure lua_replace(L: Plua_State; idx: Integer); inline; +procedure lua_copy(L: Plua_State; fromidx, toidx: Integer); cdecl; +function lua_checkstack(L: Plua_State; n: Integer): LongBool; cdecl; + +procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; + +// access functions (stack -> C) +function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_isinteger(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; +function lua_typename(L: Plua_State; tp: Integer): PAnsiChar; cdecl; +function lua_tonumberx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Number; cdecl; +function lua_tointegerx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Integer; cdecl; +function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; +function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; +function lua_rawlen(L: Plua_State; idx: Integer): size_t; cdecl; +function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; +function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; +function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; +function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; + +// Arithmetic functions +const + LUA_OPADD = 0; (* ORDER TM, ORDER OP *) + LUA_OPSUB = 1; + LUA_OPMUL = 2; + LUA_OPMOD = 3; + LUA_OPPOW = 4; + LUA_OPDIV = 5; + LUA_OPIDIV = 6; + LUA_OPBAND = 7; + LUA_OPBOR = 8; + LUA_OPBXOR = 9; + LUA_OPSHL = 10; + LUA_OPSHR = 11; + LUA_OPUNM = 12; + LUA_OPBNOT = 13; + +procedure lua_arith(L: Plua_State; op: Integer); cdecl; + +// Comparison functions +const + LUA_OPEQ = 0; + LUA_OPLT = 1; + LUA_OPLE = 2; + +function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; +function lua_compare(L: Plua_State; idx1, idx2, op: Integer): LongBool; cdecl; + +// push functions (C -> stack) +procedure lua_pushnil(L: Plua_State); cdecl; +procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; +procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; +procedure lua_pushlstring(L: Plua_State; const s: PAnsiChar; len: size_t); cdecl; +procedure lua_pushstring(L: Plua_State; const s: PAnsiChar); cdecl; overload; +procedure lua_pushstring(L: Plua_State; const s: AnsiString); inline; overload; // added for Pascal +function lua_pushvfstring(L: Plua_State; const fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; +function lua_pushfstring(L: Plua_State; const fmt: PAnsiChar): PAnsiChar; cdecl; varargs; +procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; +procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; +procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; +procedure lua_pushthread(L: Plua_State); cdecl; + +// get functions (Lua -> stack) +function lua_getglobal(L: Plua_State; const name: PAnsiChar): Integer; cdecl; +function lua_gettable(L: Plua_State; idx: Integer): Integer; cdecl; +function lua_getfield(L: Plua_state; idx: Integer; k: PAnsiChar): Integer; cdecl; +function lua_geti(L: Plua_State; idx: Integer; n: lua_Integer): Integer cdecl; +function lua_rawget(L: Plua_State; idx: Integer): Integer; cdecl; +function lua_rawgeti(L: Plua_State; idx, n: Integer): Integer; cdecl; +function lua_rawgetp(L: Plua_State; idx: Integer; p: Pointer): Integer; cdecl; + +procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; +function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; +function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; +function lua_getuservalue(L: Plua_State; idx: Integer): Integer; cdecl; + +// set functions (stack -> Lua) +procedure lua_setglobal(L: Plua_State; const name: PAnsiChar); cdecl; +procedure lua_settable(L: Plua_State; idx: Integer); cdecl; +procedure lua_setfield(L: Plua_State; idx: Integer; k: PAnsiChar); cdecl; +procedure lua_seti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; +procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; +procedure lua_rawseti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; +procedure lua_rawsetp(L: Plua_State; idx: Integer; p: Pointer); cdecl; +function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; +procedure lua_setuservalue(L: Plua_State; idx: Integer); cdecl; + +// 'load' and 'call' functions (load and run Lua code) +procedure lua_callk(L: Plua_State; nargs, nresults: Integer; ctx: lua_KContext; k: lua_KFunction); cdecl; +procedure lua_call(L: Plua_State; nargs, nresults: Integer); inline; +function lua_pcallk(L: Plua_State; nargs, nresults, errfunc: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; +function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; inline; +function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname, mode: PAnsiChar): Integer; cdecl; +function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer; strip: Integer): Integer; cdecl; + +// coroutine functions +function lua_yieldk(L: Plua_State; nresults: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; +function lua_yield(L: Plua_State; nresults: Integer): Integer; inline; +function lua_resume(L, from: Plua_State; narg: Integer): Integer; cdecl; +function lua_status(L: Plua_State): Integer; cdecl; +function lua_isyieldable(L: Plua_State): LongBool; cdecl; + +// garbage-collection function and options +const + LUA_GCSTOP = 0; + LUA_GCRESTART = 1; + LUA_GCCOLLECT = 2; + LUA_GCCOUNT = 3; + LUA_GCCOUNTB = 4; + LUA_GCSTEP = 5; + LUA_GCSETPAUSE = 6; + LUA_GCSETSTEPMUL = 7; + LUA_GCISRUNNING = 9; + +function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; + +// miscellaneous functions +function lua_error(L: Plua_State): Integer; cdecl; + +function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; + +procedure lua_concat(L: Plua_State; n: Integer); cdecl; +procedure lua_len(L: Plua_State; idx: Integer); cdecl; + +function lua_stringtonumber(L: Plua_State; const s: PAnsiChar): size_t; cdecl; + +function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; +procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; + +// some useful macros +function lua_getextraspace(L: Plua_State): Pointer; inline; +function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; inline; +function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; inline; +procedure lua_pop(L: Plua_State; n: Integer); inline; +procedure lua_newtable(L: Plua_state); inline; +procedure lua_register(L: Plua_State; const n: PAnsiChar; f: lua_CFunction); inline; +procedure lua_pushcfunction(L: Plua_State; f: lua_CFunction); inline; +function lua_isfunction(L: Plua_State; n: Integer): Boolean; inline; +function lua_istable(L: Plua_State; n: Integer): Boolean; inline; +function lua_islightuserdata(L: Plua_State; n: Integer): Boolean; inline; +function lua_isnil(L: Plua_State; n: Integer): Boolean; inline; +function lua_isboolean(L: Plua_State; n: Integer): Boolean; inline; +function lua_isthread(L: Plua_State; n: Integer): Boolean; inline; +function lua_isnone(L: Plua_State; n: Integer): Boolean; inline; +function lua_isnoneornil(L: Plua_State; n: Integer): Boolean; inline; +procedure lua_pushliteral(L: Plua_State; s: PAnsiChar); inline; +procedure lua_pushglobaltable(L: Plua_State); inline; +function lua_tostring(L: Plua_State; i: Integer): PAnsiChar; inline; + +// Debug API +const + // Event codes + LUA_HOOKCALL = 0; + LUA_HOOKRET = 1; + LUA_HOOKLINE = 2; + LUA_HOOKCOUNT = 3; + LUA_HOOKTAILCALL = 4; + + // Event masks + LUA_MASKCALL = 1 shl Ord(LUA_HOOKCALL); + LUA_MASKRET = 1 shl Ord(LUA_HOOKRET); + LUA_MASKLINE = 1 shl Ord(LUA_HOOKLINE); + LUA_MASKCOUNT = 1 shl Ord(LUA_HOOKCOUNT); + + LUA_IDSIZE = 60; + +type + lua_Debug = packed record (* activation record *) + event: Integer; + name: PAnsiChar; (* (n) *) + namewhat: PAnsiChar; (* (n) `global', `local', `field', `method' *) + what: PAnsiChar; (* (S) `Lua', `C', `main', `tail'*) + source: PAnsiChar; (* (S) *) + currentline: Integer; (* (l) *) + linedefined: Integer; (* (S) *) + lastlinedefined: Integer; (* (S) *) + nups: Byte; (* (u) number of upvalues *) + nparams: Byte; (* (u) number of parameters *) + isvararg: ByteBool; (* (u) *) + istailcall: ByteBool; (* (t) *) + short_src: packed array[0..LUA_IDSIZE - 1] of AnsiChar; (* (S) *) + (* private part *) + i_ci: Pointer; (* active function *) // ptr to struct CallInfo + end; + Plua_Debug = ^lua_Debug; + + // Functions to be called by the debugger in specific events + lua_Hook = procedure(L: Plua_State; ar: Plua_Debug); cdecl; + +function lua_getstack(L: Plua_State; level: Integer; ar: Plua_Debug): Integer; cdecl; +function lua_getinfo(L: Plua_State; const what: PAnsiChar; ar: Plua_Debug): Integer; cdecl; +function lua_getlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; +function lua_setlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; +function lua_getupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; +function lua_setupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; +function lua_upvalueid(L: Plua_State; funcindex, n: Integer): Pointer; cdecl; +procedure lua_upvaluejoin(L: Plua_State; funcindex1, n1, funcindex2, n2: Integer); cdecl; +procedure lua_sethook(L: Plua_State; func: lua_Hook; mask: Integer; count: Integer); cdecl; +function lua_gethook(L: Plua_State): lua_Hook; cdecl; +function lua_gethookmask(L: Plua_State): Integer; cdecl; +function lua_gethookcount(L: Plua_State): Integer; cdecl; + +// pre-defined references +const + LUA_NOREF = -2; + LUA_REFNIL = -1; + + LUAL_NUMSIZES = sizeof(lua_Integer)*16 + sizeof(lua_Number); + +type + luaL_Reg = packed record + name: PAnsiChar; + func: lua_CFunction; + end; + PluaL_Reg = ^luaL_Reg; + +procedure luaL_checkversion_(L: Plua_State; ver: lua_Number; sz: size_t); cdecl; +procedure luaL_checkversion(L: Plua_State); inline; +function luaL_getmetafield(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; +function luaL_callmeta(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; +function luaL_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; +function luaL_argerror(L: Plua_State; arg: Integer; const extramsg: PAnsiChar): Integer; cdecl; +function luaL_checklstring(L: Plua_State; arg: Integer; l_: Psize_t): PAnsiChar; cdecl; +function luaL_optlstring(L: Plua_State; arg: Integer; const def: PAnsiChar; l_: Psize_t): PAnsiChar; cdecl; +function luaL_checknumber(L: Plua_State; arg: Integer): lua_Number; cdecl; +function luaL_optnumber(L: Plua_State; arg: Integer; def: lua_Number): lua_Number; cdecl; +function luaL_checkinteger(L: Plua_State; arg: Integer): lua_Integer; cdecl; +function luaL_optinteger(L: Plua_State; arg: Integer; def: lua_Integer): lua_Integer; cdecl; +procedure luaL_checkstack(L: Plua_State; sz: Integer; const msg: PAnsiChar); cdecl; +procedure luaL_checktype(L: Plua_State; arg, t: Integer); cdecl; +procedure luaL_checkany(L: Plua_State; arg: Integer); cdecl; +function luaL_newmetatable(L: Plua_State; const tname: PAnsiChar): Integer; cdecl; +procedure luaL_setmetatable(L: Plua_State; const tname: PAnsiChar); cdecl; +function luaL_testudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; +function luaL_checkudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; +procedure luaL_where(L: Plua_State; lvl: Integer); cdecl; +function luaL_error(L: Plua_State; const fmt: PAnsiChar): Integer; cdecl; varargs; +function luaL_checkoption(L: Plua_State; arg: Integer; def: PAnsiChar; lst: PPAnsiChar): Integer; cdecl; +function luaL_fileresult(L: Plua_State; stat: Integer; const fname: PAnsiChar): Integer; cdecl; +function luaL_execresult(L: Plua_State; stat: Integer): Integer; cdecl; +function luaL_ref(L: Plua_State; t: Integer): Integer; cdecl; +procedure luaL_unref(L: Plua_State; t, ref: Integer); cdecl; +function luaL_loadfilex(L: Plua_State; const filename, mode: PAnsiChar): Integer; cdecl; +function luaL_loadfile(L: Plua_State; const filename: PAnsiChar): Integer; inline; +function luaL_loadbufferx(L: Plua_State; const buff: PAnsiChar; sz: size_t; const name, mode: PAnsiChar): Integer; cdecl; +function luaL_loadstring(L: Plua_State; const s: PAnsiChar): Integer; cdecl; +function luaL_newstate: Plua_State; cdecl; +function luaL_len(L: Plua_State; idx: Integer): lua_Integer; cdecl; +function luaL_gsub(L: Plua_State; const s, p, r: PAnsiChar): PAnsiChar; cdecl; +procedure luaL_setfuncs(L: Plua_State; lr: array of luaL_Reg; nup: Integer); inline; overload; +procedure luaL_setfuncs(L: Plua_State; lr: PluaL_Reg; nup: Integer); cdecl; overload; +function luaL_getsubtable(L: Plua_State; idx: Integer; const fname: PAnsiChar): Integer; cdecl; +procedure luaL_traceback(L, L1: Plua_State; msg: PAnsiChar; level: Integer); cdecl; +procedure luaL_requiref(L: Plua_State; const modname: PAnsiChar; openf: lua_CFunction; glb: LongBool); cdecl; + +// some useful macros +procedure luaL_newlibtable(L: Plua_State; lr: array of luaL_Reg); inline; overload; +procedure luaL_newlibtable(L: Plua_State; lr: PluaL_Reg); inline; overload; +procedure luaL_newlib(L: Plua_State; lr: array of luaL_Reg); inline; overload; +procedure luaL_newlib(L: Plua_State; lr: PluaL_Reg); inline; overload; +procedure luaL_argcheck(L: Plua_State; cond: Boolean; arg: Integer; extramsg: PAnsiChar); inline; +function luaL_checkstring(L: Plua_State; n: Integer): PAnsiChar; inline; +function luaL_optstring(L: Plua_State; n: Integer; d: PAnsiChar): PAnsiChar; inline; +function luaL_typename(L: Plua_State; i: Integer): PAnsiChar; inline; +function luaL_dofile(L: Plua_State; const filename: PAnsiChar): Integer; inline; +function luaL_dostring(L: Plua_State; const str: PAnsiChar): Integer; inline; +procedure luaL_getmetatable(L: Plua_State; tname: PAnsiChar); inline; +function luaL_loadbuffer(L: Plua_State; const buff: PAnsiChar; size: size_t; const name: PAnsiChar): Integer; inline; + +const + LUA_COLIBNAME = 'coroutine'; + LUA_TABLIBNAME = 'table'; + LUA_IOLIBNAME = 'io'; + LUA_OSLIBNAME = 'os'; + LUA_STRLIBNAME = 'string'; + LUA_UTF8LIBNAME = 'utf8'; + LUA_BITLIBNAME = 'bit32'; + LUA_MATHLIBNAME = 'math'; + LUA_DBLIBNAME = 'debug'; + LUA_LOADLIBNAME = 'package'; + +function luaopen_base(L: Plua_State): Integer; cdecl; +function luaopen_coroutine(L: Plua_State): Integer; cdecl; +function luaopen_table(L: Plua_State): Integer; cdecl; +function luaopen_io(L: Plua_State): Integer; cdecl; +function luaopen_os(L: Plua_State): Integer; cdecl; +function luaopen_string(L: Plua_State): Integer; cdecl; +function luaopen_utf8(L: Plua_State): Integer; cdecl; +function luaopen_bit32(L: Plua_State): Integer; cdecl; +function luaopen_math(L: Plua_State): Integer; cdecl; +function luaopen_debug(L: Plua_State): Integer; cdecl; +function luaopen_package(L: Plua_State): Integer; cdecl; + +// open all previous libraries +procedure luaL_openlibs(L: Plua_State); cdecl; + +implementation + +function lua_upvalueindex(I: Integer): Integer; +begin + Result := LUA_REGISTRYINDEX - i; +end; + +function lua_newstate(f: lua_Alloc; ud: Pointer): Plua_State; cdecl; external LUA_LIB_NAME; +procedure lua_close(L: Plua_State); cdecl; external LUA_LIB_NAME; +function lua_newthread(L: Plua_State): Plua_State; cdecl; external LUA_LIB_NAME; +function lua_atpanic(L: Plua_State; panicf: lua_CFunction): lua_CFunction; cdecl; external LUA_LIB_NAME; +function lua_version(L: Plua_State): Plua_Number; cdecl; external LUA_LIB_NAME; +function lua_absindex(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_gettop(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +procedure lua_settop(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_pushvalue(L: Plua_State; Idx: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_rotate(L: Plua_State; idx, n: Integer); cdecl; external LUA_LIB_NAME; + +procedure lua_remove(L: Plua_State; idx: Integer); +begin + lua_rotate(L, idx, -1); + lua_pop(L, 1); +end; + +procedure lua_insert(L: Plua_State; idx: Integer); +begin + lua_rotate(L, idx, 1); +end; + +procedure lua_replace(L: Plua_State; idx: Integer); +begin + lua_copy(L, -1, idx); + lua_pop(L, 1); +end; + +procedure lua_copy(L: Plua_State; fromidx, toidx: Integer); cdecl; external LUA_LIB_NAME; +function lua_checkstack(L: Plua_State; n: Integer): LongBool; cdecl; external LUA_LIB_NAME; +procedure lua_xmove(from, to_: Plua_State; n: Integer); cdecl; external LUA_LIB_NAME; +function lua_isnumber(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_isstring(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_iscfunction(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_isinteger(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_isuserdata(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_type(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_typename(L: Plua_State; tp: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_tonumberx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Number; cdecl; external LUA_LIB_NAME; +function lua_tointegerx(L: Plua_State; idx: Integer; isnum: PLongBool): lua_Integer; cdecl; external LUA_LIB_NAME; +procedure lua_arith(L: Plua_State; op: Integer); cdecl; external LUA_LIB_NAME; +function lua_rawequal(L: Plua_State; idx1, idx2: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_compare(L: Plua_State; idx1, idx2, op: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_toboolean(L: Plua_State; idx: Integer): LongBool; cdecl; external LUA_LIB_NAME; +function lua_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_rawlen(L: Plua_State; idx: Integer): size_t; cdecl; external LUA_LIB_NAME; +function lua_tocfunction(L: Plua_State; idx: Integer): lua_CFunction; cdecl; external LUA_LIB_NAME; +function lua_touserdata(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_LIB_NAME; +function lua_tothread(L: Plua_State; idx: Integer): Plua_State; cdecl; external LUA_LIB_NAME; +function lua_topointer(L: Plua_State; idx: Integer): Pointer; cdecl; external LUA_LIB_NAME; +procedure lua_pushnil(L: Plua_State); cdecl; external LUA_LIB_NAME; +procedure lua_pushnumber(L: Plua_State; n: lua_Number); cdecl; external LUA_LIB_NAME; +procedure lua_pushinteger(L: Plua_State; n: lua_Integer); cdecl; external LUA_LIB_NAME; +procedure lua_pushlstring(L: Plua_State; const s: PAnsiChar; len: size_t); cdecl; external LUA_LIB_NAME; +procedure lua_pushstring(L: Plua_State; const s: PAnsiChar); cdecl; external LUA_LIB_NAME; + +procedure lua_pushstring(L: Plua_State; const s: AnsiString); +begin + lua_pushlstring(L, PAnsiChar(s), Length(s)); +end; + +function lua_pushvfstring(L: Plua_State; const fmt: PAnsiChar; argp: Pointer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_pushfstring(L: Plua_State; const fmt: PAnsiChar): PAnsiChar; cdecl; varargs; external LUA_LIB_NAME; +procedure lua_pushcclosure(L: Plua_State; fn: lua_CFunction; n: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_pushboolean(L: Plua_State; b: LongBool); cdecl; external LUA_LIB_NAME; +procedure lua_pushlightuserdata(L: Plua_State; p: Pointer); cdecl; external LUA_LIB_NAME; +procedure lua_pushthread(L: Plua_State); cdecl; external LUA_LIB_NAME; +function lua_getglobal(L: Plua_State; const name: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function lua_gettable(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_getfield(L: Plua_state; idx: Integer; k: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function lua_geti(L: Plua_State; idx: Integer; n: lua_Integer): Integer cdecl; external LUA_LIB_NAME; +function lua_rawget(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_rawgeti(L: Plua_State; idx, n: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_rawgetp(L: Plua_State; idx: Integer; p: Pointer): Integer; cdecl; external LUA_LIB_NAME; +procedure lua_createtable(L: Plua_State; narr, nrec: Integer); cdecl; external LUA_LIB_NAME; +function lua_newuserdata(L: Plua_State; sz: size_t): Pointer; cdecl; external LUA_LIB_NAME; +function lua_getmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_getuservalue(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +procedure lua_setglobal(L: Plua_State; const name: PAnsiChar); cdecl; external LUA_LIB_NAME; +procedure lua_settable(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_setfield(L: Plua_State; idx: Integer; k: PAnsiChar); cdecl; external LUA_LIB_NAME; +procedure lua_seti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; external LUA_LIB_NAME; +procedure lua_rawset(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_rawseti(L: Plua_State; idx: Integer; n: lua_Integer); cdecl; external LUA_LIB_NAME; +procedure lua_rawsetp(L: Plua_State; idx: Integer; p: Pointer); cdecl; external LUA_LIB_NAME; +function lua_setmetatable(L: Plua_State; objindex: Integer): Integer; cdecl; external LUA_LIB_NAME; +procedure lua_setuservalue(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_callk(L: Plua_State; nargs, nresults: Integer; ctx: lua_KContext; k: lua_KFunction); cdecl; external LUA_LIB_NAME; +function lua_pcallk(L: Plua_State; nargs, nresults, errfunc: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; external LUA_LIB_NAME; +function lua_load(L: Plua_State; reader: lua_Reader; dt: Pointer; const chunkname, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function lua_dump(L: Plua_State; writer: lua_Writer; data: Pointer; strip: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_yieldk(L: Plua_State; nresults: Integer; ctx: lua_KContext; k: lua_KFunction): Integer; cdecl; external LUA_LIB_NAME; + +procedure lua_call(L: Plua_State; nargs, nresults: Integer); +begin + lua_callk(L, nargs, nresults, nil, nil); +end; + +function lua_pcall(L: Plua_State; nargs, nresults, errf: Integer): Integer; +begin + Result := lua_pcallk(L, nargs, nresults, errf, nil, nil); +end; + +function lua_yield(L: Plua_State; nresults: Integer): Integer; +begin + Result := lua_yieldk(L, nresults, nil, nil); +end; + +function lua_resume(L, from: Plua_State; narg: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_status(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function lua_isyieldable(L: Plua_State): LongBool; cdecl; external LUA_LIB_NAME; +function lua_gc(L: Plua_State; what, data: Integer): Integer; cdecl; external LUA_LIB_NAME; +function lua_error(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function lua_next(L: Plua_State; idx: Integer): Integer; cdecl; external LUA_LIB_NAME; +procedure lua_concat(L: Plua_State; n: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_len(L: Plua_State; idx: Integer); cdecl; external LUA_LIB_NAME; +function lua_stringtonumber(L: Plua_State; const s: PAnsiChar): size_t; cdecl; external LUA_LIB_NAME; +function lua_getallocf(L: Plua_State; ud: PPointer): lua_Alloc; cdecl; external LUA_LIB_NAME; +procedure lua_setallocf(L: Plua_State; f: lua_Alloc; ud: Pointer); cdecl; external LUA_LIB_NAME; + +function lua_getextraspace(L: Plua_State): Pointer; +const + LUA_EXTRASPACE = sizeof(Pointer); +begin + Result := L - LUA_EXTRASPACE; +end; + +function lua_tonumber(L: Plua_State; idx: Integer): lua_Number; +begin + Result := lua_tonumberx(L, idx, nil); +end; + +function lua_tointeger(L: Plua_State; idx: Integer): lua_Integer; +begin + Result := lua_tointegerx(L, idx, nil); +end; + +procedure lua_pop(L: Plua_State; n: Integer); +begin + lua_settop(L, - n - 1); +end; + +procedure lua_newtable(L: Plua_State); +begin + lua_createtable(L, 0, 0); +end; + +procedure lua_register(L: Plua_State; const n: PAnsiChar; f: lua_CFunction); +begin + lua_pushcfunction(L, f); + lua_setglobal(L, n); +end; + +procedure lua_pushcfunction(L: Plua_State; f: lua_CFunction); +begin + lua_pushcclosure(L, f, 0); +end; + +function lua_isfunction(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TFUNCTION; +end; + +function lua_istable(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TTABLE; +end; + +function lua_islightuserdata(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TLIGHTUSERDATA; +end; + +function lua_isnil(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TNIL; +end; + +function lua_isboolean(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TBOOLEAN; +end; + +function lua_isthread(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TTHREAD; +end; + +function lua_isnone(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) = LUA_TNONE; +end; + +function lua_isnoneornil(L: Plua_State; n: Integer): Boolean; +begin + Result := lua_type(L, n) <= 0; +end; + +procedure lua_pushliteral(L: Plua_State; s: PAnsiChar); +begin + lua_pushlstring(L, s, Length(s)); +end; + +procedure lua_pushglobaltable(L: Plua_State); +begin + lua_rawgeti(L, LUA_REGISTRYINDEX, LUA_RIDX_GLOBALS); +end; + +function lua_tostring(L: Plua_State; i: Integer): PAnsiChar; +begin + Result := lua_tolstring(L, i, nil); +end; + +function lua_getstack(L: Plua_State; level: Integer; ar: Plua_Debug): Integer; cdecl; external LUA_LIB_NAME; +function lua_getinfo(L: Plua_State; const what: PAnsiChar; ar: Plua_Debug): Integer; cdecl; external LUA_LIB_NAME; +function lua_getlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_setlocal(L: Plua_State; const ar: Plua_Debug; n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_getupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_setupvalue(L: Plua_State; funcindex, n: Integer): PAnsiChar; cdecl; external LUA_LIB_NAME; +function lua_upvalueid(L: Plua_State; funcindex, n: Integer): Pointer; cdecl; external LUA_LIB_NAME; +procedure lua_upvaluejoin(L: Plua_State; funcindex1, n1, funcindex2, n2: Integer); cdecl; external LUA_LIB_NAME; +procedure lua_sethook(L: Plua_State; func: lua_Hook; mask: Integer; count: Integer); cdecl; external LUA_LIB_NAME; +function lua_gethook(L: Plua_State): lua_Hook; cdecl; external LUA_LIB_NAME; +function lua_gethookmask(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function lua_gethookcount(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; + +procedure luaL_checkversion_(L: Plua_State; ver: lua_Number; sz: size_t); cdecl; external LUA_LIB_NAME; + +procedure luaL_checkversion(L: Plua_State); +begin + luaL_checkversion_(L, LUA_VERSION_NUM, LUAL_NUMSIZES); +end; + +procedure luaL_traceback(L, L1: Plua_State; msg: PAnsiChar; level: Integer); cdecl; external LUA_LIB_NAME; +function luaL_argerror(L: Plua_State; arg: Integer; const extramsg: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +procedure luaL_where(L: Plua_State; lvl: Integer); cdecl; external LUA_LIB_NAME; +function luaL_newmetatable(L: Plua_State; const tname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +procedure luaL_setmetatable(L: Plua_State; const tname: PAnsiChar); cdecl; external LUA_LIB_NAME; +function luaL_testudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; external LUA_LIB_NAME; +function luaL_checkudata(L: Plua_State; ud: Integer; const tname: PAnsiChar): Pointer; cdecl; external LUA_LIB_NAME; +function luaL_error(L: Plua_State; const fmt: PAnsiChar): Integer; cdecl; varargs; external LUA_LIB_NAME; +function luaL_checkoption(L: Plua_State; arg: Integer; def: PAnsiChar; lst: PPAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +procedure luaL_checkstack(L: Plua_State; sz: Integer; const msg: PAnsiChar); cdecl; external LUA_LIB_NAME; +procedure luaL_checktype(L: Plua_State; arg, t: Integer); cdecl; external LUA_LIB_NAME; +procedure luaL_checkany(L: Plua_State; arg: Integer); cdecl; external LUA_LIB_NAME; +function luaL_checklstring(L: Plua_State; arg: Integer; l_: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; +function luaL_optlstring(L: Plua_State; arg: Integer; const def: PAnsiChar; l_: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; +function luaL_checknumber(L: Plua_State; arg: Integer): lua_Number; cdecl; external LUA_LIB_NAME; +function luaL_optnumber(L: Plua_State; arg: Integer; def: lua_Number): lua_Number; cdecl; external LUA_LIB_NAME; +function luaL_checkinteger(L: Plua_State; arg: Integer): lua_Integer; cdecl; external LUA_LIB_NAME; +function luaL_optinteger(L: Plua_State; arg: Integer; def: lua_Integer): lua_Integer; cdecl; external LUA_LIB_NAME; + +procedure luaL_argcheck(L: Plua_State; cond: Boolean; arg: Integer; extramsg: PAnsiChar); +begin + if not cond then + luaL_argerror(L, arg, extramsg); +end; + +function luaL_checkstring(L: Plua_State; n: Integer): PAnsiChar; +begin + Result := luaL_checklstring(L, n, nil); +end; + +function luaL_optstring(L: Plua_State; n: Integer; d: PAnsiChar): PAnsiChar; +begin + Result := luaL_optlstring(L, n, d, nil); +end; + +function luaL_typename(L: Plua_State; i: Integer): PAnsiChar; +begin + Result := lua_typename(L, lua_type(L, i)); +end; + +function luaL_dofile(L: Plua_State; const filename: PAnsiChar): Integer; +begin + Result := luaL_loadfile(L, filename); + if Result = 0 then + Result := lua_pcall(L, 0, LUA_MULTRET, 0); +end; + +function luaL_dostring(L: Plua_State; const str: PAnsiChar): Integer; +begin + Result := luaL_loadstring(L, str); + if Result = 0 then + Result := lua_pcall(L, 0, LUA_MULTRET, 0); +end; + +procedure luaL_getmetatable(L: Plua_State; tname: PAnsiChar); +begin + lua_getfield(L, LUA_REGISTRYINDEX, tname); +end; + +function luaL_fileresult(L: Plua_State; stat: Integer; const fname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_execresult(L: Plua_State; stat: Integer): Integer; cdecl; external LUA_LIB_NAME; +function luaL_ref(L: Plua_State; t: Integer): Integer; cdecl; external LUA_LIB_NAME; +procedure luaL_unref(L: Plua_State; t, ref: Integer); cdecl; external LUA_LIB_NAME; +function luaL_loadfilex(L: Plua_State; const filename, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_loadbufferx(L: Plua_State; const buff: PAnsiChar; sz: size_t; const name, mode: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; + +function luaL_loadfile(L: Plua_State; const filename: PAnsiChar): Integer; +begin + Result := luaL_loadfilex(L, filename, nil); +end; + +function luaL_loadbuffer(L: Plua_State; const buff: PAnsiChar; size: size_t; const name: PAnsiChar): Integer; +begin + Result := luaL_loadbufferx(L, buff, size, name, nil); +end; + +function luaL_loadstring(L: Plua_State; const s: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_getmetafield(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_callmeta(L: Plua_State; obj: Integer; const e: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_tolstring(L: Plua_State; idx: Integer; len: Psize_t): PAnsiChar; cdecl; external LUA_LIB_NAME; +procedure luaL_requiref(L: Plua_State; const modname: PAnsiChar; openf: lua_CFunction; glb: LongBool); cdecl; external LUA_LIB_NAME; +procedure luaL_setfuncs(L: Plua_State; lr: PluaL_Reg; nup: Integer); cdecl; external LUA_LIB_NAME; + +procedure luaL_setfuncs(L: Plua_State; lr: array of luaL_Reg; nup: Integer); +begin + luaL_setfuncs(L, @lr, nup); +end; + +procedure luaL_newlibtable(L: Plua_State; lr: array of luaL_Reg); +begin + lua_createtable(L, 0, High(lr)); +end; + +procedure luaL_newlibtable(L: Plua_State; lr: PluaL_Reg); +var + n: Integer; +begin + n := 0; + while lr^.name <> nil do begin + inc(n); + inc(lr); + end; + lua_createtable(L, 0, n); +end; + +procedure luaL_newlib(L: Plua_State; lr: array of luaL_Reg); +begin + luaL_checkversion(L); + luaL_newlibtable(L, lr); + luaL_setfuncs(L, @lr, 0); +end; + +procedure luaL_newlib(L: Plua_State; lr: PluaL_Reg); +begin + luaL_checkversion(L); + luaL_newlibtable(L, lr); + luaL_setfuncs(L, lr, 0); +end; + +function luaL_gsub(L: Plua_State; const s, p, r: PAnsiChar): PAnsiChar; cdecl; external LUA_LIB_NAME; +function luaL_getsubtable(L: Plua_State; idx: Integer; const fname: PAnsiChar): Integer; cdecl; external LUA_LIB_NAME; +function luaL_newstate: Plua_State; cdecl; external LUA_LIB_NAME; +function luaL_len(L: Plua_State; idx: Integer): lua_Integer; cdecl; external LUA_LIB_NAME; + +function luaopen_base(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_coroutine(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_table(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_io(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_os(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_string(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_utf8(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_bit32(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_math(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_debug(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +function luaopen_package(L: Plua_State): Integer; cdecl; external LUA_LIB_NAME; +procedure luaL_openlibs(L: Plua_State); cdecl; external LUA_LIB_NAME; + +initialization +{$IFDEF MSWINDOWS} + Set8087CW($133F); // disable all floating-point exceptions +{$ENDIF} + +(****************************************************************************** +* Copyright (C) 1994-2015 Lua.org, PUC-Rio. +* +* Permission is hereby granted, free of charge, to any person obtaining +* a copy of this software and associated documentation files (the +* "Software"), to deal in the Software without restriction, including +* without limitation the rights to use, copy, modify, merge, publish, +* distribute, sublicense, and/or sell copies of the Software, and to +* permit persons to whom the Software is furnished to do so, subject to +* the following conditions: +* +* The above copyright notice and this permission notice shall be +* included in all copies or substantial portions of the Software. +* +* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +******************************************************************************) + +end. diff --git a/baseunits/modules/AcademyVN.pas b/baseunits/modules/AcademyVN.pas new file mode 100644 index 000000000..61b80afb6 --- /dev/null +++ b/baseunits/modules/AcademyVN.pas @@ -0,0 +1,134 @@ +unit AcademyVN; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/manga/all'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + page := StrToIntDef(XPathString('(//*[starts-with(@class,"pagination")]//a)[last()-1]'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then s += '?page=' + IncStr(AURL); + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//table[1]/tbody/tr/td[1]/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//*[@class="__image"]/img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//*[@class="__info"]/h3'); + authors := SeparateRight(XPathString('//*[@class="__info"]/p[starts-with(.,"Tác giả:")]'), ':'); + genres := SeparateRight(XPathString('//*[@class="__info"]/p[starts-with(.,"Thể loại:")]'), ':'); + s := XPathString('//*[@class="__info"]/p[starts-with(.,"Tình trạng:")]'); + if s <> '' then begin + if (Pos('Đang tiến hành', s) > 0) or (Pos('Ngưng', s) > 0) then status := '1' + else status := '0'; + end; + summary := XPathString('//*[@class="__info"]/*[@class="__description"]'); + for v in XPath('//*[@class="table-scroll"]/table/tbody/tr/td[1]/a') do begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(v.toString); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//*[@class="manga-container"]/img/@src') do + PageLinks.Add(v.toString); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'AcademyVN'; + RootURL := 'http://hocvientruyentranh.com'; + Category := 'Vietnamese'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/BlogTruyen.pas b/baseunits/modules/BlogTruyen.pas new file mode 100644 index 000000000..cba47931d --- /dev/null +++ b/baseunits/modules/BlogTruyen.pas @@ -0,0 +1,144 @@ +unit BlogTruyen; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML; + +implementation + +uses RegExpr, synacode; + +const + dirurl = '/ajax/Search/AjaxLoadListManga?key=tatca&orderBy=1&p='; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; var Page: Integer; const WorkPtr: Integer; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.XHR(Module.RootURL + dirurl + '1') then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('//*[@class="paging"]/span[last()]/a/@href/substring-before(substring-after(.,"("),")")'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.XHR(Module.RootURL + dirurl + IncStr(AURL)) then + begin + Result := NO_ERROR; + XPathHREFAll('//*[@class="list"]//span/a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do try + coverLink := XPathString('//*[@class="thumbnail"]/img/@src'); + if title = '' then title := XPathString('//title/substring-before(.," | BlogTruyen")'); + authors := XPathString('//*[@class="description"]/p[starts-with(.,"Tác giả")]/string-join(.//a,", ")'); + genres := XPathString('//*[@class="description"]/p[starts-with(.,"Thể loại")]/string-join(.//a,", ")'); + summary := XPathString('//*[@class="detail"]/*[@class="content"]'); + XPathHREFAll('//*[@id="list-chapters"]//span[@class="title"]/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + i: Integer; + image: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + XPathStringAll('//article[@id="content"]/img[not(contains(@src,"credit"))]/@src', Document, PageLinks); + // http://blogtruyen.com/scripts/image-url-filter.js?ver=1 + with TRegExpr.Create do try + ModifierI := True; + for i := 0 to PageLinks.Count - 1 do + begin + image := PageLinks[i]; + image := DecodeURL(image); + Expression := '^.+(&|\?)url='; + image := Replace(image, '', True); + Expression := '(https?:\/\/)lh(\d)(\.bp\.blogspot\.com)'; + image := Replace(image, '$1$2$3', True); + Expression := '(https?:\/\/)lh\d\.(googleusercontent|ggpht)\.com'; + image := Replace(image, '$1\4.bp.blogspot.com', True); + Expression := '\?.+$'; + image := Replace(image, '', False); + if Pos('blogspot.com', image) <> 0 then begin + Expression := '\/([^\/]+\-)?(Ic42)(\-[^\/]+)?\/'; + image := Replace(image, '/$2/', True); + Expression := '\/(((s|w|h)\d+|(w|h)\d+\-(w|h)\d+))?\-?(c|d|g)?\/([^\/]+$)'; + image := Replace(image, '/$1', True); + image += '?imgmax=0'; + end; + if Pos('i.imgur.com', image) <> 0 then begin + Expression := '(\/)(\w{5}|\w{7})(s|b|t|m|l|h)(\.(jpe?g|png|gif))$'; + image := Replace(image, '$1$2$4', True); + end; + if (Pos('i.imgur.com', image) <> 0) or (Pos('manga.truyentranh8.', image) <> 0) then begin + image := 'http://images-focus-opensocial.googleusercontent.com/gadgets/proxy?container=focus&url=' + image; + end; + image := image.Replace('https://', 'http://'); + PageLinks[i] := image; + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'BlogTruyen'; + RootURL := 'http://blogtruyen.com'; + Category := 'Vietnamese'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Cloudflare.pas b/baseunits/modules/Cloudflare.pas new file mode 100644 index 000000000..2255ff358 --- /dev/null +++ b/baseunits/modules/Cloudflare.pas @@ -0,0 +1,227 @@ +unit Cloudflare; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, uBaseUnit, XQueryEngineHTML, httpsendthread, synautil, + JSUtils, RegExpr, dateutils; + +type + + { TCFProps } + + TCFProps = class + public + cf_clearance: string; + Expires: TDateTime; + CS: TRTLCriticalSection; + constructor Create; + destructor Destroy; override; + procedure Reset; + procedure AddCookiesTo(const ACookies: TStringList); + end; + +function CFRequest(const AHTTP: THTTPSendThread; const Method, AURL: String; const Response: TObject; const CFProps: TCFProps): Boolean; + +implementation + +const + MIN_WAIT_TIME = 4000; + +function AntiBotActive(const AHTTP: THTTPSendThread): Boolean; +var + s: String; +begin + Result := False; + if AHTTP = nil then Exit; + if AHTTP.ResultCode < 500 then Exit; + if Pos('text/html', AHTTP.Headers.Values['Content-Type']) = 0 then Exit; + s := StreamToString(AHTTP.Document); + Result := Pos('name="jschl_vc"',s) <> 0; + s := ''; +end; + +function JSGetAnsweredURL(const Source, URL: String; var OMethod, OURL: String; + var OSleepTime: Integer): Boolean; +var + s, meth, surl, jschl_vc, pass, jschl_answer: String; +begin + Result := False; + if (Source = '') or (URL = '') then Exit; + + meth := ''; + surl := ''; + jschl_vc := ''; + pass := ''; + jschl_answer := ''; + + with TXQueryEngineHTML.Create(Source) do + try + meth := UpperCase(XPathString('//form[@id="challenge-form"]/@method')); + surl := XPathString('//form[@id="challenge-form"]/@action'); + jschl_vc := XPathString('//input[@name="jschl_vc"]/@value'); + pass := XPathString('//input[@name="pass"]/@value'); + finally + Free; + end; + + if (meth = '') or (surl = '') or (jschl_vc = '') or (pass = '') then Exit; + + s := Source; + with TRegExpr.Create do + try + ModifierG := False; + ModifierI := True; + + Expression := 'setTimeout\(function\(\)\{\s*var.*\w,\s+(\S.+a\.value =[^;]+;)'; + Exec(s); + if SubExprMatchCount > 0 then + begin + s := Match[1]; + Expression := '\s{3,}[a-z](\s*=\s*document\.|\.).+;\r?\n'; + s := Replace(s, '', False); + Expression := 't\s=\s*t\.firstChild.href;'; + s := Replace(s, ' t = "' + URL + '";', False); + Expression := 'a\.value\s*='; + s := Replace(s, 'a =', False); + Expression := '^.*\.submit\(.*\},\s*(\d{4,})\).*$'; + OSleepTime := StrToIntDef(Replace(Source, '$1', True), MIN_WAIT_TIME); + jschl_answer := ExecJS(s); + end; + finally + Free; + end; + + if jschl_answer = '' then Exit; + OMethod := meth; + OURL := surl + '?jschl_vc=' + jschl_vc + '&pass=' + pass + '&jschl_answer=' + jschl_answer; + Result := True; +end; + +function CFJS(const AHTTP: THTTPSendThread; AURL: String; var Acf_clearance: String; var AExpires: TDateTime): Boolean; +var + m, u, h: String; + st, sc, counter, maxretry: Integer; +begin + Result := False; + if AHTTP = nil then Exit; + counter := 0; + maxretry := AHTTP.RetryCount; + AHTTP.RetryCount := 0; + while True do + begin + Inc(counter); + m := 'GET'; + u := ''; + h := AppendURLDelim(GetHostURL(AURL)); + st := MIN_WAIT_TIME; + if JSGetAnsweredURL(StreamToString(AHTTP.Document), h, m, u, st) then + if (m <> '') and (u <> '') then + begin + AHTTP.Reset; + AHTTP.Headers.Values['Referer'] := ' ' + AURL; + if st < MIN_WAIT_TIME then st := MIN_WAIT_TIME; + sc := 0; + while sc < st do begin + if AHTTP.ThreadTerminated then Break; + Inc(sc, 250); + Sleep(250); + end; + AHTTP.FollowRedirection := False; + if AHTTP.HTTPRequest(m, FillHost(h, u)) then + begin + Acf_clearance := AHTTP.Cookies.Values['cf_clearance']; + Result := Acf_clearance <> ''; + if Result then + AExpires := AHTTP.CookiesExpires; + end; + AHTTP.FollowRedirection := True; + end; + if AHTTP.RetryCount <> 0 then + begin + maxretry := AHTTP.RetryCount; + AHTTP.RetryCount := 0; + end; + if Result then Break; + if AHTTP.ThreadTerminated then Break; + if (maxretry > -1) and (maxretry <= counter) then Break; + AHTTP.Reset; + AHTTP.HTTPRequest('GET', AURL); + end; + AHTTP.RetryCount := maxretry; +end; + +function CFRequest(const AHTTP: THTTPSendThread; const Method, AURL: String; const Response: TObject; const CFProps: TCFProps): Boolean; +begin + Result := False; + if AHTTP = nil then Exit; + if (CFProps.Expires <> 0.0) and (Now > CFProps.Expires) then + CFProps.Reset; + CFProps.AddCookiesTo(AHTTP.Cookies); + AHTTP.AllowServerErrorResponse := True; + Result := AHTTP.HTTPRequest(Method, AURL); + if AntiBotActive(AHTTP) then begin + if TryEnterCriticalsection(CFProps.CS) > 0 then + try + CFProps.Reset; + //AHTTP.Cookies.Clear; + Result := CFJS(AHTTP, AURL, CFProps.cf_clearance, CFProps.Expires); + // reduce the expires by 5 minutes, usually it is 24 hours or 16 hours + // in case of the different between local and server time + if Result then + CFProps.Expires := IncMinute(CFProps.Expires, -5); + finally + LeaveCriticalsection(CFProps.CS); + end + else + try + EnterCriticalsection(CFProps.CS); + CFProps.AddCookiesTo(AHTTP.Cookies); + finally + LeaveCriticalsection(CFProps.CS); + end; + if not AHTTP.ThreadTerminated then + Result := AHTTP.HTTPRequest(Method, AURL); + end; + if Assigned(Response) then + if Response is TStringList then + TStringList(Response).LoadFromStream(AHTTP.Document) + else + if Response is TStream then + AHTTP.Document.SaveToStream(TStream(Response)); +end; + +{ TCFProps } + +constructor TCFProps.Create; +begin + InitCriticalSection(CS); + Reset; +end; + +destructor TCFProps.Destroy; +begin + DoneCriticalsection(CS); + inherited Destroy; +end; + +procedure TCFProps.Reset; +begin + if TryEnterCriticalsection(CS) <> 0 then + try + cf_clearance := ''; + Expires := 0.0; + finally + LeaveCriticalsection(CS); + end; +end; + +procedure TCFProps.AddCookiesTo(const ACookies: TStringList); +begin + if cf_clearance <> '' then + ACookies.Values['cf_clearance'] := cf_clearance; +end; + +end. diff --git a/baseunits/modules/Comico.pas b/baseunits/modules/Comico.pas new file mode 100644 index 000000000..1b9a02745 --- /dev/null +++ b/baseunits/modules/Comico.pas @@ -0,0 +1,170 @@ +unit Comico; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil,Dialogs; + +implementation + +const + apiUrl = 'http://www.comico.jp/api'; + getChaptersApiUrl = apiUrl + '/getArticleList.nhn'; + dirurl = '/official'; + dirpages: array[0..7] of String = ('mon', 'tue', 'wed', 'thu', 'fri', 'sat', 'sun', 'finish'); + +// Get Series Name +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl + '/' + dirpages[Module.CurrentDirectoryIndex]; + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[contains(@class, "resizeTitleList")]/li/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(XPathString('div/p[1]/text()', v)); + end; + finally + Free; + end; + end; +end; + +// Get Chapter List +function GetChapterPageNumber(const MangaInfo: TMangaInformation; var Page: Integer; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; + url: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if MangaInfo.FHTTP.GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('//*[@class="m-pager__item"]/a[last()-1]'), 1); + finally + Free; + end; + end; +end; + +// Get Series Info +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s: String; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//meta[@property="og:image"]/@content'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then begin + title := XPathString('//meta[@property="og:title"]/@content'); + title := Trim(SeparateLeft(title, '|')); + end; + status := XPathString('//div[contains(@class, "meta")]/p[1]'); + if status = '完結作品' then status := '0' + else status := '1'; + authors := XPathStringAll('//*[contains(@class, "author")]/a'); + summary := XPathString('//meta[@property="og:description"]/@content'); + genres := XPathStringAll('//div[contains(@class, "meta")]/p[2]/a'); + finally + Free; + end; + + s := RegExprGetMatch('titleNo\=\d+', url, 0); + Reset; + if POST(getChaptersApiUrl, s) then + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('json(*).result.list()') do begin + chapterLinks.Add(v.getProperty('articleDetailUrl').toString); + s := v.getProperty('freeFlg').toString; + if s = 'N' then s += ' [unavailable]' + else s := ''; + chapterName.Add(v.getProperty('subtitle').toString + s); + end; + finally + Free; + end; + Reset; + Headers.Values['Referer'] := ' ' + url; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + XPathStringAll('//img[contains(@class, "comic-image")]/@src', Document, PageLinks); + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do + if CurrentDownloadChapterPtr < ChapterLinks.Count then begin + DownloadThread.FHTTP.Headers.Values['Referer'] := + ' ' + FillHost(Module.RootURL, ChapterLinks[CurrentDownloadChapterPtr]); + Result := True; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Comico'; + RootURL := 'http://www.comico.jp'; + Category := 'Raw'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnBeforeDownloadImage := @BeforeDownloadImage; + TotalDirectory := Length(dirpages); + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/EHentai.pas b/baseunits/modules/EHentai.pas new file mode 100644 index 000000000..22009ee09 --- /dev/null +++ b/baseunits/modules/EHentai.pas @@ -0,0 +1,438 @@ +unit EHentai; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, synacode, + RegExpr, LazFileUtils; + +implementation + +const + dirURL = 'f_doujinshi=on&f_manga=on&f_western=on&f_apply=Apply+Filter'; + exhentaiurllogin = 'https://forums.e-hentai.org/index.php?act=Login&CODE=01'; + accname = 'ExHentai'; + +var + onlogin: Boolean = False; + locklogin: TRTLCriticalSection; + settingsimagesize: Integer = 0; + settingsimagesizestr: array [0..5] of string = ( + 'xr_a', + 'xr_780', + 'xr_980', + 'xr_1280', + 'xr_1600', + 'xr_2400'); + +resourcestring + RS_DownloadOriginalImage = 'Download original image(require ExHentai account)'; + RS_SettingsImageSize = 'Image size:'; + RS_SettingsImageSizeItems = + 'Auto' + LineEnding + + '780x' + LineEnding + + '980x' + LineEnding + + '1280x' + LineEnding + + '1600x' + LineEnding + + '2400x' + LineEnding + + 'Original'; + +function ExHentaiLogin(const AHTTP: THTTPSendThread; const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if AHTTP = nil then Exit; + if Module.Account.Enabled = False then Exit; + + if TryEnterCriticalsection(locklogin) > 0 then + with AHTTP do begin + onlogin := True; + Module.Account.Status := asChecking; + Reset; + Cookies.Clear; + s := 'returntype=8&CookieDate=1&b=d&bt=pone' + + '&UserName=' + EncodeURLElement(Module.Account.Username) + + '&PassWord=' + EncodeURLElement(Module.Account.Password) + + '&ipb_login_submit=Login%21'; + if POST(exhentaiurllogin, s) then begin + if ResultCode = 200 then begin + Result := Cookies.Values['ipb_pass_hash'] <> ''; + if Result then begin + Module.Account.Cookies := GetCookies; + Module.Account.Status := asValid; + end + else Module.Account.Status := asInvalid; + end; + end; + onlogin := False; + if Module.Account.Status = asChecking then + Module.Account.Status := asUnknown; + LeaveCriticalsection(locklogin); + end + else + begin + while onlogin do Sleep(1000); + if Result then AHTTP.Cookies.Text := Module.Account.Cookies; + end; +end; + +function GETWithLogin(const AHTTP: THTTPSendThread; const AURL: String; const Module: TModuleContainer): Boolean; +var + ACookies: String; +begin + Result := False; + if Assigned(Module.Account) and Module.Account.Enabled then begin + AHTTP.FollowRedirection := False; + // force no warning + AHTTP.Cookies.Values['nw'] := '1'; + if AHTTP.Cookies.Count > 0 then + ACookies := AHTTP.Cookies.Text + else + ACookies := ''; + AHTTP.Cookies.AddText(Module.Account.Cookies); + Result := AHTTP.GET(AURL); + if Result and (AHTTP.ResultCode > 300) then begin + Result := ExHentaiLogin(AHTTP, Module); + if Result then + begin + if ACookies <> '' then AHTTP.Cookies.AddText(ACookies); + Result := AHTTP.GET(AURL); + end; + end; + end + else + Result := AHTTP.GET(AURL); +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if GETWithLogin(MangaInfo.FHTTP, Module.RootURL + '/?' + dirURL, Module) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + Page := StrToIntDef(query.CSSString('table.ptt>tbody>tr>td:nth-last-child(2)>a'), 1) + 1; + finally + query.Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + rurl: String; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if AURL = '0' then rurl := Module.RootURL + '/?' + dirURL + else rurl := Module.RootURL + '/?page=' + IncStr(AURL) + '&' + dirURL; + if GETWithLogin(MangaInfo.FHTTP, rurl, Module) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + for v in query.XPath('//table[@class="itg"]/tbody/tr/td/div/div/a') do + begin + ANames.Add(v.toString); + ALinks.Add(v.toNode.getAttribute('href')); + end; + finally + query.Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + v: IXQValue; + + procedure ScanParse; + begin + with MangaInfo.mangaInfo do begin + //title + title := Query.XPathString('//*[@id="gn"]'); + //cover + coverLink := Query.XPathString('//*[@id="gd1"]/img/@src'); + //artists + artists := ''; + for v in Query.XPath('//a[starts-with(@id,"ta_artist")]') do + AddCommaString(artists, v.toString); + //genres + genres := ''; + for v in Query.XPath( + '//a[starts-with(@id,"ta_")and(not(starts-with(@id,"ta_artist")))]') do + AddCommaString(genres, v.toString); + //chapter + if title <> '' then begin + chapterLinks.Add(url); + chapterName.Add(title); + end; + //status + with TRegExpr.Create do + try + Expression := '(?i)[\[\(\{](wip|ongoing)[\]\)\}]'; + if Exec(title) then + status := '1' + else + begin + Expression := '(?i)[\[\(\{]completed[\]\)\}]'; + if Exec(title) then + status := '0'; + end; + finally + Free; + end; + end; + end; + +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit; + with MangaInfo.mangaInfo do begin + website := Module.Website; + url := ReplaceRegExpr('/\?\w+.*$', AURL, '/', False); + url := AppendURLDelim(FillHost(Module.RootURL, url)); + if GETWithLogin(MangaInfo.FHTTP, url, Module) then begin + Result := NO_ERROR; + // if there is only 1 line, it's banned message! + //if Source.Count = 1 then + // info.summary := Source.Text + //else + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + ScanParse; + finally + query.Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + query: TXQueryEngineHTML; + rurl: String; + getOK: Boolean; + i, p: Integer; + + procedure GetImageLink; + var + x: IXQValue; + begin + with DownloadThread.Task.Container, query do begin + ParseHTML(DownloadThread.FHTTP.Document); + for x in XPath('//div[@id="gdt"]//a') do + begin + PageContainerLinks.Add(x.toNode.getAttribute('href')); + FileNames.Add(ExtractFileNameOnly(Trim(SeparateRight( + XPathString('img/@title', x.toNode), ':')))); + end; + while PageLinks.Count < PageContainerLinks.Count do + PageLinks.Add('G'); + end; + end; + +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageContainerLinks.Clear; + Filenames.Clear; + PageNumber := 0; + rurl := ReplaceRegExpr('/\?\w+.*$', AURL, '/', False); + rurl := AppendURLDelim(FillHost(Module.RootURL, rurl)); + if GETWithLogin(DownloadThread.FHTTP, rurl, Module) then begin + Result := True; + query := TXQueryEngineHTML.Create; + try + getOK := True; + //check content warning + if Pos('Content Warning', query.XPathString('//div/h1')) > 0 then + getOK := GETWithLogin(DownloadThread.FHTTP, rurl + '?nw=session', Module); + if getOK then begin + GetImageLink; + //get page count + p := StrToIntDef(query.XPathString('//table[@class="ptt"]//td[last()-1]'), 0); + if p > 1 then begin + Dec(p); + for i := 1 to p do + begin + if DownloadThread.IsTerminated then Break; + if GETWithLogin(DownloadThread.FHTTP, rurl + '?p=' + IntToStr(i), Module) then + GetImageLink; + end; + end; + SerializeAndMaintainNames(FileNames); + // check the max length of filenames, serialize the filenames if it's exceds available space + p := 0; + for i := 0 to FileNames.Count - 1 do + begin + if Length(FileNames[i]) > p then + p := Length(FileNames[i]); + end; + if p > Task.CurrentMaxFileNameLength then + FileNames.Clear; + end; + finally + query.Free; + end; + end; + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + query: TXQueryEngineHTML; + iurl: String; + reconnect: Integer; + + function DoDownloadImage: Boolean; + var + rcount: Integer; + base_url, startkey, gid, startpage, nl, s, nls: String; + begin + rcount := 0; + Result := False; + nls := ''; + while (not Result) and (not DownloadThread.IsTerminated) do begin + s := StreamToString(DownloadThread.FHTTP.Document); + query.ParseHTML(DownloadThread.FHTTP.Document); + iurl := ''; + if (settingsimagesize > High(settingsimagesizestr)) and (Module.Account.Status = asValid) then + iurl := query.XPathString('//a/@href[contains(.,"/fullimg.php")]'); + if iurl = '' then + iurl := query.XPathString('//*[@id="img"]/@src'); + if iurl = '' then + iurl := query.XPathString('//a/img/@src[not(contains(.,"ehgt.org/"))]'); + if iurl <> '' then + Result := GETWithLogin(DownloadThread.FHTTP, iurl, Module); + if DownloadThread.IsTerminated then Break; + if rcount >= reconnect then Break; + if not Result then begin + base_url := ''; + startkey := ''; + gid := ''; + startpage := ''; + nl := ''; + //get AURL param + if Pos('var base_url', s) > 0 then + begin + base_url := GetBetween('var base_url=', ';', s); + base_url := TrimChar(base_url, ['''', '"']); + end; + if Pos('var startkey', s) > 0 then + begin + startkey := GetBetween('var startkey=', ';', s); + startkey := TrimChar(startkey, ['''', '"']); + end; + if Pos('var gid', s) > 0 then + begin + gid := GetBetween('var gid=', ';', s); + gid := TrimChar(gid, ['''', '"']); + end; + if Pos('var startpage', s) > 0 then + begin + startpage := GetBetween('var startpage=', ';', s); + startpage := TrimChar(startpage, ['''', '"']); + end; + if Pos('return nl(', s) > 0 then + begin + nl := GetBetween('return nl(', ')', s); + nl := TrimChar(nl, ['''', '"']); + end; + s := ''; + + if (base_url <> '') and (startkey <> '') and (gid <> '') and + (startpage <> '') then + iurl := RemoveURLDelim(base_url) + '/s/' + startkey + '/' + gid + '-' + startpage + else + iurl := FillHost(Module.RootURL, AURL); + if nl <> '' then + begin + if nls = '' then + nls := '?nl=' + nl + else + nls := nls + '&nl=' + nl; + iurl := iurl + nls; + end; + if not GETWithLogin(DownloadThread.FHTTP, iurl, Module) then Break; + Inc(rcount); + end; + end; + end; + +begin + Result := False; + if DownloadThread = nil then Exit; + reconnect := DownloadThread.FHTTP.RetryCount; + iurl := FillHost(Module.RootURL, AURL); + if settingsimagesize <= High(settingsimagesizestr) then + DownloadThread.FHTTP.Cookies.Values['uconfig'] := settingsimagesizestr[settingsimagesize]; + if GETWithLogin(DownloadThread.FHTTP, iurl, Module) then begin + query := TXQueryEngineHTML.Create(DownloadThread.FHTTP.Document); + try + Result := DoDownloadImage; + finally + query.Free; + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL: String): TModuleContainer; + begin + Result := AddModule; + with Result do begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'H-Sites'; + MaxTaskLimit := 1; + MaxConnectionLimit := 2; + SortedList := True; + DynamicPageLink := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + end; + end; + +begin + with AddWebsiteModule('E-Hentai', 'https://e-hentai.org') do + AddOptionComboBox(@settingsimagesize, 'SettingsImageSize', @RS_SettingsImageSize, @RS_SettingsImageSizeItems); + with AddWebsiteModule('ExHentai', 'http://exhentai.org') do begin + AccountSupport := True; + OnLogin := @ExHentaiLogin; + end; +end; + +initialization + InitCriticalSection(locklogin); + RegisterModule; + +finalization + DoneCriticalsection(locklogin); + +end. diff --git a/baseunits/modules/EightMuses.pas b/baseunits/modules/EightMuses.pas new file mode 100644 index 000000000..5d6486cd1 --- /dev/null +++ b/baseunits/modules/EightMuses.pas @@ -0,0 +1,150 @@ +unit EightMuses; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, RegExpr; + +implementation + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + Result := NET_PROBLEM; + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//*[@class="gallery"]/a/div/img/@data-src'); + if coverLink <> '' then + coverLink := MaybeFillHost(Module.RootURL, coverLink); + if Pos('//', coverLink) = 1 then coverLink := 'https:' + coverLink; + if title = '' then + title := XPathString('//*[@class="top-menu-breadcrumb"]//li[last()]'); + if ExecRegExpr('^(?i)issue\s\d+', title) then + begin + s := title; + title := XPathString('//*[@class="top-menu-breadcrumb"]//li[last()-1]'); + end; + //multi + if XPathString('//*[@class="gallery"]/a') <> '' then begin + for v in XPath('//*[@class="gallery"]/a') do begin + s := v.toNode.getAttribute('href'); + if s <> '' then + begin + chapterLinks.Add(s); + s := v.toString; + if (title <> '') and (Pos('Issue', s) = 1) then + s := title + ' - ' + s; + chapterName.Add(s); + end; + end; + end + else begin + chapterLinks.Add(url); + if s <> '' then + chapterName.Add(title + ' - ' + s) + else + chapterName.Add(title); + end; + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + v: IXQValue; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageContainerLinks.Clear; + PageNumber := 0; + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//*[@class="gallery"]/a/div/img/@data-src') do + begin + s := v.toString; + if s <> '' then + begin + s := StringReplace(s, '/th/', '/fm/', [rfIgnoreCase]); + s := MaybeFillHost(Module.RootURL, s); + if Pos('//', s) = 1 then + s := 'https:' + s; + PageLinks.Add(s); + end; + end; + if PageLinks.Count = 0 then + begin + for v in XPath('//*[@class="gallery"]/a/@href') do + PageContainerLinks.Add(v.toString); + PageNumber := PageContainerLinks.Count; + end; + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + rurl: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + if DownloadThread.WorkId >= PageContainerLinks.Count then Exit; + rurl := RemoveURLDelim(FillHost(Module.RootURL, PageContainerLinks[DownloadThread.WorkId])); + if GET(rurl) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + rurl := XPathString('string-join((//*[@id="imageDir"]/@value,//*[@id="imageName"]/@value),"")'); + if rurl <> '' then + begin + rurl := MaybeFillHost(Module.RootURL, rurl); + PageLinks[DownloadThread.WorkId] := rurl; + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := '8Muses'; + RootURL := 'https://www.8muses.com'; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/GoodManga.pas b/baseunits/modules/GoodManga.pas new file mode 100644 index 000000000..d3f3022cd --- /dev/null +++ b/baseunits/modules/GoodManga.pas @@ -0,0 +1,142 @@ +unit GoodManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/manga-list'; + imagepath = '//div[@id="manga_viewer"]/a/img/@src'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//td/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//img[@id="series_image"]/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//div[@class="right_col"]/h1'); + authors := XPathString('//div[@id="series_details"]/div/span[starts-with(.,"Authors:")]/following-sibling::text()'); + summary := XPathString('//div[@id="series_details"]/div//span[@id="full_notes"]'); + if summary = '' then + summary := XPathString('//div[@id="series_details"]/div/span[starts-with(.,"Synopsis:")]/following-sibling::*'); + status := MangaInfoStatusIfPos(XPathString('//div[@id="series_details"]/div/span[starts-with(.,"Status:")]/following-sibling::text()')); + genres := XPathString('//div[@id="series_details"]/div/span[starts-with(.,"Genres:")]/string-join(following-sibling::*,", ")'); + while true do + begin + XPathHREFAll('//div[@id="chapters"]/ul/li/a', chapterLinks, chapterName); + if Thread.IsTerminated then Break; + s := XPathString('//ul[@class="pagination"]/li/a[.="Next"]/@href'); + if (s <> '') and GET(MaybeFillHost(Module.RootURL, s)) then + ParseHTML(Document) + else + Break; + end; + InvertStrings([chapterLinks,chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + PageNumber := XPath('//div[@id="asset_2"]/select[@class="page_select"]/option').Count; + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + if GET(AppendURLDelim(FillHost(Module.RootURL, AURL)) + IncStr(DownloadThread.WorkId)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + PageLinks[DownloadThread.WorkId] := + XPathString(imagepath); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; + + procedure AddWebsiteModule(AWebsite, ARootURL: String); + begin + with AddModule do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; + end; + +begin + AddWebsiteModule('GoodManga', 'http://www.goodmanga.net'); + AddWebsiteModule('MangaBB', 'http://mangabb.co'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/GoogleDCP.pas b/baseunits/modules/GoogleDCP.pas new file mode 100644 index 000000000..97bde9415 --- /dev/null +++ b/baseunits/modules/GoogleDCP.pas @@ -0,0 +1,57 @@ +unit GoogleDCP; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, httpsendthread, synautil, synacode, dateutils; + +procedure SetGoogleDCP(const AHTTP: THTTPSendThread); +procedure RemoveGoogleDCP(const AHTTP: THTTPSendThread); + +implementation + +const + proxyhost='proxy.googlezip.net'; + authkey='ac4500dd3b7579186c1b0620614fdb1f7d61f944'; + +function randint: String; +begin + Result:=IntToStr(Random(999999999)); +end; + +procedure BeforeHTTPMethod(const AHTTP: THTTPSendThread; var Method, URL: String); +var + timestamp: String; +begin + if (Method='GET') and (LowerCase(Copy(URL,1,7))='http://') then + begin + AHTTP.SetProxy('HTTP',proxyhost,'80','',''); + timestamp:=IntToStr(DateTimeToUnix(Now)); + AHTTP.Headers.Add('Chrome-Proxy: ps='+timestamp+'-'+randint+'-'+randint+'-'+randint+', sid='+StrToHex(MD5(timestamp+authkey+timestamp))+', c=win, b=3029, p=110'); + end; +end; + +procedure AfterHTTPMethod(const AHTTP: THTTPSendThread; var Method, URL: String); +begin + if AHTTP.ProxyHost = proxyhost then + AHTTP.SetDefaultProxy; +end; + +procedure SetGoogleDCP(const AHTTP: THTTPSendThread); +begin + AHTTP.BeforeHTTPMethod := @BeforeHTTPMethod; + AHTTP.AfterHTTPMethod := @AfterHTTPMethod; +end; + +procedure RemoveGoogleDCP(const AHTTP: THTTPSendThread); +begin + if AHTTP.BeforeHTTPMethod=@BeforeHTTPMethod then + AHTTP.BeforeHTTPMethod:=nil; + if AHTTP.AfterHTTPMethod=@AfterHTTPMethod then + AHTTP.AfterHTTPMethod:=nil; +end; + +end. + diff --git a/baseunits/modules/Hentai2Read.pas b/baseunits/modules/Hentai2Read.pas new file mode 100644 index 000000000..0314f5cf4 --- /dev/null +++ b/baseunits/modules/Hentai2Read.pas @@ -0,0 +1,180 @@ +unit Hentai2Read; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +const + dirurl = '/hentai-list/all/any/all/last-added'; + cdnurl = 'http://static.hentaicdn.com/hentai'; + +implementation + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then + Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString( + '//ul[starts-with(@class,"pagination")]/li[last()-1]/a'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then + Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then + s := s + '/' + IncStr(AURL) + '/'; + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//*[@class="img-overlay text-center"]/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(XPathString('h2/@data-title', v)); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then + Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do + begin + url := FillHost(Module.RootURL, AURL); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(cdnurl, XPathString('//img[@class="img-responsive border-black-op"]/@src')); + title := XPathString('//h3[@class="block-title"]/a/text()'); + status := MangaInfoStatusIfPos(XPathString('//ul[contains(@class,"list-simple-mini")]/li[starts-with(.,"Status")]')); + authors := XPathStringAll('//ul[contains(@class,"list-simple-mini")]/li[starts-with(.,"Author")]/a'); + artists := XPathStringAll('//ul[contains(@class,"list-simple-mini")]/li[starts-with(.,"Artist")]/a'); + genres := XPathStringAll('//ul[contains(@class,"list-simple-mini")]/li/a'); + summary := XPathStringAll('//ul[contains(@class,"list-simple-mini")]/li[starts-with(.,"Storyline")]/*[position()>1]'); + for v in XPath('//ul[contains(@class,"nav-chapters")]/li/div/a') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(XPathString('string-join(text()," ")', v.toNode)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then + Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then + begin + Result := True; + if PageLinks.Count = 0 then + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('json(//script[contains(.,"images'' :")]/substring-before(substring-after(.,"images'' : "),"]")||"]")()') do + PageLinks.Add(cdnurl + v.toString); + if PageLinks.Count = 0 then + PageNumber := XPath('(//li[contains(@class, "pageDropdown")])[1]/ul/li').Count; + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if DownloadThread = nil then + Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + s := FillHost(Module.RootURL, AURL); + if DownloadThread.WorkId > 0 then + s := AppendURLDelim(s) + IncStr(DownloadThread.WorkId) + '/'; + if GET(s) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//img[@id="arf-reader"]/@src'); + if s <> '' then + begin + s := TrimLeftChar(s, ['/']); + PageLinks[DownloadThread.WorkId] := MaybeFillHost(cdnurl, s); + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Hentai2Read'; + RootURL := 'https://hentai2read.com'; + Category := 'H-Sites'; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/HentaiCafe.pas b/baseunits/modules/HentaiCafe.pas new file mode 100644 index 000000000..fdb2419b1 --- /dev/null +++ b/baseunits/modules/HentaiCafe.pas @@ -0,0 +1,149 @@ +unit HentaiCafe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread; + +implementation + +uses + synautil; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + Page := StrToIntDef(query.XPathString('//a[@class="last"]'), 1); + finally + query.Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + '/page/' + AURL + '/') then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + for v in query.XPath('//h2[@class="entry-title"]/a') do + begin + ANames.Add(v.toString); + ALinks.Add(v.toNode.getAttribute('href')); + end; + finally + query.Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + MangaInfo.mangaInfo.website := Module.Website; + if MangaInfo.FHTTP.GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + with MangaInfo.mangaInfo, query do begin + coverLink := XPathString('//div[@class="entry-content content"]//img/@src'); + title := XPathString('//div[@class="entry-content content"]//h3'); + for v in XPath('//div[@class="entry-content content"]//a') do begin + s := v.toNode.getAttribute('href'); + if Pos('/artist/', s) > 0 then AddCommaString(artists, v.toString) + else if Pos('/read/', s) > 0 then begin + if title <> '' then begin + chapterLinks.Add(s); + chapterName.Add(title); + end; + end + else AddCommaString(genres, v.toString); + end; + end; + finally + query.Free; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + source: TStringList; + i: Integer; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + source := TStringList.Create; + try + source.LoadFromStream(DownloadThread.FHTTP.Document); + if source.Count > 0 then + for i := 0 to source.Count - 1 do + if Pos('var pages = ', source[i]) > 0 then begin + s := SeparateRight(source[i], 'var pages = '); + s := Trim(TrimRightChar(s, [';'])); + ParseJSONArray(s, 'url', PageLinks); + Break; + end; + PageNumber := PageLinks.Count; + finally + source.Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'HentaiCafe'; + RootURL := 'https://hentai.cafe'; + Category := 'H-Sites'; + SortedList := True; + FavoriteAvailable := False; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/ImageHoster.pas b/baseunits/modules/ImageHoster.pas new file mode 100644 index 000000000..8c7b347c9 --- /dev/null +++ b/baseunits/modules/ImageHoster.pas @@ -0,0 +1,49 @@ +unit ImageHoster; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, httpsendthread, XQueryEngineHTML; + +function GetImageHoster(const AHTTP: THTTPSendThread; const AURL: String): String; + +implementation + +const + imghosts: array [0..2] of array [0..1] of string = ( + ('imagetwist.com', '//img[@class="pic img img-responsive"]/@src'), + ('imgchili.net', '//img[@id="show_image"]/@src'), + ('imgbox.com', '//img[@id="img"]/@src ') + ); + +function GetImageHoster(const AHTTP: THTTPSendThread; const AURL: String): String; +var + u: String; + i: Integer; +begin + Result := ''; + u := Trim(LowerCase(AURL)); + if u = '' then Exit; + + for i := Low(imghosts) to High(imghosts) do + begin + if Pos(imghosts[i, 0], u) <> 0 then + begin + AHTTP.GET(AURL); + if i = 0 then + AHTTP.GET(AURL); + with TXQueryEngineHTML.Create(AHTTP.Document) do + try + Result := XPathString(imghosts[i, 1]); + finally + Free; + end; + Break; + end; + end; +end; + +end. + diff --git a/baseunits/modules/KissManga.pas b/baseunits/modules/KissManga.pas new file mode 100644 index 000000000..746dc60c3 --- /dev/null +++ b/baseunits/modules/KissManga.pas @@ -0,0 +1,328 @@ +unit KissManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, BaseCrypto, GoogleDCP, RegExpr, + synautil; + +implementation + +const + kissmangadirurl = '/MangaList/Newest'; + readcomiconlinedirurl = '/ComicList/Newest'; + kissdoujindirurl = '/HentaiList/NewDoujinshi'; + +var + kissmangaiv: String ='a5e8e2e9c2721be0a84ad660c472c1f3'; + kissmangakey: String ='mshsdf832nsdbash20asdmnasdbasd612basd'; + kissmangausegoogledcp: Boolean = False; + +resourcestring + RS_KissManga_Key = 'Key:'; + RS_KissManga_InitVector = 'Initialization Vector:'; + RS_KissManga_UseGoogleDCP = 'Use Google DCP'; + +function GETWithCookie(const AHTTP: THTTPSendThread; const AURL: String; + const Module: TModuleContainer): Boolean; +begin + if (Module.Website = 'KissManga') and kissmangausegoogledcp then + SetGoogleDCP(AHTTP); + Result := AHTTP.GET(AURL); +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL; + if Module.Website = 'KissManga' then + s := s + kissmangadirurl + else if Module.Website = 'ReadComicOnline' then + s := s + readcomiconlinedirurl + else if Module.Website = 'KissDoujin' then + s := s + kissdoujindirurl; + if GETWithCookie(MangaInfo.FHTTP, s, Module) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + s := XPathString('//ul[@class="pager"]/li[last()]/a/@href'); + if s <> '' then begin + s := ReplaceRegExpr('^.*=(\d+)$', s, '$1', True); + Page := StrToIntDef(s, 1); + end; + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL; + if Module.Website = 'KissManga' then + s := s + kissmangadirurl + else if Module.Website = 'ReadComicOnline' then + s := s + readcomiconlinedirurl + else if Module.Website = 'KissDoujin' then + s := s + kissdoujindirurl; + if AURL <> '0' then + s := s + '?page=' + IncStr(AURL); + if GETWithCookie(MangaInfo.FHTTP, s, Module) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//table[@class="listing"]/tbody/tr/td[1]/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if GETWithCookie(MangaInfo.FHTTP, FillHost(Module.RootURL, AURL), Module) then begin + Result := NO_ERROR; + with MangaInfo.mangaInfo, TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//div[@id="rightside"]//img/@src')); + if title = '' then + begin + title := XPathString('//title'); + if title <> '' then + begin + if Pos('manga | Read', title) <> 0 then + title := SeparateLeft(title, 'manga | Read') + else if Pos('comic | Read', title) <> 0 then + title := SeparateLeft(title, 'comic | Read'); + end; + end; + genres := XPathStringAll('//div[@class="barContent"]//span[starts-with(., "Genre")]/parent::*/a'); + authors := XPathStringAll('//div[@class="barContent"]//span[starts-with(., "Author") or starts-with(., "Writer")]/parent::*/a'); + artists := XPathStringAll('//div[@class="barContent"]//span[starts-with(., "Artist")]/parent::*/a'); + status := MangaInfoStatusIfPos(XPathString( + '//div[@class="barContent"]/div/p[starts-with(.,"Status:")]'), + 'Ongoing', + 'Completed'); + summary := XPathString('//div[@class="barContent"]/div/p[starts-with(.,"Summary:")]//following-sibling::p[1]'); + for v in XPath('//table[@class="listing"]/tbody/tr/td/a') do begin + chapterLinks.Add(v.toNode.getAttribute('href')); + s := v.toNode.getAttribute('title'); + if LeftStr(s, 5) = 'Read ' then + Delete(s, 1, 5); + if RightStr(s, 7) = ' online' then + SetLength(s, Length(s) - 7) + else if RightStr(s, 29) = ' comic online in high quality' then + SetLength(s, Length(s) - 29) + else if RightStr(s, 23) = ' online in high quality' then + SetLength(s, Length(s) - 23); + chapterName.Add(s); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + source: TStringList; + i: Integer; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + Cookies.Values['rco_quality'] := 'hq'; + if GETWithCookie(DownloadThread.FHTTP, FillHost(Module.RootURL, AURL), Module) then + try + Result := True; + source := TStringList.Create; + source.LoadFromStream(Document); + if source.Count > 0 then + for i := 0 to source.Count - 1 do begin + if Pos('lstImages.push', source[i]) > 0 then + PageLinks.Add(GetBetween('("', '")', source[i])); + end; + finally + source.Free; + end; + end; +end; + +function KissMangaGetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + source: TStringList; + i, chkop, ivp: Integer; + chkos, chko1, chko2, civ, key, iv: String; + s: String; + + function testkeyiv(const akey, aiv: string): Boolean; + begin + if DownloadThread.Task.Container.PageLinks.Count=0 then Exit(False); + Result:=Pos('://',AESDecryptCBCSHA256Base64Pkcs7(DownloadThread.Task.Container.PageLinks[0],akey,aiv))<>0; + if Result then + begin + key := akey; + iv := aiv; + end; + end; + + procedure testkeyivlast; + begin + if testkeyiv(kissmangakey, kissmangaiv) then Exit; + SendLog('KissManga, failed to decrypt. chko1='+chko1+'; chko2= '+chko2+'; iv='+civ+'; '+ AURL, DownloadThread.Task.Container.PageLinks); + DownloadThread.Task.Container.PageLinks.Clear; + end; + +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GETWithCookie(DownloadThread.FHTTP, FillHost(Module.RootURL, AURL), Module) then + try + Result := True; + chkop := -1; + ivp := -1; + chkos := ''; + chko1 := ''; + chko2 := ''; + civ := ''; + key := ''; + iv := ''; + s := ''; + source := TStringList.Create; + source.LoadFromStream(Document); + for i := 0 to source.Count - 1 do + begin + if Pos('lstImages.push', source[i]) <> 0 then + PageLinks.Add(GetBetween('("', '")', source[i])) + else if (Pos('chko', source[i]) <> 0) and (Pos('=', source[i]) <> 0) then + chko2 := GetBetween('["', '"]', source[i]); + end; + if PageLinks.Count <> 0 then + begin + if GETWithCookie(DownloadThread.FHTTP, Module.RootURL + '/Scripts/lo.js', Module) then + begin + source.Text := StringReplace(StreamToString(Document), ';', LineEnding, [rfReplaceAll]); + for i := 0 to source.Count - 1 do + if (Pos('boxzq', source[i]) <> 0) and (Pos('=', source[i]) <> 0) then + ivp := StrToIntDef(GetBetween('[',']', source[i]), -1) + else if (Pos('chko', source[i]) <> 0) and (Pos('=', source[i]) <> 0) then + begin + chkos := GetBetween('=','[',source[i]); + chkop := StrToIntDef(GetBetween('[',']', source[i]), -1); + Break; + end; + if (chkos <> '') and (chkop <> -1) then + begin + for i := 0 to source.Count - 1 do + if Pos(chkos, source[i]) <> 0 then + begin + s := GetBetween('[', ']',source[i]); + Break; + end; + if s <> '' then + begin + source.CommaText := s; + if chkop < source.Count then + chko1 := source[chkop]; + if (ivp <> -1) and (ivp < source.Count) then + civ := JSHexToStr(source[ivp]); + end; + end; + end; + if (chko1 <> '') or (chko2 <> '') then + begin + chko1 := JSHexToStr(chko1); + chko2 := JSHexToStr(chko2); + if civ = '' then + civ := kissmangaiv; + // test all possibilities + if not testkeyiv(chko1, civ) then + if not testkeyiv(chko2, civ) then + if not testkeyiv(chko1+chko2, civ) then + if not testkeyiv(chko2+chko1, civ) then + testkeyivlast; + end + else + testkeyivlast; + if PageLinks.Count <> 0 then + begin + for i := 0 to PageLinks.Count - 1 do + PageLinks[i] := AESDecryptCBCSHA256Base64Pkcs7(PageLinks[i], key, iv); + end; + end + else + SendLogError('KissManga, image list empty. '+AURL); + finally + source.Free; + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL, ACategory: String): TModuleContainer; + begin + Result := AddModule; + with Result do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := ACategory; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; + end; + +begin + with AddWebsiteModule('KissManga', 'http://kissmanga.com', 'English') do + begin + OnGetPageNumber := @KissMangaGetPageNumber; + AddOptionEdit(@kissmangakey,'Key',@RS_KissManga_Key); + AddOptionEdit(@kissmangaiv,'IV',@RS_KissManga_InitVector); + AddOptionCheckBox(@kissmangausegoogledcp,'UseGoogleDCP',@RS_KissManga_UseGoogleDCP); + end; + AddWebsiteModule('ReadComicOnline', 'http://readcomiconline.to', 'English'); + AddWebsiteModule('KissDoujin', 'http://kissdoujin.com', 'H-Sites'); +end; + +initialization + RegisterModule; + +finalization + +end. diff --git a/baseunits/modules/KuManga.pas b/baseunits/modules/KuManga.pas new file mode 100644 index 000000000..c0e4e5ef3 --- /dev/null +++ b/baseunits/modules/KuManga.pas @@ -0,0 +1,178 @@ +unit KuManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, URIParser; + +implementation + +const + dirurl = '/backend/ajax/searchengine.php'; + dirperpage = '15'; + dirpostdata = 'contentType=manga&retrieveCategories=true&retrieveAuthors=true&perPage=' + + dirperpage + '&page='; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.POST(Module.RootURL + dirurl, dirpostdata + '1') then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + s := XPathString('json(*).totalContents'); + Page := ceil(StrToIntDef(s, 1) / StrToInt(dirperpage)); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + c, i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.POST(Module.RootURL + dirurl, dirpostdata + IncStr(AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + c := XPath('json(*).contents()').Count; + for i := 1 to c do + begin + ANames.Add(XPathString('json(*).contents(' + IntToStr(i) + ').name')); + ALinks.Add(XPathString('json(*).contents(' + IntToStr(i) + ')/concat("/manga/",id,"/",slug)')); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + lastPage, i, totalChapters, perPage: Integer; + s: String; + tmp: TStringList; + uri: TURI; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo do + begin + url := FillHost(Module.RootURL, AURL); + if MangaInfo.FHTTP.GET(url) then begin + Result := NO_ERROR; + tmp := TStringList.Create; + lastPage := 0; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + coverLink := XPathString('//div[@class="row"]//img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//h1'); + summary := XPathString('//*[@class="infom"]/div/div[1]/p'); + authors := XPathString('//*[@class="infom"]/div/div[2]//p[contains(.,"Autor") and not(contains(.,"No Disponible"))]/substring-after(normalize-space(.),": ")'); + artists := XPathString('//*[@class="infom"]/div/div[2]//p[contains(.,"Artist") and not(contains(.,"No Disponible"))]/substring-after(normalize-space(.),": ")'); + status := MangaInfoStatusIfPos(XPathString('//*[@class="infom"]/div/div[2]//p[contains(.,"Estado")]'), 'Activo', 'Finalizado'); + genres := XPathString('//*[@class="panel-footer" and contains(.,"Géneros")]/string-join(.//a,", ")'); + XPathHREFAll('//table[contains(@class, "table")]//h4[@class="title"]/a', chapterLinks, chapterName); + + s := XPathString('//script[contains(., "php_pagination")]'); + if s <> '' then begin + s := GetBetween('php_pagination(', ');', s); + tmp.Delimiter := ','; + tmp.DelimitedText := s; + totalChapters := StrToIntDef(tmp[4], 0); + perPage := StrToIntDef(tmp[5], 1); + lastPage := Math.ceil(float(totalChapters) / float(perPage)); + end; + finally + tmp.Free; + Free; + end; + + for i := 2 to lastPage do begin + uri := ParseURI(url); + uri.Path := uri.Path + 'p/' + IntToStr(i); + s := EncodeURI(uri); + if MangaInfo.FHTTP.GET(s) then begin + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//table[contains(@class, "table")]//h4[@class="title"]/a', chapterLinks, chapterName); + finally + Free; + end; + end; + end; + + InvertStrings([chapterLinks, chapterName]); + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + pages: Integer; + pageFormat, pageFormat2: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL.Replace('/c/','/leer/'))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do try + pageFormat := XPathString('//script[contains(.,"konekomangareader")]/substring-before(substring-after(substring-after(.,"setup"),","),");")'); + if pageFormat <> '' then begin + pageFormat := ReplaceString(pageFormat, ':remote', ':''remote'''); + ParseHTML(pageFormat); + pages := StrToIntDef(XPathString('json(*)//pages'), 0); + pageFormat := XPathString('substring-before(json(*)//pageFormat,"{pnumber}")'); + pageFormat2 := XPathString('substring-after(json(*)//pageFormat,"{pnumber}")'); + if pageFormat <> '' then + for pages := 1 to pages do + PageLinks.Add(pageFormat + IntToStr(pages) + pageFormat2); + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'KuManga'; + RootURL := 'http://www.kumanga.com'; + Category := 'Spanish'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/LeoManga.pas b/baseunits/modules/LeoManga.pas new file mode 100644 index 000000000..c21a9e70d --- /dev/null +++ b/baseunits/modules/LeoManga.pas @@ -0,0 +1,154 @@ +unit LeoManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/directorio-manga?orden=alfabetico'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(SeparateRight( + XPathString('//ul[@class="pagination"]/li[last()-1]/a/@href'), 'pagina='), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + s := Module.RootURL + dirurl; + if AURL <> '0' then + s += '&pagina=' + IncStr(AURL); + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[@class="list-inline reset-floats"]/li/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(Trim(XPathString('div//h2/text()[1]', v.toNode))); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v, x: IXQValue; + s, t: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//img[contains(@class,"manga-picture")]/@data-original')); + if title = '' then + begin + title := XPathString('//*[@id="page-manga"]/h1'); + if RightStr(title, 6) = ' Manga' then + SetLength(title, Length(title) - 6); + end; + summary := XPathString('//*[@id="page-manga"]/h2[.="Sinopsis"]/following-sibling::p/text()'); + authors := XPathString('//*[@id="page-manga"]/div[@class="row"]/div[starts-with(.,"Autor")]/substring-after(normalize-space(.),": ")'); + genres := XPathString('//*[@id="page-manga"]/div[@class="row"]/div[starts-with(.,"Géneros")]/substring-after(normalize-space(.),": ")'); + for v in XPath('//ul[contains(@class,"caps-list")]/li') do + begin + s := Trim(XPathString('div[1]/h3/text()[2]', v.toNode)); + for x in XPath('div[2]/ul/li/a', v.toNode) do + begin + chapterLinks.Add(x.toNode.getAttribute('href')); + t := x.toString; + if s <> '' then + t := s + ' ' + t; + chapterName.Add(t); + end; + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//a[contains(@class,"cap-option")]/@href'); + if s = '' then Exit; + if GET(MaybeFillHost(Module.RootURL, s)) then begin + ParseHTML(Document); + XPathStringAll('//*[@id="cascade-images"]//img/@src', PageLinks); + MaybeFillHost(Module.RootURL, PageLinks); + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'LeoManga'; + RootURL := 'http://leomanga.com'; + Category := 'Spanish'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Luscious.pas b/baseunits/modules/Luscious.pas new file mode 100644 index 000000000..939465854 --- /dev/null +++ b/baseunits/modules/Luscious.pas @@ -0,0 +1,127 @@ +unit Luscious; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, RegExpr; + +implementation + +const + dirurl = '/c/-/albums/frontpage/0/t/manga/sorted/new/page/'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '1/') then + begin + Result := NO_ERROR; + Page := StrToIntDef(TrimChar(XPathString('//*[@class="pagination"]/*[@class="last"]/a/@href/substring-after(.,"/new/page")', MangaInfo.FHTTP.Document), ['/']), 1); + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + IncStr(AURL) + '/') then + begin + Result := NO_ERROR; + XPathHREFtitleAll('//*[@id="albums_wrapper"]//*[@class="item_cover"]/a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@class="album_cover_item"]//img/@src')); + if title = '' then title := XPathString('//*[@class="album_cover"]/h2'); + artists := XPathString('//*[@id="tag_section"]/ol/li/a[starts-with(.,"Artist")]/text()[last()]'); + genres := XPathString('//*[@id="tag_section"]/ol/string-join(li/a/text()[last()],", ")'); + chapterLinks.Add(url); + chapterName.Add(title); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + n: String; + i: Integer; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + while True do + begin + XPathStringAll('//*[@class="picture_page"]//img/@data-src', PageLinks); + n := XPathString('//*[@class="pagination"]/a/@href'); + if n = '' then Break; + if GET(MaybeFillHost(Module.RootURL, n)) then + ParseHTML(Document) + else + begin + PageLinks.Clear; + Break; + end; + end; + if PageLinks.Count <> 0 then + with TRegExpr.Create('\.\d+x\d+(\.\w+)') do + try + for i := 0 to PageLinks.Count - 1 do + PageLinks[i] := Replace(PageLinks[i], '$1', True); + finally + Free; + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Luscious'; + RootURL := 'https://luscious.net'; + Category := 'H-Sites'; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Madokami.pas b/baseunits/modules/Madokami.pas new file mode 100644 index 000000000..d5b9e6434 --- /dev/null +++ b/baseunits/modules/Madokami.pas @@ -0,0 +1,308 @@ +unit Madokami; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synacode, RegExpr, fpjson; + +implementation + +uses FMDVars; + +const + modulename = 'Madokami'; + urlroot = 'https://manga.madokami.al'; + madokamilist = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; + madokamiotherlist: array [0..9] of String = ( + '/Manga/_Autouploads/AutoUploaded%20from%20Assorted%20Sources', + '/Manga/_Autouploads/ComicWalker', + '/Manga/Oneshots', + '/Manga/Non-English/Bahasa%20Indonesia', + '/Manga/Non-English/Brazilian%20Portuguese', + '/Manga/Non-English/Deutsch', + '/Manga/Non-English/Fran%C3%A7ais', + '/Manga/Non-English/Italian', + '/Manga/Non-English/Russian', + '/Manga/Non-English/Spanish' + ); + +var + madokamiauth: String = ''; + locklogin: TRTLCriticalSection; + madokamiulist: array of TStrings; + accountexist: Boolean = False; + +function Login(const AHTTP: THTTPSendThread; const Module: TModuleContainer): Boolean; +begin + Result := False; + if Module.Account.Enabled = False then Exit; + if (Module.Account.Username = '') or (Module.Account.Password = '') then Exit; + if TryEnterCriticalsection(locklogin) > 0 then + try + Module.Account.Status := asChecking; + AHTTP.Reset; + AHTTP.Cookies.Clear; + madokamiauth := 'Authorization: Basic ' + + Base64Encode(Module.Account.Username + ':' + Module.Account.Password); + AHTTP.Headers.Add(madokamiauth); + if AHTTP.GET(urlroot) then begin + //Result := AHTTP.Cookies.Values['laravel_session'] <> ''; + Result := (AHTTP.ResultCode < 400) and (AHTTP.Headers.Values['WWW-Authenticate'] = ''); + if Result then begin + Module.Account.Cookies := AHTTP.GetCookies; + Module.Account.Status := asValid; + end + else begin + Module.Account.Cookies := ''; + Module.Account.Status := asInvalid; + end; + end; + finally + LeaveCriticalsection(locklogin); + end + else begin + EnterCriticalsection(locklogin); + try + if Result then + AHTTP.Cookies.Text := Module.Account.Cookies; + finally + LeaveCriticalsection(locklogin); + end; + end; + AHTTP.Reset; +end; + +procedure SetAuth(const AHTTP: THTTPSendThread; const Module: TModuleContainer); +begin + AHTTP.Cookies.Text := Module.Account.Cookies; + if AHTTP.Cookies.Count <> 0 then + begin + if madokamiauth = '' then + madokamiauth := 'Authorization: Basic ' + Base64Encode(Module.Account.Username); + AHTTP.Headers.Add(madokamiauth); + end; +end; + +function GETWithLogin(const AHTTP: THTTPSendThread; AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + SetAuth(AHTTP, Module); + AHTTP.FollowRedirection := False; + Result := AHTTP.GET(AURL); + if ((AHTTP.ResultCode > 400) and (AHTTP.Headers.Values['WWW-Authenticate'] = ' Basic')) or + (Pos('/login',AHTTP.Headers.Values['Location']) <> 0) then + begin + if Login(AHTTP, Module) then + Result := AHTTP.GET(AURL); + end; +end; + +procedure ClearMadokamiUlist; +var + i: Integer; +begin + if Length(madokamiulist) <> 0 then begin + for i := Low(madokamiulist) to High(madokamiulist) do + FreeAndNil(madokamiulist[i]); + SetLength(madokamiulist, 0); + end; +end; + +function BeforeUpdateList(const Module: TModuleContainer): Boolean; +var + i: Integer; +begin + Result := True; + accountexist := Module.Account.Username <> ''; + if not accountexist then Exit; + ClearMadokamiUlist; + SetLength(madokamiulist, Length(madokamilist)); + for i := Low(madokamiulist) to High(madokamiulist) do + madokamiulist[i] := TStringList.Create; +end; + +function AfterUpdateList(const Module: TModuleContainer): Boolean; +begin + Result := True; + if not accountexist then Exit; + ClearMadokamiUlist; +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NO_ERROR; + if not accountexist then Exit; + if workPtr < Length(madokamilist) then begin + if GETWithLogin(MangaInfo.FHTTP, Module.RootURL + '/Manga/' + madokamilist[WorkPtr+1], Module) then begin + XPathStringAll('//table[@id="index-table"]/tbody/tr/td[1]/a/@href', MangaInfo.FHTTP.Document, madokamiulist[WorkPtr]); + Page := madokamiulist[WorkPtr].Count; + end; + end + else + Page := 1; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; + + procedure GetList; + begin + XPathHREFAll('//table[@id="index-table"]/tbody/tr/td[1]/a[not(ends-with(.,".txt") or ends-with(.,".zip") or ends-with(.,".rar"))]', MangaInfo.FHTTP.Document, ALinks, ANames); + end; + +var + workPtr, i: Integer; + u: String; + l1: TStrings; +begin + Result := NET_PROBLEM; + if not accountexist then Exit; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + workPtr := StrToIntDef(AURL, 0); + u := ''; + if Module.CurrentDirectoryIndex < Length(madokamilist) then + begin + if workPtr < madokamiulist[Module.CurrentDirectoryIndex].Count then + u := MaybeFillHost(Module.RootURL, madokamiulist[Module.CurrentDirectoryIndex][workPtr]); + end + else + u := Module.RootURL + madokamiotherlist[Module.CurrentDirectoryIndex-Length(madokamilist)]; + if u = '' then Exit; + if GETWithLogin(MangaInfo.FHTTP, u, Module) then begin + Result := NO_ERROR; + if Module.CurrentDirectoryIndex < Length(madokamilist) then begin + l1 := TStringList.Create; + try + XPathStringAll('//table[@id="index-table"]/tbody/tr/td[1]/a/@href', MangaInfo.FHTTP.Document, l1); + for i := 0 to l1.Count - 1 do begin + if MangaInfo.Thread.IsTerminated then Break; + if GETWithLogin(MangaInfo.FHTTP, MaybeFillHost(Module.RootURL, l1[i]), Module) then + GetList; + end; + finally + l1.Free; + end; + end + else + GetList; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if GETWithLogin(MangaInfo.FHTTP, MaybeFillHost(Module.RootURL, AURL), Module) then begin + Result := NO_ERROR; + with MangaInfo.mangaInfo, TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + coverLink := XPathString('//img[@itemprop="image"]/@src'); + if title = '' then title := XPathString('//*[@class="title"]'); + if title = '' then title := XPathString('(//h1//span[@itemprop="title"])[last()]'); + authors := XPathString('//*[@itemprop="author"]'); + v := XPath('//div[@class="genres"]/a'); + if v.Count > 0 then begin + genres := ''; + for i := 0 to v.Count - 1 do + AddCommaString(genres, v.get(i).toString); + end; + for v in XPath('//table[@id="index-table"]/tbody/tr') do begin + chapterLinks.Add(XPathString('td/a[contains(text(),"Read")]/@href', v.toNode)); + chapterName.Add(XPathString('td[1]/a', v.toNode)); + end; + if chapterName.Count > 0 then + with TRegExpr.Create do + try + Expression := '\.\w+\s*$'; + for i := 0 to chapterName.Count - 1 do + chapterName[i] := Replace(chapterName[i], '', False); + finally + Free; + end; + finally + Free; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + datapath, datafiles: String; + i: Integer; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GETWithLogin(DownloadThread.FHTTP, FillHost(Module.RootURL, AURL), Module) then begin + Result := True; + with TXQueryEngineHTML.Create(DownloadThread.FHTTP.Document) do + try + datapath := XPathString('//div[@id="reader"]/@data-path'); + datapath := EncodeURLElement(datapath); + datafiles := XPathString('//div[@id="reader"]/@data-files'); + datafiles := Trim(TrimChar(datafiles, ['[', ']'])); + datafiles := JSONStringToString(datafiles); + PageLinks.Delimiter := ','; + PageLinks.DelimitedText := datafiles; + if PageLinks.Count > 0 then + for i := 0 to PageLinks.Count - 1 do + PageLinks[i] := Module.RootURL + '/reader/image?path=' + + datapath + '&file=' + EncodeURLElement(PageLinks[i]); + finally + Free; + end; + end; + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + Result := GETWithLogin(DownloadThread.FHTTP, AURL, Module); +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := modulename; + RootURL := urlroot; + Category := 'English'; + AccountSupport := True; + //MaxTaskLimit := 1; + //MaxConnectionLimit := 4; + TotalDirectory := Length(madokamilist) + Length(madokamiotherlist); + OnBeforeUpdateList := @BeforeUpdateList; + OnAfterUpdateList := @AfterUpdateList; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + OnLogin := @Login; + end; +end; + +initialization + InitCriticalSection(locklogin); + RegisterModule; + +finalization + ClearMadokamiUlist; + DoneCriticalsection(locklogin); + +end. diff --git a/baseunits/modules/MangaAe.pas b/baseunits/modules/MangaAe.pas new file mode 100644 index 000000000..302b56227 --- /dev/null +++ b/baseunits/modules/MangaAe.pas @@ -0,0 +1,107 @@ +unit MangaAe; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, strutils; + +implementation + +const + dirurl = '/manga'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; var Page: Integer; const WorkPtr: Integer; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + Page := XPathCount('//div[@class="pagination"]/a', MangaInfo.FHTTP.Document); + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '/page:' + IncStr(AURL)) then + begin + Result := NO_ERROR; + XPathHREFAll('//div[@id="mangadirectory"]/div[@class="mangacontainer"]/a[2]', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do try + coverLink := XPathString('//img[@class="manga-cover"]/resolve-uri(@src)'); + if title = '' then title := TrimChar(XPathString('//h1[@class="EnglishName"]'), ['(', ')']); + authors := XPathString('//div[@class="manga-details-author"]/h4[1]'); + genres := XPathString('//div[@class="manga-details-extended"]/ul/string-join(./li/a,", ")'); + summary := XPathString('//div[@class="manga-details-extended"]/h4[last()]'); + status := MangaInfoStatusIfPos(XPathString('//div[@class="manga-details-extended"]/h4[2]'), + 'مستمرة', + 'مكتملة'); + XPathHREFAll('//ul[@class="new-manga-chapters"]/li/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + u: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + u := RemoveURLDelim(MaybeFillHost(Module.RootURL, AURL)); + if AnsiEndsStr('/1', u) then u := AnsiLeftStr(u, Length(u)-2); + u += '/0/full'; + if GET(u) then + begin + Result := True; + XPathStringAll('//*[@id="showchaptercontainer"]//img/resolve-uri(@src)', Document, PageLinks); + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaAe'; + RootURL := 'https://www.manga.ae'; + Category := 'Arabic'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaChanRU.pas b/baseunits/modules/MangaChanRU.pas new file mode 100644 index 000000000..c6f399a7c --- /dev/null +++ b/baseunits/modules/MangaChanRU.pas @@ -0,0 +1,171 @@ +unit MangaChanRU; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr; + +implementation + +const + dirurl = '/manga/new'; + perpage = 20; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + s := XPathString('//*[@id="pagination"]/a[last()]/@href'); + if s <> '' then Page := StrToIntDef(SeparateRight(s, 'offset='), 1); + if Page > 1 then + Page := ceil(Page / perpage) + 1; + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then s += '?offset=' + IntToStr(StrToInt(AURL) * perpage); + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//*[@class="content_row"]//a[@class="title_link"]') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do + begin + if GET(FillHost(Module.RootURL, AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//img[@id="cover"]/@src')); + if title = '' then title := XPathString('//*[@class="name_row"]/h1'); + authors := XPathString('//*[@class="item" and contains(.,"Автор")]/following-sibling::*[1]'); + genres := XPathString('//*[@class="item" and contains(.,"Тэги")]/following-sibling::*[1]'); + status := MangaInfoStatusIfPos( + XPathString('//*[@class="item" and contains(.,"Загружено")]/following-sibling::*[1]'), + 'продолжается', + ''); + summary := XPathString('//*[@id="description"]/text()'); + for v in XPath('//*[@class="table_cha"]//*[@class="manga"]/a') do begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(v.toString); + end; + if chapterLinks.Count = 0 then + for v in XPath('//a[.="Читать онлайн"]') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(title); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + Source: TStringList; + i, j: Integer; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + Source := TStringList.Create; + try + Source.LoadFromStream(Document); + if Source.Count > 0 then + for i := 0 to Source.Count - 1 do + if Pos('"fullimg":', Source[i]) > 0 then begin + s := SeparateRight(Source[i], ':'); + s := TrimChar(s, ['[', ']', ',']); + PageLinks.CommaText := s; + if PageLinks.Count > 0 then + with TRegExpr.Create('(?i)//im(\d*\.)') do + try + for j := 0 to PageLinks.Count - 1 do + PageLinks[j] := Replace(PageLinks[j], '//img$1', True); + finally + Free; + end; + Break; + end; + finally + Source.Free; + end; + end; + end; +end; + +procedure RegisterModule; + + procedure AddWebsiteModule(const AWebsite, ARootURL, ACategory: String); + begin + with AddModule do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := ACategory; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; + end; + +begin + AddWebsiteModule('MangaChanRU', 'http://mangachan.me', 'Russian'); + AddWebsiteModule('HentaiChanRU', 'http://hentai-chan.me', 'H-Sites'); + AddWebsiteModule('YaoiChanRU', 'http://yaoichan.me', 'H-Sites'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaFox.pas b/baseunits/modules/MangaFox.pas new file mode 100644 index 000000000..67b7b0ee6 --- /dev/null +++ b/baseunits/modules/MangaFox.pas @@ -0,0 +1,175 @@ +unit MangaFox; + +{$mode objfpc}{$H+} + +interface + +implementation + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, MangaFoxWatermark, JSUtils, synautil; + +var + removewatermark: Boolean = True; + saveaspng: Boolean = False; + +resourcestring + RS_RemoveWatermark = 'Remove watermark'; + RS_SaveAsPNG = 'Save as PNG'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; +var + s: string; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + '/directory/' + IncStr(AURL) + '.html?az'; + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + XPathHREFtitleAll('//ul[contains(@class, "manga-list")]/li/a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do begin + url := MaybeFillHost(Module.RootURL, AURL); + Cookies.Values['isAdult'] := '1'; + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//img[@class="detail-info-cover-img"]/@src')); + if title = '' then title := XPathString('//span[@class="detail-info-right-title-font"]'); + authors := XPathStringAll('//p[@class="detail-info-right-say"]/a'); + genres := XPathStringAll('//p[@class="detail-info-right-tag-list"]/a'); + summary := XPathString('//p[@class="fullcontent"]'); + status := MangaInfoStatusIfPos(XPathString('//span[@class="detail-info-right-title-tip"]')); + for v in XPath('//ul[@class="detail-main-list"]/li/a') do + begin + chapterLinks.Add(StringReplace(v.toNode.getAttribute('href'), '1.html', '', [rfReplaceAll])); + chapterName.Add(XPathString('./div/p[@class="title3"]', v)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + s, key, cid: string; + query: TXQueryEngineHTML; + page: Integer; + v: IXQValue; + lst: TStringList; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + Cookies.Values['isAdult'] := '1'; + if GET(MaybeFillHost(Module.RootURL, AURL) + '1.html') then begin + Result := True; + query := TXQueryEngineHTML.Create(Document); + try + s := query.XPathString('//script[contains(., "eval")]'); + s := 'var $=function(){return{val:function(){}}},newImgs,guidkey;' + s; + s := s + ';newImgs||guidkey;'; + key := ExecJS(s); + if Length(key) > 16 then + PageLinks.CommaText := key + else if Length(key) > 0 then begin + s := query.XPathString('//script[contains(., "chapterid")]'); + cid := Trim(ReplaceString(GetBetween('chapterid', ';', s), '=', '')); + PageNumber := StrToIntDef(Trim(ReplaceString(GetBetween('imagecount', ';', s), '=', '')), 0); + page := 1; + while page <= PageNumber do begin + Reset; + Headers.Values['Pragma'] := 'no-cache'; + Headers.Values['Cache-Control'] := 'no-cache'; + Headers.Values['Referer'] := MaybeFillHost(Module.RootURL, AURL) + '1.html'; + s := 'chapterfun.ashx?cid=' + cid + '&page=' + IntToStr(page) + '&key=' + key; + if XHR(MaybeFillHost(Module.RootURL, AURL) + s) then begin + s := Trim(StreamToString(Document)); + if s <> '' then begin + s := ExecJS(s + ';d;'); + lst := TStringList.Create; + try + lst.CommaText := s; + if page > 1 then lst.Delete(0); + PageLinks.AddStrings(lst); + finally + lst.Free; + end; + end; + end; + if PageLinks.Count >= PageNumber then Break; + Inc(page); Sleep(3000); + end; + end; + finally + query.Free; + end; + end; + end; +end; + +function AfterImageSaved(const AFilename: String; const Module: TModuleContainer): Boolean; +begin + Result := True; + if removewatermark then + Result := MangaFoxWatermark.RemoveWatermark(AFilename, saveaspng); +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + '/directory/?az') then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('//div[@class="pager-list"]//a[last()-1]'), 1); + finally + Free; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaFox'; + RootURL := 'http://fanfox.net'; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnAfterImageSaved := @AfterImageSaved; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + AddOptionCheckBox(@removewatermark, 'RemoveWatermark', @RS_RemoveWatermark); + AddOptionCheckBox(@saveaspng, 'SaveAsPNG', @RS_SaveAsPNG); + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaHere.pas b/baseunits/modules/MangaHere.pas new file mode 100644 index 000000000..eaa16f6bd --- /dev/null +++ b/baseunits/modules/MangaHere.pas @@ -0,0 +1,25 @@ +unit MangaHere; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules; + +implementation + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaHere'; + RootURL := 'http://www.mangahere.cc'; + Category := 'English'; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaHome.pas b/baseunits/modules/MangaHome.pas new file mode 100644 index 000000000..5863296b5 --- /dev/null +++ b/baseunits/modules/MangaHome.pas @@ -0,0 +1,174 @@ +unit MangaHome; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/directory'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + Page := query.XPath('//select/option').Count; + finally + query.Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then s += '/' + IncStr(AURL) + '.html'; + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(MangaInfo.FHTTP.Document)); + for v in query.XPath('//div[@class="cover-info"]/p[@class="title"]/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + query.Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + a, v, t: IXQValue; + s: String; + i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(Document)); + coverLink := query.XPathString('//img[@class="detail-cover"]/@src'); + if title = '' then title := query.XPathString('//div[@class="manga-detail"]/h1'); + for v in query.XPath('//div[@class="manga-detail"]//p') do begin + s := v.toString; + if Pos('Author(s):', s) > 0 then authors := SeparateRight(s, ':') else + if Pos('Artist(s):', s) > 0 then artists := SeparateRight(s, ':') else + if Pos('Genre(s):', s) > 0 then genres := SeparateRight(s, ':') else + if Pos('Status:', s) > 0 then begin + s := LowerCase(s); + if Pos('ongoing', s) > 0 then status := '1' else status := '0'; + end; + end; + summary := query.XPathString('//p[@id="show"]/text()'); + + a := query.XPath('//ul[@class="detail-chlist"]/li/a/@href'); + v := query.XPath('//ul[@class="detail-chlist"]/li/a/span[1]'); + t := query.XPath('//ul[@class="detail-chlist"]/li/span[@class="vol"]'); + if (a.Count > 0) and (a.Count = v.Count) and (a.Count = t.Count) then + for i := 1 to a.Count do begin + chapterLinks.Add(a.get(i).toString); + chapterName.Add(v.get(i).toString + ' ' + t.get(i).toString); + end; + InvertStrings([chapterLinks, chapterName]); + finally + query.Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + query: TXQueryEngineHTML; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(Document)); + PageNumber := query.XPath('//div[@class="mangaread-pagenav"]/select/option').Count; + finally + query.Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + query: TXQueryEngineHTML; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + s := RemoveURLDelim(AURL); + if DownloadThread.WorkId > 0 then s += '/' + IncStr(DownloadThread.WorkId) + '.html'; + if GET(FillHost(Module.RootURL, s)) then begin + Result := True; + query := TXQueryEngineHTML.Create; + try + query.ParseHTML(StreamToString(Document)); + PageLinks[DownloadThread.WorkId] := query.XPathString('//section[@id="viewer"]//img/@src'); + finally + query.Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaHome'; + RootURL := 'http://www.mangahome.com'; + Category := 'English'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaHubRU.pas b/baseunits/modules/MangaHubRU.pas new file mode 100644 index 000000000..80288da93 --- /dev/null +++ b/baseunits/modules/MangaHubRU.pas @@ -0,0 +1,128 @@ +unit MangaHubRU; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr; + +implementation + +const + dirurl = '/explore?search[sort]=date'; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then + begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create(Document); + try + if title = '' then title := query.XPathString('//div[@class="b-group-head__desc"]/h1'); + coverLink := MaybeFillHost(Module.RootURL, query.XPathString('//div[@class="manga-section-image__img"]/img/@src')); + authors := query.XPathString('//a[@itemprop="author"]'); + summary:= query.XPathString('//div[@itemprop="description"]'); + genres := query.XPathStringAll('//div[@class="b-dtl-desc__labels"]/a'); + query.XPathHREFAll('//div[@class="b-ovf-table"]/div[@class="b-ovf-table__elem"]/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + query.Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//div[contains(@class, "b-reader__full")]/@data-js-scans'); + s := ReplaceString(s, '\/', '/'); + if s <> '' then begin + ParseHTML(s); + for v in XPath('json(*)()("src")') do begin + s := ReplaceString(v.toString, '\/', '/'); + PageLinks.Add(MaybeFillHost(Module.RootURL, s)); + end; + end; + finally + Free; + end; + end; +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + s := XPathString('//div[@class="pagination"]/ul/li[last()-1]/a'); + Page := StrToIntDef(s, 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '&page=' + IncStr(AURL)) then begin + Result := NO_ERROR; + XPathHREFAll('//div[@class="list-element__name"]/a', + MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaHubRU'; + RootURL := 'https://mangahub.ru'; + Category := 'Russian'; + SortedList := True; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + end; +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/MangaIndo.pas b/baseunits/modules/MangaIndo.pas new file mode 100644 index 000000000..3b1643734 --- /dev/null +++ b/baseunits/modules/MangaIndo.pas @@ -0,0 +1,86 @@ +unit MangaIndo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML; + +implementation + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + '/manga-list/') then + begin + Result := NO_ERROR; + XPathHREFAll('//li[@class="manga-list"]/a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@id="m-cover"]/img/@src')); + if title = '' then title := XPathString('//*[@class="title"]/h2'); + authors := XPathString('//*[@id="m-author"]'); + artists := XPathString('//*[@id="m-artist"]'); + genres := XPathString('//*[@id="m-genre"]/string-join(a," ")'); + status := MangaInfoStatusIfPos(XPathString('//*[@id="m-status"]')); + summary := XPathString('//*[@id="m-synopsis"]'); + XPathHREFAll('//ul[@class="lcp_catlist"]/li/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + XPathStringAll('//*[@class="entry-content"]//img/@src', Document, PageLinks); + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaIndo'; + RootURL := 'http://mangaindo.web.id'; + Category := 'Indonesian'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaInn.pas b/baseunits/modules/MangaInn.pas new file mode 100644 index 000000000..d74f6e415 --- /dev/null +++ b/baseunits/modules/MangaInn.pas @@ -0,0 +1,120 @@ +unit MangaInn; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, synautil, FMDVars; + +implementation + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + s := ALPHA_LIST[Module.CurrentDirectoryIndex + 1]; + if MangaInfo.FHTTP.GET(Module.RootURL + '/manga-list/' + s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + updateList.CurrentDirectoryPageNumber := 1; + XPathHREFAll('//ul[contains(@class, "manga-list")]/li/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//div[contains(@class, "manga-info")]//img[@class="img-responsive mobile-img"]/resolve-uri(@src)'); + title := XPathString('//title'); + if Pos(' - Read ', title) <> 0 then + title := Trim(GetBetween('- Read ', ' Online at', title)); + status := MangaInfoStatusIfPos( + XPathString('//dt[starts-with(.,"Status")]/following-sibling::dd[1]'), + 'Ongoing', + 'Complete'); + authors := XPathString('//dt[starts-with(.,"Author")]/following-sibling::dd[1]'); + artists := XPathString('//dt[starts-with(.,"Artist")]/following-sibling::dd[1]'); + genres := XPathStringAll('//dt[starts-with(.,"Categories")]/following-sibling::dd[1]/a'); + summary := Trim(XPathString('//div[contains(@class, "manga-info")]//div[contains(@class, "note")]')); + for v in XPath('//div[@id="chapter_list"]/ul/li/a') do + begin + chapterLinks.Add(v.toNode().getAttribute('href')); + chapterName.Add(XPathString('span[1]', v)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL + '/all-pages')) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//script[contains(.,"var images = [")]'); + if s <> '' then + begin + s := '[' + GetBetween('var images = [', '];', s) + ']'; + ParseHTML(s); + XPathStringAll('json(*)().url', PageLinks); + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaInn'; + RootURL := 'http://www.mangainn.net'; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + TotalDirectory := Length(ALPHA_LIST); + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaLife.pas b/baseunits/modules/MangaLife.pas new file mode 100644 index 000000000..1fe6e8d34 --- /dev/null +++ b/baseunits/modules/MangaLife.pas @@ -0,0 +1,148 @@ +unit MangaLife; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synacode; + +implementation + +uses + synautil; + +const + dirURL = '/directory/'; + diralpha = '#ABCDEFGHIJKLMNOPQRSTUVWXYZ'; + +function fixcleanurl(const u: string): string; +begin + Result := u; + if Result = '' then Exit; + while Result[1] = '.' do + Delete(Result, 1, 1); +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + s := Module.RootURL + dirURL; + if AURL <> '0' then + s += diralpha[StrToIntDef(AURL, 0) + 1]; + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//*[@id="content"]//a') do + begin + ALinks.Add(fixcleanurl(v.toNode.getAttribute('href'))); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + title := XPathString('//*[@class="row"]//h1'); + if ResultCode = 404 then + begin + status := '-1'; + Exit; + end; + coverLink := MaybeFillHost(Module.RootURL, XPathString('//meta[@property="og:image"]/@content')); + authors := SeparateRight(XPathString('//*[@class="row"][starts-with(.,"Author")]'), ':'); + artists := SeparateRight(XPathString('//*[@class="row"][starts-with(.,"Artist")]'), ':'); + status := XPathString('//*[@class="row"][starts-with(.,"Scanlation Status")]'); + if status = '' then + status := XPathString('//*[@class="row"][starts-with(.,"Status")]'); + if status <> '' then + status := MangaInfoStatusIfPos(status); + genres := SeparateRight(XPathString('//*[@class="row"][starts-with(.,"Genre")]'), ':'); + summary := Trim(SeparateRight(XPathString('//*[@class="row"][starts-with(.,"Description")]'), ':')); + for v in XPath('//div[@class="list chapter-list"]//a') do + begin + s := v.toNode.getAttribute('href'); + if Pos('-page-1', s) <> 0 then + s := StringReplace(s, '-page-1', '', []); + chapterLinks.Add(s); + chapterName.Add(XPathString('span[@class="chapterLabel"]', v)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + XPathStringAll('//*[contains(@class,"image-container")]//img/@src', PageLinks); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL: String): TModuleContainer; + begin + Result := AddModule; + with Result do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; + end; + +begin + AddWebsiteModule('MangaLife', 'http://mangalife.us'); + AddWebsiteModule('MangaSee', 'http://mangaseeonline.us'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaOnlineBR.pas b/baseunits/modules/MangaOnlineBR.pas new file mode 100644 index 000000000..041dc4976 --- /dev/null +++ b/baseunits/modules/MangaOnlineBR.pas @@ -0,0 +1,119 @@ +unit MangaOnlineBR; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, synacode, RegExpr; + +implementation + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + '/lista-titulos.php') then + begin + Result := NO_ERROR; + XPathHREFAll('//*[@class="manga"]/p/a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v, x: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@id="page-mangas"]//*[@class="image"]/img/@src')); + title := XPathString('//h1'); + authors := XPathString('//*[@class="texto-left"]/ul/li[starts-with(.,"História")]/substring-after(.,":")'); + artists := XPathString('//*[@class="texto-left"]/ul/li[starts-with(.,"Ilustração")]/substring-after(.,":")'); + genres := XPathString('string-join(//*[@class="generos"]/a,", ")'); + status := MangaInfoStatusIfPos(XPathString('//*[@class="texto-left"]/ul/li[starts-with(.,"Status")]'), 'Em Publicação', ''); + summary := XPathString('//p[.="Sinopse"]/following-sibling::p'); + for v in XPath('//*[@id="volumes-capitulos"]//*[@class="texto"]') do + begin + s := XPathString('p[1]', v); + for x in XPath('p[2]//a', v) do + begin + chapterLinks.Add(x.toNode.getAttribute('href')); + chapterName.Add(s + ' Capitulo ' + x.toString); + end; + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + a, c: String; + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + a := ''; + c := ''; + with TRegExpr.Create('(?i)/([^/]+)/capitulo/(\d+)') do + try + if Exec(AURL) then + begin + a := Match[1]; + c := Match[2]; + end; + finally + Free; + end; + if (a = '') or (c ='') then Exit; + if GET(Module.RootURL + '/capitulo.php?act=getImg&anime=' + EncodeURLElement(a) + '&capitulo=' + c + '&src=1&view=2') then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//*[@id="imgAvancadoVisualizacao"]/img') do + PageLinks.Add(MaybeFillHost(Module.RootURL, v.toNode.getAttribute('src'))); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaOnlineBR'; + RootURL := 'http://mangaonline.com.br'; + Category := 'Portugues'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaReader.pas b/baseunits/modules/MangaReader.pas new file mode 100644 index 000000000..80b4e8268 --- /dev/null +++ b/baseunits/modules/MangaReader.pas @@ -0,0 +1,222 @@ +unit MangaReader; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + httpsendthread; + +implementation + +uses + simplehtmltreeparser, xquery, RegExpr; + +const + dirurl = '/alphabetical'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NO_ERROR; + Page := 1; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + Source: TStringList; + Parser: TTreeParser; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit; + Source := TStringList.Create; + try + if GetPage(MangaInfo.FHTTP, TObject(Source), Module.RootURL + dirurl, 3) then + begin + Result := INFORMATION_NOT_FOUND; + if Source.Count > 0 then + begin + Result := NO_ERROR; + Parser := TTreeParser.Create; + try + ParseHTMLTree(Parser, Source.Text); + for v in SelectXPathIX('//ul[@class="series_alpha"]/li/a', Parser) do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Parser.Free; + end; + end; + end; + finally + Source.Free; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + Source: TStringList; + Parser: TTreeParser; + + procedure ScanInfo; + var + v: IXQValue; + s: String; + begin + with MangaInfo.mangaInfo do begin + //cover + coverLink := SelectXPathString('//*[@id="mangaimg"]/img/@src', Parser); + //title + title := SelectXPathString('//*[@id="mangaproperties"]//h2', Parser); + //author + authors := SelectXPathString( + '//*[@id="mangaproperties"]//td[contains(text(),"Author:")]/following-sibling::td', + Parser); + //artist + artists := SelectXPathString( + '//*[@id="mangaproperties"]//td[contains(text(),"Artist:")]/following-sibling::td', + Parser); + //status + s := SelectXPathString( + '//*[@id="mangaproperties"]//td[contains(text(),"Status:")]/following-sibling::td', + Parser); + if s <> '' then begin + s := LowerCase(s); + if Pos('ongoing', s) > 0 then status := '1' + else if Pos('completed', s) > 0 then status := '0'; + end; + //summary + summary := SelectXPathString('//*[@id="readmangasum"]/p', Parser); + //chapters + for v in SelectXPathIX('//table[@id="listing"]/tbody/tr/td[1]/a', Parser) do + chapterLinks.Add(v.toNode.getAttribute('href')); + for v in SelectXPathIX('//table[@id="listing"]/tbody/tr/td[1]', Parser) do + chapterName.Add(v.toString); + end; + end; + +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit; + MangaInfo.mangaInfo.website := Module.Website; + MangaInfo.mangaInfo.url := FillHost(Module.RootURL, AURL); + Source := TStringList.Create; + try + if MangaInfo.FHTTP.GET(MangaInfo.mangaInfo.url, TObject(Source)) then + begin + Result := INFORMATION_NOT_FOUND; + if Source.Count > 0 then + begin + Result := NO_ERROR; + Parser := TTreeParser.Create; + try + ParseHTMLTree(Parser, Source.Text); + ScanInfo; + finally + Parser.Free; + end; + end; + end; + finally + Source.Free; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + Source: TStringList; + Parser: TTreeParser; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + Source := TStringList.Create; + try + if GetPage(DownloadThread.FHTTP, TObject(Source), FillHost(Module.RootURL, AURL), + Manager.retryConnect) then + if Source.Count > 0 then + begin + Result := True; + Parser := TTreeParser.Create; + try + ParseHTMLTree(Parser, Source.Text); + PageNumber := SelectXPathIX( + '//select[@id="pageMenu"]/option', Parser).Count; + finally + Parser.Free; + end; + end; + finally + Source.Free; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + Source: TStringList; + Parser: TTreeParser; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do begin + Source := TStringList.Create; + try + if GetPage(DownloadThread.FHTTP, TObject(Source), + AppendURLDelim(FillHost(Module.RootURL, AURL)) + + IncStr(DownloadThread.WorkId), Manager.retryConnect) then + if Source.Count > 0 then + begin + Result := True; + Parser := TTreeParser.Create; + try + ParseHTMLTree(Parser, Source.Text); + PageLinks[DownloadThread.WorkId] := + SelectXPathString('//img[@id="img"]/@src', Parser); + finally + Parser.Free; + end; + end; + finally + Source.Free; + end; + end; +end; + +procedure RegisterModule; + + procedure AddWebsiteModule(AWebsite, ARootURL: String); + begin + with AddModule do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'English'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; + end; + +begin + AddWebsiteModule('MangaReader', 'http://www.mangareader.net'); + AddWebsiteModule('MangaPanda', 'http://www.mangapanda.com'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaRock.pas b/baseunits/modules/MangaRock.pas new file mode 100644 index 000000000..b029afef7 --- /dev/null +++ b/baseunits/modules/MangaRock.pas @@ -0,0 +1,229 @@ +unit MangaRock; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, webp, fpjson, Math, xquery; + +implementation + +var + mangaList: TStringList = nil; + +const + ModuleApiUrl: String = 'https://api.mangarockhd.com'; + DirRequest: String = '{"status":"all","genres":{},"rank":"all","order":"name"}'; + PerPage = 500; + +function DecryptImage(const imageData: TStream): TMemoryStream; +var + n, i: Integer; + tmp: TMemoryStream; +begin + n := imageData.Size + 7; + tmp := TMemoryStream.Create; + + // RIFF header + tmp.WriteByte(82); + tmp.WriteByte(73); + tmp.WriteByte(70); + tmp.WriteByte(70); + + // image size + tmp.WriteByte(n and $FF); + tmp.WriteByte((n shr 8) and $FF); + tmp.WriteByte((n shr 16) and $FF); + tmp.WriteByte((n shr 24) and $FF); + + // WEBPVP8 header + tmp.WriteByte(87); + tmp.WriteByte(69); + tmp.WriteByte(66); + tmp.WriteByte(80); + tmp.WriteByte(86); + tmp.WriteByte(80); + tmp.WriteByte(56); + + for i := 0 to imageData.Size - 1 do + tmp.WriteByte(imageData.ReadByte xor 101); + + tmp.Seek(0, TSeekOrigin.soBeginning); + Result := tmp; +end; + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + mangaId, name: String; + query: TXQueryEngineHTML; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + mangaId := TrimRightChar(SeparateRight(AURL, 'manga/'), ['/']); + if MangaInfo.FHTTP.GET(ModuleApiUrl + '/query/web401/info?oid=' + mangaId) then + begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document); + with MangaInfo.mangaInfo do + begin + title := query.XPathString('json(*).data.name'); + coverLink := query.XPathString('json(*).data.thumbnail'); + summary := query.XPathString('json(*).data.description'); + + genres := ''; + for v in query.XPath('json(*).data.rich_categories().name') do + AddCommaString(genres, v.toString()); + + authors := ''; + artists := ''; + for v in query.XPath('json(*).data.authors()') do + begin + name := v.getProperty('name').toString(); + if CompareText(v.getProperty('role').toString(), 'art') = 0 then + AddCommaString(artists, name) + else + AddCommaString(authors, name) + end; + + status := MangaInfoStatusIfPos(query.XPathString('json(*).data.completed'), 'false', 'true'); + + for v in query.XPath('json(*).data.chapters()') do + begin + chapterName.Add(v.getProperty('name').toString()); + chapterLinks.Add(v.getProperty('oid').toString()); + end; + end; + query.Free; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + chapterId: String; +begin + Result := False; + if DownloadThread = nil then Exit; + DownloadThread.Task.Container.PageLinks.Clear; + DownloadThread.Task.Container.PageNumber := 0; + chapterId := TrimLeftChar(AURL, ['/']); + if DownloadThread.FHTTP.GET(ModuleApiUrl + '/query/web401/pages?oid=' + chapterId) then + begin + Result := True; + XPathStringAll('json(*).data()', + DownloadThread.FHTTP.Document, + DownloadThread.Task.Container.PageLinks); + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + decoded: TMemoryStream; +begin + decoded := nil; + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP do + if GET(AURL) then + try + decoded := DecryptImage(Document); + Document.Size := decoded.Size; + Document.Position := 0; + decoded.SaveToStream(Document); + Result := True; + finally + decoded.Free; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; + + function GetRequest(const AURL: String): String; + var + offset, i, ubound: Integer; + begin + Result := '[]'; + offset := StrToInt(AURL) * PerPage; + ubound := Min(offset + PerPage - 1, mangaList.Count - 1); + with TJSONArray.Create do + try + for i := offset to ubound do + Add(mangaList[i]); + Result := FormatJSON([foSkipWhiteSpace, foSingleLineArray]); + finally + Free; + end; + end; + +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if (MangaInfo = nil) or (mangaList = nil) then Exit(UNKNOWN_ERROR); + + MangaInfo.FHTTP.MimeType := 'application/json'; + if MangaInfo.FHTTP.POST(ModuleApiUrl + '/meta', GetRequest(AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('json(*)/data/*') do begin + ANames.Add(XPathString('name', v)); + ALinks.Add(Module.RootURL + '/manga/' + XPathString('oid', v)); + end; + finally + Free; + end; + end; +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + MangaInfo.FHTTP.MimeType := 'application/json'; + if MangaInfo.FHTTP.POST(ModuleApiUrl + '/query/web401/mrs_filter', DirRequest) then + begin + Result := NO_ERROR; + mangaList.Clear; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathStringAll('json(*).data()', mangaList); + Page := round(ceil(double(mangaList.Count) / PerPage)); + finally + Free; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaRock'; + RootURL := 'https://mangarock.com'; + Category := 'English'; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + OnGetNameAndLink := @GetNameAndLink; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + end; +end; + +initialization + mangaList := TStringList.Create; + RegisterModule; + +finalization + mangaList.Free; + +end. + diff --git a/baseunits/modules/MangaTr.pas b/baseunits/modules/MangaTr.pas new file mode 100644 index 000000000..2a62679c8 --- /dev/null +++ b/baseunits/modules/MangaTr.pas @@ -0,0 +1,245 @@ +unit MangaTr; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +var + mangatrcookie: String = ''; + puzzmoscookie: String = ''; + +const + mangatrdirurl = '/manga-list.html?listType=allABC'; + puzzmosdirurl = '/directory?type=text'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL; + if Module.Website = 'Manga-Tr' then + s := s + mangatrdirurl + else if Module.Website = 'Puzzmos' then + s := s + puzzmosdirurl; + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//span[starts-with(@class, "manga")]//a') do + begin + ANames.Add(v.toString); + ALinks.Add(v.toNode.getAttribute('href')); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + i: Integer; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + MangaInfo.mangaInfo.website := Module.Website; + if MangaInfo.FHTTP.GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + with MangaInfo.mangaInfo, TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + coverLink := XPathString('//img[starts-with(@class,"thumbnail")]/@src'); + if coverLink <> '' then coverLink := FillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//title'); + if title <> '' then + begin + if Pos(' Manga - Oku ', title) > 0 then + title := SeparateLeft(title, ' Manga - Oku ') + else if Pos(' Mangasını Oku ', title) > 0 then + title := SeparateLeft(title, ' Mangasını Oku '); + end; + if title = '' then title := XPathString('//h1'); + if Pos('Yazar', XPathString('//table[1]/tbody/tr[1]/td[1]')) > 0 then + s := '//table[1]/tbody/tr[2]' + else + s := '//table[2]/tbody/tr[2]/'; + authors := XPathString(s + '/td[1]'); + artists := XPathString(s + '/td[2]'); + genres := TrimRightChar(Trim(XPathString(s + '/td[3]')), [',']); + summary := XPathString('//div[@class="well"]/p'); + v := XPath('//table[4]/tbody/tr/td/a'); + if v.Count = 0 then v := XPath('//table[3]/tbody/tr/td/a'); + if v.Count = 0 then begin + s := XPathString('//*[@slug]/@slug'); + if s <> '' then begin + MangaInfo.FHTTP.Reset; + MangaInfo.FHTTP.Headers.Add('X-Requested-With: XMLHttpRequest'); + if MangaInfo.FHTTP.GET(Module.RootURL+'/cek/fetch_pages_manga.php?manga_cek='+s) then begin + ParseHTML(MangaInfo.FHTTP.Document); + v := XPath('//tr/td[1]/a'); + end; + end; + end; + if v.Count <> 0 then + begin + for i := 1 to v.Count do begin + chapterLinks.Add(v.get(i).toNode.getAttribute('href')); + chapterName.Add(v.get(i).toString); + end; + InvertStrings([chapterLinks, chapterName]); + end; + finally + Free; + end; + end; +end; + +function GETWithCookie(const AHTTP: THTTPSendThread; + const AURL: String; + const Module: TModuleContainer; + const usePOST: Boolean = False; + const POSTData: String = ''): Boolean; +var + iurl, s: String; + ccookie: PString; +begin + Result := False; + if Module.Website = 'Manga-Tr' then + ccookie := @mangatrcookie + else if Module.Website = 'Puzzmos' then + ccookie := @puzzmoscookie; + iurl := MaybeFillHost(Module.RootURL, AURL); + if ccookie^ <> '' then + begin + AHTTP.Cookies.Text := ccookie^; + if AHTTP.GET(iurl) then + begin + s := StreamToString(AHTTP.Document); + if (Pos('class="chapter-content"', s) > 0) or (Pos('class=''chapter-content''', s) > 0) then + Result := True; + end; + end; + if not Result then + begin + AHTTP.Reset; + if usePOST then + Result := AHTTP.POST(iurl, POSTData) + else + Result := AHTTP.GET(iurl); + if Result then + begin + if AHTTP.Cookies.Values['PHPSESSID'] <> '' then + begin + // manga-tr allpage = 1; perpage = 2 + if Module.Website = 'Manga-Tr' then + AHTTP.Cookies.Values['read_type'] := '1'; + ccookie^ := AHTTP.GetCookies; + AHTTP.Reset; + AHTTP.Headers.Values['Referer'] := ' ' + iurl; + Result := AHTTP.GET(iurl); + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageContainerLinks.Clear; + PageNumber := 0; + //if Module.Website = 'Manga-Tr' then + // Result := GETWithCookie(DownloadThread.FHTTP, AURL, Module) + // puzzmos POST perpage = "sayfadansayfa:" allpage = "altalta:" + //else if Module.Website = 'Puzzmos' then + // Result := GETWithCookie(DownloadThread.FHTTP, AURL, Module, True, 'altalta:'); + Result := GETWithCookie(DownloadThread.FHTTP, AURL, Module); + if Result then + begin + with TXQueryEngineHTML.Create(Document) do + try + //perpage + if Module.Website = 'Manga-Tr' then + s := '//div[@class="chapter-content"]/select[2]/option' + else if Module.Website = 'Puzzmos' then + s := '(//select)[2]/option'; + for v in XPath(s) do + if Pos('Yorumlar', v.toString) = 0 then + PageContainerLinks.Add(v.toNode.getAttribute('value')); + PageNumber := PageContainerLinks.Count; + //allpage + for v in XPath('//div[@class="chapter-content"]//img[@class="chapter-img"]/@src') do + PageLinks.Add(MaybeFillHost(Module.RootURL, v.toString)); + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + Headers.Values['Referer'] := ' ' + AURL; + if DownloadThread.WorkId > PageContainerLinks.Count then Exit; + if GETWithCookie(DownloadThread.FHTTP, PageContainerLinks[DownloadThread.WorkId], Module) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + PageLinks[DownloadThread.WorkId] := + MaybeFillHost(Module.RootURL, XPathString('//div[@class="chapter-content"]//img/@src')); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; + + procedure AddWebsiteModule(const AWebsite, ARootURL: String); + begin + with AddModule do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'Turkish'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; + end; + +begin + AddWebsiteModule('Manga-Tr', 'http://manga-tr.com'); + AddWebsiteModule('Puzzmos', 'http://puzzmos.com'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaTube.pas b/baseunits/modules/MangaTube.pas new file mode 100644 index 000000000..8f678a4df --- /dev/null +++ b/baseunits/modules/MangaTube.pas @@ -0,0 +1,137 @@ +unit MangaTube; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, synautil; + +implementation + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if MangaInfo.FHTTP.GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + if title = '' then title := XPathString('//h1[@class="series-title"]'); + coverLink := XPathString('//div[contains(@class, "cover")]//img/@data-original'); + coverLink := MaybeFillHost(Module.RootURL, coverLink); + summary := XPathString('//h4[text()="Beschreibung"]/following-sibling::p'); + if summary = '' then summary := XPathString('//h4[text()="Beschreibung"]/following-sibling::text()[1]'); + genres := XPathStringAll('//ul[contains(@class, "genre-list")]/li/a'); + authors := XPathStringAll('//ul[contains(@class, "series-details")]/li[contains(., "Autor")]/a'); + artists := XPathStringAll('//ul[contains(@class, "series-details")]/li[contains(., "Artist")]/a'); + status := Trim(XPathString('//ul[contains(@class, "series-details")]/li[contains(., "Status (Offiziell):")]/text()')); + status := MangaInfoStatusIfPos(status, 'laufend', 'abgeschlossen'); + for v in XPath('//ul[contains(@class, "chapter-list")]/li/a[contains(@href, "read/")]') do + begin + chapterLinks.Add(v.toNode().getAttribute('href')); + chapterName.Add(XPathString('concat(b, " ", span[1])', v)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + imgpath, s: String; + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//script[contains(., "img_path: ")]'); + imgpath := GetBetween('img_path: ''', ''',', s); + s := GetBetween('pages: ', '}],', s) + '}]'; + ParseHTML(s); + for v in XPath('json(*)().file_name') do begin + s := v.toString; + PageLinks.Add(imgpath + s); + end; + finally + Free; + end; + end; + end; +end; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s:string; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + '/series/?filter=alphabetic') then + begin + Result := NO_ERROR; + Page := StrToIntDef(XPathString('//div[@id="series_list"]/@data-series-pages', MangaInfo.FHTTP.Document), 0); + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; +var + data: String; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + data := 'action=load_series_list_entries¶meter%5Bpage%5D=' + IncStr(AURL) + + '¶meter%5Bletter%5D=¶meter%5Bsortby%5D=alphabetic¶meter%5Border%5D=asc'; + if MangaInfo.FHTTP.POST(Module.RootURL + '/ajax', data) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathStringAll('json(*).success().manga_title', ANames); + for v in XPath('json(*).success().manga_slug') do + ALinks.Add(Module.RootURL + '/series/' + v.toString()); + finally + Free; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'MangaTube'; + RootURL := 'https://manga-tube.me'; + Category := 'German'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/MangaWindow.pas b/baseunits/modules/MangaWindow.pas new file mode 100644 index 000000000..93a4a9253 --- /dev/null +++ b/baseunits/modules/MangaWindow.pas @@ -0,0 +1,163 @@ +unit MangaWindow; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr; + +implementation + +const + dirurl = '/browse?sort=create&page='; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '1') then begin + Result := NO_ERROR; + s := XPathString('(//ul[contains(@class, "pagination")])[1]/li[last()-1]', MangaInfo.FHTTP.Document); + Page := StrToIntDef(s, 1); + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + IncStr(AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//div[@id="series-list"]/div/div') do begin + ALinks.Add(XPathString('a/@href', v)); + s := XPathString('span[contains(@class, "flag")]/@class', v); + if s <> '' then begin + s := RegExprGetMatch('flag_(\w+)\b', s, 1); + if s <> 'united_kingdom' then s := ' [' + UpperCase(s) + ']' + else s := ' [EN]'; + end; + s := XPathString('a', v) + s; + ANames.Add(s); + end; + finally + Free; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + v, obj: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + s := MaybeFillHost(Module.RootURL, AURL); + if GET(s) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := XPathString('//script[matches(., "var\s+images")]'); + s := RegExprGetMatch('var\s+images\s+\=\s+\{(.+?)\}', s, 1); + s := '{' + s + '}'; + ParseHTML(s); + obj := XPath('json(*)'); + for v in XPath('json(*)()') do + PageLinks.Add(obj.getProperty(v.toString).toString); + finally + Free; + end; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + a: TStringArray; + i: Integer; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//div[contains(@class, "attr-cover")]/img/@src')); + if title = '' then begin + title := XPathString('//h3[@class="item-title"]'); + s := XPathString('//h3[@class="item-title"]/parent::*/span[contains(@class, "flag")]/@class'); + if s <> '' then begin + s := RegExprGetMatch('flag_(\w+)\b', s, 1); + if s <> 'united_kingdom' then s := ' [' + UpperCase(s) + ']' + else s := ' [EN]'; + title += s; + end; + end; + authors := XPathStringAll('//div[@class="attr-item" and contains(b, "Authors")]/span'); + genres := XPathStringAll('//div[@class="attr-item" and contains(b, "Genres")]/span'); + a := genres.Split('/'); + for i := Low(a) to High(a) do a[i] := Trim(a[i]); + genres := ''.Join(', ', a); + status := MangaInfoStatusIfPos(XPathString('//div[@class="attr-item" and contains(b, "Status")]/span')); + summary := XPathStringAll('//p[@class="summary-set"]/text()', ''); + XPathHREFAll('//div[contains(@class, "chapter-list")]/div[@class="main"]/div/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL: String): TModuleContainer; + begin + Result := AddModule; + with Result do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'English'; + SortedList := True; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + end; + end; + +begin + AddWebsiteModule('MangaWindow', 'https://mangawindow.net'); + AddWebsiteModule('Batoto', 'https://bato.to'); +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/MangaZuki.pas b/baseunits/modules/MangaZuki.pas new file mode 100644 index 000000000..9f0fd1dd3 --- /dev/null +++ b/baseunits/modules/MangaZuki.pas @@ -0,0 +1,122 @@ +unit MangaZuki; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/manga-list'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('(//ul[contains(@class,"pagination")]//a)[last()-1]/replace(@href,"^.*page=(\d+)$","$1")'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '?page=' + IncStr(AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//*[@class="row"]//a[@class="chart-title"]', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//meta[@itemprop="photo"]/@content'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//div[@class="container"]/div[@class="row"]/div/h2'); + summary := XPathString('//h5[text()="Summary"]/following-sibling::*'); + XPathHREFAll('//ul[@class="chapters"]/li/h3/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//div[@id="all"]/img/@data-src') do + PageLinks.Add(MaybeFillHost(Module.RootURL, Trim(v.toString))); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL, ACategory: String): TModuleContainer; + begin + Result := AddModule; + with Result do begin + Website := AWebsite; + RootURL := ARootURL; + Category := ACategory; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; + end; + +begin + AddWebsiteModule('MangaZuki', 'https://mangazuki.co', 'English-Scanlation'); + AddWebsiteModule('MangaZukiRaws', 'https://raws.mangazuki.co', 'Raw'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Mangacan.pas b/baseunits/modules/Mangacan.pas new file mode 100644 index 000000000..ad71a4ed4 --- /dev/null +++ b/baseunits/modules/Mangacan.pas @@ -0,0 +1,96 @@ +unit Mangacan; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread; + +implementation + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + '/daftar-komik-manga-bahasa-indonesia.html') then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//*[@class="series_col"]//li/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + if title = '' then title := XPathString('//h1/substring-before(.," Indonesia|Baca")'); + XPathHREFAll('//table[@class="updates"]//td/a', chapterLinks, chapterName); + if chapterLinks.Count <> 0 then + chapterLinks.Text := StringReplace(chapterLinks.Text, '-1.htm', '.htm', [rfIgnoreCase, rfReplaceAll]); + InvertStrings([chapterLinks,chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//*[@id="imgholder"]//img/@src') do + PageLinks.Add(MaybeFillHost(Module.RootURL, v.toString)); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Mangacan'; + RootURL := 'http://www.mangacanblog.com'; + Category := 'Indonesian'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Mangaf.pas b/baseunits/modules/Mangaf.pas new file mode 100644 index 000000000..9540a4de0 --- /dev/null +++ b/baseunits/modules/Mangaf.pas @@ -0,0 +1,121 @@ +unit Mangaf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, FMDVars; + +implementation + +const + dirurl: String = '/api/v1/explore/state/'; + dirstates: array[0..2] of String = ('stopped', 'ongoing', 'completed'); + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; +var + s, p: String; + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := dirstates[Module.CurrentDirectoryIndex]; + p := IncStr(AURL); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + s + '?page=' + p) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + if AURL = '0' then begin + s := XPathString('json(*).last_page'); + updateList.CurrentDirectoryPageNumber := StrToIntDef(XPathString('json(*).last_page'), 0); + end; + for v in XPath('json(*).data()') do begin + s := v.getProperty('slug').toString; + p := v.getProperty('name').toString; + ALinks.Add(Module.RootURL + '/m/' + v.getProperty('slug').toString); + ANames.Add(v.getProperty('name').toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + v := XPath('//div[@id="content"]/noscript/div[@class="container"]'); + if title = '' then title := XPathString('h2', v); + coverLink := XPathString('img/@src', v); + authors := XPathString('dl[dt="الكاتب"]/dd', v); + artists := XPathString('dl[dt="الراسم"]/dd', v); + genres := XPathStringAll('dl[dt="التصنيفات"]/dd/a', ', ', v); + status := MangaInfoStatusIfPos(XPathString('dl[dt="الحالة"]/dd', v), + 'مستمرة', + 'مكتملة'); + summary := XPathString('dl[dt="القصة"]/dd', v); + XPathHREFAll('div[@class="Chapters"]/ul/li/a', chapterLinks, chapterName, v); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//noscript/div[@class="container"]/ul/li/img/@src') do + PageLinks.Add(v.toString()); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Mangaf'; + RootURL := 'https://mangaforall.com'; + Category := 'Arabic'; + TotalDirectory := 3; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/MintMangaRU.pas b/baseunits/modules/MintMangaRU.pas new file mode 100644 index 000000000..6142cb1fb --- /dev/null +++ b/baseunits/modules/MintMangaRU.pas @@ -0,0 +1,192 @@ +unit MintMangaRU; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Math, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, FMDOptions, httpsendthread, synautil; + +implementation + +const + dirurl = '/list?sortType=created'; + perpage = 70; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + s := XPathString('//*[@class="pagination"]/a[@class="step"][last()]/@href'); + if s <> '' then Page := StrToIntDef(GetBetween('offset=', '&', s), 1); + if Page > 1 then + Page := ceil(Page / perpage) + 1; + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then s += '&offset=' + IntToStr(StrToInt(AURL) * perpage) + '&max=' + IntToStr(perpage); + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//*[@class="tiles row"]/div/div[@class="desc"]/h3/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + rname, s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//*[@class="picture-fotorama"]/img/@src'); + rname := XPathString('//h1[@class="names"]/span[@class="name"]'); + if title = '' then title := XPathString('//h1[@class="names"]/span[@class="eng-name"]'); + if title = '' then title := rname; + authors := Trim(SeparateRight( + XPathString('//*[starts-with(@class,"subject-meta")]/*[starts-with(.,"Автор")]'), ':')); + genres := Trim(SeparateRight( + XPathString('//*[starts-with(@class,"subject-meta")]/*[starts-with(.,"Категория")]'), ':')); + for v in XPath('//p[@class="elementList"]/span[starts-with(@class,"elem_genre")]') do + AddCommaString(genres, v.toString); + s := XPathString('//*[starts-with(@class,"subject-meta")]/*[starts-with(.,"Перевод")]'); + if s <> '' then begin + if Pos('продолжается', s) > 0 then status := '1' + else status := '0'; + end; + summary := XPathString('//*[@class="manga-description"]'); + for v in XPath('//table[@class="table table-hover"]/tbody/tr/td/a') do begin + chapterLinks.Add(v.toNode.getAttribute('href')); + s := CleanString(v.toString); + if OptionRemoveMangaNameFromChapter and (rname <> '') then + if Pos(rname, LowerCase(s)) = 1 then s := Trim(StringReplace(s, rname, '', [rfIgnoreCase])); + chapterName.Add(s); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + Source: TStringList; + i, j, x: Integer; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + s := AURL; + if Pos('mature=1', LowerCase(s)) = 0 then s += '?mature=1'; + if GET(FillHost(Module.RootURL, s)) then begin + Result := True; + Source := TStringList.Create; + try + Source.LoadFromStream(Document); + if Source.Count > 0 then begin + s := ''; + for i := 0 to Source.Count - 1 do + if Pos('rm_h.init(', Source[i]) > 0 then begin + s := Trim(Source[i]); + Break; + end; + if s <> '' then begin + s := GetBetween('[[', ']]', Source[i]); + s := StringReplace(s, '[', '', [rfReplaceAll]); + s := StringReplace(s, ']', '', [rfReplaceAll]); + s := StringReplace(s, '"', '', [rfReplaceAll]); + s := StringReplace(s, '''', '', [rfReplaceAll]); + Source.CommaText := s; + if (Source.Count > 0) and (frac(Source.Count / 5) = 0) then begin + j := Source.Count div 5; + for i := 0 to j - 1 do begin + x := i * 5; + PageLinks.Add(Source[x + 1] + Source[x] + Source[x + 2]); + end; + end; + end; + end; + finally + Source.Free; + end; + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := True; + if DownloadThread = nil then Exit; + DownloadThread.FHTTP.Headers.Values['Referer'] := ' ' + Module.RootURL; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL: String): TModuleContainer; + begin + Result := AddModule; + with Result do begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'Russian'; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnBeforeDownloadImage := @BeforeDownloadImage; + end; + end; + +begin + AddWebsiteModule('MintMangaRU', 'http://mintmanga.com'); + AddWebsiteModule('ReadMangaRU', 'http://readmanga.me'); + AddWebsiteModule('SelfMangaRU', 'http://selfmanga.ru'); +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/NewType.pas b/baseunits/modules/NewType.pas new file mode 100644 index 000000000..ab6406787 --- /dev/null +++ b/baseunits/modules/NewType.pas @@ -0,0 +1,140 @@ +unit NewType; + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr, Dialogs, fpjson, jsonparser; + +implementation + +const + dirurl = '/contents/'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//li[@class="OblongCard--border"]/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + // h3[@class="OblongCard-title"] + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s, n: String; + v: IXQValue; + last_eps, i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := AppendURLDelim(MaybeFillHost(Module.RootURL, AURL)); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//figure/img/@src')); + if title = '' then title := XPathString('//section[@class="WorkSummary"]/header/h1'); + summary := XPathString('//section[@id="workInfo"]/p'); + { there is no chapter list? + assuming the first chapter link in manga info is always the last chapters } + s := XPathString('//li[@class="ListCard"]/a[1]/@href'); + with TRegExpr.Create do + try + Expression := '^(.+?)(\d+)/?$'; + last_eps := StrToIntDef(Replace(s, '$2', True), 0); + s := Replace(s, '$1', True); + finally + Free; + end; + if (last_eps > 0) and (s <> '') then + for i := 1 to last_eps do + begin + n := Format('%.1d', [i]); + chapterLinks.Add(s + n); + chapterName.Add(n); + end; + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; + url,json_url,s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + url := AppendURLDelim(MaybeFillHost(Module.RootURL, AURL)); + if GET(url) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + + { Read Json } + json_url := XPathString('//div[@class="ViewerContainer"]/@data-url'); + + if GET(Module.RootURL + json_url) then + begin + with TXQueryEngineHTML.Create(Document) do + + s := XPathString('//*'); + if s <> '' then + begin + s := GetBetween('{', '}', s); + ParseHTML(s); + XPathStringAll('json(*)()', PageLinks); + end; + end; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'NewType'; + RootURL := 'https://comic.webnewtype.com'; + Category := 'Raw'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/NineManga.pas b/baseunits/modules/NineManga.pas new file mode 100644 index 000000000..8f938820c --- /dev/null +++ b/baseunits/modules/NineManga.pas @@ -0,0 +1,167 @@ +unit NineManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, RegExpr; + +implementation + +uses FMDVars; + +var + cookie: String; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + i, x: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + '/category/index_' + IncStr(AURL) + '.html') then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do try + i := 1; + for v in XPath('//ul[@class="pagelist"]/li') do begin + x := StrToIntDef(v.toString, 1); + if x > i then i := x; + end; + updateList.CurrentDirectoryPageNumber := i; + XPathHREFAll('//dl[@class="bookinfo"]//dd/a[@class="bookname"]', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; + + function GetWithWarning(var url: String; const MangaInfo: TMangaInformation): Boolean; + var + w: String; + begin + Result := False; + if MangaInfo.FHTTP.GET(url) then begin + w := XPathString('//script[contains(., ''is_warning = "1"'')]', MangaInfo.FHTTP.Document); + if (w = '') or (Pos('waring=1', url) > 0) then + Result := True + else begin + url += '?waring=1'; + Result := MangaInfo.FHTTP.GET(url); + end; + end; + end; + +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GetWithWarning(url, MangaInfo) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do try + coverLink := XPathString('//*[@class="bookface"]/img/@src'); + if title = '' then title := XPathString('//*[@class="manga"]/*[@class="ttline"]/h1/substring-before(.," Manga")'); + authors := XPathString('//ul[@class="message"]/li[starts-with(.,"Author")]/string-join(a,", ")'); + genres := XPathString('//ul[@class="message"]/li[starts-with(.,"Genre")]/string-join(a,", ")'); + status := MangaInfoStatusIfPos(XPathString('//ul[@class="message"]/li[starts-with(.,"Status")]')); + summary := Trim(XPathString('//*[@class="bookintro"]/p[starts-with(.,"Summary")]/substring-after(.,":")')); + XPathHREFAll('//*[@class="chapterbox"]//li/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + PageNumber := XPathCount('(//select[@id="page"])[1]/option', Document); + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + s, ref: String; +begin + Result := False; + if DownloadThread = nil then Exit; + + s := AURL; + s := ReplaceRegExpr('\.html?$', s, '', False); + if DownloadThread.WorkId = 0 then + ref := AURL + else + ref := s + '-' + IntToStr(DownloadThread.WorkId) + '.html'; + s := s + '-' + IncStr(DownloadThread.WorkId) + '.html'; + ref := MaybeFillHost(module.RootURL, ref); + + if cookie = '' then + begin + if DownloadThread.FHTTP.GET(Module.RootURL) then + cookie := DownloadThread.FHTTP.Cookies.Text; + end; + + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + Cookies.Text := cookie; + Headers.Values['Referer'] := ref; + if GET(MaybeFillHost(Module.RootURL, s)) then + begin + Result := True; + PageLinks[DownloadThread.WorkId] := XPathString('//img[contains(@class,"manga_pic")]/@src', Document); + end; + end; +end; + +procedure RegisterModule; + + function AddWebsiteModule(AWebsite, ARootURL, ACategory: String): TModuleContainer; + begin + Result := AddModule; + with Result do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := ACategory; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; + end; + +begin + AddWebsiteModule('NineManga', 'http://www.ninemanga.com', 'English'); + AddWebsiteModule('NineMangaES', 'http://es.ninemanga.com', 'Spanish'); + AddWebsiteModule('NineMangaRU', 'http://ru.ninemanga.com', 'Russian'); + AddWebsiteModule('NineMangaDE', 'http://de.ninemanga.com', 'German'); + AddWebsiteModule('NineMangaIT', 'http://it.ninemanga.com', 'Italian'); + AddWebsiteModule('NineMangaBR', 'http://br.ninemanga.com', 'Portugues'); +end; + +initialization + cookie := ''; + RegisterModule; + +end. diff --git a/baseunits/modules/PsychoPlay.pas b/baseunits/modules/PsychoPlay.pas new file mode 100644 index 000000000..f96f1d436 --- /dev/null +++ b/baseunits/modules/PsychoPlay.pas @@ -0,0 +1,128 @@ +unit PsychoPlay; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurl = '/series'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('(//ul[contains(@class,"pagination")]//a)[last()]/replace(@href,"^.*page=(\d+)\??.*$","$1")'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl + '?page=' + IncStr(AURL)) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//*[@class="row"]//*[@class="caption"]//a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//*[@class="profile-thumb"]/img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//div[@class="media-body"]/h2/text()'); + summary := XPathString('//h6[text()="Synopsis"]/following-sibling::p'); + while True do + begin + for v in XPath('//ul[contains(@class,"media-list")]/li/a') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(XPathString('.//h6/text()', v)); + end; + s := XPathString('//ul[contains(@class,"pagination")]/li[@class="next"]/a/@href'); + if s = '' then Break; + if GET(MaybeFillHost(Module.RootURL, s)) then + ParseHTML(Document) + else Break; + if ThreadTerminated then Break; + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//*[@class="content-wrapper"]/*[@class="row"]/img') do + PageLinks.Add(MaybeFillHost(Module.RootURL, v.toNode.getAttribute('src'))); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'PsychoPlay'; + RootURL := 'https://psychoplay.co'; + Category := 'English-Scanlation'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/RawSenManga.pas b/baseunits/modules/RawSenManga.pas new file mode 100644 index 000000000..5667aeb69 --- /dev/null +++ b/baseunits/modules/RawSenManga.pas @@ -0,0 +1,191 @@ +unit RawSenManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, RegExpr, synautil, URIParser; + +implementation + +var + cookie: String; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + '/directory/text_version') then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFAll('//table//tr/td[2]/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + cl, m: String; + cu: Boolean; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + m := RemoveHostFromURL(AURL); + m := RemoveURLDelim(m); + cl := ''; + with TRegExpr.Create do + try + Expression := '(.+)/.+/\d+?$'; + cu := Exec(m); + if cu then begin + cl := m; + m := Replace(m, '$1', True); + end; + finally + Free; + end; + m := AppendURLDelim(m); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + if cl <> '' then url := FillHost(Module.RootURL, cl) + else url := FillHost(Module.RootURL, m); + if GET(FillHost(Module.RootURL, m)) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//div[@class="thumbnail"]/img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//h1[@class="title"]'); + genres := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Categories")]/a'); + authors := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Author")]/a'); + artists := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Artist")]/a'); + status := MangaInfoStatusIfPos(XPathString('//ul[@class="series-info"]/li[contains(., "Status")]/a')); + summary := XPathString('//*[@itemprop="description"]'); + XPathHREFAll('//div[@class="title" and contains(., "Chapters")]/following-sibling::div/div/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + uri: TURI; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + s := RemoveURLDelim(ChapterLinks[CurrentDownloadChapterPtr]); + with TRegExpr.Create do + try + Expression := '(.+)/.+/\d+?$'; + if Exec(s) then begin + Expression := '/\d+$'; + s := Replace(s, '', False); + end; + ChapterLinks[CurrentDownloadChapterPtr] := s; + finally + Free; + end; + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, s + '/1')) then begin + Result := True; + cookie := Cookies.Text; + with TXQueryEngineHTML.Create(Document) do + try + PageNumber := XPath('//select[@name="page"]/option').Count; + if PageNumber > 0 then begin + s := MaybeFillHost(Module.RootURL, XPathString('//img[@id="picture"]/@src')); + uri := ParseURI(s); + if (Pos('/raw-viewer.php', LowerCase(uri.Path)) > 0) and (Pos('page=1', LowerCase(uri.Params)) > 0) then + while PageLinks.Count < PageNumber do begin + uri.Params := ReplaceString(uri.Params, 'page=1', 'page=' + IncStr(PageLinks.Count)); + PageLinks.Add(EncodeURI(uri)); + end + else if (Pos('/viewer/', LowerCase(uri.Path)) > 0) and (uri.Document = '1') then + while PageLinks.Count < PageNumber do begin + uri.Document := IncStr(PageLinks.Count); + PageLinks.Add(EncodeURI(uri)); + end; + end; + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + uri: TURI; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + uri := ParseURI(FillHost(Module.RootURL, AURL)); + uri.Document := IncStr(DownloadThread.WorkId); + if GET(EncodeURI(uri)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := MaybeFillHost(Module.RootURL, XPathString('//img[@id="picture"]/@src')); + if s <> '' then + PageLinks[DownloadThread.WorkId] := s; + finally + Free; + end; + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do + if CurrentDownloadChapterPtr < ChapterLinks.Count then begin + DownloadThread.FHTTP.Headers.Values['Referer'] := + ' ' + FillHost(Module.RootURL, ChapterLinks[CurrentDownloadChapterPtr]); + DownloadThread.FHTTP.Cookies.Text := cookie; + Result := True; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'RawSenManga'; + RootURL := 'http://raw.senmanga.com'; + Category := 'Raw'; + MaxTaskLimit := 1; + MaxConnectionLimit := 4; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + OnBeforeDownloadImage := @BeforeDownloadImage; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/ReadMangaToday.pas b/baseunits/modules/ReadMangaToday.pas new file mode 100644 index 000000000..0ce10d5af --- /dev/null +++ b/baseunits/modules/ReadMangaToday.pas @@ -0,0 +1,108 @@ +unit ReadMangaToday; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML; + +implementation + +const + dirurls = ' abcdefghijklmnopqrstuvwxyz'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NO_ERROR; + Page := Length(dirurls); +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + '/manga-list/' + dirurls[StrToIntDef(AURL, 0) + 1]) then + begin + Result := NO_ERROR; + XPathHREFAll('//*[@class="manga-item"]//a', MangaInfo.FHTTP.Document, ALinks, ANames); + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@class="panel-body"]//img/@src')); + if title = '' then title := XPathString('//h1'); + authors := XPathString('//li[.="Author"]/preceding-sibling::li'); + artists := XPathString('//li[.="Artist"]/preceding-sibling::li'); + genres := XPathString('//*[@class="dl-horizontal"]/dt[starts-with(.,"Categories")]/following-sibling::dd[1]/string-join(*,", ")'); + status := MangaInfoStatusIfPos(XPathString('//*[@class="dl-horizontal"]/dt[starts-with(.,"Status")]/following-sibling::dd[1]')); + summary := XPathString('//*[contains(@class,"movie-detail")]'); + for v in XPath('//ul[@class="chp_lst"]/li/a') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(XPathString('span[1]', v)); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + s := MaybeFillHost(Module.RootURL, AURL); + if Pos('/all-pages', LowerCase(s)) = 0 then + s := AppendURLDelim(s) + 'all-pages'; + if GET(s) then + begin + Result := True; + XPathStringAll('//*[contains(@class,"content-list")]//img/@src', Document, PageLinks); + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'ReadMangaToday'; + RootURL := 'https://www.readmng.com'; + Category := 'English'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/SenManga.pas b/baseunits/modules/SenManga.pas new file mode 100644 index 000000000..20f729130 --- /dev/null +++ b/baseunits/modules/SenManga.pas @@ -0,0 +1,197 @@ +unit SenManga; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, URIParser; + +implementation + +const + dirurl = '/directory'; + +var + cookie: String; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(SeparateRight( + XPathString('//*[@id="Navigation"]//ul/li[last()]/a/@href'), '/page/'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then + s += '/page/' + IncStr(AURL); + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//*[@id="search-results"]/*[contains(@class, "media_box")]/*[contains(@class, "media-body")]/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := RemoveURLDelim(FillHost(Module.RootURL, AURL)); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//div[@class="thumbnail"]/img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//h1[@class="title"]'); + genres := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Categories")]/a'); + authors := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Author")]/a'); + artists := XPathStringAll('//ul[@class="series-info"]/li[contains(., "Artist")]/a'); + status := MangaInfoStatusIfPos(XPathString('//ul[@class="series-info"]/li[contains(., "Status")]/a')); + summary := XPathString('//*[@itemprop="description"]'); + XPathHREFAll('//div[@class="title" and contains(., "Chapters")]/following-sibling::div/div/a', chapterLinks, chapterName); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + uri: TURI; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(RemoveURLDelim(FillHost(Module.RootURL, AURL))) then + begin + Result := True; + cookie := Cookies.Text; + with TXQueryEngineHTML.Create(Document) do + try + PageNumber := XPath('//select[@name="page"]/option').Count; + if PageNumber > 0 then begin + s := MaybeFillHost(Module.RootURL, XPathString('//img[@id="picture"]/@src')); + uri := ParseURI(s); + if (Pos('/raw-viewer.php', LowerCase(uri.Path)) > 0) and (Pos('page=1', LowerCase(uri.Params)) > 0) then + while PageLinks.Count < PageNumber do begin + uri.Params := ReplaceString(uri.Params, 'page=1', 'page=' + IncStr(PageLinks.Count)); + PageLinks.Add(EncodeURI(uri)); + end + else if (Pos('/viewer/', LowerCase(uri.Path)) > 0) and (uri.Document = '1') then + while PageLinks.Count < PageNumber do begin + uri.Document := IncStr(PageLinks.Count); + PageLinks.Add(EncodeURI(uri)); + end; + end; + finally + Free; + end; + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do + if CurrentDownloadChapterPtr < ChapterLinks.Count then begin + DownloadThread.FHTTP.Headers.Values['Referer'] := + ' ' + FillHost(Module.RootURL, ChapterLinks[CurrentDownloadChapterPtr]); + DownloadThread.FHTTP.Cookies.Text := cookie; + Result := True; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + s: String; + uri: TURI; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + uri := ParseURI(FillHost(Module.RootURL, AURL)); + uri.Document := IncStr(DownloadThread.WorkId); + if GET(EncodeURI(uri)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + s := MaybeFillHost(Module.RootURL, XPathString('//img[@id="picture"]/@src')); + if s <> '' then + PageLinks[DownloadThread.WorkId] := s; + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'SenManga'; + RootURL := 'http://www.senmanga.com'; + Category := 'English'; + MaxTaskLimit := 1; + MaxConnectionLimit := 4; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnBeforeDownloadImage := @BeforeDownloadImage; + OnGetImageURL := @GetImageURL; + end; +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/Shogakukan.pas b/baseunits/modules/Shogakukan.pas new file mode 100644 index 000000000..0f26916e9 --- /dev/null +++ b/baseunits/modules/Shogakukan.pas @@ -0,0 +1,98 @@ +unit Shogakukan; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML; + +implementation + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do try + coverLink := XPathString('//meta[@property="og:image"]/@content'); + if title = '' then title := XPathString('//title/substring-before(.," | ")'); + chapterLinks.Add(url); + chapterName.Add(title); + finally + Free; + end; + end; + end; +end; + + +function TaskStart(const Task: TTaskContainer; const Module: TModuleContainer): Boolean; +begin + Result := True; + if Task = nil then Exit; + Task.PageLinks.Clear; + Task.PageLinks.Clear; + Task.PageNumber := 0; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do try + XPathStringAll('//*[@id="book_data_area"]/input[@data-key="imageCodes"]/@value', PageLinks); + PageContainerLinks.Add(XPathString('//*[@id="book_data_area"]/input[@data-key="isbn"]/@value')); + PageContainerLinks.Add(XPathString('//*[@id="book_data_area"]/input[@data-key="vsid"]/@value')); + finally + Free; + end; + end; + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread, DownloadThread.FHTTP, DownloadThread.Task.Container do begin + if WorkId = 0 then + Headers.Add('Referer: ' + Module.RootURL + '/' + PageContainerLinks[1]) + else + Headers.Add('Referer: ' + Module.RootURL + '/' + PageContainerLinks[1] + '?page=' + IntToStr(WorkId)); + if POST(Module.RootURL + '/imgDeliver?gcode=' + PageContainerLinks[0], + 'base64=1&vsid=' + PageContainerLinks[1] + '&trgCode=' + PageLinks[WorkId]) then + Result := Base64Decode(Document); + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Shogakukan'; + RootURL := 'https://shogakukan.tameshiyo.me'; + OnGetInfo := @GetInfo; + OnTaskStart := @TaskStart; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/SundayWebEvery.pas b/baseunits/modules/SundayWebEvery.pas new file mode 100644 index 000000000..ccb0ce25b --- /dev/null +++ b/baseunits/modules/SundayWebEvery.pas @@ -0,0 +1,159 @@ +unit SundayWebEvery; + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr, Dialogs; + +implementation + +const + dirurl = '/comics/'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[@class="manga-list__list"]/li/h4/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s, n: String; + last_eps, i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := AppendURLDelim(MaybeFillHost(Module.RootURL, AURL)); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@id="mainvisual"]/img/@src')); + if title = '' then title := XPathString('//*[@class="title"]/h1'); + summary := XPathString('//*[@class="title"]/h2'); + { there is no chapter list? + assuming the first chapter link in manga info is always the last chapters } + s := XPathString('//article/a[1]/@href'); + with TRegExpr.Create do + try + Expression := '^(.+?)(\d+)/?$'; + last_eps := StrToIntDef(Replace(s, '$2', True), 0); + s := Replace(s, '$1', True); + finally + Free; + end; + if (last_eps > 0) and (s <> '') then + for i := 1 to last_eps do + begin + n := Format('%.3d', [i]); + chapterLinks.Add(s + n); + chapterName.Add(n); + end; + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + source: TStringList; + i, j, bi, bv: Integer; + key: String; + v, x: IXQValue; + data: IXQValue; + regx: TRegExpr; + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(AppendURLDelim(MaybeFillHost(Module.RootURL, AURL))) then + begin + Result := True; + key := ''; + regx := TRegExpr.Create; + source := TStringList.Create; + try + source.LoadFromStream(Document); + if source.Count > 0 then + for i := 0 to source.Count - 1 do + begin + if Pos('key: ', source[i]) <> 0 then + begin + regx.Expression := '^.*["''](.+)["''].*$'; + key := regx.Replace(source[i], '$1', True); + Break; + end; + end; + finally + source.Free; + end; + if key <> '' then + begin + key := Module.RootURL + '/assets/episodes/' + key + '/'; + if GET(key + 'episode.json') then + begin + with TXQueryEngineHTML.Create(Document) do + + { h1536, h128, h1024 ++ the available res is varie for every page/image, some only had h1024 ++ try to get the biggest available } + + + for data in XPath('json(*).pages()/files/h1536.jpeg') do + PageLinks.Add(key + data.toString); + + + + end; + end; + regx.Free; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'SundayWebEvery'; + RootURL := 'https://www.sunday-webry.com'; + Category := 'Raw'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Taadd.pas b/baseunits/modules/Taadd.pas new file mode 100644 index 000000000..257942db4 --- /dev/null +++ b/baseunits/modules/Taadd.pas @@ -0,0 +1,124 @@ +unit Taadd; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML; + +implementation + +uses FMDVars; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + s: String; + v: IXQValue; + i, x: Integer; +begin + Result := NET_PROBLEM; + if Module.CurrentDirectoryIndex = 0 then + s := '0-9' + else + s := ALPHA_LIST_UP[Module.CurrentDirectoryIndex + 1]; + if MangaInfo.FHTTP.GET(Module.RootURL + '/category/' + s + '_views_'+ IncStr(AURL) + '.html') then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do try + i := 1; + for v in XPath('//*[@class="clistChr"]//span[@class="pagetor"]//text()') do begin + x := StrToIntDef(v.toString, 1); + if x > i then i := x; + end; + updateList.CurrentDirectoryPageNumber := i; + XPathHREFtitleAll('//*[@class="clistChr"]/ul/li/div/h2/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + s := url; + if Pos('waring=1', s) = 0 then s += '?waring=1'; + if GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do try + coverLink := XPathString('//table//td/a/img/@src'); + if title = '' then title := XPathString('//title/substring-before(.," - Read ")'); + authors := XPathString('//table//table//td[starts-with(.,"Author:")]/string-join(./a,", ")'); + genres := XPathString('//table//table//td[starts-with(.,"Categories:")]/string-join(./a,", ")'); + status := MangaInfoStatusIfPos(XPathString('//table//table//td[starts-with(.,"Status:")]/a'),'Updated','Completed'); + summary := XPathString('//table//table//td[contains(.," Manga Summary ")]/substring-after(.,"Manga Summary ")'); + XPathHREFAll('//*[@class="chapter_list"]/table//tr/td[1]/a', chapterLinks, chapterName); + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + PageNumber := StrToIntDef(XPathString('//select[@id="page"]/count(./option)', Document),0); + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + if GET(AppendURLDelim(MaybeFillHost(Module.RootURL, AURL)) + 'page-' + IncStr(DownloadThread.WorkId)) then + begin + Result := True; + PageLinks[DownloadThread.WorkId] := XPathString('//img[@id="comicpic"]/@src', Document); + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Taadd'; + RootURL := 'http://www.taadd.com'; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + TotalDirectory := Length(ALPHA_LIST_UP); + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Tapas.pas b/baseunits/modules/Tapas.pas new file mode 100644 index 000000000..c6d80935c --- /dev/null +++ b/baseunits/modules/Tapas.pas @@ -0,0 +1,154 @@ +unit Tapas; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, RegExpr; + +implementation + +const + dirurl = '/comics?sortType=TITLE&browse=ALL'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; var Page: Integer; const WorkPtr: Integer; + const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('//div[@class="global-pagination-wrap"]/a[last()-1]'), 1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; const ANames, ALinks: TStringList; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL + dirurl; + if AURL <> '0' then + s := s + '&pageNumber=' + IncStr(AURL); + if MangaInfo.FHTTP.GET(s) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[contains(@class,"content-list-wrap")]//li//a[@class="preferred title"]') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + locked: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(FillHost(Module.RootURL, AURL)) then begin + Result := NO_ERROR; + with MangaInfo.mangaInfo, TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + coverLink := XPathString('//a[@id="series-thumb"]/img/@src'); + if coverLink = '' then coverLink := XPathString('//script[contains(.,"has-thumb")]/substring-before(substring-after(.,"src="""),"""")'); + if title = '' then title := XPathString('//a[@class="series-header-title"]/text()'); + genres := XPathString('//div[@class="tags"]/string-join(./*,", ")'); + authors := XPathString('//a[@class="name"]/span/text()'); + summary := XPathString('//span[@id="series-desc-body"]'); + while Pos(' ', summary) <> 0 do + summary := StringReplace(summary, ' ', ' ', [rfReplaceAll]); + for v in XPath('json(//script[contains(.,"var _data")]/concat(substring-before(substring-after(.,"episodeList :"),"]"),"]"))()') do + begin + chapterLinks.Add(Module.RootURL + '/episode/' + XPathString('./id', v)); + locked := ''; + if XPathString('./locked', v) = 'true' then locked := ' [locked]'; + chapterName.Add(XPathString('./title', v) + locked); + end; + finally + Free; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + with TRegExpr.Create do + try + Expression := '[\?\&]type=q\d+'; + for v in XPath('//img[@class="art-image"]/@src') do + PageLinks.Add(Replace(v.toString, '', False)); + finally + Free; + end; + finally + Free; + end; + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do + if CurrentDownloadChapterPtr < ChapterLinks.Count then begin + DownloadThread.FHTTP.Headers.Values['Referer'] := + ' ' + FillHost(Module.RootURL, ChapterLinks[CurrentDownloadChapterPtr]); + Result := True; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Tapas'; + RootURL := 'https://tapas.io'; + Category := 'Webcomics'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnBeforeDownloadImage := @BeforeDownloadImage; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/TonariNoYoungJump.pas b/baseunits/modules/TonariNoYoungJump.pas new file mode 100644 index 000000000..7d7821608 --- /dev/null +++ b/baseunits/modules/TonariNoYoungJump.pas @@ -0,0 +1,164 @@ +unit TonariNoYoungJump; + +interface + +implementation + +uses Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, Math, synautil, ImagePuzzle; + +const + chapterListQuery = '/api/viewer/readable_products?current_readable_product_id=%s&number_since=%d&number_until=-1&read_more_num=50&type=episode'; + dirurls: array[0..2] of String = ('/series', '/series/finished', '/series/oneshot'); + +var + puzzle: TImagePuzzle; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurls[Module.CurrentDirectoryIndex]) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//div[@class="series-items"]/ul/li/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(XPathString('h4', v)); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + lastChapter: Integer; + s, episode, priv: String; + node: TTreeNode; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//div[@class="series-header-image-wrapper"]/img/@src')); + if title = '' then title := XPathString('//h1[@class="series-header-title"]'); + authors := XPathString('//h2[@class="series-header-author"]'); + summary := XPathString('//*[@class="series-header-description"]'); + lastChapter := XPathCount('//ul[contains(@class, "series-episode-list")]/li') + 1; + s := XPathString('//button[@class="js-read-more-button"]/@data-read-more-endpoint'); + if s <> '' then begin + s := RegExprGetMatch('number_since\=(\d+)\&', s, 1); + lastChapter += StrToIntDef(s, 0); + end; + episode := RegExprGetMatch('episode\/(\d+)', AURL, 1); + finally + Free; + end; + + while lastChapter > 1 do begin + if not GET(Module.RootURL + Format(chapterListQuery, [episode, lastChapter])) then Break; + if MangaInfo.Thread.IsTerminated then Break; + with TXQueryEngineHTML.Create(Document) do + try + node := XPath('json(*).html').toNode; + for v in XPath('//li', node) do begin + priv := ''; + if Pos('private', v.toNode.outerHTML()) > 0 then + priv := ' [private]'; + s := XPathString('a/@href', v); + if s <> '' then begin + chapterLinks.Add(ReplaceString(s, '\"', '')); + chapterName.Add(XPathString('a/div/h4', v) + priv); + end + else begin + chapterLinks.Add(url); + chapterName.Add(XPathString('div/h4', v) + priv); + end; + end; + finally + Free; + end; + lastChapter -= 50; + end; + InvertStrings([chapterLinks, chapterName]); + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + XPathStringAll('//img[contains(@class, "js-page-image")]/@data-src', Document, PageLinks); + end; + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + if DownloadThread.FHTTP.GET(AURL) then begin + puzzle.DeScramble(DownloadThread.FHTTP.Document, DownloadThread.FHTTP.Document); + Result := True; + end; +end; + +procedure CreateImagePuzzle; +const + DIVIDE_NUM = 4; +var + i: Integer; +begin + puzzle := TImagePuzzle.Create(DIVIDE_NUM, DIVIDE_NUM); + puzzle.Multiply := 8; + for i := 0 to DIVIDE_NUM * DIVIDE_NUM - 1 do + puzzle.Matrix[i] := (i mod DIVIDE_NUM) * DIVIDE_NUM + trunc(float(i) / DIVIDE_NUM); +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'TonarinoYoungJump'; + RootURL := 'https://tonarinoyj.jp'; + Category := 'Raw'; + TotalDirectory := Length(dirurls); + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + end; +end; + +initialization + CreateImagePuzzle; + RegisterModule; + +finalization + puzzle.Free; + +end. diff --git a/baseunits/modules/TranslateWebtoon.pas b/baseunits/modules/TranslateWebtoon.pas new file mode 100644 index 000000000..bc58f6b48 --- /dev/null +++ b/baseunits/modules/TranslateWebtoon.pas @@ -0,0 +1,170 @@ +unit TranslateWebtoon; + +interface + +implementation + +uses Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, synautil, RegExpr, Graphics, Interfaces; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + rate, nextpage: Integer; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := ReplaceRegExpr('&page=\d+', MaybeFillHost(Module.RootURL, AURL), '', False); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//meta[@property="og:image"]/@content'); + if title = '' then + title := XPathString('//h3[@class="subj"]') + ' [' + + XPathString('//div[@class="info"]/p[contains(@class, "flag")]') + ']'; + authors := XPathString('//span[@class="author"]'); + while True do + begin + for v in XPath('//div[@class="detail_lst"]/ul/li/a') do + begin + s := XPathString('./span[@class="rate"]/em', v); + s := RegExprGetMatch('(\d+)', s, 1); + rate := StrToIntDef(s, 0); + if rate >= 100 then + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(XPathString('./span[@class="subj"]', v)); + end; + end; + if ThreadTerminated then Break; + s := XPathString('//div[@class="paginate"]/a[contains(@class, "epipage")]/following-sibling::a[1]/@href'); + s := RegExprGetMatch('page=(\d+)', s, 1); + nextpage := StrToIntDef(s, 0); + if nextpage = 0 then Break; + if not GET(Format('%s&page=%d', [url, nextpage])) then Break; + ParseHTML(Document); + end; + finally + Free; + end; + InvertStrings([chapterLinks, chapterName]); + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v, w: IXQValue; + s: String; + tmp: TStringList; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + tmp := TStringList.Create; + try + for v in XPath('//div[@class="viewer_img"]/ul/li/div[@class="img_info"]') do + begin + tmp.Clear; + for w in XPath('span[@class="ly_img_text"]', v) do + begin + tmp.Add(XPathString('img/@src', w)); + tmp.Add(w.toNode.getAttribute('style')); + end; + PageContainerLinks.Add(tmp.Text); + PageLinks.Add(XPathString('img/@src', v)); + end; + // FIXME: PageContainerLinks.Count shouldn't be equal to PageNumber + PageContainerLinks.Add('$$$'); + finally + tmp.Free; + end; + finally + Free; + end; + end; + end; +end; + +function DownloadImage(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + back, text: TPicture; + tmp: TStringList; + i, left, top: Integer; + src, dst: TRect; + ext: String = 'jpg'; +begin + i := 0; + Result := False; + if DownloadThread = nil then Exit; + if DownloadThread.FHTTP.GET(AURL) then + begin + back := TPicture.Create; + tmp := TStringList.Create; + try + back.LoadFromStream(DownloadThread.FHTTP.Document); + if back.Graphic is TPortableNetworkGraphic then ext := 'png'; + tmp.Text := DownloadThread.Task.Container.PageContainerLinks[DownloadThread.WorkId]; + while i < tmp.Count-1 do + begin + if DownloadThread.FHTTP.GET(tmp[i]) then + begin + text := TPicture.Create; + try + text.LoadFromStream(DownloadThread.FHTTP.Document); + src := Rect(0, 0, text.Width, text.Height); + left := StrToIntDef(RegExprGetMatch('left\s*:\s*(\d+)', tmp[i+1], 1), 0); + top := StrToIntDef(RegExprGetMatch('top\s*:\s*(\d+)', tmp[i+1], 1), 0); + dst := Rect(left, top, left + text.Width, top + text.Height); + back.Bitmap.Canvas.CopyRect(dst, text.Bitmap.Canvas, src); + finally + text.Free; + end; + end; + i := i + 2; + if DownloadThread.CheckTerminated then Break; + end; + DownloadThread.FHTTP.Document.Position := 0; + DownloadThread.FHTTP.Document.Size := 0; + back.SaveToStreamWithFileExt(DownloadThread.FHTTP.Document, ext); + finally + back.Free; + tmp.Free; + end; + Result := True; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'TranslateWebtoon'; + RootURL := 'https://translate.webtoons.com'; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnDownloadImage := @DownloadImage; + end; +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/Tsumino.pas b/baseunits/modules/Tsumino.pas new file mode 100644 index 000000000..ea37826f8 --- /dev/null +++ b/baseunits/modules/Tsumino.pas @@ -0,0 +1,128 @@ +unit Tsumino; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil,synacode, RegExpr; + +implementation + +const + dirurl = '/Books/Operate'; + dirurldata = 'PageNumber='; + dirurldataend = '&Text=&Sort=Newest&List=0&Length=0&MinimumRating=0&ExcludeList=0&CompletelyExcludeHated=false'; + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.POST(Module.RootURL + dirurl, dirurldata + '1' + dirurldataend) then + begin + Result := NO_ERROR; + Page := StrToIntDef(XPathString('json(*)("PageCount")', MangaInfo.FHTTP.Document), 1); + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.POST(Module.RootURL + dirurl, + dirurldata + IncStr(AURL) + dirurldataend) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('json(*)("Data")().Entry') do begin + ANames.Add(v.getProperty('Title').toString()); + ALinks.Add(Module.RootURL + '/Book/Info/' + v.getProperty('Id').toString()); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + url := FillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//img[@class="book-page-image img-responsive"]/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString( + '//div[@class="book-line"][starts-with(.,"Title")]/div[@class="book-data"]'); + artists := XPathString('//div[@class="book-line"][starts-with(.,"Artist")]/div[@class="book-data"]'); + genres := XPathStringAll( + '//div[@class="book-line"][starts-with(.,"Parody") or starts-with(.,"Characters") or starts-with(.,"Tags")]/div[@class="book-data"]/*'); + if title <> '' then begin + chapterLinks.Add(url); + chapterName.Add(title); + end; + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + bookid: String; + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + bookid := RegExprGetMatch('(?i)/info/(\d+)/?',AURL,1); + Headers.Values['Referer'] := ' ' + Module.RootURL + '/Read/View/' + bookid; + if POST(Module.RootURL + '/Read/Load', 'q=' + bookid) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('json(*).reader_page_urls()') do + PageLinks.Add(Module.RootURL + '/Image/Object?name=' + EncodeURLElement(v.toString)); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Tsumino'; + RootURL := 'http://www.tsumino.com'; + Category := 'H-Sites'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + SortedList := True; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/WPAdultSiteSkins.pas b/baseunits/modules/WPAdultSiteSkins.pas new file mode 100644 index 000000000..c1c5ad894 --- /dev/null +++ b/baseunits/modules/WPAdultSiteSkins.pas @@ -0,0 +1,163 @@ +unit WPAdultSiteSkins; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, ImageHoster; + +implementation + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := 1; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + Page := StrToIntDef(XPathString('//div[@class="paginator"]/span[starts-with(.,"Page") and contains(.," of ")]/normalize-space(substring-after(.," of "))'),1); + finally + Free; + end; + end; +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + s := Module.RootURL; + if AURL <> '0' then + s += '/page/' + IncStr(AURL); + if MangaInfo.FHTTP.GET(s) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + XPathHREFtitleAll('//div[@class="posts"]/div[starts-with(@id,"post-")]/a', ALinks, ANames); + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := MaybeFillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//div[@class="single-post"]//img[starts-with(@class,"attachment-") and not(@data-lazy-src)]/@src'); + if coverLink = '' then coverLink := XPathString('//div[@class="single-post"]/p//img[not(@data-lazy-src)]/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//div[@class="posts"]/h2[@class="post-title"][1]'); + chapterLinks.Add(url); + chapterName.Add(title); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(MaybeFillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + XPathStringAll('//div[@class="single-post"]//dl[@class="gallery-item"]/dt/a/@href', PageContainerLinks); + XPathStringAll('//div[@class="single-post"]/p//a[./img[not(data-lazy-src)]]/@href', PageContainerLinks); + if PageContainerLinks.Count = 0 then + for v in XPath('//div[@class="single-post"]/p//img[not(@data-lazy-src)]/@src') do + PageLinks.Add(MaybeFillHost(Module.RootURL, v.toString)) + else + PageNumber := PageContainerLinks.Count; + finally + Free; + end; + end; + end; +end; + +function GetImageURL(const DownloadThread: TDownloadThread; const AURL: String; + const Module: TModuleContainer): Boolean; +var + s: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container, DownloadThread.FHTTP do begin + if DownloadThread.WorkId >= PageContainerLinks.Count then Exit; + s := ImageHoster.GetImageHoster(DownloadThread.FHTTP, MaybeFillHost(Module.RootURL, PageContainerLinks[DownloadThread.WorkId])); + if s = '' then + if GET(MaybeFillHost(Module.RootURL, PageContainerLinks[DownloadThread.WorkId])) then + begin + with TXQueryEngineHTML.Create(Document) do + try + s := MaybeFillHost(Module.RootURL, XPathString('//div[@class="attachment-image"]//img/@src')); + finally + Free; + end; + end; + if s <> '' then + begin + Result := True; + PageLinks[DownloadThread.WorkId] := s; + end; + end; + +end; + +procedure RegisterModule; + function AddWebsiteModule(const AWebsite, ARootURL: String): TModuleContainer; + begin + Result := AddModule; + with Result do + begin + Website := AWebsite; + RootURL := ARootURL; + Category := 'Adult'; + SortedList := True; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnGetImageURL := @GetImageURL; + end; + end; +begin + AddWebsiteModule('PornComix', 'http://www.porncomix.info'); +end; + +initialization + RegisterModule; + +end. + diff --git a/baseunits/modules/WebtoonTr.pas b/baseunits/modules/WebtoonTr.pas new file mode 100644 index 000000000..ecee03911 --- /dev/null +++ b/baseunits/modules/WebtoonTr.pas @@ -0,0 +1,131 @@ +unit WebtoonTr; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil; + +implementation + +const + dirurls: array[0..2] of String = ( + '/webtoon-listesi', + '/manga-listesi', + '/ero-listesi' + ); + +function GetDirectoryPageNumber(const MangaInfo: TMangaInformation; + var Page: Integer; const WorkPtr: Integer; const Module: TModuleContainer): Integer; +begin + Result := NET_PROBLEM; + Page := Length(dirurls); +end; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurls[StrToIntDef(AURL, 0)]) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[@class="list-inline"]/li/div/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + v: IXQValue; + s: String; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do + begin + url := FillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := XPathString('//div[@class="tanitim"]//img/@src'); + if coverLink <> '' then coverLink := MaybeFillHost(Module.RootURL, coverLink); + if title = '' then title := XPathString('//ul[@class="list-group tanitimdet"]/li[1]'); + s := XPathString('//ul[@class="list-group tanitimdet"]/li[3]'); + if Pos('Devam Ediyor', s) > 0 then + status := '1' + else if Pos('Tamamlandı', s) > 0 then + status := '0'; + authors := SeparateRight(XPathString('//ul[@class="list-group tanitimdet"]/li[5]'), ': '); + summary := XPathString('//ul[@class="list-group tanitimdet"]/li[7]/text'); + for v in XPath('//table[@class="table table-striped table-bordered"]/tbody/tr/td/a') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(v.toString); + end; + InvertStrings([chapterLinks, chapterName]); + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//div[@class="images"]/img') do + PageLinks.Add(v.toNode.getAttribute('src')); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'WebtoonTr'; + RootURL := 'http://webtoontr.com'; + Category := 'Turkish'; + OnGetDirectoryPageNumber := @GetDirectoryPageNumber; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/Webtoons.pas b/baseunits/modules/Webtoons.pas new file mode 100644 index 000000000..1678519d0 --- /dev/null +++ b/baseunits/modules/Webtoons.pas @@ -0,0 +1,157 @@ +unit Webtoons; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr; + +implementation + +const + dirurl = '/en/genre'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[@class="card_lst"]/li/a') do begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(XPathString('div/p[@class="subj"]', v.toNode)); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + query: TXQueryEngineHTML; + p, i: Integer; + + procedure getchapters; + var + v: IXQValue; + begin + for v in query.XPath('//ul[@id="_listUl"]/li/a') do begin + MangaInfo.mangaInfo.chapterLinks.Add(v.toNode.getAttribute('href')); + MangaInfo.mangaInfo.chapterName.Add(query.XPathString('span[@class="subj"]/span', v.toNode)); + end; + end; + + procedure getp; + begin + p := StrToIntDef(SeparateRight( + query.XPathString('//div[@class="detail_lst"]/div[@class="paginate"]/a[last()]/@href'), '&page='), 1); + end; + +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.FHTTP, MangaInfo.mangaInfo do begin + url := FillHost(Module.RootURL, AURL); + if GET(url) then begin + Result := NO_ERROR; + query := TXQueryEngineHTML.Create(Document); + with query do + try + coverLink := XPathString('//meta[@name="twitter:image"]/@content'); + if title = '' then title := XPathString('//div[@class="info"]/h1/text()'); + authors := XPathString('//div[@class="info"]/a/text()'); + genres := XPathString('//div[@class="info"]/h2'); + summary := XPathString('//p[@class="summary"]'); + getchapters; + getp; + if p > 1 then begin + i := 2; + while (i <= p) and (Thread.IsTerminated = False) do begin + if GET(url + '&page=' + IntToStr(i)) then begin + ParseHTML(Document); + getchapters; + getp; + end; + Inc(i); + end; + end; + InvertStrings([chapterLinks, chapterName]); + Reset; + Headers.Values['Referer'] := ' ' + url; + finally + query.Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do begin + PageLinks.Clear; + PageNumber := 0; + if GET(FillHost(Module.RootURL, AURL)) then begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + with TRegExpr.Create do + try + Expression := '[\?\&]type=q\d+'; + for v in XPath('//div[@id="_imageList"]/img[@class="_images"]/@data-url') do + PageLinks.Add(Replace(v.toString, '', False)); + finally + Free; + end; + finally + Free; + end; + end; + end; +end; + +function BeforeDownloadImage(const DownloadThread: TDownloadThread; + var AURL: String; const Module: TModuleContainer): Boolean; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.Task.Container do + if CurrentDownloadChapterPtr < ChapterLinks.Count then begin + DownloadThread.FHTTP.Headers.Values['Referer'] := + ' ' + FillHost(Module.RootURL, ChapterLinks[CurrentDownloadChapterPtr]); + Result := True; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'Webtoons'; + RootURL := 'http://www.webtoons.com'; + Category := 'English'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + OnBeforeDownloadImage := @BeforeDownloadImage; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/modules/YoungAceUp.pas b/baseunits/modules/YoungAceUp.pas new file mode 100644 index 000000000..33d335c24 --- /dev/null +++ b/baseunits/modules/YoungAceUp.pas @@ -0,0 +1,114 @@ +unit YoungAceUp; + +interface + +uses + Classes, SysUtils, WebsiteModules, uData, uBaseUnit, uDownloadsManager, + XQueryEngineHTML, httpsendthread, synautil, RegExpr, Dialogs; + +implementation + +const + dirurl = '/comics/'; + +function GetNameAndLink(const MangaInfo: TMangaInformation; + const ANames, ALinks: TStringList; const AURL: String; + const Module: TModuleContainer): Integer; +var + v: IXQValue; +begin + Result := NET_PROBLEM; + if MangaInfo.FHTTP.GET(Module.RootURL + dirurl) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(MangaInfo.FHTTP.Document) do + try + for v in XPath('//ul[@class="manga-list__list"]/li/h4/a') do + begin + ALinks.Add(v.toNode.getAttribute('href')); + ANames.Add(v.toString); + end; + finally + Free; + end; + end; +end; + +function GetInfo(const MangaInfo: TMangaInformation; + const AURL: String; const Module: TModuleContainer): Integer; +var + s, n: String; + v: IXQValue; + i: Integer; +begin + Result := NET_PROBLEM; + if MangaInfo = nil then Exit(UNKNOWN_ERROR); + with MangaInfo.mangaInfo, MangaInfo.FHTTP do + begin + url := AppendURLDelim(MaybeFillHost(Module.RootURL, AURL)); + if GET(url) then + begin + Result := NO_ERROR; + with TXQueryEngineHTML.Create(Document) do + try + coverLink := MaybeFillHost(Module.RootURL, XPathString('//*[@class="fancybox a-alpha"]/img/@src')); + if title = '' then title := XPathString('//strong'); + summary := XPathString('//*[@class="single-story"]/p'); + { there is no chapter list? + assuming the first chapter link in manga info is always the last chapters } + for v in XPath('//a[@class="single"]') do + begin + chapterLinks.Add(v.toNode.getAttribute('href')); + chapterName.Add(v.toString); + end + finally + Free; + end; + end; + end; +end; + +function GetPageNumber(const DownloadThread: TDownloadThread; + const AURL: String; const Module: TModuleContainer): Boolean; +var + v: IXQValue; + ViewerURL: String; +begin + Result := False; + if DownloadThread = nil then Exit; + with DownloadThread.FHTTP, DownloadThread.Task.Container do + begin + PageLinks.Clear; + PageNumber := 0; + ViewerURL := 'http://viewer.tonarinoyj.jp'; + if GET(FillHost(ViewerURL, AURL)) then + begin + Result := True; + with TXQueryEngineHTML.Create(Document) do + try + for v in XPath('//img[@class="js-page-image"]') do + PageLinks.Add(v.toNode.getAttribute('src')); + finally + Free; + end; + end; + end; +end; + +procedure RegisterModule; +begin + with AddModule do + begin + Website := 'YoungAceUp'; + RootURL := 'https://web-ace.jp/youngaceup'; + Category := 'Raw'; + OnGetNameAndLink := @GetNameAndLink; + OnGetInfo := @GetInfo; + OnGetPageNumber := @GetPageNumber; + end; +end; + +initialization + RegisterModule; + +end. diff --git a/baseunits/uBaseUnit.pas b/baseunits/uBaseUnit.pas index 3aac76203..eb7120eaa 100644 --- a/baseunits/uBaseUnit.pas +++ b/baseunits/uBaseUnit.pas @@ -6,7 +6,7 @@ unit uBaseUnit; -{$mode delphi} +{$mode objfpc}{$H+} {$MACRO ON} {$DEFINE DOWNLOADER} @@ -14,37 +14,24 @@ interface uses {$ifdef windows} - ShellApi, windows, + Windows, {$else} UTF8Process, {$endif} - SysUtils, Classes, Graphics, Forms, lazutf8classes, LazUTF8, strutils, - fileinfo, fpjson, jsonparser, FastHTMLParser, fgl, FileUtil, RegExpr, - synautil, httpsend, blcksock, ssl_openssl, GZIPUtils, uFMDThread, uMisc, - USimpleException, USimpleLogger; - -Type - TFMDDo = (DO_NOTHING, DO_EXIT, DO_POWEROFF, DO_HIBERNATE, DO_UPDATE); + SysUtils, Classes, Graphics, lazutf8classes, LazFileUtils, LConvEncoding, LazUtils, + strutils, dateutils, variants, base64, fpjson, jsonparser, jsonscanner, + fgl, RegExpr, synautil, httpsend, blcksock, ssl_openssl, + synacode, MultiLog, FPimage, GZIPUtils, uMisc, httpsendthread, FMDOptions, + simplehtmltreeparser, xquery, xquery_json, ImgInfos, NaturalSortUnit, + MemBitmap, FPWritePNG, zstream, FPReadPNG, VirtualTrees; const - FMD_REVISION = '$WCREV$'; - FMD_INSTANCE = '_FreeMangaDownloaderInstance_'; - - FMD_TARGETOS = {$i %FPCTARGETOS%}; - FMD_TARGETCPU = {$i %FPCTARGETCPU%}; - - JPG_HEADER: array[0..2] of Byte = ($FF, $D8, $FF); - GIF_HEADER: array[0..2] of Byte = ($47, $49, $46); - PNG_HEADER: array[0..2] of Byte = ($89, $50, $4E); + LineEnding2 = LineEnding + LineEnding; UTF8BOM = #$EF#$BB#$BF; - EXPARAM_PATH = '%PATH%'; - EXPARAM_CHAPTER = '%CHAPTER%'; - DEFAULT_EXPARAM = '"' + EXPARAM_PATH + EXPARAM_CHAPTER + '"'; - - DATA_PARAM_NAME = 0; - DATA_PARAM_LINK = 1; + DATA_PARAM_LINK = 0; + DATA_PARAM_TITLE = 1; DATA_PARAM_AUTHORS = 2; DATA_PARAM_ARTISTS = 3; DATA_PARAM_GENRES = 4; @@ -52,7 +39,6 @@ interface DATA_PARAM_SUMMARY = 6; DATA_PARAM_NUMCHAPTER = 7; DATA_PARAM_JDN = 8; - DATA_PARAM_READ = 9; FILTER_HIDE = 0; FILTER_SHOW = 1; @@ -69,10 +55,10 @@ interface 'Sports', 'Supernatural', 'Tragedy', 'Yaoi', 'Yuri', 'Webtoons'); - Symbols: array [0..10] of Char = - ('\', '/', ':', '*', '?', '"', '<', '>', '|', #9, ';'); + Symbols: set of Char = + ['\', '/', ':', '*', '?', '"', '<', '>', '|', #9, ';']; - StringFilterChar: array [0..35] of array [0..1] of string = ( + StringFilterChar: array [0..35] of array [0..1] of String = ( (#10, '\n'), (#13, '\r'), (''', ''''), @@ -111,7 +97,7 @@ interface ('²', '²') ); - HTMLEntitiesChar: array [0..82] of array [0..1] of string = ( + HTMLEntitiesChar: array [0..82] of array [0..1] of String = ( ('«', '«'), ('°', '°'), ('À', 'À'), @@ -197,38 +183,14 @@ interface ('γ', 'γ') ); - README_FILE = 'readme.rtf'; - WORK_FOLDER = 'works/'; - WORK_FILE = 'works.ini'; - DOWNLOADEDCHAPTERS_FILE = 'downloadedchapters.ini'; - FAVORITES_FILE = 'favorites.ini'; - IMAGE_FOLDER = 'images/'; - DATA_FOLDER = 'data/'; - DATA_EXT = '.dat'; - DBDATA_EXT = '.db'; - CONFIG_FOLDER = 'config/'; - CONFIG_FILE = 'config.ini'; - CONFIG_ADVANCED = 'advanced.ini'; - REVISION_FILE = 'revision.ini'; - UPDATE_FILE = 'updates.ini'; - MANGALIST_FILE = 'mangalist.ini'; - LANGUAGE_FILE = 'languages.ini'; - LOG_FILE = 'changelog.txt'; - - UPDATE_URL = 'https://raw.githubusercontent.com/riderkick/FMD/master/'; - OPTION_MANGALIST = 0; OPTION_RECONNECT = 1; + UNKNOWN_ERROR = -1; NO_ERROR = 0; NET_PROBLEM = 1; INFORMATION_NOT_FOUND = 2; - SOCKHEARTBEATRATE = 300; - - DEFAULT_LIST = 'AnimeA,MangaFox,MangaHere,MangaInn,MangaReader'; - DEFAULT_CUSTOM_RENAME = '%NUMBERING% - %CHAPTER%'; - FMDFormatSettings :TFormatSettings = ( CurrencyFormat :1; NegCurrFormat :5; @@ -256,463 +218,62 @@ interface TwoDigitYearCenturyWindow :50; ); + HTTPDateTimeFormatStr = 'ddd, dd mmm yyyy hh:nn:ss'; + // EN: Param seperator SEPERATOR = '!%~'; SEPERATOR2 = '~%!'; - ANIMEA_ID = 0; - MANGAHERE_ID = 1; - MANGAINN_ID = 2; - OURMANGA_ID = 3; - KISSMANGA_ID = 4; - BATOTO_ID = 5; - MANGA24H_ID = 6; - VNSHARING_ID = 7; - HENTAI2READ_ID = 8; - FAKKU_ID = 9; - TRUYEN18_ID = 10; - MANGAREADER_ID = 11; - MANGAPARK_ID = 12; - EHENTAI_ID = 13; - MANGAFOX_ID = 14; - MANGATRADERS_ID = 15; - MANGASTREAM_ID = 16; - MANGAEDEN_ID = 17; - PERVEDEN_ID = 18; - TRUYENTRANHTUAN_ID = 19; - TURKCRAFT_ID = 20; - MANGAVADISI_ID = 21; - MANGAFRAME_ID = 22; - EATMANGA_ID = 23; - STARKANA_ID = 24; - MANGAPANDA_ID = 25; - REDHAWKSCANS_ID = 26; - BLOGTRUYEN_ID = 27; - KOMIKID_ID = 28; - SUBMANGA_ID = 29; - ESMANGAHERE_ID = 30; - ANIMEEXTREMIST_ID = 31; - PECINTAKOMIK_ID = 32; - HUGEMANGA_ID = 33; - S2SCAN_ID = 34; - SENMANGA_ID = 35; - IMANHUA_ID = 36; - MABUNS_ID = 37; - MANGAESTA_ID = 38; - CENTRALDEMANGAS_ID = 39; - EGSCANS_ID = 40; - MANGAAR_ID = 41; - MANGAAE_ID = 42; - ANIMESTORY_ID = 43; - LECTUREENLIGNE_ID = 44; - SCANMANGA_ID = 45; - MANGAGO_ID = 46; - DM5_ID = 47; - PURURIN_ID = 48; - MANGACOW_ID = 49; - KIVMANGA_ID = 50; - MANGACAN_ID = 51; - MEINMANGA_ID = 52; - MANGASPROJECT_ID = 53; - MANGAREADER_POR_ID = 54; - MANGA2U_ID = 55; - MANGASTREAMTO_ID = 56; - NINEMANGA_ID = 57; - NINEMANGA_ES_ID = 58; - NINEMANGA_CN_ID = 59; - NINEMANGA_RU_ID = 60; - NINEMANGA_DE_ID = 61; - NINEMANGA_IT_ID = 62; - NINEMANGA_BR_ID = 63; - JAPANSHIN_ID = 64; - JAPSCAN_ID = 65; - CENTRUMMANGI_PL_ID = 66; - MANGALIB_PL_ID = 67; - ONEMANGA_ID = 68; - MANGATOWN_ID = 69; - READHENTAIMANGA_ID = 70; - MANGAOKU_ID = 71; - MYREADINGMANGAINFO_ID = 72; - IKOMIK_ID = 73; - NHENTAI_ID = 74; - UNIONMANGAS_ID = 75; - MANGAMINT_ID = 76; - UNIXMANGA_ID = 77; - HAKIHOME_ID = 78; - EXTREMEMANGAS_ID = 79; - MANGAHOST_ID = 80; - PORNCOMIX_ID = 81; - PORNCOMIXRE_ID = 82; - PORNCOMIXIC_ID = 83; - XXCOMICS_ID = 84; - XXCOMICSMT_ID = 85; - XXCOMICS3D_ID = 86; - PORNXXXCOMICS_ID = 87; - MANGASEE_ID = 88; - MANGAKU_ID = 89; - ACADEMYVN_ID = 90; - MANGAAT_ID = 91; - SENMANGARAW_ID = 92; - READMANGATODAY_ID = 93; - LONEMANGA_ID = 94; - DYNASTYSCANS_ID = 95; - MADOKAMI_ID = 96; - MANGACAP_ID = 97; - MANGABOOM_ID = 98; - AUTHRONE_ID = 99; - EYEONMANGA_ID = 100; - - WebsiteRoots: array [0..100] of array [0..1] of string = ( - ('AnimeA', 'http://manga.animea.net'), - ('MangaHere', 'http://www.mangahere.co'), - ('MangaInn', 'http://www.mangainn.me'), - ('OurManga', 'http://www.ourmanga.com'), - ('KissManga', 'http://kissmanga.com'), - ('Batoto', 'http://bato.to'), - ('Manga24h', 'http://manga24h.com'), - ('VnSharing', 'http://truyen.vnsharing.net'), - ('Hentai2Read', 'http://hentai2read.com'), - ('Fakku', 'https://www.fakku.net'), - ('Truyen18', 'http://www.truyen18.org'), - ('MangaReader', 'http://www.mangareader.net'), - ('MangaPark', 'http://mangapark.me'), - ('E-Hentai', 'http://g.e-hentai.org'), - ('MangaFox', 'http://mangafox.me'), - ('MangaTraders', 'http://mangatraders.org'), - ('MangaStream', 'http://mangastream.com'), - ('MangaEden', 'http://www.mangaeden.com'), - ('PervEden', 'http://www.perveden.com'), - ('TruyenTranhTuan', 'http://truyentranhtuan.com'), - ('Turkcraft', 'http://turkcraft.com'), - ('MangaVadisi', 'http://www.mangavadisi.net'), - ('MangaFrame', 'http://www.mangaframe.com'), - ('EatManga', 'http://eatmanga.com'), - ('Starkana', 'http://starkana.jp'), - ('MangaPanda', 'http://www.mangapanda.com'), - ('RedHawkScans', 'http://manga.redhawkscans.com'), - ('BlogTruyen', 'http://blogtruyen.com'), - ('Komikid', 'http://www.komikid.com'), - ('SubManga', 'http://submanga.com'), - ('ESMangaHere', 'http://es.mangahere.co'), - ('AnimExtremist', 'http://www.animextremist.com'), - ('PecintaKomik', 'http://www.pecintakomik.com'), - ('HugeManga', 'http://hugemanga.com'), - ('S2Scans', 'http://reader.s2smanga.com'), - ('SenManga', 'http://www.senmanga.com'), - ('imanhua', 'http://www.imanhua.com'), - ('Mabuns', 'http://www.mabuns.web.id'), - ('MangaEsta', 'http://www.mangaesta.net'), - ('CentralDeMangas', 'http://centraldemangas.com.br'), - ('EGScans', 'http://read.egscans.com'), - ('MangaAr', 'http://manga-ar.net'), - ('MangaAe', 'http://www.manga.ae'), - ('AnimeStory', 'http://www.anime-story.com'), - ('Lecture-En-Ligne', 'http://www.lecture-en-ligne.com'), - ('ScanManga', 'http://www.scan-manga.com'), - ('MangaGo', 'http://www.mangago.me'), - ('DM5', 'http://www.dm5.com'), - ('Pururin', 'http://pururin.com'), - ('Mangacow', 'http://mangacow.co'), - ('KivManga', 'http://www.kivmanga.com'), - ('Mangacan', 'http://mangacanblog.com'), - ('MeinManga', 'http://www.meinmanga.com/'), - ('MangasPROJECT', 'http://mangaproject.xpg.uol.com.br'), - ('MangaREADER_POR', 'http://www.mangareader.com.br'), - ('Manga2u', 'http://www.mangakaka.com'), - ('MangaStreamTo', 'http://www.mangastream.to'), - ('NineManga', 'http://www.ninemanga.com'), - ('NineManga_ES', 'http://es.ninemanga.com'), - ('NineManga_CN', 'http://cn.ninemanga.com'), - ('NineManga_RU', 'http://ru.ninemanga.com'), - ('NineManga_DE', 'http://de.ninemanga.com'), - ('NineManga_IT', 'http://it.ninemanga.com'), - ('NineManga_BR', 'http://br.ninemanga.com'), - ('Japan-Shin', 'http://www.japan-shin.com'), - ('Japscan', 'http://www.japscan.com'), - ('Centrum-Mangi_PL', 'http://centrum-mangi.pl'), - ('Manga-Lib_PL', 'http://www.manga-lib.pl/index.php'), - ('OneManga', 'http://www.onemanga2.com'), - ('MangaTown', 'http://www.mangatown.com'), - ('ReadHentaiManga', 'http://readhentaimanga.com'), - ('MangaOku', 'http://www.mangaoku.net'), - ('MyReadingMangaInfo', 'http://myreadingmanga.info'), - ('I-Komik', 'http://www.i-komik.com'), - ('NHentai', 'http://nhentai.net'), - ('UnionMangas', 'http://unionmangas.com.br'), - ('MangaMint', 'http://www.mangamint.com'), - ('UnixManga', 'http://unixmanga.co'), - ('HakiHome', 'http://hakihome.com'), - ('ExtremeMangas', 'http://www.extrememangas.com'), - ('MangaHost', 'http://br.mangahost.com'), - ('PornComix', 'http://porncomix.wf'), - ('PornComixRE', 'http://porncomix.re'), - ('PornComixIC', 'http://incest.porncomix.re'), - ('XXComics', 'http://gallery.xxcomics.net'), - ('XXComicsMT', 'http://milftoon.xxcomics.net'), - ('XXComics3D', 'http://3dincest.xxcomics.net'), - ('PornXXXComics', 'http://pornxxxcomics.com'), - ('MangaSee', 'http://mangasee.co'), - ('MangaKu', 'http://mangaku.web.id'), - ('AcademyVN', 'http://truyen.academyvn.com'), - ('MangaAt', 'http://www.mangaat.com'), - ('SenMangaRAW', 'http://raw.senmanga.com'), - ('ReadMangaToday', 'http://www.readmanga.today'), - ('LoneManga', 'http://lonemanga.com'), - ('Dynasty-Scans', 'http://dynasty-scans.com'), - ('Madokami', 'https://manga.madokami.com'), - ('MangaCap', 'http://www.mangacap.com'), - ('MangaBoom', 'http://www.mangaboom.com'), - ('Authrone', 'http://www.authrone.com'), - ('EyeOnManga', 'http://www.eyeonmanga.com') - ); - - ALPHA_LIST = '#abcdefghijklmnopqrstuvwxyz'; - - ANIMEA_BROWSER = '/browse.html?page='; - ANIMEA_SKIP = '?skip=1'; - - MANGAHERE_BROWSER = '/mangalist/'; - - MANGAINN_BROWSER = '/mangalist/'; - - OURMANGA_BROWSER = '/directory/'; - - KISSMANGA_BROWSER = '/MangaList'; - - BATOTO_BROWSER_1 = '/comic/_/sp/'; - BATOTO_BROWSER_2 = '/comic/_/comics/'; - - MANGA24H_BROWSER = '/manga/update/page/'; - - VNSHARING_BROWSER = '/DanhSach'; - - HENTAI2READ_ROOT = 'http://hentai2read.com'; - HENTAI2READ_MROOT = 'http://m.hentai2read.com'; - HENTAI2READ_BROWSER = '/hentai-list/all/any/name-az/'; - - FAKKU_BROWSER_1 = '/manga/newest'; - FAKKU_BROWSER_2 = '/doujinshi/newest'; - - TRUYEN18_ROOT = 'http://www.truyen18.org'; - TRUYEN18_BROWSER = '/moi-dang/danhsach'; - - MANGAREADER_BROWSER = '/alphabetical'; - - //MANGAFOX_BROWSER :string = '/directory/'; - MANGAFOX_BROWSER = '/manga/'; - - MANGATRADERS_BROWSER = '/directory/'; - - MANGASTREAM_ROOT = 'http://mangastream.com'; - MANGASTREAM_ROOT2 = 'http://readms.com'; - - MANGAEDEN_BROWSER_1 = '/en-directory/'; - MANGAEDEN_BROWSER_2 = '/it-directory/'; - - PERVEDEN_BROWSER_1 = '/en-directory/'; - PERVEDEN_BROWSER_2 = '/it-directory/'; - - TRUYENTRANHTUAN_BROWSER = '/danh-sach-truyen'; - - TURKCRAFT_BROWSER = '/'; - - MANGAVADISI_BROWSER = '/hemenoku/'; - - MANGAFRAME_BROWSER = '/okuyucu/directory/'; - - EATMANGA_BROWSER = '/Manga-Scan/'; - EATMANGA_maxDLTask: Cardinal = 1; - - STARKANA_BROWSER = '/manga/list'; - - MANGAPANDA_ROOT = 'http://www.mangapanda.com'; - MANGAPANDA_BROWSER = '/alphabetical'; - - REDHAWKSCANS_BROWSER = '/reader/list/'; - - BLOGTRUYEN_BROWSER = '/danhsach/tatca'; - BLOGTRUYEN_JS_BROWSER = '/ListStory/GetListStory/'; - BLOGTRUYEN_POST_FORM = 'Url=tatca&OrderBy=1&PageIndex='; - - KOMIKID_BROWSER = '/daftar.php'; - - SUBMANGA_BROWSER = '/series/n'; - - ESMANGAHERE_BROWSER = '/mangalist/'; - - ANIMEEXTREMIST_BROWSER = '/mangas.htm?ord=todos'; - - PECINTAKOMIK_BROWSER = '/directory/'; - - HUGEMANGA_BROWSER = '/'; - - SENMANGA_BROWSER = '/Manga/'; - - IMANHUA_BROWSER = '/all.html'; - - MABUNS_BROWSER = '/p/mabuns-manga-list.html'; - - MANGAESTA_BROWSER = '/p/manga-list.html'; - - CENTRALDEMANGAS_BROWSER = '/mangas/list/*'; - - EGSCANS_BROWSER = '/'; - - MANGAAR_BROWSER = '/manga/'; - - MANGAAE_BROWSER = '/manga/'; - - ANIMESTORY_BROWSER = '/mangas/'; - - LECTUREENLIGNE_BROWSER = '/index.php?page=liste&ordre=titre'; - - SCANMANGA_BROWSER = '/scanlation/liste_des_mangas.html'; - - MANGAGO_BROWSER = '/list/directory/all/'; - - DM5_BROWSER = '/manhua-new'; - - PURURIN_BROWSER = '/browse/'; - - //MANGACOW_BROWSER :string = '/manga-list/all/any/name-az/'; - MANGACOW_BROWSER = '/manga-list/all/any/last-added/'; - - KIVMANGA_BROWSER = '/'; - - MANGACAN_BROWSER = '/daftar-komik-manga-bahasa-indonesia.html'; - - MEINMANGA_BROWSER = '/directory/all/'; - - MANGASPROJECT_BROWSER = '/AJAX/listaMangas/all'; - - MANGAREADER_POR_BROWSER = '/AJAX/listaMangas/all'; - - //MANGA2U_BROWSER = '/list/all/any/most-popular/'; - MANGA2U_BROWSER = '/manga_list/all/any/last-added/'; - - EHENTAI_BROWSER = 'f_doujinshi=on&f_manga=on&f_western=on&f_apply=Apply+Filter'; - EHENTAI_maxDLTask: Integer = 2; + // common regex to split host/url + REGEX_HOST = '(?ig)^(\w+://)?([^/]*\.\w+)?(\:\d+)?(/?.*)$'; - MANGASTREAMTO_BROWSER = '/series.html'; + ALPHA_LIST = '#abcdefghijklmnopqrstuvwxyz'; + ALPHA_LIST_UP = '#ABCDEFGHIJKLMNOPQRSTUVWXYZ'; - NINEMANGA_BROWSER = - '/search/?name_sel=contain&wd=&author_sel=contain&author=&artist_sel=contain&artist=&category_id=&out_category_id=&completed_series=either'; + MangaInfo_StatusCompleted = '0'; + MangaInfo_StatusOngoing = '1'; - JAPANSHIN_BROWSER = '/lectureenligne/reader/list/'; - JAPSCAN_BROWSER = '/mangas/'; - - CENTRUMMANGI_PL_BROWSER = '/spis/'; - - MANGALIB_PL_BROWSER = '/manga/directory'; - - ONEMANGA_BROWSER = '/manga-list/all/any/last-added/'; - - MANGATOWN_BROWSER = '/directory/'; - - READHENTAIMANGA_BROWSER = '/hentai-manga-list/all/any/last-added/'; - - IKOMIK_BROWSER = '/manga-directory/'; - - UNIONMANGAS_BROWSER = '/mangas'; - - UNIXMANGA_BROWSER = '/onlinereading/manga-lists.html'; - - HAKIHOME_BROWSER = '/ListMangaHentai.html'; - - EXTREMEMANGAS_BROWSER = '/2013/04/lista-de-mangas.html'; - - MANGAHOST_BROWSER = '/mangas'; + FMDSupportedOutputExt: array[0..3] of ShortString = ('.zip', '.cbz', '.pdf', '.epub'); + FMDImageFileExt: array[0..3] of ShortString = ('.png', '.gif', '.jpg', '.webp'); + {$ifdef windows} + // MAX_PATH = 260 + // MAX_PATH - 12 - 1 + MAX_PATHDIR = 247; + // fmd max file extension = 4 + // max path + file in windows explorer is 259 + // = MAX_PATH - fmd max file extension - 1 + // 1 is pahtdelim "/" + FMDMaxImageFilePath = 255; + // if directory length is max_pathdir, the remaining allowed filename is 7 + // = 259 - fmd max file extension - 1 + {$endif} - DYNASTYSCANS_BROWSER: array [0..3] of string = ( - '/anthologies', - '/doujins', - '/issues', - '/series' - ); - MADOKAMI_BROWSER: array [0..11] of string = ( - '/Manga/%23%20-%20F', - '/Manga/G%20-%20M', - '/Manga/N%20-%20Z', - '/Manga/_Autouploads/AutoUploaded%20from%20Assorted%20Sources', - '/Manga/_Autouploads/ComicWalker', - '/Manga/Non-English/Bahasa%20Indonesia', - '/Manga/Non-English/Brazilian%20Portuguese', - '/Manga/Non-English/Fran%C3%A7ais', - '/Manga/Non-English/Italian', - '/Manga/Non-English/Spanish', - '/Manga/_Doujinshi', - '/Raws' - ); + // custom rename + CR_NUMBERING = '%NUMBERING%'; + CR_CHAPTER = '%CHAPTER%'; + CR_WEBSITE = '%WEBSITE%'; + CR_MANGA = '%MANGA%'; + CR_AUTHOR = '%AUTHOR%'; + CR_ARTIST = '%ARTIST%'; + CR_FILENAME = '%FILENAME%'; var - FMD_VERSION_NUMBER: String = ''; - - {$IFDEF WINDOWS} - DEFAULT_PATH : string = '/downloads'; - {$ELSE} - DEFAULT_PATH: string = '/downloads'; - {$ENDIF} - // Sites var BROWSER_INVERT: Boolean = False; - BATOTO_BROWSER: string = '/search'; - - FAKKU_BROWSER: string = '/manga/newest'; - - MANGAEDEN_BROWSER: string = '/en-directory/'; - - PERVEDEN_BROWSER: string = '/en-directory/'; - - MANGALIB_PL_COOKIES: String; //------------------------------------------ Genre: array [0..37] of String; Revision: Cardinal; - currentJDN: Cardinal; - isChangeDirectory: Boolean = False; - - currentWebsite: String; - - ProxyType: String = ''; - Host: String = ''; - Port: String = ''; - User: String = ''; - Pass: String = ''; - - fmdDirectory: String; - - OptionLetFMDDo: TFMDDo = DO_NOTHING; - - OptionCustomRename: String; - - OptionCheckMinutes: Cardinal = 0; - OptionPDFQuality: Cardinal = 95; - OptionMaxRetry: Cardinal = 0; - OptionConnectionTimeout: Integer = 15000; - OptionUpdateListNoMangaInfo: Boolean = False; - OptionUpdateListRemoveDuplicateLocalData: Boolean = False; - - OptionShowBatotoSG: Boolean = True; - OptionShowAllLang: Boolean = True; - OptionAutoDlFav: Boolean = True; - OptionEnableLoadCover: Boolean = False; - OptionAutoNumberChapterChecked: Boolean = True; - OptionAutoRemoveCompletedManga: Boolean = True; - OptionAutoCheckFavStartup: Boolean = False; - + currentJDN: Integer; + isExiting: Boolean = False; type - TArrayOfString = array of string; + TArrayOfString = array of String; - TCheckStyleType = (CS_DIRECTORY_COUNT, CS_DIRECTORY_PAGE, - CS_DIRECTORY_PAGE_2, CS_INFO); - TFlagType = (CS_GETPAGENUMBER, CS_GETPAGELINK, CS_DOWNLOAD); - TDownloadStatusType = (STATUS_STOP, STATUS_WAIT, STATUS_PREPARE, - STATUS_DOWNLOAD, STATUS_FINISH, STATUS_COMPRESS, - STATUS_PROBLEM, STATUS_FAILED); - TDownloadStatusTypes = set of TDownloadStatusType; + TCheckStyleType = (CS_DIRECTORY_COUNT, CS_DIRECTORY_PAGE, CS_INFO); + TFlagType = (CS_GETPAGENUMBER, CS_GETPAGELINK, CS_DOWNLOAD); TFavoriteStatusType = (STATUS_IDLE, STATUS_CHECK, STATUS_CHECKING, STATUS_CHECKED); TFavoriteStatusTypes = set of TFavoriteStatusType; @@ -723,6 +284,7 @@ interface TMangaListItem = record Text: String; + JDN: Longint; end; PSingleItem = ^TSingleItem; @@ -734,11 +296,24 @@ TSingleItem = record PChapterStateItem = ^TChapterStateItem; TChapterStateItem = record + Index: Integer; Title, - Link : String; + Link: String; Downloaded: Boolean; end; + PBaseMangaInfo = ^TBaseMangaInfo; + + TBaseMangaInfo = record + title, + authors, + artists, + genres, + status, + summary: String; + numChapter: Integer; + end; + PMangaInfo = ^TMangaInfo; { TMangaInfo } @@ -755,7 +330,7 @@ TMangaInfo = class genres, status, summary: String; - numChapter: Cardinal; + numChapter: Integer; chapterName, chapterLinks: TStringList; constructor Create; @@ -764,6 +339,8 @@ TMangaInfo = class PDownloadInfo = ^TDownloadInfo; + { TDownloadInfo } + TDownloadInfo = record Website, Link, @@ -778,58 +355,54 @@ TDownloadInfo = record PFavoriteInfo = ^TFavoriteInfo; + { TFavoriteInfo } + TFavoriteInfo = record Website, Title, Link, SaveTo, - numbering, - downloadedChapterList, - currentChapter: String; + Numbering, + DownloadedChapterList, + CurrentChapter: String; end; - TCardinalList = TFPGList<Cardinal>; - TByteList = TFPGList<Byte>; + TCardinalList = specialize TFPGList<Cardinal>; + TByteList = specialize TFPGList<Byte>; TDownloadPageThread = class(TThread) protected procedure Execute; override; public isSuccess, isDone: Boolean; - Retry: Cardinal; + Retry: Integer; URL, Path: String; constructor Create(CreateSuspended: Boolean); end; - { TParseHTML } + { THTMLForm } - TParseHTML = class + THTMLForm = class private - FRaw: string; - procedure FoundTag(NoCaseTag, ActualTag: string); - procedure FoundText(Text: string); + fdata: TStringList; + fvalueseparator: String; + fdelimiter: String; public - Output: TStrings; - constructor Create(const Raw: string = ''); - function Exec(const Raw: string = ''): string; - property Raw: string read FRaw write FRaw; + constructor Create; + destructor Destroy; override; + procedure Put(const AName, AValue: String); + procedure Remove(const AName: String); + function GetData: String; + property ValueSeparator: String read fvalueseparator write fvalueseparator; + property Delimiter: String read fdelimiter write fdelimiter; + property Data: TStringList read fdata; end; - { THTTPSendThread } - - THTTPSendThread = class(THTTPSend) - protected - FOwner: TFMDThread; - procedure CloseConnection(SendTerminateTag: Boolean = True); - procedure SockOnHeartBeat(Sender: TObject); - public - constructor Create(AOwner: TFMDThread); - end; +// VT extras +procedure SearchOnVT(Tree: TVirtualStringTree; Key: String; Column: Integer = 0); -// Get current binary version -function GetCurrentBinVersion: String; // Remove Unicode -function UnicodeRemove(const S: String): String; +function ReplaceUnicodeChar(const S, ReplaceStr: String): String; // Check a directory to see if it's empty (return TRUE) or not function IsDirectoryEmpty(const ADir: String): Boolean; function CheckRedirect(const HTTP: THTTPSend): String; @@ -837,67 +410,100 @@ function CorrectFilePath(const APath: String): String; function CorrectURL(const URL: String): String; procedure CheckPath(const S: String); -function GetMangaSiteID(const Name: String): Cardinal; -function GetMangaSiteName(const ID: Cardinal): String; -function GetMangaSiteRoot(const Website: String): String; overload; -function GetMangaSiteRoot(const MangaID: Cardinal): String; overload; -function GetMangaDatabaseURL(const Name: String): String; - -function SitesMemberOf(const website: String; MangaSiteIDs: array of Cardinal): Boolean; -function SitesWithSortedList(const website:String): Boolean; -function SitesWithoutFavorites(const website:String): Boolean; +function SitesWithSortedList(const website: String): Boolean; +function SitesWithoutFavorites(const website: String): Boolean; // Return true if the website doesn't contain manga information function SitesWithoutInformation(const website: String): Boolean; -function SitesWithoutPageLink(const website: String): Boolean; -function SitesWithoutReferer(const website: String): Boolean; -function SitesRefererisURL(const website: String): Boolean; -function SitesWithSingleChapter(const website: String): Boolean; -function SitesIsWPManga(const websiteid: Cardinal): Boolean; overload; -function SitesIsWPManga(const website: String): Boolean; overload; - -// Fill in website host if it's not present -function FillMangaSiteHost(const MangaID: Cardinal; URL: String): String; + +// url +function FillURLProtocol(const AProtocol, AURL: String): String; + +// modify url +function FillHost(const Host, URL: String): String; overload; +procedure FillHost(const Host: String; const URLs: TStrings); overload; +function MaybeFillHost(const Host, URL: String): String; overload; +procedure MaybeFillHost(const Host: String; const URLs: TStrings); overload; +function GetHostURL(URL: String): String; function RemoveHostFromURL(URL: String): String; -procedure RemoveHostFromURLs(Const URLs: TStringList); -procedure RemoveHostFromURLsPair(Const URLs, Names : TStringList); +procedure RemoveHostFromURLs(const URLs: TStringList); +procedure RemoveHostFromURLsPair(const URLs, Names: TStringList); +function EncodeCriticalURLElements(const URL: String): String; //JSON procedure ParseJSONArray(const S, Path: String; var OutArray: TStringList); -//HTML -procedure ParseHTML(const aRaw: string; var aOutput: TStringList); +// XPath / CSS Selector +procedure ParseHTMLTree(var tp: TTreeParser; const S: String); +function SelectXPathString(Expression: String; TP: TTreeParser): String; +function SelectXPathIX(Expression: String; TP: TTreeParser): IXQValue; +function SelectCSSString(Expression: String; TP: TTreeParser): String; +function SelectCSSIX(Expression: String; TP: TTreeParser): IXQValue; + +//convert charset to utf8 +function ConvertCharsetToUTF8(S: String): String; overload; +procedure ConvertCharsetToUTF8(S: TStrings); overload; + +// encode/decode +function Base64Encode(const s: String): String; overload; +function Base64Decode(const s: String): String; overload; +function Base64Encode(const TheStream: TStream): Boolean ; overload; +function Base64Decode(const TheStream: TStream): Boolean ; overload; // StringUtils -function QuotedStrd(const S: string): string; overload; -function QuotedStrd(const S: Integer): string; overload; -function BracketStr(const S: string): string; -procedure ParseCommandLine(const cmd: string; var Output: TStrings; - AStripQuotes: Boolean = False); -function ParsedCommandLine(const cmd: String): TArrayOfString; -function StringsToArray(const S: TStrings): TArrayOfString; -function StringsToCommandLine(const S: TStrings): string; overload; -function StringsToCommandLine(const S: array of string): string; overload; -procedure DeleteArrayOfString(Var TheStrings: TArrayOfString;Index: Integer); +function PadZero(const S: String; ATotalWidth: Integer = 3; + PadAll: Boolean = False; StripZero: Boolean = False): String; +procedure PadZeros(const S: TStrings; ATotalWidth: Integer = 3; + PadAll: Boolean = False; StripZeros: Boolean = False); + +// RegExpr +function RegExprGetMatch(const ARegExpr, AInputStr : RegExprString; const AMatchIdx: Integer): String; + +// maintain the order of strings by adding serialized number if necessary +procedure SerializeAndMaintainNames(const F: TStrings); + +function ShortenString(const S: String; const MaxWidth: Integer; + const RightLength: Integer = 0; const EllipsisStr: String = '...'): String; + +function TitleCase(const S: string): string; +function StringReplaceBrackets(const S, OldPattern, NewPattern: String; Flags: TReplaceFlags): String; +function StreamToString(const Stream: TStream): String; inline; +function GetRightValue(const Name, s: String): String; +function QuotedStr(const S: Integer): String; overload; inline; +function QuotedStrD(const S: String): String; overload; inline; +function QuotedStrD(const S: Integer): String; overload; inline; +function BracketStr(const S: String): String; inline; function RandomString(SLength: Integer; ONumber: Boolean = False; - OSymbol: Boolean = False; OSpace: Boolean = False): string; + OSymbol: Boolean = False; OSpace: Boolean = False): String; function GetValuesFromString(Str: String; Sepr: Char): String; -procedure InvertStrings(Const St: TStringList); overload; +procedure InvertStrings(const St: TStringList); overload; procedure InvertStrings(const Sts: array of TStringList); overload; -procedure TrimStrings(Const Str: TStringList); -procedure RemoveDuplicateStrings(Strs: Array of TStringList; RemIndex: Cardinal = 0); -procedure CleanHTMLComments(Const Str: TStringList); +procedure TrimStrings(TheStrings: TStrings); +procedure RemoveDuplicateStrings(Strs: array of TStringList; RemIndex: Integer = 0); +function MergeCaseInsensitive(Strs: array of String): String; overload; +function MergeCaseInsensitive(Strs: array of TStrings): String; overload; +procedure CleanHTMLComments(const Str: TStringList); function FixHTMLTagQuote(const s: String): String; -function FixCommonBrokenHTML(const s:String): string; +function FixCommonBrokenHTML(const s: String): String; function URLDecode(const s: String): String; function HTMLDecode(const AStr: String): String; function RemoveSymbols(const input: String): String; function CorrectPathSys(const Path: String): String; - +function RemovePathDelim(const Path: string): string; + +function FixWhiteSpace(const S: String): String; +function CleanString(const S: String): String; +function CleanMultilinedString(const S: String; MaxLineEnding: Integer = 1): String; +function CleanAndExpandURL(const URL: String): String; +function CleanURL(const URL: String): String; +function AppendURLDelim(const URL: String): String; +function AppendURLDelimLeft(const URL: String): String; +function RemoveURLDelim(const URL: String): String; inline; +function RemoveURLDelimLeft(const URL: String): String; inline; function FixURL(const URL: String): String; function FixPath(const path: String): String; -function GetLastDir(const path: String): String; +function GetLastDir(const Dir: String): String; function StringFilter(const Source: String): String; function HTMLEntitiesFilter(const Source: String): String; function CommonStringFilter(const Source: String): String; @@ -910,15 +516,23 @@ function TrimChar(const Source: String; const Chars: TSysCharSet): String; function TrimLeftChar(const Source: String; const Chars: TSysCharSet): String; function TrimRightChar(const Source: String; const Chars: TSysCharSet): String; -function PrepareSummaryForHint(const Source: String; MaxLength: Cardinal = 80): String; -procedure AddCommaString(var Dest: string; S: string); +function PrepareSummaryForHint(const Source: String; MaxLength: Integer = 80): String; +procedure AddCommaString(var Dest: String; S: String); + +function StringOfString(c: String; l: Integer): String; +function IncStr(const S: String; N: Integer = 1): String; overload; +function IncStr(const I: Integer; N: Integer = 1): String; overload; inline; +function StringIn(const AText: String; const AValues: array of String): Boolean; +function TextIn(const AText: String; const AValues: array of String): Boolean; //get heaader value from THTTPSend.Headers function GetHeaderValue(const AHeaders: TStrings; HName: String): String; // custom rename feature -function CustomRename(const AString, AWebsite, AMangaName, AAuthor, AArtist, - AChapter, ANumbering: String; const AIsUnicodeRemove: Boolean): String; +function CustomRename(const AString, AWebsite, AMangaName, AAuthor, AArtist, AChapter, ANumbering: String; + const AReplaceUnicode: Boolean; + const AReplaceUnicodeStr: String; + const AFileName: String = ''): String; // Get substring from source function GetString(const Source, sStart, sEnd: String): String; @@ -932,6 +546,7 @@ procedure GetParams(var output: TCardinalList; input: String); overload; procedure GetParams(var output: TList; input: String); overload; function ExtractParam(const output: TStrings; input, sep: String; WhiteSp: Boolean = True): Integer; +function GetParams(const input: String): String; overload; inline; function RemoveDuplicateNumbersInString(const AString: String): String; // Set param from input @@ -940,87 +555,133 @@ function SetParams(const input: array of String): String; overload; procedure CustomGenres(var output: TStringList; input: String); +//parse google result urls +function GoogleResultURL(const AURL: String): String; +procedure GoogleResultURLs(const AURLs: TStrings); + // deal with sourceforge URL. function SourceForgeURL(URL: String): String; -// Get HTML source code from a URL. function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; - const Reconnect: Cardinal): Boolean; overload; -function GetPage(var output: TObject; URL: String; const Reconnect: Cardinal): Boolean; + const Reconnect: Integer = 0; Method: String = 'GET'): Boolean; overload; +function GetPage(var output: TObject; URL: String; const Reconnect: Integer = 0): Boolean; overload; inline; // Get url from a bitly url. function GetURLFromBitly(const URL: String): String; + +// convert webp +function WebPToPNGStream(const AStream: TMemoryStream; const ALevel: Tcompressionlevel = clfastest): Boolean; +function WebPToJPEGStream(const AStream: TMemoryStream; const AQuality: Integer = 80): Boolean; + +// convert png +function PNGToJPEGStream(const AStream: TMemoryStream; const AQuality: Integer = 80): Boolean; + +// try to save tmemorystream to file, return the saved filename if success, otherwise return empty string +function SaveImageStreamToFile(Stream: TMemoryStream; Path, FileName: String; Age: LongInt = 0): String; overload; +function SaveImageStreamToFile(AHTTP: THTTPSend; Path, FileName: String): String; overload; + + +// detect and save image from base64 string +function SaveImageBase64StringToFile(const S, Path, FileName: String): Boolean; + // Download an image from url and save it to a specific location. -function SaveImage(const AHTTP: THTTPSend; const mangaSiteID: Integer; URL: String; - const Path, Name, prefix: String; const Reconnect: Cardinal): Boolean; overload; -function SaveImage(const mangaSiteID: Integer; URL: String; - const Path, Name, prefix: String; const Reconnect: Cardinal): Boolean; overload; inline; +function DownloadAndSaveImage(const AHTTP: THTTPSendThread; const AURL, APath, AFileName: String; var ASavedFileName: String): Boolean; overload; +function DownloadAndSaveImage(const AHTTP: THTTPSendThread; const AURL, APath, AFileName: String): Boolean; overload; + +// check file exist with known extensions. AFilename is a filename without extensions +function ImageFileExist(const AFileName: String): Boolean; +function FindImageFile(const AFileName: String): String; + +// load iamge from file with UTF8 aware +function LoadImageFromFileUTF8(const FileName: String; var Image: TFPCustomImage): Boolean; +// copy image from one image rect to dest point +procedure CopyImageRect(const Source, Dest: TFPCustomImage; const DestX, DestY: Integer; const SourceRect: TRect); + +// merge 2 images to one +function Merge2Image(const Directory, ImgName1, ImgName2, FinalName: String; const Landscape: Boolean = False): Boolean; + +function GetMimeType(const imgFileName: String): String; + +// sort procedure QuickSortChapters(var chapterList, linkList: TStringList); procedure QuickSortData(var merge: TStringList); // This method uses to sort the data. Use when we load all the lists. procedure QuickSortDataWithWebID(var merge: TStringList; const webIDList: TByteList); +function NaturalCompareStr(Str1, Str2: String): Integer; inline; +function NaturalCustomSort(List: TStringList; Index1, Index2: Integer): Integer; inline; +procedure QuickSortNaturalPart(var Alist: TStringList; Separator: String; + PartIndex: Integer); + +function GetStringPart(const S, Sep: String; PartIndex: Integer): String; -function GetCurrentJDN: longint; -function DateToJDN(const year, month, day: word): longint; overload; -function DateToJDN(const date: TDate): longint; overload; -function JDNToDate(const JDN: longint): TDate; + +function GetCurrentJDN: Longint; +function DateToJDN(const year, month, day: Word): Longint; overload; +function DateToJDN(const date: TDate): Longint; overload; +function JDNToDate(const JDN: Longint): TDate; {function ConvertInt32ToStr(const aValue: Cardinal) : String; function ConvertStrToInt32(const aStr : String): Cardinal;} procedure TransferMangaInfo(var dest: TMangaInfo; const Source: TMangaInfo); +function MangaInfoStatusIfPos(const SearchStr: String; const OngoingStr: String = 'Ongoing'; + const CompletedStr: String = 'Complete'): String; + +procedure GetBaseMangaInfo(const M: TMangaInfo; var B: TBaseMangaInfo); +// fill empty manga info +procedure FillBaseMangaInfo(const M: TMangaInfo; var B: TBaseMangaInfo); // cross platform funcs function fmdGetTempPath: String; -function fmdGetTickCount: Cardinal; procedure fmdPowerOff; procedure fmdHibernate; -function RunExternalProcessAsAdmin(Exe, Params: String; ShowWind: Boolean = True; - isPersistent: Boolean = True): Boolean; -function RunExternalProcess(Exe: String; Params: array of string; ShowWind: Boolean = True; - isPersistent: Boolean = True): Boolean; overload; -function RunExternalProcess(Exe, Params: String; ShowWind: Boolean = True; - isPersistent: Boolean = True): Boolean; overload; -function RunExternalProcess(CommandLine: String; ShowWind: Boolean = True; - isPersistent: Boolean = True): Boolean; overload; + +// logger +procedure SendLog(const AText: String); overload; inline; +procedure SendLog(const AText, AValue: String); overload; inline; +procedure SendLog(const AText: String; const AValue: Variant); overload; inline; +procedure SendLog(const AText: String; AValue: TStrings); overload; inline; +procedure SendLogError(const AText: String); overload; inline; +procedure SendLogWarning(const AText: String); overload; inline; +procedure SendLogException(const AText: String; AException: Exception); inline; implementation uses - {$IFDEF DOWNLOADER}frmMain;{$ENDIF} + {$IFDEF DOWNLOADER}WebsiteModules, webp, FPWriteJPEG;{$ENDIF} {$IFDEF WINDOWS} // thanks Leledumbo for the code const - SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; - SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; - SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; - SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; - SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; - SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; - SE_TCB_NAME = 'SeTcbPrivilege'; - SE_SECURITY_NAME = 'SeSecurityPrivilege'; - SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; - SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; - SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; - SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; + SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; + SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; + SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; + SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; + SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; + SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; + SE_TCB_NAME = 'SeTcbPrivilege'; + SE_SECURITY_NAME = 'SeSecurityPrivilege'; + SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; + SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; + SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; + SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege'; - SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; - SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; - SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; - SE_BACKUP_NAME = 'SeBackupPrivilege'; - SE_RESTORE_NAME = 'SeRestorePrivilege'; - SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; - SE_DEBUG_NAME = 'SeDebugPrivilege'; - SE_AUDIT_NAME = 'SeAuditPrivilege'; - SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; - SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; - SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; - SE_UNDOCK_NAME = 'SeUndockPrivilege'; - SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege'; - SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege'; - SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege'; + SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; + SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; + SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; + SE_BACKUP_NAME = 'SeBackupPrivilege'; + SE_RESTORE_NAME = 'SeRestorePrivilege'; + SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; + SE_DEBUG_NAME = 'SeDebugPrivilege'; + SE_AUDIT_NAME = 'SeAuditPrivilege'; + SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; + SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; + SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; + SE_UNDOCK_NAME = 'SeUndockPrivilege'; + SE_SYNC_AGENT_NAME = 'SeSyncAgentPrivilege'; + SE_ENABLE_DELEGATION_NAME = 'SeEnableDelegationPrivilege'; + SE_MANAGE_VOLUME_NAME = 'SeManageVolumePrivilege'; function SetSuspendState(hibernate, forcecritical, disablewakeevent: Boolean): Boolean; stdcall; external 'powrprof.dll' Name 'SetSuspendState'; @@ -1081,56 +742,69 @@ function NTSetPrivilege(sPrivilege: String; bEnabled: Boolean): Boolean; {$ENDIF} -function GetCurrentBinVersion: String; +procedure SearchOnVT(Tree: TVirtualStringTree; Key: String; Column: Integer); var - AppVerInfo: TStringList; - i: Integer; + s: String; + node, xnode: PVirtualNode; + v: Boolean; begin - Result := ''; - AppVerInfo := TStringList.Create; - with TFileVersionInfo.Create(nil) do - try - try - FileName := ParamStrUTF8(0); - if FileName = '' then - FileName := Application.ExeName; - {$IF FPC_FULLVERSION >= 20701} - ReadFileInfo; - {$ENDIF} - if VersionStrings.Count > 0 then + if Tree.TotalCount = 0 then + Exit; + s := AnsiUpperCase(Key); + Tree.BeginUpdate; + try + node := Tree.GetFirst(); + if s <> '' then + begin + while node <> nil do + begin + v := Pos(s, AnsiUpperCase(Tree.Text[node, Column])) <> 0; + Tree.IsVisible[node] := v; + if v then begin - {$IF FPC_FULLVERSION >= 20701} - AppVerInfo.Assign(VersionStrings); - {$ELSE} - for i := 0 to VersionStrings.Count - 1 do - AppVerInfo.Add(VersionCategories.Strings[i] + '=' + - VersionStrings.Strings[i]); - {$ENDIF} - for i := 0 to AppVerInfo.Count - 1 do - AppVerInfo.Strings[i] := LowerCase(AppVerInfo.Names[i]) + '=' + AppVerInfo.ValueFromIndex[i]; - Result := AppVerInfo.Values['fileversion']; + xnode := node^.Parent; + while (xnode <> nil) and (xnode <> Tree.RootNode) do + begin + if not (vsVisible in xnode^.States) then + Tree.IsVisible[xnode] := True; + xnode := xnode^.Parent; + end; end; - except + node := Tree.GetNext(node); + end; + end + else + begin + while node <> nil do + begin + if not (vsVisible in node^.States) then + Tree.IsVisible[node] := True; + node := Tree.GetNext(node); end; - finally - Free; - AppVerInfo.Free; end; + finally + Tree.EndUpdate; + end; end; -function UnicodeRemove(const S: String): String; +function ReplaceUnicodeChar(const S, ReplaceStr: String): String; var - i: Cardinal; + i: Integer; + s1, s2, sr: UnicodeString; begin Result := S; - for i := 1 to Length(Result) do - begin - if (byte(Result[i]) < 31) or (byte(Result[i]) > 127) then - begin - Delete(Result, i, 1); - Insert('_', Result, i); - end; + if Result = '' then Exit; + s1 := UTF8Decode(S); + s2 := UTF8Decode(ReplaceStr); + sr := ''; + for i := 1 to Length(s1) do + begin + if (Ord(s1[i]) < 31) or (Ord(s1[i]) > 127) then + sr := sr + s2 + else + sr := sr + s1[i]; end; + Result := UTF8Encode(sr); end; function IsDirectoryEmpty(const ADir: String): Boolean; @@ -1138,10 +812,8 @@ function IsDirectoryEmpty(const ADir: String): Boolean; searchRec: TSearchRec; begin try - Result := (FindFirstUTF8(CorrectFilePath(ADir) + '*.*', faAnyFile -{$ifdef unix} or faSymLink -{$endif unix} - , searchRec) = 0) and + Result := (FindFirstUTF8(CorrectPathSys(ADir) + '*.*', + faAnyFile{$ifdef unix} or faSymLink{$endif unix}, searchRec) = 0) and (FindNextUTF8(searchRec) = 0) and (FindNextUTF8(searchRec) <> 0); finally @@ -1174,14 +846,14 @@ function CorrectFilePath(const APath: String): String; procedure CheckPath(const S: String); var wS, lcS, lcS2: String; - i, j: word; + i, j: Integer; begin wS := s; lcS2 := ''; if wS[2] <> ':' then begin {$IFDEF WINDOWS} - lcS2 := CorrectFilePath(fmdDirectory); + lcS2 := CorrectFilePath(FMD_DIRECTORY); {$ELSE} lcS2 := ''; {$ENDIF} @@ -1212,282 +884,136 @@ procedure CheckPath(const S: String); end; end; end; - SetCurrentDirUTF8(fmdDirectory); end; -function GetMangaSiteID(const Name: String): Cardinal; +function SitesWithSortedList(const website: String): Boolean; var - i: Integer; -begin - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - if Name = WebsiteRoots[i, 0] then - Exit(i); -end; - -function GetMangaSiteName(const ID: Cardinal): String; + i: Integer = -1; begin - Result := WebsiteRoots[ID, 0]; + Result := False; + if Modules.ModuleAvailable(website, i) then + begin + Result := Modules.Module[i].SortedList; + Exit; + end; end; -function GetMangaSiteRoot(const Website : String) : String; +function SitesWithoutFavorites(const website: String): Boolean; var - i: Integer; -begin - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - if Website = WebsiteRoots[i, 0] then - Exit(WebsiteRoots[i, 1]); -end; - -function GetMangaSiteRoot(const MangaID : Cardinal) : String; + i: Integer = -1; begin - Result := WebsiteRoots[MangaID, 1]; -end; - -// bad coding.. but this is how FMD works -function GetMangaDatabaseURL(const Name: String): String; -begin - Result := 'https://bintray.com/artifact/download/riderkick/FMD/data/' + Name + '.7z'; + Result := False; + if Modules.ModuleAvailable(website, i) then + begin + Result := not Modules.Module[i].FavoriteAvailable; + Exit; + end; end; -function SitesMemberOf(const website: String; MangaSiteIDs: array of Cardinal): Boolean; +function SitesWithoutInformation(const website: String): Boolean; var - i: Cardinal; + i: Integer = -1; begin Result := False; - for i := Low(MangaSiteIDs) to High(MangaSiteIDs) do - if website = WebsiteRoots[MangaSiteIDs[i], 0] then - begin - Result := True; - Break; - end; + if Modules.ModuleAvailable(website, i) then + begin + Result := not Modules.Module[i].InformationAvailable; + Exit; + end; end; -function SitesWithSortedList(const website : String) : Boolean; -begin - Result := SitesIsWPManga(website); - if not Result then - Result := SitesMemberOf(website, [ - FAKKU_ID, - PURURIN_ID, - EHENTAI_ID, - NINEMANGA_ID, - NINEMANGA_ES_ID, - NINEMANGA_CN_ID, - NINEMANGA_RU_ID, - NINEMANGA_DE_ID, - NINEMANGA_IT_ID, - NINEMANGA_BR_ID, - MANGACOW_ID, - ONEMANGA_ID, - READHENTAIMANGA_ID, - MYREADINGMANGAINFO_ID, - NHENTAI_ID, - MANGA2U_ID, - PORNCOMIX_ID, - XXCOMICS_ID, - XXCOMICSMT_ID, - XXCOMICS3D_ID, - PORNCOMIXRE_ID, - PORNCOMIXIC_ID, - PORNXXXCOMICS_ID, - MANGAPARK_ID, - SENMANGA_ID, - MANGACAP_ID - ]); -end; - -function SitesWithoutFavorites(const website : String) : Boolean; +function FillURLProtocol(const AProtocol, AURL: String): String; begin - Result := False; - Result := SitesMemberOf(website, [ - EHENTAI_ID, - FAKKU_ID, - PURURIN_ID, - MYREADINGMANGAINFO_ID, - NHENTAI_ID, - PORNCOMIX_ID, - XXCOMICS_ID, - XXCOMICSMT_ID, - XXCOMICS3D_ID, - PORNCOMIXRE_ID, - PORNCOMIXIC_ID, - PORNXXXCOMICS_ID - ]); + Result := AURL; + if AURL <> '' then begin + Result := ReplaceRegExpr('^\w*:?//', AURL, '', False); + if AProtocol <> '' then + Result := AProtocol + Result; + end; end; -function SitesWithoutInformation(const website: String): Boolean; -begin - Result := False; - Result := SitesMemberOf(website, [ - MANGASPROJECT_ID, - MANGAVADISI_ID, - S2SCAN_ID, - EGSCANS_ID, - TURKCRAFT_ID, - HUGEMANGA_ID, - KIVMANGA_ID, - MANGACAN_ID, - MANGASTREAMTO_ID, - MANGAOKU_ID, - UNIXMANGA_ID - ]); -end; - -function SitesWithoutPageLink(const website : String) : Boolean; +function FillHost(const Host, URL: String): String; +var + P: String; begin - Result := False; - Result := SitesMemberOf(website, [ - EHENTAI_ID - ]); + SplitURL(URL,nil,@P); + Result:=RemoveURLDelim(Host)+P; end; -function SitesWithoutReferer(const website : String) : Boolean; -begin - Result := False; - Result:= SitesMemberOf(website, [ - MEINMANGA_ID, - PECINTAKOMIK_ID, - IKOMIK_ID, - PORNCOMIX_ID, - XXCOMICS_ID, - XXCOMICSMT_ID, - XXCOMICS3D_ID, - PORNCOMIXRE_ID, - PORNCOMIXIC_ID, - PORNXXXCOMICS_ID - ]); -end; - -function SitesRefererisURL(const website : String) : Boolean; +procedure FillHost(const Host: String; const URLs: TStrings); +var + i: Integer; begin - Result := False; - Result := SitesMemberOf(website, [ - SENMANGA_ID - ]); + if (URLs=nil) or (URLs.Count=0) then Exit; + for i:=0 to URLs.Count-1 do + URLs[i]:=FillHost(Host,URLs[i]); end; -function SitesWithSingleChapter(const website : String) : Boolean; +function MaybeFillHost(const Host, URL: String): String; +var + H,P: String; begin - Result := False; - Result := SitesMemberOf(website, [ - FAKKU_ID, - PURURIN_ID, - EHENTAI_ID, - MYREADINGMANGAINFO_ID, - NHENTAI_ID, - PORNCOMIX_ID, - XXCOMICS_ID, - XXCOMICSMT_ID, - XXCOMICS3D_ID, - PORNCOMIXRE_ID - ]); + SplitURL(URL,@H,@P); + if (H='') and (P<>'') then Result:=RemoveURLDelim(Host)+P + else Result:=URL; end; -function SitesIsWPManga(const websiteid: Cardinal): Boolean; +procedure MaybeFillHost(const Host: String; const URLs: TStrings); +var + i: Integer; begin - Result := websiteid in [ - MANGACAP_ID, - MANGABOOM_ID, - AUTHRONE_ID, - EYEONMANGA_ID - ]; + if (URLs=nil) or (URLs.Count=0) then Exit; + for i:=0 to URLs.Count-1 do + URLs[i]:=MaybeFillHost(Host,URLs[i]); end; -function SitesIsWPManga(const website: String): Boolean; +function GetHostURL(URL: String): String; +var + H: String; begin - Result := SitesIsWPManga(GetMangaSiteID(website)); + SplitURL(URL,@H,nil); + Result:=H; end; -function FillMangaSiteHost(const MangaID : Cardinal; URL : String) : String; -var - regx: TRegExpr; +function RemoveHostFromURL(URL: String): String; begin - Result := URL; - if Length(URL) < 3 then - Exit; - if MangaID <= High(WebsiteRoots) then - regx := TRegExpr.Create; - try - regx.ModifierI := True; - regx.Expression := '^([a-z]+\:)?(//)?[^/]*\w+\.\w+(\:\d+)?/?'; - if Pos('//', Result) = 1 then - Delete(Result, 1, 2); - if not regx.Exec(URL) then - Result := TrimRightChar(WebsiteRoots[MangaID, 1], ['/']) + - '/' + TrimLeftChar(URL, ['/']); - regx.Expression := '([^:])[/]{2,}(\b|\Z)'; - Result := regx.Replace(Result, '$1/', True); - finally - regx.Free - end; + SplitURL(URL,nil,@Result); end; -function RemoveHostFromURL(URL : String) : String; +procedure RemoveHostFromURLs(const URLs: TStringList); var - regx: TRegExpr; + i: Integer; begin - Result := URL; - regx := TRegExpr.Create; - try - regx.ModifierI := True; - regx.Expression := '^([a-z]+\:)?(//)?[^/]*\w+\.\w+(\:\d+)?/?'; - if regx.Exec(URL) then - Result := regx.Replace(URL, '/', False); - finally - regx.Free - end; + if (URLs=nil) or (URLs.Count=0) then Exit; + for i:=0 to URLs.Count-1 do + URLs[i]:=RemoveHostFromURL(URLs[i]); end; -procedure RemoveHostFromURLs(const URLs : TStringList); +procedure RemoveHostFromURLsPair(const URLs, Names: TStringList); var - i: Integer; - regx: TRegExpr; + i: Integer; begin - if URLs.Count > 0 then + if (URLs=nil) or (Names=nil) or (URLs.Count<>Names.Count) or (URLs.Count=0) then Exit; + i:=0; + while i<URLs.Count do begin - regx := TRegExpr.Create; - try - regx.ModifierI := True; - regx.Expression := '^([a-z]+\:)?(//)?[^/]*\w+\.\w+(\:\d+)?/?'; - for i := 0 to URLs.Count - 1 do - begin - if regx.Exec(URLs[i]) then - URLs[i] := regx.Replace(URLs[i], '/', False); - end; - finally - regx.Free + URLs[i]:=RemoveHostFromURL(URLs[i]); + if URLs[i]<>'' then + Inc(i) + else + begin + URLs.Delete(i); + Names.Delete(i); end; end; end; -procedure RemoveHostFromURLsPair(const URLs, Names : TStringList); +function EncodeCriticalURLElements(const URL: String): String; var - i: Integer; - regx: TRegExpr; + H,P: String; begin - if URLs.Count > 0 then - begin - regx := TRegExpr.Create; - try - regx.ModifierI := True; - regx.Expression := '^([a-z]+\:)?(//)?[^/]*\w+\.\w+(\:\d+)?/?'; - i := 0; - while i < URLs.Count do - begin - if regx.Exec(URLs[i]) then - URLs[i] := regx.Replace(URLs[i], '/', False); - if URLs[i] = '/' then - begin - URLs.Delete(i); - Names.Delete(i); - end - else - Inc(i); - end; - finally - regx.Free - end; - end; + SplitURL(URL,@H,@P); + Result:=H+EncodeTriplet(P,'%',URLSpecialChar+URLFullSpecialChar-['/']); end; procedure ParseJSONArray(const S, Path: String; var OutArray: TStringList); @@ -1498,11 +1024,15 @@ procedure ParseJSONArray(const S, Path: String; var OutArray: TStringList); i: Integer; begin OutArray.BeginUpdate; - P := TJSONParser.Create(Trim(S)); + {$IF (FPC_FULLVERSION >= 30101)} + P := TJSONParser.Create(Trim(S), [joUTF8]); + {$ELSE} + P := TJSONParser.Create(Trim(S), True); + {$ENDIF} try D := P.Parse; try - If Assigned(D) then + if Assigned(D) then if (D.JSONType = jtArray) and (D.Count > 0) then for i := 0 to D.Count - 1 do begin @@ -1518,36 +1048,164 @@ procedure ParseJSONArray(const S, Path: String; var OutArray: TStringList); OutArray.EndUpdate; end; -procedure ParseHTML(const aRaw: string; var aOutput: TStringList); +procedure ParseHTMLTree(var tp: TTreeParser; const S: String); begin - if not Assigned(aOutput) then Exit; - with TParseHTML.Create(aRaw) do try - Output := aOutput; - Exec; - finally - Free; + if tp = nil then tp := TTreeParser.Create; + with tp do begin + parsingModel := pmHTML; + repairMissingStartTags := True; + repairMissingEndTags := True; + trimText := False; + readComments := False; + readProcessingInstructions := False; + autoDetectHTMLEncoding := False; + if S <> '' then parseTree(S); end; end; -function QuotedStrd(const S: string): string; +function SelectXPathString(Expression: String; TP: TTreeParser): String; begin - Result := AnsiQuotedStr(S, '"'); + Result := ''; + if TP = nil then Exit; + if TP.getLastTree = nil then Exit; + try + Result := TXQueryEngine.evaluateStaticXPath3(Expression, TP.getLastTree).toString; + except + end; end; -function QuotedStrd(const S: Integer): string; +function SelectXPathIX(Expression: String; TP: TTreeParser): IXQValue; begin - Result := QuotedStrd(IntToStr(S)); + Result := xqvalue(); + if TP = nil then Exit; + if TP.getLastTree = nil then Exit; + try + Result := TXQueryEngine.evaluateStaticXPath3(Expression, TP.getLastTree); + except + end; end; -function BracketStr(const S: string): string; +function SelectCSSString(Expression: String; TP: TTreeParser): String; begin - Result := '(' + S + ')'; + Result := ''; + if TP = nil then Exit; + if TP.getLastTree = nil then Exit; + try + Result := TXQueryEngine.evaluateStaticCSS3(Expression, TP.getLastTree).toString; + except + end; end; -procedure ParseCommandLine(const cmd: string; var Output: TStrings; +function SelectCSSIX(Expression: String; TP: TTreeParser): IXQValue; +begin + Result := xqvalue(); + if TP = nil then Exit; + if TP.getLastTree = nil then Exit; + try + Result := TXQueryEngine.evaluateStaticCSS3(Expression, TP.getLastTree); + except + end; +end; + +function ConvertCharsetToUTF8(S: String): String; +var + cs: String; +begin + Result := S; + if Trim(S) = '' then Exit; + with TRegExpr.Create do + try + Expression := '(?ig)^.*<meta\s.*charset=([^''";\s]+).*$'; + if Exec(S) then begin + cs := LowerCase(Replace(S, '$1', True)); + if cs = 'gb2312' then cs := EncodingCP936 + else if (cs = 'big5') or (cs = 'big5-hkscs') then cs := EncodingCP950; + end + else cs := GuessEncoding(S); + finally + Free; + end; + if cs <> '' then Result := ConvertEncoding(S, cs, 'utf8'); +end; + +procedure ConvertCharsetToUTF8(S: TStrings); +var + cs: String; + i: Integer; +begin + if Trim(S.Text) = '' then Exit; + cs := ''; + if S.Count > 1 then + begin + with TRegExpr.Create do + try + Expression := '(?ig)^.*<meta\s.*charset=([^''";\s]+).*$'; + for i := 0 to S.Count - 1 do + if Pos('/head', S[i]) > 0 then Break + else if Pos('<meta', S[i]) > 0 then + if Exec(S[i]) then + begin + cs := LowerCase(Replace(S[i], '$1', True)); + if cs = 'gb2312' then cs := EncodingCP936 + else if (cs = 'big5') or (cs = 'big5-hkscs') then cs := EncodingCP950; + Break; + end; + finally + Free; + end; + end; + if cs = '' then cs := GuessEncoding(S.Text); + if cs <> '' then S.Text := ConvertEncoding(S.Text, cs, 'utf8'); +end; + +function StreamToString(const Stream: TStream): String; +var + p, x: Int64; +begin + //SetString(Result, PChar(Stream.Memory), Stream.Size div SizeOf(Char)); + p := Stream.Position; + Stream.Position := 0; + Setlength(Result, Stream.Size); + x := Stream.Read(PChar(Result)^, Stream.Size); + SetLength(Result, x); + Stream.Position := p; +end; + +function GetRightValue(const Name, s: String): String; +var + i: Integer; +begin + if s = '' then Exit(''); + if Name = '' then Exit(s); + i := Pos(Name, s); + if i > 0 then + Result := Trim(Copy(s, i + Length(Name), Length(s))); +end; + +function QuotedStr(const S: Integer): String; +begin + Result := AnsiQuotedStr(IntToStr(S), ''''); +end; + +function QuotedStrD(const S: String): String; +begin + Result := AnsiQuotedStr(S, '"'); +end; + +function QuotedStrD(const S: Integer): String; +begin + Result := AnsiQuotedStr(IntToStr(S), '"'); +end; + +function BracketStr(const S: String): String; +begin + Result := '(' + S + ')'; +end; + +procedure ParseCommandLine(const cmd: String; var Output: TStrings; AStripQuotes: Boolean = False); var - s, cl: string; + s, cl: String; cq: Integer; acl, lq: Boolean; @@ -1612,82 +1270,8 @@ procedure ParseCommandLine(const cmd: string; var Output: TStrings; end; end; -function ParsedCommandLine(const cmd: String): TArrayOfString; -var - ts: TStrings; -begin - if cmd = '' then Exit; - ts := TStringList.Create; - try - ParseCommandLine(cmd, ts, True); - Result := StringsToArray(ts); - finally - ts.Free; - end; -end; - -function StringsToArray(const S: TStrings): TArrayOfString; -var - i: Integer; -begin - if not Assigned(S) then Exit; - if S.Count = 0 then Exit; - SetLength(Result, S.Count); - for i := 0 to S.Count - 1 do - Result[i] := S[i]; -end; - -function StringsToCommandLine(const S: TStrings): string; -var - i: Integer; -begin - Result := ''; - if S.Count>0 then - begin - for i := 0 to S.Count-1 do - begin - if Pos(' ', S[i]) <> 0 then - Result := Result + '"' + S[i] + '" ' - else - Result := Result + S[i] + ' '; - end; - Result := Trim(Result); - end; -end; - -function StringsToCommandLine(const S: array of string): string; -var - i: Integer; -begin - Result := ''; - if Length(S)>0 then - begin - for i := Low(S) to High(S) do - begin - if (Pos(' ', S[i]) <> 0) and - ((LeftStr(S[i], 1) <> '"') and (RightStr(S[i], 1) <> '"')) then - Result := Result + '"' + S[i] + '" ' - else - Result := Result + S[i] + ' '; - end; - Result := Trim(Result); - end; -end; - -procedure DeleteArrayOfString(var TheStrings: TArrayOfString;Index: Integer); - var - i: Integer; - begin - if Length(TheStrings) > 0 then - begin - for i := Low(TheStrings) to High(TheStrings) -1 do - TheStrings[i] := TheStrings[i + 1]; - SetLength(TheStrings, Length(TheStrings) - 1); - end; - end; - function RandomString(SLength: Integer; ONumber: Boolean; OSymbol: Boolean; - OSpace: Boolean): string; + OSpace: Boolean): String; var sgen: String; const @@ -1707,35 +1291,27 @@ function RandomString(SLength: Integer; ONumber: Boolean; OSymbol: Boolean; sgen := sgen + #32; repeat Result := Result + sgen[Random(Length(sgen)) + 1]; - until (Length(Result) = SLength) + until (Length(Result) = SLength); end; function GetValuesFromString(Str: String; Sepr: Char): String; var - i: Integer; + p: Integer; + s: String; begin Result := ''; - if Str = '' then - Exit; - if Pos(Sepr, Str) > 0 then + if Str = '' then Exit; + p := Pos(Sepr, Str); + if p > 0 then begin - for i := 1 to Length(Str) do - if (Str[i] = Sepr) and (i < Length(Str)) then - begin - Result := Copy(Str, i + 1, Length(Str) - i); - Break; - end; - if Result <> '' then - begin - while (Result <> '') and (Result[Length(Result)] in [' ', '"', '''', ';']) do - Delete(Result, Length(Result), 1); - while (Result <> '') and (Result[1] in [' ', '"', '''']) do - Delete(Result, 1, 1); - end; + p := p + Length(Sepr); + s := Trim(Copy(Str, p, Length(Str))); + if s <> '' then s := TrimChar(s, ['''', '"', ';', ' ']); + Result := s; end; end; -procedure InvertStrings(const St : TStringList); +procedure InvertStrings(const St: TStringList); var i: Integer; begin @@ -1744,7 +1320,7 @@ procedure InvertStrings(const St : TStringList); St.Exchange(i, St.Count - 1 - i); end; -function FixHTMLTagQuote(const s : String) : String; +function FixHTMLTagQuote(const s: String): String; begin Result := s; if Length(Result) > 2 then @@ -1756,7 +1332,7 @@ function FixHTMLTagQuote(const s : String) : String; end; end; -function FixCommonBrokenHTML(const s: String): string; +function FixCommonBrokenHTML(const s: String): String; begin Result := s; Result := StringReplace(Result, '="width="', '="width:', [rfReplaceAll]); @@ -1766,48 +1342,48 @@ function FixCommonBrokenHTML(const s: String): string; function URLDecode(const s: String): String; var - sAnsi: String; - sUtf8: String; - sWide: WideString; - - i, len: Cardinal; - ESC: string[2]; - CharCode: integer; - c: char; -begin - sAnsi := PChar(s); - SetLength(sUtf8, Length(sAnsi)); - i := 1; - len := 1; - while (i <= Cardinal(Length(sAnsi))) do begin - if (sAnsi[i] <> '%') then begin - if (sAnsi[i] = '+') then begin - c := ' '; - end else begin - c := sAnsi[i]; - end; - sUtf8[len] := c; - Inc(len); + sAnsi: String; + sUtf8: String; + sWide: WideString; + + i, len: Integer; + ESC: String[2]; + CharCode: Integer; + c: Char; +begin + sAnsi := PChar(s); + SetLength(sUtf8, Length(sAnsi)); + i := 1; + len := 1; + while (i <= Cardinal(Length(sAnsi))) do begin + if (sAnsi[i] <> '%') then begin + if (sAnsi[i] = '+') then begin + c := ' '; end else begin - Inc(i); - ESC := Copy(sAnsi, i, 2); - Inc(i, 1); - try - CharCode := StrToInt('$' + ESC); - c := Char(CharCode); - sUtf8[len] := c; - Inc(len); - except end; + c := sAnsi[i]; end; + sUtf8[len] := c; + Inc(len); + end else begin Inc(i); - end; - Dec(len); - SetLength(sUtf8, len); + ESC := Copy(sAnsi, i, 2); + Inc(i, 1); + try + CharCode := StrToInt('$' + ESC); + c := Char(CharCode); + sUtf8[len] := c; + Inc(len); + except end; + end; + Inc(i); + end; + Dec(len); + SetLength(sUtf8, len); - sWide := UTF8Decode(sUtf8); - len := Length(sWide); + sWide := UTF8Decode(sUtf8); + len := Length(sWide); - Result := {%H-}sWide; + Result := {%H-}sWide; end; function HTMLDecode(const AStr: String): String; @@ -1825,51 +1401,52 @@ function HTMLDecode(const AStr: String): String; begin case Sp^ of '&': begin - Cp := Sp; - Inc(Sp); - case Sp^ of - 'a': if AnsiStrPos(Sp, 'amp;') = Sp then { do not localize } - begin - Inc(Sp, 3); - Rp^ := '&'; - end; - 'l', - 'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then { do not localize } - begin - Cp := Sp; - Inc(Sp, 2); - while (Sp^ <> ';') and (Sp^ <> #0) do - Inc(Sp); - if Cp^ = 'l' then - Rp^ := '<' - else - Rp^ := '>'; - end; - 'n': if AnsiStrPos(Sp, 'nbsp;') = Sp then { do not localize } - begin - Inc(Sp, 4); - Rp^ := ' '; - end; - 'q': if AnsiStrPos(Sp, 'quot;') = Sp then { do not localize } - begin - Inc(Sp,4); - Rp^ := '"'; - end; - '#': begin - Tp := Sp; - Inc(Tp); - while (Sp^ <> ';') and (Sp^ <> #0) do - Inc(Sp); - SetString(S, Tp, Sp - Tp); - Val(S, I, Code); - Rp^ := Chr((I)); - end; - else - Exit; - end; - end - else - Rp^ := Sp^; + Cp := Sp; + Inc(Sp); + case Sp^ of + 'a': if AnsiStrPos(Sp, 'amp;') = Sp then { do not localize } + begin + Inc(Sp, 3); + Rp^ := '&'; + end; + 'l', + 'g': if (AnsiStrPos(Sp, 'lt;') = Sp) or (AnsiStrPos(Sp, 'gt;') = Sp) then + { do not localize } + begin + Cp := Sp; + Inc(Sp, 2); + while (Sp^ <> ';') and (Sp^ <> #0) do + Inc(Sp); + if Cp^ = 'l' then + Rp^ := '<' + else + Rp^ := '>'; + end; + 'n': if AnsiStrPos(Sp, 'nbsp;') = Sp then { do not localize } + begin + Inc(Sp, 4); + Rp^ := ' '; + end; + 'q': if AnsiStrPos(Sp, 'quot;') = Sp then { do not localize } + begin + Inc(Sp, 4); + Rp^ := '"'; + end; + '#': begin + Tp := Sp; + Inc(Tp); + while (Sp^ <> ';') and (Sp^ <> #0) do + Inc(Sp); + SetString(S, Tp, Sp - Tp); + Val(S, I, Code); + Rp^ := Chr((I)); + end; + else + Exit; + end; + end + else + Rp^ := Sp^; end; Inc(Rp); Inc(Sp); @@ -1884,17 +1461,13 @@ function RemoveSymbols(const input: String): String; i: Integer; begin Result := input; - for i := Low(Symbols) to High(Symbols) do - begin - if Pos(Symbols[i], Result) > 0 then - Result := StringReplace(Result, Symbols[i], '', [rfReplaceAll]); - end; - - if (Length(Result) > 0) and - (Result[Length(Result)] = '.') then - begin - Result[Length(Result)] := '-'; - end; + if Result = '' then Exit; + i := 1; + while i <= Length(Result) do + if CharInSet(Result[i], Symbols) then + Delete(Result, i, 1) + else + Inc(i); end; procedure InvertStrings(const Sts: array of TStringList); @@ -1905,28 +1478,23 @@ procedure InvertStrings(const Sts: array of TStringList); InvertStrings(Sts[i]); end; -procedure TrimStrings(const Str : TStringList); +procedure TrimStrings(TheStrings: TStrings); var i: Integer; begin - if Str.Count > 0 then + if TheStrings = nil then Exit; + if TheStrings.Count > 0 then begin i := 0; - while i < Str.Count do - begin - if Trim(Str[i]) = '' then - Str.Delete(i) - else - begin - Str[i] := Trim(Str[i]); - Inc(i); - end; + while i < TheStrings.Count do begin + TheStrings[i] := Trim(TheStrings[i]); + if TheStrings[i] = '' then TheStrings.Delete(i) + else Inc(i); end; end; end; -procedure RemoveDuplicateStrings(Strs : array of TStringList; - RemIndex : Cardinal); +procedure RemoveDuplicateStrings(Strs: array of TStringList; RemIndex: Integer); var i, j, k: Integer; begin @@ -1943,7 +1511,7 @@ procedure RemoveDuplicateStrings(Strs : array of TStringList; if Strs[RemIndex].Strings[i] = Strs[RemIndex].Strings[j] then begin for k := 0 to High(Strs) do - Strs[k].Delete(j); + Strs[k].Delete(j); end else Inc(j); @@ -1952,7 +1520,45 @@ procedure RemoveDuplicateStrings(Strs : array of TStringList; end; end; -procedure CleanHTMLComments(const Str : TStringList); +function MergeCaseInsensitive(Strs: array of String): String; +var + s: TStringList; + i: Integer; +begin + if Length(Strs) = 0 then Exit; + s := TStringList.Create; + try + s.CaseSensitive := False; + s.Duplicates := dupIgnore; + s.Sorted := True; + for i := Low(Strs) to High(Strs) do + s.AddText(Strs[i]); + Result := s.Text; + finally + s.Free; + end; +end; + +function MergeCaseInsensitive(Strs: array of TStrings): String; +var + s: TStringList; + i: Integer; +begin + if Length(Strs) = 0 then Exit; + s := TStringList.Create; + try + s.CaseSensitive := False; + s.sorted := True; + s.Duplicates := dupIgnore; + for i := Low(Strs) to High(Strs) do + s.AddText(Strs[i].Text); + Result := s.Text; + finally + s.Free; + end; +end; + +procedure CleanHTMLComments(const Str: TStringList); var i: Integer; begin @@ -1970,110 +1576,438 @@ procedure CleanHTMLComments(const Str : TStringList); end; function CorrectPathSys(const Path: String): String; +{$IFDEF WINDOWS} +var + s: UnicodeString; +{$ENDIF} begin - Result := Trim(Path); - if Length(Result) > 0 then + Result := FixWhiteSpace(Path); + {$IFDEF WINDOWS} + Result := RemovePathDelim(ExpandFileNameUTF8(TrimFilename(GetForcedPathDelims(Result)), FMD_DIRECTORY)); + Result := TrimRightChar(Result, ['.']); + s := UTF8Decode(Result); + if Length(s) > MAX_PATHDIR then begin - {$IFDEF WINDOWS} - //max length = 260 - Result := StringReplace(Result, '/', '\', [rfReplaceAll]); - if Length(Result) > 0 then + SetLength(s, MAX_PATHDIR); + Result := UTF8Encode(s); + end; + {$ELSE} + Result := ExpandFileNameUTF8(TrimFilename(Path), FMD_DIRECTORY); + {$ENDIF} + Result := AppendPathDelim(Trim(Result)); +end; + +function RemovePathDelim(const Path: string): string; +begin + Result := TrimRightChar(Path, AllowDirectorySeparators); +end; + +function StringOfString(c: String; l: Integer): String; +var + i: Integer; +begin + Result := ''; + if c = '' then Exit; + if l < 1 then Exit; + for i := 1 to l do + Result += c; +end; + +function IncStr(const S: String; N: Integer): String; +var + i: Integer; +begin + Result := S; + i := StrToIntDef(S, -1); + if i > -1 then + begin + Inc(i, N); + Result := IntToStr(i); + end; +end; + +function IncStr(const I: Integer; N: Integer): String; +begin + Result := IntToStr(I + N); +end; + +function StringIn(const AText: String; const AValues: array of String): Boolean; +var + i: Integer; +begin + for i := Low(AValues) to High(AValues) do + if AValues[i] = AText then + Exit(True); + Result := False; +end; + +function TextIn(const AText: String; const AValues: array of String): Boolean; +var + i: Integer; +begin + for i := Low(AValues) to High(AValues) do + if SameText(AValues[i], AText) then + Exit(True); + Result := False; +end; + +function GetHeaderValue(const AHeaders: TStrings; HName: String): String; +var + i, p: Integer; +begin + Result := ''; + if (AHeaders.Count > 0) and (HName <> '') then + begin + for i := 0 to AHeaders.Count - 1 do begin - if Length(Result) > MAX_PATH - 13 then - SetLength(Result, MAX_PATH - 13); - Result := StringReplace(Result, '\\', '\', [rfReplaceAll]); + if (Pos(lowercase(HName), lowercase(AHeaders.Strings[i])) > 0) then + begin + p := Pos(':', AHeaders.Strings[i]); + if p > 0 then + Result := Copy(AHeaders.Strings[i], p + 2, + Length(AHeaders.Strings[i]) - p - 1); + end; end; - if Length(Result) > 0 then + end; +end; + +function Base64Encode(const s: String): String; +begin + if s = '' then Exit(s); + Result := EncodeStringBase64(s); +end; + +function Base64Decode(const s: String): String; +begin + if s = '' then Exit(s); + Result := DecodeStringBase64(s); +end; + +function Base64Encode(const TheStream: TStream): Boolean; +var + OutStream: TMemoryStream; + Encoder: TBase64EncodingStream; +begin + Result := False; + if TheStream = nil then Exit; + if TheStream.Size = 0 then Exit; + OutStream := TMemoryStream.Create; + try + Encoder := TBase64EncodingStream.Create(OutStream); + try + TheStream.Position := 0; + Encoder.CopyFrom(TheStream, TheStream.Size); + Encoder.Flush; + TheStream.Position := 0; + TheStream.Size := 0; + OutStream.Position := 0; + TheStream.CopyFrom(OutStream, OutStream.Size); + Result := True; + finally + Encoder.Free; + end; + finally + OutStream.Free; + end; +end; + +function Base64Decode(const TheStream: TStream): Boolean; +var + Decoder: TBase64DecodingStream; + InStream: TMemoryStream; +begin + Result := False; + if TheStream = nil then Exit; + if TheStream.Size = 0 then Exit; + InStream := TMemoryStream.Create; + try + TheStream.Position := 0; + InStream.CopyFrom(TheStream, TheStream.Size); + try + InStream.Position := 0; + Decoder := TBase64DecodingStream.Create(InStream); + if Decoder.Size > 0 then begin + TheStream.Position := 0; + TheStream.Size := 0; + TheStream.CopyFrom(Decoder, Decoder.Size); + Result := True; + end; + except + end; + Decoder.Free; + finally + InStream.Free; + end; +end; + +function PadZero(const S: String; ATotalWidth: Integer; PadAll: Boolean; StripZero: Boolean): String; + + function PadN(const SN: String): String; + begin + Result := SN; + if StripZero and (Length(Result) > ATotalWidth) then + while (Result[1] = '0') and (Length(Result) > ATotalWidth) do + Delete(Result, 1, 1); + if Length(Result) < ATotalWidth then + Result := StringOfChar('0', ATotalWidth - Length(Result)) + Result; + end; + +var + ls, i: Integer; + n: String; +begin + Result := ''; + if S = '' then Exit; + ls := Length(S); + i := 1; + n := ''; + Result := ''; + repeat + if S[i] in ['0'..'9'] then + n := n + s[i] + else begin - if Result[Length(Result)] <> '\' then - Result := Result + '\'; + if n <> '' then + begin + Result := Result + PadN(n); + n := ''; + if PadAll then + begin + Result := Result + PadZero(Copy(S, i, ls), ATotalWidth, PadAll, StripZero); + i := ls; + end; + Break; + end; + Result := Result + S[i]; end; - {$ENDIF} - {$IFDEF UNIX} - Result := StringReplace(Result, '\', '/', [rfReplaceAll]); - Result := StringReplace(Result, '//', '/', [rfReplaceAll]); - if Length(Result) > 0 then + Inc(i); + until i > ls; + if n <> '' then + Result := Result + PadN(n); + if i < ls then + Result := Result + Copy(S, i, ls); +end; + +procedure PadZeros(const S: TStrings; ATotalWidth: Integer; PadAll: Boolean; StripZeros: Boolean); +var + i: Integer; +begin + if S = nil then Exit; + if S.Count = 0 then Exit; + S.BeginUpdate; + try + for i := 0 to S.Count - 1 do + S[i] := PadZero(S[i], ATotalWidth, PadAll, StripZeros); + finally + S.EndUpdate; + end; +end; + +function RegExprGetMatch(const ARegExpr, AInputStr : RegExprString; + const AMatchIdx: Integer): String; +begin + Result := ''; + if AMatchIdx < 0 then Exit; + with TRegExpr.Create do + try + Expression := ARegExpr; + if Exec(AInputStr) then + Result := Match[AMatchIdx]; + finally + Free; + end; +end; + +procedure SerializeAndMaintainNames(const F: TStrings); +var + s, so: TStringList; + sameorder: Boolean; + i, ls: Integer; + fs: String; + + function identicalstrings(s1, s2: TStrings): Boolean; + var + j: Integer; + begin + Result := False; + if s1.Count <> s2.Count then Exit; + for j := 0 to s1.Count - 1 do + if s1[j] <> s2[j] then + Exit; + Result := True; + end; + + procedure checksorder; + begin + so.Clear; + so.AddStrings(s); + so.Sort; + sameorder := identicalstrings(s, so); + end; + +begin + if F = nil then Exit; + if F.Count = 0 then Exit; + s := TStringList.Create; + F.BeginUpdate; + try + //try sorting it + s.AddStrings(F); + s.Sort; + sameorder := identicalstrings(s, F); + + //try padzero + if not sameorder then + begin + so := TStringList.Create; + try + ls := Length(IntToStr(F.Count)); + if ls < 3 then + ls := 3; + s.Clear; + s.AddStrings(F); + PadZeros(s, ls, False, False); + checksorder; + + // add serializing number + if not sameorder then + begin + s.Clear; + s.AddStrings(F); + fs := '%.' + IntToStr(ls) + 'd_%s'; + for i := 0 to s.Count - 1 do + s[i] := Format(fs, [i + 1, s[i]]); + checksorder; + end; + finally + so.Free; + end; + end; + if sameorder then begin - if Result[Length(Result)] <> '/' then - Result := Result + '/'; + F.Clear; + F.AddStrings(s); end; - {$ENDIF} + finally + F.EndUpdate; + s.Free; end; end; -function GetHeaderValue(const AHeaders: TStrings; HName: String): String; +function ShortenString(const S: String; const MaxWidth: Integer; + const RightLength: Integer; const EllipsisStr: String): String; var - i, p: Integer; + r: String; +begin + Result := S; + if Length(Result) > MaxWidth then + begin + if RightLength + Length(EllipsisStr) > MaxWidth then + begin + Result := RightStr(Result, MaxWidth); + Exit; + end; + r := RightStr(Result, RightLength); + SetLength(Result, MaxWidth - RightLength - Length(EllipsisStr)); + Result := Result + EllipsisStr + r; + end; +end; + +function TitleCase(const S: string): string; +begin + Result := AnsiProperCase(S, + [#9, #10, #13, + ' ', '.', ',', '-', '+', '_', '=', + '/', '\', '[', ']', '(', ')', '{', '}', '<', '>']); +end; + +function StringReplaceBrackets(const S, OldPattern, NewPattern: String; Flags: TReplaceFlags): String; +var + b1, b2: Char; + p, r: String; + i: Integer; begin - Result := ''; - if (AHeaders.Count > 0) and (HName <> '') then - begin - for i := 0 to AHeaders.Count - 1 do - begin - if (Pos(lowercase(HName), lowercase(AHeaders.Strings[i])) > 0) then - begin - p := Pos(':', AHeaders.Strings[i]); - if p > 0 then - Result := Copy(AHeaders.Strings[i], p + 2, - Length(AHeaders.Strings[i]) - p - 1); - end; + Result := Trim(S); + if OldPattern = '' then Exit; + p := Trim(OldPattern); + r := Trim(NewPattern); + b1 := #0; + b2 := #0; + i := Pos(p, Result); + if i > 0 then begin + if i > 1 then b1 := Result[i - 1]; + if i + Length(p) <= Length(Result) then b2 := Result[i + Length(p)]; + if b1 in ['(', '[', '{'] then p := b1 + p else b1 := #0; + if b2 in [')', ']', '}'] then p := p + b2 else b2 := #0; + if r <> '' then begin + if b1 <> #0 then r := b1 + r; + if b2 <> #0 then r := r + b2; end; + Result := StringReplace(Result, p, r, Flags); end; end; -function CustomRename(const AString, AWebsite, AMangaName, AAuthor, AArtist, - AChapter, ANumbering : String; const AIsUnicodeRemove : Boolean) : String; +function CustomRename(const AString, AWebsite, AMangaName, AAuthor, AArtist, AChapter, + ANumbering: String; + const AReplaceUnicode: Boolean; + const AReplaceUnicodeStr: String; + const AFileName: String): String; + + function FixStringLocal(const S: String): String; + begin + // fix htmlentities + Result := CommonStringFilter(S); + // remove unaccepted character (Windows) + Result := RemoveSymbols(Result); + // strip unicode character + if AReplaceUnicode then + Result := ReplaceUnicodeChar(Result, AReplaceUnicodeStr); + end; + var - chap: String; + fchapter: String; begin - Result := ''; - chap := Trim(AChapter); - //Convert Digit in chapter name - if MainForm.options.ReadBool('saveto', 'ConvertDigitVolume', True) then - if MainForm.options.ReadBool('saveto', 'ConvertDigitChapter', True) then - padZero(chap, MainForm.options.ReadInteger('saveto', 'DigitVolumeLength', 2), - MainForm.options.ReadInteger('saveto', 'DigitChapterLength', 3)) - else - padZero(chap, MainForm.options.ReadInteger('saveto', 'DigitVolumeLength', 2), 0) - else if MainForm.options.ReadBool('saveto', 'ConvertDigitChapter', True) then - padZero(chap, 0, MainForm.options.ReadInteger('saveto', 'DigitChapterLength', 3)); + Result := AString; - if (Pos('%NUMBERING%', AString) = 0) and (Pos('%CHAPTER%', AString) = 0) then - Result := ANumbering + AString - else - Result := AString; + // for rename chapter only + if AChapter <> '' then begin + // numbering/index + if (Pos(CR_NUMBERING, Result) = 0) and (Pos(CR_CHAPTER, Result) = 0) then + Result := ANumbering + Result; + Result := StringReplaceBrackets(Result, CR_NUMBERING, ANumbering, [rfReplaceAll]); - Result := TrimLeft(TrimRight(Result)); - Result := StringReplace(Result, '%WEBSITE%', AWebsite, [rfReplaceAll]); - Result := StringReplace(Result, '%MANGA%', AMangaName, [rfReplaceAll]); - Result := StringReplace(Result, '%AUTHOR%', AAuthor, [rfReplaceAll]); - Result := StringReplace(Result, '%ARTIST%', AArtist, [rfReplaceAll]); - Result := StringReplace(Result, '%CHAPTER%', chap, [rfReplaceAll]); - if (AWebsite = WebsiteRoots[FAKKU_ID, 0]) or - (AWebsite = WebsiteRoots[MANGASTREAM_ID, 0]) then - begin - if Pos('%NUMBERING% - ', Result) > 0 then - Result := StringReplace(Result, '%NUMBERING% - ', '', [rfReplaceAll]) - else - Result := StringReplace(Result, '%NUMBERING%', '', [rfReplaceAll]) - end - else - Result := StringReplace(Result, '%NUMBERING%', ANumbering, [rfReplaceAll]); - Result := StringReplace(Result, '/', '', [rfReplaceAll]); - Result := StringReplace(Result, '\', '', [rfReplaceAll]); - if Result = '' then - begin - if (AWebsite = WebsiteRoots[FAKKU_ID, 0]) or - (AWebsite = WebsiteRoots[MANGASTREAM_ID, 0]) then - Result := chap + // pad number + fchapter := Trim(AChapter); + if OptionConvertDigitVolume then + begin + if OptionConvertDigitChapter then + VolumeChapterPadZero(fchapter, OptionConvertDigitVolumeLength, OptionConvertDigitChapterLength) + else + VolumeChapterPadZero(fchapter, OptionConvertDigitVolumeLength, 0); + end else + if OptionConvertDigitChapter then + VolumeChapterPadZero(fchapter, 0, OptionConvertDigitChapterLength); + + fchapter := FixStringLocal(fchapter); + + Result := StringReplaceBrackets(Result, CR_CHAPTER, fchapter, [rfReplaceAll]); + + if Result = '' then Result := ANumbering; end; - if AIsUnicodeRemove then - Result := UnicodeRemove(Result); - Result := Trim(Result); - Result := RemoveSymbols(HTMLEntitiesFilter(StringFilter(Result))); + Result := StringReplaceBrackets(Result, CR_WEBSITE, FixStringLocal(AWebsite), [rfReplaceAll]); + Result := StringReplaceBrackets(Result, CR_MANGA, FixStringLocal(AMangaName), [rfReplaceAll]); + Result := StringReplaceBrackets(Result, CR_AUTHOR, FixStringLocal(AAuthor), [rfReplaceAll]); + Result := StringReplaceBrackets(Result, CR_ARTIST, FixStringLocal(AArtist), [rfReplaceAll]); + Result := StringReplaceBrackets(Result, CR_FILENAME, FixStringLocal(AFileName), [rfReplaceAll]); + if Result = '' then Result := FixStringLocal(AMangaName); + + if Result = '' then Exit; + + // remove pathdelim + Result := TrimChar(Result, AllowDirectorySeparators); end; function GetString(const Source, sStart, sEnd: String): String; @@ -2097,7 +2031,7 @@ function GetString(const Source, sStart, sEnd: String): String; function Find(const S: String; var List: TStringList; out index: Integer): Boolean; var - i: Cardinal; + i: Integer; begin Result := False; index := -1; @@ -2121,7 +2055,7 @@ function FindStrQuick(const s: String; var AStrings: TStringList): Boolean; if AStrings.Count > 0 then begin if not AStrings.Sorted then - AStrings.Sort; + AStrings.Sorted := True; Result := AStrings.Find(s, p); end else @@ -2130,7 +2064,7 @@ function FindStrQuick(const s: String; var AStrings: TStringList): Boolean; procedure GetParams(const output: TStrings; input: String); var - l: word; + l: Integer; begin repeat l := Pos(SEPERATOR, input); @@ -2144,7 +2078,7 @@ procedure GetParams(const output: TStrings; input: String); procedure GetParams(var output: TCardinalList; input: String); var - l: word; + l: Integer; begin repeat l := Pos(SEPERATOR, input); @@ -2158,7 +2092,7 @@ procedure GetParams(var output: TCardinalList; input: String); procedure GetParams(var output: TList; input: String); var - l: word; + l: Integer; begin repeat l := Pos(SEPERATOR, input); @@ -2170,10 +2104,10 @@ procedure GetParams(var output: TList; input: String); until l = 0; end; -function ExtractParam(const output : TStrings; input, sep : String; - WhiteSp : Boolean) : Integer; +function ExtractParam(const output: TStrings; input, sep: String; + WhiteSp: Boolean): Integer; var - l, lse: QWord; + l, lse: Integer; s: String; begin Result := 0; @@ -2197,6 +2131,11 @@ function ExtractParam(const output : TStrings; input, sep : String; output.Add(input); end; +function GetParams(const input: String): String; +begin + Result := StringReplace(input, SEPERATOR, LineEnding, [rfReplaceAll]); +end; + function RemoveDuplicateNumbersInString(const AString: String): String; var i, j: Integer; @@ -2222,13 +2161,13 @@ function RemoveDuplicateNumbersInString(const AString: String): String; end; Result := ''; for i := 0 to list.Count - 1 do - Result := Result + IntToStr(integer(list.Items[i])) + SEPERATOR; + Result := Result + IntToStr(Integer(list.Items[i])) + SEPERATOR; list.Free; end; function SetParams(input: TObject): String; var - i: Cardinal; + i: Integer; begin Result := ''; if input is TStringList then @@ -2258,7 +2197,7 @@ function SetParams(input: TObject): String; function SetParams(const input: array of String): String; var - i: Cardinal; + i: Integer; begin Result := ''; if Length(input) = 0 then @@ -2267,7 +2206,107 @@ function SetParams(const input: array of String): String; Result := Result + input[i] + SEPERATOR; end; -function FixURL(const URL : String) : String; +function FixWhiteSpace(const S: String): String; +const + R: array [0..1] of string = ( + #$C2#$A0, // no-break space /   U+00A0 #160 + #$EF#$BB#$BF // zero width no-break / BOM U+FEFF + ); +var + v: String; +begin + Result := S; + if Result = '' then Exit; + for v in R do + Result := StringReplace(Result, v, '', [rfReplaceAll]); +end; + +function CleanString(const S: String): String; +begin + Result := Trim(S); + if Result = '' then Exit; + Result := StringReplace(Result, #13, ' ', [rfReplaceAll]); + Result := StringReplace(Result, #10, ' ', [rfReplaceAll]); + Result := StringReplace(Result, #9, ' ', [rfReplaceAll]); + while Pos(' ', Result) > 0 do + Result := StringReplace(Result, ' ', ' ', [rfReplaceAll]); + Result := Trim(Result); +end; + +function CleanMultilinedString(const S: String; MaxLineEnding: Integer): String; +var + rn, rnp, n, np: String; +begin + Result := Trim(s); + if Result = '' then Exit; + if MaxLineEnding < 1 then MaxLineEnding := 1; + + rn := StringOfString(#13#10, MaxLineEnding); + rnp := rn + #13#10; + while Pos(rnp, Result) > 0 do + Result := StringReplace(Result, rnp, rn, [rfReplaceAll]); + + n := StringOfChar(#10, MaxLineEnding); + np := n + #10; + while Pos(np, Result) > 0 do + Result := StringReplace(Result, np, n, [rfReplaceAll]); +end; + +function CleanAndExpandURL(const URL: String): String; +begin + Result := AppendURLDelim(CleanURL(URL)); +end; + +function CleanURL(const URL: String): String; +var + x: Integer; + p: String; +begin + Result := Trim(URL); + if Result = '' then Exit; + if Pos(':', Result) = 1 then + Delete(Result, 1, 1); + if Pos('//', Result) = 1 then + Delete(Result, 1, 2); + p := ''; + x := Pos('://', Result); + if x > 0 then + begin + x := x + 2; + p := Copy(Result, 1, x); + Delete(Result, 1, x); + while Pos('/', Result) = 1 do + Delete(Result, 1, 1); + end; + Result := ReplaceRegExpr('([^:])[\/]{2,}', Result, '$1/', True); + Result := p + Result; +end; + +function AppendURLDelim(const URL: String): String; +begin + Result := URL; + if (URL <> '') and (URL[Length(URL)] <> '/') then + Result := URL + '/'; +end; + +function AppendURLDelimLeft(const URL: String): String; +begin + Result := URL; + if (URL <> '') and (URL[1] <> '/') then + Result := '/' + URL; +end; + +function RemoveURLDelim(const URL: String): String; +begin + Result := TrimRightChar(URL, ['/']); +end; + +function RemoveURLDelimLeft(const URL: String): String; +begin + Result := TrimLeftChar(URL, ['/']); +end; + +function FixURL(const URL: String): String; begin Result := URL; if Pos(':', Result) or Pos('/', Result) > 0 then @@ -2276,38 +2315,38 @@ function FixURL(const URL : String) : String; function FixPath(const path: String): String; var - i: Cardinal; + i: Integer; begin Result := path; if Length(path) = 0 then Exit; for i := 1 to Length(path) do begin - if byte(path[i]) >= 128 then + if Byte(path[i]) >= 128 then Result := Result + '_' else Result := Result + path[i]; end; end; -function GetLastDir(const path: String): String; +function GetLastDir(const Dir: String): String; var - i: Cardinal; s: String; + i: Integer; begin Result := ''; - if Length(path) = 0 then - Exit; - s := path; - while s[Length(s)] in ['/', '\'] do - SetLength(s, Length(s) - 1); - i := Length(s); - for i := 1 to Length(s) do - begin - Result := Result + s[i]; - if (s[i] in ['/', '\']) and (i < Length(s)) then - Result := ''; - end; + s := Trim(Dir); + if s = '' then Exit; + s := TrimRightChar(s, AllowDirectorySeparators); + if s <> '' then + for i := Length(s) downto 1 do + if s[i] in AllowDirectorySeparators then + begin + Result := Copy(s, i + 1, Length(s) - i); + Break; + end; + if Result = '' then + Result := s; end; function StringFilter(const Source: String): String; @@ -2322,7 +2361,7 @@ function StringFilter(const Source: String): String; begin if Pos(StringFilterChar[i, 0], LowerCase(Result)) > 0 then Result := StringReplace(Result, StringFilterChar[i, 0], StringFilterChar[i, 1], - [rfIgnoreCase, rfReplaceAll]); + [rfIgnoreCase, rfReplaceAll]); end; // broken entities @@ -2376,7 +2415,7 @@ function HTMLEntitiesFilter(const Source: String): String; procedure CustomGenres(var output: TStringList; input: String); var s: String = ''; - i: word; + i: Integer; begin if Length(input) = 0 then Exit; @@ -2399,7 +2438,7 @@ procedure CustomGenres(var output: TStringList; input: String); output.Add(s); end; -function CommonStringFilter(const Source : String) : String; +function CommonStringFilter(const Source: String): String; begin Result := Source; if Source = '' then Exit; @@ -2444,7 +2483,7 @@ function RemoveStringBreaks(const Source: String): String; Result := StringReplace(Result, '\r', '', [rfReplaceAll]); end; -function RemoveDoubleSpace(const Source : String) : String; +function RemoveDoubleSpace(const Source: String): String; begin Result := Source; while Pos(' ', Result) > 0 do @@ -2453,18 +2492,13 @@ function RemoveDoubleSpace(const Source : String) : String; function TrimChar(const Source: String; const Chars: TSysCharSet): String; begin - Result := Source; - if Length(Result) > 0 then - while (Length(Result) > 0) and (Result[1] in Chars) do - Delete(Result, 1, 1); - if Length(Result) > 0 then - while (Length(Result) > 0) and (Result[Length(Result)] in Chars) do - Delete(Result, Length(Result), 1); + Result := TrimLeftChar(Source, Chars); + Result := TrimRightChar(Result, Chars); end; function TrimLeftChar(const Source: String; const Chars: TSysCharSet): String; var - i, j: LongInt; + i, j: Longint; begin Result := Source; i := Length(Result); @@ -2480,7 +2514,7 @@ function TrimLeftChar(const Source: String; const Chars: TSysCharSet): String; function TrimRightChar(const Source: String; const Chars: TSysCharSet): String; var - i, j: LongInt; + i, j: Longint; begin Result := Source; i := Length(Result); @@ -2494,12 +2528,13 @@ function TrimRightChar(const Source: String; const Chars: TSysCharSet): String; end; end; -function PrepareSummaryForHint(const Source: String; MaxLength: Cardinal = 80): String; +function PrepareSummaryForHint(const Source: String; MaxLength: Integer = 80): String; var - i: Cardinal = 1; - j: Cardinal = 1; + i, j: Integer; begin Result := Source; + i := 1; + j := 1; repeat if (j > MaxLength) and (Result[i] = ' ') then begin @@ -2515,10 +2550,10 @@ function PrepareSummaryForHint(const Source: String; MaxLength: Cardinal = 80): Result := TrimLeft(TrimRight(Result)); end; -procedure AddCommaString(var Dest: string; S: string); +procedure AddCommaString(var Dest: String; S: String); begin - if Trim(S) = '' then Exit; - if Trim(S) = ',' then Exit; + S := Trim(TrimChar(Trim(S), [',', ' '])); + if (S = '') or (S = ',') then Exit; if Dest = '' then Dest := S else @@ -2585,6 +2620,28 @@ function SFDirectLinkURL(URL: String; Document: TMemoryStream): String; Result := URL; end; +function GoogleResultURL(const AURL: String): String; +begin + Result := AURL; + if Pos('google.', LowerCase(AURL)) = 0 then Exit; + Result := DecodeURL(ReplaceRegExpr('(?i)^.*google\..*\&url=([^\&]+)\&?.*$', AURL, '$1', True)); +end; + +procedure GoogleResultURLs(const AURLs: TStrings); +var + i: Integer; +begin + if AURLs.Count = 0 then Exit; + if Pos('google.', LowerCase(AURLs.Text)) = 0 then Exit; + with TRegExpr.Create('(?i)^.*google\..*\&url=([^\&]+)\&?.*$') do try + for i := 0 to AURLs.Count - 1 do + if Pos('google.', LowerCase(AURLs[i])) <> 0 then + AURLs[i] := DecodeURL(Replace(AURLs[i], '$1', True)); + finally + Free; + end; +end; + function SourceForgeURL(URL: String): String; // Detects sourceforge download and tries to deal with // redirection, and extracting direct download link. @@ -2700,18 +2757,15 @@ function SourceForgeURL(URL: String): String; end; function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; - const Reconnect: Cardinal): Boolean; + const Reconnect: Integer; Method: String): Boolean; // If AHTTP <> nil, we will use it as http sender. Otherwise we create a new // instance. var - //i: Cardinal; HTTP: THTTPSend; HTTPHeader: TStringList; - counter: Cardinal = 0; + counter: Integer; s: String; - meth: String = 'GET'; - //zstream: TGZFileStream; - isGZip: Boolean = True; + meth: String; mstream: TMemoryStream; procedure HTTPClear; @@ -2722,7 +2776,6 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; RangeStart := 0; RangeEnd := 0; Headers.Clear; - MimeType := 'text/html'; end; end; @@ -2733,9 +2786,9 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; HTTP.Free; end; - function checkTerminate: boolean; + function checkTerminate: Boolean; begin - Result := HTTP.Sock.Tag = 1; //terminated via OnHeartBeat + Result := HTTP.Sock.Tag = 1; //terminate via THTTPSendThread; if Result then begin HTTP.Sock.Tag := 0; @@ -2751,6 +2804,7 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; if Trim(URL) = '' then Exit; URL := FixURL(URL); + URL := EncodeURL(DecodeURL(URL)); HTTPHeader := TStringList.Create; HTTPHeader.NameValueSeparator := ':'; @@ -2762,95 +2816,86 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; HTTPClear; end else + begin HTTP := THTTPSend.Create; + HTTP.Timeout := DefaultTimeout; + // HTTP.Sock.ConnectionTimeout := DefaultTimeout; + HTTP.Sock.SetTimeout(DefaultTimeout); + end; HTTP.Headers.NameValueSeparator := ':'; globReturn: - if ProxyType = 'HTTP' then - begin - HTTP.ProxyHost := Host; - HTTP.ProxyPort := Port; - HTTP.ProxyUser := User; - HTTP.ProxyPass := Pass; - end - else - if (ProxyType = 'SOCKS4') or (ProxyType = 'SOCKS5') then - begin - if ProxyType = 'SOCKS4' then - HTTP.Sock.SocksType := ST_Socks4 + if DefaultProxyType = 'HTTP' then + begin + HTTP.ProxyHost := DefaultProxyHost; + HTTP.ProxyPort := DefaultProxyPort; + HTTP.ProxyUser := DefaultProxyUser; + HTTP.ProxyPass := DefaultProxyPass; + end else - if ProxyType = 'SOCKS5' then - HTTP.Sock.SocksType := ST_Socks5; - HTTP.Sock.SocksIP := Host; - HTTP.Sock.SocksPort := Port; - HTTP.Sock.SocksUsername := User; - http.Sock.SocksPassword := Pass; - end - else - begin - HTTP.Sock.SocksIP := Host; - HTTP.Sock.SocksPort := Port; - HTTP.Sock.SocksUsername := User; - http.Sock.SocksPassword := Pass; - HTTP.ProxyHost := Host; - HTTP.ProxyPort := Port; - HTTP.ProxyUser := User; - HTTP.ProxyPass := Pass; - end; + if (DefaultProxyType = 'SOCKS4') or (DefaultProxyType = 'SOCKS5') then + begin + if DefaultProxyType = 'SOCKS4' then + HTTP.Sock.SocksType := ST_Socks4 + else + if DefaultProxyType = 'SOCKS5' then + HTTP.Sock.SocksType := ST_Socks5; + HTTP.Sock.SocksIP := DefaultProxyHost; + HTTP.Sock.SocksPort := DefaultProxyPort; + HTTP.Sock.SocksUsername := DefaultProxyUser; + http.Sock.SocksPassword := DefaultProxyPass; + end + else + begin + HTTP.Sock.SocksIP := DefaultProxyHost; + HTTP.Sock.SocksPort := DefaultProxyPort; + HTTP.Sock.SocksUsername := DefaultProxyUser; + http.Sock.SocksPassword := DefaultProxyPass; + HTTP.ProxyHost := DefaultProxyHost; + HTTP.ProxyPort := DefaultProxyPort; + HTTP.ProxyUser := DefaultProxyUser; + HTTP.ProxyPass := DefaultProxyPass; + end; HTTPHeader.Values['DNT'] := ' 1'; + HTTPHeader.Values['Accept'] := ' text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'; + HTTPHeader.Values['Accept-Charset'] := ' UTF-8'; + HTTPHeader.Values['Accept-Language'] := ' en-US,en;q=0.8'; HTTP.Protocol := '1.1'; HTTP.KeepAlive := False; - HTTP.Timeout := OptionConnectionTimeout; - HTTP.Sock.SetTimeout(OptionConnectionTimeout); + if (HTTP.UserAgent = '') or (HTTP.UserAgent = UA_SYNAPSE) then + HTTP.UserAgent := DEFAULT_UA; + if OptionHTTPUseGzip then + HTTPHeader.Values['Accept-Encoding'] := ' gzip, deflate'; + + //Method + if Method <> '' then meth := Method + else meth := 'GET'; + if HTTP.Sock.Tag = 100 then //POST form + meth := 'POST'; + if meth = 'POST' then + HTTP.MimeType := 'application/x-www-form-urlencoded; charset=UTF-8' + else + begin + HTTP.Document.Clear; + HTTP.RangeStart := 0; + HTTP.RangeEnd := 0; + end; //User-Agent if Trim(HTTPHeader.Values['User-Agent']) <> '' then begin HTTP.UserAgent := Trim(HTTPHeader.Values['User-Agent']); HTTPHeader.Delete(HTTPHeader.IndexOfName('User-Agent')); - end - else - if Trim(HTTP.UserAgent) = '' then - HTTP.UserAgent := UA_FIREFOX; + end; //MimeType if Trim(HTTPHeader.Values['Content-Type']) <> '' then begin HTTP.MimeType := Trim(HTTPHeader.Values['Content-Type']); HTTPHeader.Delete(HTTPHeader.IndexOfName('Content-Type')); - end - else - if Trim(HTTP.MimeType) = '' then - HTTP.MimeType := ''; - - if isGZip then - begin - //HTTP.MimeType := 'application/x-www-form-urlencoded'; - HTTPHeader.Values['Accept-Encoding'] := ' gzip, deflate'; end; - if Pos(WebsiteRoots[MEINMANGA_ID, 1], URL) > 0 then - HTTPHeader.Values['Accept-Charset'] := ' utf8' - else - if Pos(WebsiteRoots[MANGALIB_PL_ID, 1], URL) > 0 then - begin - if MANGALIB_PL_COOKIES <> '' then - HTTP.Cookies.Text := MANGALIB_PL_COOKIES; - if (Pos('/page/confirm_', URL) > 0) then - begin - s := ReplaceRegExpr('^.*/confirm_(.+)\?backlink.*$', URL, '$1', True) + '=1'; - meth := 'POST'; - HTTP.Document.Clear; - HTTP.Document.Position := 0; - HTTP.Document.Write(PChar(s)^, Length(s)); - HTTP.Protocol := '1.1'; - HTTP.MimeType := 'application/x-www-form-urlencoded'; - HTTPHeader.Values['Referer'] := ' ' + URL; - HTTPHeader.Values['Accept'] := ' text/html'; - end; - end - else if (Pos('imgmega.com/', URL) > 0) then begin s := ReplaceRegExpr('^.*\w+\.\w+/(\w+)/.*$', URL, '$1', True); @@ -2862,20 +2907,13 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; HTTP.MimeType := 'application/x-www-form-urlencoded'; end; - if HTTP.Sock.Tag = 100 then //POST - begin - meth := 'POST'; - HTTP.MimeType := 'application/x-www-form-urlencoded'; - end; - - counter := 0; + if checkTerminate then Exit; HTTP.Headers.Text := HTTPHeader.Text; - while (not HTTP.HTTPMethod(meth, URL)) or - (HTTP.ResultCode >= 500) or - (HTTP.ResultCode = 451) do + counter := 0; + while (not HTTP.HTTPMethod(meth, URL)) or (HTTP.ResultCode > 500) do begin if checkTerminate then Exit; - if (Reconnect <> 0) and (Reconnect <= counter) then + if (Reconnect > -1) and (Reconnect <= counter) then begin preTerminate; Exit; @@ -2885,36 +2923,41 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; HTTP.Headers.Text := HTTPHeader.Text; end; - counter := 0; - while (HTTP.ResultCode = 302) or (HTTP.ResultCode = 301) do + while (HTTP.ResultCode > 300) and (HTTP.ResultCode < 400) do begin if checkTerminate then Exit; HTTPHeader.Values['Referer'] := ' ' + URL; s := Trim(HTTP.Headers.Values['Location']); - s := TrimLeftChar(s, ['/', ':']); if s <> '' then begin - if LowerCase(Copy(s, 1, 4)) <> 'http' then - s := 'http://' + s; - URL := s; + with TRegExpr.Create do + try + Expression := REGEX_HOST; + if Replace(s, '$1', True) = '' then + begin + if s[1] <> '/' then + s := '/' + s; + URL := Replace(URL, '$1$2$3', True) + s; + end + else + URL := s; + finally + Free; + end; end; - if Pos(HENTAI2READ_ROOT, URL) <> 0 then - HTTP.Headers.Insert(0, 'Referer:' + HENTAI2READ_ROOT + '/'); - - counter := 0; HTTP.Clear; HTTP.Headers.Text := HTTPHeader.Text; - while (not HTTP.HTTPMethod('GET', URL)) or - (HTTP.ResultCode > 500) do //500 for abort + counter := 0; + while (not HTTP.HTTPMethod('GET', URL)) or (HTTP.ResultCode > 500) do begin if checkTerminate then Exit; - if (Reconnect <> 0) and (Reconnect <= counter) then + if (Reconnect > -1) and (Reconnect <= counter) then begin preTerminate; Exit; end; - Inc(Counter); + Inc(counter); HTTP.Clear; HTTP.Headers.Text := HTTPHeader.Text; end; @@ -2946,10 +2989,7 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; HTTP.Document.SaveToStream(TStream(output)); except on E: Exception do - begin - E.Message := 'GetPage.WriteOutput error: '#13#10 + E.Message; - USimpleException.ExceptionHandleSaveLogOnly(nil, E); - end; + Logger.SendException('GetPage.WriteOutput.Error!', E); end; Result := True; end @@ -2959,14 +2999,15 @@ function GetPage(const AHTTP: THTTPSend; var output: TObject; URL: String; preTerminate; end; -function GetPage(var output: TObject; URL: String; const Reconnect: Cardinal): Boolean; +function GetPage(var output: TObject; URL: String; const Reconnect: Integer + ): Boolean; begin Result := GetPage(nil, output, URL, Reconnect); end; function GetURLFromBitly(const URL: String): String; var - i: Cardinal; + i: Integer; httpSource: TStringList; begin Result := ''; @@ -2982,282 +3023,335 @@ function GetURLFromBitly(const URL: String): String; httpSource.Free; end; -function SaveImage(const AHTTP: THTTPSend; const mangaSiteID: Integer; - URL: String; const Path, Name, prefix: String; const Reconnect: Cardinal +function WebPToPNGStream(const AStream: TMemoryStream; + const ALevel: Tcompressionlevel): Boolean; +var + mem: TMemBitmap; + writer: TFPWriterPNG; +begin + Result := False; + mem := nil; + try + mem := WebPToMemBitmap(AStream); + if Assigned(mem) then + try + writer := TFPWriterPNG.create; + writer.Indexed := False; + writer.UseAlpha := mem.HasTransparentPixels; + writer.CompressionLevel := ALevel; + mem.SaveToStream(AStream, writer); + Result := True; + finally + writer.Free; + end; + finally + if Assigned(mem) then + mem.Free; + end; +end; + +function WebPToJPEGStream(const AStream: TMemoryStream; const AQuality: Integer ): Boolean; - // prefix: For example: 000<our prefix>.jpg. var - retryToSave: Boolean = False; - header: array [0..3] of Byte; - ext, lpath, fpath: String; - HTTPHeader: TStringList; - HTTP: THTTPSend; - counter: Cardinal; - s: String; - //source : TPicture; - fstream: TFileStreamUTF8; + mem: TMemBitmap; + writer: TFPWriterJPEG; +begin + Result := False; + mem := nil; + try + mem := WebPToMemBitmap(AStream); + if Assigned(mem) then + try + writer := TFPWriterJPEG.create; + writer.CompressionQuality := AQuality; + mem.SaveToStream(AStream, writer); + Result := True; + finally + writer.Free; + end; + finally + if Assigned(mem) then + mem.Free; + end; +end; - procedure preTerminate; - begin - HTTPHeader.Free; - if AHTTP = nil then - HTTP.Free; +function PNGToJPEGStream(const AStream: TMemoryStream; const AQuality: Integer): Boolean; +var + img: TFPCustomImage; + writer: TFPWriterJPEG; + reader: TFPReaderPNG; +begin + Result := False; + img := TFPMemoryImage.create(0,0); + reader := TFPReaderPNG.create; + try + writer := nil; + try + img.LoadFromStream(AStream, reader); + writer := TFPWriterJPEG.create; + writer.CompressionQuality := AQuality; + img.SaveToStream(AStream, writer); + Result := True; + except + end; + if writer <> nil then + writer.Free; + finally + reader.Free; + img.Free; end; +end; - function checkTerminate: boolean; - begin - Result := HTTP.Sock.Tag = 1; //terminated via OnHeartBeat - if Result then +function SaveImageStreamToFile(Stream: TMemoryStream; Path, FileName: String; Age: LongInt): String; +var + p, f: String; + fs: TFileStreamUTF8; +begin + Result := ''; + if Stream = nil then Exit; + if Stream.Size = 0 then Exit; + p := CorrectPathSys(Path); + if ForceDirectoriesUTF8(p) then begin + f := GetImageStreamExt(Stream); + if f = 'png' then begin - HTTP.Sock.Tag := 0; - preTerminate; + if OptionPNGSaveAsJPEG then + if PNGToJPEGStream(Stream, OptionJPEGQuality) then f := 'jpg' + end + else + if f = 'webp' then + begin + case OptionWebPSaveAs of + 1: if WebPToPNGStream(Stream, Tcompressionlevel(OptionPNGCompressionLevel)) then f := 'png'; + 2: if WebPToJPEGStream(Stream, OptionJPEGQuality) then f := 'jpg'; + end; + end; + + if f = '' then Exit; + f := p + FileName + '.' + f; + if FileExistsUTF8(f) then DeleteFileUTF8(f); + try + fs := TFileStreamUTF8.Create(f, fmCreate); + try + Stream.Position := 0; + fs.CopyFrom(Stream, Stream.Size); + finally + fs.Free; + end; + except + on E: Exception do + Logger.SendException('SaveImageStreamToFile.WriteToFile Failed! ' + f, E); + end; + if FileExistsUTF8(f) then + begin + Result := f; + if Age > 0 then + try + FileSetDateUTF8(f, Age); + except + on E: Exception do + Logger.SendException('SaveImageStreamToFile.FileSetDate Error! ' + f, E); + end; end; end; +end; +function SaveImageStreamToFile(AHTTP: THTTPSend; Path, FileName: String): String; +var + s: String; + lastmodified: LongInt; begin - Result := False; - if Trim(URL) = '' then Exit; - fpath := ''; - s := Path + '/' + Name; - // Check to see if a file with similar name was already exist. If so then we - // skip the download process. - if (FileExistsUTF8(s + '.jpg')) or - (FileExistsUTF8(s + '.png')) or - (FileExistsUTF8(s + '.gif')) or - (Trim(URL) = 'D') then - Exit(True); - - URL := FixURL(URL); + Result := ''; + if AHTTP = nil then Exit; + s := Trim(AHTTP.Headers.Values['last-modified']); + lastmodified := 0; + if s <> '' then + lastmodified := DateTimeToFileDate(DecodeRfcDateTime(s)); + Result := SaveImageStreamToFile(AHTTP.Document, Path, FileName, lastmodified); +end; - HTTPHeader := TStringList.Create; - HTTPHeader.NameValueSeparator := ':'; - if AHTTP <> nil then - begin - if LeftStr(AHTTP.Headers.Text, 5) <> 'HTTP/' then - HTTPHeader.Text := AHTTP.Headers.Text; - HTTP := AHTTP; - HTTP.Clear; - end - else - HTTP := THTTPSend.Create; - HTTP.Headers.NameValueSeparator := ':'; +function SaveImageBase64StringToFile(const S, Path, FileName: String): Boolean; +var + ES: String; + i: Integer; + MS: TMemoryStream; +begin + Result := False; + if S = '' then Exit; + ES := AnsiLowerCase(Copy(S, 1, 100)); + if Pos('data:image/', ES) <> 1 then Exit; + i := Pos('base64,', ES); + if i = 0 then Exit; + ES := Base64Decode(Copy(S, i + 7, Length(S))); + MS := TMemoryStream.Create; + try + MS.Write(ES[1], Length(ES)); + Result := SaveImageStreamToFile(MS, Path, FileName) <> ''; + finally + MS.Free; + end; +end; - if ProxyType = 'HTTP' then - begin - HTTP.ProxyHost := Host; - HTTP.ProxyPort := Port; - HTTP.ProxyUser := User; - HTTP.ProxyPass := Pass; - end - else - if (ProxyType = 'SOCKS4') or (ProxyType = 'SOCKS5') then - begin - if ProxyType = 'SOCKS4' then - HTTP.Sock.SocksType := ST_Socks4 - else - if ProxyType = 'SOCKS5' then - HTTP.Sock.SocksType := ST_Socks5; - HTTP.Sock.SocksIP := Host; - HTTP.Sock.SocksPort := Port; - HTTP.Sock.SocksUsername := User; - http.Sock.SocksPassword := Pass; - end - else +function DownloadAndSaveImage(const AHTTP: THTTPSendThread; const AURL, APath, + AFileName: String; var ASavedFileName: String): Boolean; +begin + Result := False; + if AHTTP.GET(AURL) then begin - HTTP.Sock.SocksIP := Host; - HTTP.Sock.SocksPort := Port; - HTTP.Sock.SocksUsername := User; - http.Sock.SocksPassword := Pass; - HTTP.ProxyHost := Host; - HTTP.ProxyPort := Port; - HTTP.ProxyUser := User; - HTTP.ProxyPass := Pass; + ASavedFileName := SaveImageStreamToFile(AHTTP, APath, AFileName); + Result := ASavedFileName <> ''; end; +end; - HTTPHeader.Values['DNT'] := ' 1'; - HTTP.Protocol := '1.1'; - HTTP.KeepAlive := False; - HTTP.Timeout := OptionConnectionTimeout; - HTTP.Sock.SetTimeout(OptionConnectionTimeout); +function DownloadAndSaveImage(const AHTTP: THTTPSendThread; const AURL, APath, AFileName: String): Boolean; +begin + Result := False; + if AHTTP.GET(AURL) then + Result := SaveImageStreamToFile(AHTTP, APath, AFileName) <> ''; +end; - //User-Agent - if Trim(HTTPHeader.Values['User-Agent']) <> '' then - begin - HTTP.UserAgent := Trim(HTTPHeader.Values['User-Agent']); - HTTPHeader.Delete(HTTPHeader.IndexOfName('User-Agent')); - end - else - if Trim(HTTP.UserAgent) = '' then - HTTP.UserAgent := UA_FIREFOX; - //MimeType - if Trim(HTTPHeader.Values['Content-Type']) <> '' then - begin - HTTP.MimeType := Trim(HTTPHeader.Values['Content-Type']); - HTTPHeader.Delete(HTTPHeader.IndexOfName('Content-Type')); - end - else - if Trim(HTTP.MimeType) = '' then - HTTP.MimeType := ''; +function ImageFileExist(const AFileName: String): Boolean; +begin + Result := FindImageFile(AFileName) <> ''; +end; - if Pos('.imgur.com/', LowerCase(URL)) = 0 then - if ((mangaSiteID >= 0) and (mangaSiteID <= High(WebsiteRoots))) then +function FindImageFile(const AFileName: String): String; +var + i: Byte; +begin + Result := ''; + for i := Low(FMDImageFileExt) to High(FMDImageFileExt) do + if FileExistsUTF8(AFileName + FMDImageFileExt[i]) then begin - if HTTPHeader.Values['Referer'] = '' then - if not (SitesWithoutReferer(WebsiteRoots[mangaSiteID, 0])) then - begin - if SitesRefererisURL(WebsiteRoots[mangaSiteID, 0]) then - HTTPHeader.Values['Referer'] := ' ' + URL - else - HTTPHeader.Values['Referer'] := ' ' + WebsiteRoots[mangaSiteID, 1]; - end; + Result := AFileName + FMDImageFileExt[i]; + Break; end; +end; - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - counter := 0; - HTTP.Headers.Text := HTTPHeader.Text; - while (not HTTP.HTTPMethod('GET', URL)) or - (HTTP.ResultCode >= 500) or //500 for abort - (HTTP.ResultCode = 403) do +function LoadImageFromFileUTF8(const FileName: String; var Image: TFPCustomImage): Boolean; +var + fs: TFileStreamUTF8; + h: TFPCustomImageReaderClass; + r: TFPCustomImageReader; +begin + Result := False; + if not FileExistsUTF8(FileName) then Exit; + h := GetImageFileReaderClass(FileName); + if h = nil then Exit; + r := h.Create; + fs := TFileStreamUTF8.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + Image.LoadFromStream(fs, r); + Result := True; + finally + r.Free; + fs.Free; + end; +end; + +procedure CopyImageRect(const Source, Dest: TFPCustomImage; const DestX, DestY: Integer; const SourceRect: TRect); +var + x, y, dx, dy: Integer; +begin + dx := DestX; + dy := DestY; + for y := SourceRect.Top to SourceRect.Bottom -1 do begin - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - if (Reconnect <> 0) and (Reconnect <= counter) then + for x := SourceRect.Left to SourceRect.Right - 1 do begin - preTerminate; - Exit; + Dest.Colors[dx, dy] := Source.Colors[x, y]; + Inc(dx); end; - Inc(Counter); - HTTP.Clear; - HTTP.Headers.Text := HTTPHeader.Text; + Inc(dy); end; +end; - counter := 0; - while (HTTP.ResultCode = 302) or (HTTP.ResultCode = 301) do - begin - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - - HTTPHeader.Values['Referer'] := ' ' + URL; - s := Trim(HTTP.Headers.Values['Location']); - s := TrimLeftChar(s, ['/', ':']); - if s <> '' then +function Merge2Image(const Directory, ImgName1, ImgName2, FinalName: String; const Landscape: Boolean): Boolean; +var + D, AImgName1, AImgName2, AFinalName: String; + Img1, Img2, ImgNew: TFPCustomImage; + newWidth: Integer; + newHeigth: LongInt; + h: TFPCustomImageWriterClass; + w: TFPCustomImageWriter; + fs: TFileStreamUTF8; +begin + Result := False; + if not DirectoryExistsUTF8(Directory) then Exit; + D := CorrectPathSys(Directory); + AImgName1 := D + ImgName1; + AImgName2 := D + ImgName2; + if not (FileExistsUTF8(AImgName1) and FileExistsUTF8(AImgName2)) then Exit; + Img1 := TFPMemoryImage.create(0,0); + Img2 := TFPMemoryImage.create(0,0); + try + if (LoadImageFromFileUTF8(AImgName1, Img1) and LoadImageFromFileUTF8(AImgName2, Img2)) then Exit; + if Landscape then begin - if LowerCase(Copy(s, 1, 4)) <> 'http' then - s := 'http://' + s; - URL := s; + newWidth := img1.Width + img2.Width; + newHeigth := max(img1.Height, img2.Height); + end + else + begin + newWidth := max(img1.Width, img2.Width); + newHeigth := img1.Height + img2.Height; end; - HTTP.Clear; - counter := 0; - HTTP.Headers.Text := HTTPHeader.Text; - while (not HTTP.HTTPMethod('GET', URL)) or - (HTTP.ResultCode > 500) or //500 for abort - (HTTP.ResultCode = 403) do - begin - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - if (Reconnect <> 0) and (Reconnect <= counter) then + ImgNew := TFPMemoryImage.create(newWidth, newHeigth); + try + CopyImageRect(Img1, ImgNew, 0, 0, Rect(0, 0, Img1.Width, Img1.Height)); + if Landscape then + CopyImageRect(Img2, ImgNew, Img1.Width + 1, 0, Rect(0, 0, Img2.Width, Img2.Height)) + else + CopyImageRect(Img2, ImgNew, 0, Img1.Height + 1, Rect(0, 0, Img2.Width, Img2.Height)); + AFinalName := D + FinalName; + if FileExistsUTF8(AFinalName) then + DeleteFileUTF8(AFinalName); + if not FileExistsUTF8(AFinalName) then begin - preTerminate; - Exit; - end; - Inc(Counter); - HTTP.Clear; - HTTP.Headers.Text := HTTPHeader.Text; - Sleep(500); - end; - end; - HTTP.Document.Seek(0, soBeginning); - HTTP.Document.Read(header[0], 4); - if (header[0] = JPG_HEADER[0]) and - (header[1] = JPG_HEADER[1]) and - (header[2] = JPG_HEADER[2]) then - ext := '.jpg' - else - if (header[0] = PNG_HEADER[0]) and - (header[1] = PNG_HEADER[1]) and - (header[2] = PNG_HEADER[2]) then - ext := '.png' - else - if (header[0] = GIF_HEADER[0]) and - (header[1] = GIF_HEADER[1]) and - (header[2] = GIF_HEADER[2]) then - ext := '.gif' - else - ext := ''; - if ext <> '' then - begin - // If an error occured, verify the path and redo the job. - // If the error still persists, break the loop. - repeat - try - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - lpath := CleanAndExpandDirectory(CorrectPathSys(Path)); - if not DirectoryExistsUTF8(lpath) then - ForceDirectoriesUTF8(lpath); - if DirectoryExistsUTF8(lpath) then - begin - fpath := CleanAndExpandFilename(lpath + Name + prefix + ext); - if FileExistsUTF8(fpath) then - DeleteFile(fpath); - fstream := TFileStreamUTF8.Create(fpath, fmCreate); - try - HTTP.Document.SaveToStream(fstream); - finally - fstream.Free; - end; - Result := FileExistsUTF8(fpath); - end - else - Result := False; - Break; - except - on E: Exception do + h := GetImageFileWriterClass(AImgName1); + if h = nil then Exit; + try + w := h.Create; + fs := TFileStreamUTF8.Create(AFinalName, fmCreate); + ImgNew.SaveToStream(fs, w); + Result := True; + finally + w.Free; + fs.Free; + end; + if Result then begin - E.Message := 'SaveImage.SavetoFile.Error'#13#10 + E.Message + #13#10 + - (CorrectPathSys(Path) + '/' + Name + prefix + ext); - USimpleException.ExceptionHandleSaveLogOnly(nil, E); - {$IFDEF DOWNLOADER} - if checkTerminate then Exit; - {$ENDIF} - if not retryToSave then - begin - CheckPath(Path); - retryToSave := True; - end - else - Break; + DeleteFileUTF8(AImgName1); + DeleteFileUTF8(AImgName2); end; end; - until False; - end - else - begin - s := 'SaveImage.ExtEmpty'#13#10'URL: ' + URL; - USimpleException.ExceptionHandleSaveLogOnly(nil, Exception.Create(s)); + finally + ImgNew.Free; + end; + finally + Img1.Free; + Img2.Free; end; - preTerminate; - Result := (fpath <> '') and FileExistsUTF8(fpath); end; -function SaveImage(const mangaSiteID: Integer; URL: String; - const Path, Name, prefix: String; const Reconnect: Cardinal): Boolean; +function GetMimeType(const imgFileName: String): String; begin - Result := SaveImage(nil, mangaSiteID, URL, Path, Name, prefix, Reconnect); + case ExtractFileExt(imgFileName) of + '.jpeg', '.jpg': Result := 'image/jpeg'; + '.png': Result := 'image/png'; + '.gif': Result := 'image/gif'; + '.bmp': Result := 'image/bmp'; + '.webp': Result := 'image/webp'; + else Result := ''; + end; end; procedure QuickSortChapters(var chapterList, linkList: TStringList); - procedure QSort(L, R: Cardinal); + procedure QSort(L, R: Integer); var - i, j: Cardinal; + i, j: Integer; X: String; begin X := chapterList.Strings[(L + R) div 2]; @@ -3294,9 +3388,9 @@ procedure QuickSortData(var merge: TStringList); var names, output: TStringList; - procedure QSort(L, R: Cardinal); + procedure QSort(L, R: Integer); var - i, j: Cardinal; + i, j: Integer; X: String; begin X := names.Strings[(L + R) div 2]; @@ -3324,7 +3418,7 @@ procedure QuickSortData(var merge: TStringList); end; var - i: Cardinal; + i: Integer; begin names := TStringList.Create; @@ -3333,7 +3427,7 @@ procedure QuickSortData(var merge: TStringList); begin output.Clear; GetParams(output, merge.Strings[i]); - names.Add(output.Strings[DATA_PARAM_NAME]); + names.Add(output.Strings[DATA_PARAM_TITLE]); end; QSort(0, names.Count - 1); output.Free; @@ -3345,9 +3439,9 @@ procedure QuickSortDataWithWebID(var merge: TStringList; const webIDList: TByteL var names, output: TStringList; - procedure QSort(L, R: Cardinal); + procedure QSort(L, R: Integer); var - i, j: Cardinal; + i, j: Integer; X: String; begin X := names.Strings[(L + R) div 2]; @@ -3376,7 +3470,7 @@ procedure QuickSortDataWithWebID(var merge: TStringList; const webIDList: TByteL end; var - i: Cardinal; + i: Integer; begin names := TStringList.Create; @@ -3385,16 +3479,105 @@ procedure QuickSortDataWithWebID(var merge: TStringList; const webIDList: TByteL begin output.Clear; GetParams(output, merge.Strings[i]); - names.Add(output.Strings[DATA_PARAM_NAME]); + names.Add(output.Strings[DATA_PARAM_TITLE]); end; QSort(0, names.Count - 1); output.Free; names.Free; end; -function DateToJDN(const year, month, day: word): longint; +function NaturalCompareStr(Str1, Str2: String): Integer; +begin + Result := NaturalSortUnit.UTF8LogicalCompareText(Str1, Str2); +end; + +function NaturalCustomSort(List: TStringList; Index1, Index2: Integer): Integer; +begin + Result := NaturalCompareStr(List[Index1], List[Index2]); +end; + +procedure QuickSortNaturalPart(var Alist: TStringList; Separator: String; + PartIndex: Integer); + + function CompareFn(Index1, Index2: Integer): Integer; + begin + Result := NaturalCompareStr(getStringPart(Alist[Index1], Separator, PartIndex), + getStringPart(Alist[Index2], Separator, PartIndex)); + end; + + procedure QSort(L, R: Integer); + var + Pivot, vL, vR: Integer; + begin + if R - L <= 1 then begin // a little bit of time saver + if L < R then + if CompareFn(L, R) > 0 then + Alist.Exchange(L, R); + + Exit; + end; + + vL := L; + vR := R; + + Pivot := L + Random(R - L); // they say random is best + + while vL < vR do begin + while (vL < Pivot) and (CompareFn(vL, Pivot) <= 0) do + Inc(vL); + + while (vR > Pivot) and (CompareFn(vR, Pivot) > 0) do + Dec(vR); + + Alist.Exchange(vL, vR); + + if Pivot = vL then // swap pivot if we just hit it from one side + Pivot := vR + else if Pivot = vR then + Pivot := vL; + end; + + if Pivot - 1 >= L then + QSort(L, Pivot - 1); + if Pivot + 1 <= R then + QSort(Pivot + 1, R); + end; + +begin + if Alist.Count < 2 then Exit; + Alist.BeginUpdate; + try + QSort(0, Alist.Count - 1); + finally + Alist.EndUpdate; + end; +end; + +function GetStringPart(const S, Sep: String; PartIndex: Integer): String; +var + i, j, lpos, rpos: Integer; +begin + lpos := 1; + rpos := 1; + Result := ''; + + for i := 0 to partIndex do + begin + j := PosEx(Sep, S, rpos); + if (j > 0) then + begin + lpos := rpos; + rpos := j + Length(Sep); + end + else + Break; + end; + Result := Copy(S, lpos, rpos - lpos - Length(Sep)); +end; + +function DateToJDN(const year, month, day: Word): Longint; var - a, y, m: longint; + a, y, m: Longint; begin a := (14 - month) div 12; y := year + 4800 - a; @@ -3403,17 +3586,17 @@ function DateToJDN(const year, month, day: word): longint; (y div 400) - 32045) - 0.5); end; -function DateToJDN(const date: TDate): longint; +function DateToJDN(const date: TDate): Longint; var - day, month, year: word; + day, month, year: Word; begin DecodeDate(date, year, month, day); Result := DateToJDN(year, month, day); end; -function JDNToDate(const JDN: longint): TDate; +function JDNToDate(const JDN: Longint): TDate; var - a, b, c, d, e, m: longint; + a, b, c, d, e, m: Longint; day, month, year: Word; begin a := trunc(JDN + 32044.5); @@ -3428,9 +3611,9 @@ function JDNToDate(const JDN: longint): TDate; Result := EncodeDate(year, month, day); end; -function GetCurrentJDN: longint; +function GetCurrentJDN: Longint; var - day, month, year: word; + day, month, year: Word; begin DecodeDate(Now, year, month, day); Result := DateToJDN(year, month, day); @@ -3453,76 +3636,84 @@ procedure TransferMangaInfo(var dest: TMangaInfo; const Source: TMangaInfo); dest.chapterLinks.Assign(Source.chapterLinks); end; -{ THTTPSendThread } - -procedure THTTPSendThread.CloseConnection(SendTerminateTag: Boolean); +function MangaInfoStatusIfPos(const SearchStr: String; const OngoingStr: String; + const CompletedStr: String): String; +var + s, o, c: String; begin - with Self.Sock do - begin - if SendTerminateTag then - Tag := 1; - StopFlag := True; - AbortSocket; - end; + Result := ''; + if SearchStr = '' then Exit; + s := LowerCase(SearchStr); + o := LowerCase(OngoingStr); + c := LowerCase(CompletedStr); + If Pos(o, s) <> 0 then + Result := MangaInfo_StatusOngoing + else if Pos(c, s) <> 0 then + Result := MangaInfo_StatusCompleted; end; -procedure THTTPSendThread.SockOnHeartBeat(Sender: TObject); +procedure GetBaseMangaInfo(const M: TMangaInfo; var B: TBaseMangaInfo); begin - if Assigned(FOwner) then - if FOwner.IsTerminated then - CloseConnection; + B.title := M.title; + B.authors := M.authors; + B.artists := M.artists; + B.genres := M.genres; + B.status := M.status; + B.summary := M.summary; + B.numChapter := M.numChapter; end; -constructor THTTPSendThread.Create(AOwner: TFMDThread); +procedure FillBaseMangaInfo(const M: TMangaInfo; var B: TBaseMangaInfo); begin - inherited Create; - if Assigned(AOwner) then - begin - FOwner := TFMDThread(AOwner); - Sock.OnHeartbeat := SockOnHeartBeat; - Sock.HeartbeatRate := SOCKHEARTBEATRATE; - end; + if Trim(M.title) = '' then M.title := B.title; + if Trim(M.authors) = '' then M.authors := B.authors; + if Trim(M.artists) = '' then M.artists := B.artists; + if Trim(M.genres) = '' then M.genres := B.genres; + if Trim(M.status) = '' then M.status := B.status; + if Trim(M.summary) = '' then M.summary := B.summary; + if M.numChapter = 0 then M.numChapter := B.numChapter; end; -{ TParseHTML } +{ THTMLForm } -procedure TParseHTML.FoundTag(NoCaseTag, ActualTag: string); +constructor THTMLForm.Create; begin - Output.Add(ActualTag); + fdata := TStringList.Create; + fdata.NameValueSeparator := '='; + fdata.Delimiter := '&'; + fvalueseparator := '='; + fdelimiter := '&'; end; -procedure TParseHTML.FoundText(Text: string); +destructor THTMLForm.Destroy; begin - Output.Add(Text); + fdata.Free; + inherited Destroy; end; -constructor TParseHTML.Create(const Raw: string); +procedure THTMLForm.Put(const AName, AValue: String); begin - inherited Create; - if Raw <> '' then - FRaw := Raw - else - FRaw := ''; + fdata.Values[AName] := AValue; end; -function TParseHTML.Exec(const Raw: string): string; +procedure THTMLForm.Remove(const AName: String); var - parser: THTMLParser; + i: Integer; begin - if not Assigned(Output) then Exit; - if Raw <> '' then - FRaw := Raw; - if FRaw = '' then - Exit(''); - Output.Clear; - parser := THTMLParser.Create(PChar(FRaw)); - try - parser.OnFoundTag := FoundTag; - parser.OnFoundText := FoundText; - parser.Exec; - finally - parser.Free; - end; + i := fdata.IndexOfName(AName); + if i > -1 then fdata.Delete(i); +end; + +function THTMLForm.GetData: String; +var + i: Integer; +begin + Result := ''; + if fdata.Count > 0 then + for i := 0 to fdata.Count - 1 do begin + if Result <> '' then Result := Result + fdelimiter; + Result := Result + fdata.Names[i] + fvalueseparator + EncodeURLElement(fdata.ValueFromIndex[i]); + end; end; { TMangaInfo } @@ -3557,7 +3748,7 @@ procedure TDownloadPageThread.Execute; // OS dependent function fmdGetTempPath: String; var - l: Cardinal; + l: Integer; begin {$IFDEF WINDOWS} SetLength(Result, 4096); @@ -3569,13 +3760,6 @@ function fmdGetTempPath: String; {$ENDIF} end; -function fmdGetTickCount: Cardinal; -begin - {$IFDEF WINDOWS} - Result := GetTickCount64; - {$ENDIF} -end; - procedure fmdPowerOff; begin {$IFDEF WINDOWS} @@ -3588,11 +3772,11 @@ procedure fmdPowerOff; {$IFDEF UNIX} // This process require admin rights in order to execute with TProcessUTF8.Create(nil) do try - CommandLine := 'poweroff'; - Execute; - finally - Free; - end; + CommandLine := 'poweroff'; + Execute; + finally + Free; + end; {$ENDIF} end; @@ -3603,195 +3787,47 @@ procedure fmdHibernate; {$ENDIF} end; -function RunExternalProcessAsAdmin(Exe, Params: String; ShowWind: Boolean; - isPersistent: Boolean): Boolean; -var - {$IFDEF WINDOWS} - SEInfo: TSHELLEXECUTEINFOW; - {$ELSE} - Process: TProcessUTF8; - pr: TStringList; - {$ENDIF} +procedure SendLog(const AText: String); begin - {$IFDEF WINDOWS} - Initialize(SEInfo); - FillChar(SEInfo, SizeOf(SEInfo), 0); - SEInfo.cbSize := SizeOf(SEInfo); - with SEInfo do begin - wnd := 0; - fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; - if isPersistent then - fMask := fMask or SEE_MASK_NOCLOSEPROCESS; - lpVerb := 'runas'; - lpFile := PWideChar(UTF8Decode(Exe)); - lpParameters := PWideChar(UTF8Decode(Params)); - if ShowWind then - nShow := SW_SHOWNORMAL - else - nShow := SW_HIDE; - end; - Result := ShellExecuteExW(@SEInfo); - if isPersistent then - WaitForSingleObject(SEInfo.hProcess, INFINITE); - {$ELSE} - Process := TProcessUTF8.Create(nil); - try - Process.Executable := Exe; - pr := TStringList.Create; - try - ParseCommandLine(Params, TStrings(pr), True); - Process.Parameters.Assign(pr); - finally - pr.Free; - end; - Process.Execute; - finally - Process.Free; - end; - {$ENDIF} + Logger.Send(AText); end; -{$ifdef windows} -function WinRunProcessA(Exe, Params: string; ShowWind: Boolean; isPersistent: Boolean): Boolean; -var - SEInfo: TSHELLEXECUTEINFOA; +procedure SendLog(const AText, AValue: String); begin - Initialize(SEInfo); - FillChar(SEInfo, SizeOf(SEInfo), 0); - SEInfo.cbSize := SizeOf(TSHELLEXECUTEINFOA); - with SEInfo do begin - wnd := 0; - fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; - if isPersistent then - fMask := fMask or SEE_MASK_NOCLOSEPROCESS; - lpFile := PChar(Utf8ToAnsi(Exe)); - lpParameters := PChar(Utf8ToAnsi(Params)); - if ShowWind then - nShow := SW_SHOWNORMAL - else - nShow := SW_HIDE; - end; - Result := ShellExecuteExA(@SEInfo); - if isPersistent then - WaitForSingleObject(SEInfo.hProcess, INFINITE); + Logger.Send(AText, AValue); end; -function WinRunProcessW(Exe, Params: string; ShowWind: Boolean; isPersistent: Boolean): Boolean; -var - SEInfo: TSHELLEXECUTEINFOW; +procedure SendLog(const AText: String; const AValue: Variant); begin - Initialize(SEInfo); - FillChar(SEInfo, SizeOf(SEInfo), 0); - SEInfo.cbSize := SizeOf(TSHELLEXECUTEINFOW); - with SEInfo do begin - wnd := 0; - fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; - if isPersistent then - fMask := fMask or SEE_MASK_NOCLOSEPROCESS; - lpFile := PWideChar(UTF8Decode(Exe)); - lpParameters := PWideChar(UTF8Decode(Params)); - if ShowWind then - nShow := SW_SHOWNORMAL - else - nShow := SW_HIDE; - end; - Result := ShellApi.ShellExecuteExW(@SEInfo); - if isPersistent then - WaitForSingleObject(SEInfo.hProcess, INFINITE); + Logger.Send(AText, VarToStr(AValue)); end; -{$endif} -function RunExternalProcess(Exe: String; Params: array of string; - ShowWind: Boolean; isPersistent: Boolean): Boolean; -{$ifndef windows} -var - Process: TProcessUTF8; - I: Integer; -{$endif} +procedure SendLog(const AText: String; AValue: TStrings); begin - if Trim(Exe) = '' then Exit(False); - Result := True; - {$ifdef windows} - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := WinRunProcessW(Exe, StringsToCommandLine(Params), ShowWind, isPersistent) - else - Result := WinRunProcessA(Exe, StringsToCommandLine(Params), ShowWind, isPersistent); - {$else} - Process := TProcessUTF8.Create(nil); - try - Process.InheritHandles := isPersistent; - Process.Executable := Exe; - Process.Parameters.AddStrings(Params); - if isPersistent then - Process.Options := Process.Options + [poWaitOnExit] - else - Process.Options := []; - if ShowWind then - Process.ShowWindow := swoShow - else - Process.ShowWindow := swoHIDE; - // Copy default environment variables including DISPLAY variable for GUI application to work - for I := 0 to GetEnvironmentVariableCount - 1 do - Process.Environment.Add(GetEnvironmentString(I)); - Process.Execute; - except - on E: Exception do - begin - WriteLog_E('RunExternalProcess.Error '#13#10+ - 'Executable: '+Exe+#13#10+ - 'Parameters: '+StringsToCommandLine(Params)+#13#10+ - 'Message : '+E.Message+#13#10+ - GetStackTraceInfo); - end; - end; - Process.Free; - {$endif} + Logger.Send(AText, AValue); end; -function RunExternalProcess(Exe, Params: String; ShowWind: Boolean; - isPersistent: Boolean): Boolean; +procedure SendLogError(const AText: String); begin - if Trim(Exe) = '' then Exit(False); - {$ifdef windows} - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := WinRunProcessW(Exe, Params, ShowWind, isPersistent) - else - Result := WinRunProcessA(Exe, Params, ShowWind, isPersistent); - {$else} - Result := RunExternalProcess(Exe, ParsedCommandLine(Params), ShowWind, isPersistent); - {$endif} + Logger.SendError(AText); end; -function RunExternalProcess(CommandLine: String; ShowWind: Boolean; - isPersistent: Boolean): Boolean; -var - s: string; - sa: TArrayOfString; +procedure SendLogWarning(const AText: String); begin - if Trim(CommandLine) = '' then Exit(False); - try - sa := ParsedCommandLine(CommandLine); - s := sa[Low(sa)]; - DeleteArrayOfString(sa, Low(sa)); - {$ifdef windows} - if Win32Platform = VER_PLATFORM_WIN32_NT then - Result := WinRunProcessW(s, StringsToCommandLine(sa), ShowWind, isPersistent) - else - Result := WinRunProcessA(s, StringsToCommandLine(sa), ShowWind, isPersistent); - {$else} - Result := RunExternalProcess(s, sa, ShowWind, isPersistent); - {$endif} - finally - SetLength(sa, 0); - end; + Logger.SendWarning(AText); +end; + +procedure SendLogException(const AText: String; AException: Exception); +begin + Logger.SendException(AText, AException); end; function HeaderByName(const AHeaders: TStrings; const AHeaderName: String): String; var - i, p: Cardinal; + i, p: Integer; hn: String; - begin + Result := ''; if AHeaders.Count < 1 then Exit; hn := AHeaderName; @@ -3812,12 +3848,4 @@ function HeaderByName(const AHeaders: TStrings; const AHeaderName: String): Stri end; end; -initialization - FMD_VERSION_NUMBER := GetCurrentBinVersion; - {$IFDEF WINDOWS} - DEFAULT_PATH := GetCurrentDir + DirectorySeparator + 'downloads'; - {$ELSE} - DEFAULT_PATH := '/downloads'; - {$ENDIF} - end. diff --git a/baseunits/uData.pas b/baseunits/uData.pas index 60f6e22d4..5b4c28313 100644 --- a/baseunits/uData.pas +++ b/baseunits/uData.pas @@ -6,7 +6,7 @@ unit uData; -{$mode delphi} +{$mode objfpc}{$H+} {$DEFINE DOWNLOADER} // This unit contains all necessary functions for data processing @@ -14,2604 +14,285 @@ interface uses - Classes, SysUtils, uBaseUnit, uFMDThread, sqlite3conn, sqldb, USimpleLogger, - strutils, dateutils, RegExpr, sqlite3, FileUtil, httpsend; + Classes, SysUtils, uBaseUnit, DBDataProcess, FMDOptions, httpsendthread, + BaseThread, LazFileUtils, strutils, RegExpr, httpsend, MultiLog; type - TSQLite3Connectionx = class(TSQLite3Connection) - public - property Handle read GetHandle; - end; - - { TDBDataProcess } - - TDBDataProcess = class - private - FConn: TSQLite3Connectionx; - FTrans: TSQLTransaction; - FQuery: TSQLQuery; - FRegxp: TRegExpr; - FWebsite: String; - FTableName: String; - FDataCount: Integer; - FFiltered: Boolean; - FFilterAllSites: Boolean; - FSitesList: TStringList; - FSQLSelect: String; - protected - function GetConnected: Boolean; - procedure CreateTable; - procedure VacuumTable; - procedure GetDataCount; - function GetWebsiteName(RecIndex: Integer): String; - function GetParam(RecIndex, ParamNo: Integer): String; - public - constructor Create; - destructor Destroy; override; - function Open(AWebsite: String = ''): Boolean; - procedure Save; - procedure Refresh; - procedure AddData(Title, Link, Authors, Artists, Genres, Status, Summary: String; - NumChapter, JDN: Integer); overload; - procedure AddData(Title, Link, Authors, Artists, Genres, Status, Summary: String; - NumChapter: Integer; JDN: TDateTime); overload; - procedure ApplyUpdates; - function Search(ATitle: String): Boolean; - function CanFilter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean): Boolean; - function Filter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean; - useRegExpr: Boolean = False): Boolean; - procedure RemoveFilter; - procedure Sort; - property Website: String read FWebsite write FWebsite; - property TableName: String read FTableName write FTableName; - property Connected: Boolean read GetConnected; - property DataCount: Integer read FDataCount; - property Filtered: Boolean read FFiltered; - property FilterAllSites: Boolean read FFilterAllSites write FFilterAllSites; - property SitesList: TStringList read FSitesList write FSitesList; - property WebsiteName[RecIndex: Integer]: String read GetWebsiteName; - property Param[RecIndex, ParamNo: Integer]: String read GetParam; - end; - - { TDataProcess } - - TDataProcess = class(TObject) - private - function GetInfo(const index: Cardinal): TStringList; - function GetParam(const index, paramNo : Integer) : String; - public - website, Filename: String; - isFilterAllSites, isFiltered: Boolean; - - site, filterMark: TByteList; - // used by search - searchPos, filterPos: TCardinalList; - Data, - - // parts - Title, Link, Authors, Artists, Genres, Status, Summary: TStringList; - JDN: TList; - - constructor Create; - destructor Destroy; override; - procedure Clear; - - function FirstParam(const index: Cardinal): String; - - // en: Break data into parts... This may be considered as bad coding, but - // it's for faster filter - procedure BreakDataToParts(const i: Cardinal); - - function LoadFromFile(const website: String): Boolean; - function LoadFromAllFiles(const websiteList: TStringList): Boolean; - procedure SaveToFile(const website: String); overload; - procedure SaveToFile; overload; - - function CanFilter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean): Boolean; - - // en: Filter by genres, title, authors, ... - function Filter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean; - useRegExpr: Boolean = False): Boolean; - // realtime search - function Search(AMangaName: String): Boolean; - // get data position - function GetPos(const ANodePos: Integer): Integer; - - // en: Remove filter - procedure RemoveFilter; - procedure Sort; - property Info[index: Cardinal]: TStringList read GetInfo; - property Param[index, paramNo: Integer]: String read GetParam; - end; - { TMangaInformation } TMangaInformation = class(TObject) + private + FOwner: TBaseThread; + FModuleId: Integer; + procedure SetModuleId(AValue: Integer); public isGetByUpdater: Boolean; mangaInfo: TMangaInfo; parse: TStringList; isGenerateFolderChapterName: Boolean; isRemoveUnicode: Boolean; - FHTTP: THTTPSend; + RemoveHostFromChapterLinks: Boolean; + FHTTP: THTTPSendThread; - procedure OnTag(NoCaseTag, ActualTag: string); - procedure OnText(Text: String); - constructor Create(AOwnerThread: TFMDThread = nil); + constructor Create(AOwnerThread: TBaseThread = nil; ACreateInfo: Boolean = True); destructor Destroy; override; procedure ClearInfo; - function GetDirectoryPage(var Page: Cardinal; const website: String): Byte; - function GetNameAndLink(const names, links: TStringList; - const website, URL: String): Byte; - function GetInfoFromURL(const website, URL: String; const Reconnect: Cardinal): Byte; - procedure SyncInfoToData(const DataProcess: TDataProcess; const index: Cardinal); - procedure SyncMinorInfoToData(const DataProcess: TDataProcess; - const index: Cardinal); - - // Only use this function for getting manga infos for the first time - procedure AddInfoToDataWithoutBreak(const Name, link: String; - const DataProcess: TDataProcess); - // Only use this function for update manga list - procedure AddInfoToData(const Name, link: String; const DataProcess: TDataProcess); - + function GetDirectoryPage(var APage: Integer; const AWebsite: String): Byte; + function GetNameAndLink(const ANames, ALinks: TStringList; const AWebsite, AURL: String): Byte; + function GetInfoFromURL(const AWebsite, AURL: String): Byte; + procedure SyncInfoToData(const ADataProcess: TDBDataProcess); overload; + procedure AddInfoToData(const ATitle, ALink: String; const ADataProcess: TDBDataProcess); overload; //wrapper - function GetPage(var output: TObject; URL: String; const Reconnect: Cardinal): Boolean; overload; + function GetPage(var AOutput: TObject; AURL: String; const AReconnect: Integer = 0): Boolean; inline; + property Thread: TBaseThread read FOwner; + property ModuleId: Integer read FModuleId write SetModuleId; end; var options: TStringList; -const - DBDataProcessParam = 'title,link,authors,artists,genres,status,summary,numchapter,jdn'; - DBDataProcessParams: array [0..8] of ShortString = - ('title', 'link', 'authors', 'artists', 'genres', 'status', 'summary', 'numchapter', 'jdn'); - DBDataProccesCreateParam = '(title TEXT,'+ - 'link TEXT NOT NULL PRIMARY KEY,'+ - 'authors TEXT,'+ - 'artists TEXT,'+ - 'genres TEXT,'+ - 'status TEXT,'+ - 'summary TEXT,'+ - 'numchapter INTEGER,'+ - 'jdn INTEGER);'; - - procedure ConvertDataProccessToDB(AWebsite: String; DeleteOriginal: Boolean = False); - implementation uses - Dialogs, - fpJSON, JSONParser, IniFiles, - jsHTMLUtil, - FastHTMLParser, HTMLUtil, - SynaCode, - frmMain, - uMisc; - -function NaturalCompareCallback({%H-}user: pointer; len1: longint; data1: pointer; - len2: longint; data2: pointer): longint; cdecl; -var - s1, s2: String; -begin - SetString(s1, data1, len1); - SetString(s2, data2, len2); - Result := NaturalCompareStr(s1, s2); -end; - -procedure RegexCallback(context: PSqlite3_Context; argc: longint; - argv: PPSqlite3_Value); cdecl; -var - regexp, Text: PChar; - regex: TRegExpr; -begin - if sqlite3_user_data(context) = nil then - begin - sqlite3_result_int64(context, 0); - Exit; - end; - if argc <> 2 then - begin - sqlite3_result_int64(context, 0); - Exit; - end; - regexp := sqlite3_value_text(argv[0]); - Text := sqlite3_value_text(argv[1]); - if (regexp = nil) or (Text = nil) then - begin - sqlite3_result_int64(context, 0); - Exit; - end; - try - regex := TRegExpr(sqlite3_user_data(context)); - regex.Expression := regexp; - sqlite3_result_int64(context, int64(regex.Exec(Text))); - except - sqlite3_result_int64(context, 0); - end; -end; - -procedure ConvertDataProccessToDB(AWebsite: String; DeleteOriginal: Boolean); -var - filepath: String; - rawdata: TDataProcess; - dbdata: TDBDataProcess; - i: Integer; -begin - filepath := fmdDirectory + DATA_FOLDER + AWebsite; - if FileExistsUTF8(filepath + DATA_EXT) then - begin - rawdata := TDataProcess.Create; - dbdata := TDBDataProcess.Create; - try - if FileExistsUTF8(filepath + DBDATA_EXT) then - DeleteFileUTF8(filepath + DBDATA_EXT); - rawdata.LoadFromFile(AWebsite); - dbdata.Open(AWebsite); - if rawdata.Data.Count > 0 then - with rawdata do - begin - for i := 0 to Data.Count-1 do - begin - dbdata.AddData(Title[i], Link[i], Authors[i], Artists[i], Genres[i], - Status[i], StringBreaks(Summary[i]), StrToIntDef(Param[i, DATA_PARAM_NUMCHAPTER], 1), - {%H-}Integer(JDN[i])-3); - end; - dbdata.ApplyUpdates; - end; - dbdata.Sort; - finally - rawdata.Free; - dbdata.Free; - end; - if DeleteOriginal then - DeleteFileUTF8(filepath + DATA_EXT); - end; -end; - -{ TDBDataProcess } - -function TDBDataProcess.GetConnected: Boolean; -begin - Result := FConn.Connected; -end; - -procedure TDBDataProcess.CreateTable; -begin - if FConn.Connected then - begin - FConn.ExecuteDirect('CREATE TABLE ' + QuotedStr(FTableName) + - DBDataProccesCreateParam); - FTrans.Commit; - end; -end; - -procedure TDBDataProcess.VacuumTable; -begin - if FConn.Connected then - with FConn do - begin - ExecuteDirect('END TRANSACTION'); - ExecuteDirect('VACUUM'); - ExecuteDirect('BEGIN TRANSACTION'); - end; -end; - -procedure TDBDataProcess.GetDataCount; -begin - if FQuery.Active then - begin - FQuery.Last; - FDataCount := FQuery.RecordCount; - FQuery.Refresh; - end - else - FDataCount := 0; -end; - -function TDBDataProcess.GetWebsiteName(RecIndex: Integer): String; -begin - if FConn.Connected then - begin - if FilterAllSites then - begin - - end - else - Result := FWebsite; - end; -end; + Dialogs, frmMain, WebsiteModules, uUpdateThread; -function TDBDataProcess.GetParam(RecIndex, ParamNo: Integer): String; -begin - Result := ''; - if FQuery.Active and - (ParamNo < Length(DBDataProcessParams)) and - (RecIndex < FDataCount) then - begin - try - FQuery.RecNo := RecIndex+1; - Result:= FQuery.FieldByName(DBDataProcessParams[ParamNo]).AsString; - except - on E: Exception do - WriteLog_E('TDBDataProcess.GetParam.Error: ' + E.Message + - LineEnding + GetStackTraceInfo); - end; - end; -end; +{ TMangaInformation } -constructor TDBDataProcess.Create; +constructor TMangaInformation.Create(AOwnerThread: TBaseThread; ACreateInfo: Boolean); begin - FConn := TSQLite3Connectionx.Create(nil); - FTrans := TSQLTransaction.Create(nil); - FQuery := TSQLQuery.Create(nil); - FTrans.DataBase := FConn; - FQuery.Transaction := FTrans; - FQuery.DataBase := FTrans.DataBase; - FRegxp := TRegExpr.Create; - FRegxp.ModifierI := True; - FSitesList := TStringList.Create; - FTableName := 'masterlist'; - FSQLSelect := 'SELECT * FROM ' + FTableName; - FDataCount := 0; + inherited Create; + FOwner := AOwnerThread; + FHTTP := THTTPSendThread.Create(AOwnerThread); + FHTTP.Headers.NameValueSeparator := ':'; + parse := TStringList.Create; + if ACreateInfo then + mangaInfo := TMangaInfo.Create; + isGetByUpdater := False; + ModuleId := -1; + RemoveHostFromChapterLinks := True; end; -destructor TDBDataProcess.Destroy; +destructor TMangaInformation.Destroy; begin - FSitesList.Free; - FQuery.Close; - if FConn.Connected then - begin - FTrans.Commit; - VacuumTable; - end; - FTrans.Active := False; - FConn.Connected := False; - FQuery.Free; - FTrans.Free; - FConn.Free; - FRegxp.Free; + if Assigned(mangaInfo) then + mangaInfo.Free; + if Assigned(parse) then + parse.Free; + FHTTP.Free; inherited Destroy; end; -function TDBDataProcess.Open(AWebsite: String): Boolean; -var - ts: TStringList; - filepath: String; - i: Integer; -begin - Result := False; - if AWebsite <> '' then FWebsite := AWebsite; - if FWebsite = '' then Exit; - - filepath := fmdDirectory + DATA_FOLDER + FWebsite + DBDATA_EXT; - if not FileExistsUTF8(filepath) then - ConvertDataProccessToDB(AWebsite); - if not FileExistsUTF8(filepath) then Exit; - - try - if FConn.Connected then - begin - FTrans.Commit; - VacuumTable; - FConn.Connected := False; - end; - FConn.DatabaseName := filepath; - FConn.Connected := True; - sqlite3_create_collation(FConn.Handle, PChar('NATCMP'), SQLITE_UTF8, nil, - NaturalCompareCallback); - sqlite3_create_function(FConn.Handle, PChar('REGEXP'), 2, SQLITE_UTF8, FRegxp, - RegexCallback, nil, nil); - FTrans.Active := True; - ts := TStringList.Create; - try - FConn.GetTableNames(ts); - ts.Sort; - if not ts.Find(FTableName, i) then - CreateTable; - finally - ts.Free; - end; - FSQLSelect := 'SELECT * FROM ' + FTableName;; - FQuery.SQL.Text := FSQLSelect; - FQuery.Open; - GetDataCount; - FFiltered := False; - Result := FQuery.Active; - except - on E: Exception do - WriteLog_E('TDBDataProcess.LoadFromFile.Error: ' + E.Message + - LineEnding + GetStackTraceInfo); - end; -end; - -procedure TDBDataProcess.Save; -begin - Self.ApplyUpdates; -end; - -procedure TDBDataProcess.Refresh; -begin - if FQuery.Active then - FQuery.Refresh; -end; - -procedure TDBDataProcess.AddData(Title, Link, Authors, Artists, Genres, Status, - Summary: String; NumChapter, JDN: Integer); -begin - if FConn.Connected then - try - FConn.ExecuteDirect('INSERT INTO ' + FTableName + '(' + DBDataProcessParam + - ') VALUES (' + - QuotedStrd(Title) + ',' + - QuotedStrd(Link) + ',' + - QuotedStrd(Authors) + ',' + - QuotedStrd(Artists) + ',' + - QuotedStrd(Genres) + ',' + - QuotedStrd(Status) + ',' + - QuotedStrd(Summary) + ',' + - QuotedStrd(NumChapter) + ',' + - QuotedStrd(JDN) + ');'); - except - on E: Exception do - WriteLog_E('TDBDataProcess.AddData.Error: ' + E.Message + LineEnding + GetStackTraceInfo); - end; -end; - -procedure TDBDataProcess.AddData(Title, Link, Authors, Artists, Genres, Status, - Summary: String; NumChapter: Integer; JDN: TDateTime); -begin - Self.AddData(Title, Link, Authors, Artists, Genres, Status, Summary, - NumChapter, DateToJDN(JDN)); -end; - -procedure TDBDataProcess.ApplyUpdates; -begin - if FConn.Connected then - begin - FQuery.Close; - FTrans.Commit; - FQuery.Open; - GetDataCount; - end; -end; - -function TDBDataProcess.Search(ATitle: String): Boolean; -begin - Result := False; - if FConn.Connected then - begin - try - FQuery.Close; - FQuery.SQL.Text := FSQLSelect; - if ATitle <> '' then - FQuery.SQL.Add('WHERE title LIKE ' + QuotedStrd(AnsiQuotedStr(ATitle, '%'))); - FQuery.Open; - GetDataCount; - except - on E: Exception do - WriteLog_E('TDBDataProcess.Search.Error: ' + E.Message + LineEnding + GetStackTraceInfo); - end; - end; -end; - -function TDBDataProcess.CanFilter(const checkedGenres, - uncheckedGenres: TStringList; const stTitle, stAuthors, stArtists, stStatus, - stSummary: String; const minusDay: Cardinal; const haveAllChecked, - searchNewManga: Boolean): Boolean; +procedure TMangaInformation.ClearInfo; begin - Result := True; + mangaInfo.artists := ''; + mangaInfo.authors := ''; + mangaInfo.genres := ''; + mangaInfo.summary := ''; + mangaInfo.coverLink := ''; + mangaInfo.numChapter := 0; + mangaInfo.status := ''; + mangaInfo.title := ''; + mangaInfo.url := ''; + mangaInfo.website := ''; + mangaInfo.chapterName.Clear; + mangaInfo.chapterLinks.Clear; end; -function TDBDataProcess.Filter(const checkedGenres, - uncheckedGenres: TStringList; const stTitle, stAuthors, stArtists, stStatus, - stSummary: String; const minusDay: Cardinal; const haveAllChecked, - searchNewManga: Boolean; useRegExpr: Boolean): Boolean; +procedure TMangaInformation.SetModuleId(AValue: Integer); begin - Result := False; - with FQuery do - begin - Close; - try - SQL.Clear; - SQL.Add(FSQLSelect); - SQL.Add('WHERE'); - if searchNewManga then - SQL.Add('jdn > ' + QuotedStrd(DateToJDN(IncDay(Now, (0-minusDay))))); - Open; - FFiltered := Active; - except - on E: Exception do - begin - WriteLog_E('TDBDataProcess.Filter.Error: ' + E.Message + - LineEnding + GetStackTraceInfo); - Close; - SQL.Text := FSQLSelect; - Open; - FFiltered := False; - end; - end; - Result := FFiltered; - end; + if FModuleId = AValue then Exit; + FModuleId := AValue; + if (FModuleId <> -1) and Assigned(FHTTP) then + WebsiteModules.Modules[FModuleId].PrepareHTTP(FHTTP); end; -procedure TDBDataProcess.RemoveFilter; +function TMangaInformation.GetDirectoryPage(var APage: Integer; const AWebsite: String): Byte; begin - FFiltered := False; -end; + APage := 1; -procedure TDBDataProcess.Sort; -begin - if FConn.Connected then + //load pagenumber_config if available + if Modules[ModuleId].Settings.Enabled and (Modules[ModuleId].Settings.UpdateListDirectoryPageNumber > 0) then begin - FQuery.Close; - with FConn do - begin - ExecuteDirect('CREATE TABLE ' + QuotedStrd(FTableName+'_ordered') + - DBDataProccesCreateParam); - ExecuteDirect('INSERT INTO '+ QuotedStrd(FTableName+'_ordered') + ' ' + - BracketStr(DBDataProcessParam) + ' SELECT ' + DBDataProcessParam + - ' FROM '+ QuotedStrd(FTableName) + 'ORDER BY title COLLATE NATCMP'); - ExecuteDirect('DROP TABLE ' + QuotedStrd(FTableName)); - ExecuteDirect('ALTER TABLE '+ QuotedStrd(FTableName+'_ordered') + - 'RENAME TO ' + QuotedStrd(FTableName)); - FTrans.Commit; - VacuumTable - end; - FQuery.Open; + APage := Modules[ModuleId].Settings.UpdateListDirectoryPageNumber; + BROWSER_INVERT := True; + Exit(NO_ERROR); end; -end; - -// ----- TDataProcess ----- - -constructor TDataProcess.Create; -begin - inherited Create; - isFilterAllSites := False; - isFiltered := False; - Data := TStringList.Create; - - Title := TStringList.Create; - Link := TStringList.Create; - Authors := TStringList.Create; - Artists := TStringList.Create; - Genres := TStringList.Create; - Status := TStringList.Create; - Summary := TStringList.Create; - JDN := TList.Create; - site := TByteList.Create; - filterMark := TByteList.Create; - filterPos := TCardinalList.Create; - searchPos := TCardinalList.Create; -end; - -destructor TDataProcess.Destroy; -begin - searchPos.Free; - filterMark.Free; - filterPos.Free; - site.Free; - - Title.Free; - Link.Free; - Authors.Free; - Artists.Free; - Genres.Free; - Status.Free; - Summary.Free; - JDN.Free; - - Data.Free; - inherited Destroy; -end; - -procedure TDataProcess.Clear; -begin - isFilterAllSites := False; - isFiltered := False; - - Data.Clear; - Title.Clear; - Link.Clear; - Authors.Clear; - Artists.Clear; - Genres.Clear; - Status.Clear; - Summary.Clear; - - JDN.Clear; - site.Clear; - filterMark.Clear; - filterPos.Clear; - searchPos.Clear; -end; - -function TDataProcess.FirstParam(const index: Cardinal): String; -var - l: Cardinal; -begin - Result := ''; - l := Pos(SEPERATOR, Data.Strings[index]); - if l <> 0 then - Result := LeftStr(Data.Strings[index], l - 1); -end; + BROWSER_INVERT := False; + if ModuleId < 0 then + ModuleId := Modules.LocateModule(AWebsite); + if Modules.ModuleAvailable(ModuleId, MMGetDirectoryPageNumber) then + Result := Modules.GetDirectoryPageNumber(Self, APage, TUpdateListThread(Thread).workPtr, ModuleId) + else + Exit(INFORMATION_NOT_FOUND); -function TDataProcess.GetInfo(const index: Cardinal): TStringList; -begin - GetParams(Result{%H-}, Data.Strings[index]); + if APage < 1 then + APage := 1; end; -function TDataProcess.GetParam(const index, paramNo: Integer): String; -var - i, p: Integer; - s: String; +function TMangaInformation.GetNameAndLink(const ANames, ALinks: TStringList; + const AWebsite, AURL: String): Byte; begin - Result := ''; - if index < Data.Count then + if ModuleId < 0 then + ModuleId := Modules.LocateModule(AWebsite); + if Modules.ModuleAvailable(ModuleId, MMGetNameAndLink) then begin - s := Data.Strings[index]; - i := 0; - p := 0; - repeat - p := Pos(SEPERATOR, s); - if p > 0 then - begin - Inc(i); - Result := LeftStr(s, p - 1); - s := RightStr(s, Length(s) - p - Length(SEPERATOR) + 1); - end; - until (p = 0) or (i > paramNo); - if i <= paramNo then - Result := ''; - end; -end; + Result := Modules.GetNameAndLink(Self, ANames, ALinks, AURL, ModuleId) + end + else + Exit(INFORMATION_NOT_FOUND); -// en: break data - for fast filter -procedure TDataProcess.BreakDataToParts(const i: Cardinal); -begin - if i < Data.Count then - begin - Title.Strings[i] := GetParam(i, DATA_PARAM_NAME); - Link.Strings[i] := GetParam(i, DATA_PARAM_LINK); - Authors.Strings[i] := GetParam(i, DATA_PARAM_AUTHORS); - Artists.Strings[i] := GetParam(i, DATA_PARAM_ARTISTS); - Genres.Strings[i] := GetParam(i, DATA_PARAM_GENRES); - Status.Strings[i] := GetParam(i, DATA_PARAM_STATUS); - Summary.Strings[i] := GetParam(i, DATA_PARAM_SUMMARY); - JDN.Items[i] := Pointer(StrToIntDef(GetParam(i, DATA_PARAM_JDN),0)); - end; + //remove host from AURL + if ALinks.Count > 0 then + RemoveHostFromURLsPair(ALinks, ANames); end; -function TDataProcess.LoadFromFile(const website: String): Boolean; +function TMangaInformation.GetInfoFromURL(const AWebsite, AURL: String): Byte; var - id, i: Cardinal; - l: TStringList; - Filename: String; + s, s2: String; + j, k: Integer; + del: Boolean; + bmangaInfo: TBaseMangaInfo; begin - Filename := DATA_FOLDER + website; - - Data.Clear; - searchPos.Clear; - filterMark.Clear; - filterPos.Clear; - site.Clear; - - title.Clear; - authors.Clear; - artists.Clear; - genres.Clear; - status.Clear; - summary.Clear; - jdn.Clear; + if Trim(AURL) = '' then + Exit(INFORMATION_NOT_FOUND); - if not FileExists(Filename + DATA_EXT) then - Exit(False); - l := TStringList.Create; - try - Self.Filename := Filename; + GetBaseMangaInfo(mangaInfo, bmangaInfo); - Data.LoadFromFile(Filename + DATA_EXT); - id := GetMangaSiteID(website); - - if Data.Count > 0 then - begin - //QuickSortData(data); - QuickSortNaturalPart(Data, SEPERATOR, DATA_PARAM_NAME); //Natural Sorting - for i := 0 to Data.Count - 1 do - begin - filterMark.Add(FILTER_SHOW); - filterPos.Add(i); - site.Add(id); + mangaInfo.website := AWebsite; + mangaInfo.coverLink := ''; + mangaInfo.numChapter := 0; + mangaInfo.chapterName.Clear; + mangaInfo.chapterLinks.Clear; - l.Clear; - try - GetParams(l, Data.Strings[i]); - while l.Count < 10 do - l.Add(''); - title.Add(l.Strings[DATA_PARAM_NAME]); - link.Add(l.Strings[DATA_PARAM_LINK]); - authors.Add(l.Strings[DATA_PARAM_AUTHORS]); - artists.Add(l.Strings[DATA_PARAM_ARTISTS]); - genres.Add(l.Strings[DATA_PARAM_GENRES]); - status.Add(l.Strings[DATA_PARAM_STATUS]); - summary.Add(l.Strings[DATA_PARAM_SUMMARY]); - jdn.Add(Pointer(StrToIntDef(l.Strings[DATA_PARAM_JDN], 0))); - except - end; + if ModuleId < 0 then + ModuleId := Modules.LocateModule(AWebsite); + if Modules.ModuleAvailable(ModuleId, MMGetInfo) then begin + mangaInfo.url := FillHost(Modules.Module[ModuleId].RootURL, AURL); + Result := Modules.GetInfo(Self, AURL, ModuleId); + end + else + Exit(INFORMATION_NOT_FOUND); + + with mangaInfo do begin + if link = '' then + link := RemoveHostFromURL(mangaInfo.url); + + // cleanup info + coverLink := CleanURL(coverLink); + title := Trim(FixWhiteSpace(RemoveStringBreaks(CommonStringFilter(title)))); + authors := Trim(FixWhiteSpace(RemoveStringBreaks(Trim(authors)))); + artists := Trim(FixWhiteSpace(RemoveStringBreaks(Trim(artists)))); + genres := Trim(FixWhiteSpace(RemoveStringBreaks(Trim(genres)))); + + authors := TrimRightChar(Trim(FixWhiteSpace(authors)), [',']); + artists := TrimRightChar(Trim(FixWhiteSpace(artists)), [',']); + genres := TrimRightChar(Trim(FixWhiteSpace(genres)), [',']); + + summary := CleanMultilinedString(FixWhiteSpace(summary)); + + // fix info + if (LeftStr(authors, 1) = '<') or (authors = '-') or (authors = ':') then + authors := ''; + if (LeftStr(artists, 1) = '<') or (artists = '-') or (artists = ':') then + artists := ''; + if (summary = '-') or (summary = ':') then + summary := ''; + if title = '' then + title := 'N/A'; + FillBaseMangaInfo(mangaInfo, bmangaInfo); + + // cleanup chapters + if chapterLinks.Count > 0 then begin + while chapterName.Count < chapterLinks.Count do + chapterName.Add(''); + while chapterLinks.Count < chapterName.Count do + chapterName.Delete(chapterName.Count - 1); + for j := 0 to chapterLinks.Count - 1 do begin + chapterLinks[j] := Trim(chapterLinks[j]); + chapterName[j] := Trim(chapterName[j]); end; end; - finally - l.Free; - end; - Result := True; -end; - -// TODO: load from all files - this function is for "Filter all sites" -function TDataProcess.LoadFromAllFiles(const websiteList: TStringList): Boolean; -var - id, j, i: Cardinal; - l: TStringList; - Filename: String; -begin - if websiteList.Count = 0 then - Exit(False); - Data.Clear; - searchPos.Clear; - filterMark.Clear; - filterPos.Clear; - site.Clear; - - title.Clear; - authors.Clear; - artists.Clear; - genres.Clear; - status.Clear; - summary.Clear; - jdn.Clear; - l := TStringList.Create; - try - for i := 0 to websiteList.Count - 1 do + // remove duplicate chapter + if chapterLinks.Count > 0 then begin - Filename := DATA_FOLDER + websiteList.Strings[i]; - id := GetMangaSiteID(websiteList.Strings[i]); - if not FileExists(Filename + DATA_EXT) then - continue; - l.Clear; - l.LoadFromFile(Filename + DATA_EXT); - - if l.Count <> 0 then + j := 0; + while j < (chapterLinks.Count - 1) do begin - for j := 0 to l.Count - 1 do - begin - site.Add(id); - end; - Data.Text := Data.Text + l.Text; + del := False; + if (j + 1) < chapterLinks.Count then + for k := j + 1 to chapterLinks.Count - 1 do + if SameText(chapterLinks[j], chapterLinks[k]) then + begin + chapterLinks.Delete(j); + chapterName.Delete(j); + del := True; + Break; + end; + if not del then + Inc(j); end; end; - if Data.Count > 0 then + if chapterLinks.Count > 0 then begin - QuickSortDataWithWebID(Data, site); - for i := 0 to Data.Count - 1 do + // remove host from chapter links + if RemoveHostFromChapterLinks then + RemoveHostFromURLsPair(chapterLinks, chapterName); + // fixing chapter name + for j := 0 to chapterName.Count - 1 do + chapterName[j] := Trim(CleanString(RemoveStringBreaks( + CommonStringFilter(chapterName[j])))); + + //remove manga name from chapter + if OptionRemoveMangaNameFromChapter and (title <> '') then begin - filterMark.Add(FILTER_SHOW); - filterPos.Add(i); - - l.Clear; - try - GetParams(l, Data.Strings[i]); - While l.Count < 10 do - l.Add(''); - title.Add(l.Strings[DATA_PARAM_NAME]); - link.Add(l.Strings[DATA_PARAM_LINK]); - authors.Add(l.Strings[DATA_PARAM_AUTHORS]); - artists.Add(l.Strings[DATA_PARAM_ARTISTS]); - genres.Add(l.Strings[DATA_PARAM_GENRES]); - status.Add(l.Strings[DATA_PARAM_STATUS]); - summary.Add(l.Strings[DATA_PARAM_SUMMARY]); - jdn.Add(Pointer(StrToIntDef(l.Strings[DATA_PARAM_JDN], 0))); - except + s := LowerCase(title); + j := Length(s); + for k := 0 to chapterName.Count - 1 do begin + s2 := LowerCase(chapterName[k]); + if Length(s2) > j then + if Pos(s, s2) = 1 then begin + s2 := chapterName[k]; + Delete(s2, 1, j); + s2 := Trim(s2); + if LeftStr(s2, 2) = '- ' then + Delete(s2, 1, 2); + chapterName[k] := s2; + end; end; end; end; - finally - l.Free; - end; - Result := True; -end; -procedure TDataProcess.SaveToFile(const website: String); -begin - if Data.Count = 0 then - Exit; - //QuickSortData(Data); - ForceDirectoriesUTF8(DATA_FOLDER); - Data.SaveToFile(DATA_FOLDER + website + DATA_EXT); -end; - -procedure TDataProcess.SaveToFile; -begin - if Data.Count = 0 then - Exit; - //QuickSortData(Data); - ForceDirectoriesUTF8(DATA_FOLDER); - Data.SaveToFile(Filename + DATA_EXT); + numChapter := chapterLinks.Count; + end; end; -// check if we need to filter or not -function TDataProcess.CanFilter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean): Boolean; +procedure TMangaInformation.SyncInfoToData(const ADataProcess: TDBDataProcess); begin - if (filterPos.Count = 0) or - (Data.Count = 0) or - ((stTitle = '') and - (stAuthors = '') and - (stArtists = '') and - (stSummary = '') and - (stStatus = '2') and - (checkedGenres.Count = 0) and - (uncheckedGenres.Count = 0)) and - (not searchNewManga) then - Result := False - else - Result := True; + if Assigned(ADataProcess) then + with mangaInfo do + ADataProcess.UpdateData(title, link, authors, artists, genres, status, summary, + numChapter, website); end; -function TDataProcess.Filter(const checkedGenres, uncheckedGenres: TStringList; - const stTitle, stAuthors, stArtists, stStatus, stSummary: String; - const minusDay: Cardinal; const haveAllChecked, searchNewManga: Boolean; - useRegExpr: Boolean = False): Boolean; -var - currentJDN, i, j, k, fpos, Count: Integer; - s: String; - regx: TRegExpr; - fshow: Boolean; - gen: TStringList; +procedure TMangaInformation.AddInfoToData(const ATitle, ALink: String; const ADataProcess: TDBDataProcess); begin - regx := TRegExpr.Create; - regx.ModifierI := True; - try - Result := False; - searchPos.Clear; - if (filterPos.Count = 0) or - (Data.Count = 0) or - ((stTitle = '') and - (stAuthors = '') and - (stArtists = '') and - (stSummary = '') and - (stStatus = '2') and - (checkedGenres.Count = 0) and - (uncheckedGenres.Count = 0)) and - (not searchNewManga) then - Exit; - - // ugly filter code but quite fast - if searchNewManga then - begin - currentJDN := GetCurrentJDN; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if (currentJDN - Integer(jdn.Items[fpos]) >= minusDay) and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - - // filter title - if Trim(stTitle) <> '' then - begin - s := LowerCase(stTitle); - if useRegExpr then - regx.Expression := stTitle; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if useRegExpr then - fshow := not regx.Exec(Title[fpos]) - else - fshow := (Pos(s, LowerCase(Title.Strings[fpos])) = 0); - if fshow and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - - // filter authors - if stAuthors <> '' then - begin - s := LowerCase(stAuthors); - if useRegExpr then - regx.Expression := stAuthors; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if useRegExpr then - fshow := not regx.Exec(Authors[fpos]) - else - fshow := (Pos(s, LowerCase(Authors.Strings[fpos])) = 0); - if fshow and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - - // filter artist - if stArtists <> '' then - begin - s := LowerCase(stArtists); - if useRegExpr then - regx.Expression := stArtists; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if useRegExpr then - fshow := not regx.Exec(Artists[fpos]) - else - fshow := (Pos(s, LowerCase(Artists.Strings[fpos])) = 0); - if fshow and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - - // filter summary - if stSummary <> '' then - begin - s := LowerCase(stSummary); - if useRegExpr then - regx.Expression := stSummary; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if useRegExpr then - fshow := not regx.Exec(Summary[fpos]) - else - fshow := (Pos(s, LowerCase(Summary.Strings[fpos])) = 0); - if fshow and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - - // filter status - if stStatus <> '2' then - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if (CompareText(stStatus, Status.Strings[fpos]) <> 0) and - (filterMark.Items[fpos] = FILTER_SHOW) then - filterMark.Items[fpos] := FILTER_HIDE; - end; - - // filter genres - if checkedGenres.Count > 0 then - begin - for i := 0 to checkedGenres.Count - 1 do - if useRegExpr then - checkedGenres[i] := Trim(checkedGenres[i]) - else - checkedGenres.Strings[i] := Trim(LowerCase(checkedGenres.Strings[i])); - gen := TStringList.Create; - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if filterMark.Items[fpos] = FILTER_SHOW then - begin - gen.Clear; - ExtractStrings([','], [], PChar(Trim(LowerCase(Genres[fpos]))), gen); - TrimStrings(gen); - if gen.Count > 0 then - begin - if haveAllChecked then - begin - Count := checkedGenres.Count; - for j := 0 to checkedGenres.Count - 1 do - begin - if useRegExpr then - regx.Expression := checkedGenres[j]; - for k := 0 to gen.Count - 1 do - begin - if useRegExpr then - fshow := regx.Exec(gen[k]) - else - fshow := SameText(checkedGenres[j], gen[k]); - if fshow then - begin - Dec(Count); - Break; - end; - end; - end; - if Count > 0 then - filterMark.Items[fpos] := FILTER_HIDE; - end - else - begin - filterMark.Items[fpos] := FILTER_HIDE; - for j := 0 to checkedGenres.Count - 1 do - begin - if useRegExpr then - regx.Expression := checkedGenres[j]; - for k := 0 to gen.Count - 1 do - begin - if useRegExpr then - fshow := regx.Exec(gen[k]) - else - fshow := SameText(checkedGenres[j], gen[k]); - if fshow then - Break; - end; - if fshow then - begin - filterMark.Items[fpos] := FILTER_SHOW; - Break; - end; - end; - end; - end - else - begin - if filterMark.Items[fpos] = FILTER_SHOW then - filterMark.Items[fpos] := FILTER_HIDE; - end; - end; - end; - gen.Free; - end; - - if uncheckedGenres.Count > 0 then - begin - for i := 0 to uncheckedGenres.Count - 1 do - uncheckedGenres.Strings[i] := LowerCase(uncheckedGenres.Strings[i]); - - for i := 0 to filterPos.Count - 1 do - begin - fpos := filterPos.Items[i]; - if (filterMark.Items[fpos] = FILTER_SHOW) then - begin - s := LowerCase(Genres.Strings[fpos]); - if haveAllChecked then - begin - Count := uncheckedGenres.Count; - for j := 0 to uncheckedGenres.Count - 1 do - if Pos((uncheckedGenres.Strings[j] + ','), s) = 0 then - Dec(Count); - if Count > 0 then - filterMark.Items[fpos] := FILTER_HIDE; - end - else - begin - for j := 0 to uncheckedGenres.Count - 1 do - if Pos((uncheckedGenres.Strings[j] + ','), s) <> 0 then - begin - filterMark.Items[fpos] := FILTER_HIDE; - Break; - end; - end; - end; - end; - end; - - fpos := filterPos.Count; - filterPos.Clear; - for i := 0 to Data.Count - 1 do - if filterMark.Items[i] = FILTER_SHOW then - filterPos.Add(i); - - if filterPos.Count <> fpos then - begin - isFiltered := True; - Result := True; - end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; - regx.Free; -end; - -function TDataProcess.Search(AMangaName: String): Boolean; -var - i: Cardinal; -begin - searchPos.Clear; - if filterPos.Count <= 0 then - Exit; - AMangaName := Upcase(AMangaName); - for i := 0 to filterPos.Count - 1 do - begin - if Pos(AMangaName, upcase(Title.Strings[filterPos.Items[i]])) > 0 then - begin - searchPos.Add(filterPos.Items[i]); - Result := True; - end; - end; -end; - -// get data position -function TDataProcess.GetPos(const ANodePos: Integer): Integer; -begin - if searchPos.Count = 0 then - Result := filterPos.Items[ANodePos] - else - Result := searchPos.Items[ANodePos]; -end; - -procedure TDataProcess.RemoveFilter; -var - i: Cardinal; -begin - searchPos.Clear; - filterMark.Clear; - filterPos.Clear; - if Data.Count > 0 then - begin - for i := 0 to Data.Count - 1 do - begin - filterMark.Add(FILTER_SHOW); - filterPos.Add(i); - end; - end; - isFiltered := False; -end; - -procedure TDataProcess.Sort; -begin - //QuickSortData(data); - uMisc.QuickSortNaturalPart(Data, SEPERATOR, DATA_PARAM_NAME); -end; - -{ TMangaInformation } - -constructor TMangaInformation.Create(AOwnerThread: TFMDThread); -begin - inherited Create; - FHTTP := THTTPSendThread.Create(AOwnerThread); - FHTTP.Headers.NameValueSeparator := ':'; - parse := TStringList.Create; - mangaInfo := TMangaInfo.Create; - isGetByUpdater := False; -end; - -destructor TMangaInformation.Destroy; -begin - ClearInfo; - mangaInfo.Free; - parse.Free; - FHTTP.Free; - inherited Destroy; -end; - -procedure TMangaInformation.ClearInfo; -begin - mangaInfo.artists := ''; - mangaInfo.authors := ''; - mangaInfo.genres := ''; - mangaInfo.summary := ''; - mangaInfo.coverLink := ''; - mangaInfo.numChapter := 0; - mangaInfo.status := ''; - mangaInfo.title := ''; - mangaInfo.url := ''; - mangaInfo.website := ''; - mangaInfo.chapterName.Clear; - mangaInfo.chapterLinks.Clear; -end; - -procedure TMangaInformation.OnTag(NoCaseTag, ActualTag : string); -begin - parse.Add(ActualTag); -end; - -procedure TMangaInformation.OnText(Text: String); -begin - parse.Add(Text); -end; - -function TMangaInformation.GetDirectoryPage(var Page: Cardinal; - const website: String): Byte; -var - s: String; - p: Integer; - Source: TStringList; - Parser: THTMLParser; - WebsiteID: Cardinal; - - {$I includes/AnimeA/directory_page_number.inc} - - {$I includes/KissManga/directory_page_number.inc} - - {$I includes/Batoto/directory_page_number.inc} - - {$I includes/Manga24h/directory_page_number.inc} - - {$I includes/VnSharing/directory_page_number.inc} - - {$I includes/Hentai2Read/directory_page_number.inc} - - {$I includes/Fakku/directory_page_number.inc} - - {$I includes/Pururin/directory_page_number.inc} - - {$I includes/MangaPark/directory_page_number.inc} - - {$I includes/MangaFox/directory_page_number.inc} - - //{$I includes/MangaTraders/directory_page_number.inc} - - {$I includes/SenManga/directory_page_number.inc} - - {$I includes/MangaGo/directory_page_number.inc} - - {$I includes/MangaEden/directory_page_number.inc} - - {$I includes/BlogTruyen/directory_page_number.inc} - - {$I includes/RedHawkScans/directory_page_number.inc} - - {$I includes/S2Scans/directory_page_number.inc} - - {$I includes/LectureEnLigne/directory_page_number.inc} - - {$I includes/MangaAe/directory_page_number.inc} - - {$I includes/CentralDeMangas/directory_page_number.inc} - - {$I includes/Manga2u/directory_page_number.inc} - - {$I includes/DM5/directory_page_number.inc} - - {$I includes/EHentai/directory_page_number.inc} - - {$I includes/NineManga/directory_page_number.inc} - - {$I includes/JapanShin/directory_page_number.inc} - - {$I includes/Mangacow/directory_page_number.inc} - - {$I includes/OneManga/directory_page_number.inc} - - {$I includes/MangaTown/directory_page_number.inc} - - {$I includes/ReadHentaiManga/directory_page_number.inc} - - {$I includes/MyReadingMangaInfo/directory_page_number.inc} - - {$I includes/IKomik/directory_page_number.inc} - - {$I includes/NHentai/directory_page_number.inc} - - {$I includes/UnionMangas/directory_page_number.inc} - - {$I includes/MangaMint/directory_page_number.inc} - - {$I includes/HakiHome/directory_page_number.inc} - - {$I includes/MangaFrame/directory_page_number.inc} - - {$I includes/MangaHost/directory_page_number.inc} - - {$I includes/PornComix/directory_page_number.inc} - - {$I includes/MangaSee/directory_page_number.inc} - - {$I includes/AcademyVN/directory_page_number.inc} - - {$I includes/MangaAt/directory_page_number.inc} - - {$I includes/ReadMangaToday/directory_page_number.inc} - - {$I includes/Dynasty-Scans/directory_page_number.inc} - - {$I includes/Madokami/directory_page_number.inc} - - {$I includes/WPManga/directory_page_number.inc} - -begin - Page := 0; - WebsiteID := GetMangaSiteID(website); - - //load User-Agent from INIAdvanced - if website <> '' then - FHTTP.UserAgent := INIAdvanced.ReadString('UserAgent', website, ''); - - //load pagenumber_config if available - p := INIAdvanced.ReadInteger('UpdateListDirectoryPageNumber', website, -1); - - if p > 0 then - begin - Page := p; - BROWSER_INVERT := True; - end - else - begin - BROWSER_INVERT := False; - - Source := TStringList.Create; - if website = WebsiteRoots[ANIMEA_ID, 0] then - Result := GetAnimeADirectoryPageNumber - else - if website = WebsiteRoots[KISSMANGA_ID, 0] then - Result := GetKissMangaDirectoryPageNumber - else - if website = WebsiteRoots[BATOTO_ID, 0] then - Result := GetBatotoDirectoryPageNumber - else - if website = WebsiteRoots[MANGA24H_ID, 0] then - Result := GetManga24hDirectoryPageNumber - else - if website = WebsiteRoots[VNSHARING_ID, 0] then - Result := GetVnSharingDirectoryPageNumber - else - if website = WebsiteRoots[HENTAI2READ_ID, 0] then - Result := GetHentai2ReadDirectoryPageNumber - else - if website = WebsiteRoots[FAKKU_ID, 0] then - Result := GetFakkuDirectoryPageNumber - else - if website = WebsiteRoots[MANGAPARK_ID, 0] then - Result := GetMangaParkDirectoryPageNumber - else - //if website = WebsiteRoots[MANGAFOX_ID, 0] then - // Result := GetMangaFoxDirectoryPageNumber - //else - //if website = WebsiteRoots[MANGATRADERS_ID, 0] then - // Result := GetMangaTradersDirectoryPageNumber - //else - if website = WebsiteRoots[MANGAGO_ID, 0] then - Result := GetMangaGoDirectoryPageNumber - else - if website = WebsiteRoots[MANGAEDEN_ID, 0] then - Result := GetMangaEdenDirectoryPageNumber(WebsiteRoots[MANGAEDEN_ID, 1]) - else - if website = WebsiteRoots[PERVEDEN_ID, 0] then - Result := GetMangaEdenDirectoryPageNumber(WebsiteRoots[PERVEDEN_ID, 1]) - else - if website = WebsiteRoots[BLOGTRUYEN_ID, 0] then - Result := GetBlogTruyenDirectoryPageNumber - else - if website = WebsiteRoots[REDHAWKSCANS_ID, 0] then - Result := GetRedHawkScansDirectoryPageNumber - else - if website = WebsiteRoots[S2SCAN_ID,0] then - Result:= GetS2ScanDirectoryPageNumber - else - if website = WebsiteRoots[SENMANGA_ID, 0] then - Result := GetSenMangaDirectoryPageNumber - else - if website = WebsiteRoots[LECTUREENLIGNE_ID, 0] then - Result := GetLectureEnLigneDirectoryPageNumber - else - if website = WebsiteRoots[MANGAAE_ID, 0] then - Result := GetMangaAeDirectoryPageNumber - else - if website = WebsiteRoots[CENTRALDEMANGAS_ID, 0] then - Result := GetCentralDeMangasDirectoryPageNumber - else - if website = WebsiteRoots[MANGA2U_ID, 0] then - Result := GetManga2uDirectoryPageNumber - else - if website = WebsiteRoots[DM5_ID, 0] then - Result := GetDM5DirectoryPageNumber - else - if website = WebsiteRoots[PURURIN_ID, 0] then - Result := GetPururinDirectoryPageNumber - else - if website = WebsiteRoots[EHENTAI_ID, 0] then - Result := GetEHentaiDirectoryPageNumber - else - if (website = WebsiteRoots[NINEMANGA_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_ES_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_CN_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_RU_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_DE_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_IT_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_BR_ID, 0]) then - Result := GetNineMangaDirectoryPageNumber - else - if website = WebsiteRoots[JAPANSHIN_ID, 0] then - Result := GetJapanShinDirectoryPageNumber - else - if website = WebsiteRoots[MANGACOW_ID, 0] then - Result := GetMangaCowDirectoryPageNumber - else - if website = WebsiteRoots[ONEMANGA_ID, 0] then - Result := GetOneMangaDirectoryPageNumber - else - if website = WebsiteRoots[MANGATOWN_ID, 0] then - Result := GetMangaTownDirectoryPageNumber - else - if website = WebsiteRoots[READHENTAIMANGA_ID, 0] then - Result := GetReadHentaiMangaDirectoryPageNumber - else - if website = WebsiteRoots[MYREADINGMANGAINFO_ID, 0] then - Result := GetMyReadingMangaInfoDirectoryPageNumber - else - if website = WebsiteRoots[IKOMIK_ID, 0] then - Result := GetIKomikDirectoryPageNumber - else - if website = WebsiteRoots[NHENTAI_ID, 0] then - Result := GetNHentaiDirectoryPageNumber - else - if website = GetMangaSiteName(UNIONMANGAS_ID) then - Result := GetUnionMangasDirectoryPageNumber - else - if website = WebsiteRoots[MANGAMINT_ID, 0] then - Result := GetMangaMintDirectoryPageNumber - else - if website = WebsiteRoots[HAKIHOME_ID, 0] then - Result := GetHakiHomeDirectoryPageNumber - else - if website = WebsiteRoots[MANGAFRAME_ID, 0] then - Result := GetMangaFrameDirectoryPageNumber - else - if website = WebsiteRoots[MANGAHOST_ID, 0] then - Result := GetMangaHostDirectoryPageNumber - else - if (website = WebsiteRoots[PORNCOMIX_ID, 0]) or - (website = WebsiteRoots[XXCOMICS_ID, 0]) or - (website = WebsiteRoots[XXCOMICSMT_ID, 0]) or - (website = WebsiteRoots[XXCOMICS3D_ID, 0]) or - (website = WebsiteRoots[PORNCOMIXRE_ID, 0]) or - (website = WebsiteRoots[PORNCOMIXIC_ID, 0]) or - (website = WebsiteRoots[PORNXXXCOMICS_ID, 0]) then - Result := GetPornComixDirectoryPageNumber(GetMangaSiteID(website)) - else - if website = WebsiteRoots[MANGASEE_ID, 0] then - Result := GetMangaSeeDirectoryPageNumber - else - if website = WebsiteRoots[ACADEMYVN_ID, 0] then - Result := GetAcademyVNDirectoryPageNumber - else - if website = WebsiteRoots[MANGAAT_ID, 0] then - Result := GetMangaAtDirectoryPageNumber - else - if website = WebsiteRoots[READMANGATODAY_ID, 0] then - Result := GetReadMangaTodayDirectoryPageNumber - else - if website = WebsiteRoots[DYNASTYSCANS_ID, 0] then - Result := GetDynastyScansDirectoryPageNumber - else - if website = WebsiteRoots[MADOKAMI_ID, 0] then - Result := GetMadokamiDirectoryPageNumber - else - if SitesIsWPManga(WebsiteID) then - Result := GetWPMangaDirectoryPageNumber - else - begin - Result := NO_ERROR; - Page := 1; - Source.Free; - end; - - if page < 1 then - Page := 1; - end; -end; - -function TMangaInformation.GetNameAndLink(const names, links: TStringList; - const website, URL: String): Byte; -var - Source: TStringList; - Parser: THTMLParser; - WebsiteID: Cardinal; - - {$I includes/Manga2u/names_and_links.inc} - - {$I includes/AnimeA/names_and_links.inc} - - {$I includes/MangaHere/names_and_links.inc} - - {$I includes/EsMangaHere/names_and_links.inc} - - {$I includes/AnimExtremist/names_and_links.inc} - - {$I includes/MangaInn/names_and_links.inc} - - {$I includes/KissManga/names_and_links.inc} - - {$I includes/Batoto/names_and_links.inc} - - {$I includes/Manga24h/names_and_links.inc} - - {$I includes/VnSharing/names_and_links.inc} - - {$I includes/Hentai2Read/names_and_links.inc} - - {$I includes/Fakku/names_and_links.inc} - - {$I includes/MangaReader/names_and_links.inc} - - {$I includes/MangaPark/names_and_links.inc} - - {$I includes/MangaFox/names_and_links.inc} - - {$I includes/MangaTraders/names_and_links.inc} - - {$I includes/TruyenTranhTuan/names_and_links.inc} - - {$I includes/SubManga/names_and_links.inc} - - {$I includes/Komikid/names_and_links.inc} - - {$I includes/PecintaKomik/names_and_links.inc} - - {$I includes/Mabuns/names_and_links.inc} - - {$I includes/MangaEsta/names_and_links.inc} - - {$I includes/Pururin/names_and_links.inc} - - {$I includes/HugeManga/names_and_links.inc} - - {$I includes/AnimeStory/names_and_links.inc} - - {$I includes/LectureEnLigne/names_and_links.inc} - - {$I includes/ScanManga/names_and_links.inc} - - {$I includes/MangaAr/names_and_links.inc} - - {$I includes/MangaAe/names_and_links.inc} - - {$I includes/CentralDeMangas/names_and_links.inc} - - {$I includes/Imanhua/names_and_links.inc} - - {$I includes/Turkcraft/names_and_links.inc} - - {$I includes/MangaVadisi/names_and_links.inc} - - {$I includes/MangaFrame/names_and_links.inc} - - {$I includes/Mangacow/names_and_links.inc} - - {$I includes/SenManga/names_and_links.inc} - - {$I includes/Starkana/names_and_links.inc} - - {$I includes/EatManga/names_and_links.inc} - - {$I includes/MangaPanda/names_and_links.inc} - - {$I includes/MangaGo/names_and_links.inc} - - {$I includes/MangaStream/names_and_links.inc} - - {$I includes/RedHawkScans/names_and_links.inc} - - {$I includes/S2Scans/names_and_links.inc} - - {$I includes/EGScans/names_and_links.inc} - - {$I includes/BlogTruyen/names_and_links.inc} - - {$I includes/MangaEden/names_and_links.inc} - - {$I includes/Kivmanga/names_and_links.inc} - - {$I includes/Mangacan/names_and_links.inc} - - {$I includes/MeinManga/names_and_links.inc} - - {$I includes/MangasPROJECT/names_and_links.inc} - - {$I includes/MangaREADER_POR/names_and_links.inc} - - {$I includes/EHentai/names_and_links.inc} - - {$I includes/MangaStreamTo/names_and_links.inc} - - {$I includes/NineManga/names_and_links.inc} - - {$I includes/JapanShin/names_and_links.inc} - - {$I includes/Japscan/names_and_links.inc} - - {$I includes/CentrumMangi_PL/names_and_links.inc} - - {$I includes/MangaLib_PL/names_and_links.inc} - - {$I includes/OneManga/names_and_links.inc} - - {$I includes/MangaTown/names_and_links.inc} - - {$I includes/ReadHentaiManga/names_and_links.inc} - - {$I includes/MangaOku/names_and_links.inc} - - {$I includes/MyReadingMangaInfo/names_and_links.inc} - - {$I includes/IKomik/names_and_links.inc} - - {$I includes/NHentai/names_and_links.inc} - - {$I includes/UnionMangas/names_and_links.inc} - - {$I includes/MangaMint/names_and_links.inc} - - {$I includes/UnixManga/names_and_links.inc} - - {$I includes/HakiHome/names_and_links.inc} - - {$I includes/ExtremeMangas/names_and_links.inc} - - {$I includes/MangaHost/names_and_links.inc} - - {$I includes/PornComix/names_and_links.inc} - - {$I includes/MangaSee/names_and_links.inc} - - {$I includes/MangaKu/names_and_links.inc} - - {$I includes/AcademyVN/names_and_links.inc} - - {$I includes/MangaAt/names_and_links.inc} - - {$I includes/SenMangaRAW/names_and_links.inc} - - {$I includes/ReadMangaToday/names_and_links.inc} - - {$I includes/LoneManga/names_and_links.inc} - - {$I includes/Dynasty-Scans/names_and_links.inc} - - {$I includes/Madokami/names_and_links.inc} - - {$I includes/WPManga/names_and_links.inc} - -begin - WebsiteID := GetMangaSiteID(website); - - //load User-Agent from INIAdvanced - if website <> '' then - FHTTP.UserAgent := INIAdvanced.ReadString('UserAgent', website, ''); - - Source := TStringList.Create; - if website = WebsiteRoots[ANIMEA_ID, 0] then - Result := AnimeAGetNamesAndLinks - else - if website = WebsiteRoots[MANGAHERE_ID, 0] then - Result := MangaHereGetNamesAndLinks - else - if website = WebsiteRoots[MANGAINN_ID, 0] then - Result := MangaInnGetNamesAndLinks - else - if website = WebsiteRoots[KISSMANGA_ID, 0] then - Result := KissMangaGetNamesAndLinks - else - if website = WebsiteRoots[BATOTO_ID, 0] then - Result := BatotoGetNamesAndLinks - else - if website = WebsiteRoots[MANGA24H_ID, 0] then - Result := Manga24hGetNamesAndLinks - else - if website = WebsiteRoots[VNSHARING_ID, 0] then - Result := VnSharingGetNamesAndLinks - else - if website = WebsiteRoots[HENTAI2READ_ID, 0] then - Result := Hentai2ReadGetNamesAndLinks - else - if website = WebsiteRoots[FAKKU_ID, 0] then - Result := FakkuGetNamesAndLinks - else - if website = WebsiteRoots[MANGAREADER_ID, 0] then - Result := MangaReaderGetNamesAndLinks - else - if website = WebsiteRoots[MANGAPARK_ID, 0] then - Result := MangaParkGetNamesAndLinks - else - if website = WebsiteRoots[MANGAFOX_ID, 0] then - Result := MangaFoxGetNamesAndLinks - else - if website = WebsiteRoots[MANGATRADERS_ID, 0] then - Result := MangaTradersGetNamesAndLinks - else - if website = WebsiteRoots[STARKANA_ID, 0] then - Result := StarkanaGetNamesAndLinks - else - if website = WebsiteRoots[EATMANGA_ID, 0] then - Result := EatMangaGetNamesAndLinks - else - if website = WebsiteRoots[MANGAPANDA_ID, 0] then - Result := MangaPandaGetNamesAndLinks - else - if website = WebsiteRoots[MANGAGO_ID, 0] then - Result := MangaGoGetNamesAndLinks - else - if website = WebsiteRoots[MANGASTREAM_ID, 0] then - Result := MangaStreamGetNamesAndLinks - else - if website = WebsiteRoots[REDHAWKSCANS_ID, 0] then - Result := RedHawkScansGetNamesAndLinks - else - if website = WebsiteRoots[S2SCAN_ID, 0] then - Result := S2ScanGetNamesAndLinks - else - if website = WebsiteRoots[EGSCANS_ID, 0] then - Result := EGScansGetNamesAndLinks - else - if website = WebsiteRoots[MANGAEDEN_ID, 0] then - Result := MangaEdenGetNamesAndLinks(WebsiteRoots[MANGAEDEN_ID, 1]) - else - if website = WebsiteRoots[PERVEDEN_ID, 0] then - Result := MangaEdenGetNamesAndLinks(WebsiteRoots[PERVEDEN_ID, 1]) - else - if website = WebsiteRoots[MEINMANGA_ID, 0] then - Result := MeinMangaGetNamesAndLinks - else - if website = WebsiteRoots[BLOGTRUYEN_ID, 0] then - Result := BlogTruyenGetNamesAndLinks - else - if website = WebsiteRoots[TRUYENTRANHTUAN_ID, 0] then - Result := TruyenTranhTuanGetNamesAndLinks - else - if website = WebsiteRoots[SUBMANGA_ID, 0] then - Result := SubMangaGetNamesAndLinks - else - if website = WebsiteRoots[ESMANGAHERE_ID, 0] then - Result := EsMangaHereGetNamesAndLinks - else - if website = WebsiteRoots[ANIMEEXTREMIST_ID, 0] then - Result := AnimeExtremistGetNamesAndLinks - else - if website = WebsiteRoots[KOMIKID_ID, 0] then - Result := KomikidGetNamesAndLinks - else - if website = WebsiteRoots[PECINTAKOMIK_ID, 0] then - Result := PecintaKomikGetNamesAndLinks - else - if website = WebsiteRoots[MABUNS_ID, 0] then - Result := MabunsGetNamesAndLinks - else - if website = WebsiteRoots[MANGAESTA_ID, 0] then - Result := MangaEstaGetNamesAndLinks - else - if website = WebsiteRoots[PURURIN_ID, 0] then - Result := PururinGetNamesAndLinks - else - if website = WebsiteRoots[HUGEMANGA_ID, 0] then - Result := HugeMangaGetNamesAndLinks - else - if website = WebsiteRoots[ANIMESTORY_ID, 0] then - Result := AnimeStoryGetNamesAndLinks - else - if website = WebsiteRoots[LECTUREENLIGNE_ID, 0] then - Result := LectureEnLigneGetNamesAndLinks - else - if website = WebsiteRoots[SCANMANGA_ID, 0] then - Result := ScanMangaGetNamesAndLinks - else - if website = WebsiteRoots[MANGAAR_ID, 0] then - Result := MangaArGetNamesAndLinks - else - if website = WebsiteRoots[MANGAAE_ID, 0] then - Result := MangaAeGetNamesAndLinks - else - if website = WebsiteRoots[CENTRALDEMANGAS_ID, 0] then - Result := CentralDeMangasGetNamesAndLinks - else - if website = WebsiteRoots[IMANHUA_ID, 0] then - Result := imanhuaGetNamesAndLinks - else - if website = WebsiteRoots[TURKCRAFT_ID, 0] then - Result := TurkcraftGetNamesAndLinks - else - if website = WebsiteRoots[MANGAVADISI_ID, 0] then - Result := MangaVadisiGetNamesAndLinks - else - if website = WebsiteRoots[MANGAFRAME_ID, 0] then - Result := MangaFrameNamesAndLinks - else - if website = WebsiteRoots[MANGACOW_ID, 0] then - Result := MangaCowGetNamesAndLinks - else - if website = WebsiteRoots[SENMANGA_ID, 0] then - Result := SenMangaGetNamesAndLinks - else - if website = WebsiteRoots[KIVMANGA_ID, 0] then - Result := KivmangaGetNamesAndLinks - else - if website = WebsiteRoots[MANGACAN_ID, 0] then - Result := MangacanGetNamesAndLinks - else - if website = WebsiteRoots[MANGASPROJECT_ID, 0] then - Result := MangasPROJECTGetNamesAndLinks - else - if website = WebsiteRoots[MANGAREADER_POR_ID, 0] then - Result := MangaREADER_PORGetNamesAndLinks - else - if website = WebsiteRoots[MANGA2U_ID, 0] then - Result := Manga2uGetNamesAndLinks - else - if website = WebsiteRoots[EHENTAI_ID, 0] then - Result := EHentaiGetNamesAndLinks - else - if website = WebsiteRoots[MANGASTREAMTO_ID, 0] then - Result := MangaStreamToGetNamesAndLinks - else - if (website = WebsiteRoots[NINEMANGA_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_ES_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_CN_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_RU_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_DE_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_IT_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_BR_ID, 0]) then - Result := NineMangaGetNamesAndLinks - else - if website = WebsiteRoots[JAPANSHIN_ID, 0] then - Result := JapanShinGetNamesAndLinks - else - if website = WebsiteRoots[JAPSCAN_ID, 0] then - Result := JapscanNamesAndLinks - else - if website = WebsiteRoots[CENTRUMMANGI_PL_ID, 0] then - Result := CentrumMangi_PLGetNamesAndLinks - else - if website = WebsiteRoots[MANGALIB_PL_ID, 0] then - Result := MangaLib_PLGetNamesAndLinks - else - if website = WebsiteRoots[ONEMANGA_ID, 0] then - Result := OneMangaGetNamesAndLinks - else - if website = WebsiteRoots[MANGATOWN_ID, 0] then - Result := MangaTownGetNamesAndLinks - else - if website = WebsiteRoots[READHENTAIMANGA_ID, 0] then - Result := ReadHentaiMangaGetNamesAndLinks - else - if website = WebsiteRoots[MANGAOKU_ID, 0] then - Result := MangaOkuGetNamesAndLinks - else - if website = WebsiteRoots[MYREADINGMANGAINFO_ID, 0] then - Result := MyReadingMangaInfoNamesAndLinks - else - if website = WebsiteRoots[IKOMIK_ID, 0] then - Result := IKomikNamesAndLinks - else - if website = WebsiteRoots[NHENTAI_ID, 0] then - Result := NHentaiNamesAndLinks - else - if website = WebsiteRoots[UNIONMANGAS_ID, 0] then - Result := UnionMangasNamesAndLinks - else - if website = WebsiteRoots[MANGAMINT_ID, 0] then - Result := MangaMintGetNamesAndLinks - else - if website = WebsiteRoots[UNIXMANGA_ID, 0] then - Result := UnixMangaNamesAndLinks - else - if website = WebsiteRoots[HAKIHOME_ID, 0] then - Result := HakiHomeNamesAndLinks - else - if website = WebsiteRoots[EXTREMEMANGAS_ID, 0] then - Result := ExtremeMangasNamesAndLinks - else - if website = WebsiteRoots[MANGAHOST_ID, 0] then - Result := MangaHostGetNamesAndLinks - else - if (website = WebsiteRoots[PORNCOMIX_ID, 0]) or - (website = WebsiteRoots[XXCOMICS_ID, 0]) or - (website = WebsiteRoots[XXCOMICSMT_ID, 0]) or - (website = WebsiteRoots[XXCOMICS3D_ID, 0]) or - (website = WebsiteRoots[PORNCOMIXRE_ID, 0]) or - (website = WebsiteRoots[PORNCOMIXIC_ID, 0]) or - (website = WebsiteRoots[PORNXXXCOMICS_ID, 0]) then - Result := PornComixGetNamesAndLinks(GetMangaSiteID(website)) - else - if website = WebsiteRoots[MANGASEE_ID, 0] then - Result := MangaSeeGetNamesAndLinks - else - if website = WebsiteRoots[MANGAKU_ID, 0] then - Result := MangaKuGetNamesAndLinks - else - if website = WebsiteRoots[ACADEMYVN_ID, 0] then - Result := AcademyVNGetNamesAndLinks - else - if website = WebsiteRoots[MANGAAT_ID, 0] then - Result := MangaAtGetNamesAndLinks - else - if website = WebsiteRoots[SENMANGARAW_ID, 0] then - Result := SenMangaRAWGetNamesAndLinks - else - if website = WebsiteRoots[READMANGATODAY_ID, 0] then - Result := ReadMangaTodayGetNamesAndLinks - else - if website = WebsiteRoots[LONEMANGA_ID, 0] then - Result := LoneMangaGetNamesAndLinks - else - if website = WebsiteRoots[DYNASTYSCANS_ID, 0] then - Result := DynastyScansGetNamesAndLinks - else - if website = WebsiteRoots[MADOKAMI_ID, 0] then - Result := MadokamiGetNamesAndLinks - else - if SitesIsWPManga(WebsiteID) then - Result := GetWPMangaNamesAndLinks - else - begin - Result := INFORMATION_NOT_FOUND; - Source.Free; - end; - - //remove host from url - if links.Count > 0 then - RemoveHostFromURLsPair(links, names); -end; - -function TMangaInformation.GetInfoFromURL(const website, URL: String; - const Reconnect: Cardinal): Byte; -var - s: String; - j, k: Integer; - del: Boolean; - rex: TRegExpr; - Source: TStringList; - Parser: THTMLParser; - WebsiteID: Cardinal; - - {$I includes/AnimeA/manga_information.inc} - - {$I includes/MangaHere/manga_information.inc} - - // due to its weird designs, this will take a lot of work (and time) for it to - // work property - - {$I includes/SubManga/manga_information.inc} - - {$I includes/EsMangaHere/manga_information.inc} - - {$I includes/AnimExtremist/manga_information.inc} - - {$I includes/MangaInn/manga_information.inc} - - {$I includes/KissManga/manga_information.inc} - - {$I includes/Batoto/manga_information.inc} - - {$I includes/Manga24h/manga_information.inc} - - {$I includes/VnSharing/manga_information.inc} - - {$I includes/Hentai2Read/manga_information.inc} - - {$I includes/Fakku/manga_information.inc} - - {$I includes/MangaReader/manga_information.inc} - - {$I includes/MangaPark/manga_information.inc} - - {$I includes/MangaFox/manga_information.inc} - - {$I includes/MangaTraders/manga_information.inc} - - {$I includes/MangaStream/manga_information.inc} - - {$I includes/MangaEden/manga_information.inc} - - {$I includes/Starkana/manga_information.inc} - - {$I includes/EatManga/manga_information.inc} - - {$I includes/RedHawkScans/manga_information.inc} - - {$I includes/S2Scans/manga_information.inc} - - {$I includes/EGScans/manga_information.inc} - - {$I includes/MangaPanda/manga_information.inc} - - {$I includes/MangaGo/manga_information.inc} - - {$I includes/TruyenTranhTuan/manga_information.inc} - - {$I includes/Komikid/manga_information.inc} - - // this site have 2 kind of cover page - - {$I includes/PecintaKomik/manga_information.inc} - - {$I includes/Mabuns/manga_information.inc} - - {$I includes/MangaEsta/manga_information.inc} - - {$I includes/Pururin/manga_information.inc} - - {$I includes/HugeManga/manga_information.inc} - - {$I includes/AnimeStory/manga_information.inc} - - {$I includes/LectureEnLigne/manga_information.inc} - - {$I includes/ScanManga/manga_information.inc} - - {$I includes/Turkcraft/manga_information.inc} - - {$I includes/MangaVadisi/manga_information.inc} - - {$I includes/MangaFrame/manga_information.inc} - - {$I includes/MangaAr/manga_information.inc} - - {$I includes/MangaAe/manga_information.inc} - - {$I includes/CentralDeMangas/manga_information.inc} - - {$I includes/Mangacow/manga_information.inc} - - {$I includes/SenManga/manga_information.inc} - - {$I includes/BlogTruyen/manga_information.inc} - - {$I includes/MeinManga/manga_information.inc} - - {$I includes/Manga2u/manga_information.inc} - - {$I includes/KivManga/manga_information.inc} - - {$I includes/Mangacan/manga_information.inc} - - {$I includes/MangasPROJECT/manga_information.inc} - - {$I includes/MangaREADER_POR/manga_information.inc} - - {$I includes/EHentai/manga_information.inc} - - {$I includes/MangaStreamTo/manga_information.inc} - - {$I includes/NineManga/manga_information.inc} - - {$I includes/JapanShin/manga_information.inc} - - {$I includes/Japscan/manga_information.inc} - - {$I includes/CentrumMangi_PL/manga_information.inc} - - {$I includes/MangaLib_PL/manga_information.inc} - - {$I includes/OneManga/manga_information.inc} - - {$I includes/MangaTown/manga_information.inc} - - {$I includes/ReadHentaiManga/manga_information.inc} - - {$I includes/MangaOku/manga_information.inc} - - {$I includes/MyReadingMangaInfo/manga_information.inc} - - {$I includes/IKomik/manga_information.inc} - - {$I includes/NHentai/manga_information.inc} - - {$I includes/UnionMangas/manga_information.inc} - - {$I includes/MangaMint/manga_information.inc} - - {$I includes/UnixManga/manga_information.inc} - - {$I includes/HakiHome/manga_information.inc} - - {$I includes/ExtremeMangas/manga_information.inc} - - {$I includes/MangaHost/manga_information.inc} - - {$I includes/PornComix/manga_information.inc} - - {$I includes/MangaSee/manga_information.inc} - - {$I includes/MangaKu/manga_information.inc} - - {$I includes/AcademyVN/manga_information.inc} - - {$I includes/MangaAt/manga_information.inc} - - {$I includes/SenMangaRAW/manga_information.inc} - - {$I includes/ReadMangaToday/manga_information.inc} - - {$I includes/LoneManga/manga_information.inc} - - {$I includes/Dynasty-Scans/manga_information.inc} - - {$I includes/Madokami/manga_information.inc} - - {$I includes/WPManga/manga_information.inc} - -begin - if Trim(URL) = '' then Exit(INFORMATION_NOT_FOUND); - WebsiteID := GetMangaSiteID(website); - if WebsiteID > High(WebsiteRoots) then Exit(INFORMATION_NOT_FOUND); - - //load User-Agent from INIAdvanced - if website <> '' then - FHTTP.UserAgent := INIAdvanced.ReadString('UserAgent', website, ''); - - Source := TStringList.Create; - mangaInfo.coverLink := ''; - mangaInfo.numChapter := 0; - mangaInfo.chapterName.Clear; - mangaInfo.chapterLinks.Clear; - - if website = WebsiteRoots[ANIMEA_ID, 0] then - Result := GetAnimeAInfoFromURL - else - if website = WebsiteRoots[MANGAHERE_ID, 0] then - Result := GetMangaHereInfoFromURL - else - if website = WebsiteRoots[MANGAINN_ID, 0] then - Result := GetMangaInnInfoFromURL - else - if website = WebsiteRoots[KISSMANGA_ID, 0] then - Result := GetKissMangaInfoFromURL - else - if website = WebsiteRoots[BATOTO_ID, 0] then - Result := GetBatotoInfoFromURL - else - if website = WebsiteRoots[MANGA24H_ID, 0] then - Result := GetManga24hInfoFromURL - else - if website = WebsiteRoots[VNSHARING_ID, 0] then - Result := GetVnSharingInfoFromURL - else - if website = WebsiteRoots[HENTAI2READ_ID, 0] then - Result := GetHentai2ReadInfoFromURL - else - if website = WebsiteRoots[FAKKU_ID, 0] then - Result := GetFakkuInfoFromURL - else - if website = WebsiteRoots[MANGAREADER_ID, 0] then - Result := GetMangaReaderInfoFromURL - else - if website = WebsiteRoots[MANGAPARK_ID, 0] then - Result := GetMangaParkInfoFromURL - else - if website = WebsiteRoots[MANGAFOX_ID, 0] then - Result := GetMangaFoxInfoFromURL - else - if website = WebsiteRoots[MANGATRADERS_ID, 0] then - Result := GetMangaTradersInfoFromURL - else - if website = WebsiteRoots[STARKANA_ID, 0] then - Result := GetStarkanaInfoFromURL - else - if website = WebsiteRoots[EATMANGA_ID, 0] then - Result := GetEatMangaInfoFromURL - else - if website = WebsiteRoots[MANGAPANDA_ID, 0] then - Result := GetMangaPandaInfoFromURL - else - if website = WebsiteRoots[MANGAGO_ID, 0] then - Result := GetMangaGoInfoFromURL - else - if website = WebsiteRoots[MANGASTREAM_ID, 0] then - Result := GetMangaStreamInfoFromURL - else - if website = WebsiteRoots[REDHAWKSCANS_ID, 0] then - Result := GetRedHawkScansInfoFromURL - else - if website = WebsiteRoots[S2SCAN_ID, 0] then - Result := GetS2scanInfoFromURL - else - if website = WebsiteRoots[EGSCANS_ID, 0] then - Result := GetEGScansInfoFromURL - else - if website = WebsiteRoots[TRUYENTRANHTUAN_ID, 0] then - Result := GetTruyenTranhTuanInfoFromURL - else - if website = WebsiteRoots[MANGAEDEN_ID, 0] then - Result := GetMangaEdenInfoFromURL(WebsiteRoots[MANGAEDEN_ID, 1]) - else - if website = WebsiteRoots[PERVEDEN_ID, 0] then - Result := GetMangaEdenInfoFromURL(WebsiteRoots[PERVEDEN_ID, 1]) - else - if website = WebsiteRoots[MEINMANGA_ID, 0] then - Result := GetMeinMangaInfoFromURL - else - if website = WebsiteRoots[MANGA2U_ID, 0] then - Result := GetManga2uInfoFromURL - else - if website = WebsiteRoots[SUBMANGA_ID, 0] then - Result := GetSubMangaInfoFromURL - else - if website = WebsiteRoots[ESMANGAHERE_ID, 0] then - Result := GetEsMangaHereInfoFromURL - else - if website = WebsiteRoots[ANIMEEXTREMIST_ID, 0] then - Result := GetAnimeExtremistInfoFromURL - else - if website = WebsiteRoots[KOMIKID_ID, 0] then - Result := GetKomikidInfoFromURL - else - if website = WebsiteRoots[PECINTAKOMIK_ID, 0] then - Result := GetPecintaKomikInfoFromURL - else - if website = WebsiteRoots[MABUNS_ID, 0] then - Result := GetMabunsInfoFromURL - else - if website = WebsiteRoots[MANGAESTA_ID, 0] then - Result := GetMangaEstaInfoFromURL - else - if website = WebsiteRoots[PURURIN_ID, 0] then - Result := GetPururinInfoFromURL - else - if website = WebsiteRoots[HUGEMANGA_ID, 0] then - Result := GetHugeMangaInfoFromURL - else - if website = WebsiteRoots[ANIMESTORY_ID, 0] then - Result := GetAnimeStoryInfoFromURL - else - if website = WebsiteRoots[LECTUREENLIGNE_ID, 0] then - Result := GetLectureEnLigneInfoFromURL - else - if website = WebsiteRoots[SCANMANGA_ID, 0] then - Result := GetScanMangaInfoFromURL - else - if website = WebsiteRoots[TURKCRAFT_ID, 0] then - Result := GetTurkcraftInfoFromURL - else - if website = WebsiteRoots[MANGAFRAME_ID, 0] then - Result := GetMangaframeInfoFromURL - else - if website = WebsiteRoots[MANGAVADISI_ID, 0] then - Result := GetMangaVadisiInfoFromURL - else - if website = WebsiteRoots[MANGAAR_ID, 0] then - Result := GetMangaArInfoFromURL - else - if website = WebsiteRoots[MANGAAE_ID, 0] then - Result := GetMangaAeInfoFromURL - else - if website = WebsiteRoots[CENTRALDEMANGAS_ID, 0] then - Result := GetCentralDeMangasInfoFromURL - else - if website = WebsiteRoots[MANGACOW_ID, 0] then - Result := GetMangaCowInfoFromURL - else - if website = WebsiteRoots[SENMANGA_ID, 0] then - Result := GetSenMangaInfoFromURL - else - if website = WebsiteRoots[BLOGTRUYEN_ID, 0] then - Result := GetBlogTruyenInfoFromURL - else - if website = WebsiteRoots[KIVMANGA_ID, 0] then - Result := GetKivmangaInfoFromURL - else - if website = WebsiteRoots[MANGACAN_ID, 0] then - Result := GetMangacanInfoFromURL - else - if website = WebsiteRoots[MANGASPROJECT_ID, 0] then - Result := GetMangasPROJECTInfoFromURL - else - if website = WebsiteRoots[MANGAREADER_POR_ID, 0] then - Result := GetMangaREADER_PORInfoFromURL - else - if website = WebsiteRoots[EHENTAI_ID, 0] then - Result := GetEHentaiInfoFromURL - else - if website = WebsiteRoots[MANGASTREAMTO_ID, 0] then - Result := GetMangaStreamToInfoFromURL - else - if (website = WebsiteRoots[NINEMANGA_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_ES_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_CN_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_RU_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_DE_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_IT_ID, 0]) or - (website = WebsiteRoots[NINEMANGA_BR_ID, 0]) then - Result := GetNineMangaInfoFromURL - else - if website = WebsiteRoots[JAPANSHIN_ID, 0] then - Result := GetJapanShinInfoFromURL - else - if website = WebsiteRoots[JAPSCAN_ID, 0] then - Result := GetJapscanInfoFromURL - else - if website = WebsiteRoots[CENTRUMMANGI_PL_ID, 0] then - Result := GetCentrumMangi_PLInfoFromURL - else - if website = WebsiteRoots[MANGALIB_PL_ID, 0] then - Result := GetMangaLib_PLInfoFromURL - else - if website = WebsiteRoots[ONEMANGA_ID, 0] then - Result := GetOneMangaInfoFromURL - else - if website = WebsiteRoots[MANGATOWN_ID, 0] then - Result := GetMangaTownInfoFromURL - else - if website = WebsiteRoots[READHENTAIMANGA_ID, 0] then - Result := GetReadHentaiMangaInfoFromURL - else - if website = WebsiteRoots[MANGAOKU_ID, 0] then - Result := GetMangaOkuInfoFromURL - else - if website = WebsiteRoots[MYREADINGMANGAINFO_ID, 0] then - Result := GetMyReadingMangaInfoInfoFromURL - else - if website = WebsiteRoots[IKOMIK_ID, 0] then - Result := GetIKomikInfoFromURL - else - if website = WebsiteRoots[NHENTAI_ID, 0] then - Result := GetNHentaiInfoFromURL - else - if website = WebsiteRoots[UNIONMANGAS_ID, 0] then - Result := GetUnionMangasInfoFromURL - else - if website = WebsiteRoots[MANGAMINT_ID, 0] then - Result := GetMangaMintInfoFromURL - else - if website = WebsiteRoots[UNIXMANGA_ID, 0] then - Result := GetUnixMangaInfoFromURL - else - if website = WebsiteRoots[HAKIHOME_ID, 0] then - Result := GetHakiHomeInfoFromURL - else - if website = WebsiteRoots[EXTREMEMANGAS_ID, 0] then - Result := GetExtremeMangasInfoFromURL - else - if website = GetMangaSiteName(MANGAHOST_ID) then - Result := GetMangaHostInfoFromURL - else - if (website = GetMangaSiteName(PORNCOMIX_ID)) or - (website = GetMangaSiteName(XXCOMICS_ID)) or - (website = GetMangaSiteName(XXCOMICSMT_ID)) or - (website = GetMangaSiteName(XXCOMICS3D_ID)) or - (website = GetMangaSiteName(PORNCOMIXRE_ID)) or - (website = GetMangaSiteName(PORNCOMIXIC_ID)) or - (website = GetMangaSiteName(PORNXXXCOMICS_ID)) then - Result := GetPornComixInfoFromURL(GetMangaSiteID(website)) - else - if website = GetMangaSiteName(MANGASEE_ID) then - Result := GetMangaSeeInfoFromURL - else - if website = GetMangaSiteName(MANGAKU_ID) then - Result := GetMangaKuInfoFromURL - else - if website = GetMangaSiteName(ACADEMYVN_ID) then - Result := GetAcademyVNInfoFromURL - else - if website = GetMangaSiteName(MANGAAT_ID) then - Result := GetMangaAtInfoFromURL - else - if website = GetMangaSiteName(SENMANGARAW_ID) then - Result := GetSenMangaRAWInfoFromURL - else - if website = GetMangaSiteName(READMANGATODAY_ID) then - Result := GetReadMangaTodayInfoFromURL - else - if website = GetMangaSiteName(LONEMANGA_ID) then - Result := GetLoneMangaInfoFromURL - else - if website = GetMangaSiteName(DYNASTYSCANS_ID) then - Result := GetDynastyScansInfoFromURL - else - if website = GetMangaSiteName(MADOKAMI_ID) then - Result := GetMadokamiInfoFromURL - else - if SitesIsWPManga(WebsiteID) then - Result := GetWPMangaInfoFromURL - else - begin - Source.Free; - Result := INFORMATION_NOT_FOUND; - Exit; - end; - - s := mangaInfo.artists; - if (s <> '') and (s[1] = '<') then - mangaInfo.artists := ''; - s := mangaInfo.authors; - if (s <> '') and (s[1] = '<') then - mangaInfo.authors := ''; - - // check everything once more - mangaInfo.title := Trim(RemoveStringBreaks(CommonStringFilter(mangaInfo.title))); - mangaInfo.authors := Trim(RemoveStringBreaks(Trim(mangaInfo.authors))); - mangaInfo.artists := Trim(RemoveStringBreaks(Trim(mangaInfo.artists))); - mangaInfo.genres := Trim(RemoveStringBreaks(Trim(mangaInfo.genres))); - mangaInfo.authors := TrimRightChar(Trim(mangaInfo.authors), [',']); - mangaInfo.artists := TrimRightChar(Trim(mangaInfo.artists), [',']); - mangaInfo.genres := TrimRightChar(Trim(mangaInfo.genres), [',']); - mangaInfo.summary := StringBreaks(mangaInfo.summary); - mangaInfo.summary := Trim(TrimChar(mangaInfo.summary, [#13, #10])); - mangaInfo.summary := BreaksString(mangaInfo.summary); - // strip double CR - mangaInfo.summary := Trim(StringReplace(mangaInfo.summary, '\n\r\n\r', '\n\r', [rfReplaceAll])); - mangaInfo.summary := Trim(StringReplace(mangaInfo.summary, '\r\n\r\n', '\r\n', [rfReplaceAll])); - - // fix info - rex := TRegExpr.Create; - try - rex.Expression := '^[\-\:]$'; - if rex.Exec(mangaInfo.authors) then - mangaInfo.authors := ''; - if rex.Exec(mangaInfo.artists) then - mangaInfo.artists := ''; - if rex.Exec(mangaInfo.summary) then - mangaInfo.summary := ''; - rex.Expression := '\<\/?\w\>'; - if rex.Exec(LowerCase(mangaInfo.summary)) then - mangaInfo.summary := ''; - finally - rex.Free; - end; - - // remove duplicate chapter - if mangaInfo.chapterLinks.Count > 0 then - begin - j := 0; - while j < (mangaInfo.chapterLinks.Count - 1) do - begin - del := False; - if (j + 1) < mangaInfo.chapterLinks.Count then - for k := j + 1 to mangaInfo.chapterLinks.Count - 1 do - begin - if SameText(mangaInfo.chapterLinks[j], mangaInfo.chapterLinks[k]) then - begin - mangaInfo.chapterLinks.Delete(j); - mangaInfo.chapterName.Delete(j); - del := True; - Break; - end; - end; - if not del then - Inc(j); - end; - end; - - if mangaInfo.chapterLinks.Count > 0 then - begin - // remove host from chapter links - RemoveHostFromURLsPair(mangaInfo.chapterLinks, mangaInfo.chapterName); - // fixing chapter name - for j := 0 to mangaInfo.chapterName.Count - 1 do - begin - mangaInfo.chapterName.Strings[j] := Trim(RemoveStringBreaks( - CommonStringFilter(mangaInfo.chapterName[j]))); - end; - end; - - mangaInfo.numChapter := mangaInfo.chapterLinks.Count; -end; - -procedure TMangaInformation.SyncMinorInfoToData(const DataProcess: TDataProcess; - const index: Cardinal); -begin - // sync info to data - {$IFDEF DOWNLOADER} - if not dataProcess.isFilterAllSites then - {$ENDIF} - begin - DataProcess.Data.Strings[index] := SetParams( - [DataProcess.Param[index, DATA_PARAM_NAME], - DataProcess.Param[index, DATA_PARAM_LINK], - DataProcess.Param[index, DATA_PARAM_AUTHORS], - DataProcess.Param[index, DATA_PARAM_ARTISTS], - DataProcess.Param[index, DATA_PARAM_GENRES], - mangaInfo.status, - DataProcess.Param[index, DATA_PARAM_SUMMARY], - IntToStr(mangaInfo.numChapter), - {$IFDEF DOWNLOADER} - DataProcess.Param[index, DATA_PARAM_JDN], - {$ELSE} - '0', - {$ENDIF} - '0']); - end; - // then break it into parts - dataProcess.BreakDataToParts(index); -end; - -procedure TMangaInformation.SyncInfoToData(const DataProcess: TDataProcess; - const index: Cardinal); -begin - // sync info to data - {$IFDEF DOWNLOADER} - if not dataProcess.isFilterAllSites then - {$ENDIF} + if Assigned(ADataProcess) then begin - if Trim(mangaInfo.title) = '' then - mangaInfo.title := DataProcess.Param[index, DATA_PARAM_NAME]; - DataProcess.Data.Strings[index] := SetParams( - //[DataProcess.Param[index, DATA_PARAM_NAME], - //sync title as well, some site possible to change title or when mangainfo script not work - [mangaInfo.title, - DataProcess.Param[index, DATA_PARAM_LINK], - mangaInfo.authors, - mangaInfo.artists, - mangaInfo.genres, - mangaInfo.status, - StringFilter(mangaInfo.summary), - IntToStr(mangaInfo.numChapter), - {$IFDEF DOWNLOADER} - DataProcess.Param[index, DATA_PARAM_JDN], - {$ELSE} - '0', - {$ENDIF} - '0']); + if (mangaInfo.title = '') and (ATitle <> '') then mangaInfo.title := ATitle; + if (mangaInfo.link = '') and (ALink <> '') then mangaInfo.link := ALink; + with mangaInfo do + ADataProcess.AddData(title, link, authors, artists, genres, status, + StringBreaks(summary), numChapter, Now); end; - // then break it into parts - dataProcess.BreakDataToParts(index); -end; - -procedure TMangaInformation.AddInfoToDataWithoutBreak(const Name, link: String; - const DataProcess: TDataProcess); -var - S: String; -begin - if mangaInfo.title <> '' then - S := mangaInfo.title - else - S := Name; - - DataProcess.Data.Add(RemoveStringBreaks(SetParams([ - S, - link, - mangaInfo.authors, - mangaInfo.artists, - mangaInfo.genres, - mangaInfo.status, - StringFilter(mangaInfo.summary), - IntToStr(mangaInfo.numChapter), - {$IFDEF DOWNLOADER} - IntToStr(GetCurrentJDN), - {$ELSE} - '0', - {$ENDIF} - '0' - ]))); -end; - -procedure TMangaInformation.AddInfoToData(const Name, link: String; - const DataProcess: TDataProcess); -var - l: TStringList; -begin - l := TStringList.Create; - DataProcess.Data.Add( - RemoveStringBreaks( - SetParams( - [Name, - link, - mangaInfo.authors, - mangaInfo.artists, - mangaInfo.genres, - mangaInfo.status, - StringFilter(mangaInfo.summary), - IntToStr(mangaInfo.numChapter), - IntToStr(GetCurrentJDN), - '0']))); - GetParams(l, DataProcess.Data.Strings[DataProcess.Data.Count - 1]); - DataProcess.title.Add(l.Strings[DATA_PARAM_NAME]); - DataProcess.link.Add(l.Strings[DATA_PARAM_LINK]); - DataProcess.authors.Add(l.Strings[DATA_PARAM_AUTHORS]); - DataProcess.artists.Add(l.Strings[DATA_PARAM_ARTISTS]); - DataProcess.genres.Add(l.Strings[DATA_PARAM_GENRES]); - DataProcess.status.Add(l.Strings[DATA_PARAM_STATUS]); - DataProcess.summary.Add(l.Strings[DATA_PARAM_SUMMARY]); - {$IFDEF DOWNLOADER} - DataProcess.jdn.Add(Pointer(StrToInt(l.Strings[DATA_PARAM_JDN]))); - {$ELSE} - DataProcess.jdn.Add(Pointer(StrToInt('0'))); - {$ENDIF} - l.Free; end; -function TMangaInformation.GetPage(var output: TObject; URL: String; - const Reconnect: Cardinal): Boolean; +function TMangaInformation.GetPage(var AOutput: TObject; AURL: String; const AReconnect: Integer): Boolean; begin - Result := uBaseUnit.GetPage(FHTTP, output, URL, Reconnect); + Result := uBaseUnit.GetPage(FHTTP, AOutput, AURL, AReconnect); end; end. diff --git a/baseunits/uDownloadsManager.pas b/baseunits/uDownloadsManager.pas index 68dd42648..6c8abdd10 100644 --- a/baseunits/uDownloadsManager.pas +++ b/baseunits/uDownloadsManager.pas @@ -6,108 +6,130 @@ unit uDownloadsManager; -{$mode delphi} +{$mode objfpc}{$H+} + +{$IF FPC_FULLVERSION >= 20701} + {$DEFINE FPC271} +{$ENDIF} interface uses - lazutf8classes, jsHTMLUtil, FastHTMLParser, HTMLUtil, SynaCode, FileUtil, - Controls, RegExpr, Imaging, ImagingTypes, ImagingCanvases, Classes, SysUtils, - Dialogs, ExtCtrls, IniFiles, typinfo, syncobjs, httpsend, blcksock, uBaseUnit, - uPacker, uFMDThread, uMisc, USimpleLogger, dateutils, frmShutdownCounter; + LazFileUtils, RegExpr, IniFiles, Classes, SysUtils, ExtCtrls, typinfo, fgl, + blcksock, MultiLog, uBaseUnit, uPacker, uMisc, DownloadedChaptersDB, FMDOptions, + httpsendthread, DownloadsDB, BaseThread, dateutils, strutils; type + TDownloadStatusType = ( + STATUS_STOP, + STATUS_WAIT, + STATUS_PREPARE, + STATUS_DOWNLOAD, + STATUS_FINISH, + STATUS_COMPRESS, + STATUS_PROBLEM, + STATUS_FAILED, + STATUS_NONE // devault value oncreate, don't use + ); + TDownloadStatusTypes = set of TDownloadStatusType; + TDownloadManager = class; TTaskContainer = class; TTaskThread = class; { TDownloadThread } - TDownloadThread = class(TFMDThread) - protected - parse: TStringList; - checkStyle: TFlagType; - workCounter: Cardinal; - FSortColumn: Cardinal; - FMessage, FAnotherURL: String; - FHTTP: THTTPSend; - - procedure MainThreadMessageDialog; - // Helper method allows to merge 2 images into 1 image. - // Final image format: png. (too big!) - procedure Merge2Images(const path, imgName1, imgName2, finalName: String); - // wait for changing directoet completed - procedure SetChangeDirectoryFalse; - procedure SetChangeDirectoryTrue; + TDownloadThread = class(TBaseThread) + private + FTask: TTaskThread; + procedure SetTask(AValue: TTaskThread); + public // Get download link from URL function GetLinkPageFromURL(const URL: String): Boolean; // Get number of download link from URL function GetPageNumberFromURL(const URL: String): Boolean; // Download image - function DownloadImage(const prefix: String = ''): Boolean; - - procedure OnTag(NoCaseTag, ActualTag: string); - procedure OnText(Text: String); + function DownloadImage: Boolean; procedure SockOnStatus(Sender: TObject; Reason: THookSocketReason; const Value: String); - procedure SockOnHeartBeat(Sender: TObject); function GetPage(var output: TObject; URL: String; - const Reconnect: Cardinal): Boolean; overload; - - function SaveImage(const mangaSiteID: Integer; URL: String; - const Path, Name, prefix: String; const Reconnect: Cardinal): Boolean; overload; + const Reconnect: Integer = 0): Boolean; inline; procedure Execute; override; - procedure DoTerminate; override; public - // ID of the site - manager: TTaskThread; + FHTTP: THTTPSendThread; + WorkId: Integer; constructor Create; destructor Destroy; override; - - property SortColumn: Cardinal read FSortColumn write FSortColumn; - property AnotherURL: String read FAnotherURL write FAnotherURL; - property GetworkCounter: Cardinal read workCounter; + property Task: TTaskThread read FTask write SetTask; end; + TDownloadThreads = specialize TFPGList<TDownloadThread>; + { TTaskThread } - TTaskThread = class(TFMDThread) + TTaskThread = class(TBaseThread) + private + FCS_THREADS: TRTLCriticalSection; + FCheckAndActiveTaskFlag: Boolean; + FCurrentWorkingDir: String; + {$IFDEF Windows} + FCurrentMaxFileNameLength: Integer; + {$ENDIF} + FCurrentCustomFileName: String; + FIsForDelete: Boolean; + procedure SetCurrentWorkingDir(AValue: String); + procedure SetIsForDelete(AValue: Boolean); + procedure SyncShowBallonHint; protected - FMessage, FAnotherURL: String; procedure CheckOut; - procedure MainThreadCompressRepaint; - procedure MainThreadMessageDialog; procedure Execute; override; - procedure DoTerminate; override; - procedure Compress; + function Compress: Boolean; + procedure SyncStop; + procedure StatusFailedToCreateDir; + function FirstFailedChapters: Integer; + function FailedChaptersExist: Boolean; // show notification when download completed - procedure ShowBaloon; - procedure Stop(const check: Boolean = True); + procedure ShowBalloonHint; + // general exception info + function GetExceptionInfo: String; public //additional parameter httpCookies: String; Flag: TFlagType; // container (for storing information) - container: TTaskContainer; + Container: TTaskContainer; // download threads - threads: TFPList; - CS_threads: TCriticalSection; + Threads: TDownloadThreads; constructor Create; destructor Destroy; override; - property AnotherURL: String read FAnotherURL write FAnotherURL; + function GetFileName(const AWorkId: Integer): String; + property CurrentWorkingDir: String read FCurrentWorkingDir write SetCurrentWorkingDir; + property CurrentMaxFileNameLength: Integer read FCurrentMaxFileNameLength; + // current custom filename with only %FILENAME% left intact + property CurrentCustomFileName: String read FCurrentCustomFileName write FCurrentCustomFileName; + property IsForDelete: Boolean read FIsForDelete write SetIsForDelete; end; { TTaskContainer } TTaskContainer = class private - FReadCount: Integer; - CS_FReadCount: TCriticalSection; + FWebsite: String; + FStatus: TDownloadStatusType; + FEnabled: Boolean; + procedure SetEnabled(AValue: Boolean); + procedure SetStatus(AValue: TDownloadStatusType); + procedure SetWebsite(AValue: String); public + DlId: Integer; + // critical section + CS_Container: TRTLCriticalSection; + // read count for transfer rate + ReadCount: Integer; // task thread of this container - Thread: TTaskThread; + Task: TTaskThread; // download manager Manager: TDownloadManager; DownloadInfo: TDownloadInfo; @@ -118,47 +140,65 @@ TTaskContainer = class WorkCounter, DownCounter, PageNumber: Integer; - MangaSiteID: Cardinal; - Status: TDownloadStatusType; + ModuleId: Integer; + //Status: TDownloadStatusType; ThreadState: Boolean; ChapterName, ChapterLinks, - FailedChapterName, - FailedChapterLinks, + ChaptersStatus, PageContainerLinks, PageLinks: TStringList; - procedure IncReadCount(const ACount: Integer); + FileNames: TStringList; + // custom filename + CustomFileName: String; constructor Create; destructor Destroy; override; + procedure IncReadCount(const ACount: Integer); + procedure SaveToDB(const AOrder: Integer = -1); + public + Visible: Boolean; + property Website: String read FWebsite write SetWebsite; + property Status: TDownloadStatusType read FStatus write SetStatus; + property Enabled: Boolean read FEnabled write SetEnabled; end; + TTaskContainers = specialize TFPGList<TTaskContainer>; + { TDownloadManager } TDownloadManager = class private - FTotalReadCount: Integer; FSortDirection: Boolean; FSortColumn: Integer; - DownloadManagerFile: TIniFile; - FisDlgCounter: Boolean; + FDownloadsDB: TDownloadsDB; + procedure AddItemsActiveTask(const Item: TTaskContainer); + procedure RemoveItemsActiveTask(const Item: TTaskContainer); + function GetTask(const TaskId: Integer): TTaskContainer; + function ConvertToDB: Boolean; protected - function GetTaskCount: Integer; + function GetTaskCount: Integer; inline; function GetTransferRate: Integer; + procedure ChangeStatusCount(const OldStatus, NewStatus: TDownloadStatusType); + procedure DecStatusCount(const Status: TDownloadStatusType); + procedure IncStatusCount(const Status: TDownloadStatusType); public - CS_DownloadManager_Task: TCriticalSection; - CS_DownloadedChapterList: TCriticalSection; - Containers: TFPList; + CS_Task, + CS_ItemsActiveTask: TRTLCriticalSection; + Items, + ItemsActiveTask: TTaskContainers; isRunningBackup, isFinishTaskAccessed, isRunningBackupDownloadedChaptersList, isReadyForExit: Boolean; - compress, retryConnect, - // max. active tasks - maxDLTasks, - // max. download threads per task - maxDLThreadsPerTask: Integer; - // current chapterLinks which thread is processing + // status count + CS_StatusCount: TRTLCriticalSection; + StatusCount: array [TDownloadStatusType] of Integer; + // disabled count + DisabledCount, + CompressType, + RetryConnect: Integer; - DownloadedChaptersListFile: TStringList; + //downloaded chapter list database + DownloadedChapters: TDownloadedChaptersDB; //exit counter ExitWaitOK: Boolean; @@ -166,36 +206,26 @@ TDownloadManager = class constructor Create; destructor Destroy; override; - function TaskItem(const Index: Integer): TTaskContainer; property Count: Integer read GetTaskCount; - procedure BackupDownloadedChaptersList; - procedure Restore; procedure Backup; - // TransferRate - procedure ClearTransferRate; - // These methods relate to highlight downloaded chapters. - procedure AddToDownloadedChaptersList(const ALink, AValue: String); overload; - procedure AddToDownloadedChaptersList(const Alink: String; AValue: TStrings); overload; procedure GetDownloadedChaptersState(const Alink: String; var Chapters: array of TChapterStateItem); // Add new task to the list. - function AddTask:Integer; + function AddTask: Integer; // Check and active previous work-in-progress tasks. procedure CheckAndActiveTaskAtStartup; // Check and active waiting tasks. - procedure CheckAndActiveTask(const isCheckForFMDDo: Boolean = False; - SenderThread: TThread = nil); - // Check if we can active another wating task or not. - function CanActiveTask(const pos : Integer) : Boolean; + procedure CheckAndActiveTask(const isCheckForFMDDo: Boolean = False); // Active a stopped task. - procedure ActiveTask(const taskID : Integer); + procedure SetTaskActive(const taskID: Integer); + procedure ActiveTask(const taskID: Integer); // Stop a download/wait task. - procedure StopTask(const taskID : Integer; const isCheckForActive : Boolean = + procedure StopTask(const taskID: Integer; const isCheckForActive: Boolean = True; isWaitFor: Boolean = False); // Start all task procedure StartAllTasks; @@ -203,14 +233,17 @@ TDownloadManager = class procedure StopAllTasks; // Stop all download task inside a task before terminate the program. procedure StopAllDownloadTasksForExit; + // Free then delete task without any check, use with caution + procedure FreeAndDelete(const TaskId: Integer); // Remove a task from list. - procedure RemoveTask(const taskID : Integer); + procedure RemoveTask(const TaskID: Integer); // Remove all finished tasks. procedure RemoveAllFinishedTasks; - // show exit counter - procedure doExitWaitCounter; // check status of task function TaskStatusPresent(Stats: TDownloadStatusTypes): Boolean; + // enable task + procedure EnableTask(const TaskId: Integer); + procedure DisableTask(const TaskId: Integer); // Sort procedure Sort(const AColumn: Integer); @@ -218,11 +251,11 @@ TDownloadManager = class property SortDirection: Boolean read FSortDirection write FSortDirection; property SortColumn: Integer read FSortColumn write FSortColumn; property TransferRate: Integer read GetTransferRate; - property isDlgCounter: Boolean read FisDlgCounter; + property Task[const TaskId: Integer]: TTaskContainer read GetTask; default; end; resourcestring - RS_FailedToCreateDirTooLong = 'Failed to create dir! Too long?'; + RS_FailedToCreateDir = 'Failed to create directory!'; RS_FailedTryResumeTask = 'Failed, try resuming this task!'; RS_Preparing = 'Preparing'; RS_Downloading = 'Downloading'; @@ -231,29 +264,34 @@ TDownloadManager = class RS_Waiting = 'Waiting...'; RS_Compressing = 'Compressing...'; RS_Failed = 'Failed'; + RS_Disabled = 'Disabled'; implementation uses - frmMain; + frmMain, WebsiteModules, FMDVars, SimpleException; -{ TDownloadThread } - -procedure TDownloadThread.OnTag(NoCaseTag, ActualTag : string); +function IntToStr(Value: Cardinal): String; begin - parse.Add(ActualTag); + Result := SysUtils.IntToStr(QWord(Value)); end; -procedure TDownloadThread.OnText(Text: String); +{ TDownloadThread } + +procedure TDownloadThread.SetTask(AValue: TTaskThread); begin - parse.Add(Text); + if FTask = AValue then Exit; + FTask := AValue; + with FTask.Container do + if ModuleId<>-1 then + WebsiteModules.Modules[ModuleId].PrepareHTTP(FHTTP); end; procedure TDownloadThread.SockOnStatus(Sender: TObject; Reason: THookSocketReason; const Value: String); begin if Reason = HR_ReadCount then - manager.container.IncReadCount(StrToIntDef(Value, 0)); + Task.Container.IncReadCount(StrToIntDef(Value, 0)); end; constructor TDownloadThread.Create; @@ -261,67 +299,58 @@ constructor TDownloadThread.Create; inherited Create(True); FHTTP := THTTPSendThread.Create(Self); FHTTP.Headers.NameValueSeparator := ':'; - FHTTP.Sock.OnStatus := SockOnStatus; + FHTTP.Sock.OnStatus := @SockOnStatus; end; destructor TDownloadThread.Destroy; begin + EnterCriticalsection(Task.FCS_THREADS); + try + Modules.DecActiveConnectionCount(Task.Container.ModuleId); + Task.Threads.Remove(Self); + finally + LeaveCriticalsection(Task.FCS_THREADS); + end; FHTTP.Free; inherited Destroy; end; -procedure TDownloadThread.SockOnHeartBeat(Sender: TObject); -begin - if Terminated then - begin - TBlockSocket(Sender).Tag := 1; - TBlockSocket(Sender).StopFlag := True; - TBlockSocket(Sender).AbortSocket; - end; -end; - function TDownloadThread.GetPage(var output: TObject; URL: String; - const Reconnect: Cardinal): Boolean; + const Reconnect: Integer): Boolean; begin if FHTTP.Sock.Tag <> 100 then FHTTP.Clear; Result := uBaseUnit.GetPage(FHTTP, output, URL, Reconnect); end; -function TDownloadThread.SaveImage(const mangaSiteID: Integer; URL: String; - const Path, Name, prefix: String; const Reconnect: Cardinal): Boolean; -begin - Result := uBaseUnit.SaveImage(FHTTP, mangaSiteID, URL, Path, Name, prefix, Reconnect); -end; - procedure TDownloadThread.Execute; var Reslt: Boolean = False; begin try - case checkStyle of + case Task.Flag of // Get number of images. CS_GETPAGENUMBER: begin Reslt := GetPageNumberFromURL( - manager.container.ChapterLinks.Strings[ - manager.container.CurrentDownloadChapterPtr]); + Task.Container.ChapterLinks.Strings[ + Task.Container.CurrentDownloadChapterPtr]); // Prepare 'space' for storing image url. if (not Terminated) and - (manager.container.PageNumber > 0) then + (Task.Container.PageNumber > 0) then begin - while manager.container.PageLinks.Count < manager.container.PageNumber do - manager.container.PageLinks.Add('W'); + while Task.Container.PageLinks.Count < Task.Container.PageNumber do + Task.Container.PageLinks.Add('W'); end else - Reslt := False + Reslt := False; end; // Get image urls. CS_GETPAGELINK: begin Reslt := GetLinkPageFromURL( - manager.container.ChapterLinks.Strings[ - manager.container.CurrentDownloadChapterPtr]); + Task.Container.ChapterLinks.Strings[ + Task.Container.CurrentDownloadChapterPtr]); end; // Download images. CS_DOWNLOAD: @@ -332,1224 +361,643 @@ procedure TDownloadThread.Execute; if not Terminated and Reslt then begin - manager.container.DownCounter := InterLockedIncrement(manager.container.DownCounter); - manager.container.DownloadInfo.Progress := - Format('%d/%d', [manager.container.DownCounter, manager.container.PageNumber]); + EnterCriticalSection(Task.Container.CS_Container); + try + Task.Container.DownCounter := InterLockedIncrement(Task.Container.DownCounter); + Task.Container.DownloadInfo.Progress := + Format('%d/%d', [Task.Container.DownCounter, Task.Container.PageNumber]); + finally + LeaveCriticalSection(Task.Container.CS_Container); + end; end; except on E: Exception do begin - E.Message := E.Message + LineEnding + - ' In TDownloadThread.Execute : ' + GetEnumName(TypeInfo(TFlagType), integer(checkStyle)) + LineEnding + - ' Website : ' + manager.container.DownloadInfo.Website + LineEnding + - ' URL : ' + FillMangaSiteHost(manager.container.MangaSiteID, - manager.container.ChapterLinks[manager.container.CurrentDownloadChapterPtr]) + LineEnding + - ' Title : ' + manager.container.DownloadInfo.title + LineEnding + - ' Chapter : ' + manager.container.ChapterName[manager.container.CurrentDownloadChapterPtr] + LineEnding; + E.Message := E.Message + LineEnding + ' In TDownloadThread.Execute' + LineEnding + Task.GetExceptionInfo; MainForm.ExceptionHandler(Self, E); end; end; end; -procedure TDownloadThread.DoTerminate; -begin - manager.CS_threads.Acquire; - try - manager.threads.Remove(Self); - finally - manager.CS_threads.Release; - end; - inherited DoTerminate; -end; - function TDownloadThread.GetPageNumberFromURL(const URL: String): Boolean; -var - Parser: THTMLParser; - - {$I includes/AnimeStory/chapter_page_number.inc} - - {$I includes/AnimExtremist/chapter_page_number.inc} - - {$I includes/Batoto/chapter_page_number.inc} - - {$I includes/EatManga/chapter_page_number.inc} +begin + Result := False; + Task.Container.PageNumber := 0; - {$I includes/EGScans/chapter_page_number.inc} + if Modules.ModuleAvailable(Task.Container.ModuleId, MMGetPageNumber) then + Result := Modules.GetPageNumber(Self, URL, Task.Container.ModuleId); + if Task.Container.PageLinks.Count > 0 then + TrimStrings(Task.Container.PageLinks); +end; - {$I includes/EHentai/chapter_page_number.inc} +function TDownloadThread.GetLinkPageFromURL(const URL: String): Boolean; +begin + Result := False; + if Task.Container.PageLinks[WorkId] <> 'W' then Exit; + if Modules.ModuleAvailable(Task.Container.ModuleId, MMGetImageURL) then + Result := Modules.GetImageURL(Self, URL, Task.Container.ModuleId); +end; - {$I includes/EsMangaHere/chapter_page_number.inc} +// ----- TTaskThread ----- - {$I includes/Hentai2Read/chapter_page_number.inc} +constructor TTaskThread.Create; +begin + inherited Create(True); + InitCriticalSection(FCS_THREADS); + Threads := TDownloadThreads.Create; + FCheckAndActiveTaskFlag := True; + FIsForDelete := False; + httpCookies := ''; + FCurrentWorkingDir := ''; + FCurrentCustomFileName := ''; + {$IFDEF WINDOWS} + FCurrentMaxFileNameLength := 0; + {$ENDIF} +end; - {$I includes/HugeManga/chapter_page_number.inc} +destructor TTaskThread.Destroy; +var + i: Integer; +begin + EnterCriticalsection(FCS_THREADS); + try + if Threads.Count > 0 then + for i := 0 to Threads.Count - 1 do + Threads[i].Terminate; + finally + LeaveCriticalsection(FCS_THREADS); + end; + while Threads.Count > 0 do + Sleep(32); - {$I includes/KissManga/chapter_page_number.inc} + Modules.DecActiveTaskCount(Container.ModuleId); + with Container do + begin + ThreadState := False; + Manager.RemoveItemsActiveTask(Container); + Task := nil; + if not (IsForDelete or Manager.isReadyForExit) then + begin + Container.ReadCount := 0; + DownloadInfo.TransferRate := ''; + if Status <> STATUS_STOP then + begin + if (WorkCounter >= PageLinks.Count) and + (CurrentDownloadChapterPtr >= ChapterLinks.Count) and + (not FailedChaptersExist) then + begin + Status := STATUS_FINISH; + DownloadInfo.Status := Format('[%d/%d] %s',[Container.ChapterLinks.Count,Container.ChapterLinks.Count,RS_Finish]); + DownloadInfo.Progress := ''; + end + else + if not (Status in [STATUS_FAILED, STATUS_PROBLEM]) then + begin + Status := STATUS_STOP; + DownloadInfo.Status := + Format('[%d/%d] %s', [CurrentDownloadChapterPtr + 1, + ChapterLinks.Count, RS_Stopped]); + FCheckAndActiveTaskFlag := False; + end; + if not isExiting then + Synchronize(@SyncStop); + end; + end; + end; + Threads.Free; + DoneCriticalsection(FCS_THREADS); + inherited Destroy; +end; - {$I includes/Kivmanga/chapter_page_number.inc} +function TTaskThread.GetFileName(const AWorkId: Integer): String; +{$IFDEF WINDOWS} +var + s: UnicodeString; +{$ENDIF} +begin + Result := ''; + if (Container.FileNames.Count = Container.PageLinks.Count) and + (AWorkId < Container.FileNames.Count) then + Result := Container.FileNames[AWorkId]; + if Result = '' then + Result := Format('%.3d', [AWorkId + 1]); + Result := StringReplace(CurrentCustomFileName, CR_FILENAME, Result, [rfReplaceAll]); + {$IFDEF WINDOWS} + s := UTF8Decode(Result); + if Length(s) > FCurrentMaxFileNameLength then + begin + Delete(s, 1, Length(s) - FCurrentMaxFileNameLength); + Result := UTF8Encode(s); + end; + {$ENDIF} +end; - {$I includes/Komikid/chapter_page_number.inc} +function TTaskThread.Compress: Boolean; +var + uPacker: TPacker; + i: Integer; + s: String; +begin + Result := True; + if (Container.Manager.CompressType >= 1) then + begin + Container.DownloadInfo.Status := + Format('[%d/%d] %s', [Container.CurrentDownloadChapterPtr + 1, + Container.ChapterLinks.Count, RS_Compressing]); + uPacker := TPacker.Create; + try + case Container.Manager.CompressType of + 1: uPacker.Format := pfZIP; + 2: uPacker.Format := pfCBZ; + 3: uPacker.Format := pfPDF; + 4: uPacker.Format := pfEPUB; + end; + uPacker.CompressionQuality := OptionPDFQuality; + uPacker.Path := CurrentWorkingDir; + uPacker.FileName := RemovePathDelim(CorrectPathSys(CorrectPathSys(Container.DownloadInfo.SaveTo) + + Container.ChapterName[Container.CurrentDownloadChapterPtr])); + for i := 0 to Container.PageLinks.Count - 1 do + begin + s := FindImageFile(uPacker.Path + GetFileName(i)); + if s <> '' then + uPacker.FileList.Add(s); + end; + Result := uPacker.Execute; + if not Result then + Logger.SendWarning(Self.ClassName+', failed to compress. '+uPacker.SavedFileName); + except + on E: Exception do + begin + E.Message := E.Message + LineEnding + ' In TTaskThread.Compress' + LineEnding + GetExceptionInfo; + MainForm.ExceptionHandler(Self, E); + end; + end; + uPacker.Free; + end; +end; - {$I includes/Manga2u/chapter_page_number.inc} +procedure TTaskThread.SyncStop; +begin + Container.Manager.CheckAndActiveTask(FCheckAndActiveTaskFlag); +end; - {$I includes/MangaAe/chapter_page_number.inc} +procedure TTaskThread.StatusFailedToCreateDir; +begin + Logger.SendError(Format('Failed to create dir(%d) = %s', [Length(CurrentWorkingDir), CurrentWorkingDir])); + Container.Status := STATUS_FAILED; + Container.DownloadInfo.Status := Format('[%d/%d] %s (%d) %s', [ + Container.CurrentDownloadChapterPtr, + Container.ChapterLinks.Count, + RS_FailedToCreateDir, Length(CurrentWorkingDir), LineEnding + CurrentWorkingDir]); +end; - {$I includes/MangaAr/chapter_page_number.inc} +function TTaskThread.FirstFailedChapters: Integer; +var + i: Integer; +begin + for i := 0 to Container.ChaptersStatus.Count - 1 do + if Container.ChaptersStatus[i] = 'F' then Exit(i); + Result := -1; +end; - {$I includes/Mangacow/chapter_page_number.inc} +function TTaskThread.FailedChaptersExist: Boolean; +begin + Result := FirstFailedChapters <> -1; +end; - {$I includes/MangaEden/chapter_page_number.inc} +procedure TTaskThread.ShowBalloonHint; +begin + if OptionShowBalloonHint then + Synchronize(@SyncShowBallonHint); +end; - {$I includes/MangaFox/chapter_page_number.inc} +function TTaskThread.GetExceptionInfo: String; +begin + Result := + ' Flag : ' + GetEnumName(TypeInfo(TFlagType), Integer(Flag)) + LineEnding + + ' Website : ' + Container.DownloadInfo.Website + LineEnding + + ' Title : ' + Container.DownloadInfo.title + LineEnding + + ' Chapterlink : ' + Container.ChapterLinks[Container.CurrentDownloadChapterPtr] + LineEnding + + ' Chaptername : ' + Container.ChapterName[Container.CurrentDownloadChapterPtr] + LineEnding; +end; - {$I includes/MangaFrame/chapter_page_number.inc} +function TDownloadThread.DownloadImage: Boolean; +var + workFilename, + workURL, + savedFilename: String; +begin + Result := True; - {$I includes/MangaGo/chapter_page_number.inc} + // check download path + if not ForceDirectoriesUTF8(Task.CurrentWorkingDir) then + begin + Task.StatusFailedToCreateDir; + Result := False; + Exit; + end; - {$I includes/MangaHere/chapter_page_number.inc} + // check pagelinks url + workURL := Task.Container.PageLinks[WorkId]; + if (workURL = '') or + (workURL = 'W') or + (workURL = 'D') then + Exit; - {$I includes/MangaInn/chapter_page_number.inc} + FHTTP.Clear; - {$I includes/MangaPanda/chapter_page_number.inc} + // prepare filename + workFilename := Task.GetFileName(WorkId); - {$I includes/MangaPark/chapter_page_number.inc} + // download image + savedFilename := ''; - {$I includes/MangaReader/chapter_page_number.inc} + if Modules.ModuleAvailable(Task.Container.ModuleId, MMDownloadImage) and + (Task.Container.PageNumber = Task.Container.PageContainerLinks.Count) and + (WorkId < Task.Container.PageContainerLinks.Count) then + workURL := Task.Container.PageContainerLinks[WorkId]; - {$I includes/MangaStream/chapter_page_number.inc} + // OnBeforeDownloadImage + if Modules.ModuleAvailable(Task.Container.ModuleId, MMBeforeDownloadImage) then + Result := Modules.BeforeDownloadImage(Self, workURL, Task.Container.ModuleId); - {$I includes/MangaStreamTo/chapter_page_number.inc} + if Result then + begin + // OnDownloadImage + if Modules.ModuleAvailable(Task.Container.ModuleId, MMDownloadImage) then + Result := Modules.DownloadImage(Self, workURL, Task.Container.ModuleId) + else + Result := FHTTP.GET(workURL); + end; - {$I includes/MangaTraders/chapter_page_number.inc} + if Result then + begin + savedFilename := FindImageFile(Task.CurrentWorkingDir + workFilename); + Result := savedFilename <> ''; + if not Result then + begin + if Modules.ModuleAvailable(Task.Container.ModuleId, MMSaveImage) then + savedFilename := Modules.SaveImage(FHTTP, Task.CurrentWorkingDir, workFilename, Task.Container.ModuleId) + else + savedFilename := SaveImageStreamToFile(FHTTP, Task.CurrentWorkingDir, workFilename); + Result := savedFilename <> ''; + end; + end; - {$I includes/MangaVadisi/chapter_page_number.inc} + if Result then + Result := FileExistsUTF8(savedFilename); - {$I includes/MeinManga/chapter_page_number.inc} + if Terminated then Exit(False); + if Result then + begin + Task.Container.PageLinks[WorkId] := 'D'; + // OnAfterImageSaved + if Modules.ModuleAvailable(Task.Container.ModuleId, MMAfterImageSaved) then + Modules.AfterImageSaved(savedFilename, Task.Container.ModuleId); + end; +end; - {$I includes/PecintaKomik/chapter_page_number.inc} +procedure TTaskThread.SetCurrentWorkingDir(AValue: String); +{$IFDEF WINDOWS} +var + s: UnicodeString; +{$ENDIF} +begin + if FCurrentWorkingDir = AValue then Exit; + FCurrentWorkingDir := CorrectPathSys(AValue); + {$IFDEF Windows} + s := UTF8Decode(FCurrentWorkingDir); + FCurrentMaxFileNameLength := FMDMaxImageFilePath - Length(s); + {$ENDIF} +end; - {$I includes/Pururin/chapter_page_number.inc} +procedure TTaskThread.SetIsForDelete(AValue: Boolean); +begin + if FIsForDelete = AValue then Exit; + FIsForDelete := AValue; +end; - {$I includes/RedHawkScans/chapter_page_number.inc} +procedure TTaskThread.SyncShowBallonHint; +begin + with MainForm.TrayIcon, Container.DownloadInfo do + begin + if Container.Status = STATUS_FAILED then + begin + BalloonFlags := bfError; + BalloonHint := QuotedStrd(Title); + if Status = '' then + BalloonHint := BalloonHint + ' - ' + RS_Failed + else + BalloonHint := BalloonHint + LineEnding + Status; + end + else + if Container.Status = STATUS_FINISH then + begin + BalloonFlags := bfInfo; + BalloonHint := + '"' + Container.DownloadInfo.title + '" - ' + RS_Finish; + end; + ShowBalloonHint; + end; +end; - {$I includes/S2Scans/chapter_page_number.inc} +procedure TTaskThread.CheckOut; +var + currentMaxThread, currentMaxConnections: Integer; + s: String; +begin + if Terminated then Exit; - {$I includes/SenManga/chapter_page_number.inc} + try + if Modules.MaxThreadPerTaskLimit[Container.ModuleId] > 0 then + currentMaxThread := Modules.MaxThreadPerTaskLimit[Container.ModuleId] + else + currentMaxThread := OptionMaxThreads; + if currentMaxThread > OptionMaxThreads then + currentMaxThread := OptionMaxThreads; - {$I includes/Starkana/chapter_page_number.inc} + if Container.PageLinks.Count > 0 then + begin + s := Trim(Container.PageLinks[Container.WorkCounter]); + if ((Flag = CS_GETPAGELINK) and (s <> 'W')) or + ((Flag = CS_DOWNLOAD) and (s = 'D')) then + begin + Container.WorkCounter := InterLockedIncrement(Container.WorkCounter); + Container.DownCounter := InterLockedIncrement(Container.DownCounter); + Container.DownloadInfo.Progress := + Format('%d/%d', [Container.DownCounter, Container.PageNumber]); + if Flag = CS_GETPAGELINK then + Container.CurrentPageNumber := InterLockedIncrement(Container.CurrentPageNumber); + Exit; + end; + end; - {$I includes/SubManga/chapter_page_number.inc} + if Modules.MaxConnectionLimit[Container.ModuleId] > 0 then + while (not Terminated) and (not Modules.CanCreateConnection(Container.ModuleId)) do + Sleep(SOCKHEARTBEATRATE) + else + while (not Terminated) and (Threads.Count >= currentMaxThread) do + Sleep(SOCKHEARTBEATRATE); - {$I includes/Turkcraft/chapter_page_number.inc} + currentMaxConnections := Modules.MaxConnectionLimit[Container.ModuleId]; + if currentMaxConnections <= 0 then + currentMaxConnections := currentMaxThread; - {$I includes/AnimeA/chapter_page_number.inc} + if (not Terminated) and (Threads.Count < currentMaxThread) then + try + EnterCriticalsection(FCS_THREADS); + if Modules.ActiveConnectionCount[Container.ModuleId] >= currentMaxConnections then Exit; + Modules.IncActiveConnectionCount(Container.ModuleId); + Threads.Add(TDownloadThread.Create); + with TDownloadThread(Threads.Last) do begin + Task := Self; + WorkId := Container.WorkCounter; + Start; + Container.WorkCounter := InterLockedIncrement(Container.WorkCounter); + end; + if Flag = CS_GETPAGELINK then + Container.CurrentPageNumber := InterLockedIncrement(Container.CurrentPageNumber); + finally + LeaveCriticalsection(FCS_THREADS); + end; - {$I includes/NineManga/chapter_page_number.inc} + except + on E: Exception do + begin + E.Message := E.Message + LineEnding + ' In TTaskThread.Checkout' + LineEnding + GetExceptionInfo; + MainForm.ExceptionHandler(Self, E); + end; + end; +end; - {$I includes/LectureEnLigne/chapter_page_number.inc} +procedure TTaskThread.Execute; - {$I includes/JapanShin/chapter_page_number.inc} + function CheckForPrepare: Boolean; + var + i: Integer; + begin + if Container.PageLinks.Count = 0 then + Exit(True); + Result := False; + if Container.PageLinks.Count > 0 then + for i := 0 to Container.PageLinks.Count - 1 do + if (Trim(Container.PageLinks[i]) = 'W') or + (Trim(Container.PageLinks[i]) = '') then + Exit(True); + end; - {$I includes/Japscan/chapter_page_number.inc} + function CheckForFinish: Boolean; + var + i, c: Integer; + sf: String; + begin + if Container.PageLinks.Count > 0 then + Result := True + else + begin + Result := False; + Exit; + end; - {$I includes/CentrumMangi_PL/chapter_page_number.inc} + c := 0; + sf := ''; + for i := 0 to Container.PageLinks.Count - 1 do + if Trim(Container.PageLinks[i]) <> 'D' then + begin + Inc(c); + sf += Container.PageLinks[i] + LineEnding; + end; + if c > 0 then begin + Logger.SendWarning(Format('%s, checkforfinish failed=%d/%d [%s]"%s" > "%s"', + [Self.ClassName, + c, + Container.PageLinks.Count, + Container.Website, + Container.DownloadInfo.Title, + Container.ChapterLinks[Container.CurrentDownloadChapterPtr]]) + LineEnding + Trim(sf)); + Result := False; + end; + end; - {$I includes/MangaLib_PL/chapter_page_number.inc} + procedure WaitForThreads; + begin + while (not Terminated) and (Threads.Count > 0) do + Sleep(SOCKHEARTBEATRATE); + end; - {$I includes/OneManga/chapter_page_number.inc} +var + j: Integer; + DynamicPageLink: Boolean; + FailedRetryCount: Integer = 0; +begin + Container.ThreadState := True; + Container.DownloadInfo.TransferRate := FormatByteSize(Container.ReadCount, true); + try + if (Container.Website = '') and (Container.DownloadInfo.Website <> '') then + Container.Website := Container.DownloadInfo.Website; + if Container.ModuleId > -1 then + DynamicPageLink := Modules.Module[Container.ModuleId].DynamicPageLink + else + DynamicPageLink := False; - {$I includes/MangaTown/chapter_page_number.inc} + if Trim(Container.CustomFileName) = '' then + Container.CustomFileName := OptionFilenameCustomRename; + if Trim(Container.CustomFileName) = '' then + Container.CustomFileName := DEFAULT_FILENAME_CUSTOMRENAME; - {$I includes/ReadHentaiManga/chapter_page_number.inc} + while container.ChaptersStatus.Count < Container.CurrentDownloadChapterPtr - 1 do + Container.ChaptersStatus.Add('D'); + while Container.ChaptersStatus.Count < Container.ChapterLinks.Count do + Container.ChaptersStatus.Add('P'); - {$I includes/MangaOku/chapter_page_number.inc} + if OptionAlwaysStartTaskFromFailedChapters and (Container.CurrentDownloadChapterPtr <> 0) then + Container.CurrentDownloadChapterPtr := 0; - {$I includes/MyReadingMangaInfo/chapter_page_number.inc} + while Container.CurrentDownloadChapterPtr < Container.ChapterLinks.Count do + begin + while Container.ChaptersStatus[Container.CurrentDownloadChapterPtr] = 'D' do + Inc(Container.CurrentDownloadChapterPtr); - {$I includes/IKomik/chapter_page_number.inc} + WaitForThreads; + if Terminated then Exit; - {$I includes/NHentai/chapter_page_number.inc} + //check path + if OptionGenerateChapterFolder then + CurrentWorkingDir := CorrectPathSys(Container.DownloadInfo.SaveTo) + + Container.ChapterName[Container.CurrentDownloadChapterPtr] + else + CurrentWorkingDir := Container.DownloadInfo.SaveTo; + if not ForceDirectoriesUTF8(CurrentWorkingDir) then + begin + StatusFailedToCreateDir; + ShowBalloonHint; + Exit; + end; - {$I includes/UnionMangas/chapter_page_number.inc} + if Container.ModuleId > -1 then + Modules.TaskStart(Container, Container.ModuleId); + + // set current working custom filename + CurrentCustomFileName := CustomRename(Container.CustomFileName, + Container.DownloadInfo.Website, + Container.DownloadInfo.Title, + '', + '', + Container.ChapterName[Container.CurrentDownloadChapterPtr], + '', + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr, + CR_FILENAME); - {$I includes/MangaMint/chapter_page_number.inc} + // Get page number. + if Container.PageLinks.Count = 0 then + begin + Container.PageNumber := 0; + Flag := CS_GETPAGENUMBER; + Container.WorkCounter := 0; + Container.DownCounter := 0; + Container.DownloadInfo.iProgress := 0; + Container.DownloadInfo.Progress := '0/0'; + Container.DownloadInfo.Status := + Format('[%d/%d] %s (%s)', + [Container.CurrentDownloadChapterPtr + 1, + Container.ChapterLinks.Count, + RS_Preparing, + Container.ChapterName[Container.CurrentDownloadChapterPtr]]); + Container.Status := STATUS_PREPARE; + CheckOut; + WaitForThreads; + if Terminated then begin + Container.PageLinks.Clear; + Container.PageNumber := 0; + Exit; + end; + end; - {$I includes/UnixManga/chapter_page_number.inc} + //Check file, if exist set mark 'D', otherwise 'W' or 'G' for dynamic image url + if Container.PageLinks.Count > 0 then + begin + for j := 0 to Container.PageLinks.Count - 1 do + begin + if ImageFileExist(CurrentWorkingDir + GetFileName(j)) then + Container.PageLinks[j] := 'D' + else + if Container.PageLinks[j] = 'D' then + begin + if DynamicPageLink then + Container.PageLinks[j] := 'G' + else + Container.PageLinks[j] := 'W'; + end; + end; + end; - {$I includes/HakiHome/chapter_page_number.inc} - - {$I includes/ExtremeMangas/chapter_page_number.inc} - - {$I includes/MangaHost/chapter_page_number.inc} - - {$I includes/PornComix/chapter_page_number.inc} - - {$I includes/MangaSee/chapter_page_number.inc} - - {$I includes/MangaKu/chapter_page_number.inc} - - {$I includes/AcademyVN/chapter_page_number.inc} - - {$I includes/MangaAt/chapter_page_number.inc} - - {$I includes/SenMangaRAW/chapter_page_number.inc} - - {$I includes/ReadMangaToday/chapter_page_number.inc} - - {$I includes/LoneManga/chapter_page_number.inc} - - {$I includes/Dynasty-Scans/chapter_page_number.inc} - - {$I includes/Madokami/chapter_page_number.inc} - - {$I includes/WPManga/chapter_page_number.inc} - -begin - manager.container.PageNumber := 0; - if manager.container.MangaSiteID = ANIMEA_ID then - Result := GetAnimeAPageNumber - else - if manager.container.MangaSiteID = MANGAHERE_ID then - Result := GetMangaHerePageNumber - else - if manager.container.MangaSiteID = MANGAINN_ID then - Result := GetMangaInnPageNumber - else - if manager.container.MangaSiteID = BATOTO_ID then - Result := GetBatotoPageNumber - else - if manager.container.MangaSiteID = MANGAFOX_ID then - Result := GetMangaFoxPageNumber - else - if manager.container.MangaSiteID = MANGAREADER_ID then - Result := GetMangaReaderPageNumber - else - if manager.container.MangaSiteID = MANGATRADERS_ID then - Result := GetMangaTradersPageNumber - else - if manager.container.MangaSiteID = STARKANA_ID then - Result := GetStarkanaPageNumber - else - if manager.container.MangaSiteID = EATMANGA_ID then - Result := GetEatMangaPageNumber - else - if manager.container.MangaSiteID = MANGAPANDA_ID then - Result := GetMangaPandaPageNumber - else - if manager.container.MangaSiteID = MANGAPARK_ID then - Result := GetMangaParkPageNumber - else - if manager.container.MangaSiteID = MANGAGO_ID then - Result := GetMangaGoPageNumber - else - if manager.container.MangaSiteID = MANGASTREAM_ID then - Result := GetMangaStreamPageNumber - else - if manager.container.MangaSiteID = REDHAWKSCANS_ID then - Result := GetRedHawkScansPageNumber - else - if manager.container.MangaSiteID = S2SCAN_ID then - Result := GetS2scanPageNumber - else - if manager.container.MangaSiteID = MEINMANGA_ID then - Result := GetMeinMangaPageNumber - else - if manager.container.MangaSiteID = MANGA2U_ID then - Result := GetManga2uPageNumber - else - if manager.container.MangaSiteID = ESMANGAHERE_ID then - Result := GetEsMangaHerePageNumber - else - if manager.container.MangaSiteID = SUBMANGA_ID then - Result := GetSubMangaPageNumber - else - if manager.container.MangaSiteID = ANIMEEXTREMIST_ID then - Result := GetAnimeExtremistPageNumber - else - if manager.container.MangaSiteID = KOMIKID_ID then - Result := GetKomikidPageNumber - else - if manager.container.MangaSiteID = PECINTAKOMIK_ID then - Result := GetPecintaKomikPageNumber - else - if manager.container.MangaSiteID = PURURIN_ID then - Result := GetPururinPageNumber - else - if manager.container.MangaSiteID = HUGEMANGA_ID then - Result := GetHugeMangaPageNumber - else - if manager.container.MangaSiteID = ANIMESTORY_ID then - Result := GetAnimeStoryPageNumber - else - if manager.container.MangaSiteID = TURKCRAFT_ID then - Result := GetTurkcraftPageNumber - else - if manager.container.MangaSiteID = MANGAVADISI_ID then - Result := GetMangaVadisiPageNumber - else - if manager.container.MangaSiteID = MANGAFRAME_ID then - Result := GetMangaFramePageNumber - else - if manager.container.MangaSiteID = MANGAAE_ID then - Result := GetMangaAePageNumber - else - if manager.container.MangaSiteID = MANGACOW_ID then - Result := GetMangaCowPageNumber - else - if manager.container.MangaSiteID = SENMANGA_ID then - Result := GetSenMangaPageNumber - else - if (manager.container.MangaSiteID = MANGAEDEN_ID) or - (manager.container.MangaSiteID = PERVEDEN_ID) then - Result := GetMangaEdenPageNumber - else - if manager.container.MangaSiteID = KISSMANGA_ID then - Result := GetKissMangaPageNumber - else - if manager.container.MangaSiteID = KIVMANGA_ID then - Result := GetKivmangaPageNumber - else - if manager.container.MangaSiteID = HENTAI2READ_ID then - Result := GetHentai2ReadPageNumber - else - if manager.container.MangaSiteID = EHENTAI_ID then - Result := GetEHentaiPageNumber - else - if manager.container.MangaSiteID = MANGASTREAMTO_ID then - Result := GetMangaStreamToPageNumber - else - if (manager.container.MangaSiteID = NINEMANGA_ID) or - (manager.container.MangaSiteID = NINEMANGA_ES_ID) or - (manager.container.MangaSiteID = NINEMANGA_CN_ID) or - (manager.container.MangaSiteID = NINEMANGA_RU_ID) or - (manager.container.MangaSiteID = NINEMANGA_DE_ID) or - (manager.container.MangaSiteID = NINEMANGA_IT_ID) or - (manager.container.MangaSiteID = NINEMANGA_BR_ID) then - Result := GetNineMangaPageNumber - else - if manager.container.MangaSiteID = LECTUREENLIGNE_ID then - Result := GetLectureEnLignePageNumber - else - if manager.container.MangaSiteID = JAPANSHIN_ID then - Result := GetJapanShinPageNumber - else - if manager.container.MangaSiteID = JAPSCAN_ID then - Result := GetJapscanPageNumber - else - if manager.container.MangaSiteID = CENTRUMMANGI_PL_ID then - Result := GetCentrumMangi_PLPageNumber - else - if manager.container.MangaSiteID = MANGALIB_PL_ID then - Result := GetMangaLib_PLPageNumber - else - if manager.container.MangaSiteID = ONEMANGA_ID then - Result := GetOneMangaPageNumber - else - if manager.container.MangaSiteID = MANGATOWN_ID then - Result := GetMangaTownPageNumber - else - if manager.container.MangaSiteID = READHENTAIMANGA_ID then - Result := GetReadHentaiMangaPageNumber - else - if manager.container.MangaSiteID = MANGAOKU_ID then - Result := GetMangaOkuPageNumber - else - if manager.container.MangaSiteID = MYREADINGMANGAINFO_ID then - Result := GetMyReadingMangaInfoPageNumber - else - if manager.container.MangaSiteID = IKOMIK_ID then - Result := GetIKomikPageNumber - else - if manager.container.MangaSiteID = NHENTAI_ID then - Result := GetNHentaiPageNumber - else - if manager.container.MangaSiteID = UNIONMANGAS_ID then - Result := GetUnionMangasPageNumber - else - if manager.container.MangaSiteID = MANGAMINT_ID then - Result := GetMangaMintPageNumber - else - if manager.container.MangaSiteID = UNIXMANGA_ID then - Result := GetUnixMangaPageNumber - else - if manager.container.MangaSiteID = HAKIHOME_ID then - Result := GetHakiHomePageNumber - else - if manager.container.MangaSiteID = EXTREMEMANGAS_ID then - Result := GetExtremeMangasPageNumber - else - if manager.container.MangaSiteID = MANGAHOST_ID then - Result := GetMangaHostPageNumber - else - if (manager.container.MangaSiteID = PORNCOMIX_ID) or - (manager.container.MangaSiteID = XXCOMICS_ID) or - (manager.container.MangaSiteID = XXCOMICSMT_ID) or - (manager.container.MangaSiteID = XXCOMICS3D_ID) or - (manager.container.MangaSiteID = PORNCOMIXRE_ID) or - (manager.container.MangaSiteID = PORNCOMIXIC_ID) or - (manager.container.MangaSiteID = PORNXXXCOMICS_ID) then - Result := GetPornComixPageNumber(manager.container.MangaSiteID) - else - if manager.container.MangaSiteID = MANGASEE_ID then - Result := GetMangaSeePageNumber - else - if manager.container.MangaSiteID = MANGAKU_ID then - Result := GetMangaKuPageNumber - else - if manager.container.MangaSiteID = ACADEMYVN_ID then - Result := GetAcademyVNPageNumber - else - if manager.container.MangaSiteID = MANGAAT_ID then - Result := GetMangaAtPageNumber - else - if manager.container.MangaSiteID = SENMANGARAW_ID then - Result := GetSenMangaRAWPageNumber - else - if manager.container.MangaSiteID = READMANGATODAY_ID then - Result := GetReadMangaTodayPageNumber - else - if manager.container.MangaSiteID = LONEMANGA_ID then - Result := GetLoneMangaPageNumber - else - if manager.container.MangaSiteID = DYNASTYSCANS_ID then - Result := GetDynastyScansPageNumber - else - if manager.container.MangaSiteID = MADOKAMI_ID then - Result := GetMadokamiPageNumber - else - if SitesIsWPManga(manager.container.MangaSiteID) then - Result := GetWPMangaPageNumber - else - Result := False; -end; - -function TDownloadThread.GetLinkPageFromURL(const URL: String): Boolean; -var - Parser: THTMLParser; - - {$I includes/AnimeStory/image_url.inc} - - {$I includes/AnimExtremist/image_url.inc} - - {$I includes/Batoto/image_url.inc} - - {$I includes/BlogTruyen/image_url.inc} - - {$I includes/CentralDeMangas/image_url.inc} - - {$I includes/EatManga/image_url.inc} - - {$I includes/EGScans/image_url.inc} - - {$I includes/EsMangaHere/image_url.inc} - - {$I includes/Fakku/image_url.inc} - - {$I includes/Hentai2Read/image_url.inc} - - {$I includes/HugeManga/image_url.inc} - - {$I includes/Kivmanga/image_url.inc} - - {$I includes/Komikid/image_url.inc} - - {$I includes/Mabuns/image_url.inc} - - {$I includes/Manga24h/image_url.inc} - - {$I includes/Manga2u/image_url.inc} - - {$I includes/MangaAe/image_url.inc} - - {$I includes/MangaAr/image_url.inc} - - {$I includes/Mangacan/image_url.inc} - - {$I includes/Mangacow/image_url.inc} - - {$I includes/MangaEden/image_url.inc} - - {$I includes/MangaEsta/image_url.inc} - - {$I includes/MangaFox/image_url.inc} - - {$I includes/MangaFrame/image_url.inc} - - {$I includes/MangaGo/image_url.inc} - - {$I includes/MangaHere/image_url.inc} - - {$I includes/MangaInn/image_url.inc} - - {$I includes/MangaPanda/image_url.inc} - - //{$I includes/MangaPark/image_url.inc} - - {$I includes/MangaReader/image_url.inc} - - {$I includes/MangaREADER_POR/image_url.inc} - - {$I includes/MangasPROJECT/image_url.inc} - - {$I includes/MangaStream/image_url.inc} - - {$I includes/MangaStreamTo/image_url.inc} - - {$I includes/MangaTraders/image_url.inc} - - {$I includes/MangaVadisi/image_url.inc} - - {$I includes/PecintaKomik/image_url.inc} - - {$I includes/Pururin/image_url.inc} - - {$I includes/RedHawkScans/image_url.inc} - - {$I includes/ScanManga/image_url.inc} - - {$I includes/SenManga/image_url.inc} - - {$I includes/Starkana/image_url.inc} - - {$I includes/SubManga/image_url.inc} - - {$I includes/TruyenTranhTuan/image_url.inc} - - {$I includes/Turkcraft/image_url.inc} - - {$I includes/VnSharing/image_url.inc} - - {$I includes/AnimeA/image_url.inc} - - {$I includes/NineManga/image_url.inc} - - {$I includes/LectureEnLigne/image_url.inc} - - {$I includes/JapanShin/image_url.inc} - - {$I includes/Japscan/image_url.inc} - - {$I includes/CentrumMangi_PL/image_url.inc} - - {$I includes/MangaLib_PL/image_url.inc} - - {$I includes/OneManga/image_url.inc} - - {$I includes/MangaTown/image_url.inc} - - {$I includes/ReadHentaiManga/image_url.inc} - - {$I includes/MangaOku/image_url.inc} - - {$I includes/IKomik/image_url.inc} - - {$I includes/NHentai/image_url.inc} - - {$I includes/MangaMint/image_url.inc} - - {$I includes/UnixManga/image_url.inc} - - {$I includes/HakiHome/image_url.inc} - - {$I includes/MangaHost/image_url.inc} - - {$I includes/PornComix/image_url.inc} - - {$I includes/MangaAt/image_url.inc} - - {$I includes/WPManga/image_url.inc} - -begin - if (manager.container.PageLinks.Count > 0) and - (manager.container.PageLinks.Strings[workCounter] <> 'W') then - Exit; - - if manager.container.MangaSiteID = ANIMEA_ID then - Result := GetAnimeAImageURL - else - if manager.container.MangaSiteID = MANGATRADERS_ID then - Result := GetMangaTradersImageURL - else - if manager.container.MangaSiteID = MANGAHERE_ID then - Result := GetMangaHereImageURL - else - if manager.container.MangaSiteID = MANGAINN_ID then - Result := GetMangaInnImageURL - else - if manager.container.MangaSiteID = BATOTO_ID then - Result := GetBatotoImageURL - else - if manager.container.MangaSiteID = MANGA2U_ID then - Result := GetManga2uImageURL - else - if manager.container.MangaSiteID = MANGA24H_ID then - Result := GetManga24hImageURL - else - if manager.container.MangaSiteID = VNSHARING_ID then - Result := GetVnSharingImageURL - else - if manager.container.MangaSiteID = HENTAI2READ_ID then - Result := GetHentai2ReadImageURL - else - if manager.container.MangaSiteID = FAKKU_ID then - Result := GetFakkuImageURL - else - if manager.container.MangaSiteID = MANGAREADER_ID then - Result := GetMangaReaderImageURL - else - //if manager.container.MangaSiteID = MANGAPARK_ID then - // Result := GetMangaParkImageURL - //else - if manager.container.MangaSiteID = MANGAFOX_ID then - Result := GetMangaFoxImageURL - else - if manager.container.MangaSiteID = STARKANA_ID then - Result := GetStarkanaImageURL - else - if manager.container.MangaSiteID = EATMANGA_ID then - Result := GetEatMangaImageURL - else - if manager.container.MangaSiteID = MANGAPANDA_ID then - Result := GetMangaPandaImageURL - else - if manager.container.MangaSiteID = MANGAGO_ID then - Result := GetMangaGoImageURL - else - if manager.container.MangaSiteID = MANGASTREAM_ID then - Result := GetMangaStreamImageURL - else - if manager.container.MangaSiteID = REDHAWKSCANS_ID then - Result := GetRedHawkScansImageURL - else - if manager.container.MangaSiteID = EGSCANS_ID then - Result := GetEGScansImageURL - else - if manager.container.MangaSiteID = ESMANGAHERE_ID then - Result := GetEsMangaHereImageURL - else - if manager.container.MangaSiteID = SUBMANGA_ID then - Result := GetSubMangaImageURL - else - if manager.container.MangaSiteID = ANIMEEXTREMIST_ID then - Result := GetAnimeExtremistImageURL - else - if manager.container.MangaSiteID = KOMIKID_ID then - Result := GetKomikidImageURL - else - if manager.container.MangaSiteID = PECINTAKOMIK_ID then - Result := GetPecintaKomikImageURL - else - if manager.container.MangaSiteID = MABUNS_ID then - Result := GetMabunsImageURL - else - if manager.container.MangaSiteID = MANGAESTA_ID then - Result := GetMangaEstaImageURL - else - if manager.container.MangaSiteID = PURURIN_ID then - Result := GetPururinImageURL - else - if manager.container.MangaSiteID = HUGEMANGA_ID then - Result := GetHugeMangaImageURL - else - if manager.container.MangaSiteID = ANIMESTORY_ID then - Result := GetAnimeStoryImageURL - else - if manager.container.MangaSiteID = SCANMANGA_ID then - Result := GetScanMangaImageURL - else - if manager.container.MangaSiteID = TURKCRAFT_ID then - Result := GetTurkcraftImageURL - else - if manager.container.MangaSiteID = MANGAVADISI_ID then - Result := GetMangaVadisiImageURL - else - if manager.container.MangaSiteID = MANGAFRAME_ID then - Result := GetMangaFrameImageURL - else - if manager.container.MangaSiteID = MANGAAR_ID then - Result := GetMangaArImageURL - else - if manager.container.MangaSiteID = MANGAAE_ID then - Result := GetMangaAeImageURL - else - if manager.container.MangaSiteID = CENTRALDEMANGAS_ID then - Result := GetCentralDeMangasImageURL - else - if manager.container.MangaSiteID = MANGACOW_ID then - Result := GetMangaCowImageURL - else - if manager.container.MangaSiteID = SENMANGA_ID then - Result := GetSenMangaImageURL - else - if manager.container.MangaSiteID = TRUYENTRANHTUAN_ID then - Result := GetTruyenTranhTuanImageURL - else - if manager.container.MangaSiteID = BLOGTRUYEN_ID then - Result := GetBlogTruyenImageURL - else - if (manager.container.MangaSiteID = MANGAEDEN_ID) or - (manager.container.MangaSiteID = PERVEDEN_ID) then - Result := GetMangaEdenImageURL - else - if manager.container.MangaSiteID = KIVMANGA_ID then - Result := GetKivmangaImageURL - else - if manager.container.MangaSiteID = MANGACAN_ID then - Result := GetMangacanImageURL - else - if manager.container.MangaSiteID = MANGASPROJECT_ID then - Result := GetMangasPROJECTImageURL - else - if manager.container.MangaSiteID = MANGAREADER_POR_ID then - Result := GetMangaREADER_PORImageURL - else - if manager.container.MangaSiteID = MANGASTREAMTO_ID then - Result := GetMangaStreamToImageURL - else - if (manager.container.MangaSiteID = NINEMANGA_ID) or - (manager.container.MangaSiteID = NINEMANGA_ES_ID) or - (manager.container.MangaSiteID = NINEMANGA_CN_ID) or - (manager.container.MangaSiteID = NINEMANGA_RU_ID) or - (manager.container.MangaSiteID = NINEMANGA_DE_ID) or - (manager.container.MangaSiteID = NINEMANGA_IT_ID) or - (manager.container.MangaSiteID = NINEMANGA_BR_ID) then - Result := GetNineMangaImageURL - else - if manager.container.MangaSiteID = LECTUREENLIGNE_ID then - Result := GeLectureEnligneImageURL - else - if manager.container.MangaSiteID = JAPANSHIN_ID then - Result := GetJapanShinImageURL - else - if manager.container.MangaSiteID = JAPSCAN_ID then - Result := GetJapscanImageURL - else - if manager.container.MangaSiteID = CENTRUMMANGI_PL_ID then - Result := GetCentrumMangi_PLImageURL - else - if manager.container.MangaSiteID = MANGALIB_PL_ID then - Result := GetMangaLib_PLImageURL - else - if manager.container.MangaSiteID = ONEMANGA_ID then - Result := GetOneMangaImageURL - else - if manager.container.MangaSiteID = MANGATOWN_ID then - Result := GetMangaTownImageURL - else - if manager.container.MangaSiteID = READHENTAIMANGA_ID then - Result := GetReadHentaiMangaImageURL - else - if manager.container.MangaSiteID = MANGAOKU_ID then - Result := GetMangaOkuImageURL - else - if manager.container.MangaSiteID = IKOMIK_ID then - Result := GetIKomikImageURL - else - if manager.container.MangaSiteID = NHENTAI_ID then - Result := GetNHentaiImageURL - else - if manager.container.MangaSiteID = MANGAMINT_ID then - Result := GetMangaMintImageURL - else - if manager.container.MangaSiteID = UNIXMANGA_ID then - Result := GetUnixMangaImageURL - else - if manager.container.MangaSiteID = HAKIHOME_ID then - Result := GetHakiHomeImageURL - else - if manager.container.MangaSiteID = MANGAHOST_ID then - Result := GetMangaHostImageURL - else - if (manager.container.MangaSiteID = PORNCOMIX_ID) or - (manager.container.MangaSiteID = XXCOMICS_ID) or - (manager.container.MangaSiteID = XXCOMICSMT_ID) or - (manager.container.MangaSiteID = XXCOMICS3D_ID) or - (manager.container.MangaSiteID = PORNCOMIXRE_ID) or - (manager.container.MangaSiteID = PORNCOMIXIC_ID) or - (manager.container.MangaSiteID = PORNXXXCOMICS_ID) then - Result := GetPornComixImageURL - else - if manager.container.MangaSiteID = MANGAAT_ID then - Result := GetMangaAtImageURL - else - if SitesIsWPManga(manager.container.MangaSiteID) then - Result := GetWPMangaImageURL - else - Result := False; -end; - -procedure TDownloadThread.MainThreadMessageDialog; -begin - MessageDlg('TDownloadThread', FMessage, mtInformation, [mbOK], ''); -end; - -procedure TDownloadThread.Merge2Images( - const path, imgName1, imgName2, finalName: String); -var - rect: TRect; - img1, img2, finalImg: TImageData; - cv1, cv2, canvas: TImagingCanvas; - stream: TFileStreamUTF8; - fullImgName1, fullImgName2, fullFinalImgName, fext: String; -begin - fullImgName1 := Path + '/' + imgName1; - fullImgName2 := Path + '/' + imgName2; - fullFinalImgName := Path + '/' + finalName; - - if (not FileExistsUTF8(fullImgName1)) or (not FileExistsUTF8(fullImgName2)) then - Exit; - - // Load first image to stream. - stream := TFileStreamUTF8.Create(fullImgName1, fmOpenRead); - LoadImageFromStream(stream, img1); - stream.Free; - cv1 := TImagingCanvas.CreateForData(@img1); - - // Load second image to stream. - stream := TFileStreamUTF8.Create(fullImgName2, fmOpenRead); - LoadImageFromStream(stream, img2); - stream.Free; - cv2 := TImagingCanvas.CreateForData(@img2); - - // Create new buffer for merging images ... - NewImage(img1.Width, img1.Height + img2.Height, ifR8G8B8, finalImg); - canvas := TImagingCanvas.CreateForData(@finalImg); - - // Merge images. - rect.Left := 0; - rect.Top := 0; - rect.Right := img1.Width; - rect.Bottom := img1.Height; - cv1.DrawBlend(rect, canvas, 0, 0, bfOne, bfZero); - - rect.Left := 0; - rect.Top := 0; - rect.Right := img2.Width; - rect.Bottom := img2.Height; - cv2.DrawBlend(rect, canvas, 0, img1.Height, bfOne, bfZero); - - // Save final image. - if FileExistsUTF8(fullFinalImgName) then - DeleteFileUTF8(fullFinalImgName); - stream := TFileStreamUTF8.Create(fullFinalImgName, fmCreate); - //SaveImageToStream('png', stream, finalImg); - fext := ExtractFileExt(finalName); - if fext[1] = '.' then - fext := Copy(fext, 2, Length(fext) - 1); - SaveImageToStream(fext, stream, finalImg); - stream.Free; - - // Remove old images. - DeleteFileUTF8(fullImgName1); - DeleteFileUTF8(fullImgName2); - - // Free memory. - cv1.Free; - cv2.Free; - canvas.Free; - FreeImage(img1); - FreeImage(img2); - FreeImage(finalImg); -end; - -procedure TDownloadThread.SetChangeDirectoryFalse; -begin - isChangeDirectory := False; -end; - -procedure TDownloadThread.SetChangeDirectoryTrue; -begin - isChangeDirectory := True; -end; - -// ----- TTaskThread ----- - -constructor TTaskThread.Create; -begin - inherited Create(True); - CS_threads := TCriticalSection.Create; - threads := TFPList.Create; - anotherURL := ''; - httpCookies := ''; -end; - -destructor TTaskThread.Destroy; -begin - threads.Free; - CS_threads.Free; - inherited Destroy; -end; - -procedure TTaskThread.MainThreadCompressRepaint; -begin - container.DownloadInfo.Status := - Format('%s (%d/%d)', [RS_Compressing, container.CurrentDownloadChapterPtr + - 1, container.ChapterLinks.Count]); - MainForm.vtDownload.Repaint; -end; - -procedure TTaskThread.MainThreadMessageDialog; -begin - MessageDlg('TTaskThread', FMessage, mtInformation, [mbOK], ''); -end; - -procedure TTaskThread.Compress; -var - uPacker: TPacker; -begin - if (container.Manager.compress >= 1) then - begin - Synchronize(MainThreadCompressRepaint); - uPacker := TPacker.Create; - try - case container.Manager.compress of - 1: uPacker.ext := '.zip'; - 2: uPacker.ext := '.cbz'; - 3: uPacker.ext := '.pdf'; - end; - uPacker.CompressionQuality := OptionPDFQuality; - uPacker.Path := CorrectPathSys(container.DownloadInfo.SaveTo) + - container.ChapterName.Strings[container.CurrentDownloadChapterPtr]; - uPacker.Execute; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; - uPacker.Free; - end; -end; - -procedure TTaskThread.ShowBaloon; -begin - if container.Status = STATUS_FAILED then - begin - MainForm.TrayIcon.BalloonFlags := bfError; - MainForm.TrayIcon.BalloonHint := - '"' + container.DownloadInfo.title + '" - ' + RS_Failed;; - end - else - if container.Status = STATUS_FINISH then - begin - MainForm.TrayIcon.BalloonFlags := bfInfo; - MainForm.TrayIcon.BalloonHint := - '"' + container.DownloadInfo.title + '" - ' + RS_Finish; - end; - MainForm.TrayIcon.ShowBalloonHint; -end; - -function TDownloadThread.DownloadImage(const prefix: String): Boolean; -var - TURL, lpath: String; - - {$I includes/EHentai/image_url.inc} - - {$I includes/MeinManga/image_url.inc} - - {$I includes/SenMangaRAW/image_url.inc} - -begin - lpath := CleanAndExpandDirectory(CorrectPathSys(manager.container.DownloadInfo.SaveTo + - manager.container.ChapterName[manager.container.CurrentDownloadChapterPtr])); - if not DirectoryExistsUTF8(lpath) then - begin - if not ForceDirectoriesUTF8(lpath) then - begin - manager.container.Status := STATUS_FAILED; - manager.container.DownloadInfo.Status := 'Failed to create dir! Too long?'; - Result := False; - Exit; - end; - end; - - Result := True; - TURL := manager.container.PageLinks[workCounter]; - if (TURL = '') or (TURL = 'W') or (TURL = 'D') then - Exit; - - FHTTP.Clear; - if manager.container.MangaSiteID = SENMANGARAW_ID then - Result := GetSenMangaRAWImageURL; - - TURL := DecodeURL(TURL); //decode first to avoid double encoded - TURL := EncodeTriplet(TURL, '%', URLSpecialChar + ['#']); - - if manager.container.MangaSiteID = EHENTAI_ID then - Result := getEHentaiImageURL - else - if manager.container.MangaSiteID = MEINMANGA_ID then - Result := GetMeinMangaImageURL - else - if Result then - Result := SaveImage( - manager.container.MangaSiteID, - TURL, - lpath, - Format('%.3d', [workCounter + 1]), - prefix, - manager.container.Manager.retryConnect); - - SetCurrentDirUTF8(fmdDirectory); - if Terminated then Exit(False); - if Result then - manager.container.PageLinks[workCounter] := 'D'; -end; - -procedure TTaskThread.CheckOut; -var - currentMaxThread: Integer; - s: String; - mt: Integer; -begin - if Terminated then Exit; - // TODO: Ugly code, need to be fixed later - - //load advanced config if any - mt := INIAdvanced.ReadInteger('DownloadMaxThreadsPerTask', - WebsiteRoots[container.MangaSiteID, 0], -1); - if (mt > 0) then - begin - if (mt > 32) then - mt := 32; - currentMaxThread := mt; - end - else - begin - case container.MangaSiteID of - PECINTAKOMIK_ID : currentMaxThread := 1; - EHENTAI_ID : currentMaxThread := 2; - else - currentMaxThread := container.Manager.maxDLThreadsPerTask; - end; - if currentMaxThread > container.Manager.maxDLThreadsPerTask then - currentMaxThread := container.Manager.maxDLThreadsPerTask; - end; - - if container.PageLinks.Count > 0 then - begin - s := Trim(container.PageLinks[container.WorkCounter]); - if ((Flag = CS_GETPAGELINK) and (s <> 'W')) or - ((Flag = CS_DOWNLOAD) and (s = 'D')) then - begin - container.WorkCounter := InterLockedIncrement(container.WorkCounter); - container.DownCounter := InterLockedIncrement(container.DownCounter); - container.DownloadInfo.Progress := - Format('%d/%d', [container.DownCounter, container.PageNumber]); - if Flag = CS_GETPAGELINK then - container.CurrentPageNumber := InterLockedIncrement(container.CurrentPageNumber); - Exit; - end; - - while (not Terminated) and (threads.Count >= currentMaxThread) do - Sleep(SOCKHEARTBEATRATE); - end; - - if (not Terminated) and (threads.Count < currentMaxThread) then - begin - CS_threads.Acquire; - try - threads.Add(TDownloadThread.Create); - with TDownloadThread(threads.Last) do begin - manager := Self; - workCounter := container.WorkCounter; - checkStyle := Flag; - //load User-Agent from INIAdvanced - if container.DownloadInfo.Website <> '' then - FHTTP.UserAgent := INIAdvanced.ReadString('UserAgent', - container.DownloadInfo.Website, ''); - Start; - container.WorkCounter := InterLockedIncrement(container.WorkCounter); - end; - if Flag = CS_GETPAGELINK then - container.CurrentPageNumber := InterLockedIncrement(container.CurrentPageNumber); - finally - CS_threads.Release; - end; - end; -end; - -procedure TTaskThread.Execute; - - function CheckForPrepare: Boolean; - var - i: Integer; - begin - if container.PageLinks.Count = 0 then - Exit(True); - Result := False; - if container.PageLinks.Count > 0 then - for i := 0 to container.PageLinks.Count - 1 do - if (Trim(container.PageLinks[i]) = 'W') or - (Trim(container.PageLinks[i]) = '') then - Exit(True); - end; - - function CheckForFinish: Boolean; - var - i, c: Integer; - begin - if container.PageLinks.Count > 0 then - Result := True - else - begin - Result := False; - Exit; - end; - - c := 0; - for i := 0 to container.PageLinks.Count - 1 do - begin - if Trim(container.PageLinks[i]) <> 'D' then - Inc(c); - end; - if c > 0 then - Result := False; - end; - - procedure WaitForThreads; - begin - while (not Terminated) and (threads.Count > 0) do - Sleep(SOCKHEARTBEATRATE); - end; - -var - j: Integer; - S, P: String; -begin - INIAdvanced.Reload; - container.ThreadState := True; - container.DownloadInfo.TransferRate := ''; - try - while container.CurrentDownloadChapterPtr < container.ChapterLinks.Count do - begin - WaitForThreads; - if Terminated then Exit; - - //strip - container.DownloadInfo.SaveTo := CorrectPathSys(container.DownloadInfo.SaveTo); - S := CorrectPathSys(container.DownloadInfo.SaveTo + - container.ChapterName[container.CurrentDownloadChapterPtr]); - //check path - if not DirectoryExistsUTF8(S) then - begin - if not ForceDirectoriesUTF8(S) then - begin - container.Status := STATUS_FAILED; - container.DownloadInfo.Status := RS_FailedToCreateDirTooLong; - Exit; - end; - end; - - //if no total page number found, we reset pagelinks here - if container.MangaSiteID = SUBMANGA_ID then - container.PageLinks.Clear; - - // Get page number. - if container.PageLinks.Count = 0 then - begin - container.PageNumber := 0; - Flag := CS_GETPAGENUMBER; - container.WorkCounter := 0; - container.DownCounter := 0; - container.DownloadInfo.iProgress := 0; - container.DownloadInfo.Progress := '0/0'; - container.DownloadInfo.Status := - Format('%s (%d/%d [%s])', - [RS_Preparing, - container.CurrentDownloadChapterPtr + 1, - container.ChapterLinks.Count, - container.ChapterName.Strings[container.CurrentDownloadChapterPtr]]); - container.Status := STATUS_PREPARE; - CheckOut; - WaitForThreads; - if Terminated then Exit; - end; - - //Check file, if exist set mark 'D', otherwise 'W' or 'G' for dynamic image url - if container.PageLinks.Count > 0 then - begin - for j := 0 to container.PageLinks.Count - 1 do - begin - P := S + PathDelim + Format('%.3d', [j + 1]); - if (FileExistsUTF8(P + '.jpg')) or - (FileExistsUTF8(P + '.png')) or - (FileExistsUTF8(P + '.gif')) then - container.PageLinks[j] := 'D' - else - if container.PageLinks[j] = 'D' then - if SitesWithoutPageLink(WebsiteRoots[container.MangaSiteID, 0]) then - container.PageLinks[j] := 'G' - else - container.PageLinks[j] := 'W'; - end; - end; - - //Get page links - if container.PageLinks.Count = 0 then - container.PageLinks.Add('W'); - container.PageNumber := container.PageLinks.Count; - if not SitesWithoutPageLink(WebsiteRoots[container.MangaSiteID, 0]) and - CheckForPrepare then - begin - Flag := CS_GETPAGELINK; - container.WorkCounter := 0; - container.DownCounter := 0; - container.DownloadInfo.iProgress := 0; - container.DownloadInfo.Progress := - Format('%d/%d', [container.DownCounter, container.PageNumber]); - container.DownloadInfo.Status := - Format('%s (%d/%d [%s])', - [RS_Preparing, - container.CurrentDownloadChapterPtr + 1, - container.ChapterLinks.Count, - container.ChapterName[container.CurrentDownloadChapterPtr]]); - container.Status := STATUS_PREPARE; - while container.WorkCounter < container.PageNumber do - begin - if Terminated then Exit; - Checkout; - container.DownloadInfo.iProgress := - InterLockedIncrement(container.DownloadInfo.iProgress); - end; - WaitForThreads; - if Terminated then Exit; + //Get page links + if Container.PageLinks.Count = 0 then + Container.PageLinks.Add('W'); + Container.PageNumber := Container.PageLinks.Count; + if (not DynamicPageLink) and CheckForPrepare then + begin + Flag := CS_GETPAGELINK; + Container.WorkCounter := 0; + Container.DownCounter := 0; + Container.DownloadInfo.iProgress := 0; + Container.DownloadInfo.Progress := + Format('%d/%d', [Container.DownCounter, Container.PageNumber]); + Container.DownloadInfo.Status := + Format('[%d/%d] %s (%s)', + [Container.CurrentDownloadChapterPtr + 1, + Container.ChapterLinks.Count, + RS_Preparing, + Container.ChapterName[Container.CurrentDownloadChapterPtr]]); + Container.Status := STATUS_PREPARE; + while Container.WorkCounter < Container.PageNumber do + begin + if Terminated then Exit; + Checkout; + Container.DownloadInfo.iProgress := + InterLockedIncrement(Container.DownloadInfo.iProgress); + end; + WaitForThreads; + if Terminated then Exit; //check if pagelink is found. Else set again to 'W'(some script return '') - if container.PageLinks.Count > 0 then + if Container.PageLinks.Count > 0 then begin - for j := 0 to container.PageLinks.Count - 1 do + for j := 0 to Container.PageLinks.Count - 1 do begin - if Trim(container.PageLinks[j]) = '' then - container.PageLinks[j] := 'W'; + if Trim(Container.PageLinks[j]) = '' then + Container.PageLinks[j] := 'W'; end; end; end; if Terminated then Exit; // download pages - // If container doesn't have any image, we will skip the loop. Otherwise + // If Container doesn't have any image, we will skip the loop. Otherwise // download them - container.PageNumber := container.PageLinks.Count; - if (container.PageLinks.Count > 0) then + Container.PageNumber := Container.PageLinks.Count; + if Container.PageLinks.Count > 0 then begin Flag := CS_DOWNLOAD; - container.WorkCounter := 0; - container.DownCounter := 0; - container.DownloadInfo.iProgress := 0; - container.DownloadInfo.Progress := - Format('%d/%d', [container.DownCounter, container.PageNumber]); - container.Status := STATUS_DOWNLOAD; - container.DownloadInfo.Status := - Format('%s (%d/%d) [%s]', - [RS_Downloading, - container.CurrentDownloadChapterPtr + 1, - container.ChapterLinks.Count, - container.ChapterName.Strings[container.CurrentDownloadChapterPtr]]); - while container.WorkCounter < container.PageLinks.Count do + Container.WorkCounter := 0; + Container.DownCounter := 0; + Container.DownloadInfo.iProgress := 0; + Container.DownloadInfo.Progress := + Format('%d/%d', [Container.DownCounter, Container.PageNumber]); + Container.Status := STATUS_DOWNLOAD; + Container.DownloadInfo.Status := + Format('[%d/%d] %s (%s)', + [Container.CurrentDownloadChapterPtr + 1, + Container.ChapterLinks.Count, + RS_Downloading, + Container.ChapterName[Container.CurrentDownloadChapterPtr]]); + while Container.WorkCounter < Container.PageLinks.Count do begin if Terminated then Exit; Checkout; - container.DownloadInfo.iProgress := - InterLockedIncrement(container.DownloadInfo.iProgress); + Container.DownloadInfo.iProgress := + InterLockedIncrement(Container.DownloadInfo.iProgress); end; WaitForThreads; if Terminated then Exit; @@ -1557,768 +1005,617 @@ procedure TTaskThread.Execute; //check if all page is downloaded if CheckForFinish then begin - container.Status := STATUS_COMPRESS; - container.DownloadInfo.Progress := ''; - Compress; + Container.Status := STATUS_COMPRESS; + Container.DownloadInfo.Progress := ''; + if not Compress then + Container.Status := STATUS_FAILED; end else - container.Status := STATUS_FAILED; + begin + Container.Status := STATUS_FAILED; + Logger.SendWarningStrings(Format('%s, download failed. "%s" "%s" "%s"', + [Self.ClassName, + Container.DownloadInfo.Title, + Container.ChapterName[Container.CurrentDownloadChapterPtr], + Container.ChapterLinks[Container.CurrentDownloadChapterPtr] + ]), Container.PageLinks.Text); + end; end else - container.Status := STATUS_FAILED; - - if (container.Status = STATUS_FAILED) and - (not FindStrLinear(container.FailedChapterLinks, - container.ChapterName[container.CurrentDownloadChapterPtr])) then begin - container.FailedChapterName.Add(container.ChapterName[container.CurrentDownloadChapterPtr]); - container.FailedChapterLinks.Add(container.ChapterLinks[container.CurrentDownloadChapterPtr]); + Container.Status := STATUS_FAILED; + Logger.SendWarning(Format('%s, pagelinks is empty. "%s" "%s" "%s"', + [Self.ClassName, + Container.DownloadInfo.Title, + Container.ChapterName[Container.CurrentDownloadChapterPtr], + Container.ChapterLinks[Container.CurrentDownloadChapterPtr] + ])); end; - container.CurrentPageNumber := 0; - container.PageLinks.Clear; - container.PageContainerLinks.Clear; - container.CurrentDownloadChapterPtr := - InterLockedIncrement(container.CurrentDownloadChapterPtr); + if Container.Status = STATUS_FAILED then + Container.ChaptersStatus[Container.CurrentDownloadChapterPtr] := 'F' + else + Container.ChaptersStatus[Container.CurrentDownloadChapterPtr] := 'D'; + + Container.CurrentPageNumber := 0; + Container.PageLinks.Clear; + Container.PageContainerLinks.Clear; + Container.CurrentDownloadChapterPtr := + InterLockedIncrement(Container.CurrentDownloadChapterPtr); + + if (Container.CurrentDownloadChapterPtr = Container.ChapterLinks.Count) and + (FailedRetryCount < OptionRetryFailedTask) then + begin + Container.CurrentDownloadChapterPtr := FirstFailedChapters; + if container.CurrentDownloadChapterPtr <> -1 then + Inc(FailedRetryCount) + else + Container.CurrentDownloadChapterPtr := Container.ChapterLinks.Count; + end; end; - if container.FailedChapterLinks.Count > 0 then + if FailedChaptersExist then begin - container.Status := STATUS_FAILED; - container.DownloadInfo.Status := RS_FailedTryResumeTask; - container.DownloadInfo.Progress := ''; - container.CurrentDownloadChapterPtr := 0; - - container.ChapterName.Assign(container.FailedChapterName); - container.ChapterLinks.Assign(container.FailedChapterLinks); - container.FailedChapterName.Clear; - container.FailedChapterLinks.Clear; + Container.Status := STATUS_FAILED; + Container.DownloadInfo.Status := Format('[%d/%d] %s', [ + Container.CurrentDownloadChapterPtr, + Container.ChapterLinks.Count, + RS_FailedTryResumeTask]); + Container.DownloadInfo.Progress := ''; + Container.CurrentDownloadChapterPtr := 0; end else begin - container.Status := STATUS_FINISH; - container.DownloadInfo.Status := RS_Finish; - container.DownloadInfo.Progress := ''; + Container.Status := STATUS_FINISH; + Container.DownloadInfo.Status := Format('[%d/%d] %s',[Container.ChapterLinks.Count,Container.ChapterLinks.Count,RS_Finish]); + Container.DownloadInfo.Progress := ''; end; - Synchronize(ShowBaloon); + ShowBalloonHint; except on E: Exception do + begin + E.Message := E.Message + LineEnding + ' In TTaskThread.Execute' + LineEnding + GetExceptionInfo; MainForm.ExceptionHandler(Self, E); + end; end; end; -procedure TTaskThread.DoTerminate; -var - i: Integer; +{ TTaskContainer } + +procedure TTaskContainer.SetWebsite(AValue: String); begin - if threads.Count > 0 then - begin - CS_threads.Acquire; - try - for i := 0 to threads.Count - 1 do - TDownloadThread(threads[i]).Terminate; - finally - CS_threads.Release; - end; - while threads.Count > 0 do - Sleep(100); - end; - Stop; - container.DownloadInfo.TransferRate := ''; - container.ThreadState := False; - inherited DoTerminate; + if FWebsite = AValue then Exit; + FWebsite := AValue; + DownloadInfo.Website := AValue; + ModuleId := Modules.LocateModule(AValue); end; -procedure TTaskThread.Stop(const check: Boolean = True); +procedure TTaskContainer.SetStatus(AValue: TDownloadStatusType); begin - if container.Status = STATUS_STOP then - Exit; - if check and not (container.Manager.isReadyForExit) then - begin - if (container.WorkCounter >= container.PageLinks.Count) and - (container.CurrentDownloadChapterPtr >= container.ChapterLinks.Count) - and (container.FailedChapterLinks.Count = 0) then - begin - container.Status := STATUS_FINISH; - container.DownloadInfo.Status := RS_Finish; - container.DownloadInfo.Progress := ''; - container.Manager.CheckAndActiveTask(True, Self); - end - else - if (container.Status in [STATUS_PROBLEM, STATUS_FAILED]) then - container.Manager.CheckAndActiveTask(True, Self) - else - begin - container.Status := STATUS_STOP; - container.DownloadInfo.Status := - Format('%s (%d/%d)', [RS_Stopped, container.CurrentDownloadChapterPtr + - 1, container.ChapterLinks.Count]); - container.Manager.CheckAndActiveTask(False, Self); - end; - end; + if FStatus = AValue then Exit; + if Assigned(Manager) then + Manager.ChangeStatusCount(FStatus, AValue); + FStatus := AValue; end; -{ TTaskContainer } - -procedure TTaskContainer.IncReadCount(const ACount: Integer); +procedure TTaskContainer.SetEnabled(AValue: Boolean); begin - CS_FReadCount.Acquire; - try - Inc(FReadCount, ACount); - finally - CS_FReadCount.Release; + if FEnabled = AValue then Exit; + FEnabled := AValue; + if Assigned(Manager) then + begin + if Enabled then + Dec(Manager.DisabledCount) + else + Inc(Manager.DisabledCount); end; end; constructor TTaskContainer.Create; begin inherited Create; + DlId := -1; + InitCriticalSection(CS_Container); ThreadState := False; - CS_FReadCount := TCriticalSection.Create; ChapterLinks := TStringList.Create; ChapterName := TStringList.Create; - FailedChapterName := TStringList.Create; - FailedChapterLinks := TStringList.Create; + ChaptersStatus := TStringList.Create; PageLinks := TStringList.Create; PageContainerLinks := TStringList.Create; - FReadCount := 0; + FileNames := TStringList.Create; + FWebsite := ''; + ModuleId := -1; + ReadCount := 0; WorkCounter := 0; CurrentPageNumber := 0; CurrentDownloadChapterPtr := 0; + CustomFileName := OptionFilenameCustomRename; + FStatus := STATUS_NONE; + FEnabled := True; + Visible := True; end; destructor TTaskContainer.Destroy; begin + FileNames.Free; PageContainerLinks.Free; PageLinks.Free; ChapterName.Free; ChapterLinks.Free; - FailedChapterName.Free; - FailedChapterLinks.Free; - CS_FReadCount.Free; + ChaptersStatus.Free; + DoneCriticalsection(CS_Container); + if Assigned(Manager) then + Manager.DecStatusCount(Status); inherited Destroy; end; -{ TDownloadManager } - -function TDownloadManager.GetTaskCount: Integer; +procedure TTaskContainer.IncReadCount(const ACount: Integer); begin - Result := Containers.Count; + EnterCriticalSection(CS_Container); + try + Inc(ReadCount, ACount); + finally + LeaveCriticalSection(CS_Container); + end; end; -function TDownloadManager.GetTransferRate: Integer; +procedure TTaskContainer.SaveToDB(const AOrder: Integer); var i: Integer; begin - Result := 0; - if Containers.Count > 0 then - begin - CS_DownloadManager_Task.Acquire; - try - FTotalReadCount := 0; - for i := 0 to Containers.Count - 1 do - with TTaskContainer(Containers[i]) do - if ThreadState then - begin - CS_FReadCount.Acquire; - try - if Status = STATUS_COMPRESS then - DownloadInfo.TransferRate := '' - else - begin - DownloadInfo.TransferRate := FormatByteSize(FReadCount, True); - Inc(FTotalReadCount, FReadCount); - end; - FReadCount := 0; - finally - CS_FReadCount.Release; - end; - end; - Result := FTotalReadCount; - finally - CS_DownloadManager_Task.Release; - end; - end; + if AOrder = -1 then + i := Manager.Items.IndexOf(Self) + else + i := AOrder; + Manager.FDownloadsDB.Add(DlId, + FEnabled, + i, + Integer(Status), + CurrentDownloadChapterPtr, + PageNumber, + CurrentPageNumber, + Website, + DownloadInfo.Link, + DownloadInfo.Title, + DownloadInfo.Status, + DownloadInfo.Progress, + DownloadInfo.SaveTo, + DownloadInfo.DateTime, + ChapterLinks.Text, + ChapterName.Text, + PageLinks.Text, + PageContainerLinks.Text, + FileNames.Text, + CustomFileName, + ChaptersStatus.Text); end; -constructor TDownloadManager.Create; -begin - inherited Create; - CS_DownloadManager_Task := TCriticalSection.Create; - CS_DownloadedChapterList := TCriticalSection.Create; - - DownloadManagerFile := TIniFile.Create(WORK_FOLDER + WORK_FILE); - DownloadManagerFile.CacheUpdates := True; - - DownloadedChaptersListFile := TStringList.Create; - - if FileExists(WORK_FOLDER + DOWNLOADEDCHAPTERS_FILE) then - DownloadedChaptersListFile.LoadFromFile(WORK_FOLDER + DOWNLOADEDCHAPTERS_FILE); +{ TDownloadManager } - Containers := TFPList.Create; - isFinishTaskAccessed := False; - isRunningBackup := False; - isRunningBackupDownloadedChaptersList := False; - isReadyForExit := False; - FisDlgCounter := False; +procedure TDownloadManager.AddItemsActiveTask(const Item: TTaskContainer); +begin + EnterCriticalsection(CS_ItemsActiveTask); + try + ItemsActiveTask.Add(Item); + finally + LeaveCriticalsection(CS_ItemsActiveTask); + end; end; -destructor TDownloadManager.Destroy; +procedure TDownloadManager.RemoveItemsActiveTask(const Item: TTaskContainer); begin - CS_DownloadManager_Task.Acquire; + EnterCriticalsection(CS_ItemsActiveTask); try - while Containers.Count > 0 do - begin - TTaskContainer(Containers.Last).Free; - Containers.Remove(Containers.Last); - end; + ItemsActiveTask.Remove(Item); finally - CS_DownloadManager_Task.Release; + LeaveCriticalsection(CS_ItemsActiveTask); end; - FreeAndNil(Containers); - FreeAndNil(DownloadedChaptersListFile); - FreeAndNil(DownloadManagerFile); - CS_DownloadedChapterList.Free; - CS_DownloadManager_Task.Free; - inherited Destroy; end; -function TDownloadManager.TaskItem(const Index: Integer): TTaskContainer; +function TDownloadManager.GetTask(const TaskId: Integer): TTaskContainer; begin - if (Index < 0) or (Containers.Count < 0) then - Exit(nil); - Result := TTaskContainer(Containers[Index]); + Result := Items[TaskId]; end; -procedure TDownloadManager.BackupDownloadedChaptersList; +function TDownloadManager.GetTaskCount: Integer; begin - if CS_DownloadedChapterList.TryEnter then - begin - CS_DownloadedChapterList.Acquire; - try - DownloadedChaptersListFile.SaveToFile(WORK_FOLDER + DOWNLOADEDCHAPTERS_FILE); - finally - CS_DownloadedChapterList.Release; - end; - end; + Result := Items.Count; end; -procedure TDownloadManager.Restore; +function TDownloadManager.GetTransferRate: Integer; var - tid, s: String; - tmp, i, j: Integer; + i: Integer; begin - CS_DownloadManager_Task.Acquire; + Result := 0; + if ItemsActiveTask.Count = 0 then Exit; + EnterCriticalSection(CS_ItemsActiveTask); try - while Containers.Count > 0 do - begin - TTaskContainer(Containers.Last).Free; - Containers.Remove(Containers.Last); - end; - - tmp := DownloadManagerFile.ReadInteger('general', 'NumberOfTasks', 0); - if tmp = 0 then - Exit; - for i := 0 to tmp - 1 do - begin - // Restore chapter links, chapter name and page links - Containers.Add(TTaskContainer.Create); - with DownloadManagerFile, TTaskContainer(Containers.Last) do begin - tid := 'task' + IntToStr(i); - Manager := Self; - DownloadInfo.Website := ReadString(tid, 'Website', 'NULL'); - DownloadInfo.Link := ReadString(tid, 'Link', ''); - DownloadInfo.Title := ReadString(tid, 'Title', 'NULL'); - DownloadInfo.SaveTo := CorrectPathSys(ReadString(tid, 'SaveTo', 'NULL')); - DownloadInfo.Status := ReadString(tid, 'Status', 'NULL'); - DownloadInfo.Progress := ReadString(tid, 'Progress', 'NULL'); - s := ReadString(tid, 'ChapterLinks', ''); - if s <> '' then GetParams(ChapterLinks, s); - s := ReadString(tid, 'ChapterName', ''); - if s <> '' then GetParams(ChapterName, s); - s := ReadString(tid, 'FailedChapterLinks', ''); - if s <> '' then GetParams(FailedChapterLinks, s); - s := ReadString(tid, 'FailedChapterName', ''); - if s <> '' then GetParams(FailedChapterName, s); - s := ReadString(tid, 'PageLinks', ''); - if s <> '' then GetParams(PageLinks, s); - s := ReadString(tid, 'PageContainerLinks', ''); - if s <> '' then GetParams(PageContainerLinks, s); //deprecated, for old config - j := ReadInteger(tid, 'TaskStatus', -1); - if j >= 0 then - Status := TDownloadStatusType(j) - else - begin - s := ReadString(tid, 'TaskStatus', 'STATUS_STOP'); - Status := TDownloadStatusType(GetEnumValue(TypeInfo(TDownloadStatusType), s)); - if Status = STATUS_COMPRESS then - Status := STATUS_WAIT; - end; - CurrentDownloadChapterPtr := ReadInteger(tid, 'ChapterPtr', 0); - PageNumber := ReadInteger(tid, 'NumberOfPages', 0); - CurrentPageNumber := ReadInteger(tid, 'CurrentPage', 0); - if Status = STATUS_COMPRESS then - DownloadInfo.Status := RS_Waiting; - s := ReadString(tid, 'DateTime', ''); - //for old config - if (Pos('/', s) > 0) or (Pos('\', s) > 0) then - DownloadInfo.dateTime := StrToDateDef(s, Now) - else - begin - s := StringReplace(s, ',', FMDFormatSettings.DecimalSeparator, [rfReplaceAll]); - s := StringReplace(s, '.', FMDFormatSettings.DecimalSeparator, [rfReplaceAll]); - DownloadInfo.dateTime := StrToFloatDef(s, Now, FMDFormatSettings); + for i := 0 to ItemsActiveTask.Count - 1 do + with ItemsActiveTask[i] do + begin + EnterCriticalSection(CS_Container); + try + DownloadInfo.TransferRate := FormatByteSize(ReadCount, True); + Inc(Result, ReadCount); + ReadCount := 0; + finally + LeaveCriticalSection(CS_Container); end; - if DownloadInfo.dateTime > Now then DownloadInfo.dateTime := Now; - - MangaSiteID := GetMangaSiteID(DownloadInfo.website); - ThreadState := False; - - //validating - if (CurrentDownloadChapterPtr > 0) and (CurrentDownloadChapterPtr >= ChapterLinks.Count) then - CurrentDownloadChapterPtr := ChapterLinks.Count - 1; end; - end; finally - CS_DownloadManager_Task.Release; + LeaveCriticalSection(CS_ItemsActiveTask); + end; +end; + +procedure TDownloadManager.ChangeStatusCount(const OldStatus, + NewStatus: TDownloadStatusType); +begin + EnterCriticalsection(CS_StatusCount); + try + if OldStatus = NewStatus then Exit; + if StatusCount[OldStatus] > 0 then + Dec(StatusCount[OldStatus]); + Inc(StatusCount[NewStatus]); + finally + LeaveCriticalsection(CS_StatusCount); end; end; -procedure TDownloadManager.Backup; -var - i: Integer; - tid: String; +procedure TDownloadManager.DecStatusCount(const Status: TDownloadStatusType); begin - if isRunningBackup then - Exit; + EnterCriticalsection(CS_StatusCount); + try + if StatusCount[Status] > 0 then + Dec(StatusCount[Status]); + finally + LeaveCriticalsection(CS_StatusCount); + end; +end; - CS_DownloadManager_Task.Acquire; - isRunningBackup := True; +procedure TDownloadManager.IncStatusCount(const Status: TDownloadStatusType); +begin + EnterCriticalsection(CS_StatusCount); try - DownloadManagerFile.CacheUpdates := True; - // Erase all sections - for i := 0 to DownloadManagerFile.ReadInteger('general', 'NumberOfTasks', 0) do - DownloadManagerFile.EraseSection('task' + IntToStr(i)); - DownloadManagerFile.EraseSection('general'); - - // backup - if Containers.Count > 0 then - begin - DownloadManagerFile.WriteInteger('general', 'NumberOfTasks', Containers.Count); - for i := 0 to Containers.Count - 1 do - begin - tid := 'task' + IntToStr(i); - with DownloadManagerFile, TTaskContainer(TaskItem(i)) do begin - WriteString(tid, 'Website', DownloadInfo.Website); - WriteString(tid, 'Link', DownloadInfo.Link); - WriteString(tid, 'Title', DownloadInfo.Title); - WriteString(tid, 'SaveTo', DownloadInfo.SaveTo); - WriteString(tid, 'Status', DownloadInfo.Status); - WriteString(tid, 'Progress', DownloadInfo.Progress); - WriteString(tid, 'DateTime', FloatToStr(DownloadInfo.dateTime, FMDFormatSettings)); - WriteString(tid, 'ChapterLinks', SetParams(ChapterLinks)); - WriteString(tid, 'ChapterName', SetParams(ChapterName)); - if FailedChapterLinks.Count > 0 then - WriteString(tid, 'FailedChapterLinks', SetParams(FailedChapterLinks)); - if FailedChapterName.Count > 0 then - WriteString(tid, 'FailedChapterName', SetParams(FailedChapterName)); - if PageLinks.Count > 0 then - WriteString(tid, 'PageLinks', SetParams(PageLinks)); - if PageContainerLinks.Count > 0 then - WriteString(tid, 'PageContainerLinks', SetParams(PageContainerLinks)); - WriteString(tid, 'TaskStatus', GetEnumName(TypeInfo(TDownloadStatusType), integer(Status))); - WriteInteger(tid, 'ChapterPtr', CurrentDownloadChapterPtr); - WriteInteger(tid, 'NumberOfPages', PageNumber); - WriteInteger(tid, 'CurrentPage', CurrentPageNumber); - end; - end; - end; - DownloadManagerFile.UpdateFile; + Inc(StatusCount[Status]); finally - isRunningBackup := False; - CS_DownloadManager_Task.Release; + LeaveCriticalsection(CS_StatusCount); end; end; -procedure TDownloadManager.ClearTransferRate; +constructor TDownloadManager.Create; var - i: Integer; + ds: TDownloadStatusType; +begin + inherited Create; + InitCriticalSection(CS_Task); + InitCriticalSection(CS_ItemsActiveTask); + ForceDirectoriesUTF8(WORK_FOLDER); + DownloadedChapters := TDownloadedChaptersDB.Create; + DownloadedChapters.Filename := DOWNLOADEDCHAPTERSDB_FILE; + DownloadedChapters.OnError := @MainForm.ExceptionHandler; + DownloadedChapters.Open; + if FileExistsUTF8(DOWNLOADEDCHAPTERS_FILE) then + if DownloadedChapters.ImportFromIni(DOWNLOADEDCHAPTERS_FILE) then + DeleteFileUTF8(DOWNLOADEDCHAPTERS_FILE); + + Items := TTaskContainers.Create; + ItemsActiveTask := TTaskContainers.Create; + isFinishTaskAccessed := False; + isRunningBackup := False; + isRunningBackupDownloadedChaptersList := False; + isReadyForExit := False; + + InitCriticalSection(CS_StatusCount); + for ds := Low(StatusCount) to High(StatusCount) do + StatusCount[ds] := 0; + DisabledCount := 0; + FDownloadsDB := TDownloadsDB.Create(WORK_FILEDB); + FDownloadsDB.Open; +end; + +destructor TDownloadManager.Destroy; begin - if Containers.Count > 0 then + while Items.Count > 0 do begin - CS_DownloadManager_Task.Acquire; - try - FTotalReadCount := 0; - for i := 0 to Containers.Count - 1 do - with TTaskContainer(Containers[i]) do - begin - CS_FReadCount.Acquire; - try - FReadCount := 0; - DownloadInfo.TransferRate := ''; - finally - CS_FReadCount.Release; - end; - end; - finally - CS_DownloadManager_Task.Release; - end; + Items.Last.Free; + Items.Remove(Items.Last); end; + Items.Free; + ItemsActiveTask.Free; + DownloadedChapters.Free; + FDownloadsDB.Free; + DoneCriticalsection(CS_ItemsActiveTask); + DoneCriticalsection(CS_Task); + DoneCriticalsection(CS_StatusCount); + inherited Destroy; end; -procedure TDownloadManager.AddToDownloadedChaptersList(const ALink, AValue: String); +function TDownloadManager.ConvertToDB: Boolean; var - st: TStringList; + i, d: Integer; + s: String; begin - if (ALink <> '') and (AValue <> '') then - begin - st := TStringList.Create; - try - GetParams(st, AValue); - AddToDownloadedChaptersList(ALink, st); - finally - St.Free; + Result := False; + if not FileExistsUTF8(WORK_FILE) then Exit; + with TIniFile.Create(WORK_FILE) do + try + i := ReadInteger('general', 'NumberOfTasks', 0); + if i = 0 then Exit; + for i := 0 to i - 1 do + begin + d := -1; + s := 'task' + IntToStr(i); + FDownloadsDB.Add(d, + ReadBool(s, 'Enabled', True), + i, + GetEnumValue(TypeInfo(TDownloadStatusType), ReadString(s, 'TaskStatus', GetEnumName(TypeInfo(TDownloadStatusType), 0))), + ReadInteger(s, 'ChapterPtr', 0), + ReadInteger(s, 'NumberOfPages', 0), + ReadInteger(s, 'CurrentPage', 0), + ReadString(s, 'Website', ''), + RemoveHostFromURL(ReadString(s, 'Link', '')), + ReadString(s, 'Title', ''), + ReadString(s, 'Status', ''), + ReadString(s, 'Progress', ''), + ReadString(s, 'SaveTo', ''), + StrToFloatDef(ReadString(s, 'DateTime', ''), Now, FMDFormatSettings), + GetParams(ReadString(s, 'ChapterLinks', '') + ReadString(s, 'FailedChapterLinks', '')), + GetParams(ReadString(s, 'ChapterName', '') + ReadString(s, 'FailedChapterName', '')), + GetParams(ReadString(s, 'PageLinks', '')), + GetParams(ReadString(s, 'PageContainerLinks', '')), + GetParams(ReadString(s, 'Filenames', '')), + ReadString(s, 'CustomFileName', DEFAULT_FILENAME_CUSTOMRENAME), + ''); end; + FDownloadsDB.Commit; + Result := True; + finally + Free; end; + if Result then + Result := DeleteFileUTF8(WORK_FILE); end; -procedure TDownloadManager.AddToDownloadedChaptersList(const Alink: String; - AValue: TStrings); -var - i, p, q: Integer; - Ch, dlCh: TStringList; +procedure TDownloadManager.Restore; begin - if (Alink <> '') and (AValue.Count > 0) then - begin - CS_DownloadedChapterList.Acquire; - Ch := TStringList.Create; - dlCh := TStringList.Create; - try - p := -1; - //locate the link - if DownloadedChaptersListFile.Count > 1 then - for i := 0 to DownloadedChaptersListFile.Count - 1 do - if SameText(Alink, DownloadedChaptersListFile[i]) then + if not FDownloadsDB.Connection.Connected then Exit; + ConvertToDB; + if FDownloadsDB.OpenTable(False) then + try + if FDownloadsDB.RecordCount = 0 then Exit; + EnterCriticalsection(CS_Task); + try + FDownloadsDB.Table.First; + while not FDownloadsDB.Table.EOF do + begin + Items.Add(TTaskContainer.Create); + with Items.Last, FDownloadsDB.Table do begin - p := i; - if i + 1 < DownloadedChaptersListFile.Count then - GetParams(dlCh, DownloadedChaptersListFile[i + 1]); - Break; + Manager := Self; + DlId := Fields[f_dlid].AsInteger; + Enabled := Fields[f_enabled].AsBoolean; + Status := TDownloadStatusType(Fields[f_taskstatus].AsInteger); + CurrentDownloadChapterPtr := Fields[f_chapterptr].AsInteger; + PageNumber := Fields[f_numberofpages].AsInteger; + CurrentPageNumber := Fields[f_currentpage].AsInteger; + Website := Fields[f_website].AsString; + DownloadInfo.Website := Website; + DownloadInfo.Link := Fields[f_link].AsString; + DownloadInfo.Title := Fields[f_title].AsString; + DownloadInfo.Status := Fields[f_status].AsString; + DownloadInfo.Progress := Fields[f_progress].AsString; + if Pos('/', DownloadInfo.Progress) <> 0 then + DownCounter := StrToIntDef(Trim(ExtractWord(1, DownloadInfo.Progress, ['/'])), 0); + DownloadInfo.SaveTo := Fields[f_saveto].AsString; + DownloadInfo.DateTime := Fields[f_datetime].AsDateTime; + ChapterLinks.Text := Fields[f_chapterslinks].AsString; + ChapterName.Text := Fields[f_chaptersnames].AsString; + PageLinks.Text := Fields[f_pagelinks].AsString; + PageContainerLinks.Text := Fields[f_pagecontainerlinks].AsString; + FileNames.Text := Fields[f_filenames].AsString; + CustomFileName := Fields[f_customfilenames].AsString; + ChaptersStatus.Text := Fields[f_chaptersstatus].AsString; end; - - //remove if links found on downloadedchapterlist - Ch.Assign(AValue); - if dlCh.Count > 0 then - begin - dlCh.Sort; - i := 0; - while i < Ch.Count do - begin - if dlCh.Find(Ch[i], q) then - Ch.Delete(i) - else - Inc(i); + FDownloadsDB.Table.Next; end; - end; - - //merge the links - if p > -1 then - begin - if p + 1 < DownloadedChaptersListFile.Count then - DownloadedChaptersListFile[p + 1] := DownloadedChaptersListFile[p + 1] + SetParams(Ch) - else - DownloadedChaptersListFile.Add(SetParams(Ch)); - end - else - begin - //if it's new data - DownloadedChaptersListFile.Add(Alink); - DownloadedChaptersListFile.Add(SetParams(Ch)); + finally + LeaveCriticalsection(CS_Task); end; finally - dlCh.Free; - Ch.Free; - CS_DownloadedChapterList.Release; + FDownloadsDB.CloseTable; end; +end; + +procedure TDownloadManager.Backup; +var + i: Integer; +begin + if isRunningBackup then Exit; + if Items.Count = 0 then Exit; + if not FDownloadsDB.Connection.Connected then Exit; + try + EnterCriticalSection(CS_Task); + isRunningBackup := True; + for i := 0 to Items.Count - 1 do + Items[i].SaveToDB(i); + FDownloadsDB.Commit; + finally + LeaveCriticalSection(CS_Task); end; + isRunningBackup := False; end; procedure TDownloadManager.GetDownloadedChaptersState(const Alink: String; var Chapters: array of TChapterStateItem); var - dlCh : TStringList; - i, p, q: Integer; + s: TStringList; + i, p: Integer; begin - if (Alink <> '') and (Length(Chapters) > 0) and - (DownloadedChaptersListFile.Count > 0) then - begin - CS_DownloadedChapterList.Acquire; - try - p := -1; - //locate the link - for i := 0 to DownloadedChaptersListFile.Count - 1 do - if SameText(Alink, DownloadedChaptersListFile[i]) then - begin - if i + 1 < DownloadedChaptersListFile.Count then - if DownloadedChaptersListFile[i + 1] <> '' then - p := i + 1; - Break; - end; - - //compare the content - if p > -1 then - begin - dlCh := TStringList.Create; - try - GetParams(dlCh, DownloadedChaptersListFile[p]); - if dlCh.Count > 0 then - begin - dlCh.Sort; - for i := Low(Chapters) to High(Chapters) do - Chapters[i].Downloaded := dlCh.Find(Chapters[i].Link, q); - end; - finally - dlCh.Free; - end; - end - else - begin - for i := Low(Chapters) to High(Chapters) do - Chapters[i].Downloaded := False; - end; - finally - CS_DownloadedChapterList.Release; - end; + s := TStringList.Create; + try + s.Sorted := True; + s.AddText(DownloadedChapters.Chapters[Alink]); + if s.Count > 0 then + for i := Low(Chapters) to High(Chapters) do + Chapters[i].Downloaded := s.Find(LowerCase(Chapters[i].Link), p) + else + for i := Low(Chapters) to High(Chapters) do + Chapters[i].Downloaded := False; + finally + s.Free; end; end; -function TDownloadManager.AddTask : Integer; +function TDownloadManager.AddTask: Integer; begin Result := -1; - CS_DownloadManager_Task.Acquire; + EnterCriticalSection(CS_Task); try - Result := Containers.Add(TTaskContainer.Create); - TTaskContainer(Containers.Last).Manager := Self; + Result := Items.Add(TTaskContainer.Create); + with Items[Result] do + begin + Manager := Self; + Status := STATUS_STOP; + end; finally - CS_DownloadManager_Task.Release; + LeaveCriticalSection(CS_Task); end; end; -procedure TDownloadManager.CheckAndActiveTask(const isCheckForFMDDo : Boolean; - SenderThread : TThread); +procedure TDownloadManager.CheckAndActiveTask(const isCheckForFMDDo: Boolean); var - EHENTAI_Count: Cardinal = 0; - Count: Cardinal = 0; - i: Integer; - - procedure ShowExitCounter; - begin - if OptionLetFMDDo in [DO_NOTHING, DO_UPDATE] then Exit; - Self.Backup; - if ThreadID <> MainThreadID then - begin - {$IF FPC_FULLVERSION >= 20701} - TThread.Synchronize(TThread.CurrentThread, doExitWaitCounter); - {$ELSE} - if SenderThread <> nil then - TThread.Synchronize(SenderThread, doExitWaitCounter); - {$ENDIF} - end - else - doExitWaitCounter; - end; - + i, tcount: Integer; begin - if Containers.Count = 0 then - Exit; - CS_DownloadManager_Task.Acquire; + if Items.Count = 0 then Exit; + EnterCriticalSection(CS_Task); try - try - for i := 0 to Containers.Count - 1 do - begin - if (TaskItem(i).Status in [STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_COMPRESS]) then - begin - Inc(Count); - if TaskItem(i).MangaSiteID = EHENTAI_ID then - Inc(EHENTAI_Count); - end; - end; - - if Count < maxDLTasks then - begin - for i := 0 to Containers.Count - 1 do - begin - if Count >= maxDLTasks then - Break; - if (TaskItem(i).Status = STATUS_WAIT) then + tcount := 0; + for i := 0 to Items.Count - 1 do + if Items[i].ThreadState then + Inc(tcount); + + if tcount < OptionMaxParallel then + for i := 0 to Items.Count - 1 do + with Items[i] do + if (ModuleId<>-1) and + (tcount < OptionMaxParallel) and + (Status = STATUS_WAIT) and + Modules.CanCreateTask(ModuleId) then begin - if (TaskItem(i).MangaSiteID = EHENTAI_ID) and - (EHENTAI_Count < EHENTAI_maxDLTask) then - begin - Inc(EHENTAI_Count); - Inc(Count); - ActiveTask(i); - end - else - begin - ActiveTask(i); - Inc(Count); - end; + ActiveTask(i); + Inc(tcount); end; - end; - end; + finally + LeaveCriticalSection(CS_Task); + end; - if Count > 0 then - begin - //MainForm.vtDownload.Repaint; - if not MainForm.itRefreshDLInfo.Enabled then - MainForm.itRefreshDLInfo.Enabled := True; - end - else - begin - //MainForm.vtDownload.Repaint; - MainForm.itRefreshDLInfo.Enabled := False; + try + if tcount > 0 then + begin + if not MainForm.tmRefreshDownloadsInfo.Enabled then + MainForm.tmRefreshDownloadsInfo.Enabled := True; + MainForm.UpdateVtDownload; + end + else + begin + MainForm.tmRefreshDownloadsInfo.Enabled := False; + MainForm.UpdateVtDownload; + if isCheckForFMDDo and (OptionLetFMDDo <> DO_NOTHING) then begin + DoAfterFMD := OptionLetFMDDo; + MainForm.DoExitWaitCounter; end; - - if (Count = 0) and (isCheckForFMDDo) then - ShowExitCounter; - MainForm.vtDownloadFilters; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); end; - finally - CS_DownloadManager_Task.Release; + except + on E: Exception do + MainForm.ExceptionHandler(Self, E); end; end; -function TDownloadManager.CanActiveTask(const pos: Integer): Boolean; -var - EHENTAI_Count: Integer = 0; - i: Integer; - Count: Integer = 0; +procedure TDownloadManager.SetTaskActive(const taskID: Integer); begin - Result := True; - - if (Containers.Count = 0) or (pos >= Containers.Count) then - Exit(False); - - for i := 0 to Containers.Count - 1 do - begin - if (TaskItem(i).Status in [STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_COMPRESS]) and - (i <> pos) then + if not Items[taskID].Enabled then Exit; + with Items[taskID] do + if not (ThreadState or (Status in [STATUS_FINISH, STATUS_WAIT])) then begin - Inc(Count); - if (TaskItem(i).MangaSiteID = EHENTAI_ID) then - Inc(EHENTAI_Count); + Status := STATUS_WAIT; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Waiting]); end; - end; - - if (TaskItem(pos).MangaSiteID = EHENTAI_ID) and - (EHENTAI_Count >= EHENTAI_maxDLTask) then - Result := False - else - if Count >= maxDLTasks then - Result := False; end; procedure TDownloadManager.CheckAndActiveTaskAtStartup; - - procedure ActiveTaskAtStartup(const taskID: Integer); - begin - if taskID >= Containers.Count then - Exit; - if (not Assigned(TaskItem(taskID))) then - Exit; - if (TaskItem(taskID).Status = STATUS_WAIT) or - (TaskItem(taskID).Status = STATUS_STOP) or - (TaskItem(taskID).Status = STATUS_FINISH) then - Exit; - TaskItem(taskID).Status := STATUS_DOWNLOAD; - TaskItem(taskID).Thread := TTaskThread.Create; - TaskItem(taskID).Thread.container := TaskItem(taskID); - TaskItem(taskID).Thread.Start; - end; - var - i: Integer; - Count: Integer = 0; + i, tcount: Integer; begin - if Containers.Count = 0 then - Exit; - for i := 0 to Containers.Count - 1 do - begin - if (TaskItem(i).Status = STATUS_DOWNLOAD) or - (TaskItem(i).Status = STATUS_PREPARE) then - begin - if Count < maxDLTasks then - begin - ActiveTaskAtStartup(i); - Inc(Count); - end - else - begin - TaskItem(i).Status := STATUS_WAIT; - TaskItem(i).DownloadInfo.Status := RS_Waiting; - end; - end; - end; - MainForm.vtDownloadFilters; + if Items.Count = 0 then Exit; + tcount := 0; + for i := 0 to Items.Count - 1 do + with Items[i] do + if Status in [STATUS_DOWNLOAD, STATUS_PREPARE] then + if (tcount < OptionMaxParallel) and + Modules.CanCreateTask(ModuleId) then + begin + if ModuleId<>-1 then + begin + Inc(tcount); + ActiveTask(i); + end + else + begin + Status := STATUS_STOP; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Stopped]); + end; + end + else + begin + Status := STATUS_WAIT; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Waiting]); + end; //force to check task if all task loaded is STATUS_WAIT - CheckAndActiveTask; + if tcount = 0 then + CheckAndActiveTask + else if MainForm.tmRefreshDownloadsInfo.Enabled = False then + MainForm.tmRefreshDownloadsInfo.Enabled := True; + MainForm.UpdateVtDownload; end; procedure TDownloadManager.ActiveTask(const taskID: Integer); begin - if taskID < Containers.Count then - begin - if Assigned(TaskItem(taskID)) then + if not Items[taskID].Enabled then Exit; + if Items[taskID].Status = STATUS_FINISH then Exit; + with Items[taskID] do + if not ThreadState then begin - if not((TaskItem(taskID).Status = STATUS_DOWNLOAD) or - (TaskItem(taskID).Status = STATUS_PREPARE) or - (TaskItem(taskID).Status = STATUS_FINISH)) then + if not (Status in [STATUS_DOWNLOAD, STATUS_PREPARE]) then begin - TaskItem(taskID).Status := STATUS_DOWNLOAD; - TaskItem(taskID).DownloadInfo.Status := RS_Downloading; - TaskItem(taskID).Thread := TTaskThread.Create; - TaskItem(taskID).Thread.container := TaskItem(taskID); - TaskItem(taskID).Thread.Start; - MainForm.vtDownload.Repaint; - MainForm.vtDownloadFilters; + Status := STATUS_DOWNLOAD; + DownloadInfo.Status := RS_Downloading; end; + Modules.IncActiveTaskCount(ModuleId); + Task := TTaskThread.Create; + Task.Container := Items[taskID]; + AddItemsActiveTask(Task.Container); + Task.Start; end; - if not MainForm.itRefreshDLInfo.Enabled then - MainForm.itRefreshDLInfo.Enabled := True; - end; end; procedure TDownloadManager.StopTask(const taskID: Integer; const isCheckForActive: Boolean; isWaitFor: Boolean); begin - if taskID < Containers.Count then + with Items[taskID] do begin - if TaskItem(taskID).Status in [STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_WAIT] then + if Status = STATUS_WAIT then begin - isReadyForExit := False; - if TaskItem(taskID).Status = STATUS_WAIT then - begin - TaskItem(taskID).Status := STATUS_STOP; - TaskItem(taskID).DownloadInfo.Status := RS_Stopped; - end; - if TaskItem(taskID).ThreadState then - begin - TaskItem(taskID).Thread.Terminate; - if isWaitFor then - TaskItem(taskID).Thread.WaitFor; - end; - if isCheckForActive then - begin - Backup; - CheckAndActiveTask; - end; - MainForm.vtDownload.Repaint; - MainForm.vtDownloadFilters; + Status := STATUS_STOP; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Stopped]); + end + else if ThreadState then + begin + Task.Terminate; + if isWaitFor then + Task.WaitFor; end; + if isCheckForActive then + CheckAndActiveTask(); end; end; @@ -2326,20 +1623,16 @@ procedure TDownloadManager.StartAllTasks; var i: Integer; begin - if Containers.Count > 0 then + if Items.Count > 0 then begin - for i := 0 to Containers.Count - 1 do - begin - if TaskItem(i).Status in [STATUS_STOP, STATUS_FAILED, STATUS_PROBLEM] then - begin - TaskItem(i).Status := STATUS_WAIT; - TaskItem(i).DownloadInfo.Status := RS_Waiting; - end; - end; - Backup; + for i := 0 to Items.Count - 1 do + with Items[i] do + if Enabled and (Status <> STATUS_FINISH) and (not ThreadState) then + begin + Status := STATUS_WAIT; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Waiting]); + end; CheckAndActiveTask; - MainForm.vtDownload.Repaint; - MainForm.vtDownloadFilters; end; end; @@ -2347,116 +1640,69 @@ procedure TDownloadManager.StopAllTasks; var i: Integer; begin - if Containers.Count > 0 then - begin - isReadyForExit := False; - for i := 0 to Containers.Count - 1 do - begin - if TaskItem(i).Status = STATUS_WAIT then - begin - TaskItem(i).Status := STATUS_STOP; - TaskItem(i).DownloadInfo.Status := RS_Stopped; - end; - if TaskItem(i).ThreadState then - TaskItem(i).Thread.Terminate; - end; - Backup; - MainForm.vtDownload.Repaint; - MainForm.vtDownloadFilters; - end; + if Items.Count = 0 then Exit; + for i := 0 to Items.Count - 1 do + StopTask(i, False, False); end; procedure TDownloadManager.StopAllDownloadTasksForExit; var i: Integer; begin - if Containers.Count > 0 then + if Items.Count > 0 then begin + isReadyForExit := True; try - isReadyForExit := True; - for i := 0 to Containers.Count - 1 do - if TaskItem(i).ThreadState then - TaskItem(i).Thread.Terminate; - for i := 0 to Containers.Count - 1 do - if TaskItem(i).ThreadState then - TaskItem(i).Thread.WaitFor; + for i := 0 to Items.Count - 1 do + with Items[i] do + if ThreadState then + Task.Terminate; + for i := 0 to Items.Count - 1 do + with Items[i] do + if ThreadState then + Task.WaitFor; finally - Backup; + isReadyForExit := False; end; end; end; -procedure TDownloadManager.RemoveTask(const taskID: Integer); +procedure TDownloadManager.FreeAndDelete(const TaskId: Integer); begin - if taskID < Containers.Count then - begin - CS_DownloadManager_Task.Acquire; - try - if TaskItem(taskID).ThreadState then - begin - TaskItem(taskID).Status := STATUS_STOP; - TaskItem(taskID).Thread.Terminate; - TaskItem(taskID).Thread.WaitFor; + FDownloadsDB.Delete(Items[TaskID].DlId); + Items[TaskID].Free; + Items.Delete(taskID); +end; + +procedure TDownloadManager.RemoveTask(const TaskID: Integer); +begin + EnterCriticalSection(CS_Task); + try + with Items[TaskID] do + if ThreadState then begin + Task.Terminate; + Task.WaitFor; end; - TaskItem(taskID).Free; - Containers.Delete(taskID); - finally - CS_DownloadManager_Task.Release; - end; - CheckAndActiveTask; + FreeAndDelete(TaskID); + finally + LeaveCriticalSection(CS_Task); end; + CheckAndActiveTask; end; procedure TDownloadManager.RemoveAllFinishedTasks; var i: Integer; begin - if Containers.Count = 0 then - Exit; - // remove - i := 0; - repeat - if TaskItem(i).Status = STATUS_FINISH then - begin - Containers.Delete(i); - end - else - Inc(i); - until i >= Containers.Count; -end; - -procedure TDownloadManager.doExitWaitCounter; -begin - FisDlgCounter := True; - with TShutdownCounterForm.Create(MainForm) do try - case OptionLetFMDDo of - DO_POWEROFF: - begin - WaitTimeout := 60; - LabelMessage := RS_LblMessageShutdown; - end; - DO_HIBERNATE: - begin - WaitTimeout := 30; - LabelMessage := RS_LblMessageHibernate; - end; - DO_EXIT: - begin - WaitTimeout := 5; - LabelMessage := RS_LblMessageExit; - end; - end; - ExitWaitOK := (ShowModal = mrOK); + if Items.Count = 0 then Exit; + EnterCriticalsection(CS_Task); + try + for i := Items.Count - 1 downto 0 do + if Items[i].Status = STATUS_FINISH then + FreeAndDelete(i); finally - Free; - end; - - if ExitWaitOK then - begin - frmMain.DoAfterFMD := OptionLetFMDDo; - MainForm.itMonitor.Enabled := True; + LeaveCriticalsection(CS_Task); end; - FisDlgCounter := False; end; function TDownloadManager.TaskStatusPresent(Stats: TDownloadStatusTypes): Boolean; @@ -2464,110 +1710,94 @@ function TDownloadManager.TaskStatusPresent(Stats: TDownloadStatusTypes): Boolea i: Integer; begin Result := False; - if Containers.Count > 0 then + if Items.Count > 0 then begin - CS_DownloadManager_Task.Acquire; + EnterCriticalSection(CS_Task); try - for i := 0 to Containers.Count - 1 do - begin - if TaskItem(i).Status in Stats then - begin + for i := 0 to Items.Count - 1 do + if Items[i].Status in Stats then begin Result := True; Break; end; - end; finally - CS_DownloadManager_Task.Release; + LeaveCriticalSection(CS_Task); end; end; end; -procedure TDownloadManager.Sort(const AColumn: Integer); +procedure TDownloadManager.EnableTask(const TaskId: Integer); +begin + If not Items[TaskId].Enabled then + Items[TaskId].Enabled := True; +end; - function GetStr(ARow: Pointer): String; +procedure TDownloadManager.DisableTask(const TaskId: Integer); +begin + with Items[TaskId] do begin - case AColumn of - 0: Result := TTaskContainer(ARow).DownloadInfo.title; - 1: Result := TTaskContainer(ARow).DownloadInfo.Status; - 2: Result := TTaskContainer(ARow).DownloadInfo.Progress; - 3: Result := TTaskContainer(ARow).DownloadInfo.TransferRate; - 4: Result := TTaskContainer(ARow).DownloadInfo.Website; - 5: Result := TTaskContainer(ARow).DownloadInfo.SaveTo; - 6: Result := FloatToStr(TTaskContainer(ARow).DownloadInfo.dateTime, FMDFormatSettings); + if ThreadState then + StopTask(TaskId, False); + if Enabled then + begin + if Status = STATUS_WAIT then + begin + Status := STATUS_STOP; + DownloadInfo.Status := Format('[%d/%d] %s',[CurrentDownloadChapterPtr+1,ChapterLinks.Count,RS_Stopped]); + end; + Enabled := False; end; end; +end; + +function CompareTaskContainer(const Item1, Item2: TTaskContainer): Integer; - function GetAddedDate(ARow: Pointer): TDateTime; + function GetStr(ARow: TTaskContainer): String; begin - Result := TTaskContainer(ARow).DownloadInfo.DateTime; + with ARow.DownloadInfo do + case ARow.Manager.SortColumn of + 0: Result := Title; + 1: Result := Status; + 2: Result := Progress; + 3: Result := TransferRate; + 4: Result := Website; + 5: Result := SaveTo; + else + Result := ''; + end; end; - function Compare(Item1, Item2: Pointer): Integer; - var - ItemT: Pointer; + function GetDateTime(ARow: TTaskContainer): TDateTime; begin - if SortDirection then - begin - ItemT := Item1; - Item1 := Item2; - Item2 := ItemT; - end; - case AColumn of - 6 : Result := CompareDateTime(GetAddedDate(Item1), GetAddedDate(Item2)); - else - Result := NaturalCompareStr(GetStr(Item1), GetStr(Item2)); - end; + Result := ARow.DownloadInfo.DateTime; end; - procedure QSort(FList: TFPList; L, R: Integer); - var - I, J : Longint; - P, Q : Pointer; +begin + if Item1.Manager.SortColumn = 6 then + begin + if Item1.Manager.SortDirection then + Result := CompareDateTime(GetDateTime(Item2), GetDateTime(Item1)) + else + Result := CompareDateTime(GetDateTime(Item1), GetDateTime(Item2)); + end + else begin - repeat - I := L; - J := R; - P := FList[ (L + R) div 2 ]; - repeat - while Compare(P, FList[i]) > 0 do - I := I + 1; - while Compare(P, FList[J]) < 0 do - J := J - 1; - If I <= J then - begin - Q := FList[I]; - Flist[I] := FList[J]; - FList[J] := Q; - I := I + 1; - J := J - 1; - end; - until I > J; - if J - L < R - I then - begin - if L < J then - QSort(FList, L, J); - L := I; - end - else - begin - if I < R then - QSort(FList, I, R); - R := J; - end; - until L >= R; + if Item1.Manager.SortDirection then + Result := NaturalCompareStr(GetStr(Item2), GetStr(Item1)) + else + Result := NaturalCompareStr(GetStr(Item1), GetStr(Item2)); end; +end; +procedure TDownloadManager.Sort(const AColumn: Integer); begin - if Containers.Count < 2 then Exit; - CS_DownloadManager_Task.Acquire; + if Items.Count < 2 then Exit; + EnterCriticalSection(CS_Task); try SortColumn := AColumn; - QSort(Containers, 0, Containers.Count - 1); + Items.Sort(@CompareTaskContainer); finally - CS_DownloadManager_Task.Release; + LeaveCriticalSection(CS_Task); end; - MainForm.vtDownload.Repaint; - MainForm.vtDownloadFilters; end; end. diff --git a/baseunits/uEpub.pas b/baseunits/uEpub.pas new file mode 100644 index 000000000..ddc9376c3 --- /dev/null +++ b/baseunits/uEpub.pas @@ -0,0 +1,326 @@ +unit uEpub; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fgl; + +type + TPage = class; + TPages = specialize TFPGList<TPage>; + TStreams = specialize TFPGList<TStream>; + + { TEpubBuilder } + + TEpubBuilder = class + private + FTitle, FUuid: String; + FMimeType, FContainer, FStyle, FContent, FToc: TStringStream; + FPages: TPages; + function CreateContent: String; + function CreateToc: String; + public + constructor Create; + destructor Destroy; override; + procedure AddImage(const path: String); + procedure SaveToStream(const stream: TStream); + property Title: String read FTitle write FTitle; + end; + + { TPage } + + TPage = class + private + FIndex: Integer; + FImagePath, FPageTitle: String; + FPage: TStringStream; + function GetContentItem: String; + function GetPageId: String; + function GetImageId: String; + function GetImageName: String; + function GetPageName: String; + function GetPageRef: String; + function GetPage: String; + function GetPageStream: TStringStream; + function GetNavPoint: String; + public + constructor Create(const index: Integer; const imagePath, pageTitle: String); + destructor Destroy; override; + property ImagePath: String read FImagePath; + property Index: Integer read FIndex; + property ContentItem: String read GetContentItem; + property PageId: String read GetPageId; + property ImageId: String read GetImageId; + property ImageName: String read GetImageName; + property PageName: String read GetPageName; + property PageRef: String read GetPageRef; + property PageStream: TStringStream read GetPageStream; + property NavPoint: String read GetNavPoint; + end; + +implementation + +uses Zipper, htmlelements, uBaseUnit; + +const + CONTAINER: String = + '<?xml version="1.0" encoding="utf-8"?>' + LineEnding + + '<container version="1.0" xmlns="urn:oasis:names:tc:opendocument:xmlns:container">' + LineEnding + + ' <rootfiles>' + LineEnding + + ' <rootfile full-path="OEBPS/content.opf" media-type="application/oebps-package+xml"/>' + LineEnding + + ' </rootfiles>' + LineEnding + + '</container>' + LineEnding; + + CONTENT: String = + '<?xml version="1.0" encoding="utf-8"?>' + LineEnding + + '<package xmlns="http://www.idpf.org/2007/opf" xmlns:dc="http://purl.org/dc/elements/1.1/" ' + + 'xmlns:opf="http://www.idpf.org/2007/opf" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" ' + + 'xmlns:dcterms="http://purl.org/dc/terms/" unique-identifier="bookid" version="2.0">' + LineEnding + + ' <metadata xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:opf="http://www.idpf.org/2007/opf">' + LineEnding + + ' <dc:title>%s</dc:title>' + LineEnding + + ' <dc:language>und</dc:language>' + LineEnding + + ' <dc:identifier id="bookid" opf:scheme="UUID">urn:uuid:%s</dc:identifier>' + LineEnding + + ' </metadata>' + LineEnding + + ' <manifest>' + LineEnding + + ' <item id="_toc" href="toc.ncx" media-type="application/x-dtbncx+xml"/>' + LineEnding + + ' <item id="_style" href="style.css" media-type="text/css"/>' + LineEnding + + '%s' + LineEnding + + ' </manifest>' + LineEnding + + ' <spine toc="_toc">' + LineEnding + + '%s' + LineEnding + + ' </spine>' + LineEnding + + '</package>'; + + CONTENT_ITEM: String = + ' <item id="%s" href="%s" media-type="%s"/>' + LineEnding; + + CONTENT_ITEMREF: String = + ' <itemref idref="%s"/>' + LineEnding; + + TOC: String = + '<?xml version="1.0" encoding="utf-8"?>' + LineEnding + + '<ncx xmlns="http://www.daisy.org/z3986/2005/ncx/" version="2005-1">' + LineEnding + + ' <head>' + LineEnding + + ' <meta name="dtb:uid" content="urn:uuid:%s"/>' + LineEnding + + ' </head>' + LineEnding + + ' <docTitle>' + LineEnding + + ' <text>%s</text>' + LineEnding + + ' </docTitle>' + LineEnding + + ' <navMap>' + LineEnding + + '%s' + LineEnding + + ' </navMap>' + LineEnding + + '</ncx>' + LineEnding; + + NAV_POINT: String = + ' <navPoint id="toc_%d" playOrder="%d">' + LineEnding + + ' <navLabel>' + LineEnding + + ' <text>Page %d</text>' + LineEnding + + ' </navLabel>' + LineEnding + + ' <content src="%s"/>' + LineEnding + + ' </navPoint>' + LineEnding; + + PAGE: String = + '<?xml version="1.0" encoding="utf-8"?>' + LineEnding + + '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">' + LineEnding + + '<html xmlns="http://www.w3.org/1999/xhtml">' + LineEnding + + '<head>' + LineEnding + + ' <link href="style.css" rel="stylesheet" type="text/css"/>' + LineEnding + + ' <title>%s' + LineEnding + + '' + LineEnding + + '' + LineEnding + + '
' + LineEnding + + '' + LineEnding + + '' + LineEnding; + + STYLE: String = + 'img {' + LineEnding + + ' max-width: 100%;' + LineEnding + + ' max-height: 100%;' + LineEnding + + '}' + LineEnding; + +function NewUUID: String; +var + guid: TGuid; +begin + CreateGUID(guid); + SetLength(Result, 36); + StrLFmt(PChar(Result), 36, '%.8x-%.4x-%.4x-%.2x%.2x-%.2x%.2x%.2x%.2x%.2x%.2x', + [ + Longint(GUID.D1), GUID.D2, GUID.D3, + GUID.D4[0], GUID.D4[1], GUID.D4[2], GUID.D4[3], + GUID.D4[4], GUID.D4[5], GUID.D4[6], GUID.D4[7] + ]); + Result := LowerCase(Result); +end; + +{ TEpubBuilder } + +function TEpubBuilder.CreateContent: String; +var + items: String = ''; + refs: String = ''; + i: Integer; +begin + for i := 0 to FPages.Count-1 do begin + items += FPages[i].ContentItem; + refs += FPages[i].PageRef; + end; + Result := Format(CONTENT, [EscapeHTML(Title), FUuid, items, refs]); +end; + +function TEpubBuilder.CreateToc: String; +var + navPoints: String = ''; + i: Integer; +begin + for i := 0 to FPages.Count-1 do + navPoints += FPages[i].NavPoint; + Result := Format(TOC, [FUuid, Title, navPoints]); +end; + +procedure TEpubBuilder.AddImage(const path: String); +var + index: Integer; + pageTitle: String; +begin + index := FPages.Count + 1; + pageTitle := Format('%s - %.4d', [Title, index]); + FPages.Add(TPage.Create(index, path, pageTitle)); +end; + +procedure TEpubBuilder.SaveToStream(const stream: TStream); +var + zip: TZipper; + i: Integer; + page: TPage; +begin + zip := TZipper.Create; + try + // add mimetype + FMimeType := TStringStream.Create('application/epub+zip'); + zip.Entries.AddFileEntry(FMimeType, 'mimetype'); + + // add META-INF/container.xml + FContainer := TStringStream.Create(CONTAINER); + zip.Entries.AddFileEntry(FContainer, 'META-INF/container.xml'); + + // add css + FStyle := TStringStream.Create(STYLE); + zip.Entries.AddFileEntry(FStyle, 'OEBPS/style.css'); + + for i := 0 to FPages.Count-1 do begin + page := FPages[i]; + // add image file + zip.Entries.AddFileEntry(page.ImagePath, 'OEBPS/images/' + page.ImageName); + // add xhtml file + zip.Entries.AddFileEntry(page.PageStream, 'OEBPS/' + page.PageName); + end; + + // add content.opf + FContent := TStringStream.Create(CreateContent); + zip.Entries.AddFileEntry(FContent, 'OEBPS/content.opf'); + + // add toc.ncx + FToc := TStringStream.Create(CreateToc); + zip.Entries.AddFileEntry(FToc, 'OEBPS/toc.ncx'); + + zip.SaveToStream(stream); + finally + zip.Free; + end; +end; + +constructor TEpubBuilder.Create; +begin + FMimeType := nil; + FContainer := nil; + FStyle := nil; + FContent := nil; + FToc := nil; + FPages := TPages.Create; + FUuid := NewUUID; +end; + +destructor TEpubBuilder.Destroy; +var + i: Integer; +begin + for i := 0 to FPages.Count-1 do + FPages[i].Free; + FreeAndNil(FPages); + FreeAndNil(FMimeType); + FreeAndNil(FContainer); + FreeAndNil(FStyle); + FreeAndNil(FContent); + FreeAndNil(FToc); + inherited; +end; + +{ TPage } + +function TPage.GetContentItem: String; +begin + Result := Format(CONTENT_ITEM, [ImageId, 'images/' + ImageName, GetMimeType(FImagePath)]); + Result += Format(CONTENT_ITEM, [PageId, PageName, 'application/xhtml+xml']); +end; + +function TPage.GetPageId: String; +begin + Result := Format('page%.4d', [FIndex]); +end; + +function TPage.GetImageId: String; +begin + Result := Format('image%.4d', [FIndex]); +end; + +function TPage.GetImageName: String; +begin + Result := Format('%.4d%s', [FIndex, ExtractFileExt(FImagePath)]); +end; + +function TPage.GetPageName: String; +begin + Result := Format('%.4d.xhtml', [FIndex]) +end; + +function TPage.GetPageRef: String; +begin + Result := Format(CONTENT_ITEMREF, [PageId]); +end; + +function TPage.GetPage: String; +begin + Result := Format(PAGE, [EscapeHTML(FPageTitle), 'images/' + ImageName]); +end; + +function TPage.GetPageStream: TStringStream; +begin + if not Assigned(FPage) then + FPage := TStringStream.Create(GetPage); + Result := FPage; +end; + +function TPage.GetNavPoint: String; +begin + Result := Format(NAV_POINT, [FIndex, FIndex, FIndex, PageName]); +end; + +constructor TPage.Create(const index: Integer; const imagePath, pageTitle: String); +begin + FPage := nil; + FIndex := index; + FImagePath := imagePath; + FPageTitle := pageTitle; +end; + +destructor TPage.Destroy; +begin + FreeAndNil(FPage); + inherited Destroy; +end; + +end. + diff --git a/baseunits/uFMDThread.pas b/baseunits/uFMDThread.pas deleted file mode 100644 index 6fe741358..000000000 --- a/baseunits/uFMDThread.pas +++ /dev/null @@ -1,53 +0,0 @@ -{ - File: uFMDThread.pas - License: GPLv2 - This unit is a part of Free Manga Downloader -} - -unit uFMDThread; - -{$mode delphi} - -interface - -uses - Classes, SysUtils, USimpleException; - -type - - { TFMDThread } - - TFMDThread = class(TThread) - protected - function GetTerminated: Boolean; - procedure DoTerminate; override; - public - constructor Create(CreateSuspended: Boolean = True); - property IsTerminated: Boolean read GetTerminated; - end; - -implementation - -function TFMDThread.GetTerminated: Boolean; -begin - Result := Terminated; -end; - -procedure TFMDThread.DoTerminate; -begin - if (FatalException <> nil) and (FatalException is Exception) then - begin - Exception(FatalException).Message := - 'FatalException, ' + Exception(FatalException).Message; - USimpleException.ExceptionHandle(Self, Exception(FatalException)); - end; - inherited DoTerminate; -end; - -constructor TFMDThread.Create(CreateSuspended: Boolean = True); -begin - inherited Create(CreateSuspended); - FreeOnTerminate := True; -end; - -end. diff --git a/baseunits/uFavoritesManager.pas b/baseunits/uFavoritesManager.pas index be923b1b2..623a89b47 100644 --- a/baseunits/uFavoritesManager.pas +++ b/baseunits/uFavoritesManager.pas @@ -11,8 +11,9 @@ interface uses - Classes, SysUtils, Dialogs, IniFiles, syncobjs, lazutf8classes, FileUtil, - uBaseUnit, uData, uDownloadsManager, uFMDThread, uMisc, USimpleLogger; + Classes, SysUtils, fgl, Dialogs, IniFiles, lazutf8classes, LazFileUtils, + uBaseUnit, uData, uDownloadsManager, WebsiteModules, + FMDOptions, httpsendthread, FavoritesDB, BaseThread, SimpleException; type TFavoriteManager = class; @@ -21,72 +22,84 @@ TfavoriteContainer = class; { TFavoriteThread } - TFavoriteThread = class(TFMDThread) + TFavoriteThread = class(TBaseThread) + private + FMangaInformation: TMangaInformation; protected procedure SyncStatus; procedure Execute; override; public - workCounter: Cardinal; - getInfo: TMangaInformation; - task: TFavoriteTask; - container: TfavoriteContainer; + WorkId: Cardinal; + Task: TFavoriteTask; + Container: TfavoriteContainer; constructor Create; destructor Destroy; override; end; + TFavoriteThreads = TFPGList; + { TFavoriteTask } - TFavoriteTask = class(TFMDThread) + TFavoriteTask = class(TBaseThread) private FBtnCaption: String; - statuscheck: Integer; + FPendingCount: Integer; protected - function GetThreadCount: Integer; procedure SyncStartChecking; procedure SyncFinishChecking; procedure SyncUpdateBtnCaption; - procedure SyncShowResult; + procedure Checkout; procedure Execute; override; public - CS_Threads: TCriticalSection; - manager: TFavoriteManager; - threads: TFPList; - procedure PushNewCheck; + CS_Threads: TRTLCriticalSection; + Manager: TFavoriteManager; + Threads: TFavoriteThreads; procedure UpdateBtnCaption(Cap: String); constructor Create; destructor Destroy; override; - property ThreadCount: Integer read GetThreadCount; end; { TFavoriteContainer } - TFavoriteContainer = Class + TFavoriteContainer = class + private + FEnabled: Boolean; + FModuleId: Integer; + FWebsite: String; + procedure SetEnabled(AValue: Boolean); + procedure SetWebsite(AValue: String); public + Tag: Integer; FavoriteInfo: TFavoriteInfo; - MangaInfo: TMangaInfo; NewMangaInfo: TMangaInfo; NewMangaInfoChaptersPos: TCardinalList; Thread: TFavoriteThread; Manager: TFavoriteManager; Status: TFavoriteStatusType; + constructor Create; destructor Destroy; override; + procedure SaveToDB(const AOrder: Integer = -1); + property ModuleId: Integer read FModuleId; + property Website: String read FWebsite write SetWebsite; + property Enabled: Boolean read FEnabled write SetEnabled; end; + TFavoriteContainers = TFPGList; + { TFavoriteManager } TFavoriteManager = class private - CS_Favorites : TCriticalSection; + CS_Favorites: TRTLCriticalSection; + FFavoritesDB: TFavoritesDB; FSortColumn: Integer; - FSortDirection, - FIsAuto, - FIsRunning: Boolean; - FFavorites: TFPList; - protected - function GetFavoritesCount: Integer; + FSortDirection, FIsAuto, FIsRunning: Boolean; + function GetFavoritesCount: Integer; inline; + function GetFavorite(const Index: Integer): TFavoriteContainer; + function ConvertToDB: Boolean; public - favoritesFile: TIniFile; - taskthread: TFavoriteTask; + Items: TFavoriteContainers; + TaskThread: TFavoriteTask; DLManager: TDownloadManager; OnUpdateFavorite: procedure of object; OnUpdateDownload: procedure of object; @@ -94,35 +107,36 @@ TFavoriteManager = class constructor Create; destructor Destroy; override; - function FavoriteItem(const Index: Integer): TFavoriteContainer; - //Check favorites procedure CheckForNewChapter(FavoriteIndex: Integer = -1); - procedure StopChekForNewChapter(WaitFor: Boolean = True; - FavoriteIndex: Integer = -1); + procedure StopChekForNewChapter(WaitFor: Boolean = True; FavoriteIndex: Integer = -1); // Show notification form after checking completed procedure ShowResult; - // Return true if a manga exist in FFavorites - function IsMangaExist(const title, website: String): Boolean; - function IsMangaExistURL(const website, URL: String): Boolean; + // Return true if a manga exist in favorites + function LocateManga(const ATitle, AWebsite: String): TFavoriteContainer; + function IsMangaExist(const ATitle, AWebsite: String): Boolean; inline; + function LocateMangaByLink(const AWebsite, ALink: String): TFavoriteContainer; + function IsMangaExistLink(const AWebsite, ALink: String): Boolean; inline; // Add new manga to the list - procedure Add(const title, currentChapter, downloadedChapterList, - website, saveTo, link: String); - // Merge manga information with a title that already exist in FFavorites - procedure AddMerge(const title, currentChapter, downloadedChapterList, - website, saveTo, link: String); - // Merge a FFavorites.ini with another FFavorites.ini + procedure Add(const ATitle, ACurrentChapter, ADownloadedChapterList, AWebsite, ASaveTo, ALink: String); + // Merge manga information with a title that already exist in favorites + procedure AddMerge(const ATitle, ACurrentChapter, ADownloadedChapterList, AWebsite, + ASaveTo, ALink: String); + // Merge a favorites.ini with another favorites.ini procedure MergeWith(const APath: String); + // Free then delete favorite without any check, use with caution + procedure FreeAndDelete(const Pos: Integer); overload; + procedure FreeAndDelete(const T: TFavoriteContainer); overload; // Remove a manga from FFavorites - procedure Remove(const pos: Integer; const isBackup: Boolean = True); - // Restore information from FFavorites.ini + procedure Remove(const Pos: Integer; const isBackup: Boolean = True); overload; + procedure Remove(const T: TFavoriteContainer; const isBackup: Boolean = True); overload; + // Restore information from favorites.db procedure Restore; - // Backup to FFavorites.ini + // Backup to favorites.db procedure Backup; // Add FFavorites downloadedchapterlist - procedure AddToDownloadedChaptersList(const AWebsite, ALink, AValue: String); overload; - procedure AddToDownloadedChaptersList(const AWebsite, Alink: String; AValue: TStrings); overload; + procedure AddToDownloadedChaptersList(const AWebsite, ALink: String; const AValue: TStrings); // sorting procedure Sort(const AColumn: Integer); // critical section @@ -134,6 +148,7 @@ TFavoriteManager = class property SortColumn: Integer read FSortColumn write FSortColumn; property isAuto: Boolean read FIsAuto write FIsAuto; property isRunning: Boolean read FIsRunning write FIsRunning; + property Favorite[const Index: Integer]: TFavoriteContainer read GetFavorite; default; end; resourcestring @@ -152,10 +167,31 @@ TFavoriteManager = class implementation uses - frmMain, frmNewChapter; + frmMain, frmNewChapter, FMDVars; { TFavoriteContainer } +procedure TFavoriteContainer.SetWebsite(AValue: String); +begin + if FWebsite = AValue then Exit; + FWebsite := AValue; + FavoriteInfo.Website := AValue; + FModuleId := Modules.LocateModule(FavoriteInfo.Website); +end; + +procedure TFavoriteContainer.SetEnabled(AValue: Boolean); +begin + if FEnabled = AValue then Exit; + FEnabled := AValue; +end; + +constructor TFavoriteContainer.Create; +begin + FModuleId := -1; + FEnabled := True; + Tag := 0; +end; + destructor TFavoriteContainer.Destroy; begin if Assigned(Thread) then @@ -164,15 +200,35 @@ destructor TFavoriteContainer.Destroy; Thread.WaitFor; Thread := nil; end; - if Assigned(MangaInfo) then - MangaInfo.Free; if Assigned(NewMangaInfo) then + begin NewMangaInfo.Free; - if Assigned(NewMangaInfoChaptersPos) then NewMangaInfoChaptersPos.Free; + end; inherited Destroy; end; +procedure TFavoriteContainer.SaveToDB(const AOrder: Integer); +var + i: Integer; +begin + if AOrder = -1 then + i := Manager.Items.IndexOf(Self) + else + i := AOrder; + with FavoriteInfo do + Manager.FFavoritesDB.Add( + i, + FEnabled, + Website, + Link, + Title, + CurrentChapter, + DownloadedChapterList, + SaveTo + ); +end; + { TFavoriteThread } procedure TFavoriteThread.SyncStatus; @@ -182,59 +238,99 @@ procedure TFavoriteThread.SyncStatus; end; procedure TFavoriteThread.Execute; +var + DLChapters: TStringList; + i: Integer; begin - if (container.FavoriteInfo.Link) = '' then Exit; - try - Synchronize(SyncStatus); - getInfo.mangaInfo.title := container.FavoriteInfo.Title; - getInfo.GetInfoFromURL(container.FavoriteInfo.Website, - container.FavoriteInfo.Link, container.Manager.DLManager.retryConnect); - if container.MangaInfo = nil then - container.MangaInfo := TMangaInfo.Create; - TransferMangaInfo(container.MangaInfo, getInfo.mangaInfo); - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; + if (Container.FavoriteInfo.Link) = '' then Exit; + + Synchronize(SyncStatus); + with Container do + try + // get new manga info + FMangaInformation.isGetByUpdater := False; + //FMangaInformation.mangaInfo.title := FavoriteInfo.Title; // retrieve the original title so custom rename can remove them + FMangaInformation.GetInfoFromURL(FavoriteInfo.Website, FavoriteInfo.Link); + if not Terminated then + begin + NewMangaInfo := FMangaInformation.mangaInfo; + FMangaInformation.mangaInfo := nil; + NewMangaInfoChaptersPos := TCardinalList.Create; + // update current chapters count immedietly + FavoriteInfo.CurrentChapter := IntToStr(NewMangaInfo.chapterLinks.Count); + if NewMangaInfo.chapterLinks.Count > 0 then + begin + // tag 100 for transfer favorite, add all chapter to downloaded chapter list + if Container.Tag = 100 then + begin + FavoriteInfo.DownloadedChapterList := NewMangaInfo.chapterLinks.Text; + Container.Tag := 0; + end + else + try + DLChapters := TStringList.Create; + DLChapters.Sorted := False; + DLChapters.Text := FavoriteInfo.DownloadedChapterList; + DLChapters.Sorted := True; + for i := 0 to NewMangaInfo.chapterLinks.Count - 1 do + if DLChapters.IndexOf(NewMangaInfo.chapterLinks[i]) = -1 then + NewMangaInfoChaptersPos.Add(i); + finally + DLChapters.Free; + end; + end; + + // free unneeded objects + if (NewMangaInfoChaptersPos.Count = 0) and + (NewMangaInfo.status <> MangaInfo_StatusCompleted) then + begin + FreeAndNil(NewMangaInfo); + FreeAndNil(NewMangaInfoChaptersPos); + end; + end; + except + on E: Exception do + ExceptionHandle(Self, E); + end; end; constructor TFavoriteThread.Create; begin inherited Create(True); - getInfo := TMangaInformation.Create(Self); - getInfo.isGetByUpdater := False; + FMangaInformation := TMangaInformation.Create(Self); end; destructor TFavoriteThread.Destroy; begin - if Self.Terminated then - container.Status := STATUS_IDLE + if Terminated then + begin + Container.Status := STATUS_IDLE; + // free unused objects + if Assigned(Container.NewMangaInfo) then + begin + FreeAndNil(Container.NewMangaInfo); + FreeAndNil(Container.NewMangaInfoChaptersPos); + end; + end else - container.Status := STATUS_CHECKED; - task.CS_Threads.Acquire; + Container.Status := STATUS_CHECKED; + Container.Thread := nil; + + EnterCriticalsection(Task.CS_Threads); try - container.Thread := nil; - task.threads.Remove(Self); - Synchronize(SyncStatus); + Modules.DecActiveConnectionCount(Container.ModuleId); + Task.Threads.Remove(Self); finally - task.CS_Threads.Release; + LeaveCriticalsection(Task.CS_Threads); end; - getInfo.Free; + FMangaInformation.Free; + if not Terminated then + Synchronize(SyncStatus); inherited Destroy; end; { TFavoriteTask } -function TFavoriteTask.GetThreadCount: Integer; -begin - CS_Threads.Acquire; - try - Result := threads.Count; - finally - CS_Threads.Release; - end; -end; - procedure TFavoriteTask.SyncStartChecking; begin with MainForm do begin @@ -247,12 +343,15 @@ procedure TFavoriteTask.SyncStartChecking; procedure TFavoriteTask.SyncFinishChecking; begin - with MainForm do begin + with MainForm do + begin btCancelFavoritesCheck.Visible := False; - btFavoritesCheckNewChapter.Width := - btFavoritesCheckNewChapter.Width + btCancelFavoritesCheck.Width + 6; + btFavoritesCheckNewChapter.Width := btFavoritesCheckNewChapter.Width + + btCancelFavoritesCheck.Width + 6; btFavoritesCheckNewChapter.Caption := RS_BtnCheckFavorites; vtFavorites.Repaint; + if OptionAutoCheckFavInterval and (not tmCheckFavorites.Enabled) then + tmCheckFavorites.Enabled := True; end; end; @@ -261,106 +360,78 @@ procedure TFavoriteTask.SyncUpdateBtnCaption; MainForm.btFavoritesCheckNewChapter.Caption := FBtnCaption; end; -procedure TFavoriteTask.SyncShowResult; -begin - manager.ShowResult; -end; - -procedure TFavoriteTask.Execute; +procedure TFavoriteTask.Checkout; var i: Integer; +begin + if Terminated then Exit; + if Manager.Items.Count = 0 then Exit; - procedure CheckOut; - var - j: Integer; - started: Boolean; + FPendingCount := 0; + for i := 0 to Manager.Items.Count - 1 do begin - manager.CS_Favorites.Acquire; - try - statuscheck := 0; - started := False; - for j := 0 to manager.FFavorites.Count-1 do + if Terminated then Break; + with Manager.Items[i] do + if (Status = STATUS_CHECK) then begin - with TFavoriteContainer(manager.FFavorites[j]) do + if (Threads.Count < OptionMaxThreads) and + Modules.CanCreateConnection(ModuleId) then begin - if (Status = STATUS_CHECK) and - (Trim(FavoriteInfo.Link) <> '') then - begin - if not started then - begin - CS_Threads.Acquire; - try - if Thread = nil then - begin - Status := STATUS_CHECKING; - Thread := TFavoriteThread.Create; - Thread.task := Self; - Thread.container := manager.FavoriteItem(j); - Thread.workCounter := j; - threads.Add(Thread); - Thread.Start; - end; - finally - CS_Threads.Release; - end; - started := True; - end; - Inc(statuscheck); - end; - end; + EnterCriticalsection(CS_Threads); + try + Modules.IncActiveConnectionCount(ModuleId); + Status := STATUS_CHECKING; + Thread := TFavoriteThread.Create; + Threads.Add(Thread); + Thread.Task := Self; + Thread.Container := Manager.Items[i]; + Thread.WorkId := i; + Thread.Start; + finally + LeaveCriticalsection(CS_Threads); + end + end + else + Inc(FPendingCount); end; - finally - manager.CS_Favorites.Release; - end; end; +end; + +procedure TFavoriteTask.Execute; +var + cthread, + cmaxthreads: Integer; begin - manager.isRunning := True; + Manager.isRunning := True; Synchronize(SyncStartChecking); try - CheckOut; - while statuscheck > 0 do + while not Terminated do begin - while (not Terminated) and (threads.Count >= manager.DLManager.maxDLThreadsPerTask) do + cmaxthreads := OptionMaxThreads; + // if current thread count > max Threads allowed we wait until thread count decreased + while (not Terminated) and (Threads.Count >= cmaxthreads) do Sleep(SOCKHEARTBEATRATE); - if Terminated then Break; - CheckOut; - while (not Terminated) and (statuscheck = 0) and (threads.Count > 0) do + Checkout; + // if there is concurent connection limit applied and no more possible item to check + // we will wait until thread count decreased + // break wait if OptionMaxThreads changed + cthread := Threads.Count; + while (not Terminated) and (Threads.Count > 0) and (Threads.Count = cthread) and + (cmaxthreads = OptionMaxThreads) do Sleep(SOCKHEARTBEATRATE); + // if there is no more item need to be checked, but thread count still > 0 we will wait for it + // we will also wait if there is new item pushed, so we will check it after it + while (not Terminated) and (FPendingCount = 0) and (Threads.Count > 0) do + Sleep(SOCKHEARTBEATRATE); + if FPendingCount = 0 then Break; end; - if Terminated and (ThreadCount > 0) then - begin - CS_Threads.Acquire; - try - for i := 0 to ThreadCount - 1 do - TFavoriteThread(threads[i]).Terminate; - finally - CS_Threads.Release; - end; - while threads.Count > 0 do - Sleep(100); - end; - - if (not Terminated) and (not manager.DLManager.isDlgCounter) then - Synchronize(SyncShowResult); + while (not Terminated) and (Threads.Count > 0) do + Sleep(SOCKHEARTBEATRATE); except on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; - manager.CS_Favorites.Acquire; - try - for i := 0 to manager.FFavorites.Count-1 do - if TFavoriteContainer(manager.FFavorites[i]).Status <> STATUS_IDLE then - TFavoriteContainer(manager.FFavorites[i]).Status := STATUS_IDLE; - finally - manager.CS_Favorites.Release; + ExceptionHandle(Self, E); end; - Synchronize(SyncFinishChecking); -end; - -procedure TFavoriteTask.PushNewCheck; -begin - Inc(statuscheck); end; procedure TFavoriteTask.UpdateBtnCaption(Cap: String); @@ -372,16 +443,67 @@ procedure TFavoriteTask.UpdateBtnCaption(Cap: String); constructor TFavoriteTask.Create; begin inherited Create(True); - CS_Threads := TCriticalSection.Create; - threads := TFPList.Create; + InitCriticalSection(CS_Threads); + Threads := TFavoriteThreads.Create; end; destructor TFavoriteTask.Destroy; +var + i: Integer; begin - manager.taskthread := nil; - manager.isRunning := False; - threads.Free; - CS_Threads.Free; + // reset all status + EnterCriticalsection(Manager.CS_Favorites); + try + for i := 0 to Manager.Items.Count - 1 do + Manager.Items[i].Status := STATUS_IDLE; + finally + LeaveCriticalsection(Manager.CS_Favorites); + end; + + // terminate all threads and wait + EnterCriticalsection(CS_Threads); + try + if Threads.Count > 0 then + for i := 0 to Threads.Count - 1 do + Threads[i].Terminate; + finally + LeaveCriticalsection(CS_Threads); + end; + while Threads.Count > 0 do + Sleep(32); + + if (not Terminated) and (not isDlgCounter) then + Synchronize(Manager.ShowResult) + else + // free unused unit + begin + EnterCriticalsection(Manager.CS_Favorites); + try + for i := 0 to Manager.Items.Count - 1 do + with Manager.Items[i] do + begin + if Assigned(NewMangaInfo) then + FreeAndNil(NewMangaInfo); + if Assigned(NewMangaInfoChaptersPos) then + FreeAndNil(NewMangaInfoChaptersPos); + end; + finally + LeaveCriticalsection(Manager.CS_Favorites); + end; + end; + + Threads.Free; + try + EnterCriticalsection(Manager.CS_Favorites); + Manager.isRunning := False; + Manager.TaskThread := nil; + finally + LeaveCriticalsection(Manager.CS_Favorites); + end; + + // reset the ui + if not isExiting then + Synchronize(SyncFinishChecking); inherited Destroy; end; @@ -389,192 +511,202 @@ destructor TFavoriteTask.Destroy; function TFavoriteManager.GetFavoritesCount: Integer; begin - CS_Favorites.Acquire; + Result := Items.Count; +end; + +function TFavoriteManager.GetFavorite(const Index: Integer): TFavoriteContainer; +begin + Result := Items[Index]; +end; + +function TFavoriteManager.ConvertToDB: Boolean; +var + i: Integer; + s: String; +begin + Result := False; + if not FileExistsUTF8(FAVORITES_FILE) then Exit; + with TIniFile.Create(FAVORITES_FILE) do try - Result := FFavorites.Count; + i := ReadInteger('general', 'NumberOfFavorites', 0); + if i > 0 then + begin + for i := 0 to i - 1 do + begin + s := IntToStr(i); + FFavoritesDB.Add( + i, + True, + ReadString(s, 'Website', ''), + RemoveHostFromURL(ReadString(s, 'Link', '')), + ReadString(s, 'Title', ''), + ReadString(s, 'CurrentChapter', ''), + GetParams(ReadString(s, 'DownloadedChapterList', '')), + ReadString(s, 'SaveTo', '') + ); + end; + FFavoritesDB.Commit; + end; + Result := True; finally - CS_Favorites.Release; + Free; end; + if Result then + Result := DeleteFileUTF8(FAVORITES_FILE); end; constructor TFavoriteManager.Create; begin inherited Create; - CS_Favorites := TCriticalSection.Create; + ForceDirectoriesUTF8(WORK_FOLDER); + InitCriticalSection(CS_Favorites); isRunning := False; - favoritesFile := TIniFile.Create(WORK_FOLDER + FAVORITES_FILE); - favoritesFile.CacheUpdates := True; - FFavorites := TFPList.Create; - Restore; + Items := TFavoriteContainers.Create;; + FFavoritesDB := TFavoritesDB.Create(FAVORITESDB_FILE); + FFavoritesDB.Open; + ConvertToDB; end; destructor TFavoriteManager.Destroy; +var + i: Integer; begin - Backup; - favoritesFile.UpdateFile; - favoritesFile.Free; - if FFavorites.Count > 0 then begin + if Items.Count > 0 then + begin StopChekForNewChapter; - while FFavorites.Count > 0 do begin - TFavoriteContainer(FFavorites.Last).Free; - FFavorites.Remove(FFavorites.Last); - end; + for i := 0 to Items.Count - 1 do + Items[i].Free; end; - FFavorites.Free; - CS_Favorites.Free; + Items.Free; + FFavoritesDB.Free; + DoneCriticalsection(CS_Favorites); inherited Destroy; end; -function TFavoriteManager.FavoriteItem(const Index: Integer): TFavoriteContainer; -begin - if (Index < 0) or (Index >= FFavorites.Count) then - Exit(nil); - Result := TFavoriteContainer(FFavorites.Items[Index]); -end; - procedure TFavoriteManager.CheckForNewChapter(FavoriteIndex: Integer); var i: Integer; begin - if DLManager.isDlgCounter then Exit; + if isDlgCounter then Exit; try if FavoriteIndex > -1 then - TFavoriteContainer(FFavorites[FavoriteIndex]).Status := STATUS_CHECK - else begin - if isRunning then - begin - if not isAuto then - MessageDlg('', RS_DlgFavoritesCheckIsRunning, mtInformation, [mbOK], 0); - end - else - begin - CS_Favorites.Acquire; - try - for i := 0 to FFavorites.Count-1 do - if TFavoriteContainer(FFavorites[i]).Status = STATUS_IDLE then - TFavoriteContainer(FFavorites[i]).Status := STATUS_CHECK; - finally - CS_Favorites.Release; + with Items[FavoriteIndex] do + if FEnabled and (Status = STATUS_IDLE) then + begin + Status := STATUS_CHECK; + if Assigned(TaskThread) then + TaskThread.FPendingCount := InterLockedIncrement(TaskThread.FPendingCount); end; - end; - end; - if taskthread = nil then + end + else + if isRunning then begin - taskthread := TFavoriteTask.Create; - taskthread.manager := Self; - taskthread.Start; + if not isAuto then + MessageDlg('', RS_DlgFavoritesCheckIsRunning, mtInformation, [mbOK], 0); end else - taskthread.PushNewCheck; + begin + EnterCriticalsection(CS_Favorites); + try + for i := 0 to Items.Count - 1 do + with Items[i] do + if FEnabled and (Status = STATUS_IDLE) and (Trim(FavoriteInfo.Link) <> '') then + Status := STATUS_CHECK; + finally + LeaveCriticalsection(CS_Favorites); + end; + end; + if TaskThread = nil then + begin + TaskThread := TFavoriteTask.Create; + TaskThread.Manager := Self; + TaskThread.Start; + end; except on E: Exception do - MainForm.ExceptionHandler(Self, E); + ExceptionHandle(Self, E); end; end; -procedure TFavoriteManager.StopChekForNewChapter(WaitFor: Boolean; - FavoriteIndex: Integer); +procedure TFavoriteManager.StopChekForNewChapter(WaitFor: Boolean; FavoriteIndex: Integer); begin - if isRunning then + if not isRunning then Exit; + if FavoriteIndex > -1 then begin - if FavoriteIndex > -1 then - begin - if TFavoriteContainer(FFavorites[FavoriteIndex]).Thread <> nil then + with Items[FavoriteIndex] do begin + if Thread <> nil then begin - TFavoriteContainer(FFavorites[FavoriteIndex]).Thread.Terminate; + Thread.Terminate; if WaitFor then - TFavoriteContainer(FFavorites[FavoriteIndex]).Thread.WaitFor; + Thread.WaitFor; end; - if TFavoriteContainer(FFavorites[FavoriteIndex]).Status <> STATUS_IDLE then - TFavoriteContainer(FFavorites[FavoriteIndex]).Status := STATUS_IDLE; - end - else - begin - taskthread.Terminate; - if WaitFor then - taskthread.WaitFor; + if Status <> STATUS_IDLE then + Status := STATUS_IDLE; end; + end + else + if Assigned(TaskThread) then + begin + TaskThread.Terminate; + if WaitFor then + TaskThread.WaitFor; end; end; procedure TFavoriteManager.ShowResult; var - i, p, counter, + i, j, numOfNewChapters, numOfMangaNewChapters, - numOfCompleted : Integer; - dlChapters : TStringList; - LNCResult : TNewChapterResult = ncrCancel; - newChapterListStr : String = ''; - removeListStr : String = ''; - favDelete : Boolean; + numOfCompleted: Integer; + LNCResult: TNewChapterResult = ncrCancel; + newChapterListStr: String = ''; + removeListStr: String = ''; + newdl: LongInt; begin - if DLManager.isDlgCounter then Exit; + if isDlgCounter then Exit; + if (Self.DLManager = nil) and Assigned(DLManager) then + Self.DLManager := DLManager; + if Self.DLManager = nil then Exit; + + EnterCriticalsection(CS_Favorites); try - CS_Favorites.Acquire; - dlChapters := TStringList.Create; + numOfNewChapters := 0; + numOfMangaNewChapters := 0; + numOfCompleted := 0; + try - numOfNewChapters := 0; - numOfMangaNewChapters := 0; - numOfCompleted := 0; - counter := 0; - while counter < FFavorites.Count do - begin - //compare new mangainfo's chapters with downloadedchapter from favorites - with FavoriteItem(counter) do try - if Assigned(MangaInfo) then + // check for all favorites + for i := 0 to Items.Count - 1 do + with Items[i] do + if Assigned(NewMangaInfo) then begin - if MangaInfo.chapterLinks.Count > 0 then + // new chapters add to notification + if NewMangaInfoChaptersPos.Count > 0 then begin - NewMangaInfo := TMangaInfo.Create; - NewMangaInfoChaptersPos := TCardinalList.Create; - TransferMangaInfo(NewMangaInfo, MangaInfo); - NewMangaInfo.chapterLinks.Clear; - NewMangaInfo.chapterName.Clear; - dlChapters.Clear; - GetParams(dlChapters, FavoriteInfo.downloadedChapterList); - dlChapters.Sort; - for i := 0 to MangaInfo.chapterLinks.Count - 1 do - if not dlChapters.Find(MangaInfo.chapterLinks[i], p) then - begin - NewMangaInfo.chapterLinks.Add(MangaInfo.chapterLinks[i]); - NewMangaInfo.chapterName.Add(MangaInfo.chapterName[i]); - NewMangaInfoChaptersPos.Add(i); - Inc(numOfNewChapters); - end; - - //add to notification - if NewMangaInfo.chapterLinks.Count > 0 then - begin - newChapterListStr := newChapterListStr + LineEnding + '- ' + - Format(RS_FavoriteHasNewChapter, - [FavoriteInfo.Title, FavoriteItem(counter).FavoriteInfo.Website, - NewMangaInfo.chapterLinks.Count]); - Inc(numOfMangaNewChapters); - end; - - //add completed manga - if (OptionAutoRemoveCompletedManga) and (NewMangaInfo.status = '0') then - begin - removeListStr := removeListStr + LineEnding + - Format('- %s <%s>', [FavoriteInfo.Title, FavoriteInfo.Website]); - Inc(numOfCompleted); - end; + newChapterListStr += LineEnding + '- ' + Format( + RS_FavoriteHasNewChapter, [FavoriteInfo.Title, FavoriteInfo.Website, + NewMangaInfoChaptersPos.Count]); + Inc(numOfMangaNewChapters); + Inc(numOfNewChapters, NewMangaInfoChaptersPos.Count); + end + else + // completed series add to notification + if OptionAutoCheckFavRemoveCompletedManga and + (NewMangaInfo.status = MangaInfo_StatusCompleted) then + begin + removeListStr += LineEnding + Format('- %s <%s>', + [FavoriteInfo.Title, FavoriteInfo.Website]); + Inc(numOfCompleted); end; end; - finally - Inc(counter); - end; - end; - dlChapters.Clear; - if numOfNewChapters = 0 then + // if there is completed mangas, show dialog + if numOfCompleted > 0 then begin - // If there's no new chapter, but there're completed mangas, show dialog - if numOfCompleted > 0 then - begin - with TNewChapter.Create(MainForm) do try + with TNewChapter.Create(MainForm) do + try Caption := Format(RS_DlgCompletedMangaCaption, [numOfCompleted]); lbNotification.Caption := RS_LblMangaWillBeRemoved; mmMemo.Lines.Text := Trim(removeListStr); @@ -589,231 +721,224 @@ procedure TFavoriteManager.ShowResult; Free; end; - //delete complete FFavorites - if LNCResult = ncrDownload then - begin - counter := 0; - while counter < FFavorites.Count do + //delete complete FFavorites + if LNCResult = ncrDownload then + begin + i := 0; + while i < Items.Count do + with Items[i] do begin - favDelete := False; - with FavoriteItem(counter) do begin - if Assigned(NewMangaInfo) then - if (NewMangaInfo.chapterLinks.Count = 0) and (NewMangaInfo.status = '0') then - begin - FavoriteItem(counter).Free; - FFavorites.Delete(counter); - favDelete := True; - end; - end; - if not favDelete then - Inc(counter); + if Assigned(NewMangaInfo) and + (NewMangaInfoChaptersPos.Count = 0) and + (NewMangaInfo.status = MangaInfo_StatusCompleted) then + FreeAndDelete(i) + else + Inc(i); end; - end; - Backup; - if Assigned(OnUpdateFavorite) then - OnUpdateFavorite; end; - end - else + Backup; + end; + + // if there is new chapters + if numOfNewChapters > 0 then begin - //if there's new chapters - if OptionAutoDlFav then - begin - if MainForm.cbAddAsStopped.Checked then - LNCResult := ncrQueue - else - LNCResult := ncrDownload; - end + if OptionAutoCheckFavDownload then + LNCResult := ncrDownload else - begin - with TNewChapter.Create(MainForm) do try - Caption := Format(RS_DlgNewChapterCaption, [numOfNewChapters]); - lbNotification.Caption := Format(RS_LblNewChapterFound, [numOfNewChapters, numOfMangaNewChapters]); - mmMemo.Lines.Text := Trim(newChapterListStr); - btDownload.Caption := RS_BtnDownload; - btQueue.Caption := RS_BtnAddToQueue; - btCancel.Caption := RS_BtnCancel; - btDownload.Show; - btQueue.Show; - btCancel.Show; - ShowModal; - LNCResult := FormResult; - finally - Free; - end; - end; + with TNewChapter.Create(MainForm) do + try + Caption := Format(RS_DlgNewChapterCaption, [numOfNewChapters]); + lbNotification.Caption := + Format(RS_LblNewChapterFound, [numOfNewChapters, numOfMangaNewChapters]); + mmMemo.Lines.Text := Trim(newChapterListStr); + btDownload.Caption := RS_BtnDownload; + btQueue.Caption := RS_BtnAddToQueue; + btCancel.Caption := RS_BtnCancel; + btDownload.Show; + btQueue.Show; + btCancel.Show; + ShowModal; + LNCResult := FormResult; + finally + Free; + end; + // generate download task if LNCResult <> ncrCancel then - //generate new download task begin while DLManager.isRunningBackup do Sleep(100); - counter := 0; - while counter < FFavorites.Count do - begin - with FavoriteItem(counter) do begin - if Assigned(NewMangaInfo) then - if NewMangaInfo.chapterLinks.Count > 0 then - begin - DLManager.CS_DownloadManager_Task.Acquire; - try - DLManager.containers.Add(TTaskContainer.Create); - with TTaskContainer(DLManager.Containers.Last) do begin - Manager := DLManager; - CurrentDownloadChapterPtr := 0; - MangaSiteID := GetMangaSiteID(FavoriteInfo.Website); - with DownloadInfo do begin - Website := FavoriteInfo.Website; - Link := FavoriteInfo.Link; - Title := FavoriteInfo.Title; - SaveTo := FavoriteInfo.SaveTo; - dateTime := Now; - end; - ChapterLinks.Assign(NewMangaInfo.chapterLinks); - for i := 0 to NewMangaInfo.chapterLinks.Count - 1 do begin - ChapterName.Add(CustomRename( - OptionCustomRename, - FavoriteInfo.Website, - FavoriteInfo.Title, - NewMangaInfo.authors, - NewMangaInfo.artists, - NewMangaInfo.chapterName[i], - Format('%.4d', [NewMangaInfoChaptersPos[i] + 1]), - MainForm.cbOptionPathConvert.Checked)); - end; - if LNCResult = ncrDownload then - begin - DownloadInfo.Status := RS_Waiting; - Status := STATUS_WAIT; - end - else - begin - DownloadInfo.Status := RS_Stopped; - Status := STATUS_STOP; - end; + + for i := 0 to Items.Count - 1 do + with Items[i] do + if Assigned(NewMangaInfo) and + (NewMangaInfoChaptersPos.Count > 0) then + try + EnterCriticalSection(DLManager.CS_Task); + newdl := DLManager.Items.Add(TTaskContainer.Create); + with DLManager.Items[newdl] do + begin + Manager := DLManager; + CurrentDownloadChapterPtr := 0; + Website := FavoriteInfo.Website; + DownloadInfo.Link := FavoriteInfo.Link; + DownloadInfo.Title := FavoriteInfo.Title; + DownloadInfo.SaveTo := FavoriteInfo.SaveTo; + DownloadInfo.dateTime := Now; + + for j := 0 to NewMangaInfoChaptersPos.Count - 1 do + begin + ChapterLinks.Add(NewMangaInfo.chapterLinks[NewMangaInfoChaptersPos[j]]); + ChapterName.Add(CustomRename( + OptionChapterCustomRename, + FavoriteInfo.Website, + FavoriteInfo.Title, + NewMangaInfo.authors, + NewMangaInfo.artists, + NewMangaInfo.chapterName[NewMangaInfoChaptersPos[j]], + Format('%.4d', [NewMangaInfoChaptersPos[j] + 1]), + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr)); + end; + + if LNCResult = ncrDownload then + begin + DownloadInfo.Status := Format('[%d/%d] %s',[0,ChapterLinks.Count,RS_Waiting]); + Status := STATUS_WAIT; + end + else + begin + DownloadInfo.Status := Format('[%d/%d] %s',[0,ChapterLinks.Count,RS_Stopped]); + Status := STATUS_STOP; end; - FavoriteInfo.currentChapter := IntToStr(MangaInfo.chapterLinks.Count); - finally - DLManager.CS_DownloadManager_Task.Release; + SaveToDB(newdl); + // add to downloaded chapter list + FavoriteInfo.downloadedChapterList := MergeCaseInsensitive([FavoriteInfo.DownloadedChapterList, chapterLinks.Text]); + // add to downloaded chapter list in downloadmanager + DLManager.DownloadedChapters.Chapters[FavoriteInfo.Website + FavoriteInfo.Link] := chapterLinks.Text; end; - //mark downloaded - FavoriteInfo.downloadedChapterList := - FavoriteInfo.downloadedChapterList + SetParams(NewMangaInfo.chapterLinks); - //save to downloaded chapter list from dlmanager. - DLManager.AddToDownloadedChaptersList( - FavoriteInfo.Website + FavoriteInfo.Link, NewMangaInfo.chapterLinks); + // free unused objects + FreeAndNil(NewMangaInfo); + FreeAndNil(NewMangaInfoChaptersPos); + finally + LeaveCriticalSection(DLManager.CS_Task); end; - end; - Inc(counter); - end; + Backup; - DLManager.Backup; - if Assigned(OnUpdateDownload) then - OnUpdateDownload; if LNCResult = ncrDownload then begin DLManager.CheckAndActiveTask; MainForm.pcMain.ActivePage := MainForm.tsDownload; end; + if Assigned(OnUpdateDownload) then + OnUpdateDownload; if Assigned(OnUpdateFavorite) then OnUpdateFavorite; end; end; - finally - //free used memory - counter := 0; - while counter < FFavorites.Count do - begin - with FavoriteItem(counter) do begin - if Assigned(MangaInfo) then - FreeAndNil(MangaInfo); - if Assigned(NewMangaInfo) then - FreeAndNil(NewMangaInfo); - if Assigned(NewMangaInfoChaptersPos) then - FreeAndNil(NewMangaInfoChaptersPos); - end; - Inc(counter) - end; - FreeAndNil(dlChapters); - CS_Favorites.Release; + + except + on E: Exception do + ExceptionHandle(Self, E); end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); + + // check again for unused objects and free them + for i := 0 to Items.Count - 1 do + with Items[i] do + if Assigned(NewMangaInfo) then + begin + FreeAndNil(NewMangaInfo); + FreeAndNil(NewMangaInfoChaptersPos); + end; + finally + LeaveCriticalsection(CS_Favorites); end; end; -function TFavoriteManager.IsMangaExist(const title, website: String): Boolean; +function TFavoriteManager.LocateManga(const ATitle, AWebsite: String): TFavoriteContainer; var i: Integer; begin - if FFavorites.Count > 0 then - for i := 0 to FFavorites.Count - 1 do - if (CompareText(FavoriteItem(i).FavoriteInfo.Title, title) = 0) and - (CompareText(FavoriteItem(i).FavoriteInfo.website, website) = 0) then - Exit(True); - Result := False; + Result := nil; + if Items.Count <> 0 then + for i := 0 to Items.Count - 1 do + with Items[i].FavoriteInfo do + if SameText(ATitle, Title) and SameText(AWebsite, Website) then + Exit(Items[i]); +end; + +function TFavoriteManager.IsMangaExist(const ATitle, AWebsite: String): Boolean; +begin + Result := LocateManga(ATitle, AWebsite) <> nil; end; -function TFavoriteManager.IsMangaExistURL(const website, URL : String): Boolean; -Var +function TFavoriteManager.LocateMangaByLink(const AWebsite, ALink: String): TFavoriteContainer; +var i: Integer; begin - Result := False; - if FFavorites.Count > 0 then - for i := 0 to FFavorites.Count - 1 do - if SameText(website, FavoriteItem(i).FavoriteInfo.Website) and - SameText(URL, FavoriteItem(i).FavoriteInfo.Link) then - Exit(True); - Result := False; + Result := nil; + if Items.Count <> 0 then + for i := 0 to Items.Count - 1 do + with Items[i].FavoriteInfo do + if SameText(AWebsite, Website) and SameText(ALink, Link) then + Exit(Items[i]); end; -procedure TFavoriteManager.Add( - const title, currentChapter, downloadedChapterList, website, saveTo, link: String); +function TFavoriteManager.IsMangaExistLink(const AWebsite, ALink: String): Boolean; begin - if IsMangaExist(title, website) then Exit; - CS_Favorites.Acquire; + Result := LocateMangaByLink(AWebsite, ALink) <> nil; +end; + +procedure TFavoriteManager.Add(const ATitle, ACurrentChapter, ADownloadedChapterList, + AWebsite, ASaveTo, ALink: String); +var + newfv: Integer; +begin + if IsMangaExist(ATitle, AWebsite) then Exit; + EnterCriticalsection(CS_Favorites); try - FFavorites.Add(TFavoriteContainer.Create); - with TFavoriteContainer(FFavorites.Last) do begin + newfv := Items.Add(TFavoriteContainer.Create); + with Items[newfv] do begin Manager := Self; - FavoriteInfo.Title := title; - FavoriteInfo.currentChapter := currentChapter; - FavoriteInfo.website := website; - FavoriteInfo.saveTo := saveTo; - FavoriteInfo.Link := Link; - FavoriteInfo.downloadedChapterList := downloadedChapterList; + Website := AWebsite; + with FavoriteInfo do begin + Title := ATitle; + CurrentChapter := ACurrentChapter; + SaveTo := ASaveTo; + Link := ALink; + DownloadedChapterList := ADownloadedChapterList; + end; Status := STATUS_IDLE; + SaveToDB(newfv); end; if not isRunning then - begin Sort(SortColumn); - Backup; - end; finally - CS_Favorites.Release; + LeaveCriticalsection(CS_Favorites); end; end; -procedure TFavoriteManager.AddMerge( - const title, currentChapter, downloadedChapterList, website, saveTo, link: String); +procedure TFavoriteManager.AddMerge(const ATitle, ACurrentChapter, ADownloadedChapterList, + AWebsite, ASaveTo, ALink: String); begin - if IsMangaExist(title, website) then + if IsMangaExist(ATitle, AWebsite) then Exit; - CS_Favorites.Acquire; + EnterCriticalsection(CS_Favorites); try - FFavorites.Add(TFavoriteContainer.Create); - with TFavoriteContainer(FFavorites.Last) do begin + Items.Add(TFavoriteContainer.Create); + with Items.Last do begin Manager := Self; - FavoriteInfo.Title := title; - FavoriteInfo.currentChapter := currentChapter; - FavoriteInfo.website := website; - FavoriteInfo.saveTo := saveTo; - FavoriteInfo.Link := Link; - FavoriteInfo.downloadedChapterList := downloadedChapterList; + Website := AWebsite; + with FavoriteInfo do begin + Title := ATitle; + CurrentChapter := ACurrentChapter; + SaveTo := ASaveTo; + Link := ALink; + DownloadedChapterList := ADownloadedChapterList; + end; end; except - CS_Favorites.Release; + LeaveCriticalsection(CS_Favorites); end; end; @@ -832,263 +957,197 @@ procedure TFavoriteManager.MergeWith(const APath: String); fstream := TFileStreamUTF8.Create(APath, fmOpenRead); mergeFile := TIniFile.Create(fstream); - - l := mergeFile.ReadInteger('general', 'NumberOfFavorites', 0); - if l > 0 then - begin - SetLength(infos, l); - for i := 0 to l - 1 do - begin - infos[i].Title := mergeFile.ReadString(IntToStr(i), 'Title', ''); - infos[i].currentChapter := - mergeFile.ReadString(IntToStr(i), 'CurrentChapter', '0'); - infos[i].downloadedChapterList := - mergeFile.ReadString(IntToStr(i), 'DownloadedChapterList', ''); - infos[i].website := mergeFile.ReadString(IntToStr(i), 'Website', ''); - infos[i].SaveTo := mergeFile.ReadString(IntToStr(i), 'SaveTo', ''); - infos[i].link := mergeFile.ReadString(IntToStr(i), 'Link', ''); - - AddMerge(infos[i].Title, - infos[i].currentChapter, - infos[i].downloadedChapterList, - infos[i].website, - infos[i].SaveTo, - infos[i].link); + try + with mergeFile do begin + l := mergeFile.ReadInteger('general', 'NumberOfFavorites', 0); + if l > 0 then + begin + SetLength(infos, l); + for i := 0 to l - 1 do + with infos[i] do begin + Title := ReadString(IntToStr(i), 'Title', ''); + currentChapter := ReadString(IntToStr(i), 'CurrentChapter', '0'); + downloadedChapterList := ReadString(IntToStr(i), 'DownloadedChapterList', ''); + Website := ReadString(IntToStr(i), 'Website', ''); + SaveTo := ReadString(IntToStr(i), 'SaveTo', ''); + Link := ReadString(IntToStr(i), 'Link', ''); + + AddMerge(Title, currentChapter, downloadedChapterList, Website, SaveTo, Link); + end; + end; end; + Sort(SortColumn); + Backup; + finally + fStream.Free; + mergeFile.Free; end; - Sort(SortColumn); - Backup; - SetLength(infos, 0); - fStream.Free; - mergeFile.Free; isRunning := False; end; -procedure TFavoriteManager.Remove(const pos: Integer; const isBackup: Boolean); +procedure TFavoriteManager.FreeAndDelete(const Pos: Integer); +begin + with Items[Pos].FavoriteInfo do + FFavoritesDB.Delete(Website, Link); + Items[Pos].Free; + Items.Delete(Pos); +end; + +procedure TFavoriteManager.FreeAndDelete(const T: TFavoriteContainer); begin - if (not isRunning) and (pos < FFavorites.Count) then + with T.FavoriteInfo do + FFavoritesDB.Delete(Website, Link); + T.Free; + Items.Remove(T); +end; + +procedure TFavoriteManager.Remove(const Pos: Integer; const isBackup: Boolean); +begin + if (not isRunning) and (Pos < Items.Count) then begin - CS_Favorites.Acquire; + EnterCriticalsection(CS_Favorites); try - FavoriteItem(pos).Free; - FFavorites.Delete(pos); + FreeAndDelete(Pos); if isBackup then Backup; finally - CS_Favorites.Release; + LeaveCriticalsection(CS_Favorites); end; end; end; -procedure TFavoriteManager.Restore; -var - i, c: Integer; +procedure TFavoriteManager.Remove(const T: TFavoriteContainer; const isBackup: Boolean); begin - c := favoritesFile.ReadInteger('general', 'NumberOfFavorites', 0); - if c > 0 then - for i := 0 to c - 1 do - begin - FFavorites.Add(TFavoriteContainer.Create); - with TFavoriteContainer(FFavorites.Last) do begin - Manager := Self; - FavoriteInfo.Title := favoritesFile.ReadString(IntToStr(i), 'Title', ''); - FavoriteInfo.currentChapter := - favoritesFile.ReadString(IntToStr(i), 'CurrentChapter', '0'); - FavoriteInfo.downloadedChapterList := - favoritesFile.ReadString(IntToStr(i), 'DownloadedChapterList', ''); - FavoriteInfo.website := favoritesFile.ReadString(IntToStr(i), 'Website', ''); - FavoriteInfo.SaveTo := - CorrectPathSys(favoritesFile.ReadString(IntToStr(i), 'SaveTo', '')); - FavoriteInfo.link := favoritesFile.ReadString(IntToStr(i), 'Link', ''); - Status := STATUS_IDLE; - end; + if not isRunning then + begin + EnterCriticalsection(CS_Favorites); + try + FreeAndDelete(T); + if isBackup then + Backup; + finally + LeaveCriticalsection(CS_Favorites); end; + end; end; -procedure TFavoriteManager.Backup; +procedure TFavoriteManager.Restore; var - i: Integer; + t: TFavoriteContainer; begin - // delete old info - if favoritesFile.ReadInteger('general', 'NumberOfFavorites', 0) > 0 then - for i := 0 to favoritesFile.ReadInteger('general', 'NumberOfFavorites', 0) - 1 do - favoritesFile.EraseSection(IntToStr(i)); - - favoritesFile.WriteInteger('general', 'NumberOfFavorites', FFavorites.Count); - if FFavorites.Count > 0 then - for i := 0 to FFavorites.Count - 1 do - begin - favoritesFile.WriteString(IntToStr(i), 'Title', FavoriteItem(i).FavoriteInfo.Title); - favoritesFile.WriteString(IntToStr(i), 'CurrentChapter', - FavoriteItem(i).FavoriteInfo.currentChapter); - favoritesFile.WriteString(IntToStr(i), 'DownloadedChapterList', - FavoriteItem(i).FavoriteInfo.downloadedChapterList); - favoritesFile.WriteString(IntToStr(i), 'Website', FavoriteItem(i).FavoriteInfo.Website); - favoritesFile.WriteString(IntToStr(i), 'SaveTo', FavoriteItem(i).FavoriteInfo.SaveTo); - favoritesFile.WriteString(IntToStr(i), 'Link', FavoriteItem(i).FavoriteInfo.link); + if not FFavoritesDB.Connection.Connected then Exit; + if FFavoritesDB.OpenTable(False) then + try + if FFavoritesDB.Table.RecordCount = 0 then Exit; + EnterCriticalsection(CS_Favorites); + try + FFavoritesDB.Table.First; + while not FFavoritesDB.Table.EOF do + begin + t := TFavoriteContainer.Create; + with t, FavoriteInfo, FFavoritesDB.Table do + begin + Manager := Self; + Status := STATUS_IDLE; + Enabled := Fields[f_enabled].AsBoolean; + Website := Fields[f_website].AsString; + t.Website := Website; + Link := Fields[f_link].AsString; + Title := Fields[f_title].AsString; + CurrentChapter := Fields[f_currentchapter].AsString; + DownloadedChapterList := Fields[f_downloadedchapterlist].AsString; + SaveTo := Fields[f_saveto].AsString; + end; + Items.Add(t); + FFavoritesDB.Table.Next; + end; + finally + LeaveCriticalsection(CS_Favorites); + end; + finally + FFavoritesDB.CloseTable; end; - favoritesFile.UpdateFile; end; -procedure TFavoriteManager.AddToDownloadedChaptersList(const AWebsite, ALink, - AValue: String); +procedure TFavoriteManager.Backup; var - st: TStringList; + i: Integer; begin - if (AWebsite <> '') and (ALink <> '') and (AValue <> '') then - begin - st := TStringList.Create; + if not FFavoritesDB.Connection.Connected then Exit; + if Items.Count > 0 then try - GetParams(st, AValue); - AddToDownloadedChaptersList(AWebsite, ALink, st); + EnterCriticalsection(CS_Favorites); + for i := 0 to Items.Count - 1 do + Items[i].SaveToDB(i); + FFavoritesDB.Commit; finally - St.Free; + LeaveCriticalsection(CS_Favorites); end; - end; end; procedure TFavoriteManager.AddToDownloadedChaptersList(const AWebsite, - Alink: String; AValue: TStrings); + ALink: String; const AValue: TStrings); var - i, p, q: Integer; - Ch, dlCh: TStringList; + i: Integer; begin - if Count = 0 then - Exit; - if (AWebsite <> '') and (Alink <> '') and (AValue.Count > 0) then - begin - CS_Favorites.Acquire; - Ch := TStringList.Create; - dlCh := TStringList.Create; - try - p := -1; - //locate the link - if FFavorites.Count > 1 then - for i := 0 to FFavorites.Count - 1 do - if SameText(AWebsite, FavoriteItem(i).FavoriteInfo.Website) and - SameText(Alink, FavoriteItem(i).FavoriteInfo.Link) then - begin - p := i; - GetParams(dlCh, FavoriteItem(i).FavoriteInfo.downloadedChapterList); - Break; - end; - - //if found the FavoriteItem - if p > -1 then - begin - //remove if links found on downloadedchapterlist - Ch.Assign(AValue); - if dlCh.Count > 0 then + if (Items.Count = 0) or (AWebsite = '') or (ALink = '') or (AValue.Count = 0) then Exit; + try + EnterCriticalsection(CS_Favorites); + for i := 0 to Items.Count - 1 do + with Items[i].FavoriteInfo do + if SameText(AWebsite, Website) and SameText(ALink, Link) then begin - dlCh.Sort; - i := 0; - while i < Ch.Count do - begin - if dlCh.Find(Ch[i], q) then - Ch.Delete(i) - else - Inc(i); - end; - end; - - //merge the links - with FavoriteItem(p).FavoriteInfo do begin - downloadedChapterList := downloadedChapterList + SetParams(ch); - currentChapter := IntToStr(dlCh.Count + ch.Count); + DownloadedChapterList := MergeCaseInsensitive([DownloadedChapterList, AValue.Text]); + Break; end; - MainForm.UpdateVtFavorites; - end; - finally - dlCh.Free; - Ch.Free; - CS_Favorites.Release; - end; + finally + LeaveCriticalsection(CS_Favorites); end; end; -procedure TFavoriteManager.Sort(const AColumn: Integer); +function CompareFavoriteContainer(const Item1, Item2: TFavoriteContainer): Integer; - function GetStr(ARow: Pointer): String; + function GetStr(ARow: TFavoriteContainer): String; begin - case AColumn of - 1: Result := TFavoriteContainer(ARow).FavoriteInfo.Title; - 2: Result := TFavoriteContainer(ARow).FavoriteInfo.currentChapter; - 3: Result := TFavoriteContainer(ARow).FavoriteInfo.website; - 4: Result := TFavoriteContainer(ARow).FavoriteInfo.SaveTo; - end; + with ARow.FavoriteInfo do + case ARow.Manager.SortColumn of + 1: Result := Title; + 2: Result := currentChapter; + 3: Result := website; + 4: Result := SaveTo; + else + Result := ''; + end; end; - function Compare(Item1, Item2: Pointer): Integer; - var - ItemT: Pointer; - begin - if SortDirection then - begin - ItemT := Item1; - Item1 := Item2; - Item2 := ItemT; - end; +begin + if Item1.Manager.SortDirection then + Result := NaturalCompareStr(GetStr(Item2), GetStr(Item1)) + else Result := NaturalCompareStr(GetStr(Item1), GetStr(Item2)); - end; - - procedure QSort(FList: TFPList; L, R: Integer); - var - I, J : Longint; - P, Q : Pointer; - begin - repeat - I := L; - J := R; - P := FList[ (L + R) div 2 ]; - repeat - while Compare(P, FList[i]) > 0 do - I := I + 1; - while Compare(P, FList[J]) < 0 do - J := J - 1; - If I <= J then - begin - Q := FList[I]; - Flist[I] := FList[J]; - FList[J] := Q; - I := I + 1; - J := J - 1; - end; - until I > J; - if J - L < R - I then - begin - if L < J then - QSort(FList, L, J); - L := I; - end - else - begin - if I < R then - QSort(FList, I, R); - R := J; - end; - until L >= R; - end; +end; +procedure TFavoriteManager.Sort(const AColumn: Integer); begin - if FFavorites.Count < 2 then Exit; - CS_Favorites.Acquire; + if Items.Count < 2 then Exit; + EnterCriticalsection(CS_Favorites); try SortColumn := AColumn; - QSort(FFavorites, 0, FFavorites.Count - 1); + Items.Sort(CompareFavoriteContainer); finally - CS_Favorites.Release; + LeaveCriticalsection(CS_Favorites); end; end; procedure TFavoriteManager.Lock; begin - CS_Favorites.Acquire; + EnterCriticalsection(CS_Favorites); end; procedure TFavoriteManager.LockRelease; begin - CS_Favorites.Release; + LeaveCriticalsection(CS_Favorites); end; end. diff --git a/baseunits/uGetMangaInfosThread.pas b/baseunits/uGetMangaInfosThread.pas index b7afe8940..a0eadb5e6 100644 --- a/baseunits/uGetMangaInfosThread.pas +++ b/baseunits/uGetMangaInfosThread.pas @@ -16,103 +16,116 @@ interface uses - SysUtils, Graphics, Dialogs, uBaseUnit, uData, uFMDThread; + SysUtils, Graphics, Dialogs, uBaseUnit, uData, FMDOptions, BaseThread, + VirtualTrees; type { TGetMangaInfosThread } - TGetMangaInfosThread = class(TFMDThread) + TGetMangaInfosThread = class(TBaseThread) protected - FMangaListPos: Integer; + FMangaListNode: PVirtualNode; FCover: TPicture; FTitle, FWebsite, FLink: String; FInfo: TMangaInformation; FNumChapter: Cardinal; // Return TRUE if we can load manga cover. - FIsHasMangaCover, + FIsHasMangaCover: Boolean; // Flush this thread, means that the result will not be shown. - FIsFlushed: Boolean; - procedure Execute; override; - procedure DoGetInfos; - + procedure MainThreadSyncInfos; procedure MainThreadShowInfos; procedure MainThreadShowCover; procedure MainThreadShowCannotGetInfo; public constructor Create; destructor Destroy; override; - property Title: String read FTitle write FTitle; property Website: String read FWebsite write FWebsite; property Link: String read FLink write FLink; - property IsFlushed: Boolean read FIsFlushed write FIsFlushed; - property MangaListPos: Integer read FMangaListPos write FMangaListPos; + property MangaListNode: PVirtualNode read FMangaListNode write FMangaListNode; end; implementation uses - frmMain; + frmMain, WebsiteModules, FMDVars; -procedure TGetMangaInfosThread.DoGetInfos; +procedure TGetMangaInfosThread.MainThreadSyncInfos; +begin + FInfo.SyncInfoToData(DataProcess); + dataProcess.Commit; +end; + +procedure TGetMangaInfosThread.Execute; function GetMangaInfo: Boolean; var - filterPos: Cardinal; infob: byte; + data: PMangaInfoData; begin Result := False; try FInfo.mangaInfo.website := Website; FInfo.mangaInfo.link := Link; - if (FMangaListPos >= 0) and + FInfo.mangaInfo.title := Title; + FInfo.ModuleId := Modules.LocateModule(Website); + data := MainForm.vtMangaList.GetNodeData(FMangaListNode); + if Assigned(FMangaListNode) and (MainForm.cbSelectManga.ItemIndex<>-1) and (website = MainForm.cbSelectManga.Items[MainForm.cbSelectManga.ItemIndex]) then begin - filterPos := MainForm.dataProcess.GetPos(FMangaListPos); - FInfo.mangaInfo.title := MainForm.dataProcess.Param[filterPos, DATA_PARAM_NAME]; - FInfo.mangaInfo.link := MainForm.dataProcess.Param[filterPos, DATA_PARAM_LINK]; - FInfo.mangaInfo.authors := MainForm.dataProcess.Param[filterPos, DATA_PARAM_AUTHORS]; - FInfo.mangaInfo.artists := MainForm.dataProcess.Param[filterPos, DATA_PARAM_ARTISTS]; - FInfo.mangaInfo.status := MainForm.dataProcess.Param[filterPos, DATA_PARAM_STATUS]; - FInfo.mangaInfo.summary := MainForm.dataProcess.Param[filterPos, DATA_PARAM_SUMMARY]; - FInfo.mangaInfo.numChapter := StrToIntDef(MainForm.dataProcess.Param[filterPos, DATA_PARAM_NUMCHAPTER], 0); - FNumChapter := StrToIntDef(MainForm.dataProcess.Param[filterPos, DATA_PARAM_NUMCHAPTER], 0); - if SitesWithoutInformation(website) or - (website = WebsiteRoots[EHENTAI_ID, 0]) then - FInfo.mangaInfo.genres := MainForm.dataProcess.Param[filterPos, DATA_PARAM_GENRES]; + if FInfo.mangaInfo.title = '' then + FInfo.mangaInfo.title := data^.title; + FInfo.mangaInfo.link := data^.link; + FInfo.mangaInfo.authors := data^.authors; + FInfo.mangaInfo.artists := data^.artists; + FInfo.mangaInfo.status := data^.status; + FInfo.mangaInfo.summary := data^.summary; + FInfo.mangaInfo.numChapter := data^.numchapter; + FInfo.mangaInfo.genres := data^.genres; + FNumChapter := data^.numchapter; end; - - FInfo.isGenerateFolderChapterName := MainForm.cbOptionGenerateChapterName.Checked; - FInfo.isRemoveUnicode := MainForm.cbOptionPathConvert.Checked; + FInfo.isGenerateFolderChapterName := OptionGenerateMangaFolder; + FInfo.isRemoveUnicode := OptionChangeUnicodeCharacter; infob := INFORMATION_NOT_FOUND; - infob := FInfo.GetInfoFromURL(Website, Link, 2); - if Self.Terminated then Exit; + //wait if there is concurrent connection limit + if Modules.MaxConnectionLimit[FInfo.ModuleId] > 0 then + begin + while not Modules.CanCreateConnection(FInfo.ModuleId) do + Sleep(SOCKHEARTBEATRATE); + Modules.IncActiveConnectionCount(FInfo.ModuleId); + end; + + infob := FInfo.GetInfoFromURL(Website, Link); + + if Terminated or isExiting then Exit; if infob <> NO_ERROR then Exit; - if FMangaListPos >= 0 then + //set back if title changed + if (FInfo.mangaInfo.title <> '') and (FInfo.mangaInfo.title <> FTitle) then + FTitle := FInfo.mangaInfo.title; + + if Assigned(data) then begin - if website = MainForm.cbSelectManga.Items[MainForm.cbSelectManga.ItemIndex] then + if dataProcess.WebsiteLoaded(Website) then begin if SitesWithoutInformation(website) then begin if FInfo.mangaInfo.authors = '' then - FInfo.mangaInfo.authors := - MainForm.DataProcess.Param[filterPos, DATA_PARAM_AUTHORS]; + FInfo.mangaInfo.authors := data^.authors; if FInfo.mangaInfo.artists = '' then - FInfo.mangaInfo.artists := - MainForm.DataProcess.Param[filterPos, DATA_PARAM_ARTISTS]; + FInfo.mangaInfo.artists := data^.artists; if FInfo.mangaInfo.genres = '' then - FInfo.mangaInfo.genres := - MainForm.DataProcess.Param[filterPos, DATA_PARAM_GENRES]; + FInfo.mangaInfo.genres := data^.genres; if FInfo.mangaInfo.summary = '' then - FInfo.mangaInfo.summary := - MainForm.DataProcess.Param[filterPos, DATA_PARAM_SUMMARY]; + FInfo.mangaInfo.summary := data^.summary; end; - FInfo.SyncInfoToData(MainForm.DataProcess, filterPos); + + if not (Terminated or isExiting) then + Synchronize(MainThreadSyncInfos); end; end; Result := True; @@ -123,25 +136,30 @@ procedure TGetMangaInfosThread.DoGetInfos; end; begin - if MainForm.cbSelectManga.ItemIndex < 0 then - Exit; try - INIAdvanced.Reload; if not GetMangaInfo then begin - if not Self.Terminated then + if not (Terminated or isExiting) then Synchronize(MainThreadShowCannotGetInfo); end else begin + if Terminated or isExiting then Exit; Synchronize(MainThreadShowInfos); FCover.Clear; // If there's cover then we will load it to the TPicture component. if OptionEnableLoadCover and (Trim(FInfo.mangaInfo.coverLink) <> '') then - FIsHasMangaCover := GetPage(FInfo.FHTTP, TObject(FCover), FInfo.mangaInfo.coverLink, 3) - else - FIsHasMangaCover := False; - Synchronize(MainThreadShowCover); + try + FInfo.FHTTP.Document.Clear; + if FInfo.FHTTP.GET(FInfo.mangaInfo.coverLink) then + begin + FCover.LoadFromStream(FInfo.FHTTP.Document); + FIsHasMangaCover := True; + end; + except + end; + if not (Terminated or isExiting) then + Synchronize(MainThreadShowCover); end; except on E: Exception do @@ -149,97 +167,71 @@ procedure TGetMangaInfosThread.DoGetInfos; end; end; -procedure TGetMangaInfosThread.Execute; -begin - MainForm.isGetMangaInfos := True; - try - DoGetInfos; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; -end; - procedure TGetMangaInfosThread.MainThreadShowCannotGetInfo; begin - if IsFlushed then - Exit; - try - MessageDlg('', RS_DlgCannotGetMangaInfo, - mtInformation, [mbYes], 0); - MainForm.rmInformation.Clear; - MainForm.itAnimate.Enabled := False; - MainForm.pbWait.Visible := False; - MainForm.imCover.Picture.Assign(nil); - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; + MessageDlg('', RS_DlgCannotGetMangaInfo, + mtInformation, [mbYes], 0); + MainForm.rmInformation.Clear; + MainForm.tmAnimateMangaInfo.Enabled := False; + MainForm.pbWait.Visible := False; + MainForm.imCover.Picture.Assign(nil); end; procedure TGetMangaInfosThread.MainThreadShowInfos; +var node: PVirtualNode; begin - if IsFlushed then Exit; - try - TransferMangaInfo(MainForm.mangaInfo, FInfo.mangaInfo); - if (Website = MainForm.cbSelectManga.Text) and - (FMangaListPos > -1) then - begin - if (FInfo.mangaInfo.title <> FTitle) or - (FInfo.mangaInfo.numChapter <> FNumChapter) then + TransferMangaInfo(mangaInfo, FInfo.mangaInfo); + with MainForm do begin + if Assigned(FMangaListNode) and dataProcess.WebsiteLoaded(Website) then begin - FTitle := FInfo.mangaInfo.title; - with MainForm.vtMangaList do - begin - ReinitNode(RootNode, True); - Repaint; + vtMangaList.BeginUpdate; + dataProcess.Refresh(dataProcess.Filtered); + vtMangaList.ReinitNode(FMangaListNode, False); + if dataProcess.Filtered then begin + node := vtMangaList.GetNextVisible(FMangaListNode, False); + while Assigned(node) do begin + vtMangaList.ReinitNode(node, False); + node := vtMangaList.GetNextVisible(node, False); + end; + vtMangaList.RootNodeCount := dataProcess.RecordCount; + MainForm.UpdateVtMangaListFilterStatus; end; + vtMangaList.EndUpdate; end; - end; - MainForm.ShowInformation(FTitle, FWebsite, FLink); - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); + ShowInformation; end; end; procedure TGetMangaInfosThread.MainThreadShowCover; begin - if IsFlushed then - Exit; - try - MainForm.itAnimate.Enabled := False; - MainForm.pbWait.Visible := False; - if FIsHasMangaCover then - begin - try - MainForm.imCover.Picture.Assign(FCover); - except - on E: Exception do ; - end; - FCover.Clear; + MainForm.tmAnimateMangaInfo.Enabled := False; + MainForm.pbWait.Visible := False; + if FIsHasMangaCover then + begin + try + MainForm.imCover.Picture.Assign(FCover); + except + on E: Exception do ; end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); + FCover.Clear; end; end; constructor TGetMangaInfosThread.Create; begin inherited Create(True); - FIsFlushed := False; FInfo := TMangaInformation.Create(Self); FCover := MainForm.mangaCover; - FMangaListPos := -1; + FIsHasMangaCover := False; + FMangaListNode := nil; end; destructor TGetMangaInfosThread.Destroy; begin - FInfo.Free; + Modules.DecActiveConnectionCount(FInfo.ModuleId); + GetInfosThread := nil; FCover := nil; - if not IsFlushed then - MainForm.isGetMangaInfos := False; + FInfo.Free; inherited Destroy; end; diff --git a/baseunits/uImg2Pdf.pas b/baseunits/uImg2Pdf.pas deleted file mode 100644 index 87f737955..000000000 --- a/baseunits/uImg2Pdf.pas +++ /dev/null @@ -1,481 +0,0 @@ -{ - File: img2pdf.pas - License: GPLv2 - This unit is a part of Free Manga Downloader -} - -unit uImg2Pdf; - -{$mode delphi} - -interface - -uses - Classes, SysUtils, ZStream, FPImage, FPReadJPEG, FPWriteJPEG, - ImagingTypes, Imaging, lazutf8classes, USimpleLogger, USimpleException; - -const - TPDFFormatSetings: TFormatSettings = ( - CurrencyFormat: 1; - NegCurrFormat: 5; - ThousandSeparator: #0; - DecimalSeparator: '.'; - CurrencyDecimals: 2; - DateSeparator: '-'; - TimeSeparator: ':'; - ListSeparator: ','; - CurrencyString: '$'; - ShortDateFormat: 'd/m/y'; - LongDateFormat: 'dd" "mmmm" "yyyy'; - TimeAMString: 'AM'; - TimePMString: 'PM'; - ShortTimeFormat: 'hh:nn'; - LongTimeFormat: 'hh:nn:ss'; - ShortMonthNames: ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', - 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); - LongMonthNames: ('January', 'February', 'March', 'April', 'May', 'June', - 'July', 'August', 'September', 'October', 'November', 'December'); - ShortDayNames: ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); - LongDayNames: ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', - 'Friday', 'Saturday'); - TwoDigitYearCenturyWindow: 50; - ); - -type - TPageInfo = record - fWidth, fHeight: Single; - imgStream : TMemoryStream; - bpc : Byte; - cs, f : String; - end; - - { TImg2Pdf } - - TImg2Pdf = class(TObject) - private - FBuffer : TMemoryStream; - FState : Integer; - FCompressionQuality, - FObjCount, - FCurrentPage: Cardinal; - FTitle : String; - FPages : array of String; - FOffsets : array of Cardinal; - FPageInfos : array of TPageInfo; - - procedure CreateNewObj; - procedure BeginPDF; - procedure EndPDF; - procedure BeginPDFPage(const AFWidth, AFHeight: Single); - procedure EndPDFPage; - procedure PDFWrite(AText: String); - function PDFString(const AText: String): String; - procedure Error(AMsg: String); - procedure AddFlateImage(const AName: String); - procedure AddDCTImage(const AName: String); - function GetImageFormat(imData: TImageData): string; - procedure SetCompressionQuality(Quality: Cardinal); - public - constructor Create; - destructor Destroy; override; - procedure AddImage(const AName: String); - procedure SaveToStream(const AStream: TStream); - procedure SaveToFile(const AFile: String); - - property Title: String read FTitle write FTitle; - property CompressionQuality: Cardinal read FCompressionQuality write SetCompressionQuality; - end; - -implementation - -// private - -procedure TImg2Pdf.CreateNewObj; -begin - Inc(FObjCount); - SetLength(FOffsets, Length(FOffsets) + 1); - FOffsets[FObjCount]:= FBuffer.Size; - PDFWrite(IntToStr(FObjCount) + ' 0 obj'); -end; - -procedure TImg2Pdf.BeginPDF; -begin - FState:= 0; - SetLength(FPages, 1); - SetLength(FPageInfos, 1); - PDFWrite('%PDF-1.7'); -end; - -procedure TImg2Pdf.EndPDF; -var - vni, vo, - vnbpal, - i : Integer; - vkids, - data: String; -begin - for i:= 1 to FCurrentPage do - begin - CreateNewObj; - - PDFWrite('<>'); - PDFWrite('endobj'); - - data:= FPages[i]; - CreateNewObj; - PDFWrite('<>'); - PDFWrite('stream'); - PDFWrite(data + 'endstream'); - PDFWrite('endobj'); - end; - - vni:= FObjCount; - for i:= 1 to FCurrentPage do - begin - CreateNewObj; - PDFWrite('<>'); - PDFWrite('stream'); - FPageInfos[i].imgStream.Position := 0; - FBuffer.CopyFrom(FPageInfos[i].imgStream, FPageInfos[i].imgStream.Size); - PDFWrite(#10 + 'endstream'); - PDFWrite('endobj'); - end; - - FOffsets[1]:= FBuffer.Size; - PDFWrite('1 0 obj'); - PDFWrite('<>'); - PDFWrite('endobj'); - - FOffsets[2]:= FBuffer.Size; - PDFWrite('2 0 obj'); - PDFWrite('<>'); - PDFWrite('/XObject <<'); - vnbpal:= 0; - for i:= 1 to FCurrentPage do - begin - PDFWrite('/I' + IntToStr(i) + ' ' + - IntToStr(vni + (i) + vnbpal) + ' 0 R'); - if (FPageInfos[i].cs = 'Indexed') then - vnbpal:= vnbpal + 1; - end; - PDFWrite('>>'); - PDFWrite('>>'); - PDFWrite('endobj'); - - CreateNewObj; - PDFWrite('< '' then - PDFWrite('/Title (' + PDFString(FTitle) + ')'); - - PDFWrite('/ModDate (D:' + FormatDateTime('yyyymmddhhnnss', now) +')'); - PDFWrite('/CreationDate (D:' + FormatDateTime('yyyymmddhhnnss', now) +')>>'); - PDFWrite('endobj'); - - CreateNewObj; - PDFWrite('<>'); - PDFWrite('endobj'); - - vo:= FBuffer.Size; - PDFWrite('xref'); - PDFWrite('0 ' + IntToStr(QWord(FObjCount) + 1)); - PDFWrite('0000000000 65535 f '); - for i:= 1 to FObjCount do - PDFWrite(Format('%.10d 00000 n ', [FOffsets[i]], TPDFFormatSetings)); - PDFWrite('trailer'); - PDFWrite('<>'); - PDFWrite('startxref'); - PDFWrite(IntToStr(vo)); - - // TODO: add compress method - - PDFWrite('%%EOF'); -end; - -procedure TImg2Pdf.BeginPDFPage(const AFWidth, AFHeight: Single); -begin - Inc(FCurrentPage); - SetLength(FPages, Length(FPages) + 1); - SetLength(FPageInfos, Length(FPageInfos) + 1); - - FPages[FCurrentPage]:= ''; - FState:= 1; - - PDFWrite(FloatToStrF(1, ffNumber, 14, 6, TPDFFormatSetings) + - ' 0 0 ' + FloatToStrF(1, ffNumber, 14, 6, TPDFFormatSetings) + - ' 0 ' + FloatToStr(AFHeight) + ' cm'); -end; - -procedure TImg2Pdf.EndPDFPage; -begin - FState:= 0; -end; - -procedure TImg2Pdf.PDFWrite(AText: String); -begin - if FState = 1 then - FPages[FCurrentPage]:= FPages[FCurrentPage] + AText + #10 - else - begin - AText := AText + #10; - FBuffer.Write(Pointer(AText)^, Length(AText)); - end; -end; - -function TImg2Pdf.PDFString(const AText: String): String; -begin - Result:= StringReplace(StringReplace(StringReplace(AText, '\', '\\', [rfReplaceAll]), - ')', '\)', [rfReplaceAll]), '(', '\(', [rfReplaceAll]); -end; - -procedure TImg2Pdf.Error(AMsg: String); -begin - raise Exception.Create('IMG2PDF error: ' + AMsg); -end; - -// public - -constructor TImg2Pdf.Create; -begin - inherited; - Imaging.SetOption(ImagingJpegProgressive, 1); - FTitle := ''; - FState := 0; - FObjCount := 2; - FCurrentPage:= 0; - FCompressionQuality:= 100; - SetLength(FPages, 0); - SetLength(FOffsets, 3); - SetLength(FPageInfos, 0); - FBuffer:= TMemoryStream.Create; - - BeginPDF; -end; - -destructor TImg2Pdf.Destroy; -var - i: Cardinal; -begin - if FCurrentPage > 0 then - for i:= 1 to FCurrentPage do - FPageInfos[i].imgStream.Free; - SetLength(FPageInfos, 0); - SetLength(FOffsets, 0); - SetLength(FPages, 0); - FBuffer.Free; - inherited; -end; - -procedure TImg2Pdf.AddFlateImage(const AName: String); -var - fs : TFileStreamUTF8; - ext : String; - im : TImageData; -begin - ext:= StringReplace(UpperCase(ExtractFileExt(AName)), '.', '', [rfReplaceAll]); - if (ext = '') then - Error('File without an extension!'); - - Initialize(im); - fs := TFileStreamUTF8.Create(AName, fmOpenRead); - try - LoadImageFromStream(fs, im); - if not Assigned(im.Bits) then Exit; - - BeginPDFPage(im.Width, im.Height); - FPageInfos[FCurrentPage].imgStream:= TMemoryStream.Create; - try - FPageInfos[FCurrentPage].cs := GetImageFormat(im); - FPageInfos[FCurrentPage].fWidth := im.Width; - FPageInfos[FCurrentPage].fHeight:= im.Height; - FPageInfos[FCurrentPage].bpc := 8; - PDFWrite('q ' + FloatToStr(im.Width) + ' 0 0 ' + FloatToStr(im.Height) + - ' 0 -' + FloatToStr(im.Height) + ' cm /I' + - IntToStr(FCurrentPage) + ' Do Q'); - - if (ext = 'JPG') or (ext = 'JPEG') then - begin - FPageInfos[FCurrentPage].f := 'DCTDecode'; - FPageInfos[FCurrentPage].imgStream.CopyFrom(fs, 0); - end - else - begin - FPageInfos[FCurrentPage].f := 'FlateDecode'; - if GetImageFormat(im) = 'DeviceRGB' then try - SwapChannels(im, ChannelRed, ChannelBlue); - except - end; - FPageInfos[FCurrentPage].imgStream.Position := 0; - with Tcompressionstream.create(clmax, FPageInfos[FCurrentPage].imgStream) do try - write(im.Bits^, im.Size); - finally - Free; - end; - end; - finally - EndPDFPage; - end; - except - on E :Exception do begin - WriteLog_E('TImg2Pdf.AddFlateImage.Error, '+E.Message); - USimpleException.ExceptionHandleSaveLogOnly(Self, E); - end; - end; - fs.Free; - FreeImage(im); -end; - -procedure TImg2Pdf.AddDCTImage(const AName: String); -var - fs : TFileStreamUTF8; - im : TImageData; - ext : string; -begin - ext := StringReplace(UpperCase(ExtractFileExt(AName)), '.', '', [rfReplaceAll]); - if (ext = '') then - Error('File without an extension!'); - - Initialize(im); - fs:= TFileStreamUTF8.Create(AName, fmOpenRead); - try - LoadImageFromStream(fs, im); - finally - fs.Free; - end; - if not Assigned(im.Bits) then Exit; - - BeginPDFPage(im.Width, im.Height); - FPageInfos[FCurrentPage].imgStream := TMemoryStream.Create; - try - FPageInfos[FCurrentPage].cs := GetImageFormat(im); - FPageInfos[FCurrentPage].fWidth := im.Width; - FPageInfos[FCurrentPage].fHeight:= im.Height; - FPageInfos[FCurrentPage].bpc := 8; - FPageInfos[FCurrentPage].f := 'DCTDecode'; - PDFWrite('q ' + FloatToStr(im.Width) + ' 0 0 ' + FloatToStr(im.Height) + - ' 0 -' + FloatToStr(im.Height) + ' cm /I' + - IntToStr(FCurrentPage) + ' Do Q'); - - SaveImageToStream('jpg', FPageInfos[FCurrentPage].imgStream, im); - except - on E :Exception do begin - WriteLog_E('TImg2Pdf.AddCDTImage.Error, '+E.Message); - USimpleException.ExceptionHandleSaveLogOnly(Self, E); - end; - end; - EndPDFPage; - FreeImage(im); -end; - -function TImg2Pdf.GetImageFormat(imData: TImageData): string; -begin - case imData.Format of - ifGray8, - ifA8Gray8, - ifGray16, - ifGray32, - ifGray64, - ifA16Gray16: Result := 'DeviceGray'; - - ifUnknown, - ifDefault, - ifIndex8, - ifX5R1G1B1, - ifR3G3B2, - ifR5G6B5, - ifA1R5G5B5, - ifA4R4G4B4, - ifX1R5G5B5, - ifX4R4G4B4, - ifR8G8B8, - ifA8R8G8B8, - ifX8R8G8B8, - ifR16G16B16, - ifA16R16G16B16, - ifB16G16R16, - ifA16B16G16R16, - ifR32F, - ifA32R32G32B32F, - ifA32B32G32R32F, - ifR16F, - ifA16R16G16B16F, - ifA16B16G16R16F, - ifR32G32B32F, - ifB32G32R32F: Result := 'DeviceRGB'; - else - Result := 'DeviceCMYK'; - end; -end; - -procedure TImg2Pdf.SetCompressionQuality(Quality: Cardinal); -begin - FCompressionQuality := Quality; - Imaging.SetOption(ImagingJpegQuality, FCompressionQuality); -end; - -procedure TImg2Pdf.AddImage(const AName: String); -begin - if FCompressionQuality = 100 then - AddFlateImage(AName) - else - AddDCTImage(AName); -end; - -procedure TImg2Pdf.SaveToStream(const AStream: TStream); -begin - // close PDF - if FCurrentPage = 0 then exit; - EndPDFPage; - EndPDF; - - // save to stream - try - FBuffer.Position:= 0; - AStream.CopyFrom(FBuffer, FBuffer.Size); - finally - end; -end; - -procedure TImg2Pdf.SaveToFile(const AFile: String); -var - fstream: TFileStreamUTF8; -begin - if FCurrentPage = 0 then exit; - EndPDFPage; - EndPDF; - - // save to file - try - FBuffer.Position:= 0; - fstream:= TFileStreamUTF8.Create(AFile, fmCreate); - fstream.CopyFrom(FBuffer, FBuffer.Size); - finally - fstream.Free; - end; -end; - -end. - diff --git a/baseunits/uMisc.pas b/baseunits/uMisc.pas index ac05e7ccc..4c563c2a2 100644 --- a/baseunits/uMisc.pas +++ b/baseunits/uMisc.pas @@ -1,101 +1,75 @@ -unit uMisc; +unit uMisc; {$mode objfpc}{$H+} interface uses - Classes, SysUtils, Graphics, strutils, syncobjs, IniFiles, - NaturalSortUnit; + {$ifdef windows} + ShellApi, Windows, + {$else} + UTF8Process, + {$endif} + Classes, SysUtils, strutils; type - TIniFileR = class(TMemIniFile) - private - FCSReload: TCriticalSection; - FFileAge: longint; - public - constructor Create(const AFileName: String; AEscapeLineFeeds: Boolean = False); - override; - destructor Destroy; override; - procedure Reload; - end; + TArrayOfString = array of String; //String utils -procedure padZero(var S: String; VolLength, ChapLength: Integer); -function padZeros(const S: String; VolLength, ChapLength: Integer): String; -function BrackText(const S: String): String; overload; -function BrackText(const S: Integer): String; overload; -function BrackSquareText(const S: String): String; overload; -function BrackSquareText(const S: Integer): String; overload; -function BrackTextQuoted(const S: String): String; overload; -function BrackTextQuoted(const S: Integer): String; overload; +procedure VolumeChapterPadZero(var S: String; VolLength, ChapLength: Integer); +function padZeros(const S: String; VolLength, ChapLength: Integer): String; inline; +function BrackText(const S: String): String; overload; inline; +function BrackText(const S: Integer): String; overload; inline; +function BrackSquareText(const S: String): String; overload; inline; +function BrackSquareText(const S: Integer): String; overload; inline; +function BrackTextQuoted(const S: String): String; overload; inline; +function BrackTextQuoted(const S: Integer): String; overload; inline; function StringToASCII(S: String): String; function StringToHex(S: String): String; -procedure QuickSortNaturalPart(var Alist: TStringList; Separator: String; - PartIndex: Integer); - -//Images -function MangaFoxRemoveWatermarks(const Filename: String): Boolean; - //Searching function FindStrLinear(aList: TStrings; aValue: String): Boolean; function FindStrLinearPos(aList: TStrings; aValue: String): Integer; //formatting -function FormatByteSize(const bytes :longint; persecond: boolean = False) :string; - -//sorting -function NaturalCompareStr(Str1, Str2: string): integer; +function FormatByteSize(const bytes: Longint; persecond: Boolean = False): String; + +//run external process +function RunExternalProcessAsAdmin(Exe, Params: String; ShowWind: Boolean = True; + isPersistent: Boolean = True): Boolean; +function RunExternalProcess(Exe: String; Params: array of String; ShowWind: Boolean = True; + isPersistent: Boolean = True): Boolean; overload; +function RunExternalProcess(Exe, Params: String; ShowWind: Boolean = True; + isPersistent: Boolean = True): Boolean; overload; +function RunExternalProcess(CommandLine: String; ShowWind: Boolean = True; + isPersistent: Boolean = True): Boolean; overload; + +//stringutils +procedure ParseCommandLine(const cmd: String; var Output: TStrings; + AStripQuotes: Boolean = False); +function ParsedCommandLine(const cmd: String): TArrayOfString; +function StringsToArray(const S: TStrings): TArrayOfString; +function StringsToCommandLine(const S: TStrings): String; overload; +function StringsToCommandLine(const S: array of String): String; overload; +procedure DeleteArrayOfString(var TheStrings: TArrayOfString; Index: Integer); const - UA_CURL = 'curl/7.42.1'; - UA_MSIE = 'Mozilla/5.0 (compatible; WOW64; MSIE 10.0; Windows NT 6.2)'; - UA_FIREFOX = 'Mozilla/5.0 (Windows NT 6.3; WOW64; rv:37.0) Gecko/20100101 Firefox/37.0'; - UA_CHROME = 'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Safari/537.36'; - UA_OPERA = 'Mozilla/5.0 (Windows NT 6.3; WOW64; rv:37.0) Gecko/20100101 Firefox/37.0'; + UA_SYNAPSE = 'Mozilla/4.0 (compatible; Synapse)'; + UA_CURL = 'curl/7.42.1'; UA_GOOGLEBOT = 'Mozilla/5.0 (compatible; Googlebot/2.1; http://www.google.com/bot.html)'; + UA_MSIE = 'Mozilla/5.0 (compatible; WOW64; MSIE 10.0; Windows NT 6.2)'; + UA_FIREFOX = 'Mozilla/5.0 (Windows NT 6.3; WOW64; rv:39.0) Gecko/20100101 Firefox/39.0'; + UA_CHROME = + 'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.125 Safari/537.36'; + UA_OPERA = + 'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/43.0.2357.130 Safari/537.36 OPR/30.0.1835.125'; RANDOM_SLEEP = 3000; -implementation - -{ TIniFileR } - -constructor TIniFileR.Create(const AFileName: String; AEscapeLineFeeds: Boolean = False); -begin - inherited Create(AFileName, AEscapeLineFeeds); - FCSReload := TCriticalSection.Create; - FFileAge := FileAge(Self.FileName); -end; - -destructor TIniFileR.Destroy; -begin - FCSReload.Free; - inherited Destroy; -end; - -procedure TIniFileR.Reload; var - slLines: TStringList; -begin - if FCSReload.TryEnter then try - if FileExists(FileName) then - if FileAge(FileName) <> FFileAge then - begin - slLines := TStringList.Create; - try - FFileAge := FileAge(FileName); - slLines.LoadFromFile(FileName); - SetStrings(slLines); - finally - slLines.Free; - end; - end; - finally - FCSReload.Release; - end; -end; + DEFAULT_UA: String = UA_CHROME; + +implementation { uMisc } @@ -119,21 +93,21 @@ function BrackSquareText(const S: Integer): String; Result := BrackText(IntToStr(S)); end; -function BrackTextQuoted(const S : String) : String; +function BrackTextQuoted(const S: String): String; begin Result := BrackText(QuotedStr(S)); end; -function BrackTextQuoted(const S : Integer) : String; +function BrackTextQuoted(const S: Integer): String; begin Result := BrackText(QuotedStr(IntToStr(S))); end; -function StringToASCII(S : String) : String; +function StringToASCII(S: String): String; var i: Integer; begin - Result:='#0'; + Result := '#0'; if Length(S) > 0 then begin Result := ''; @@ -142,11 +116,11 @@ function StringToASCII(S : String) : String; end; end; -function StringToHex(S : String) : String; +function StringToHex(S: String): String; var i: Integer; begin - Result:='#0'; + Result := '#0'; if Length(S) > 0 then begin Result := ''; @@ -155,13 +129,13 @@ function StringToHex(S : String) : String; end; end; -procedure padZero(var S: String; VolLength, ChapLength: Integer); +procedure VolumeChapterPadZero(var S: String; VolLength, ChapLength: Integer); procedure searchChap(var i, cstart, clength: Integer; var t: String); var j: Integer; begin - for j := i to Length(t) do + for j := i to Length(t) do begin if (cstart = -1) and (t[j] in ['0'..'9']) then cstart := j @@ -211,7 +185,7 @@ procedure padZero(var S: String; VolLength, ChapLength: Integer); vlength := 1; if vol then begin - for i := Pos('VOL', upcase(t)) to Length(t) do + for i := Pos('VOL', upcase(t)) to Length(t) do begin if (vstart = -1) and (t[i] in ['0'..'9']) then vstart := i @@ -299,115 +273,7 @@ procedure padZero(var S: String; VolLength, ChapLength: Integer); function padZeros(const S: String; VolLength, ChapLength: Integer): String; begin Result := S; - padZero(Result, VolLength, ChapLength); -end; - -//loading directly from stream accepted as raw (file become bigger) -//Not all mangafox image has watermarks, old manga doesn't have watermarks -//recognizing by file age or by scanning images manually. -function MangaFoxRemoveWatermarks(const Filename: String): Boolean; -var - fpic: TPicture; -begin - Result := False; - Exit; //Disable for a moment - fpic := TPicture.Create; - try - fpic.LoadFromFile(Filename); - if fpic.Bitmap.Height < 100 then - Exit; - fpic.Bitmap.Height := fpic.Bitmap.Height - 90;// crop by 90px - if FileExists(Filename) then - DeleteFile(Filename); - fpic.SaveToFile(Filename); - Result := True; - finally - fpic.Free; - end; -end; - -function getStringPart(const txt, sep: String; partIndex: Cardinal): String; -var - i, j, lpos, rpos: Integer; -begin - lpos := 1; - rpos := 1; - Result := ''; - - for i := 0 to partIndex do - begin - j := PosEx(sep, txt, rpos); - if (j > 0) then - begin - lpos := rpos; - rpos := j + Length(sep); - end - else - Break; - end; - Result := Copy(txt, lpos, rpos - lpos - Length(sep)); -end; - -function NaturalCompareStr(Str1, Str2: string): integer; -begin - Result := NaturalSortUnit.UTF8LogicalCompareText(Str1, Str2); -end; - -procedure QuickSortNaturalPart(var Alist: TStringList; Separator: String; - PartIndex: Integer); - - function CompareFn(Index1, Index2: Integer): Integer; - begin - Result := NaturalCompareStr(getStringPart(Alist[Index1], Separator, PartIndex), - getStringPart(Alist[Index2], Separator, PartIndex)); - end; - - procedure QSort(L, R: Integer); - var - Pivot, vL, vR: Integer; - begin - if R - L <= 1 then begin // a little bit of time saver - if L < R then - if CompareFn(L, R) > 0 then - Alist.Exchange(L, R); - - Exit; - end; - - vL := L; - vR := R; - - Pivot := L + Random(R - L); // they say random is best - - while vL < vR do begin - while (vL < Pivot) and (CompareFn(vL, Pivot) <= 0) do - Inc(vL); - - while (vR > Pivot) and (CompareFn(vR, Pivot) > 0) do - Dec(vR); - - Alist.Exchange(vL, vR); - - if Pivot = vL then // swap pivot if we just hit it from one side - Pivot := vR - else if Pivot = vR then - Pivot := vL; - end; - - if Pivot - 1 >= L then - QSort(L, Pivot - 1); - if Pivot + 1 <= R then - QSort(Pivot + 1, R); - end; - -begin - if Alist.Count < 2 then Exit; - Alist.BeginUpdate; - try - QSort(0, Alist.Count - 1); - finally - Alist.EndUpdate; - end; + VolumeChapterPadZero(Result, VolLength, ChapLength); end; function FindStrLinearPos(aList: TStrings; aValue: String): Integer; @@ -433,9 +299,9 @@ function FindStrLinear(aList: TStrings; aValue: String): Boolean; Result := False; end; -function FormatByteSize(const bytes :longint; persecond: boolean = False) :string; +function FormatByteSize(const bytes: Longint; persecond: Boolean = False): String; const - B = 1; + B = 1; KB = 1024 * B; MB = 1024 * KB; GB = 1024 * MB; @@ -467,4 +333,336 @@ function FormatByteSize(const bytes :longint; persecond: boolean = False) :strin Result := Result + 'ps'; end; + +function RunExternalProcessAsAdmin(Exe, Params: String; ShowWind: Boolean; + isPersistent: Boolean): Boolean; +var + {$IFDEF WINDOWS} + SEInfo: TSHELLEXECUTEINFOW; + {$ELSE} + Process: TProcessUTF8; + pr: TStringList; + {$ENDIF} +begin + {$IFDEF WINDOWS} + Initialize(SEInfo); + FillChar(SEInfo, SizeOf(SEInfo), 0); + SEInfo.cbSize := SizeOf(SEInfo); + with SEInfo do begin + wnd := 0; + fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; + if isPersistent then + fMask := fMask or SEE_MASK_NOCLOSEPROCESS; + lpVerb := 'runas'; + lpFile := PWideChar(UTF8Decode(Exe)); + lpParameters := PWideChar(UTF8Decode(Params)); + if ShowWind then + nShow := SW_SHOWNORMAL + else + nShow := SW_HIDE; + end; + Result := ShellExecuteExW(@SEInfo); + if isPersistent then + WaitForSingleObject(SEInfo.hProcess, INFINITE); + {$ELSE} + Process := TProcessUTF8.Create(nil); + try + Process.Executable := Exe; + pr := TStringList.Create; + try + ParseCommandLine(Params, TStrings(pr), True); + Process.Parameters.Assign(pr); + finally + pr.Free; + end; + Process.Execute; + finally + Process.Free; + end; + {$ENDIF} +end; + +{$ifdef windows} +function WinRunProcessA(Exe, Params: String; ShowWind: Boolean; isPersistent: Boolean): Boolean; +var + SEInfo: TSHELLEXECUTEINFOA; +begin + Initialize(SEInfo); + FillChar(SEInfo, SizeOf(SEInfo), 0); + SEInfo.cbSize := SizeOf(TSHELLEXECUTEINFOA); + with SEInfo do begin + wnd := 0; + fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; + if isPersistent then + fMask := fMask or SEE_MASK_NOCLOSEPROCESS; + lpFile := PChar(Utf8ToAnsi(Exe)); + lpParameters := PChar(Utf8ToAnsi(Params)); + if ShowWind then + nShow := SW_SHOWNORMAL + else + nShow := SW_HIDE; + end; + Result := ShellExecuteExA(@SEInfo); + if isPersistent then + WaitForSingleObject(SEInfo.hProcess, INFINITE); +end; + +function WinRunProcessW(Exe, Params: String; ShowWind: Boolean; isPersistent: Boolean): Boolean; +var + SEInfo: TSHELLEXECUTEINFOW; +begin + Initialize(SEInfo); + FillChar(SEInfo, SizeOf(SEInfo), 0); + SEInfo.cbSize := SizeOf(TSHELLEXECUTEINFOW); + with SEInfo do begin + wnd := 0; + fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI; + if isPersistent then + fMask := fMask or SEE_MASK_NOCLOSEPROCESS; + lpFile := PWideChar(UTF8Decode(Exe)); + lpParameters := PWideChar(UTF8Decode(Params)); + if ShowWind then + nShow := SW_SHOWNORMAL + else + nShow := SW_HIDE; + end; + Result := ShellApi.ShellExecuteExW(@SEInfo); + if isPersistent then + WaitForSingleObject(SEInfo.hProcess, INFINITE); +end; + +{$endif} + +function RunExternalProcess(Exe: String; Params: array of String; + ShowWind: Boolean; isPersistent: Boolean): Boolean; +{$ifndef windows} +var + Process: TProcessUTF8; + I: Integer; +{$endif} +begin + if Trim(Exe) = '' then Exit(False); + Result := True; + {$ifdef windows} + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := WinRunProcessW(Exe, StringsToCommandLine(Params), ShowWind, isPersistent) + else + Result := WinRunProcessA(Exe, StringsToCommandLine(Params), ShowWind, isPersistent); + {$else} + Process := TProcessUTF8.Create(nil); + try + Process.InheritHandles := isPersistent; + Process.Executable := Exe; + Process.Parameters.AddStrings(Params); + if isPersistent then + Process.Options := Process.Options + [poWaitOnExit] + else + Process.Options := []; + if ShowWind then + Process.ShowWindow := swoShow + else + Process.ShowWindow := swoHIDE; + // Copy default environment variables including DISPLAY variable for GUI application to work + for I := 0 to GetEnvironmentVariableCount - 1 do + Process.Environment.Add(GetEnvironmentString(I)); + Process.Execute; + except + on E: Exception do + begin + WriteLog_E('RunExternalProcess.Error '#13#10 + + 'Executable: ' + Exe + #13#10 + + 'Parameters: ' + StringsToCommandLine(Params) + #13#10 + + 'Message : ' + E.Message + #13#10 + + GetStackTraceInfo); + end; + end; + Process.Free; + {$endif} +end; + +function RunExternalProcess(Exe, Params: String; ShowWind: Boolean; + isPersistent: Boolean): Boolean; +begin + if Trim(Exe) = '' then Exit(False); + {$ifdef windows} + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := WinRunProcessW(Exe, Params, ShowWind, isPersistent) + else + Result := WinRunProcessA(Exe, Params, ShowWind, isPersistent); + {$else} + Result := RunExternalProcess(Exe, ParsedCommandLine(Params), ShowWind, isPersistent); + {$endif} +end; + +function RunExternalProcess(CommandLine: String; ShowWind: Boolean; + isPersistent: Boolean): Boolean; +var + s: String; + sa: TArrayOfString; +begin + if Trim(CommandLine) = '' then Exit(False); + try + sa := ParsedCommandLine(CommandLine); + s := sa[Low(sa)]; + DeleteArrayOfString(sa, Low(sa)); + {$ifdef windows} + if Win32Platform = VER_PLATFORM_WIN32_NT then + Result := WinRunProcessW(s, StringsToCommandLine(sa), ShowWind, isPersistent) + else + Result := WinRunProcessA(s, StringsToCommandLine(sa), ShowWind, isPersistent); + {$else} + Result := RunExternalProcess(s, sa, ShowWind, isPersistent); + {$endif} + finally + SetLength(sa, 0); + end; +end; + +procedure ParseCommandLine(const cmd: String; var Output: TStrings; + AStripQuotes: Boolean = False); +var + s, cl: String; + cq: Integer; + acl, lq: Boolean; + + procedure Addcl; + begin + if cl <> '' then + begin + if AStripQuotes and (Length(cl) > 1) then + begin + if cl[1] = '"' then + Delete(cl, 1, 1); + if cl[Length(cl)] = '"' then + Delete(cl, Length(cl), 1); + end; + Output.Add(cl); + cl := ''; + acl := False; + end; + end; + +begin + if not Assigned(Output) then Exit; + Output.Clear; + Output.BeginUpdate; + try + s := cmd; + cl := ''; + cq := 0; + lq := False; + while s <> '' do + begin + acl := True; + if s[1] = '"' then + begin + Inc(cq); + lq := True; + end + else + begin + if s[1] = ' ' then + begin + if cq > 0 then + begin + if (not odd(cq)) and lq then + begin + cq := 0; + Addcl; + end; + end + else + Addcl; + end; + lq := False; + end; + if acl then + cl := cl + s[1]; + Delete(s, 1, 1); + end; + Addcl; + finally + Output.EndUpdate; + end; +end; + +function ParsedCommandLine(const cmd: String): TArrayOfString; +var + ts: TStrings; +begin + if cmd = '' then Exit; + ts := TStringList.Create; + try + ParseCommandLine(cmd, ts, True); + Result := StringsToArray(ts); + finally + ts.Free; + end; +end; + +function StringsToArray(const S: TStrings): TArrayOfString; +var + i: Integer; +begin + SetLength(Result, 0); + if not Assigned(S) then Exit; + if S.Count = 0 then Exit; + SetLength(Result, S.Count); + for i := 0 to S.Count - 1 do + Result[i] := S[i]; +end; + +function StringsToCommandLine(const S: TStrings): String; +var + i: Integer; +begin + Result := ''; + if S.Count > 0 then + begin + for i := 0 to S.Count - 1 do + begin + if Pos(' ', S[i]) <> 0 then + Result := Result + '"' + S[i] + '" ' + else + Result := Result + S[i] + ' '; + end; + Result := Trim(Result); + end; +end; + +function StringsToCommandLine(const S: array of String): String; +var + i: Integer; +begin + Result := ''; + if Length(S) > 0 then + begin + for i := Low(S) to High(S) do + begin + if (Pos(' ', S[i]) <> 0) and + ((LeftStr(S[i], 1) <> '"') and (RightStr(S[i], 1) <> '"')) then + Result := Result + '"' + S[i] + '" ' + else + Result := Result + S[i] + ' '; + end; + Result := Trim(Result); + end; +end; + +procedure DeleteArrayOfString(var TheStrings: TArrayOfString; Index: Integer); +var + i: Integer; +begin + if (Index < Low(TheStrings)) and (Index > High(TheStrings)) then Exit; + if Length(TheStrings) > 0 then + begin + if Index < High(TheStrings) then + begin + for i := Index to High(TheStrings) - 1 do + TheStrings[i] := TheStrings[i + 1]; + end; + SetLength(TheStrings, Length(TheStrings) - 1); + end; +end; + end. diff --git a/baseunits/uOption.pas b/baseunits/uOption.pas deleted file mode 100644 index 632a228f3..000000000 --- a/baseunits/uOption.pas +++ /dev/null @@ -1,21 +0,0 @@ -unit uOption; - -{$mode delphi} - -interface - -uses - Classes, SysUtils, IniFiles; - -type - TOption = class - public - - protected - - end; - -implementation - -end. - diff --git a/baseunits/uPacker.pas b/baseunits/uPacker.pas index 9c2fe64ce..782a6820e 100644 --- a/baseunits/uPacker.pas +++ b/baseunits/uPacker.pas @@ -11,162 +11,208 @@ interface uses - Classes, FileUtil, Zipper, SysUtils, uBaseUnit, uImg2Pdf, USimpleException, - USimpleLogger; + Classes, Zipper, zstream, SysUtils, uBaseUnit, Img2Pdf, FileUtil, lazutf8classes, + LazFileUtils, SimpleException, uEpub; type + TPackerFormat = (pfZIP, pfCBZ, pfPDF, pfEPUB); + + { TPacker } + TPacker = class protected - list: TStringList; - procedure OnFileFound(FileIterator: TFileIterator); - public - ext, Path: String; - CompressionQuality: Cardinal; + FSavedFileName, FExt: String; + FFileList: TStringList; + procedure FileFound(FileIterator: TFileIterator); procedure DoZipCbz; procedure DoPdf; - procedure Execute; + procedure DoEpub; + public + Path, + FileName: String; + Format: TPackerFormat; + CompressionQuality: Cardinal; + function Execute: Boolean; + property FileList: TStringList read FFileList; + property SavedFileName: String read FSavedFileName; + property Ext: String read FExt; + public + constructor Create; + destructor Destroy; override; end; implementation -uses - lazutf8classes; - -procedure TPacker.OnFileFound(FileIterator: TFileIterator); +procedure TPacker.FileFound(FileIterator: TFileIterator); begin - list.Add(FileIterator.Filename); + FFileList.Add(FileIterator.Filename); end; procedure TPacker.DoZipCbz; var - s, fPath: String; - searcher: TFileSearcher; - Zip: TZipper; - i: Cardinal; - fstream: TFileStreamUTF8; + i: Integer; begin - try - fPath := Trim(Path); - RenameFileUTF8(Path, fPath); - list := TStringList.Create; - searcher := TFileSearcher.Create; - searcher.OnFileFound := OnFileFound; - searcher.Search(fPath, '*.jpg;*.jpeg;*.png;*.gif;*.db', False, False); - - if list.Count > 0 then - begin - Zip := TZipper.Create; + with TZipper.Create do + try try - Zip.FileName := fPath + ext; - for i := 0 to list.Count - 1 do + FileName := FSavedFileName; + for i := 0 to FFileList.Count - 1 do + with Entries.AddFileEntry(FFileList[i]) do + begin + CompressionLevel := clnone; + ArchiveFileName := ExtractFileName(FFileList[i]); + end; + ZipAllFiles; + except + on E: Exception do begin - s := list[i]; - {$IFDEF WINDOWS} - s := StringReplace(s, '/', '\', [rfReplaceAll]); - {$ENDIF} - Zip.Entries.AddFileEntry(TFileStreamUTF8.Create(s, fmOpenRead), - ExtractFileName(s)); + E.Message := 'DoZipCbz.Exception'#13#10 + E.Message; + SimpleException.ExceptionHandleSaveLogOnly(Self, E); end; - fstream := TFileStreamUTF8.Create(fPath + ext, fmCreate); + end; + finally + Free; + end; +end; + +procedure TPacker.DoPdf; +var + pdf: TImg2Pdf; + i: Cardinal; + fstream: TFileStreamUTF8; +begin + try + pdf := TImg2Pdf.Create; + try + pdf.CompressionQuality := CompressionQuality; + pdf.Infos.Title := GetLastDir(Path); + pdf.Infos.Creator := ApplicationName; + for i := 0 to FFileList.Count - 1 do + begin try - Zip.SaveToStream(fstream); - finally - fstream.Free; + pdf.AddImage(FFileList[i]); + except end; + end; - for i := 0 to list.Count - 1 do - begin - Zip.Entries[i].Stream.Free; - end; + fstream := TFileStreamUTF8.Create(FSavedFileName, fmCreate); + try + pdf.SaveToStream(fstream); finally - Zip.Free; + fstream.Free; end; - - //for i := 0 to list.Count - 1 do - //begin - // DeleteFileUTF8(list[i]); - //end; - if DeleteDirectory(fPath, False) then - RemoveDirUTF8(fPath); - RenameFileUTF8(fPath + ext, Path + ext); + finally + pdf.Free; end; - searcher.Free; - list.Free; except on E: Exception do begin - E.Message := 'DoZipCbz.Exception'#13#10 + E.Message; - USimpleException.ExceptionHandleSaveLogOnly(Self, E); + E.Message := 'DoPdf.Exception'#13#10 + E.Message; + SimpleException.ExceptionHandleSaveLogOnly(Self, E); end; end; end; -procedure TPacker.DoPdf; +procedure TPacker.DoEpub; var - s, fPath: String; - searcher: TFileSearcher; - pdf: TImg2Pdf; - i: Cardinal; + epub: TEpubBuilder; + i: Integer; fstream: TFileStreamUTF8; begin try - // Path:= FixPath(Path); - fPath := Trim(Path); - RenameFileUTF8(Path, fPath); - list := TStringList.Create; - searcher := TFileSearcher.Create; - searcher.OnFileFound := OnFileFound; - searcher.Search(fPath, '*.jpg;*.jpeg;*.png;*.gif', False, False); - - if list.Count <> 0 then - begin - pdf := TImg2Pdf.Create; - pdf.CompressionQuality := CompressionQuality; - pdf.Title := GetLastDir(Path); - // pdf.FileName:= fPath+ext; - for i := 0 to list.Count - 1 do + epub := TEpubBuilder.Create; + try + epub.Title := GetLastDir(Path); + for i := 0 to FFileList.Count - 1 do begin - s := list[i]; - {$IFDEF WINDOWS} - s := StringReplace(s, '/', '\', [rfReplaceAll]); - {$ENDIF} - // add image to PDF try - pdf.AddImage(s); + epub.AddImage(FFileList[i]); except end; end; - fstream := TFileStreamUTF8.Create(fPath + ext, fmCreate); - pdf.SaveToStream(fstream); - fstream.Free; - pdf.Free; - //searcher.Search(fPath, '*.db', False, False); - //for i := 0 to list.Count - 1 do - // DeleteFileUTF8(list.Strings[i]); - if DeleteDirectory(fPath, False) then - RemoveDirUTF8(fPath); - RenameFileUTF8(fPath + ext, Path + ext); + fstream := TFileStreamUTF8.Create(FSavedFileName, fmCreate); + try + epub.SaveToStream(fstream); + finally + fstream.Free; + end; + finally + epub.Free; end; - searcher.Free; - list.Free; except on E: Exception do begin - E.Message := 'DoPdf.Exception'#13#10 + E.Message; - USimpleException.ExceptionHandleSaveLogOnly(Self, E); + E.Message := 'DoEpub.Exception'#13#10 + E.Message; + SimpleException.ExceptionHandleSaveLogOnly(Self, E); end; end; end; -procedure TPacker.Execute; +function TPacker.Execute: Boolean; +var + i: Integer; begin - if (ext = '.zip') or (ext = '.cbz') then + Result := False; + Path := CorrectPathSys(Path); + + if FFileList.Count = 0 then begin - DoZipCbz; - end + if DirectoryExistsUTF8(Path) = False then Exit; + with TFileSearcher.Create do + try + OnFileFound := FileFound; + Search(Self.Path, '*.jpg;*.png;*.gif;*.webp', False, False); + finally + Free; + end; + end; + + if FFileList.Count = 0 then Exit; + + FFileList.CustomSort(NaturalCustomSort); + case Format of + pfZIP: FExt := '.zip'; + pfCBZ: FExt := '.cbz'; + pfPDF: FExt := '.pdf'; + pfEPUB: FExt := '.epub'; + end; + if FileName <> '' then + FSavedFileName := FileName + FExt else - DoPdf; + FSavedFileName := TrimAndExpandFilename(Path) + FExt; + if FileExistsUTF8(FSavedFileName) then + if DeleteFileUTF8(FSavedFileName) = False then + Exit; + case Format of + pfZIP, pfCBZ: DoZipCbz; + pfPDF: DoPdf; + pfEPUB: DoEpub; + end; + Result := FileExistsUTF8(FSavedFileName); + if Result then + begin + for i := 0 to FFileList.Count - 1 do + DeleteFileUTF8(FFileList[i]); + if IsDirectoryEmpty(Path) then + RemoveDirUTF8(Path); + end; +end; + +constructor TPacker.Create; +begin + FFileList := TStringList.Create; + FSavedFileName := ''; + FExt := ''; + Path := ''; + FileName := ''; + Format := pfZIP; +end; + +destructor TPacker.Destroy; +begin + FFileList.Free; + inherited Destroy; end; end. diff --git a/baseunits/uSilentThread.pas b/baseunits/uSilentThread.pas index 41d1ad2f8..6d7e023c1 100644 --- a/baseunits/uSilentThread.pas +++ b/baseunits/uSilentThread.pas @@ -15,34 +15,36 @@ interface uses - Classes, SysUtils, uBaseUnit, uData, uFMDThread, uDownloadsManager, - blcksock, syncobjs; + SysUtils, fgl, uBaseUnit, uData, uDownloadsManager, + WebsiteModules, FMDOptions, httpsendthread, BaseThread, LazFileUtils; type TMetaDataType = (MD_DownloadAll, MD_AddToFavorites); TSilentThreadMetaData = class + private + ModuleId: Integer; public MetaDataType: TMetaDataType; Website, Title, URL, SaveTo: String; - constructor Create(const AType: TMetaDataType; const AWebsite, AManga, - AURL, APath: String); + constructor Create(const AType: TMetaDataType; + const AWebsite, AManga, AURL, APath: String); end; TSilentThreadManager = class; { TSilentThread } - TSilentThread = class(TFMDThread) + TSilentThread = class(TBaseThread) protected FSavePath: String; Info: TMangaInformation; Freconnect: Cardinal; // manga information from main thread title, website, URL: String; + ModuleId: Integer; procedure MainThreadAfterChecking; virtual; - procedure MainThreadUpdateStatus; procedure Execute; override; public Manager: TSilentThreadManager; @@ -58,22 +60,41 @@ TSilentAddToFavThread = class(TSilentThread) procedure MainThreadAfterChecking; override; end; + { TSilentThreadManagerThread } + + TSilentThreadManagerThread = class(TBaseThread) + protected + procedure Checkout; + procedure Execute; override; + public + Manager: TSilentThreadManager; + destructor Destroy; override; + end; + + TSilentThreadMetaDatas = TFPGList; + TSilentThreads = TFPGList; + { TSilentThreadManager } TSilentThreadManager = class - protected - function GetItemCount: Integer; + private + FCS_META: TRTLCriticalSection; + FCS_THREADS: TRTLCriticalSection; + FLockAdd: Boolean; + FManagerThread: TSilentThreadManagerThread; + function GetCount: Integer; + procedure StartManagerThread; + procedure Checkout(Index: Integer); public - CS_Threads: TCriticalSection; - DLManager: TDownloadManager; - MetaData: TFPList; - Threads: TFPList; + MetaDatas: TSilentThreadMetaDatas; + Threads: TSilentThreads; procedure Add(AType: TMetaDataType; AWebsite, AManga, AURL: String; ASavePath: String = ''); - procedure CheckOut; procedure StopAll(WaitFor: Boolean = True); procedure UpdateLoadStatus; - property ItemCount: Integer read GetItemCount; + procedure BeginAdd; + procedure EndAdd; + property Count: Integer read GetCount; constructor Create; destructor Destroy; override; end; @@ -84,61 +105,113 @@ TSilentThreadManager = class implementation uses - frmMain; + frmMain, FMDVars; + +{ TSilentThreadManagerThread } + +procedure TSilentThreadManagerThread.Checkout; +var + i: Integer; +begin + if Terminated then Exit; + if Manager.MetaDatas.Count = 0 then Exit; + with Manager do + begin + i := 0; + while i < MetaDatas.Count do + begin + if Terminated then Break; + with MetaDatas[i] do + if (Threads.Count < OptionMaxThreads) and Modules.CanCreateConnection(ModuleId) then + Manager.Checkout(i) + else + Inc(i); + end; + end; +end; + +procedure TSilentThreadManagerThread.Execute; +begin + if Manager = nil then Exit; + Self.Checkout; + with manager do + while (not Terminated) and (MetaDatas.Count > 0) do + begin + Sleep(SOCKHEARTBEATRATE); + while (not Terminated) and (Threads.Count >= OptionMaxThreads) do + Sleep(SOCKHEARTBEATRATE); + Self.Checkout; + end; +end; + +destructor TSilentThreadManagerThread.Destroy; +begin + Manager.FManagerThread := nil; + inherited Destroy; +end; { TSilentThreadManager } -function TSilentThreadManager.GetItemCount: Integer; +function TSilentThreadManager.GetCount: Integer; begin - CS_Threads.Acquire; - try - Result := MetaData.Count + Threads.Count; - finally - CS_Threads.Release; + Result := MetaDatas.Count + Threads.Count; +end; + +procedure TSilentThreadManager.StartManagerThread; +begin + if FManagerThread = nil then + begin + FManagerThread := TSilentThreadManagerThread.Create; + FManagerThread.Manager := Self; + FManagerThread.Start; end; end; -procedure TSilentThreadManager.Add(AType: TMetaDataType; AWebsite, AManga, - AURL: String; ASavePath: String = ''); +procedure TSilentThreadManager.Add(AType: TMetaDataType; + AWebsite, AManga, AURL: String; ASavePath: String = ''); begin if not ((AType = MD_AddToFavorites) and - (MainForm.FavoriteManager.IsMangaExist(AManga, AWebsite))) then + (FavoriteManager.IsMangaExist(AManga, AWebsite))) then begin - CS_Threads.Acquire; + EnterCriticalsection(FCS_META); try - MetaData.Add(TSilentThreadMetaData.Create( + MetaDatas.Add(TSilentThreadMetaData.Create( AType, AWebsite, AManga, AURL, ASavePath)); + if not FLockAdd then + begin + StartManagerThread; + UpdateLoadStatus; + end; finally - CS_Threads.Release; + LeaveCriticalsection(FCS_META); end; - UpdateLoadStatus; end; end; -procedure TSilentThreadManager.CheckOut; +procedure TSilentThreadManager.Checkout(Index: Integer); begin - CS_Threads.Acquire; + if (Index < 0) or (Index >= MetaDatas.Count) then Exit; + Modules.IncActiveConnectionCount(MetaDatas[Index].ModuleId); + EnterCriticalsection(FCS_THREADS); try - INIAdvanced.Reload; - if MetaData.Count > 0 then + case MetaDatas[Index].MetaDataType of + MD_DownloadAll: Threads.Add(TSilentThread.Create); + MD_AddToFavorites: Threads.Add(TSilentAddToFavThread.Create); + end; + with Threads.Last do begin - case TSilentThreadMetaData(MetaData.First).MetaDataType of - MD_DownloadAll: Threads.Add(TSilentThread.Create); - MD_AddToFavorites: Threads.Add(TSilentAddToFavThread.Create); - end; - with TSilentThread(Threads.Last) do begin - Manager := Self; - website := TSilentThreadMetaData(MetaData.First).Website; - title := TSilentThreadMetaData(MetaData.First).Title; - URL := TSilentThreadMetaData(MetaData.First).URL; - SavePath := TSilentThreadMetaData(MetaData.First).SaveTo; - Start; - TSilentThreadMetaData(MetaData.First).Free; - MetaData.Remove(MetaData.First); - end; + Manager := Self; + website := MetaDatas[Index].Website; + title := MetaDatas[Index].Title; + URL := MetaDatas[Index].URL; + SavePath := MetaDatas[Index].SaveTo; + ModuleId := MetaDatas[Index].ModuleId; + Start; + MetaDatas[Index].Free; + MetaDatas.Delete(Index); end; finally - CS_Threads.Release; + LeaveCriticalsection(FCS_THREADS); end; end; @@ -146,71 +219,78 @@ procedure TSilentThreadManager.StopAll(WaitFor: Boolean); var i: Integer; begin - if MetaData.Count or Threads.Count > 0 then - begin - CS_Threads.Acquire; - try - while MetaData.Count > 0 do - begin - TSilentThreadMetaData(MetaData.Last).Free; - MetaData.Remove(MetaData.Last); - end; - if Threads.Count > 0 then - for i := 0 to Threads.Count - 1 do - TSilentThread(Threads[i]).Terminate; - finally - CS_Threads.Release; - end; - if WaitFor then + if Count = 0 then Exit; + EnterCriticalsection(FCS_META); + try + if MetaDatas.Count > 0 then begin - while ItemCount > 0 do - Sleep(100); + for i := 0 to MetaDatas.Count - 1 do + MetaDatas[i].Free; + MetaDatas.Clear; end; + finally + LeaveCriticalsection(FCS_META); + end; + if Assigned(FManagerThread) then + begin + FManagerThread.Terminate; + if WaitFor then + FManagerThread.WaitFor; + end; + EnterCriticalsection(FCS_THREADS); + try + if Threads.Count > 0 then + for i := 0 to Threads.Count - 1 do + Threads[i].Terminate; + finally + LeaveCriticalsection(FCS_THREADS); end; + if WaitFor then + while Threads.Count < 0 do + sleep(32); end; procedure TSilentThreadManager.UpdateLoadStatus; begin - if ItemCount > 0 then + if Count > 0 then MainForm.sbMain.Panels[1].Text := - Format(RS_SilentThreadLoadStatus, [Threads.Count, ItemCount]) + Format(RS_SilentThreadLoadStatus, [Threads.Count, Count]) else MainForm.sbMain.Panels[1].Text := ''; end; +procedure TSilentThreadManager.BeginAdd; +begin + FLockAdd := True; +end; + +procedure TSilentThreadManager.EndAdd; +begin + FLockAdd := False; + if MetaDatas.Count > 0 then + begin + StartManagerThread; + UpdateLoadStatus; + end; +end; + constructor TSilentThreadManager.Create; begin inherited Create; - CS_Threads := TCriticalSection.Create; - MetaData := TFPList.Create; - Threads := TFPList.Create; + InitCriticalSection(FCS_META); + InitCriticalSection(FCS_THREADS); + FLockAdd := False; + MetaDatas := TSilentThreadMetaDatas.Create; + Threads := TSilentThreads.Create; end; destructor TSilentThreadManager.Destroy; -var - i: Integer; begin - if ItemCount > 0 then - begin - CS_Threads.Acquire; - try - while MetaData.Count > 0 do - begin - TSilentThreadMetaData(MetaData.Last).Free; - MetaData.Remove(MetaData.Last); - end; - if Threads.Count > 0 then - for i := 0 to Threads.Count - 1 do - TSilentThread(Threads[i]).Terminate; - finally - CS_Threads.Release; - end; - while ItemCount > 0 do - Sleep(100); - end; - MetaData.Free; + StopAll(True); + MetaDatas.Free; Threads.Free; - CS_Threads.Free; + DoneCriticalsection(FCS_THREADS); + DoneCriticalsection(FCS_META); inherited Destroy; end; @@ -225,6 +305,7 @@ constructor TSilentThreadMetaData.Create(const AType: TMetaDataType; Title := AManga; URL := AURL; SaveTo := APath; + ModuleId := Modules.LocateModule(Website); end; { TSilentThread } @@ -241,72 +322,74 @@ procedure TSilentThread.MainThreadAfterChecking; begin // add a new download task p := DLManager.AddTask; - DLManager.TaskItem(p).mangaSiteID := GetMangaSiteID(website); + DLManager.Items[p].Website := website; if Trim(title) = '' then title := Info.mangaInfo.title; for i := 0 to Info.mangaInfo.numChapter - 1 do begin // generate folder name - s := CustomRename(OptionCustomRename, - website, - title, - info.mangaInfo.authors, - Info.mangaInfo.artists, - Info.mangaInfo.chapterName.Strings[i], - Format('%.4d', [i + 1]), - cbOptionPathConvert.Checked); - DLManager.TaskItem(p).chapterName.Add(s); - DLManager.TaskItem(p).chapterLinks.Add( + s := CustomRename(OptionChapterCustomRename, + website, + title, + info.mangaInfo.authors, + Info.mangaInfo.artists, + Info.mangaInfo.chapterName.Strings[i], + Format('%.4d', [i + 1]), + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); + DLManager.Items[p].chapterName.Add(s); + DLManager.Items[p].chapterLinks.Add( Info.mangaInfo.chapterLinks.Strings[i]); end; if cbAddAsStopped.Checked then begin - DLManager.TaskItem(p).Status := STATUS_STOP; - DLManager.TaskItem(p).downloadInfo.Status := RS_Stopped; + DLManager.Items[p].Status := STATUS_STOP; + DLManager.Items[p].downloadInfo.Status := Format('[%d/%d] %s',[0,DLManager[p].ChapterLinks.Count,RS_Stopped]); end else begin - DLManager.TaskItem(p).downloadInfo.Status := RS_Waiting; - DLManager.TaskItem(p).Status := STATUS_WAIT; + DLManager.Items[p].downloadInfo.Status := Format('[%d/%d] %s',[0,DLManager[p].ChapterLinks.Count,RS_Waiting]); + DLManager.Items[p].Status := STATUS_WAIT; end; - DLManager.TaskItem(p).currentDownloadChapterPtr := 0; - DLManager.TaskItem(p).downloadInfo.Website := website; - DLManager.TaskItem(p).downloadInfo.Link := URL; - DLManager.TaskItem(p).downloadInfo.Title := title; - DLManager.TaskItem(p).downloadInfo.DateTime := Now; + DLManager.Items[p].currentDownloadChapterPtr := 0; + DLManager.Items[p].downloadInfo.Website := website; + DLManager.Items[p].downloadInfo.Link := URL; + DLManager.Items[p].downloadInfo.Title := title; + DLManager.Items[p].downloadInfo.DateTime := Now; if FSavePath = '' then begin - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := options.ReadString('saveto', 'SaveTo', DEFAULT_PATH); - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := DEFAULT_PATH; - edSaveTo.Text := CorrectPathSys(edSaveTo.Text); + FillSaveTo; FSavePath := edSaveTo.Text; // save to - if cbOptionGenerateMangaFolderName.Checked then - begin - if not cbOptionPathConvert.Checked then - FSavePath := FSavePath + RemoveSymbols(Info.mangaInfo.title) - else - FSavePath := FSavePath + RemoveSymbols(UnicodeRemove(Info.mangaInfo.title)); - end; - FSavePath := CorrectPathSys(FSavePath); + if OptionGenerateMangaFolder then + FSavePath := AppendPathDelim(FSavePath) + CustomRename( + OptionMangaCustomRename, + website, + title, + info.mangaInfo.authors, + info.mangaInfo.artists, + '', + '', + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); end; - DLManager.TaskItem(p).downloadInfo.SaveTo := FSavePath; + DLManager.Items[p].downloadInfo.SaveTo := FSavePath; + DLManager.Items[p].SaveToDB(p); UpdateVtDownload; - DLManager.Backup; - DLManager.CheckAndActiveTask(False, Self); + DLManager.CheckAndActiveTask(False); // save downloaded chapters if Info.mangaInfo.chapterLinks.Count > 0 then begin - DLManager.AddToDownloadedChaptersList(Info.mangaInfo.website + URL, Info.mangaInfo.chapterLinks); - FavoriteManager.AddToDownloadedChaptersList(Info.mangaInfo.website, URL, Info.mangaInfo.chapterLinks); + DLManager.DownloadedChapters.Chapters[Info.mangaInfo.website + URL]:= + Info.mangaInfo.chapterLinks.Text; + FavoriteManager.AddToDownloadedChaptersList(Info.mangaInfo.website, + URL, Info.mangaInfo.chapterLinks); end; end; except @@ -315,34 +398,19 @@ procedure TSilentThread.MainThreadAfterChecking; end; end; -procedure TSilentThread.MainThreadUpdateStatus; -begin - if Manager.ItemCount > 0 then - MainForm.sbMain.Panels[1].Text := - Format(RS_SilentThreadLoadStatus, [Manager.Threads.Count, Manager.ItemCount]) - else - MainForm.sbMain.Panels[1].Text := ''; -end; - procedure TSilentThread.Execute; begin + Synchronize(Manager.UpdateLoadStatus); try - Synchronize(MainThreadUpdateStatus); + Info.ModuleId := Self.ModuleId; Info.mangaInfo.title := title; - if Info.GetInfoFromURL(website, URL, Freconnect) = NO_ERROR then + if Info.GetInfoFromURL(website, URL) = NO_ERROR then if not Terminated then Synchronize(MainThreadAfterChecking); except on E: Exception do MainForm.ExceptionHandler(Self, E); end; - Manager.CS_Threads.Acquire; - try - Manager.Threads.Remove(Self); - finally - Manager.CS_Threads.Release; - end; - Synchronize(MainThreadUpdateStatus); end; constructor TSilentThread.Create; @@ -351,11 +419,21 @@ constructor TSilentThread.Create; Freconnect := 3; SavePath := ''; Info := TMangaInformation.Create(Self); + ModuleId := -1; end; destructor TSilentThread.Destroy; begin + EnterCriticalsection(Manager.FCS_THREADS); + try + Modules.DecActiveConnectionCount(ModuleId); + Manager.Threads.Remove(Self); + finally + LeaveCriticalsection(Manager.FCS_THREADS); + end; Info.Free; + if not isExiting then + Synchronize(Manager.UpdateLoadStatus); inherited Destroy; end; @@ -363,44 +441,36 @@ destructor TSilentThread.Destroy; procedure TSilentAddToFavThread.MainThreadAfterChecking; var - s, s2: String; - i: Integer; + s: String; begin try with MainForm do begin + if Trim(title) = '' then + title := Info.mangaInfo.title; if FSavePath = '' then begin - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := options.ReadString('saveto', 'SaveTo', DEFAULT_PATH); - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := DEFAULT_PATH; - edSaveTo.Text := CorrectPathSys(edSaveTo.Text); + FillSaveTo; s := edSaveTo.Text; end else - s := CorrectPathSys(FSavePath); - - if cbOptionGenerateMangaFolderName.Checked then - begin - if not cbOptionPathConvert.Checked then - s := s + RemoveSymbols(title) - else - s := s + RemoveSymbols(UnicodeRemove(title)); - end; - s := CorrectPathSys(s); - - s2 := ''; - if (Info.mangaInfo.numChapter > 0) then - begin - for i := 0 to Info.mangaInfo.numChapter - 1 do - s2 := s2 + Info.mangaInfo.chapterLinks.Strings[i] + SEPERATOR; - end; + s := FSavePath; + if OptionGenerateMangaFolder then + s := AppendPathDelim(s) + CustomRename( + OptionMangaCustomRename, + website, + title, + info.mangaInfo.authors, + info.mangaInfo.artists, + '', + '', + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); if Trim(title) = '' then title := Info.mangaInfo.title; FavoriteManager.Add(title, IntToStr(Info.mangaInfo.numChapter), - s2, + info.mangaInfo.chapterLinks.Text, website, s, URL); diff --git a/baseunits/uSubThread.pas b/baseunits/uSubThread.pas deleted file mode 100644 index 5e111eab2..000000000 --- a/baseunits/uSubThread.pas +++ /dev/null @@ -1,202 +0,0 @@ -{ - File: uSubThread.pas - License: GPLv2 - This unit is a part of Free Manga Downloader -} - -unit uSubThread; - -{$mode delphi} - -interface - -uses - Classes, SysUtils, Controls, Forms, uBaseUnit, uFMDThread; - -type - - { TCheckUpdateThread } - - TCheckUpdateThread = class(TFMDThread) - protected - fNewVersionNumber, - fUpdateURL, - fChangelog, - FBtnCheckCaption: String; - procedure MainThreadUpdate; - procedure MainThreadSetButton; - procedure Execute; override; - public - CheckStatus: ^Boolean; - ThreadStatus: ^Boolean; - destructor Destroy; override; - end; - - { TSubThread } - TSubThread = class(TFMDThread) - protected - FCheckUpdateRunning: Boolean; - FCheckUpdateThread: TCheckUpdateThread; - procedure Execute; override; - public - CheckUpdate: Boolean; - constructor Create; - destructor Destroy; override; - end; - -resourcestring - RS_NewVersionFound = 'New Version found!'; - RS_CurrentVersion = 'Installed Version'; - RS_LatestVersion = 'Latest Version '; - RS_BtnCheckUpdates = 'Check for new version'; - -implementation - -uses - frmMain, frmUpdateDialog; - -{ TCheckUpdateThread } - -procedure TCheckUpdateThread.MainThreadUpdate; -begin - if MainForm.DLManager.isDlgCounter then Exit; - with TUpdateDialogForm.Create(MainForm) do try - Caption := Application.Title + ' - ' + RS_NewVersionFound; - with mmLog.Lines do - begin - BeginUpdate; - try - Clear; - Add(RS_CurrentVersion + ' : ' + FMD_VERSION_NUMBER); - Add(RS_LatestVersion + ' : ' + fNewVersionNumber + LineEnding); - AddText(fChangelog); - finally - EndUpdate; - end; - end; - if ShowModal = mrYes then - begin - frmMain.FUpdateURL := fUpdateURL; - DoAfterFMD := DO_UPDATE; - MainForm.itMonitor.Enabled := True; - end - else - MainForm.btCheckVersion.Caption := RS_BtnCheckUpdates; - finally - Free; - end; -end; - -procedure TCheckUpdateThread.MainThreadSetButton; -begin - MainForm.btCheckVersion.Caption := FBtnCheckCaption; -end; - -procedure TCheckUpdateThread.Execute; -var - l: TStringList; - FHTTP: THTTPSendThread; - updateFound: Boolean = False; -begin - ThreadStatus^ := True; - l := TStringList.Create; - FHTTP := THTTPSendThread.Create(Self); - try - fNewVersionNumber := FMD_VERSION_NUMBER; - fUpdateURL := ''; - FBtnCheckCaption := RS_Checking; - Synchronize(MainThreadSetButton); - if not Terminated and - GetPage(FHTTP, TObject(l), UPDATE_URL + 'update', 3) then - if l.Count > 1 then - begin - l.NameValueSeparator := '='; - if Trim(l.Values['VERSION']) <> FMD_VERSION_NUMBER then - begin - fNewVersionNumber := Trim(l.Values['VERSION']); - fUpdateURL := Trim(l.Values[UpperCase(FMD_TARGETOS)]); - if fUpdateURL <> '' then - updateFound := True; - FHTTP.Clear; - l.Clear; - if not Terminated and - GetPage(FHTTP, TObject(l), UPDATE_URL + 'changelog.txt', 3) then - fChangelog := l.Text; - end; - FBtnCheckCaption := RS_BtnCheckUpdates; - Synchronize(MainThreadSetButton); - end; - finally - FHTTP.Free; - l.Free; - end; - if not Terminated and updateFound and (not MainForm.DLManager.isDlgCounter) then - Synchronize(MainThreadUpdate); -end; - -destructor TCheckUpdateThread.Destroy; -begin - CheckStatus^ := False; - ThreadStatus^ := False; - inherited Destroy; -end; - -{ TSubThread } - -procedure TSubThread.Execute; -begin - MainForm.isSubthread := True; - try - if FileExists(fmdDirectory + 'old_updater.exe') then - DeleteFile(fmdDirectory + 'old_updater.exe'); - - if OptionAutoCheckFavStartup then - begin - MainForm.FavoriteManager.isAuto := True; - MainForm.FavoriteManager.CheckForNewChapter; - end; - - while not Terminated do - begin - if CheckUpdate and (not FCheckUpdateRunning) and - (not MainForm.DLManager.isDlgCounter) then - begin - FCheckUpdateThread := TCheckUpdateThread.Create(True); - FCheckUpdateThread.CheckStatus := @CheckUpdate; - FCheckUpdateThread.ThreadStatus := @FCheckUpdateRunning; - FCheckUpdateThread.Start; - end; - - with MainForm do - begin - while (SilentThreadManager.MetaData.Count > 0) and - (SilentThreadManager.Threads.Count < DLManager.maxDLThreadsPerTask) do - SilentThreadManager.CheckOut; - end; - Sleep(500); - end; - if FCheckUpdateRunning then - begin - FCheckUpdateThread.Terminate; - FCheckUpdateThread.WaitFor; - end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; -end; - -constructor TSubThread.Create; -begin - inherited Create(True); - CheckUpdate := False; - FCheckUpdateRunning := CheckUpdate; -end; - -destructor TSubThread.Destroy; -begin - MainForm.isSubthread := False; - inherited Destroy; -end; - -end. diff --git a/baseunits/uUpdateDBThread.pas b/baseunits/uUpdateDBThread.pas deleted file mode 100644 index 07a38582d..000000000 --- a/baseunits/uUpdateDBThread.pas +++ /dev/null @@ -1,118 +0,0 @@ -{ - File: uUpdateDBThread.pas - License: GPLv2 - This unit is a part of Free Manga Downloader -} - -unit uUpdateDBThread; - -{$mode delphi} - -interface - -uses - Classes, SysUtils, uData, uBaseUnit, uTranslation; - -type - TUpdateDBThread = class(TThread) - protected - procedure MainThreadShowGetting; - procedure MainThreadShowEndGetting; - procedure MainThreadCannotConnectToServer; - procedure MainThreadRefreshList; - procedure Execute; override; - public - websiteName: String; - isTerminated, isSuspended: Boolean; - constructor Create; - destructor Destroy; override; - end; - -implementation - -uses - frmMain, Dialogs, ComCtrls; - -procedure TUpdateDBThread.MainThreadRefreshList; -begin - try - if MainForm.cbSelectManga.Items[MainForm.cbSelectManga.ItemIndex] = websiteName then - begin - MainForm.edSearch.Clear; - MainForm.dataProcess.RemoveFilter; - MainForm.dataProcess.Free; - MainForm.dataProcess := TDataProcess.Create; - MainForm.dataProcess.LoadFromFile(websiteName); - MainForm.vtMangaList.Clear; - MainForm.vtMangaList.RootNodeCount := MainForm.dataProcess.filterPos.Count; - MainForm.lbMode.Caption := - Format(RS_ModeAll, [MainForm.dataProcess.filterPos.Count]); - end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; - - MainThreadShowEndGetting; -end; - -constructor TUpdateDBThread.Create; -begin - inherited Create(True); -end; - -destructor TUpdateDBThread.Destroy; -begin - isTerminated := True; - inherited Destroy; -end; - -procedure TUpdateDBThread.MainThreadShowGetting; -begin - if MainForm.sbUpdateList.Visible = False then - begin - MainForm.sbUpdateList.Height := 23; - MainForm.sbMain.Hide; - MainForm.sbUpdateList.Show; - mainForm.sbUpdateList.Panels[0].Style := psText; - MainForm.btAbortUpdateList.Hide; - MainForm.sbMain.Show; - end; - MainForm.sbMain.SizeGrip := not MainForm.sbUpdateList.Visible; - MainForm.sbUpdateList.Panels[0].Text := 'Getting list for ' + websiteName + ' ...'; -end; - -procedure TUpdateDBThread.MainThreadShowEndGetting; -begin - MainForm.sbUpdateList.Panels[0].Text := ''; - MainForm.sbUpdateList.Hide; - MainForm.sbMain.SizeGrip := not MainForm.sbUpdateList.Visible; - MainForm.isUpdating := False; -end; - -procedure TUpdateDBThread.MainThreadCannotConnectToServer; -begin - MessageDlg('', RS_DlgCannotConnectToServer, mtInformation, [mbYes], 0); -end; - -procedure TUpdateDBThread.Execute; -begin - try - Synchronize(MainThreadShowGetting); - RunExternalProcess(fmdDirectory + 'updater.exe', ['-x', '-r' , '3', '-d', - GetMangaDatabaseURL(websiteName), '--lang', uTranslation.LastSelected]); - if FileExists(fmdDirectory + DATA_FOLDER + websiteName + '.dat') then - begin - Synchronize(MainThreadRefreshList); - end - else - begin - Synchronize(MainThreadShowEndGetting); - end; - except - on E: Exception do - MainForm.ExceptionHandler(Self, E); - end; -end; - -end. diff --git a/baseunits/uUpdateThread.pas b/baseunits/uUpdateThread.pas index 3568aed29..243c24d84 100644 --- a/baseunits/uUpdateThread.pas +++ b/baseunits/uUpdateThread.pas @@ -7,65 +7,78 @@ unit uUpdateThread; {$mode delphi} -{$DEFINE DOWNLOADER} interface uses - Classes, SysUtils, typinfo, FileUtil, syncobjs, uData, uBaseUnit, - uFMDThread, uTranslation; + Classes, SysUtils, typinfo, uData, LazFileUtils, uBaseUnit, uMisc, + WebsiteModules, DBDataProcess, SimpleTranslator, FMDOptions, httpsendthread, + BaseThread, MultiLog; type - TUpdateMangaManagerThread = class; + TUpdateListManagerThread = class; - { TUpdateMangaThread } + { TUpdateListThread } - TUpdateMangaThread = class(TFMDThread) + TUpdateListThread = class(TBaseThread) protected - checkStyle: TCheckStyleType; - names, links: TStringList; - workPtr: Cardinal; - manager: TUpdateMangaManagerThread; Info: TMangaInformation; - - procedure MainThreadUpdateNamesAndLinks; procedure Execute; override; - procedure DoTerminate; override; public + checkStyle: TCheckStyleType; + manager: TUpdateListManagerThread; + workPtr: Integer; + title, link: String; constructor Create; destructor Destroy; override; end; - { TUpdateMangaManagerThread } + { TUpdateListManagerThread } - TUpdateMangaManagerThread = class(TFMDThread) + TUpdateListManagerThread = class(TBaseThread) private FStatus: String; + FCommitCount: Integer; + FThreadAborted, + FThreadEndNormally, + FIsPreListAvailable: Boolean; + FCurrentGetInfoLimit: Integer; + FCS_CurrentGetInfoLimit: TRTLCriticalSection; + procedure SetCurrentDirectoryPageNumber(AValue: Integer); protected procedure Execute; override; {$IFNDEF DOWNLOADER} procedure ConsoleReport; procedure SaveCurrentDatabase; {$ENDIF} + procedure MainThreadStatusRepaint; procedure MainThreadShowGetting; procedure MainThreadEndGetting; + procedure MainThreadRemoveFilter; + procedure ExtractFile; procedure RefreshList; procedure DlgReport; - procedure GetInfo(const limit: Cardinal; const cs: TCheckStyleType); + procedure GetInfo(const limit: Integer; const cs: TCheckStyleType); procedure DoTerminate; override; public - CS_AddInfoToData, CS_AddNamesAndLinks: TCriticalSection; - isFinishSearchingForNewManga, isDownloadFromServer, isDoneUpdateNecessary: Boolean; - mainDataProcess, syncProcess: TDataProcess; - names, links, websites, dataLinks: TStringList; - website: String; - workPtr, directoryCount, - // for fakku's doujinshi only - directoryCount2, numberOfThreads, websitePtr: Cardinal; - threads: TFPList; - CS_threads: TCriticalSection; + CS_Threads, + CS_AddInfoToData, + CS_AddNamesAndLinks: TRTLCriticalSection; + isFinishSearchingForNewManga, isDoneUpdateNecessary: Boolean; + mainDataProcess: TDBDataProcess; + tempDataProcess: TDBDataProcess; + websites: TStringList; + website, twebsite, twebsitetemp: String; + Module: TModuleContainer; + directoryCount, + workPtr, + websitePtr, + numberOfThreads: Integer; + Threads: TFPList; constructor Create; destructor Destroy; override; + procedure CheckCommit(const CommitCount: Integer = 32); + property CurrentDirectoryPageNumber: Integer read FCurrentGetInfoLimit write SetCurrentDirectoryPageNumber; end; resourcestring @@ -87,146 +100,101 @@ TUpdateMangaManagerThread = class(TFMDThread) implementation uses - {$IFDEF DOWNLOADER} - frmMain, - {$ELSE} - mainunit, - {$ENDIF} - Dialogs, ComCtrls, Forms, Controls; + frmMain, FMDVars, Dialogs, ComCtrls; -// ----- TUpdateMangaThread ----- +{ TUpdateListThread } -constructor TUpdateMangaThread.Create; +constructor TUpdateListThread.Create; begin inherited Create(True); - names := TStringList.Create; - links := TStringList.Create; - Info := TMangaInformation.Create(Self); - info.isGetByUpdater := True; end; -destructor TUpdateMangaThread.Destroy; +destructor TUpdateListThread.Destroy; begin - links.Free; - names.Free; - Info.Free; + manager.Module.DecActiveConnectionCount; + EnterCriticalsection(manager.CS_Threads); + try + manager.Threads.Remove(Self); + finally + LeaveCriticalsection(manager.CS_Threads); + end; + if Assigned(Info) then + Info.Free; inherited Destroy; end; -procedure TUpdateMangaThread.MainThreadUpdateNamesAndLinks; -begin - if names.Count = 0 then - Exit; - manager.links.AddStrings(links); - manager.names.AddStrings(names); -end; - -procedure TUpdateMangaThread.Execute; +procedure TUpdateListThread.Execute; var - iPos: Integer; + names, links: TStringList; + i: Integer; begin try + if checkStyle = CS_INFO then + Info := TMangaInformation.Create(Self, True) + else + Info := TMangaInformation.Create(Self, False); + Info.isGetByUpdater := True; + info.ModuleId := manager.Module.ID; + case CheckStyle of CS_DIRECTORY_COUNT: - begin - if SitesMemberOf(manager.website, - [BATOTO_ID, FAKKU_ID, MANGAEDEN_ID, PERVEDEN_ID]) then - begin - BATOTO_BROWSER := BATOTO_BROWSER_1; - FAKKU_BROWSER := FAKKU_BROWSER_1; - MANGAEDEN_BROWSER := MANGAEDEN_BROWSER_1; - PERVEDEN_BROWSER := PERVEDEN_BROWSER_1; - info.GetDirectoryPage(manager.directoryCount, manager.website); - - BATOTO_BROWSER := BATOTO_BROWSER_2; - FAKKU_BROWSER := FAKKU_BROWSER_2; - MANGAEDEN_BROWSER := MANGAEDEN_BROWSER_2; - PERVEDEN_BROWSER := PERVEDEN_BROWSER_2; - info.GetDirectoryPage(manager.directoryCount2, manager.website); - end - else - info.GetDirectoryPage(manager.directoryCount, manager.website); - end; + info.GetDirectoryPage(manager.Module.TotalDirectoryPage[workPtr], manager.website); //get names and links - CS_DIRECTORY_PAGE, CS_DIRECTORY_PAGE_2: + CS_DIRECTORY_PAGE: begin - if BROWSER_INVERT then - begin - if checkStyle = CS_DIRECTORY_PAGE then - workPtr := manager.directoryCount - workPtr - 1 - else - if checkStyle = CS_DIRECTORY_PAGE_2 then - workPtr := manager.directoryCount2 - workPtr - 1; - end; - if SitesMemberOf(manager.website, - [BATOTO_ID, FAKKU_ID, MANGAEDEN_ID, PERVEDEN_ID]) then - begin - if checkStyle = CS_DIRECTORY_PAGE then - begin - BATOTO_BROWSER := BATOTO_BROWSER_1; - FAKKU_BROWSER := FAKKU_BROWSER_1; - MANGAEDEN_BROWSER := MANGAEDEN_BROWSER_1; - PERVEDEN_BROWSER := PERVEDEN_BROWSER_1; - Info.GetNameAndLink(names, links, manager.website, IntToStr(workPtr)); - end - else - if checkStyle = CS_DIRECTORY_PAGE_2 then - begin - BATOTO_BROWSER := BATOTO_BROWSER_2; - FAKKU_BROWSER := FAKKU_BROWSER_2; - MANGAEDEN_BROWSER := MANGAEDEN_BROWSER_2; - PERVEDEN_BROWSER := PERVEDEN_BROWSER_2; - Info.GetNameAndLink(names, links, manager.website, IntToStr(workPtr)); - end; - end - else - begin + names := TStringList.Create; + links := TStringList.Create; + try + if BROWSER_INVERT then + workPtr := manager.Module.TotalDirectoryPage[manager.Module.CurrentDirectoryIndex] - workPtr -1; Info.GetNameAndLink(names, links, manager.website, IntToStr(workPtr)); - end; - //Synchronize(MainThreadUpdateNamesAndLinks); - // For Fakku and Pururin only, reduce the number of page we have to visit - // in order to search for new series. - {$IFDEF DOWNLOADER} - if SitesWithSortedList(manager.website) then - begin - if links.Count > 0 then - if manager.dataLinks.Find(links.Strings[0], iPos) then - manager.isFinishSearchingForNewManga := True; - end; - {$ENDIF} - - //**removing hostname in links - RemoveHostFromURLs(links); - if links.Count > 0 then - begin - manager.CS_AddNamesAndLinks.Acquire; - try - manager.links.AddStrings(links); - manager.names.AddStrings(names); - finally - manager.CS_AddNamesAndLinks.Release; + //if website has sorted list by latest added + //we will stop at first found against current db + if links.Count > 0 then + begin + EnterCriticalSection(manager.CS_AddNamesAndLinks); + try + if manager.FIsPreListAvailable then begin + for i:=0 to links.Count-1 do begin + if manager.mainDataProcess.AddData(names[i],links[i],'','','','','',0,0) then + manager.tempDataProcess.AddData(names[i],links[i],'','','','','',0,0) + else if (manager.isFinishSearchingForNewManga=False) and manager.Module.SortedList and (not BROWSER_INVERT) then + manager.isFinishSearchingForNewManga:=True; + end; + manager.mainDataProcess.Rollback; + end + else + for i:=0 to links.Count-1 do + manager.tempDataProcess.AddData(names[i],links[i],'','','','','',0,0); + manager.tempDataProcess.Commit; + finally + LeaveCriticalSection(manager.CS_AddNamesAndLinks); + end; end; + finally + names.Free; + links.Free; end; end; CS_INFO: begin - Info.mangaInfo.title := manager.names[workPtr]; - {$IFDEF DOWNLOADER} - Info.GetInfoFromURL(manager.website, manager.links[workPtr], 5); - {$ELSE} - Info.GetInfoFromURL(manager.website, manager.links[workPtr], 0); - {$ENDIF} - if not Terminated then - begin - manager.CS_AddInfoToData.Acquire; - try - Info.AddInfoToDataWithoutBreak(manager.names[workPtr], - manager.links[workPtr], manager.mainDataProcess); - finally - manager.CS_AddInfoToData.Release; + Info.mangaInfo.title:=title; + Info.mangaInfo.link:=link; + if link<>'' then begin + Info.GetInfoFromURL(manager.website,link); + // status = '-1' mean it's not exist and shouldn't be saved to database + if (not Terminated) and (Info.mangaInfo.status <> '-1') then + begin + EnterCriticalSection(manager.CS_AddInfoToData); + try + Info.AddInfoToData(title,link,manager.mainDataProcess); + manager.CheckCommit(manager.numberOfThreads); + finally + LeaveCriticalSection(manager.CS_AddInfoToData); + end; end; end; end; @@ -240,30 +208,23 @@ procedure TUpdateMangaThread.Execute; if checkStyle = CS_INFO then begin E.Message := E.Message + - ' Title : ' + manager.names[workPtr] + LineEnding + - ' URL : ' + manager.links[workPtr] + LineEnding; + ' Title : ' + title + LineEnding + + ' URL : ' + link + LineEnding; end; MainForm.ExceptionHandler(Self, E); end; end; end; -procedure TUpdateMangaThread.DoTerminate; +{ TUpdateListManagerThread } + +procedure TUpdateListManagerThread.MainThreadStatusRepaint; begin - manager.CS_threads.Acquire; - try - manager.threads.Remove(Self); - finally - manager.CS_threads.Release; - end; - inherited DoTerminate; + MainForm.sbUpdateList.Repaint; end; -// ----- TUpdateMangaManagerThread ----- - -procedure TUpdateMangaManagerThread.MainThreadShowGetting; +procedure TUpdateListManagerThread.MainThreadShowGetting; begin - {$IFDEF DOWNLOADER} if MainForm.sbUpdateList.Visible = False then begin //statusbar reordering based on who's show up first? @@ -276,219 +237,239 @@ procedure TUpdateMangaManagerThread.MainThreadShowGetting; end; MainForm.sbMain.SizeGrip := not MainForm.sbUpdateList.Visible; MainForm.sbUpdateList.Panels[0].Text := FStatus; - {$ENDIF} end; -procedure TUpdateMangaManagerThread.MainThreadEndGetting; +procedure TUpdateListManagerThread.MainThreadEndGetting; begin MainForm.sbUpdateList.Panels[0].Text := ''; mainForm.sbUpdateList.Panels[0].Style := psText; MainForm.sbUpdateList.Hide; MainForm.sbMain.SizeGrip := not MainForm.sbUpdateList.Visible; + isUpdating:=False; + if isPendingExitCounter then + MainForm.DoExitWaitCounter; +end; + +procedure TUpdateListManagerThread.MainThreadRemoveFilter; +begin + MainForm.btRemoveFilterClick(MainForm.btRemoveFilter); +end; + +procedure TUpdateListManagerThread.ExtractFile; +var + Sza, datapath, filepath: String; +begin + Sza := FMD_DIRECTORY + ZIP_EXE; + if not FileExistsUTF8(Sza) then Exit; + + datapath := DATA_FOLDER; + filepath := datapath + website; + if FileExistsUTF8(filepath + '.7z') then + filepath += '.7z' + else + if FileExistsUTF8(filepath + '.zip') then + filepath += '.zip'; + + if FileExistsUTF8(filepath) then + begin + if FileExistsUTF8(datapath + website + DBDATA_EXT) then + DeleteFileUTF8(datapath + website + DBDATA_EXT); + if FileExistsUTF8(datapath + website + DATA_EXT) then + DeleteFileUTF8(datapath + website + DATA_EXT); + RunExternalProcess(Sza, ['x', filepath, '-o' + + AnsiQuotedStr(datapath, '"'), '-aoa'], False, True); + DeleteFileUTF8(filepath); + end end; -constructor TUpdateMangaManagerThread.Create; +constructor TUpdateListManagerThread.Create; begin inherited Create(True); - CS_threads := TCriticalSection.Create; - CS_AddInfoToData := TCriticalSection.Create; - CS_AddNamesAndLinks := TCriticalSection.Create; FreeOnTerminate := True; - websites := TStringList.Create; - names := TStringList.Create; - links := TStringList.Create; - dataLinks := TStringList.Create; + InitCriticalSection(CS_Threads); + InitCriticalSection(CS_AddInfoToData); + InitCriticalSection(CS_AddNamesAndLinks); + InitCriticalSection(FCS_CurrentGetInfoLimit); - mainDataProcess := TDataProcess.Create; - syncProcess := TDataProcess.Create; - - threads := TFPList.Create; + websites := TStringList.Create; + mainDataProcess := TDBDataProcess.Create; + tempDataProcess := TDBDataProcess.Create; + Threads := TFPList.Create; + FThreadEndNormally:=False; + FThreadAborted:=False; + FIsPreListAvailable:=False; + FCurrentGetInfoLimit := 1; end; -destructor TUpdateMangaManagerThread.Destroy; +destructor TUpdateListManagerThread.Destroy; begin + if FThreadAborted then Logger.SendWarning(Self.ClassName+', thread aborted by user?'); + if not FThreadEndNormally then Logger.SendWarning(Self.ClassName+', thread doesn''t end normally, ended by user?'); websites.Free; - names.Free; - links.Free; - dataLinks.Free; + mainDataProcess.Close; + tempDataProcess.Close; + DeleteDBDataProcess(twebsite); + DeleteDBDataProcess(twebsitetemp); mainDataProcess.Free; - syncProcess.Free; - threads.Free; - {$IFDEF DOWNLOADER} - MainForm.isUpdating := False; - {$ENDIF} - CS_AddInfoToData.Free; - CS_AddNamesAndLinks.Free; - CS_threads.Free; + tempDataProcess.Free; + Threads.Free; + isUpdating := False; + DoneCriticalsection(FCS_CurrentGetInfoLimit); + DoneCriticalsection(CS_AddInfoToData); + DoneCriticalsection(CS_AddNamesAndLinks); + DoneCriticalsection(CS_Threads); inherited Destroy; end; -{$IFNDEF DOWNLOADER} -procedure TUpdateMangaManagerThread.ConsoleReport; -begin - MainForm.Memo1.Lines.Add(S); -end; - -procedure TUpdateMangaManagerThread.SaveCurrentDatabase; +procedure TUpdateListManagerThread.CheckCommit(const CommitCount: Integer); begin - mainDataProcess.SaveToFile(website); - MainForm.Memo1.Lines.Clear; + Inc(FCommitCount); + if FCommitCount >= CommitCount then + begin + FCommitCount := 0; + if Assigned(mainDataProcess) then + mainDataProcess.Commit; + end; end; -{$ENDIF} - -procedure TUpdateMangaManagerThread.RefreshList; +procedure TUpdateListManagerThread.RefreshList; begin - {$IFDEF DOWNLOADER} try - if MainForm.cbSelectManga.Items[MainForm.cbSelectManga.ItemIndex] = website then + with MainForm do begin - Screen.Cursor := crHourGlass; - MainForm.edSearch.Clear; - MainForm.dataProcess.RemoveFilter; - MainForm.dataProcess.Free; - MainForm.dataProcess := TDataProcess.Create; - MainForm.dataProcess.LoadFromFile(website); - MainForm.vtMangaList.Clear; - MainForm.vtMangaList.RootNodeCount := MainForm.dataProcess.filterPos.Count; - MainForm.lbMode.Caption := - Format(RS_ModeAll, [MainForm.dataProcess.filterPos.Count]); - Screen.Cursor := crDefault; + if cbSelectManga.Text = website then + begin + vtMangaList.Clear; + if dataProcess = nil then + dataProcess := TDBDataProcess.Create + else + dataProcess.Close; + OverwriteDBDataProcess(website, twebsite); + OpenDataDB(website); + end + else + begin + if dataProcess.WebsiteLoaded(website) then + dataProcess.RemoveFilter; + OverwriteDBDataProcess(website, twebsite); + end; end; except on E: Exception do MainForm.ExceptionHandler(Self, E); end; - {$ENDIF} end; -procedure TUpdateMangaManagerThread.DlgReport; +procedure TUpdateListManagerThread.DlgReport; begin - MessageDlg('', Format(RS_DlgHasNewManga, [website, links.Count]), + MessageDlg('', Format(RS_DlgHasNewManga, [website, tempDataProcess.RecordCount]), mtInformation, [mbYes], 0); end; -procedure TUpdateMangaManagerThread.GetInfo(const limit: Cardinal; +procedure TUpdateListManagerThread.GetInfo(const limit: Integer; const cs: TCheckStyleType); procedure WaitForThreads; begin - while threads.Count > 0 do - Sleep(200); - end; - - procedure TerminateThreads; - var - i: Cardinal; - begin - if threads.Count > 0 then - for i := threads.Count - 1 downto 0 do - TUpdateMangaThread(threads[i]).Terminate; - WaitForThreads; + while (not Terminated) and (Threads.Count > 0) do + Sleep(SOCKHEARTBEATRATE); end; var - mt: Integer; + plimit, conlimit: Integer; s: String; + t: TUpdateListThread; begin - MainForm.ulTotalPtr := limit; try - while workPtr < limit do - begin - MainForm.ulWorkPtr := workPtr + 1; - if Terminated then - begin - TerminateThreads; - Break; - end; - - mt := INIAdvanced.ReadInteger('UpdateListNumberOfThreads', website, -1); - if mt > 0 then - begin - if mt > 32 then //32 is max | be carefull, there's still memory leak problems - mt := 32; - numberOfThreads := mt; - end + FCurrentGetInfoLimit := limit; + while workPtr < FCurrentGetInfoLimit do begin + if Terminated then Break; + if ulTotalPtr <> FCurrentGetInfoLimit then + ulTotalPtr := FCurrentGetInfoLimit; + if Module.Settings.Enabled and (Module.Settings.UpdateListNumberOfThread > 0) then + numberOfThreads := Module.Settings.UpdateListNumberOfThread else - begin - mt := MainForm.options.ReadInteger('connections', 'NumberOfThreadsPerTask', 1); - case GetMangaSiteID(website) of - EATMANGA_ID : numberOfThreads := 1; - SCANMANGA_ID : numberOfThreads := 1; - EHENTAI_ID : numberOfThreads := 3; - else - numberOfThreads := mt; - end; - if numberOfThreads > mt then - numberOfThreads := mt; - end; + numberOfThreads := OptionMaxThreads; if numberOfThreads < 1 then numberOfThreads := 1; //default + conlimit := Module.GetMaxConnectionLimit; + if conlimit < 1 then + conlimit := numberOfThreads; + // Finish searching for new series - {$IFDEF DOWNLOADER} - if ((cs = CS_DIRECTORY_PAGE) or (cs = CS_DIRECTORY_PAGE_2)) and + if (cs = CS_DIRECTORY_PAGE) and (isFinishSearchingForNewManga) then begin WaitForThreads; - workPtr := limit; - Break; + workPtr := FCurrentGetInfoLimit; + Exit; end; - {$ENDIF} - while threads.Count >= numberOfThreads do - begin - if Terminated then - begin - TerminateThreads; - Break; - end; - Sleep(200); //waiting for empty slot / slowing down the circle - end; + if Module.GetMaxConnectionLimit > 0 then + while (not Terminated) and (Module.ActiveConnectionCount >= conlimit) do + Sleep(SOCKHEARTBEATRATE) + else + while (not Terminated) and (Threads.Count >= numberOfThreads) do + Sleep(SOCKHEARTBEATRATE); - if Terminated then - begin - TerminateThreads; - Break; - end; - if threads.Count < numberOfThreads then + if Terminated then Break; + if Threads.Count < numberOfThreads then begin - CS_threads.Acquire; + EnterCriticalsection(CS_Threads); try - threads.Add(TUpdateMangaThread.Create); - TUpdateMangaThread(threads.Last).checkStyle := cs; - TUpdateMangaThread(threads.Last).manager := Self; - TUpdateMangaThread(threads.Last).workPtr := workPtr; - TUpdateMangaThread(threads.Last).Start; + if Module.ActiveConnectionCount >= conlimit then Exit; + Module.IncActiveConnectionCount; + t := TUpdateListThread.Create; + Threads.Add(t); + if cs=CS_INFO then begin + t.title:=tempDataProcess.Value[workPtr,DATA_PARAM_TITLE]; + t.link:=tempDataProcess.Value[workPtr,DATA_PARAM_LINK]; + end; + t.checkStyle:=cs; + t.manager:=Self; + t.workPtr:=Self.workPtr; + t.Start; Inc(workPtr); s := RS_UpdatingList + Format(' [%d/%d] %s | [T:%d] [%d/%d]', - [websitePtr, websites.Count, website, threads.Count, workPtr, limit]); - if cs = CS_DIRECTORY_COUNT then - if limit = 1 then - s := RS_UpdatingList + Format(' [%d/%d] ', [websitePtr, websites.Count]) + - website + ' | ' + RS_GettingDirectory + '...' - else - s := s + ' | ' + RS_GettingDirectory + '...'; - if cs = CS_DIRECTORY_PAGE then - s := s + ' | ' + RS_LookingForNewTitle + '...'; - if cs = CS_DIRECTORY_PAGE_2 then - s := s + ' | ' + RS_LookingForNewTitleFromAnotherDirectory + '...'; - if cs = CS_INFO then - s := s + ' | ' + RS_GettingInfo + ' "' + names.Strings[workPtr - 1] + - '" "' + WebsiteRoots[GetMangaSiteID(website), 1] + - links.Strings[workPtr - 1] + '"'; - {$IFNDEF DOWNLOADER} - Synchronize(ConsoleReport); - if (workPtr mod 100 = 0) and (workPtr > 50) and (cs = CS_INFO) and - (mainDataProcess.Data.Count > 5) then - Synchronize(SaveCurrentDatabase); - {$ELSE} + [websitePtr, websites.Count, website, Threads.Count, workPtr, FCurrentGetInfoLimit]); + + case cs of + CS_DIRECTORY_COUNT: + begin + if FCurrentGetInfoLimit = 1 then + s := RS_UpdatingList + Format(' [%d/%d] ', [websitePtr, websites.Count]) + + website + ' | ' + RS_GettingDirectory + '...' + else + s := s + ' | ' + RS_GettingDirectory + '...'; + end; + CS_DIRECTORY_PAGE: + begin + s += ' | ' + RS_LookingForNewTitle + + Format(' %d/%d', [Module.CurrentDirectoryIndex + 1, Module.TotalDirectory]) + + '...'; + end; + CS_INFO: + s := Format('%s | %s "%s"', [s, RS_GettingInfo, tempDataProcess.Value[workPtr-1,DATA_PARAM_TITLE]]); + end; FStatus := s; + ulWorkPtr := workPtr + 1; Synchronize(MainThreadShowGetting); - {$ENDIF} finally - CS_threads.Release; + LeaveCriticalsection(CS_Threads); + end; + end; + // wait for threads and new data + if workPtr >= FCurrentGetInfoLimit then + begin + plimit := FCurrentGetInfoLimit; + while Threads.Count > 0 do + begin + if Terminated then Break; + // if limit changed, break and continue the loop with new limit + if FCurrentGetInfoLimit <> plimit then Break; + Sleep(SOCKHEARTBEATRATE); end; end; end; @@ -496,432 +477,180 @@ procedure TUpdateMangaManagerThread.GetInfo(const limit: Cardinal; on E: Exception do MainForm.ExceptionHandler(Self, E); end; + WaitForThreads; end; -procedure TUpdateMangaManagerThread.DoTerminate; +procedure TUpdateListManagerThread.DoTerminate; +var + i: Integer; begin - Synchronize(MainThreadEndGetting); - while threads.Count > 0 do - Sleep(200); + EnterCriticalsection(CS_Threads); + try + if Threads.Count > 0 then + for i := 0 to Threads.Count - 1 do + TUpdateListThread(Threads[i]).Terminate; + finally + LeaveCriticalsection(CS_Threads); + end; + while Threads.Count > 0 do + Sleep(SOCKHEARTBEATRATE); inherited DoTerminate; end; -procedure TUpdateMangaManagerThread.Execute; - - procedure WaitForThreads; - var - i: Cardinal; - begin - while threads.Count > 0 do - begin - if Terminated then - for i := threads.Count - 1 downto 0 do - TUpdateMangaThread(threads[i]).Terminate; - Sleep(200); - end; +procedure TUpdateListManagerThread.SetCurrentDirectoryPageNumber(AValue: Integer); +begin + if AValue < FCurrentGetInfoLimit then Exit; + try + EnterCriticalsection(FCS_CurrentGetInfoLimit); + FCurrentGetInfoLimit := AValue; + finally + LeaveCriticalsection(FCS_CurrentGetInfoLimit); end; +end; +procedure TUpdateListManagerThread.Execute; var - s: String; - j, k, iPos: Integer; - del, purg: Boolean; + j, k: Integer; + cloghead: String; begin if websites.Count = 0 then Exit; try websitePtr := 0; - {$IFDEF DOWNLOADER} - if isDownloadFromServer then + while websitePtr < websites.Count do begin - while websitePtr < websites.Count do + FThreadAborted:=True; + website := websites.Strings[websitePtr]; + if Modules.ModuleAvailable(website, Module) then begin - website := websites.Strings[websitePtr]; - Inc(websitePtr); - FStatus := RS_GettingListFor + ' ' + website + ' ...'; - Synchronize(MainThreadShowGetting); - RunExternalProcess(fmdDirectory + 'updater.exe', ['-x', '-r' , '3', '-d', - GetMangaDatabaseURL(website), '--lang', uTranslation.LastSelected]); - Synchronize(RefreshList); - end; - end - else - {$ENDIF} - while websitePtr < websites.Count do - begin - website := websites.Strings[websitePtr]; Inc(websitePtr); + + cloghead:=Self.ClassName+', '+website+': '; FStatus := RS_UpdatingList + Format(' [%d/%d] %s', [websitePtr, websites.Count, website]) + ' | ' + RS_Preparing + '...'; Synchronize(MainThreadShowGetting); - mainDataProcess.Clear; - mainDataProcess.LoadFromFile(website); - - //Sort first for faster searching - dataLinks.Assign(mainDataProcess.Link); - dataLinks.Sort; - - // convert old data - if (mainDataProcess.Link.Count > 0) and - (website = WebsiteRoots[MANGAFOX_ID, 0]) then - begin - purg := False; - s := WebsiteRoots[GetMangaSiteID(website), 1]; - if dataLinks.Find(s, iPos) then - purg := True; - if purg then + twebsite:='__'+website; + twebsitetemp:=twebsite+'_templist'; + try + DeleteDBDataProcess(twebsite); + DeleteDBDataProcess(twebsitetemp); + if (dataProcess.Website = website) and + (dataProcess.Connected) then + dataProcess.Backup(twebsite) + else begin - for k := 0 to mainDataProcess.Link.Count - 1 do - begin - if Pos(s, mainDataProcess.Link[k]) > 0 then - begin - mainDataProcess.Link[k] := - StringReplace(mainDataProcess.Link[k], s, '', [rfIgnoreCase]); - - mainDataProcess.Data[k] := RemoveStringBreaks( - mainDataProcess.Param[k, DATA_PARAM_NAME] + SEPERATOR + - mainDataProcess.Link[k] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_AUTHORS] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_ARTISTS] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_GENRES] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_STATUS] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_SUMMARY] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_NUMCHAPTER] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_JDN] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_READ] + SEPERATOR); - end; - end; - mainDataProcess.SaveToFile(website); - dataLinks.Assign(mainDataProcess.Link); - dataLinks.Sort; + if dataProcess.WebsiteLoaded(website) then + Synchronize(MainThreadRemoveFilter); + CopyDBDataProcess(website, twebsite); end; - mainDataProcess.Clear; - end; - names.Clear; - links.Clear; - - //get directory page count - INIAdvanced.Reload; - directoryCount := 0; - directoryCount2 := 0; - workPtr := 0; - GetInfo(1, CS_DIRECTORY_COUNT); - WaitForThreads; - if Terminated then - Break; + if not mainDataProcess.Connect(twebsite) then + mainDataProcess.CreateDatabase(twebsite); + tempDataProcess.CreateDatabase(twebsitetemp); - //get names and links - INIAdvanced.Reload; - workPtr := 0; - isFinishSearchingForNewManga := False; - if SitesMemberOf(website, [BATOTO_ID, FAKKU_ID, MANGAEDEN_ID, - PERVEDEN_ID]) then - begin - if directoryCount = 0 then - directoryCount := 1; - GetInfo(directoryCount, CS_DIRECTORY_PAGE); + // get directory page count + directoryCount := 0; workPtr := 0; - isFinishSearchingForNewManga := False; - if directoryCount2 = 0 then - directoryCount2 := 1; - GetInfo(directoryCount2, CS_DIRECTORY_PAGE_2); - end - else - GetInfo(directoryCount, CS_DIRECTORY_PAGE); - WaitForThreads; - if Terminated then - Break; + Modules.AfterUpdateList(Module.ID); + Modules.BeforeUpdateList(Module.ID); + GetInfo(Module.TotalDirectory, CS_DIRECTORY_COUNT); - {$IFNDEF DOWNLOADER} - names.SaveToFile(website + '_names.txt'); - links.SaveToFile(website + '_links.txt'); - - names.Clear; - links.Clear; - - names.LoadFromFile(website + '_names.txt'); - links.LoadFromFile(website + '_links.txt'); - {$ENDIF} - - FStatus := RS_UpdatingList + Format(' [%d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_IndexingNewTitle + '...'; - Synchronize(MainThreadShowGetting); - - // remove duplicate - if links.Count > 0 then - begin - FStatus := RS_UpdatingList + Format(' [%d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_RemovingDuplicateFromNewTitle + '...'; - Synchronize(MainThreadShowGetting); - j := 0; - while j < (links.Count - 1) do + if Terminated then begin - if Terminated then - Break; - del := False; - if (j + 1) < links.Count then - for k := j + 1 to links.Count - 1 do - begin - if Terminated then - Break; - if SameText(links.Strings[j], links.Strings[k]) then - begin - links.Delete(j); - names.Delete(j); - del := True; - Break; - end; - end; - if not del then - Inc(j); + Modules.AfterUpdateList(Module.ID); + Break; end; - end; - // remove duplicate found<>current database - if links.Count > 0 then - begin - FStatus := RS_UpdatingList + Format(' [%d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_RemovingDuplicateFromCurrentData + '...'; - Synchronize(MainThreadShowGetting); - j := 0; - while j < links.Count do + mainDataProcess.OpenTable('',True); + FIsPreListAvailable:=mainDataProcess.RecordCount>0; + mainDataProcess.CloseTable; + + // get names and links + workPtr := 0; + isFinishSearchingForNewManga := False; + j := Low(Module.TotalDirectoryPage); + while j <= High(Module.TotalDirectoryPage) do begin - if Terminated then - Break; - if dataLinks.Find(links[j], integer(workPtr)) then - begin - links.Delete(j); - names.Delete(j); - end - else - Inc(j); + workPtr := 0; + isFinishSearchingForNewManga := False; + Module.CurrentDirectoryIndex := j; + GetInfo(Module.TotalDirectoryPage[j], CS_DIRECTORY_PAGE); + Inc(j); + if Terminated then Break; end; - end; - dataLinks.Clear; - mainDataProcess.Clear; - mainDataProcess.LoadFromFile(website); + Modules.BeforeUpdateList(Module.ID); + if Terminated then + if not (OptionUpdateListNoMangaInfo and not(Module.SortedList)) then + Break; - if OptionUpdateListRemoveDuplicateLocalData then - begin - FStatus := RS_UpdatingList + Format(' [ %d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_RemovingDuplicateFromLocalData + '...'; + FStatus := RS_UpdatingList + Format(' [%d/%d] %s', + [websitePtr, websites.Count, website]) + ' | ' + RS_IndexingNewTitle + '...'; Synchronize(MainThreadShowGetting); - if mainDataProcess.Link.Count > 0 then - begin - j := 0; - while j < (mainDataProcess.Link.Count - 1) do - begin - if Terminated then - Break; - del := False; - if (j + 1) < mainDataProcess.Link.Count then - for k := j + 1 to mainDataProcess.Link.Count - 1 do - begin - if Terminated then - Break; - - if SameText(mainDataProcess.Link.Strings[j], - mainDataProcess.Link.Strings[k]) then - begin - mainDataProcess.Link.Delete(j); - mainDataProcess.Title.Delete(j); - mainDataProcess.Data.Delete(j); - del := True; - Break; - end; - end; - if not del then - Inc(j); - end; - end; - end; - - //get manga info - if links.Count > 0 then - begin - if (SitesWithoutInformation(website)) or - OptionUpdateListNoMangaInfo then - begin - mainDataProcess.Title.AddStrings(names); - mainDataProcess.Link.AddStrings(links); - for k := 0 to links.Count - 1 do - begin - {$IFDEF DOWNLOADER} - mainDataProcess.Data.Add( - RemoveStringBreaks( - SetParams( - [names.Strings[k], - links.Strings[k], - '', - '', - '', - '', - '', - '0', - IntToStr(GetCurrentJDN), - '0']))); - {$ELSE} - mainDataProcess.Data.Add( - RemoveStringBreaks( - SetParams( - [names.Strings[k], - links.Strings[k], - '', - '', - '', - '', - '', - '0', - '0', - '0']))); - {$ENDIF} - end; - end - else + tempDataProcess.OpenTable('', True); + // get manga info + if tempDataProcess.RecordCount>0 then begin workPtr := 0; - GetInfo(links.Count, CS_INFO); - end; - WaitForThreads; - names.Clear; - links.Clear; - - // sync data based on existing sites - if (mainDataProcess.Data.Count > 0) and - (SitesWithoutInformation(website)) and - (FileExistsUTF8(DATA_FOLDER + WebsiteRoots[BATOTO_ID, 0] + DATA_EXT) or - FileExistsUTF8(DATA_FOLDER + WebsiteRoots[ANIMEA_ID, 0] + DATA_EXT) or - FileExistsUTF8(DATA_FOLDER + WebsiteRoots[MANGAGO_ID, 0] + DATA_EXT) or - FileExistsUTF8(DATA_FOLDER + WebsiteRoots[MANGAPARK_ID, 0] + DATA_EXT)) - then - begin - FStatus := RS_UpdatingList + Format(' [%d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_SynchronizingData + '...'; - Synchronize(MainThreadShowGetting); - - syncProcess.Clear; - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[GetMangaSiteID(website), 0] + DATA_EXT) then - syncProcess.LoadFromFile(website); - - //remove existed data - if syncProcess.Data.Count > 0 then + FCommitCount := 0; + if not Module.InformationAvailable or + OptionUpdateListNoMangaInfo then begin - j := 0; - while j < mainDataProcess.Link.Count do + Inc(workPtr); + for k:=0 to tempDataProcess.RecordCount-1 do begin - if Terminated then - Break; - del := False; - for k := 0 to syncProcess.Link.Count - 1 do - begin - if Terminated then - Break; - if SameText(mainDataProcess.Link[j], syncProcess.Link[k]) then - begin - mainDataProcess.Title.Delete(j); - mainDataProcess.Link.Delete(j); - mainDataProcess.Data.Delete(j); - del := True; - Break; - end; - end; - if not del then - Inc(j); + mainDataProcess.AddData( + tempDataProcess.Value[k,DATA_PARAM_TITLE], + tempDataProcess.Value[k,DATA_PARAM_LINK], + '', + '', + '', + '', + '', + 0, + Now + ); + CheckCommit(5000); end; - end; + end + else + GetInfo(tempDataProcess.RecordCount, CS_INFO); + mainDataProcess.Commit; - syncProcess.Clear; - if mainDataProcess.Link.Count > 0 then + if (workPtr > 0) and (not (Terminated and Module.SortedList)) then begin - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[BATOTO_ID, 0] + DATA_EXT) then - syncProcess.LoadFromFile(WebsiteRoots[BATOTO_ID, 0]) - else - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[ANIMEA_ID, 0] + DATA_EXT) then - syncProcess.LoadFromFile(WebsiteRoots[ANIMEA_ID, 0]) - else - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[MANGAGO_ID, 0] + DATA_EXT) then - syncProcess.LoadFromFile(WebsiteRoots[MANGAGO_ID, 0]) - else - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[MANGAPARK_ID, 0] + DATA_EXT) then - syncProcess.LoadFromFile(WebsiteRoots[MANGAPARK_ID, 0]); - - // brute force ... - if syncProcess.Link.Count > 0 then - begin - for k := 0 to mainDataProcess.Data.Count - 1 do - begin - if Terminated then - Break; - for j := 0 to syncProcess.Link.Count - 1 do - begin - if Terminated then - Break; - if SameText(mainDataProcess.Title[k], syncProcess.Title[j]) then - begin - s := syncProcess.Param[j, DATA_PARAM_SUMMARY]; - mainDataProcess.Data.Strings[k] := RemoveBreaks( - mainDataProcess.Param[k, DATA_PARAM_NAME] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_LINK] + SEPERATOR + - syncProcess.Param[j, DATA_PARAM_AUTHORS] + SEPERATOR + - syncProcess.Param[j, DATA_PARAM_ARTISTS] + SEPERATOR + - syncProcess.Param[j, DATA_PARAM_GENRES] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_STATUS] + SEPERATOR + - s + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_NUMCHAPTER] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_JDN] + SEPERATOR + - mainDataProcess.Param[k, DATA_PARAM_READ] + SEPERATOR); - Break; - end; - end; - end; - end; - syncProcess.Clear; - // add back existing data - if FileExistsUTF8(DATA_FOLDER + WebsiteRoots[GetMangaSiteID(website), 0] + DATA_EXT) then - begin - syncProcess.LoadFromFile(website); - if syncProcess.Data.Count > 0 then - mainDataProcess.Data.AddStrings(syncProcess.Data); - syncProcess.Clear; - end; + FStatus := RS_UpdatingList + Format(' [%d/%d] %s', + [websitePtr, websites.Count, website]) + ' | ' + RS_SavingData + '...'; + Synchronize(MainThreadShowGetting); + mainDataProcess.Sort; + mainDataProcess.Close; + Synchronize(RefreshList); end; end; + except + on E: Exception do + Logger.SendException(cloghead + 'error occured!', E); end; - if (not Terminated) or (not SitesWithSortedList(website)) then - begin - FStatus := RS_UpdatingList + Format(' [%d/%d] %s', - [websitePtr, websites.Count, website]) + ' | ' + RS_SavingData + '...'; - Synchronize(MainThreadShowGetting); - { TODO -ocholif : Sort after update } - mainDataProcess.Sort; - mainDataProcess.SaveToFile(website); - end; - {$IFDEF DOWNLOADER} - Synchronize(RefreshList); - {$ENDIF} + tempDataProcess.Close; + mainDataProcess.Close; + DeleteDBDataProcess(twebsite); + DeleteDBDataProcess(twebsitetemp); + if Terminated then Break; - websites[websitePtr - 1] := - UTF8Encode(#$2714 + WideString(websites[websitePtr - 1])); + websites[websitePtr - 1] := UTF8Encode(#$2714) + websites[websitePtr - 1]; + FThreadAborted:=False; end; - {$IFNDEF DOWNLOADER} - S := 'Saving to ' + website + '.dat ...'; - Synchronize(ConsoleReport); - S := 'Done.'; - Synchronize(ConsoleReport); - {$ELSE} - // Synchronize(DlgReport); - //Synchronize(MainThreadEndGetting); - {$ENDIF} - // Synchronize(DlgReport); + end; except on E: Exception do MainForm.ExceptionHandler(Self, E); end; + FThreadEndNormally:=True; + Synchronize(MainThreadEndGetting); end; end. diff --git a/baseunits/utranslation.pas b/baseunits/utranslation.pas deleted file mode 100644 index 9bac7ef1e..000000000 --- a/baseunits/utranslation.pas +++ /dev/null @@ -1,974 +0,0 @@ -{ Simple Translation Collector - - Copyright (C) 2015 Nur Cholif - - This source is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your option) - any later version. - - This code is distributed in the hope that it will be useful, but WITHOUT ANY - WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS - FOR A PARTICULAR PURPOSE. See the GNU General Public License for more - details. - - A copy of the GNU General Public License is available on the World Wide Web - at . You can also obtain it by writing - to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, - MA 02111-1307, USA. -} - -unit uTranslation; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, strutils, gettext, FileUtil, LCLTranslator, Translations, - LResources, Forms; - -type - TLanguageItem = record - id: String; - name: String; - end; - - TLanguageCollection = array of TLanguageItem; - -const - Lang_english: array[0..184] of array[0..1] of string = ( - ('ab', 'Abkhaz'), - ('aa', 'Afar'), - ('af', 'Afrikaans'), - ('ak', 'Akan'), - ('sq', 'Albanian'), - ('am', 'Amharic'), - ('ar', 'Arabic'), - ('an', 'Aragonese'), - ('hy', 'Armenian'), - ('as', 'Assamese'), - ('av', 'Avaric'), - ('ae', 'Avestan'), - ('ay', 'Aymara'), - ('az', 'Azerbaijani'), - ('bm', 'Bambara'), - ('ba', 'Bashkir'), - ('eu', 'Basque'), - ('be', 'Belarusian'), - ('bn', 'Bengali, Bangla'), - ('bh', 'Bihari'), - ('bi', 'Bislama'), - ('bs', 'Bosnian'), - ('br', 'Breton'), - ('bg', 'Bulgarian'), - ('my', 'Burmese'), - ('ca', 'Catalan'), - ('ch', 'Chamorro'), - ('ce', 'Chechen'), - ('ny', 'Chichewa, Chewa, Nyanja'), - ('zh', 'Chinese'), - ('cv', 'Chuvash'), - ('kw', 'Cornish'), - ('co', 'Corsican'), - ('cr', 'Cree'), - ('hr', 'Croatian'), - ('cs', 'Czech'), - ('da', 'Danish'), - ('dv', 'Divehi, Dhivehi, Maldivian'), - ('nl', 'Dutch'), - ('dz', 'Dzongkha'), - ('en', 'English'), - ('eo', 'Esperanto'), - ('et', 'Estonian'), - ('ee', 'Ewe'), - ('fo', 'Faroese'), - ('fj', 'Fijian'), - ('fi', 'Finnish'), - ('fr', 'French'), - ('ff', 'Fula, Fulah, Pulaar, Pular'), - ('gl', 'Galician'), - ('ka', 'Georgian'), - ('de', 'German'), - ('el', 'Greek (modern)'), - ('gn', 'Guaraní'), - ('gu', 'Gujarati'), - ('ht', 'Haitian, Haitian Creole'), - ('ha', 'Hausa'), - ('he', 'Hebrew (modern)'), - ('hz', 'Herero'), - ('hi', 'Hindi'), - ('ho', 'Hiri Motu'), - ('hu', 'Hungarian'), - ('ia', 'Interlingua'), - ('id', 'Indonesian'), - ('ie', 'Interlingue'), - ('ga', 'Irish'), - ('ig', 'Igbo'), - ('ik', 'Inupiaq'), - ('io', 'Ido'), - ('is', 'Icelandic'), - ('it', 'Italian'), - ('iu', 'Inuktitut'), - ('ja', 'Japanese'), - ('jv', 'Javanese'), - ('kl', 'Kalaallisut, Greenlandic'), - ('kn', 'Kannada'), - ('kr', 'Kanuri'), - ('ks', 'Kashmiri'), - ('kk', 'Kazakh'), - ('km', 'Khmer'), - ('ki', 'Kikuyu, Gikuyu'), - ('rw', 'Kinyarwanda'), - ('ky', 'Kyrgyz'), - ('kv', 'Komi'), - ('kg', 'Kongo'), - ('ko', 'Korean'), - ('ku', 'Kurdish'), - ('kj', 'Kwanyama, Kuanyama'), - ('la', 'Latin'), - ('lld', 'Ladin'), - ('lb', 'Luxembourgish, Letzeburgesch'), - ('lg', 'Ganda'), - ('li', 'Limburgish, Limburgan, Limburger'), - ('ln', 'Lingala'), - ('lo', 'Lao'), - ('lt', 'Lithuanian'), - ('lu', 'Luba-Katanga'), - ('lv', 'Latvian'), - ('gv', 'Manx'), - ('mk', 'Macedonian'), - ('mg', 'Malagasy'), - ('ms', 'Malay'), - ('ml', 'Malayalam'), - ('mt', 'Maltese'), - ('mi', 'Māori'), - ('mr', 'Marathi (Marāṭhī)'), - ('mh', 'Marshallese'), - ('mn', 'Mongolian'), - ('na', 'Nauru'), - ('nv', 'Navajo, Navaho'), - ('nd', 'Northern Ndebele'), - ('ne', 'Nepali'), - ('ng', 'Ndonga'), - ('nb', 'Norwegian Bokmål'), - ('nn', 'Norwegian Nynorsk'), - ('no', 'Norwegian'), - ('ii', 'Nuosu'), - ('nr', 'Southern Ndebele'), - ('oc', 'Occitan'), - ('oj', 'Ojibwe, Ojibwa'), - ('cu', 'Old Church Slavonic, Church Slavonic, Old Bulgarian'), - ('om', 'Oromo'), - ('or', 'Oriya'), - ('os', 'Ossetian, Ossetic'), - ('pa', 'Panjabi, Punjabi'), - ('pi', 'Pāli'), - ('fa', 'Persian (Farsi)'), - ('pl', 'Polish'), - ('ps', 'Pashto, Pushto'), - ('pt', 'Portuguese'), - ('qu', 'Quechua'), - ('rm', 'Romansh'), - ('rn', 'Kirundi'), - ('ro', 'Romanian'), - ('ru', 'Russian'), - ('sa', 'Sanskrit (Saṁskṛta)'), - ('sc', 'Sardinian'), - ('sd', 'Sindhi'), - ('se', 'Northern Sami'), - ('sm', 'Samoan'), - ('sg', 'Sango'), - ('sr', 'Serbian'), - ('gd', 'Scottish Gaelic, Gaelic'), - ('sn', 'Shona'), - ('si', 'Sinhala, Sinhalese'), - ('sk', 'Slovak'), - ('sl', 'Slovene'), - ('so', 'Somali'), - ('st', 'Southern Sotho'), - ('es', 'Spanish'), - ('su', 'Sundanese'), - ('sw', 'Swahili'), - ('ss', 'Swati'), - ('sv', 'Swedish'), - ('ta', 'Tamil'), - ('te', 'Telugu'), - ('tg', 'Tajik'), - ('th', 'Thai'), - ('ti', 'Tigrinya'), - ('bo', 'Tibetan Standard, Tibetan, Central'), - ('tk', 'Turkmen'), - ('tl', 'Tagalog'), - ('tn', 'Tswana'), - ('to', 'Tonga (Tonga Islands)'), - ('tr', 'Turkish'), - ('ts', 'Tsonga'), - ('tt', 'Tatar'), - ('tw', 'Twi'), - ('ty', 'Tahitian'), - ('ug', 'Uyghur'), - ('uk', 'Ukrainian'), - ('ur', 'Urdu'), - ('uz', 'Uzbek'), - ('ve', 'Venda'), - ('vi', 'Vietnamese'), - ('vo', 'Volapük'), - ('wa', 'Walloon'), - ('cy', 'Welsh'), - ('wo', 'Wolof'), - ('fy', 'Western Frisian'), - ('xh', 'Xhosa'), - ('yi', 'Yiddish'), - ('yo', 'Yoruba'), - ('za', 'Zhuang, Chuang'), - ('zu', 'Zulu')); - - Lang_native: array[0..184] of array[0..1] of string = ( - ('ab', 'аҧсуа бызшәа, аҧсшәа'), - ('aa', 'Afaraf'), - ('af', 'Afrikaans'), - ('ak', 'Akan'), - ('sq', 'Shqip'), - ('am', 'አማርኛ'), - ('ar', 'العربية'), - ('an', 'aragonés'), - ('hy', 'Հայերեն'), - ('as', 'অসমীয়া'), - ('av', 'авар мацӀ, магӀарул мацӀ'), - ('ae', 'avesta'), - ('ay', 'aymar aru'), - ('az', 'azərbaycan dili'), - ('bm', 'bamanankan'), - ('ba', 'башҡорт теле'), - ('eu', 'euskara, euskera'), - ('be', 'беларуская мова'), - ('bn', 'বাংলা'), - ('bh', 'भोजपुरी'), - ('bi', 'Bislama'), - ('bs', 'bosanski jezik'), - ('br', 'brezhoneg'), - ('bg', 'български език'), - ('my', 'ဗမာစာ'), - ('ca', 'català'), - ('ch', 'Chamoru'), - ('ce', 'нохчийн мотт'), - ('ny', 'chiCheŵa, chinyanja'), - ('zh', '中文 (Zhōngwén), 汉语, 漢語'), - ('cv', 'чӑваш чӗлхи'), - ('kw', 'Kernewek'), - ('co', 'corsu, lingua corsa'), - ('cr', 'ᓀᐦᐃᔭᐍᐏᐣ'), - ('hr', 'hrvatski jezik'), - ('cs', 'čeština, český jazyk'), - ('da', 'dansk'), - ('dv', 'ދިވެހި'), - ('nl', 'Nederlands, Vlaams'), - ('dz', 'རྫོང་ཁ'), - ('en', 'English'), - ('eo', 'Esperanto'), - ('et', 'eesti, eesti keel'), - ('ee', 'Eʋegbe'), - ('fo', 'føroyskt'), - ('fj', 'vosa Vakaviti'), - ('fi', 'suomi, suomen kieli'), - ('fr', 'français, langue française'), - ('ff', 'Fulfulde, Pulaar, Pular'), - ('gl', 'galego'), - ('ka', 'ქართული'), - ('de', 'Deutsch'), - ('el', 'ελληνικά'), - ('gn', 'Avañe''ẽ'), - ('gu', 'ગુજરાતી'), - ('ht', 'Kreyòl ayisyen'), - ('ha', '(Hausa) هَوُسَ'), - ('he', 'עברית'), - ('hz', 'Otjiherero'), - ('hi', 'हिन्दी, हिंदी'), - ('ho', 'Hiri Motu'), - ('hu', 'magyar'), - ('ia', 'Interlingua'), - ('id', 'Bahasa Indonesia'), - ('ie', 'Interlingue'), - ('ga', 'Gaeilge'), - ('ig', 'Asụsụ Igbo'), - ('ik', 'Iñupiaq, Iñupiatun'), - ('io', 'Ido'), - ('is', 'Íslenska'), - ('it', 'italiano'), - ('iu', 'ᐃᓄᒃᑎᑐᑦ'), - ('ja', '日本語 (にほんご)'), - ('jv', 'basa Jawa'), - ('kl', 'kalaallisut, kalaallit oqaasii'), - ('kn', 'ಕನ್ನಡ'), - ('kr', 'Kanuri'), - ('ks', 'कश्मीरी, كشميري‎'), - ('kk', 'қазақ тілі'), - ('km', 'ខ្មែរ, ខេមរភាសា, ភាសាខ្មែរ'), - ('ki', 'Gĩkũyũ'), - ('rw', 'Ikinyarwanda'), - ('ky', 'Кыргызча, Кыргыз тили'), - ('kv', 'коми кыв'), - ('kg', 'Kikongo'), - ('ko', '한국어, 조선어'), - ('ku', 'Kurdî, كوردی‎'), - ('kj', 'Kuanyama'), - ('la', 'latine, lingua latina'), - ('lld', 'ladin, lingua ladina'), - ('lb', 'Lëtzebuergesch'), - ('lg', 'Luganda'), - ('li', 'Limburgs'), - ('ln', 'Lingála'), - ('lo', 'ພາສາລາວ'), - ('lt', 'lietuvių kalba'), - ('lu', 'Tshiluba'), - ('lv', 'latviešu valoda'), - ('gv', 'Gaelg, Gailck'), - ('mk', 'македонски јазик'), - ('mg', 'fiteny malagasy'), - ('ms', 'bahasa Melayu, بهاس ملايو‎'), - ('ml', 'മലയാളം'), - ('mt', 'Malti'), - ('mi', 'te reo Māori'), - ('mr', 'मराठी'), - ('mh', 'Kajin M̧ajeļ'), - ('mn', 'монгол'), - ('na', 'Ekakairũ Naoero'), - ('nv', 'Diné bizaad'), - ('nd', 'isiNdebele'), - ('ne', 'नेपाली'), - ('ng', 'Owambo'), - ('nb', 'Norsk bokmål'), - ('nn', 'Norsk nynorsk'), - ('no', 'Norsk'), - ('ii', 'ꆈꌠ꒿ Nuosuhxop'), - ('nr', 'isiNdebele'), - ('oc', 'occitan, lenga d''òc'), - ('oj', 'ᐊᓂᔑᓈᐯᒧᐎᓐ'), - ('cu', 'ѩзыкъ словѣньскъ'), - ('om', 'Afaan Oromoo'), - ('or', 'ଓଡ଼ିଆ'), - ('os', 'ирон æвзаг'), - ('pa', 'ਪੰਜਾਬੀ, پنجابی‎'), - ('pi', 'पाऴि'), - ('fa', 'فارسی'), - ('pl', 'język polski, polszczyzna'), - ('ps', 'پښتو'), - ('pt', 'português'), - ('qu', 'Runa Simi, Kichwa'), - ('rm', 'rumantsch grischun'), - ('rn', 'Ikirundi'), - ('ro', 'limba română'), - ('ru', 'Русский'), - ('sa', 'संस्कृतम्'), - ('sc', 'sardu'), - ('sd', 'सिन्धी, سنڌي، سندھی‎'), - ('se', 'Davvisámegiella'), - ('sm', 'gagana fa''a Samoa'), - ('sg', 'yângâ tî sängö'), - ('sr', 'српски језик'), - ('gd', 'Gàidhlig'), - ('sn', 'chiShona'), - ('si', 'සිංහල'), - ('sk', 'slovenčina, slovenský jazyk'), - ('sl', 'slovenski jezik, slovenščina'), - ('so', 'Soomaaliga, af Soomaali'), - ('st', 'Sesotho'), - ('es', 'español'), - ('su', 'Basa Sunda'), - ('sw', 'Kiswahili'), - ('ss', 'SiSwati'), - ('sv', 'svenska'), - ('ta', 'தமிழ்'), - ('te', 'తెలుగు'), - ('tg', 'тоҷикӣ, toçikī, تاجیکی‎'), - ('th', 'ไทย'), - ('ti', 'ትግርኛ'), - ('bo', 'བོད་ཡིག'), - ('tk', 'Türkmen, Түркмен'), - ('tl', 'Wikang Tagalog, ᜏᜒᜃᜅ᜔ ᜆᜄᜎᜓᜄ᜔'), - ('tn', 'Setswana'), - ('to', 'faka Tonga'), - ('tr', 'Türkçe'), - ('ts', 'Xitsonga'), - ('tt', 'татар теле, tatar tele'), - ('tw', 'Twi'), - ('ty', 'Reo Tahiti'), - ('ug', 'ئۇيغۇرچە‎, Uyghurche'), - ('uk', 'українська мова'), - ('ur', 'اردو'), - ('uz', 'Oʻzbek, Ўзбек, أۇزبېك‎'), - ('ve', 'Tshivenḓa'), - ('vi', 'Việt Nam'), - ('vo', 'Volapük'), - ('wa', 'walon'), - ('cy', 'Cymraeg'), - ('wo', 'Wollof'), - ('fy', 'Frysk'), - ('xh', 'isiXhosa'), - ('yi', 'ייִדיש'), - ('yo', 'Yorùbá'), - ('za', 'Saɯ cueŋƅ, Saw cuengh'), - ('zu', 'isiZulu')); - - Country_name: array[0..248] of array[0..1] of string = ( - ('AD', 'Andorra'), - ('AE', 'United Arab Emirates'), - ('AF', 'Afghanistan'), - ('AG', 'Antigua and Barbuda'), - ('AI', 'Anguilla'), - ('AL', 'Albania'), - ('AM', 'Armenia'), - ('AO', 'Angola'), - ('AQ', 'Antarctica'), - ('AR', 'Argentina'), - ('AS', 'American Samoa'), - ('AT', 'Austria'), - ('AU', 'Australia'), - ('AW', 'Aruba'), - ('AX', 'Åland Islands'), - ('AZ', 'Azerbaijan'), - ('BA', 'Bosnia and Herzegovina'), - ('BB', 'Barbados'), - ('BD', 'Bangladesh'), - ('BE', 'Belgium'), - ('BF', 'Burkina Faso'), - ('BG', 'Bulgaria'), - ('BH', 'Bahrain'), - ('BI', 'Burundi'), - ('BJ', 'Benin'), - ('BL', 'Saint Barthélemy'), - ('BM', 'Bermuda'), - ('BN', 'Brunei Darussalam'), - ('BO', 'Bolivia, Plurinational State of'), - ('BQ', 'Bonaire, Sint Eustatius and Saba'), - ('BR', 'Brazil'), - ('BS', 'Bahamas'), - ('BT', 'Bhutan'), - ('BV', 'Bouvet Island'), - ('BW', 'Botswana'), - ('BY', 'Belarus'), - ('BZ', 'Belize'), - ('CA', 'Canada'), - ('CC', 'Cocos (Keeling) Islands'), - ('CD', 'Congo, the Democratic Republic of the'), - ('CF', 'Central African Republic'), - ('CG', 'Congo'), - ('CH', 'Switzerland'), - ('CI', 'Côte d''Ivoire'), - ('CK', 'Cook Islands'), - ('CL', 'Chile'), - ('CM', 'Cameroon'), - ('CN', 'China'), - ('CO', 'Colombia'), - ('CR', 'Costa Rica'), - ('CU', 'Cuba'), - ('CV', 'Cabo Verde'), - ('CW', 'Curaçao'), - ('CX', 'Christmas Island'), - ('CY', 'Cyprus'), - ('CZ', 'Czech Republic'), - ('DE', 'Germany'), - ('DJ', 'Djibouti'), - ('DK', 'Denmark'), - ('DM', 'Dominica'), - ('DO', 'Dominican Republic'), - ('DZ', 'Algeria'), - ('EC', 'Ecuador'), - ('EE', 'Estonia'), - ('EG', 'Egypt'), - ('EH', 'Western Sahara'), - ('ER', 'Eritrea'), - ('ES', 'Spain'), - ('ET', 'Ethiopia'), - ('FI', 'Finland'), - ('FJ', 'Fiji'), - ('FK', 'Falkland Islands (Malvinas)'), - ('FM', 'Micronesia, Federated States of'), - ('FO', 'Faroe Islands'), - ('FR', 'France'), - ('GA', 'Gabon'), - ('GB', 'United Kingdom of Great Britain and Northern Ireland'), - ('GD', 'Grenada'), - ('GE', 'Georgia'), - ('GF', 'French Guiana'), - ('GG', 'Guernsey'), - ('GH', 'Ghana'), - ('GI', 'Gibraltar'), - ('GL', 'Greenland'), - ('GM', 'Gambia'), - ('GN', 'Guinea'), - ('GP', 'Guadeloupe'), - ('GQ', 'Equatorial Guinea'), - ('GR', 'Greece'), - ('GS', 'South Georgia and the South Sandwich Islands'), - ('GT', 'Guatemala'), - ('GU', 'Guam'), - ('GW', 'Guinea-Bissau'), - ('GY', 'Guyana'), - ('HK', 'Hong Kong'), - ('HM', 'Heard Island and McDonald Islands'), - ('HN', 'Honduras'), - ('HR', 'Croatia'), - ('HT', 'Haiti'), - ('HU', 'Hungary'), - ('ID', 'Indonesia'), - ('IE', 'Ireland'), - ('IL', 'Israel'), - ('IM', 'Isle of Man'), - ('IN', 'India'), - ('IO', 'British Indian Ocean Territory'), - ('IQ', 'Iraq'), - ('IR', 'Iran, Islamic Republic of'), - ('IS', 'Iceland'), - ('IT', 'Italy'), - ('JE', 'Jersey'), - ('JM', 'Jamaica'), - ('JO', 'Jordan'), - ('JP', 'Japan'), - ('KE', 'Kenya'), - ('KG', 'Kyrgyzstan'), - ('KH', 'Cambodia'), - ('KI', 'Kiribati'), - ('KM', 'Comoros'), - ('KN', 'Saint Kitts and Nevis'), - ('KP', 'Korea, Democratic People''s Republic of'), - ('KR', 'Korea, Republic of'), - ('KW', 'Kuwait'), - ('KY', 'Cayman Islands'), - ('KZ', 'Kazakhstan'), - ('LA', 'Lao People''s Democratic Republic'), - ('LB', 'Lebanon'), - ('LC', 'Saint Lucia'), - ('LI', 'Liechtenstein'), - ('LK', 'Sri Lanka'), - ('LR', 'Liberia'), - ('LS', 'Lesotho'), - ('LT', 'Lithuania'), - ('LU', 'Luxembourg'), - ('LV', 'Latvia'), - ('LY', 'Libya'), - ('MA', 'Morocco'), - ('MC', 'Monaco'), - ('MD', 'Moldova, Republic of'), - ('ME', 'Montenegro'), - ('MF', 'Saint Martin (French part)'), - ('MG', 'Madagascar'), - ('MH', 'Marshall Islands'), - ('MK', 'Macedonia, the former Yugoslav Republic of'), - ('ML', 'Mali'), - ('MM', 'Myanmar'), - ('MN', 'Mongolia'), - ('MO', 'Macao'), - ('MP', 'Northern Mariana Islands'), - ('MQ', 'Martinique'), - ('MR', 'Mauritania'), - ('MS', 'Montserrat'), - ('MT', 'Malta'), - ('MU', 'Mauritius'), - ('MV', 'Maldives'), - ('MW', 'Malawi'), - ('MX', 'Mexico'), - ('MY', 'Malaysia'), - ('MZ', 'Mozambique'), - ('NA', 'Namibia'), - ('NC', 'New Caledonia'), - ('NE', 'Niger'), - ('NF', 'Norfolk Island'), - ('NG', 'Nigeria'), - ('NI', 'Nicaragua'), - ('NL', 'Netherlands'), - ('NO', 'Norway'), - ('NP', 'Nepal'), - ('NR', 'Nauru'), - ('NU', 'Niue'), - ('NZ', 'New Zealand'), - ('OM', 'Oman'), - ('PA', 'Panama'), - ('PE', 'Peru'), - ('PF', 'French Polynesia'), - ('PG', 'Papua New Guinea'), - ('PH', 'Philippines'), - ('PK', 'Pakistan'), - ('PL', 'Poland'), - ('PM', 'Saint Pierre and Miquelon'), - ('PN', 'Pitcairn'), - ('PR', 'Puerto Rico'), - ('PS', 'Palestine, State of'), - ('PT', 'Portugal'), - ('PW', 'Palau'), - ('PY', 'Paraguay'), - ('QA', 'Qatar'), - ('RE', 'Réunion'), - ('RO', 'Romania'), - ('RS', 'Serbia'), - ('RU', 'Russian Federation'), - ('RW', 'Rwanda'), - ('SA', 'Saudi Arabia'), - ('SB', 'Solomon Islands'), - ('SC', 'Seychelles'), - ('SD', 'Sudan'), - ('SE', 'Sweden'), - ('SG', 'Singapore'), - ('SH', 'Saint Helena, Ascension and Tristan da Cunha'), - ('SI', 'Slovenia'), - ('SJ', 'Svalbard and Jan Mayen'), - ('SK', 'Slovakia'), - ('SL', 'Sierra Leone'), - ('SM', 'San Marino'), - ('SN', 'Senegal'), - ('SO', 'Somalia'), - ('SR', 'Suriname'), - ('SS', 'South Sudan'), - ('ST', 'Sao Tome and Principe'), - ('SV', 'El Salvador'), - ('SX', 'Sint Maarten (Dutch part)'), - ('SY', 'Syrian Arab Republic'), - ('SZ', 'Swaziland'), - ('TC', 'Turks and Caicos Islands'), - ('TD', 'Chad'), - ('TF', 'French Southern Territories'), - ('TG', 'Togo'), - ('TH', 'Thailand'), - ('TJ', 'Tajikistan'), - ('TK', 'Tokelau'), - ('TL', 'Timor-Leste'), - ('TM', 'Turkmenistan'), - ('TN', 'Tunisia'), - ('TO', 'Tonga'), - ('TR', 'Turkey'), - ('TT', 'Trinidad and Tobago'), - ('TV', 'Tuvalu'), - ('TW', 'Taiwan, Province of China'), - ('TZ', 'Tanzania, United Republic of'), - ('UA', 'Ukraine'), - ('UG', 'Uganda'), - ('UM', 'United States Minor Outlying Islands'), - ('US', 'United States of America'), - ('UY', 'Uruguay'), - ('UZ', 'Uzbekistan'), - ('VA', 'Holy See'), - ('VC', 'Saint Vincent and the Grenadines'), - ('VE', 'Venezuela, Bolivarian Republic of'), - ('VG', 'Virgin Islands, British'), - ('VI', 'Virgin Islands, U.S.'), - ('VN', 'Viet Nam'), - ('VU', 'Vanuatu'), - ('WF', 'Wallis and Futuna'), - ('WS', 'Samoa'), - ('YE', 'Yemen'), - ('YT', 'Mayotte'), - ('ZA', 'South Africa'), - ('ZM', 'Zambia'), - ('ZW', 'Zimbabwe')); - - ldir: array[0..3] of string = - ('LANG', 'languages', 'locale', 'locale' + PathDelim + 'LC_MESSAGES'); - -var - AvailableLanguages: TStringList; - LastSelected: string = ''; - LangDir: string = ''; - LangAppName: string = ''; - - procedure CollectLanguagesFiles(appname: string = ''; dir: string = ''; useNativeName: Boolean = True); - function GetLangName(lcode: string; useNativeName: Boolean = True): string; - - function SetLang(lang: string; appname: string = ''): Boolean; - function SetLangByIndex(Idx: Integer): Boolean; - function GetDefaultLang: string; - -implementation - -function SortValue(List: TStringList; Index1, Index2: Integer): Integer; -begin - Result := CompareStr(List.ValueFromIndex[Index1], List.ValueFromIndex[Index2]); -end; - -procedure CollectLanguagesFiles(appname: string; dir: string; - useNativeName: Boolean); - - procedure searchLangDir(adir, aname: string); - var - SR: TSearchRec; - p: Integer; - ldir, lname, s, id: string; - begin - ldir := adir; - lname := LowerCase(aname); - if RightStr(ldir, 1) <> PathDelim then - ldir := ldir + PathDelim; - if DirectoryExistsUTF8(ldir) then - begin - if FindFirstUTF8(ldir + '*', faAnyFile, SR) = 0 then - repeat - s := LowerCase(SR.Name); - if (Pos(lname + '.', s) = 1) and - ((RightStr(s, 3) = '.po') or (RightStr(s, 3) = '.mo')) then - begin - s := SR.Name; - SetLength(s, Length(s) - 3); - p := Pos('.', s); - if p > 0 then - begin - id := Copy(s, p + 1, Length(s)); - if AvailableLanguages.Values[id] = '' then - AvailableLanguages.Values[id] := GetLangName(id, useNativeName); - end; - end; - until FindNextUTF8(SR) <> 0; - FindCloseUTF8(SR); - if AvailableLanguages.Count > 0 then - AvailableLanguages.CustomSort(@SortValue); - end; - end; - -var - sdir: string; - lauto: Boolean = False; - i: Integer; -begin - if dir = '' then - begin - if LangDir <> '' then - dir := LangDir - else - begin - dir := GetCurrentDirUTF8 + PathDelim; - lauto := True; - end; - end; - if appname = '' then - begin - if LangAppName <> '' then - appname := LangAppName - else - appname := ExtractFileNameOnly(ParamStrUTF8(0)); - end; - AvailableLanguages.Clear; - - if lauto then - for i := Low(ldir) to High(ldir) do - begin - sdir := dir + ldir[i] + PathDelim; - searchLangDir(sdir, appname); - end - else - searchLangDir(dir, appname); -end; - -function GetLangName(lcode: string; useNativeName: Boolean): string; - - function GetLang(const l: string): string; - var - i: Integer; - begin - Result := l; - for i := Low(Lang_english) to High(Lang_english) do - begin - if SameText(l, Lang_english[i, 0]) then - begin - Result := Lang_english[i, 1]; - Break; - end; - end; - end; - - function GetLangNative(const l: string): string; - var - i: Integer; - begin - Result := l; - for i := Low(Lang_native) to High(Lang_native) do - begin - if SameText(l, Lang_native[i, 0]) then - begin - Result := Lang_native[i, 1]; - Break; - end; - end; - end; - - function GetCountry(l: string): string; - var - i: Integer; - begin - Result := l; - for i := Low(Country_name) to High(Country_name) do - begin - if SameText(l, Country_name[i, 0]) then - begin - Result := Country_name[i, 1]; - Break; - end; - end; - end; - -var - p: Integer; - s, id: String; -begin - Result := lcode; - if Result = '' then Exit; - s := TrimSet(lcode,[' ','.','_','-']); - p := Pos('_', s); - if p = 0 then - p := Pos('-', s); - if p > 1 then - begin - id := Copy(s, 1, p - 1); - if useNativeName then - Result := GetLangNative(id) - else - Result := GetLang(id); - id := Copy(s, P + 1, Length(s)); - s := GetCountry(id); - if s <> id then - Result := Format('%s (%s)', [Result, GetCountry(id)]); - end - else - Result := GetLang(s); -end; - -function TranslateLCL(Lang: string): Boolean; -var - lcllang, lcllangdir, lcllangpath: string; - mofile: Boolean; - - procedure FindLCLFile; - var - i: Integer; - s: string; - begin - if LangDir <> '' then - begin - lcllangdir := LangDir; - if RightStr(lcllangdir, 1) <> PathDelim then - lcllangdir := lcllangdir + PathDelim; - s := lcllangdir + 'lclstrconsts.' + lcllang; - if FileExistsUTF8(s + '.po') then - lcllangpath := s + '.po' - else if FileExistsUTF8(s + '.mo') then - begin - lcllangpath := s + '.mo'; - mofile := True; - end; - end; - if lcllangpath = '' then - begin - for i := Low(ldir) to High(ldir) do - begin - lcllangdir := GetCurrentDirUTF8 + PathDelim + ldir[i]; - s := lcllangdir + 'lclstrconsts.' + lcllang; - if FileExistsUTF8(s + '.po') then - begin - lcllangpath := s + '.po'; - Break; - end - else if FileExistsUTF8(s + '.mo') then - begin - lcllangpath := s + '.mo'; - mofile := True; - Break; - end; - end; - end; - end; - -begin - Result := False; - lcllangpath := ''; - mofile := False; - lcllang := Lang; - FindLCLFile; - if lcllangpath = '' then - begin - if Pos('_', lcllang) <> 0 then - SetLength(lcllang, Pos('_', lcllang)-1); - FindLCLFile; - end; - if lcllangpath <> '' then - begin - if mofile then - gettext.TranslateUnitResourceStrings('LclStrConsts', lcllangpath) - else - Translations.TranslateUnitResourceStrings('LclStrConsts', lcllangpath); - Result := True; - end; -end; - -function SetLang(lang: string; appname: string): Boolean; -var - lfile: string; - ltrans: TUpdateTranslator; - i: Integer; -begin - Result := False; - ltrans := nil; - if (LastSelected <> lang) then - begin - LangDir := TrimRightSet(LangDir, [PathDelim]); - if appname = '' then - begin - if LangAppName <> '' then - appname := LangAppName - else - appname := ExtractFileNameOnly(ParamStrUTF8(0)); - end; - lfile := LangDir + PathDelim + appname + '.' + lang; - - if FileExistsUTF8(lfile + '.po') then //po file - begin - lfile := lfile + '.po'; - Translations.TranslateResourceStrings(lfile); - ltrans := TPOTranslator.Create(lfile); - end - else - if FileExistsUTF8(lfile + '.mo') then //mo file - begin - lfile := lfile + '.mo'; - gettext.TranslateResourceStrings(lfile); - ltrans := TDefaultTranslator.Create(lfile); - end; - - TranslateLCL(lang); - - if ltrans <> nil then - begin - if Assigned(LRSTranslator) then - LRSTranslator.Free; - LRSTranslator := ltrans; - for i := 0 to Screen.CustomFormCount-1 do - ltrans.UpdateTranslation(Screen.CustomForms[i]); - LastSelected := lang; - Result := True; - end; - end; -end; - -function SetLangByIndex(Idx: Integer): Boolean; -begin - Result := False; - if Idx < 0 then Exit; - if LastSelected <> AvailableLanguages.Names[idx] then - Result := SetLang(AvailableLanguages.Names[idx]); -end; - -function GetDefaultLang: string; -begin - {$IF FPC_FULLVERSION >= 20701} - Result := LCLTranslator.GetDefaultLang; - {$ELSE} - Result := ''; - {$ENDIF} -end; - -initialization - AvailableLanguages := TStringList.Create; - AvailableLanguages.NameValueSeparator := '='; - -finalization - AvailableLanguages.Free; - -end. - diff --git a/baseunits/webp.pas b/baseunits/webp.pas new file mode 100644 index 000000000..de7aaf1be --- /dev/null +++ b/baseunits/webp.pas @@ -0,0 +1,154 @@ +unit webp; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, MemBitmap, Dynlibs; + +var + WebPLibHandle: TLibHandle = 0; + DLLWebPName: String = {$IFDEF LINUX} 'libwebp.so' {$ELSE} 'libwebp.dll' {$ENDIF}; + +function IsWebPModuleLoaded: Boolean; +procedure InitWebPModule; +procedure DestroyWebPModule; +function WebPToMemBitmap(webp: TMemoryStream): TMemBitmap; +function WebPGetVersion: String; + +implementation + +uses + FMDOptions, SyncObjs; + +type + TWebPGetInfo = function (data: Pointer; data_size: UInt32; width, height: pInt32): Int32; cdecl; + TWebPDecodeBGRAInto = function (data: Pointer; data_size: UInt32; output: Pointer; output_size: UInt32; stride: Int32): pInt32; cdecl; + TWebPGetDecoderVersion = function (): Int32; cdecl; + +var + pWebPGetInfo: TWebPGetInfo = nil; + pWebPDecodeBGRAInto: TWebPDecodeBGRAInto = nil; + pWebPGetDecoderVersion: TWebPGetDecoderVersion = nil; + webpCS: TCriticalSection; + webpLibLoaded: Boolean = False; + +resourcestring + SErrLoadFailed = 'Can not load WebP codec library "%s". Check your installation.'; + +function IsWebPModuleLoaded: Boolean; +begin + Result := webpLibLoaded; +end; + +procedure InitWebPModule; +begin + if IsWebPModuleLoaded then Exit; + webpCS.Enter; + try + if not IsWebPModuleLoaded then begin + WebPLibHandle := LoadLibrary(PChar(DLLWebPName)); + if WebPLibHandle <> 0 then begin + pWebPGetInfo := TWebPGetInfo(GetProcAddress(WebPLibHandle, 'WebPGetInfo')); + pWebPDecodeBGRAInto := TWebPDecodeBGRAInto(GetProcAddress(WebPLibHandle, 'WebPDecodeBGRAInto')); + pWebPGetDecoderVersion := TWebPGetDecoderVersion(GetProcAddress(WebPLibHandle, 'WebPGetDecoderVersion')); + webpLibLoaded := True; + end else + raise EInOutError.CreateFmt(SErrLoadFailed, [DLLWebPName]); + end; + finally + webpCS.Leave; + end; +end; + +procedure DestroyWebPModule; +begin + webpCS.Enter; + try + if IsWebPModuleLoaded then begin + if WebPLibHandle <> 0 then begin + pWebPGetInfo := nil; + pWebPDecodeBGRAInto := nil; + pWebPGetDecoderVersion := nil; + FreeLibrary(WebPLibHandle); + WebPLibHandle := 0; + end; + webpLibLoaded := False; + end; + finally + webpCS.Leave; + end; +end; + +function WebPGetInfo(data: Pointer; data_size: UInt32; width, height: pInt32): Int32; +begin + if IsWebPModuleLoaded and Assigned(pWebPGetInfo) then + Result := pWebPGetInfo(data, data_size, width, height) + else + Result := 0; +end; + +function WebPDecodeBGRAInto(data: Pointer; data_size: UInt32; output: Pointer; output_size: UInt32; stride: Int32): pInt32; +begin + if IsWebPModuleLoaded and Assigned(pWebPDecodeBGRAInto) then + Result := pWebPDecodeBGRAInto(data, data_size, output, output_size, stride) + else + Result := nil; +end; + +function WebPGetDecoderVersion: Int32; +begin + if IsWebPModuleLoaded and Assigned(pWebPGetDecoderVersion) then + Result := pWebPGetDecoderVersion() + else + Result := 0; +end; + +function WebPGetVersion: String; +var + ver: Int32; +begin + Result := ''; + ver := WebPGetDecoderVersion; + if ver > 0 then begin + Result += chr(((ver shr 16) and $ff) + $30) + '.'; + Result += chr(((ver shr 8) and $ff) + $30) + '.'; + Result += chr(( ver and $ff) + $30); + end; +end; + +function WebPToMemBitmap(webp: TMemoryStream): TMemBitmap; +var + e, width, height, stride: Integer; + scan: pInt32; + r: TMemBitmap; +begin + Result := nil; + if webp = nil then Exit; + + e := WebPGetInfo(webp.Memory, webp.Size, @width, @height); + if e = 0 then Exit; + + r := TMemBitmap.Create(width, height); + stride := (r.ScanLine[1] - r.ScanLine[0]) * SizeOf(TMemPixel); + scan := WebPDecodeBGRAInto(webp.Memory, webp.Size, + r.ScanLine[0], stride * height, stride); + + if scan <> PLongint(r.ScanLine[0]) then begin + r.Free; + Exit; + end; + + Result := r; +end; + +initialization + webpCS := TCriticalSection.Create; + +finalization + DestroyWebPModule; + webpCS.Free; + +end. + diff --git a/changelog.txt b/changelog.txt index 20dc3f8c5..3e06e2b3d 100644 --- a/changelog.txt +++ b/changelog.txt @@ -1,13 +1,1218 @@ Free Manga Downloader Project page: https://github.com/riderkick/FMD -For manga list data check: -https://bintray.com/riderkick/FMD/data/all/#files -https://www.mediafire.com/folder/3ccy2c7g36hp3/Fmd - Changelog: (! = Important, + = Addition, - = Removal, * = Bug fix/Change/Edit, ? = Require feedback) +0.9.158.0 (06-01-2018) +[*] Minor bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.157.0...0.9.158.0 + +0.9.157.0 (29-12-2018) +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.156.0...0.9.157.0 + +0.9.156.0 (02-07-2018) +[+] Added DoujinsCom [H-Sites] +[+] Added PlusComico [RAW] +[+] Added ZingBox [EN] +[+] Added MangaRoom [EN] +[+] Added RawNeko [RAW] +[+] Added MangaHispano [SP] +[+] Added WestManga [ID] +[+] Added DM5 [RAW] +[+] Added TranslateWebtoon +[+] Added RawQV [RAW] +[+] Added AsmHentai [H-Sites] +[+] Added KomikGue [ID] +[+] Added Toonkor [RAW] +[+] Added 3asq [AR-SC] +[+] Added TruyenChon [VI] +[+] Added NetTruyen [VI] +[+] Added Mexat [AR-SC] +[-] Removed Bamtoki +[*] Tumangaonline, fixed all +[*] Mangavy, fixed all +[*] MyReadingManga, fixed manga info +[*] Lhscans, fixed manga info +[*] TruyenTranhTuan, fixed page order +[*] MangaID, fixed domain name +[*] UnionMangas, fixed list update +[*] HatigarmScans, fixed domain name +[*] HeavenManga, fixed domain name +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.155.0...0.9.156.0 + +0.9.155.0 (14-05-2018) +[+] Added ePub support +[+] Added Bamtoki [RAW] +[+] Added RawQQ [RAW] +[+] Added AllHentai [RU] +[+] Added ComicExtra [EN] +[+] Added ReadComicBooksOnline [EN] +[+] Added SOSScanlation [SP-SC] +[+] Added MangaHereIO [EN] +[+] Added SiberOwl [EN-SC] +[+] Added ComicoCoID [ID] +[+] Added IMangaScans [EN-SC] +[+] Added InManga [SP] +[-] Removed MangaSh +[*] MangaKu, fixed domain name +[*] JapScan, fixed download +[*] Pzykosis666HFansub, fixed domain name +[*] ReadComicOnline, set high image quality +[*] MangaDex, fixed all +[*] CentralDeMangas, fixed domain name +[*] Mangaf, fixed domain name +[*] AcademyVN, fixed domain name +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.154.0...0.9.155.0 + +0.9.154.0 (15-04-2018) +[+] Added GodsRealmScan [SP-SC] +[+] Added IlluminatiManga [EN-SC] +[+] Added MangaFreak [EN] +[+] Added MangaHereFun [EN] +[+] Added MangaAll [RAW] +[+] Added MangaTrue [RAW] +[-] Removed MangaBackup +[*] MangaTail, changed domain +[*] MangaDex, fixed all +[*] Tapas, fixed manga list update +[*] MyReadingManga, fixed download +[*] MangaHere, fixed manga list update +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.153.0...0.9.154.0 + +0.9.153.0 (08-04-2018) +[+] Added SoManga [PT] +[+] Added ReadMangaEU [EN] +[+] Added MangaDoom [EN] +[+] Added RawMangaUpdate [RAW] +[+] Added ManhuaTr [TR] +[+] Added MangaVadisi [TR] +[+] Added Manga99 [EN] +[+] Added MangaRawOnline [RAW] +[+] Added AcQQCom [RAW] +[+] Added MangaLib [RU] +[+] Added DesuMe [RU] +[+] Added Shakai [RU] +[+] Added MangaOnlineBiz [RU] +[+] Added MangaOnlineToday [EN] +[+] Added TrashScanlations [EN-SC] +[+] Added HatigarmScans [EN-SC] +[+] Added BunnysScans [EN-SC] +[+] Added CanisMajorScans [EN-SC] +[+] Added HoshikuzuuScans [EN-SC] +[+] Added YaoiIsLife [EN-SC] +[+] Added FujoshiBitches [EN-SC] +[+] Added TwistedHelScans [EN-SC] +[+] Added TapTrans [EN-SC] +[+] Added ZeroScans [EN-SC] +[+] Added WhiteCloudPavilion [EN-SC] +[+] Added EvilFlowers [EN-SC] +[+] Added LoliVault [SP-SC] +[+] Added CoYuHi [SP-SC] +[+] Added SKSubs [SP-SC] +[+] Added ComicVn [VI] +[+] Added MangaSupa [EN] +[+] Added MangaFoxCom [EN] +[+] Added MangaKid [ID] +[+] Added MangaCast [ID] +[-] Removed MangaTraders +[*] MangaDex, fixed all +[*] Hentai2Read, fix domain +[*] Imgur, fix download +[*] LHTranslation, fixed all +[*] HeavenManga, change domain +[*] LeitorNet, added manga list update +[*] JapScan, change domain +[*] UnionMangas, change domain +[*] NeuManga, fix manga info +[*] Updated Russian localization +[*] Cloudflare, fix bypass +[*] Fixed crash when searching website by name +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.152.0...0.9.153.0 + +0.9.152.0 (28-02-2018) +[!] Fix updater doesn't extract the update package after download. + You have to download this version manually or extract updatepakage.7z +Full changes: https://github.com/riderkick/FMD/compare/0.9.151.0...0.9.152.0 + +0.9.151.0 (28-02-2018) +[+] Added MangajinNoFansub [SP-SC] +[+] Added TenManga [EN] +[*] Updated Portuguese (Brazil) translation by Havokdan +[*] Updated Spanish translation by rs3mk +[*] Updated Turkish translation by Tmp341 +[*] Madokami, fixed login +[*] MangaDex, fixed all +[*] Disable coloring on disabled item in favorites list +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.150.0...0.9.151.0 + +0.9.150.0 (26-02-2018) +[+] Added HeavenManga [EN] +[+] Added Nightow [SP-SC] +[+] Added TrueColorsScan [SP-SC] +[*] SeinagiFansub, fixed domain +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.149.0...0.9.150.0 + +0.9.149.0 (26-02-2018) +[!] Separated settings for each website +[+] Added KomikStation [ID] +[+] Added SilentSkyScans [EN-SC] +[+] Added Yuri-ism [EN-SC] +[+] Added SaikoScans [EN-SC] +[+] Added RoseliaScanlations [EN-SC] +[+] Added VortexScans [EN-SC] +[+] Added PhoenixSerenade [EN-SC] +[+] Added Riceballicious [EN-SC] +[+] Added ForgottenScans [EN-SC] +[+] Added MangaichiScan [EN-SC] +[+] Added DarkSkyScan [SP-SC] +[+] Added NozominoFansub [SP-SC] +[+] Added add ManHuaTai [Raw] +[+] Added add Rawdevart [Raw] +[*] Updated Indonesian localization +[*] Updated Turkish localization +[*] Fix JPG to PNG conversion +[*] MangaHubIO, fix download +[*] MangaDex, add chapter list pagination +[*] VnSharing, fix update list +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.148.0...0.9.149.0 + +0.9.148.0 (20-02-2018) +[+] Added MyMangaIO [FR] +[+] Added MangaHub [EN] +[+] Added MangaBB [EN] +[+] Added AntisenseScans [EN-SC] +[+] Added TheCatScans [EN-SC] +[+] Added DeathTollScans [EN-SC] +[+] Added IdkScans [SP-SC] +[*] Tumangaonline, show scanlation group +[*] Updated Spanish translation +[*] Added summary to manga list hint +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.147.0...0.9.148.0 + +0.9.147.0 (19-02-2018) +[+] Added LeitorNet [PT] +[*] Restore window size on startup +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.146.0...0.9.147.0 + +0.9.146.0 (18-02-2018) +[+] Added XAnimeSeduccion [SP-SC] +[+] Added JokerFansub [SP-SC] +[+] Added PatyScans [SP-SC] +[*] MangaKu, fixed all +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.145.0...0.9.146.0 + +0.9.145.0 (17-02-2018) +[*] Update Indonesian localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.144.0...0.9.145.0 + +0.9.144.0 (17-02-2018) +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.143.0...0.9.144.0 + +0.9.143.0 (17-02-2018) +[*] Update Indonesian localization +[*] Update Turkish localization +[*] Update Russian localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.142.0...0.9.143.0 + +0.9.142.0 (16-02-2018) +[+] Added ManhwaCo [EN-SC] +[+] Added HentaiHere [H] +[*] Fixed update list issue +[*] Update Indonesian localization +[*] Update Russian localization +[*] Update Turkish localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.141.0...0.9.142.0 + +0.9.141.0 (15-02-2018) +[+] Added new updater only to extract update package +[*] Download new version in the background +[*] Download mangalist database(s) in the background +[*] Pururin, change domain +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.140.0...0.9.141.0 + +0.9.140.0 (14-02-2018) +[+] Added SeaOtterScans [EN-SC] +[+] Added MangaSh +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.139.0...0.9.140.0 + +0.9.139.0 (13-02-2018) +[+] Added SelfMangaRU [RU] +[+] Added MerakiScans [EN-SC] +[*] MangaOnlineTo, change domain +[*] Update Turkish localization +[*] Fixed empty website selection in advanced website options +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.138.0...0.9.139.0 + +0.9.138.0 (13-02-2018) +[+] Added option to delete completed task on close +[+] Added option to convert PNG images to JPEG +[+] Added NeuManga [ID] +[+] Added HotChoholateScans [EN-SC] +[+] Added LetItGoScans [EN-SC] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.137.0...0.9.138.0 + +0.9.137.0 (12-02-2018) +[+] Added ChibiManga [EN-SC] +[*] Fixed updater can't find 7za.exe, you need to download this release manually +[*] Update Turkish localization +[*] Update Indonesian localization +[*] Update Russian localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.136.0...0.9.137.0 + +0.9.136.0 (12-02-2018) +[+] Added website modules updater +[+] Added RavenScans [SP-SC] +[+] Added KirishimaFansub [SP-SC] +[+] Added NoraNoFansub [SP-SC] +[+] Added YamiTenshiNoFansub [SP-SC] +[+] Added Mangavy [ID] +[-] Removed MangaWorksFansub +[-] Removed MasterPieceScans +[-] Removed R15TeamScanlation +[*] TonarinoYoungJump: fixed all +[*] Hentai2Read: fixed info +[*] Mangadex: limit maximum connections to 4 +[*] Update Turkish localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.135.0...0.9.136.0 + +0.9.135.0 (10-02-2018) +[+] Added option to convert WebP to PNG/JPEG +[-] Removed AnimeA +[-] Removed CentrumMangi_PL +[-] Removed DM5 +[-] Removed Imanhua +[-] Removed MangaLib_PL +[-] Removed MangaAr +[-] Removed MangaAt +[*] MangaStream: fixed download +[*] Update Russian localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.134.0...0.9.135.0 + +0.9.134.0 (08-02-2018) +[+] Added Lhscans [RAW] +[+] Added Mangakakalot/Manganelo [EN] +[+] Added Mangawindow [EN] +[*] MangaStream: fixed domain +[*] Update Turkish localization +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.133.0...0.9.134.0 + +0.9.133.0 (07-02-2018) +[!] Added Lua support to add website module at runtime +[+] Added left download toolbar to move selected download(s). Options > View +[+] Added WorldThree [EN-SC] +[+] Added PsychoPlay [EN-SC] +[+] Added MangaZukiRaws [Raws] +[+] Added MangaDeep [EN] +[+] Added Imgur +[-] Removed MangaSpy +[-] Removed MangaIce +[*] View manga info preserve saveto location from download or favorite +[*] MangaZuki: fixed all +[*] Comico: fixed all +[*] MangaGo: fixed all +[*] Tumangaonline: fixed all +[*] MangaAe: fixed download +[*] Cloudflare check added to all network events +[*] Update Russian localization (by TokcDK) +[*] Update Turkish localization (by Tmp341) +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.132.0...0.9.133.0 + +0.9.132.0 (29-01-2018) +[*] LHTranslation, fix chapter order +[*] Mangadex, fix download +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.131.0...0.9.132.0 + +0.9.131.0 (27-01-2018) +[+] Added Mangarock [EN] +[+] Added LHTranslation [EN-SC] +[+] Added ChampionScans [EN-SC] +[+] Added Mangaf [AR] +[+] Added WieManga [DE] +[+] Added MangaTube [DE] +[+] Added AtelierDuNoir [EN-SC] +[+] Added MangaDex [EN] +[+] Added MangaHub [RU] +[+] Added Turkish translation by Tmp341 +[+] Added WebP codec library (libwebp) +[+] Enabled high DPI awareness +[*] MangaTown, exclude ads page +[*] MangaChan, fix domain +[*] UnionMangas, fix download +[*] Update localization [EN, RU] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.130.0...0.9.131.0 + +0.9.130.0 (23-01-2018) +[+] Added transfer favorites +[+] Added rename favorites +[+] Added Subapics [ID] +[+] Added MangaDesu [ID] +[+] Added MangaKita [ID] +[+] Added Whiteoutscans [EN-SC] +[+] Added DokiFansubs [EN-SC] +[*] NineManga: fixed all +[*] MangaInn: fixed all +[*] MangaLife: fixed domain +[*] MangaId: fixed download +[*] Madokami: fixed chapter title +[*] Jaiminisbox: fixed downoad +[*] MangaPark: fixed title +[*] Tsumanga: fixed update list +[*] Kumanga: fixed all +[*] RawSenManga: fixed all +[*] SenManga: fixed all +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.129.0...0.9.130.0 + +0.9.129.0 (02-01-2018) +[*] MangaGo: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.128.0...0.9.129.0 + +0.9.128.0 (15-12-2017) +Full changes: https://github.com/riderkick/FMD/compare/0.9.127.0...0.9.128.0 + +0.9.127.0 (19-11-2017) +[*] MangaFox, MangaHere: exclude ads page +Full changes: https://github.com/riderkick/FMD/compare/0.9.126.0...0.9.127.0 + +0.9.126.0 (29-08-2017) +[*] Madokami: fixed update list +[*] Fixed download issue with some website +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.125.0...0.9.126.0 + +0.9.125.0 (26-08-2017) +[*] Japscan: fixed download +[*] MangaZuki: fixed title +[*] MangaGo: fixed title +[*] HeyManga: fixed download +[*] Fixed failed chapter(s) always marked as finished +[+] Added option to always start task from failed chapter if any +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.124.0...0.9.125.0 + +0.9.124.0 (16-08-2017) +[*] MangaShiro: fixed all +[*] MangaFox: remove "new" from chapter's title +[*] Update Portuguese (Brazil) translation by Havokdan +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.123.0...0.9.124.0 + +0.9.123.0 (13-08-2017) +[+] Added option for auto retry failed task +[*] MangaInn: fixed chapter name +[*] Update Spanish translation by Mariolr39 +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.122.0...0.9.123.0 + +0.9.122.0 (02-08-2017) +[*] MangaAe: fixed all +[*] Tumangaonline: fixed load manhwa +[*] MangaInn: fixed all +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.121.0...0.9.122.0 + +0.9.121.0 (28-07-2017) +[*] Mangago: fixed download +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.120.0...0.9.121.0 + +0.9.120.0 (26-07-2017) +[*] Added support for relative path +[*] Increased task/connection limit for win32 to 16/64 and win64 to 64/256 +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.119.0...0.9.120.0 + +0.9.119.0 (21-07-2017) +[+] Added shogakukan +[+] Added Russian translation by TokcDK +[*] Mangasee: fixed download +[*] MyReadingManga: fixed download +[*] Madokami: fixed update list +[*] TonariYoungJump: fixed chapter list +[*] Mangazuki: fixed chapter list +[*] Update Greek translation by geogeo-gr +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.118.0...0.9.119.0 + +0.9.118.0 (14-06-2017) +[*] Madokami: fixed all +[-] MangaKoi: removed +[+] Added MangaHome[EN] +[-] MangaMint: removed +[+] Added MangaTail[EN] +[+] Added MangaSail[EN] +[+] Added option to minimize on start +[*] Manga-Tr: fixed all +[*] GManga: fixed all +[*] TruyenTranhTuan: fixed all +[-] Manga24H: removed +[*] BlogTruyen: fixed all +[*] KuManga: fixed all +[*] LeoManga: fixed all +Full changes: https://github.com/riderkick/FMD/compare/0.9.117.0...0.9.118.0 + +0.9.117.0 (12-06-2017) +[*] Fixed empty update url, you may need to download this version manually +Full changes: https://github.com/riderkick/FMD/compare/0.9.116.0...0.9.117.0 + +0.9.116.0 (12-06-2017) +[*] NineManga: fixed all +[*] MyReadingManga: fixed all +Full changes: https://github.com/riderkick/FMD/compare/0.9.115.0...0.9.116.0 + +0.9.115.0 (11-06-2017) +[+] Added Taadd[EN] +[-] Fakku: removed, not free anymore +[-] Yomanga: removed, website down +Full changes: https://github.com/riderkick/FMD/compare/0.9.114.0...0.9.115.0 + +0.9.114.0 (10-06-2017) +[*] EatManga: fixed all +[*] Fixed layout +Full changes: https://github.com/riderkick/FMD/compare/0.9.113.0...0.9.114.0 + +0.9.113.0 (08-06-2017) +[*] Pururin: fixed all +[*] Layout changes +Full changes: https://github.com/riderkick/FMD/compare/0.9.112.0...0.9.113.0 + +0.9.112.0 (29-05-2017) +[*] HitomiLa: fixed download +[*] MangaGo: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.111.0...0.9.112.0 + +0.9.111.0 (23-05-2017) +[+] Added Tapas +[*] Tumangaonline: fixed all +[*] NeoProjectScan: fixed domain +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.110.0...0.9.111.0 + +0.9.110.0 (02-05-2017) +[*] CF: fixed expired cookies +[*] KissManga: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.109.0...0.9.110.0 + +0.9.109.0 (30-03-2017) +[*] KissManga: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.108.0...0.9.109.0 + +0.9.108.0 (27-03-2017) +[*] KissManga: fixed download +[*] Luscious: rewrite all +[+] Added Pururin[H] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.107.0...0.9.108.0 + +0.9.107.0 (25-03-2017) +[*] KissManga: added option to add custom key and iv #538 +Full changes: https://github.com/riderkick/FMD/compare/0.9.106.0...0.9.107.0 + +0.9.106.0 (23-03-2017) +[*] KissManga: fixed download +[*] HeyManga: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.105.0...0.9.106.0 + +0.9.105.0 (22-03-2017) +[*] Fixed memory leak +[+] Added FallenAngelsScan[EN-SC] +Full changes: https://github.com/riderkick/FMD/compare/0.9.104.0...0.9.105.0 + +0.9.104.0 (16-03-2017) +[+] Added HentaiFox[H] +[*] Fixed memory leak +Full changes: https://github.com/riderkick/FMD/compare/0.9.103.0...0.9.104.0 + +0.9.103.0 (15-03-2017) +[+] Added MangaOnlineBR[PT] +[*] UnionMangas: exclude banner +Full changes: https://github.com/riderkick/FMD/compare/0.9.102.0...0.9.103.0 + +0.9.102.0 (13-03-2017) +[*] MangaGo: fixed download +[*] ReadMangaToday: rewrite all codes +Full changes: https://github.com/riderkick/FMD/compare/0.9.101.0...0.9.102.0 + +0.9.101.0 (10-03-2017) +[+] Batoto: added option to select the image server to download +[*] MangaIndo: rewrite all codes +[+] Added MangaID[ID] +[+] Added MangaShiro[ID] +[-] Mabuns: removed +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.100.0...0.9.101.0 + +0.9.100.0 (08-03-2017) +[*] Minor bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.99.0...0.9.100.0 + +0.9.99.0 (08-03-2017) +[+] Added MangaZuki[EN-SC] +[-] HugeManga and MangaEsta were removed because the website is dead +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.98.0...0.9.99.0 + +0.9.98.0 (06-03-2017) +[*] Fixed various issue with downloads and favorites +[*] Added enable/disable favorites +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.97.0...0.9.98.0 + +0.9.97.0 (03-03-2017) +[*] Fixed save and restore downloads +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.96.0...0.9.97.0 + +0.9.96.0 (02-03-2017) +[+] Added option to sort chapter list in mangainfo +[*] Auto scroll chapter list to the bottom if sort is ascending +[*] Fixed convert old downloads data before 0.9.94.0 +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.95.0...0.9.96.0 + +0.9.95.0 (29-02-2017) +[*] Fixed various issue when terminating threads/closing app +[*] Fixed updater +Full changes: https://github.com/riderkick/FMD/compare/0.9.94.0...0.9.95.0 + +0.9.94.0 (28-02-2017) +[!+] Favorites and Downloads now saved in SQLite database file + WARNING: Please backup your favorites.ini and works.ini before update +[*] Sorted downloads and favorites only allowed with left click +[*] Fixed various issue with downloaded chapter list +[*] Hentai2Read: fixed download +[+] Added HelveticaScans[EN-SC] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.93.0...0.9.94.0 + +0.9.93.0 (22-02-2017) +[*] WPManga: Fixed memory leak +Full changes: https://github.com/riderkick/FMD/compare/0.9.92.0...0.9.93.0 + +0.9.92.0 (21-02-2017) +[+] Added MangaDoor[ES] +[+] Added HentaiRead[H] +[*] Replace MangaHen with MangaSpy +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.91.0...0.9.92.0 + +0.9.91.0 (16-02-2017) +[*] E-Hentai: fixed loading "Content Warning" +Full changes: https://github.com/riderkick/FMD/compare/0.9.90.0...0.9.91.0 + +0.9.90.0 (16-02-2017) +[+] Added Portuguese (Brazil) translation by Havokdan +[+] Added Greek translation by geogeo_gr +[*] Fixed error when removing running download task +[*] Fixed shop drop box at startup +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.89.0...0.9.90.0 + +0.9.89.0 (06-02-2017) +[*] E-Hentai: fixed root url +[*] Split MangeEden_IT and PervEden_IT +[+] Added Polish language, thanks to grzesjam +[+] Added options to open favorites at startup +Full changes: https://github.com/riderkick/FMD/compare/0.9.88.0...0.9.89.0 + +0.9.88.0 (21-01-2017) +[+] Added GoodManga[EN] +Full changes: https://github.com/riderkick/FMD/compare/0.9.87.0...0.9.88.0 + +0.9.87.0 (12-01-2017) +[*] MangaTraders: fixed manga list +[*] Japscan: rewrite all codes +[*] MangaGo: rewrite all codes +Full changes: https://github.com/riderkick/FMD/compare/0.9.86.0...0.9.87.0 + +0.9.86.0 (11-01-2017) +[+] Added MangaCool[EN] +[*] MangaTraders: fixed issue #437 +Full changes: https://github.com/riderkick/FMD/compare/0.9.85.0...0.9.86.0 + +0.9.85.0 (08-01-2017) +[*] MangaFox: fixed missing chapter title +[*] MangaLife, MangaSee, MangaTraders: fixed all, MangaTraders require account +[*] KireiCake: Fixed manga list +[*] ReadComic: Fixed manga list +[*] Fixed CF issue #433 +Full changes: https://github.com/riderkick/FMD/compare/0.9.84.0...0.9.85.0 + +0.9.84.0 (04-01-2017) +[*] MangaFox: fixed manga info and Status +[*] MangaTown: fixed Image Url +[*] Removed MangaCow and Moved to WPManga +[+] Added Tonari no Young Jump, Comico, NewType and fixed Sunday Web Every[JP] +[+] Added PowerManga, Jaiminisbox, KireiCake and ReadComics[EN] +[*] Fixed Madokami Url +[*] Fixed 8Muses +Full changes: https://github.com/riderkick/FMD/compare/0.9.83.0...0.9.84.0 + +0.9.83.0 (06-09-2016) +[*] Fixed an issue when saving to pdf +[*] Hentai2Read: fixed manga info +[+] Added MyMangaMe[EN] +Full changes: https://github.com/riderkick/FMD/compare/0.9.82.0...0.9.83.0 + +0.9.82.0 (28-08-2016) +[+] Added MangaOnlineTo[EN] +Full changes: https://github.com/riderkick/FMD/compare/0.9.81.0...0.9.82.0 + +0.9.81.0 (21-08-2016) +[*] Tumangaonline: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.80.0...0.9.81.0 + +0.9.80.0 (20-08-2016) +[*] Tsumino: fixed download +Full changes: https://github.com/riderkick/FMD/compare/0.9.79.0...0.9.80.0 + +0.9.79.0 (18-08-2016) +[*] Fixed an error when creating download task +[*] Fixed empty chapters with some website +[*] Komikid: rewrite all code +Full changes: https://github.com/riderkick/FMD/compare/0.9.78.0...0.9.79.0 + +0.9.78.0 (17-08-2016) +[*] Fixed various issue with unicode path and filename +[*] TripleSevenScan: fixed accept adult warning +[*] MangaIndo: fixed manga info +[*] MangaChanRU/HentaiChanRU/YaoiChanRU: fixed manga info and empty chapters +[+] Added custom text to be used to replace unicode character +[+] Added context menu to copy log message +[*] MangaStream: fixed an issue with some chapters +[+] Added split download feature +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.77.0...0.9.78.0 + +0.9.77.0 (13-08-2016) +[*] MangaTraders: rewrite all code +[*] MangaIndo: rewrite all code +[+] MangaJoy replaced with FunManga[EN] +[+] Added SundayWebry[RAW] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.76.0...0.9.77.0 + +0.9.76.0 (07-08-2016) +[*] Fixed download tree status not updating +[+] Added Log form, Options > Misc > Log +[+] Added TripleSevenScan[EN] +[*] MangaFox: fixed remove watermark +[*] E-Hentai/ExHentai: fixed download causing by incorrect filenames +[*] Fixed export to PDF issue with indexed PNG images +[+] Added HentaiChanRU[H], YaoiChanRU[H] +[*] GameofScanlation: fixed download embedded base64 images +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.75.0...0.9.76.0 + +0.9.75.0 (30-07-2016) +[+] Added "Delete task + data + favorite" in download list popup menu +[+] Added "Delete" in manga list popup menu +[+] Added Favorite list search +[+] Added Download list search +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.74.0...0.9.75.0 + +0.9.74.0 (06-07-2016) +[+] Added enable/disable task. Disabled task can't be resumed unless it's enabled manually, this task will be skipped on resume all. +[+] Added tray icon popup menu. Resume all, Stop all, Action after download finish, Show drop box, Restore and Exit. +[*] MangaInn: fixed incorrectly download second page and forth (#317) +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.73.0...0.9.74.0 + +0.9.73.0 (06-07-2016) +[+] Added custom color for favorite with empty chapters +[*] Various changes +Full changes: https://github.com/riderkick/FMD/compare/0.9.72.0...0.9.73.0 + +0.9.72.0 (04-07-2016) +[*] Fixed CF +[+] Added custom color options for list, Options > Misc +[*] MangaSee, MangaLife: rewrite all code +Full changes: https://github.com/riderkick/FMD/compare/0.9.71.0...0.9.72.0 + +0.9.71.0 (01-07-2016) +[*] Tumangaonline: show all available chapter with scanlation name, fixed download +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.70.0...0.9.71.0 + +0.9.70.0 (29-06-2016) +[*] SeinagiAdultoFansub: fixed manga info and download +[*] Fixed an issue with CF +Full changes: https://github.com/riderkick/FMD/compare/0.9.69.0...0.9.70.0 + +0.9.69.0 (22-06-2016) +[*] MangaJoy: fixed update list +[+] Added DangoOnlineNoFansub[ES-SC] +[+] Added DejameProbar[ES-SC] +[+] Added HoshinoFansub[ES-SC] +[+] Added MangaWorksFansub[ES-SC] +[+] Added MasterPieceScans[ES-SC] +[+] Added MenudoFansub[ES-SC] +[+] Added NeoProjectScan[ES-SC] +[+] Added Pzykosis666HFansub[ES-SC] +[+] Added R15TeamScanlation[ES-SC] +[+] Added SantosScan[ES-SC] +[+] Added SeinagiFansub[ES-SC] +[+] Added SeinagiAdultoFansub[ES-SC] +[+] Added SolitarioNoFansub[ES-SC] +Full changes: https://github.com/riderkick/FMD/compare/0.9.68.0...0.9.69.0 + +0.9.68.0 (20-06-2016) +[*] Fixed error at start +Full changes: https://github.com/riderkick/FMD/compare/0.9.67.0...0.9.68.0 + +0.9.67.0 (20-06-2016) +[*] MangaPark: rewrite all code +[*] MangaBug: replaced with MangaIce +[+] Added MangaJoy[EN] +[*] Various changes and bug fix +Full changes: https://github.com/riderkick/FMD/compare/0.9.66.0...0.9.67.0 + +0.9.66.0 (18-06-2016) +[*] KissManga: fixed manga info +[+] Added LeoManga[ES] +Full changes: https://github.com/riderkick/FMD/compare/0.9.65.0...0.9.66.0 + +0.9.65.0 (16-06-2016) +[*] Fixed check for new chapters +[*] Tumangaonline: fixed get all chapters +[*] MangaInn: rewrite all code +[*] Various changes and bug fix +Full changes: https://github.com/riderkick/FMD/compare/0.9.64.0...0.9.65.0 + +0.9.64.0 (15-06-2016) +[+] Show new chapters and status downloaded while checking favorites with icon and highlight +[*] SenManga: fixed all +[+] E-Hentai/ExHentai: replace option download original image with image size with combobox +[*] Various changes and bug fix +Full changes: https://github.com/riderkick/FMD/compare/0.9.63.0...0.9.64.0 + +0.9.63.0 (11-06-2016) +[*] Fixed an issue with CF +Full changes: https://github.com/riderkick/FMD/compare/0.9.62.0...0.9.63.0 + +0.9.62.0 (09-06-2016) +[*] Fixed various path issue (#275, #276, #279) +[+] Added OneTimeScans[EN-SC] +[+] Added SenseScan[EN-SC] +[+] Added KuManga[ES] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.61.0...0.9.62.0 + +0.9.61.0 (05-06-2016) +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.60.0...0.9.61.0 + +0.9.60.0 (03-06-2016) +[*] ReadComicOnline: fixed domain +[*] Fixed various path issue +[+] Added option for custom filename +[+] Added option to disable auto generate chapter folder +[+] Added popup menu to check/uncheck/indeterminate all genres in filter +[+] Added filter chapter list in mangainfo, activate via popup menu on chapter list +[*] Double click on "Save to" column on download list/favorite list will open folder +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.59.0...0.9.60.0 + +0.9.59.0 (30-05-2016) +[+] Added SekaiManga[ES] +Full changes: https://github.com/riderkick/FMD/compare/0.9.58.0...0.9.59.0 + +0.9.58.0 (29-05-2016) +[*] Batoto: fixed download +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.57.0...0.9.58.0 + +0.9.57.0 (28-05-2016) +[*] Fixed incorrectly store full path inside archive (zip/cbz) +[+] Added GManga[AR] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.56.0...0.9.57.0 + +0.9.56.0 (25-05-2016) +[*] YoManga: fixed download +[*] HeyManga: fixed download +[*] Webtoons: download original images (#254) +[+] Added MangaSaurus[EN] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.55.0...0.9.56.0 + +0.9.55.0 (20-05-2016) +[*] Tumangaonline: rewrite all code, require new manga list +[*] Yomanga: fixed blocked by cf +[*] GameofScanlation: fixed download +[-] MangaVadisi and MangaFrame removed +[+] Added MangaDenizi[TR] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.54.0...0.9.55.0 + +0.9.54.0 (09-05-2016) +[*] Manga-Tr: fixed get image url +[+] Added Puzzmos[TR] +[+] Added WebtoonTr[TR] +Full changes: https://github.com/riderkick/FMD/compare/0.9.53.0...0.9.54.0 + +0.9.53.0 (08-05-2016) +[*] Tsumino: fixed update list +Full changes: https://github.com/riderkick/FMD/compare/0.9.52.0...0.9.53.0 + +0.9.52.0 (07-05-2016) +[*] Added HeyManga[EN] +[*] HitomiLa: fixed update list +Full changes: https://github.com/riderkick/FMD/compare/0.9.51.0...0.9.52.0 + +0.9.51.0 (13-04-2016) +[*] Fixed restore window position +[*] MangaEden/PerEven: rewrite all script +[*] MangaHere: fixed missing genres +[*] Hentai2Read: fixed update list +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.50.0...0.9.51.0 + +0.9.50.0 (11-04-2016) +[*] Added GoManga[EN] +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.49.0...0.9.50.0 + +0.9.49.0 (08-04-2016) +[*] Preserve file last modified date from server +[*] Added more website advanced option +[*] HitomiLa: fix info +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.48.0...0.9.49.0 + +0.9.48.0 (02-04-2016) +[*] E-Hentai/ExHentai: Fixed filename serialized several times +[+] Added ReadComicOnline[EN] +[*] Website specific option moved to Options > Websites > Options +[+] Added website specific cookies and user agent, Options > Websites > Advanced +[*] Changed double click behaviour on download list and favorite list to "Open ..." +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.47.0...0.9.48.0 + +0.9.47.0 (30-03-2016) +[*] Fixed crash with clean install without works folder (#222) +Full changes: https://github.com/riderkick/FMD/compare/0.9.46.0...0.9.47.0 + +0.9.46.0 (27-03-2016) +[*] Downloaded Chapters now using SQLite3 database +[*] Config, Downloads and Favorites using temporary file at runtime (#218) +Full changes: https://github.com/riderkick/FMD/compare/0.9.45.0...0.9.46.0 + +0.9.45.0 (25-03-2016) +[*] E-Hentai/ExHentai: fixed file naming problem (#217) +[*] E-Hentai/ExHentai: fixed get another image url when failed (#213) +Full changes: https://github.com/riderkick/FMD/compare/0.9.44.0...0.9.45.0 + +0.9.44.0 (24-03-2016) +[*] MangaFox: fixed downloaded chapters incorrectly recognized as new chapter +[*] WPManga: fixed mangainfo and get image url +[*] SenManga: fixed get image url +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.43.0...0.9.44.0 + +0.9.43.0 (23-03-2016) +[*] Fixed download sometimes failed when max connection limit = 1 +[*] 8Muses: faster get image url +[*] E-Hentai/ExHentai: use original filename if available +[*] Various changes and bug fixes +Full changes: https://github.com/riderkick/FMD/compare/0.9.42.0...0.9.43.0 + +0.9.42.0 (22-03-2016) +[+] Added option to hide downloaded chapter. chapter list > right click > hide downloaded chapter +[*] Fixed various form layout +[*] Hentai2Read: fixed chapter list order +[*] MangaFox: fixed only show last 10 chapter +[*] Various changes and bug fixes + +0.9.41.0 (18-03-2016) +[*] MangaFox: fixed remove watermark and rewrite all code +[*] Tsumino: fixed get image url +[*] Fixed mainform's components layout +[*] Various changes and bug fixes + +0.9.40.0 (12-03-2016) +[+] Added Tumangaonline[ES] +[*] Various changes and bug fixes + +0.9.39.0 (10-03-2016) +[*] Hentai2Read: rewrite all script +[*] Various changes and bug fixes + +0.9.38.0 (04-03-2016) +[+] Added MangaBackup[EN] +[*] GameofScanlation: fix get image url +[*] Various changes and bug fixes + +0.9.37.0 (28-02-2016) +[*] Madokami: fix login +[*] SubManga: rewrite all script +[+] Added show password checkbox in add account dialog +[*] Various changes and bug fixes + +0.9.36.0 (27-02-2016) +[+] Added Tsumino[H], require cookie in advanced.ini + +0.9.35.2 (25-02-2016) +[*] GameofScanlation: rewrite all script +[-] LoneManga: removed, website redirected to GameofScanlation +[*] Various changes and bug fixes + +0.9.35.1 (21-02-2016) +[*] Updater: fix download manga list from server + +0.9.35.0 (21-02-2016) +[*] Added Webtoons[EN] +[*] Various changes and bug fixes + +0.9.34.0 (15-02-2016) +[*] AcademyVN: rewrite all script +[*] Various changes and bug fixes + +0.9.33.0 (11-02-2016) +[-] MangaCap: removed, website offline +[+] E-Hentai/ExHentai: added option to download original image if available +[+] Added MangaChanRU[RU] +[+] Added MintMangaRU[RU] +[+] Added ReadMangaRU[RU] +[*] Various changes and bug fixes + +0.9.32.3 (05-02-2016) +[*] Various changes and bug fixes + +0.9.32.2 (03-02-2016) +[*] E-Hentai/ExHentai: fix incorrect page number +[*] Various changes and bug fixes + +0.9.32.1 (02-02-2016) +[*] Hakihome: rewrite all script +[*] Various changes and bug fixes + +0.9.32.0 (01-02-2016) +[*] Updater: various fix +[+] Added option to show/hide dialog download manga list from server when local database empty +[*] RedHawkScan: Removed, website offline +[*] Change manga list download url to new location +[*] Various changes and bug fixes + +0.9.31.3 (28-01-2016) +[*] Fix save as pdf issue with indexed images +[*] Updater, fix download manga list always failed (403 Forbidden) +[*] Various changes and bug fixes + +0.9.31.2 (24-01-2016) +[*] Fix remove mangafox watermark (file IO error when using multiple threads) +[*] Various changes and bug fixes + +0.9.31.1 (21-01-2016) +[*] Fix double URL encoding +[*] Various changes + +0.9.31.0 (19-01-2016) +[+] Download list: Assign CTRL+Home to move item to top and CTRL+End to move item to bottom +[+] Download list and Favorite list now accept url(s) via drag n drop +[*] Updater: fix various issue +[*] Various changes and bug fixes + +0.9.30.0 (17-01-2016) +[*] E-Hentai/ExHentai: fix incorrect page links/page number +[*] Batoto: various fix +[*] Fix filter "Search only new manga" +[*] Fix various issue on "Update manga list" +[+] Added MangaKoi[EN] +[+] Added YoManga[EN-SC] +[+] Added RawYoManga[RAW] +[+] Added GameofScanlation[EN-SC] +[*] Various changes and bug fixes + +0.9.29.1 (11-01-2016) +[!*] Fix empty user-agent if it's not defined in advanced.ini (causing connection issue) + +0.9.29.0 (10-01-2016) +[*] KissManga: rewrite all script +[*] RawSenManga: rewrite all script (load full chapter list via one of chapter link https://github.com/riderkick/FMD/issues/146) +[*] UnionMangas: rewrite all script +[-] Pururin: drop support +[+] MangaFox: added option to save as PNG on remove watermark +[*] PecintaKomik: rewrite all script +[*] Various changes and bug fixes + +0.9.28.0 (29-12-2015) +[+] Added Manga folder custom rename. Options > Save to +[*] Madokami: rewrite and add account support +[*] Fix load user-agent from advanced.ini +[*] Fix "Run out of memory" when updating long manga list +[*] Various changes and bug fixes + +0.9.27.0 (26-12-2015) +[+] Added Remove MangaFox watermark feature. Options > Misc +[*] Batoto: fix add language and scan group to chapter title +[*] Various changes and bug fixes + +0.9.26.0 (23-12-2015) +[*] Batoto: fix login +[*] ExHentai: fix login +[+] Added HitomiLa[H] +[+] Added HentaiCafe[H] +[+] Added Manga-Tr[TR] +[*] Madokami: fix image url +[*] Various changes and bug fixes + +0.9.25.0 (21-12-2015) +[+] Added 8Muses[H] (no list, use drop box) +[+] Added Account Manager, Options > Accounts +[+] Batoto, add account support +[-] Drop support for Manga2u +[+] Added MangaHen[EN] +[+] Added ExHentai[H] with account support +[+] Added MangaBug[EN] +[*] Various changes and bug fixes + +0.9.24.1 (25-11-2015) +[*] Fix fmd freeze + +0.9.24.0 (25-11-2015) +[*] E-Hentai: get new image url if failed +[*] MangaHere: rewrite all script +[+] Added option to remove manga name in chapter name +[*] MangaLife: fix manga info +[*] NHentai: fix image url +[*] MangaTown: fix image url +[*] Fakku: fix image url +[*] MangaEden: fix page number +[*] Various changes and bug fixes + +0.9.23.0 (26-08-2015) +[*] E-Hentai: fix image URL on multiple page +[-] Drop support for SenMangaRAW +[+] Added MangaLife(EN) +[+] Added Luscious(H) +[*] Various changes and bug fixes + +0.9.22.1 (21-08-2015) +[*] E-Hentai: fix image url +[*] MangaIndo: remove automatically added chapter number +[*] ReadHentaiManga: fix image url +[*] Fix cover image sometimes failed to load + +0.9.22.0 (19-08-2015) +[*] Fix various bug on filter +[*] WP-Manga: rewrite all script +[*] Added MangaIndo(ID) +[*] Various changes and bug fixes + +0.9.21.8 (16-08-2015) +[*] Fix high cpu usage while updating manga list + +0.9.21.7 (16-08-2015) +[*] Various changes and bug fixes + +0.9.21.6 (11-08-2015) +[*] Doujin-Moe: reset image url every task start, fix expired url +[*] Fix empty website when adding a favorite +[*] Fix filter custom genres incorrectly treats whitespaces as separator +[*] Various changes + +0.9.21.5 (10-08-2015) +[*] Fix remove multiple task +[*] Fix timer auto check favorites on interval not enabled if auto check new version not enabled +[*] Fix auto download new chapters in favorites always failed +[*] Various changes and bug fixes + +0.9.21.4 (10-08-2015) +[*] Various changes and bug fixes + +0.9.21.3 (09-08-2015) +[*] Fix favoritemanager doesn't showing the result when new chapter found +[*] Fix per item favorite check + +0.9.21.2 (08-08-2015) +[*] Fix access violation when trying to download new chapter from favorites +[*] Fix option "Automatic download after finish checking" (favorites) doesn't stored properly + +0.9.21.1 (08-08-2015) +[*] Minor bug fixes + +0.9.21.0 (08-08-2015) +[+] Add button to abort check new version +[*] Minor UI changes +[*] Batoto: limit task to 1 and concurrent connection to 4 +[+] Added Doujin-Moe (H) +[*] Various changes and bug fixes + +0.9.20.0 (02-08-2015) +[*] Mangacan: rewrite all script +[*] PecintaKomik: rewrite all script +[*] Various changes and bug fixes + +0.9.19.7 (30-07-2015) +[*] Minor bug fixes + +0.9.19.6 (30-07-2015) +[*] Fix no manga folder when adding favorites from drop box +[*] Fix drop box issue with chrome + +0.9.19.5 (30-07-2015) +[*] MangaFox: rewrite all script +[*] Fix drop box range check error + +0.9.19.4 (28-07-2015) +[+] Added changelog tab +[+] Support multiple url on drop box +[+] Added popup menu to change drop box mode +[+] Added popup menu to abort loading thread (download all/add to favorites) +[*] Various changes and bug fixes + +0.9.19.3 (27-07-2015) +[*] Various changes and bug fixes + +0.9.19.2 (26-07-2015) +[*] Batoto: rewrite all script +[*] Various changes and bug fixes + +0.9.19.1 (26-07-2015) +[*] Fix updater not closed after launching fmd. + For previous version just close FMD after update, it will also close the updater. + +0.9.19.0 (26-07-2015) +[+] Mangalist data now using sqlite3, existing data will be automatically converted. + BUGS EXPECTED! +[*] Opening mangalist will be executed in separated thread, access to mangalist will be blocked until the process finish +[*] Search mangalist will be executed in separated thread, eleminate lag when searching large mangalist +[+] Added Soujosense (EN) +[+] Added mh160 (CN) +[*] Fix freeze in the middle of shutdown counter +[*] Fix Readmanga.today +[*] Fix various issue with unicode path +[*] Various changes and bug fixes + 0.9.18.2 (05-07-2015) [*] Minor bug fixes diff --git a/config/base.ini b/config/base.ini new file mode 100644 index 000000000..844782fce --- /dev/null +++ b/config/base.ini @@ -0,0 +1,8 @@ +[base] +DEFAULT_SELECTED_WEBSITES=MangaFox,MangaHere,MangaInn,MangaReader +DB_URL=https://sourceforge.net/projects/newfmd/files/data/.7z/download +UPDATE_URL=https://raw.githubusercontent.com/riderkick/FMD/master/update +CHANGELOG_URL=https://raw.githubusercontent.com/riderkick/FMD/master/changelog.txt +UPDATE_PACKAGE_NAME=updatepackage.7z +MODULES_URL=https://api.github.com/repos/riderkick/FMD/contents/lua/modules +MODULES_URL2=https://github.com/riderkick/FMD/file-list/master/lua/modules diff --git a/config/mangalist.ini b/config/mangalist.ini deleted file mode 100644 index 00a964747..000000000 --- a/config/mangalist.ini +++ /dev/null @@ -1,21 +0,0 @@ -[general] -DefaultSelect=AnimeA,MangaFox,MangaHere,MangaInn,MangaReader - -[available] -Arabic=MangaAe,MangaAr,MangaAt -English=AnimeA,Authrone,Batoto,EatManga,EyeOnManga,KissManga,KivManga,LoneManga,Madokami,Manga2u,MangaCap,MangaFox,MangaGo,MangaHere,MangaInn,MangaPanda,MangaPark,MangaReader,MangaSee,MangaStreamTo,MangaTown,MangaTraders,NineManga,OneManga,ReadMangaToday,SenManga,UnixManga -English-Italian=MangaEden,NineManga_IT -English-Scanlation=Dynasty-Scans,EGScans,Mangacow,MangaStream,RedHawkScans,S2Scans -French=AnimeStory,Japan-Shin,Japscan,Lecture-En-Ligne,ScanManga -German=MeinManga,NineManga_DE -Indonesian=HugeManga,Komikid,Mabuns,Mangacan,MangaEsta,MangaKu,PecintaKomik -Malaysian-Indonesian=I-Komik -Polish=Manga-Lib_PL -Portugues=CentralDeMangas,ExtremeMangas,MangaHost,MangaREADER_POR,NineManga_BR,UnionMangas -Raw=MangaMint,SenMangaRAW -Russian=NineManga_RU -Spanish=AnimExtremist,ESMangaHere,NineManga_ES,SubManga -Thai=MangaBoom -Turkish=MangaFrame,MangaOku,MangaVadisi -Vietnamese=AcademyVN,BlogTruyen,Manga24h,TruyenTranhTuan,VnSharing -H-Sites=E-Hentai,Fakku,HakiHome,Hentai2Read,MyReadingMangaInfo,NHentai,PervEden,PornComix,PornComixRE,PornComixIC,PornXXXComics,Pururin,ReadHentaiManga,XXComics,XXComicsMT,XXComics3D diff --git a/extras/mangafoxtemplate/728-01.png b/extras/mangafoxtemplate/728-01.png new file mode 100644 index 000000000..a3aa6c90c Binary files /dev/null and b/extras/mangafoxtemplate/728-01.png differ diff --git a/extras/mangafoxtemplate/728-02.png b/extras/mangafoxtemplate/728-02.png new file mode 100644 index 000000000..20c3d84e6 Binary files /dev/null and b/extras/mangafoxtemplate/728-02.png differ diff --git a/extras/mangafoxtemplate/728-03.png b/extras/mangafoxtemplate/728-03.png new file mode 100644 index 000000000..bf1aea5d2 Binary files /dev/null and b/extras/mangafoxtemplate/728-03.png differ diff --git a/extras/mangafoxtemplate/728-04.png b/extras/mangafoxtemplate/728-04.png new file mode 100644 index 000000000..8a9e169b6 Binary files /dev/null and b/extras/mangafoxtemplate/728-04.png differ diff --git a/extras/mangafoxtemplate/728-05.png b/extras/mangafoxtemplate/728-05.png new file mode 100644 index 000000000..28f869be3 Binary files /dev/null and b/extras/mangafoxtemplate/728-05.png differ diff --git a/extras/mangafoxtemplate/728-06.png b/extras/mangafoxtemplate/728-06.png new file mode 100644 index 000000000..faedb6144 Binary files /dev/null and b/extras/mangafoxtemplate/728-06.png differ diff --git a/extras/mangafoxtemplate/728x48.png b/extras/mangafoxtemplate/728x48.png new file mode 100644 index 000000000..3fa925fe8 Binary files /dev/null and b/extras/mangafoxtemplate/728x48.png differ diff --git a/extras/mangafoxtemplate/728x67.png b/extras/mangafoxtemplate/728x67.png new file mode 100644 index 000000000..d81b5418e Binary files /dev/null and b/extras/mangafoxtemplate/728x67.png differ diff --git a/extras/mangafoxtemplate/728x86-2.png b/extras/mangafoxtemplate/728x86-2.png new file mode 100644 index 000000000..82c9163de Binary files /dev/null and b/extras/mangafoxtemplate/728x86-2.png differ diff --git a/extras/mangafoxtemplate/728x86.png b/extras/mangafoxtemplate/728x86.png new file mode 100644 index 000000000..d823a0895 Binary files /dev/null and b/extras/mangafoxtemplate/728x86.png differ diff --git a/license.txt b/license.txt new file mode 100644 index 000000000..d159169d1 --- /dev/null +++ b/license.txt @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/lua/modules/9hentai.lua b/lua/modules/9hentai.lua new file mode 100644 index 000000000..a6301e2ad --- /dev/null +++ b/lua/modules/9hentai.lua @@ -0,0 +1,74 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('css("div#info > h1")') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//div[@id="cover"]//v-lazy-image/@src')) + mangainfo.artists = x.XPathStringAll('//section[@id="tags"]/div[contains(text(), "Artist")]//a') + mangainfo.genres = x.XPathStringAll('//section[@id="tags"]/div[contains(text(), "Tag")]//a') + mangainfo.chapterlinks.add(mangainfo.url) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + local id = url:match('g/(%d+)') + http.mimetype = 'application/json' + if http.post(module.rooturl..'/api/getBookByID', string.format('{"id":%s}', id)) then + local x=TXQuery.Create(http.Document) + local srv=x.xpathstring('json(*).results.image_server') + local pages=tonumber(x.xpathstring('json(*).results.total_page')) + for i = 1, pages do + task.pagelinks.add(string.format('%s%s/%d.jpg', srv, id, i)) + end + return true + else + return false + end +end + +query = '{"search":{"text":"","page":%s,"sort":0,"pages":{"range":[0,10000]},"tag":{"text":"","type":1,"tags":[],"items":{"included":[],"excluded":[]}}}}' + +function GetNameAndLink() + http.mimetype = 'application/json' + if http.post(module.rooturl..'/api/getBook', string.format(query, url)) then + local x=TXQuery.Create(http.Document) + local v = x.xpath('json(*).results()') + for i = 1, v.count do + local v1 = v.get(i) + links.add(string.format('%s/g/%s', module.rooturl, x.xpathstring('id', v1))) + names.add(x.xpathstring('title', v1)) + end + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + http.mimetype = 'application/json' + if http.post(module.RootURL..'/api/getBook', string.format(query, '0')) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('json(*).total_count')) + if page == nil then page = 1 end + print(page) + return true + else + return false + end +end + +function Init() + m=NewModule() + m.category='H-Sites' + m.website='9hentai' + m.rooturl='https://9hentai.com' + m.sortedlist=true + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/AllHentai.lua b/lua/modules/AllHentai.lua new file mode 100644 index 000000000..1847ad931 --- /dev/null +++ b/lua/modules/AllHentai.lua @@ -0,0 +1,90 @@ +local dirurl = '/list?type=&sortType=DATE_CREATE' +local perpage = 60 + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + local rname = x.xpathstring('//meta[@itemprop="name"]/@content') + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//meta[@itemprop="alternativeHeadline"]/@content') + end + if mangainfo.title == '' then + mangainfo.title = rname + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@itemprop="image"]/@src')) + mangainfo.authors=x.xpathstringall('//p[@class="elementList" and contains(b, "Автор")]/a') + mangainfo.genres=x.xpathstringall('//p[@class="elementList" and (contains(b, "Жанры") or contains(b, "Категории"))]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//p[contains(b, "Перевод")]'), 'продолжается', 'завершен') + mangainfo.summary=x.xpathstring('//div[@class="mangaDescription"]/div[@itemprop="description"]') + -- TODO: remove manga name from chapter name + x.xpathhrefall('//div[@class="expandable"]/table[@class="cTable"]/tbody/tr/td/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function beforedownloadimage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "var pictures")]') + s = GetBetween('pictures =', ';', s) + x.parsehtml(s) + x.xpathstringall('json(*)().url', task.pagelinks) + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. dirurl) then + local x = TXQuery.Create(http.Document) + local s = x.xpathstring('//*[@class="pagination"]/a[@class="step"][last()]/@href') + page = tonumber(s:match('offset=(%d+)')) + if page == nil then page = 1 end + if page > 1 then page = math.ceil(page / perpage) + 1; end + return no_error + else + return net_problem + end +end + +function getnameandlink() + local s = module.rooturl .. dirurl + if url ~= '0' then s = s .. '&offset=' .. (tonumber(url) * perpage) .. '&max=' .. perpage; end + if http.get(s) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//table[@class="cTable"]//tr/td/a[not(@class)]') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('./text()', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'AllHentai' + m.rooturl = 'http://allhentai.ru' + m.category = 'Russian' + m.lastupdated='April 26, 2018' + m.sortedlist = true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + m.onbeforedownloadimage = 'beforedownloadimage' +end diff --git a/lua/modules/AnimExtremist.lua b/lua/modules/AnimExtremist.lua new file mode 100644 index 000000000..0fc2f99ac --- /dev/null +++ b/lua/modules/AnimExtremist.lua @@ -0,0 +1,56 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@id="LayerContenido"]/div[@id][1]') + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//div[@id="LayerContenido"]/div[@id][2]//tr[1]/td[2]//img/@src')) + mangainfo.genres=x.xpathstring('string-join(//div[@id="LayerContenido"]/div[@id][2]//tr[5]//a,", ")') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[@id="LayerContenido"]/div[@id][2]//tr[6]/td[1]'),'En proceso','Completo') + mangainfo.summary=x.xpathstring('//div[@id="LayerContenido"]/div[@id][2]//tr[1]/td[1]') + x.xpathstringall('//div[@id="tomo"]//a/@href',mangainfo.chapterlinks) + x.xpathstringall('//div[@id="tomo"]//a/string-join((../b,.)," ")',mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url):gsub('%.html?$','-1%1')) then + task.pagenumber=TXQuery.Create(http.Document).xpathcount('//select[@id="nav-jump"]/option') + return true + else + return false + end + return true +end + +function getimageurl() + if http.get(MaybeFillHost(module.rooturl,url):gsub('%.html?$','-'..(workid+1)..'%1')) then + task.pagelinks[workid]=TXQuery.create(http.document).xpathstring('//img[@id="photo"]/@src') + return true + end + return false +end + +function getnameandlink() + if http.get(module.rooturl..'/mangas.htm?ord=todos') then + TXQuery.Create(http.document).xpathhrefall('//*[@id="manga"]/div/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Spanish' + m.website='AnimExtremist' + m.rooturl='http://www.animextremist.com' + m.lastupdated='February 18, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetimageurl='getimageurl' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/BoredomSociety.lua b/lua/modules/BoredomSociety.lua new file mode 100644 index 000000000..97effc8f5 --- /dev/null +++ b/lua/modules/BoredomSociety.lua @@ -0,0 +1,60 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('css("div.titlesinfo_top > h2")') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('css("img.titlesinfo_coverimage")/@src')) + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[contains(span, "Status")]/span[@class="titleinfo_infovalue"]')) + mangainfo.summary=x.xpathstringall('//div[contains(span, "Description")]/*[@class="titlesinfo_description"]/text()', '') + x.xpathhrefall('//table[@class="titlesinfo_chaptertable"]//td[3]/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + http.post(module.rooturl .. '/module/reader/ajax.php', 'readingtype=all') + http.reset() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="reader_mangaimagebox"]/img/@src', task.pagelinks) + return true + end + return false +end + +function getnameandlink() + if http.get(module.rooturl .. '/titles/page/' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('css("div.titlelist_name > a")', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/titles') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//div[@class="titles_pages"]/a[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'BoredomSociety' + m.rooturl = 'https://www.boredomsociety.xyz' + m.category = 'English-Scanlation' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber='getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/CentralDeMangas.lua b/lua/modules/CentralDeMangas.lua new file mode 100644 index 000000000..c7005cb69 --- /dev/null +++ b/lua/modules/CentralDeMangas.lua @@ -0,0 +1,77 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//div[@id="main"]//h1') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//div[@id="main"]//div[@class="description"]/img/@src')) + mangainfo.summary = x.XPathStringAll('//div[@id="main"]//div[@class="description"]/div/text()', '') + mangainfo.artists = x.XPathStringAll('//div[@id="main"]//div[@class="content" and contains(div[@class="header"], "Arte")]/div[@class="description"]/a') + mangainfo.authors = x.XPathStringAll('//div[@id="main"]//div[@class="content" and contains(div[@class="header"], "Autor")]/div[@class="description"]/a') + mangainfo.genres = x.XPathStringAll('//div[@id="main"]//div[@class="content" and contains(div[@class="header"], "Gênero")]/div[@class="description"]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@id="main"]//div[@class="content" and contains(div[@class="header"], "Status")]/div[@class="description"]/a'), 'publicação', 'completo') + x.XPathHREFAll('//table/tbody/tr/td/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "urlSulfix")]') + local suffix = GetBetween("var urlSulfix = '", "';", s) + local pages = GetBetween("var pages =", ";", s) + x.parsehtml(pages) + local v = x.xpath('json(*)()'); + for i = 1, v.count do + local v1=v.get(i) + task.pagelinks.add(suffix .. v1.ToString .. '.jpg') + end + return true + else + return false + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function GetNameAndLink() + if http.get(module.rooturl..'/titulos/filtro/*/p/'..IncStr(url)) then + x=TXQuery.Create(http.Document) + x.XPathHREFAll('//div[contains(@class, "list")]/div[contains(@class, "item")]/div[@class="content"]//a', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/titulos') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('(//div[contains(@class, "grid")]/div/a[contains(@class, "button")])[last()]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Portugues' + m.website='CentralDeMangas' + m.rooturl='http://cdmnet.com.br' + m.lastupdated='February 15, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' +end \ No newline at end of file diff --git a/lua/modules/ComiCake.lua b/lua/modules/ComiCake.lua new file mode 100644 index 000000000..d211c4a40 --- /dev/null +++ b/lua/modules/ComiCake.lua @@ -0,0 +1,62 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1/text()') + mangainfo.coverlink=x.xpathstring('//main//img/@src') + mangainfo.artists=x.xpathstringall('//main//table//tr[td="Artist:"]/td/a') + mangainfo.authors=x.xpathstringall('//main//table//tr[td="Author:"]/td/a') + mangainfo.genres=x.xpathstringall('//main//table//tr[td="Tags:"]/td/a') + mangainfo.summary=x.xpathstring('//main//pre') + x.xpathhrefall('//main//ul/li/span/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url..'/manifest.json')) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('json(*).readingOrder().href',task.pagelinks) + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.get(module.rooturl..'/directory/') then + page=tonumber(TXQuery.Create(http.document).xpathstring('//div[@class="pagination"]//a[contains(., "last")]/@href'):match('/(%d+)/')) + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/directory/'..IncStr(url)) then + TXQuery.Create(http.document).xpathhrefall('//div[@class="mdc-card__media-title"]/a',links,names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url, category) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = category + m.ongetinfo = 'getinfo' + m.OnGetPageNumber = 'getpagenumber' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + m.OnGetNameAndLink = 'getnameandlink' + return m +end + +function Init() + local cat = 'English-Scanlation' + AddWebsiteModule('ChampionScans', 'https://reader.championscans.com', cat) +end diff --git a/lua/modules/ComicExtra.lua b/lua/modules/ComicExtra.lua new file mode 100644 index 000000000..4f1ca61e0 --- /dev/null +++ b/lua/modules/ComicExtra.lua @@ -0,0 +1,50 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1[1]/span') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="movie-l-img"]/img/@src')) + mangainfo.authors=x.xpathstring('//dt[contains(., "Author")]/following-sibling::dd') + mangainfo.genres=x.xpathstringall('//dt[contains(., "Genre")]/following-sibling::dd/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//dt[contains(., "Status")]/following-sibling::dd')) + mangainfo.summary=x.xpathstring('//div[@id="film-content"]') + x.xpathhrefall('//tbody[@id="list"]/tr/td/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url .. '/full')) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[@class="chapter_img"]/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/comic-list') then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="serie-box"]/ul/li/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'ComicExtra' + m.rooturl = 'http://www.comicextra.com' + m.category = 'English' + m.lastupdated='April 26, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/ComicVn.lua b/lua/modules/ComicVn.lua new file mode 100644 index 000000000..9c51cb4ae --- /dev/null +++ b/lua/modules/ComicVn.lua @@ -0,0 +1,61 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="manga-info"]//h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="manga-info"]/div[contains(@class, "manga-detail")]//img/@src')) + mangainfo.authors=x.xpathstring('//div[@class="manga-info"]/div[contains(@class, "manga-detail")]//ul/li[contains(span, "Tác giả")]/span[2]') + mangainfo.artists=x.xpathstring('//div[@class="manga-info"]/div[contains(@class, "manga-detail")]//ul/li[contains(span, "Họa sĩ")]/span[2]') + mangainfo.genres=x.xpathstringall('//div[@class="manga-info"]/div[contains(@class, "manga-detail")]//ul/li[contains(span, "Thể loại")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="manga-info"]/div[contains(@class, "manga-detail")]//ul/li[contains(span, "Trạng thái")]'), 'Đang thực hiện', 'Đã hoàn thành') + mangainfo.summary=x.xpathstring('//div[contains(@class, "manga-summary")]') + x.xpathhrefall('//div[contains(@class,"manga-chapter")]//ul/li/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[contains(@class, "manga-chapter-image")]/textarea/img/@src', task.pagelinks) + else + return false + end + return true +end + +local dirurl = '/noi-bat/' +local perpage = 30 + +function getnameandlink() + if tonumber(url) < 0 then return no_error end + if http.get(module.rooturl .. dirurl .. tostring(tonumber(url) * perpage)) then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//div[contains(@class, "manga-list")]//div[contains(@class,"tit")]/a', links, names) + local s = x.xpathstring('(//ul[@class="pagination"])[1]/li[last()-1]/a/@href') + s = tonumber(s:match('(%d+)/?$')) + if s ~= nil then + s = s / perpage + updatelist.CurrentDirectoryPageNumber = s + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'ComicVn' + m.rooturl = 'http://comicvn.net' + m.category = 'Vietnamese' + m.lastupdated='March 7, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/ComicoCoID.lua b/lua/modules/ComicoCoID.lua new file mode 100644 index 000000000..947cdd6d7 --- /dev/null +++ b/lua/modules/ComicoCoID.lua @@ -0,0 +1,78 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="con"]/h2') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//*[@class="bg_img_small"]/img/@src')) + mangainfo.authors=x.xpathstringall('//div[@class="con"]/dl/dd[@class="name"]/span[@class="aln"]') + mangainfo.genres=x.xpathstring('//div[@class="con"]/dl/dd[@class="name"]/p'):gsub('%s+', ''):gsub(',', ', ') + mangainfo.summary=x.xpathstring('//div[@class="con"]/dl/dd[@class="dsc"]') + if http.get(mangainfo.url .. '/chapters') then + x.parsehtml(http.document) + local v = x.xpath('json(*).data.list()') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(mangainfo.url .. '/chapters/' .. x.xpathstring('id', v1)) + local s = x.xpathstring('name', v1) + if x.xpathstring('./salePolicy/isFree', v1) == 'false' then + s = s .. ' [LOCKED]' + end + mangainfo.chapternames.add(s) + end + end + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + x=TXQuery.Create(http.Document) + v=x.xpathstringall('//div[contains(@class,"_view")]/img/@src', task.pagelinks) + else + return false + end + return true +end + +local dirurls = { + '/weekly/list?page=', + '/titles/completed?page=' +} + +function getnameandlink() + local lurl = dirurls[module.CurrentDirectoryIndex+1] + if http.get(module.rooturl .. lurl .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + local s = 'json(*).data().list()' + if module.CurrentDirectoryIndex == 1 then + s = 'json(*).data.list()' + end + local v = x.xpath(s) + local hasTitles = false + for i = 1, v.count do + local v1 = v.get(i) + links.add(module.rooturl..'/titles/'..x.xpathstring('id', v1)) + names.add(x.xpathstring('name', v1)) + hasTitles = true + end + if hasTitles then + updatelist.CurrentDirectoryPageNumber = updatelist.CurrentDirectoryPageNumber + 1 + end + end + return net_problem +end + +function Init() + local m = NewModule() + m.website = 'ComicoCoID' + m.rooturl = 'http://www.comico.co.id' + m.category = 'Indonesian' + m.lastupdated='April 13, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.totaldirectory = 2 +end diff --git a/lua/modules/DesuMe.lua b/lua/modules/DesuMe.lua new file mode 100644 index 000000000..deed43f61 --- /dev/null +++ b/lua/modules/DesuMe.lua @@ -0,0 +1,70 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1/span[@class="name"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@itemprop="image"]/@src')) + mangainfo.genres=x.xpathstringall('//ul[@class="tagList"]/li/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//span[contains(@class, "status_tag")]'), 'выходит', 'издано') + mangainfo.summary=x.xpathstring('//div[@itemprop="description"]') + x.xpathhrefall('//ul[@class="chlist"]/li/h4/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "Reader.init")]') + s = GetBetween('.init(', ');', s) + x.parsehtml(s) + local dir = x.xpathstring('json(*).dir') + local v = x.xpath('json(*).images()()') + for i = 1,v.count,3 do + local v1=v.get(i) + task.pagelinks.add(dir .. v1.tostring) + end + else + return false + end + return true +end + +local dirurl = '/manga/?order_by=name&page=' +function getnameandlink() + if http.get(module.rooturl .. dirurl .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//div[@class="animeList"]/ol/li/div/h3/a', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. dirurl .. '1') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//div[@class="PageNav"]/nav/a[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'DesuMe' + m.rooturl = 'https://desu.me' + m.category = 'Russian' + m.lastupdated='March 3, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/DigitalTeam.lua b/lua/modules/DigitalTeam.lua new file mode 100644 index 000000000..2b7846925 --- /dev/null +++ b/lua/modules/DigitalTeam.lua @@ -0,0 +1,82 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + if mangainfo.title == '' then + mangainfo.title=x.XPathString('css("div.title")') + end + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('css(".cover > img")/@src')) + local status = x.XPathString('//li[@class="info_block" and contains(span, "Status")]/span[@class="info_content"]') + mangainfo.status = MangaInfoStatusIfPos(status, "In corso", "Completo") + mangainfo.authors = x.XPathString('//li[@class="info_block" and contains(span, "Autore")]/span[@class="info_content"]') + mangainfo.artists = x.XPathString('//li[@class="info_block" and contains(span, "Artista")]/span[@class="info_content"]') + mangainfo.genres = x.XPathString('//li[@class="info_block" and contains(span, "Genere")]/span[@class="info_content"]') + mangainfo.summary = x.XPathString('//div[@class="plot"]') + x.xpathhrefall('css("div.chapter_list > ul > li > .ch_top > a")', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local isExt = (x.xpathstring('//script[contains(@src, "rext.js")]/@src') ~= '') + local title=x.xpathstring('//title') + local s=x.xpathstring('//script[contains(., "current_page")]') + s=ExecJS(s .. ';JSON.stringify({m:m,ch:ch,chs:chs});') + x.parsehtml(s) + local m=x.xpathstring('json(*).m') + local ch=x.xpathstring('json(*).ch') + local chs=x.xpathstring('json(*).chs') + local data=string.format('info[manga]=%s&info[chapter]=%s&info[ch_sub]=%s&info[title]=%s', m, ch, chs, title) + if isExt then data = data .. '&info[external]=1' end + http.reset() + if http.post(MaybeFillHost(module.rooturl, '/reader/c_i'), EncodeURL(data)) then + x.parsehtml(ExecJS(StreamToString(http.document))) + local path = x.xpathstring('json(*)()[3]') + local v=x.xpath('json(*)()[2]()') + local t={} + for i = 1, v.count do + local v1 = v.get(i) + table.insert(t, v1.toString) + end + v=x.xpath('json(*)()[1]()') + for i = 1, v.count do + local v1=v.get(i) + if isExt then + s = string.format('%s/%s%s', t[i], x.xpathstring('./name', v1), x.xpathstring('./ex', v1)) + else + s = string.format('/reader/%s/%s%s%s', path, x.xpathstring('./name', v1), t[i], x.xpathstring('./ex', v1)) + end + task.pagelinks.add(MaybeFillHost(module.rooturl, s)) + end + return true + end + end + return false +end + +function GetNameAndLink() + if http.get(module.rooturl..'/reader/series') then + local x=TXQuery.Create(http.Document) + x.xpathhrefall('css(".manga_title > a")', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Italian-Scanlation' + m.website='DigitalTeam' + m.rooturl='https://dgtread.com' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' +end diff --git a/lua/modules/DoujinsCom.lua b/lua/modules/DoujinsCom.lua new file mode 100644 index 000000000..3236b034e --- /dev/null +++ b/lua/modules/DoujinsCom.lua @@ -0,0 +1,76 @@ +local dirurl = '/list?type=&sortType=DATE_CREATE' +local perpage = 60 + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//div[@class="folder-title"]/a[last()]') + end + mangainfo.coverlink = x.xpathstring('(//img[@class="doujin"])[1]/@data-thumb') + mangainfo.authors=x.xpathstringall('//div[@class="gallery-artist"]/a') + mangainfo.artists=x.xpathstringall('//div[@class="gallery-artist"]/a') + mangainfo.genres=x.xpathstringall('//li[@class="tag-area"]/a') + mangainfo.chapterlinks.add(mangainfo.url) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[@class="doujin"]/@data-file', task.pagelinks) + else + return false + end + return true +end + +function today() + local now = os.date('*t'); + return os.time({year=now.year, month=now.month, day=now.day}) +end + +local endDate = os.time({year=2007, month=9, day=30}) +local step = 30 * 24 * 60 * 60 + +function getdirectorypagenumber() + page = math.ceil((today() - endDate) / step) + return no_error +end + +function getnameandlink() + local to = today() - tonumber(url) * step + local from = to - step + 1 + if from < endDate then return no_error; end + if http.xhr(module.rooturl .. string.format('/folders?start=%d&end=%d', from, to)) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('json(*).folders()') + for i = 1, v.count do + local v1 = v.get(i) + links.add(x.xpathstring('link', v1)) + names.add(x.xpathstring('name', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'DoujinsCom' + m.rooturl = 'https://doujins.com' + m.category = 'H-Sites' + m.lastupdated='May 14, 2018' + m.sortedlist = true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/DynastyScans.lua b/lua/modules/DynastyScans.lua new file mode 100644 index 000000000..496c177a3 --- /dev/null +++ b/lua/modules/DynastyScans.lua @@ -0,0 +1,59 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h2[@class="tag-title"]/b') + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//img[@class="thumbnail"]/@src')) + mangainfo.authors=x.xpathstring('string-join(//a[contains(@href,"/authors/")],", ")') + mangainfo.genres=x.xpathstringall('//*[@class="label" or @class="doujin_tags"]') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//h2[@class="tag-title"]/small')) + mangainfo.summary=x.xpathstring('//*[@class="description"]') + x.xpathhrefall('//dl[@class="chapter-list"]/dd/a[1]',mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + TXQuery.Create(http.Document).xpathstringall('json(//script[contains(.,"var pages")]/substring-after(substring-before(.,";")," = "))()/concat("'..module.rooturl..'",./image)',task.pagelinks) + return true + else + return false + end + return true +end + +local diruris={ + '/anthologies', + '/doujins', + '/issues', + '/series' + } + +function getdirectorypagenumber() + page=#diruris + return no_error +end + +function getnameandlink() + if http.get(module.rooturl..diruris[tonumber(url)+1]) then + TXQuery.Create(http.document).xpathhrefall('//dd/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='English-Scanlation' + m.website='DynastyScans' + m.rooturl='https://dynasty-scans.com' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/EGScans.lua b/lua/modules/EGScans.lua new file mode 100644 index 000000000..5a5be3532 --- /dev/null +++ b/lua/modules/EGScans.lua @@ -0,0 +1,73 @@ +function getinfo() + local lurl = MaybeFillHost(module.rooturl, url) + local result = net_problem + if http.get(lurl) then + local x = TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//select[@name="manga"]/option[@selected]') + end + local v = x.xpath('//select[@name="chapter"]/option') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapternames.add(v1.ToString) + mangainfo.chapterlinks.add(url .. '/' .. v1.getattribute('value')) + end + result = no_error + end + return result +end + +function taskstart() + task.pagelinks.clear() + task.pagenumber = 0 + return true +end + +function getpagenumber() + local result = false + local s = url .. '&display=webtoon' + s = MaybeFillHost(module.rooturl, s) + if http.get(s) then + local x = TXQuery.create(http.document) + local v = x.xpath('//td/a/img[@class="picture"]/@src') + for i = 1, v.count do + local v1 = v.get(i) + task.pagelinks.add(MaybeFillHost(module.rooturl, v1.toString)) + end + result = true + end + return result +end + +function getdirectorypagenumber() + page = 1 + return no_error +end + +function getnameandlink() + local result = net_problem + if http.get(module.rooturl) then + local x = TXQuery.create(http.document) + local v = x.xpath('//select[@name="manga"]/option[@value!="0"]') + for i = 1, v.count do + local v1 = v.get(i) + links.add(module.rooturl .. '/' .. v1.getattribute('value')) + names.add(v1.ToString) + end + result = no_error + end + return result +end + +function Init() + local m = NewModule() + m.category = 'English-Scanlation' + m.website = 'EGScans' + m.rooturl = 'http://read.egscans.com' + m.lastupdated = 'february, 10 2018' + m.ongetinfo = 'getinfo' + m.OnTaskStart = 'taskstart' + m.OnGetPageNumber = 'getpagenumber' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + m.OnGetNameAndLink = 'getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/FoOlSlide.lua b/lua/modules/FoOlSlide.lua new file mode 100644 index 000000000..830510ce7 --- /dev/null +++ b/lua/modules/FoOlSlide.lua @@ -0,0 +1,287 @@ +local dirurl = '/directory/' +local dirurlreader = '/reader/directory/' +local dirurlfoolslide = '/foolslide/directory/' +local dirurlslide = '/slide/directory/' +local dirurlslideU = '/Slide/directory/' +local dirurlonline = '/online/directory/' +local dirurlhelvetica = '/r/directory/' +local dirurllector = '/lector/directory/' +local dirurlfsdir = '/fs/directory/' +local dirurlreaderlist = '/fs/reader/list/' + +function getWithCookie(lurl) + if http.get(lurl) then + local x = TXQuery.Create(http.document) + local s = x.xpathstring('//form//input[(@type="hidden") and (@name="adult")]/@value') + if s:lower() == 'true' then + http.reset() + return http.post(lurl, 'adult=true') + end + return true + else + return false + end +end + +function getdirurl(website) + local dirs = { + ['Jaiminisbox'] = dirurlreader, + ['DokiFansubs'] = dirurlreader, + ['AtelierDuNoir'] = dirurlreader, + ['OneTimeScans'] = dirurlfoolslide, + ['DejameProbar'] = dirurlslide, + ['MenudoFansub'] = dirurlslide, + ['SolitarioNoFansub'] = dirurlslide, + ['Pzykosis666HFansub'] = dirurlonline, + ['SeinagiFansub'] = dirurlonline, + ['HelveticaScans'] = dirurlhelvetica, + ['RavensScans'] = dirurllector, + ['NoraNoFansub'] = dirurllector, + ['HotChocolateScans'] = dirurlfsdir, + ['AntisenseScans'] = dirurlonline, + ['MangaichiScan'] = dirurlfsdir, + ['Riceballicious'] = dirurlreaderlist, + ['Yuri-ism'] = dirurlslide, + ['MangajinNoFansub'] = dirurllector, + ['BunnysScans'] = '/read/directory/', + ['CanisMajorScans'] = dirurlreader, + ['HoshikuzuuScans'] = dirurl, + ['YaoiIsLife'] = dirurlreader, + ['FujoshiBitches'] = dirurlreader, + ['TapTrans'] = dirurlfsdir, + ['LoliVault'] = dirurlonline + } + if dirs[website] ~= nil then + return dirs[website] + else + return dirurl + end +end + +function getinfo() + local lurl = MaybeFillHost(module.rooturl, url) + local result = net_problem + if getWithCookie(lurl) then + x = TXQuery.Create(http.document) + mangainfo.coverlink = x.xpathstring('//div[@class="thumbnail" or contains(@class, "thumb")]/img/@src') + if mangainfo.title == '' then + if module.website == 'AtelierDuNoir' then + mangainfo.title = x.xpathstring('//div[@class="section-headline"]//h3') + else + mangainfo.title = x.xpathstring('//h1[@class="title"]') + end + end + if Pos('emailprotected', mangainfo.title) > 0 then + mangainfo.title = Trim(SeparateLeft(x.xpathstring('//title'), '::')) + end + local cls = 'info' + mangainfo.authors = string.gsub( + x.xpathstring('//div[@class="'..cls..'"]/*[contains(text(),"Author")]/following-sibling::text()[1]'), + '^[%s:]*', '') + mangainfo.artists = string.gsub( + x.xpathstring('//div[@class="'..cls..'"]/*[contains(text(),"Artist")]/following-sibling::text()[1]'), + '^[%s:]*', '') + mangainfo.summary = string.gsub( + x.xpathstring('//div[@class="'..cls..'"]/*[contains(text(),"Synopsis")]/following-sibling::text()[1]'), + '^[%s:]*', '') + v = x.xpath('//div[@class="list"]//div[@class="title"]/a') + for i = 1, v.count do + v1 = v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + if v1.getattribute('title') ~= '' then + mangainfo.chapternames.add(v1.getattribute('title')) + else + mangainfo.chapternames.add(v1.ToString) + end + end + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + result = no_error + end + return result +end + +function getinfo_ths() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if getWithCookie(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@id="series_right"]/h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@class="series_img"]/@src')) + mangainfo.authors = x.xpathstring('//ul[@class="series_left_data"]/li[contains(span, "Author")]/span[@class="value"]') + mangainfo.artists = x.xpathstring('//ul[@class="series_left_data"]/li[contains(span, "Artist")]/span[@class="value"]') + mangainfo.genres=x.xpathstringall('//ul[@class="series_left_data"]/li[contains(span, "Genre")]/span[@class="value"]/text()') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//ul[@class="series_left_data"]/li[contains(span, "Status")]/span[@class="value"]')) + mangainfo.summary = x.xpathstring('//div[@id="series_des"]') + x.xpathhreftitleall('//div[@id="staff"]/div/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function taskstart() + task.pagelinks.clear() + task.pagenumber = 0 + return true +end + +function getpagenumber() + local result = false + if getWithCookie(MaybeFillHost(module.rooturl, url)) then + x = TXQuery.create(http.document) + task.pagenumber = x.xpath('//div[@class="topbar_right"]//ul[@class="dropdown"]/li').count + s = x.xpathstring('//script[contains(.,"var pages")]') + if s ~= '' then + s = GetBetween('var pages = ', ';', s) + if Pos('atob("', s) > 0 then + s = GetBetween('atob("', '")', s) + s = DecodeBase64(s) + end + x.parsehtml(s) + v = x.xpath('json(*)()("url")') + for i = 1, v.count do + task.pagelinks.add(v.get(i).ToString) + end + end + result = true + end + return result +end + +function getimageurl() + local result = false + local s = url + if workid > 0 then + s = AppendURLDelim(s) .. 'page/' .. (workid + 1) + end + if getWithCookie(MaybeFillHost(module.rooturl, s)) then + x = TXQuery.create(http.document) + task.pagelinks.set(workid, x.XPathString('//div[@id="page"]//img/@src')) + end + return result +end + +function getdirectorypagenumber() + local result = net_problem + page = 1 + if getWithCookie(module.rooturl .. getdirurl(module.website)) then + result = no_error + x = TXQuery.create(http.document) + v = x.xpath('//*[@class="next"]/a/@href') + for i = 1, v.count do + local s = tonumber(string.match(v.get(i).tostring, '/(%d+)/$')) + if (s ~= nil) and (s > page) then + page = s + end + end + end + return result +end + +function getnameandlink() + local result = net_problem + local s = module.rooturl .. getdirurl(module.website) + if url ~= '0' then + s = s .. (tonumber(url) + 1) .. '/' + end + if getWithCookie(s) then + result = no_error + local x = TXQuery.create(http.document) + if module.website == 'AtelierDuNoir' then + local v = x.xpath('//div[@class="caption"]') + for i = 1, v.count do + v1 = v.get(i) + links.add(x.xpathstring('div/a/@href', v1)) + names.add(x.xpathstring('h4', v1)) + end + elseif module.website == 'TwistedHelScans' then + local v = x.xpath('//div[contains(@class, "series_card")]/a') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('span', v1)) + end + else + x.XpathHREFAll('//div[@class="list series"]/div/div[@class="title"]/a', links, names) + end + end + return result +end + +function AddWebsiteModule(name, url, category) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = category + m.lastupdated = 'february, 6 2018' + m.ongetinfo = 'getinfo' + m.OnTaskStart = 'taskstart' + m.OnGetPageNumber = 'getpagenumber' + m.OnGetImageURL = 'getimageurl' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + m.OnGetNameAndLink = 'getnameandlink' + if name == 'TwistedHelScans' then m.ongetinfo = 'getinfo_ths'; end + return m +end + +function Init() + local cat = 'English-Scanlation' + AddWebsiteModule('PowerManga', 'http://read.powermanga.org', cat) + AddWebsiteModule('Shoujosense', 'http://reader.shoujosense.com', cat) + AddWebsiteModule('OneTimeScans', 'http://otscans.com', cat) + AddWebsiteModule('SenseScans', 'http://reader.sensescans.com', cat) + AddWebsiteModule('Jaiminisbox', 'https://jaiminisbox.com', cat) + AddWebsiteModule('KireiCake', 'https://reader.kireicake.com', cat) + AddWebsiteModule('HelveticaScans', 'http://helveticascans.com', cat) + AddWebsiteModule('DokiFansubs', 'https://kobato.hologfx.com', cat) + AddWebsiteModule('AtelierDuNoir', 'http://atelierdunoir.org', cat) + AddWebsiteModule('WorldThree', 'http://www.slide.world-three.org', cat) + AddWebsiteModule('S2Scans', 'https://reader.s2smanga.com', cat) + AddWebsiteModule('HotChocolateScans', 'http://hotchocolatescans.com', cat) + AddWebsiteModule('LetItGoScans', 'http://reader.letitgo.scans.today', cat) + AddWebsiteModule('SeaOtterScans', 'https://reader.seaotterscans.com', cat) + AddWebsiteModule('AntisenseScans', 'http://antisensescans.com', cat) + AddWebsiteModule('TheCatScans', 'https://reader.thecatscans.com', cat) + AddWebsiteModule('DeathTollScans', 'https://reader.deathtollscans.net', cat) + AddWebsiteModule('MangaichiScan', 'http://mangaichiscans.mokkori.fr', cat) + AddWebsiteModule('ForgottenScans', 'http://reader.fos-scans.com', cat) + AddWebsiteModule('Riceballicious', 'http://riceballicious.info', cat) + AddWebsiteModule('PhoenixSerenade', 'https://reader.serenade.moe', cat) + AddWebsiteModule('VortexScans', 'https://reader.vortex-scans.com', cat) + AddWebsiteModule('RoseliaScanlations', 'http://reader.roseliascans.com', cat) + AddWebsiteModule('Yuri-ism', 'https://www.yuri-ism.net', cat) + AddWebsiteModule('SilentSkyScans', 'http://reader.silentsky-scans.net', cat) + AddWebsiteModule('BunnysScans', 'http://bns.shounen-ai.net', cat) + AddWebsiteModule('CanisMajorScans', 'http://cm-scans.shounen-ai.net', cat) + AddWebsiteModule('HoshikuzuuScans', 'http://hoshiscans.shounen-ai.net', cat) + AddWebsiteModule('YaoiIsLife', 'http://yaoislife.shounen-ai.net', cat) + AddWebsiteModule('FujoshiBitches', 'http://fujoshibitches.shounen-ai.net', cat) + AddWebsiteModule('TwistedHelScans', 'http://www.twistedhelscans.com', cat) + AddWebsiteModule('TapTrans', 'https://taptaptaptaptap.net', cat) + AddWebsiteModule('EvilFlowers', 'http://reader.evilflowers.com', cat) + AddWebsiteModule('IlluminatiManga', 'http://reader.manga-download.org', cat) + + -- es-sc + cat = 'Spanish-Scanlation' + AddWebsiteModule('DejameProbar', 'http://dejameprobar.es', cat) + AddWebsiteModule('HoshinoFansub', 'http://manga.animefrontline.com', cat) + AddWebsiteModule('MenudoFansub', 'http://www.menudo-fansub.com', cat) + AddWebsiteModule('Pzykosis666HFansub', 'https://pzykosis666hfansub.com', cat) + AddWebsiteModule('SeinagiFansub', 'https://seinagi.org', cat) + AddWebsiteModule('SeinagiAdultoFansub', 'https://adulto.seinagi.org', cat) + AddWebsiteModule('SolitarioNoFansub', 'http://snf.mangaea.net', cat) + AddWebsiteModule('RavensScans', 'http://ravens-scans.com', cat) + AddWebsiteModule('KirishimaFansub', 'http://lector.kirishimafansub.com', cat) + AddWebsiteModule('NoraNoFansub', 'https://www.noranofansub.com', cat) + AddWebsiteModule('NeoProjectScan', 'http://npscan.mangaea.net', cat) + AddWebsiteModule('YamiTenshiNoFansub', 'http://lector.ytnofan.com', cat) + AddWebsiteModule('XAnimeSeduccion', 'http://xanime-seduccion.com', cat) + AddWebsiteModule('JokerFansub', 'http://reader.jokerfansub.com', cat) + AddWebsiteModule('PatyScans', 'http://lector.patyscans.com', cat) + AddWebsiteModule('PCNet', 'http://pcnet.patyscans.com', cat) + AddWebsiteModule('Nightow', 'http://nightow.net', cat) + AddWebsiteModule('TrueColorsScan', 'https://truecolorsscans.miocio.org', cat) + AddWebsiteModule('MangajinNoFansub', 'https://www.mangajinnofansub.com', cat) + AddWebsiteModule('LoliVault', 'https://lolivault.net', cat) + AddWebsiteModule('Mangasubes', 'http://mangasubes.patyscans.com', cat) +end diff --git a/lua/modules/FunManga.lua b/lua/modules/FunManga.lua new file mode 100644 index 000000000..f1f6fcf35 --- /dev/null +++ b/lua/modules/FunManga.lua @@ -0,0 +1,73 @@ +local ALPHA_LIST = '#abcdefghijklmnopqrstuvwxyz' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="content"]//h5') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="content"]//img/@src')) + mangainfo.authors=x.xpathstringall('//dl[@class="dl-horizontal"]/dt[starts-with(.,"Author")]/following-sibling::dd[1]/a') + mangainfo.artists=x.xpathstringall('//dl[@class="dl-horizontal"]/dt[starts-with(.,"Artist")]/following-sibling::dd[1]/a') + mangainfo.genres=x.xpathstringall('//dl[@class="dl-horizontal"]/dt[starts-with(.,"Categories")]/following-sibling::dd[1]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//dl[@class="dl-horizontal"]/dt[starts-with(.,"Status")]/following-sibling::dd[1]')) + mangainfo.summary=x.xpathstring('//div[@class="content"]/div/div[contains(@class,"note")]') + local v=x.xpath('//ul[@class="chapter-list"]/li/a') + for i=1,v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('span[1]', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + local s = MaybeFillHost(module.rooturl, url) + if Pos('/all-pages', s) == 0 then s = s .. '/all-pages' end + if http.get(s) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[contains(@class,"content-inner")]//img/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + local s = '' + if module.CurrentDirectoryIndex ~= 0 then + s = '/'..ALPHA_LIST:sub(module.CurrentDirectoryIndex+1,module.CurrentDirectoryIndex+1) + end + local dirurl = '/manga-list' + if module.website == 'MangaDoom' then dirurl = '/manga-directory' end + if http.get(module.rooturl .. dirurl .. s) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="content"]/div/div[@class="row"]//li/a', links, names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'English' + m.lastupdated = 'March 1, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.totaldirectory = ALPHA_LIST:len() + return m +end + +function Init() + AddWebsiteModule('FunManga', 'http://www.funmanga.com') + AddWebsiteModule('MangaDoom', 'http://www.mngdoom.com') +end diff --git a/lua/modules/GMangaMe.lua b/lua/modules/GMangaMe.lua new file mode 100644 index 000000000..ea34eedf8 --- /dev/null +++ b/lua/modules/GMangaMe.lua @@ -0,0 +1,106 @@ +local domain = 'gmanga.me' +local mediaUrl = 'http://media.' .. domain .. '/uploads' + +function getinfo() + function urlencode(str) + if (str) then + str = string.gsub(str, "\n", "\r\n") + str = string.gsub(str, "([^%w ])", + function (c) return string.format ("%%%02X", string.byte(c)) end) + str = string.gsub(str, " ", "_") + str = string.gsub(str, '%.', '') + end + return str + end + + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + local s = x.xpathstring('//script[@type="application/json" and @class]') + x.parsehtml(s) + local pageurl = x.xpathstring('json(*).globals.page_url') + local id = x.xpathstring('json(*).mangaDataAction.mangaData.id') + local cover = x.xpathstring('json(*).mangaDataAction.mangaData.cover') + mangainfo.coverlink = mediaUrl .. '/manga/cover/' .. id .. '/' .. cover + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('json(*).mangaDataAction.mangaData.title') + end + mangainfo.authors=x.xpathstringall('json(*).mangaDataAction.mangaData.authors().name') + mangainfo.artists=x.xpathstringall('json(*).mangaDataAction.mangaData.artists().name') + mangainfo.genres=x.xpathstringall('json(*).mangaDataAction.mangaData.categories().name') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('json(*).mangaDataAction.mangaData.status'),'publish','finish') + mangainfo.summary=x.xpathstring('json(*).mangaDataAction.mangaData.summary') + if http.xhr(MaybeFillHost(module.RootURL, '/api/mangas/' .. id)) then + x = TXQuery.Create(http.document) + local v = x.xpath('json(*).mangaReleases()') + local t = {} + local data = {} + for i = 1, v.count do + local v1 = v.get(i) + local ch = tonumber(x.xpathstring('chapter', v1)) + local team = x.xpathstring('team_name', v1) + local key = string.format('%08.2f %s', ch, team) + table.insert(t, key) + data[key] = { + name = string.format('%s - %s [%s]', tostring(ch), x.xpathstring('title', v1), team), + link = MaybeFillHost(module.rooturl, pageurl .. '/' .. tostring(ch) .. '/' .. urlencode(team)) + } + end + table.sort(t) + for _, k in ipairs(t) do + mangainfo.chapterlinks.add(data[k].link) + mangainfo.chapternames.add(data[k].name) + end + return no_error + else + return net_problem + end + else + return net_problem + end +end + +function getpagenumber() + local js = require 'modules.jsunpack' + if http.get(MaybeFillHost(module.rooturl,url)) then + local x = TXQuery.Create(http.Document); + local s = x.xpathstring('//script[@type="application/json" and @class]') + x.parsehtml(s) + local pages = js.splitstr(x.xpathstring('json(*).readerDataAction.readerData.release.hq_pages'), '\r\n') + for _, k in ipairs(pages) do + task.pagelinks.add(mediaUrl .. '/releases/' .. k) + end + return true + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl..'/mangas') then + local x = TXQuery.Create(http.Document); + local s = HTMLDecode(x.xpathstring('//*[@data-store-name="mangasIndexStore"]/@data-props')) + x.parsehtml(s) + local v = x.xpath('json(*).mangas()') + for i = 1, v.count do + local v1 = v.get(i) + names.add(x.xpathstring('title', v1)) + links.add(MaybeFillHost(module.rooturl, '/mangas/' .. x.xpathstring('id', v1) .. '/' .. x.xpathstring('slug', v1))) + end + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Arabic' + m.website='GManga' + m.rooturl='http://' .. domain + m.lastupdated='December 6, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/HamTruyen.lua b/lua/modules/HamTruyen.lua new file mode 100644 index 000000000..a0e92e9c6 --- /dev/null +++ b/lua/modules/HamTruyen.lua @@ -0,0 +1,59 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//h1[@class="tentruyen"]') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//div[contains(@class, "wrapper_image")]/img/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[contains(@class, "wrapper_info")]/p[contains(., "Trạng thái")]'), 'Đang tiến hành', 'Hoàn thành') + mangainfo.authors=x.xpathstring('//div[contains(@class, "wrapper_info")]/p[contains(., "Tác giả")]/substring-after(.,":")') + mangainfo.genres=x.xpathstringall('//div[contains(@class, "wrapper_info")]/p[contains(., "Thể loại")]/a') + mangainfo.summary=x.xpathstring('//p[@id="tomtattruyen"]') + x.xpathhrefall('//div[@id="wrapper_listchap"]//section/div/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@id="content_chap"]/img/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + local s = module.RootURL .. string.format('/danhsach/P%s/index.html?sort=1', IncStr(url)) + if http.get(s) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//a[h5[@class="tentruyen_slide"]]', links, names) + local maxp = -1 + local v = x.xpath('//ul[@class="pagination"]/li/a/@href') + for i = 1, v.count do + local p = tonumber(string.match(v.get(i).toString, '/P(%d+)/')) + if (p ~= nil) and (p > maxp) then maxp = p; end + end + if maxp > 0 then updatelist.CurrentDirectoryPageNumber = maxp; end + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='Vietnamese' + m.website='HamTruyen' + m.rooturl='https://hamtruyen.com' + m.lastupdated='June 15, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/HeavenManga.lua b/lua/modules/HeavenManga.lua new file mode 100644 index 000000000..15b5dce51 --- /dev/null +++ b/lua/modules/HeavenManga.lua @@ -0,0 +1,83 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="comic-info"]/div/h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="comic-info"]/div/img/@src')) + mangainfo.authors=x.xpathstringall('//div[@class="comic-info"]//div[@class="author"]/a') + mangainfo.genres=x.xpathstringall('//div[@class="comic-info"]//div[@class="genre"]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="comic-info"]//div[@class="update"]/span[last()]')) + mangainfo.summary=x.xpathstring('//div[@class="comic-description"]/p') + local pages = tonumber(x.xpathstring('(//div[@class="pagination"]/a[contains(@class, "page-numbers")])[last()]/substring-after(@href, "/page-")')) + if pages == nil then pages = 1 end + local p = 1 + while true do + local v=x.xpath('//div[contains(@class, "chapters-wrapper")]//h2[@class="chap"]/a') + for i=1,v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('text()', v1)) + end + p = p + 1 + if p > pages then break end + if http.get(mangainfo.url .. '/page-' .. tostring(p)) then + x=TXQuery.Create(http.document) + else + break + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="chapter-content"]//img/@src', task.pagelinks) + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/manga-list/') then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('(//div[@class="pagination"]/a[contains(@class, "page-numbers")])[last()]/substring-after(@href, "/page-")')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl .. '/manga-list/page-' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="comics-grid"]/div/div/h3/a', links, names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'English' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + return m +end + +function Init() + AddWebsiteModule('HeavenManga', 'https://heavenmanga.ca') + AddWebsiteModule('HolyManga', 'http://holymanga.ca') +end diff --git a/lua/modules/HentaiFox.lua b/lua/modules/HentaiFox.lua new file mode 100644 index 000000000..9f0c0b4b1 --- /dev/null +++ b/lua/modules/HentaiFox.lua @@ -0,0 +1,82 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//div[@class="info"]/h1') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="cover"]//img/@src')) + if module.website == 'HentaiFox' then + mangainfo.artists=x.xpathstringall('//*[@class="info"]/span[starts-with(.,"Artist")]/substring-after(.,": ")') + mangainfo.genres=x.xpathstringall('//*[@class="info"]/string-join(./span/a,", ")') + else + mangainfo.artists=x.xpathstringall('//div[@class="tags" and contains(h3, "Artist")]/div/a/span/text()') + mangainfo.genres=x.xpathstringall('//div[@class="tags" and (contains(h3, "Tags") or contains(h3, "Category"))]/div/a/span/text()') + end + mangainfo.chapterlinks.add(mangainfo.url) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local v = x.xpath('//*[@class="gallery"]//img/@data-src') + for i = 1, v.count do + local s = v.get(i).toString; + s = s:gsub('^//', 'https://'):gsub('(/%d+)[tT]%.', '%1.') + task.pagelinks.add(s) + end + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('//*[@class="pagination"]/a[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl .. '/pag/' .. IncStr(url) .. '/') then + local x = TXQuery.Create(http.Document) + if module.website == 'HentaiFox' then + x.xpathhrefall('//*[@class="galleries_overview"]//*[contains(@class,"item")]/a', links, names) + else + x.xpathhrefall('//*[@class="preview_item"]/*[@class="caption"]/a', links, names) + end + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'H-Sites' + m.lastupdated='May 31, 2018' + m.sortedlist = true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + return m +end + +function Init() + AddWebsiteModule('HentaiFox', 'https://hentaifox.com') + AddWebsiteModule('AsmHentai', 'https://asmhentai.com') +end diff --git a/lua/modules/HentaiHere.lua b/lua/modules/HentaiHere.lua new file mode 100644 index 000000000..46ed1528c --- /dev/null +++ b/lua/modules/HentaiHere.lua @@ -0,0 +1,72 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//h4/a/text()') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//div[@id="cover"]//img/@src')) + mangainfo.artists = x.XPathString('//div[@id="info"]/div[contains(span, "Artist")]/a') + mangainfo.genres = x.XPathStringAll('//div[@id="info"]/div[contains(span, "Category")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@id="info"]/div[contains(span, "Status")]/a')) + mangainfo.summary=x.XPathStringall('//div[@id="info"]/div[contains(span, "Summary")]/text()', '') + v=x.xpath('//ul[@class="arf-list"]/li/a') + for i=1,v.count do + v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('./span/text()', v1)) + end + return no_error + else + return net_problem + end +end + +function GetPageNumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + s=x.xpathstring('//script[contains(.,"rff_imageList")]') + s=GetBetween('rff_imageList =', ';', s) + x.parsehtml(s) + v=x.xpath('json(*)()') + for i=1,v.count do + v1=v.get(i) + task.pagelinks.add('https://hentaicdn.com/hentai' .. v1.toString) + end + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/directory/newest?page='..IncStr(url)) then + x=TXQuery.Create(http.Document) + v=x.XPathHREFAll('//div[contains(@class, "seriesBlock")]/div/div[2]/a', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL..'/directory/newest') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('(//ul[contains(@class,"pagination")]/li/a)[last()-1]')) + if page == nil then page = 1 end + return true + else + return false + end +end + +function Init() + m=NewModule() + m.category='H-Sites' + m.website='HentaiHere' + m.rooturl='https://hentaihere.com' + m.sortedlist=true + m.lastupdated='February 15, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/HitomiLa.lua b/lua/modules/HitomiLa.lua new file mode 100644 index 000000000..8fffff66a --- /dev/null +++ b/lua/modules/HitomiLa.lua @@ -0,0 +1,80 @@ +local domain = 'hitomi.la' + +function set_https(s) + if s:match('^//') then + return 'https:' .. s + else + return s + end +end + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//div[starts-with(@class,"gallery")]/h1') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="cover"]//img/@src')) + mangainfo.coverlink = set_https(mangainfo.coverlink) + mangainfo.authors=x.xpathstringall('//div[starts-with(@class,"gallery")]/h2/ul/li/a') + mangainfo.genres=x.xpathstringall('//div[@class="gallery-info"]/table//tr/td//a') + mangainfo.chapterlinks.add(x.xpathstring('//div[contains(@class,"cover-column")]/a/@href')) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local subdomain = nil + local galleryid = tonumber(ReplaceRegExpr('(?i)^.*reader/(\\d+).*$', url, '$1')) + if galleryid ~= nil then + subdomain = string.char(97 + (galleryid % 2)) .. 'a.' ..domain + end + local x=TXQuery.Create(http.Document) + local v=x.xpath('//div[@class="img-url"]') + for i=1,v.count do + local s=v.get(i).toString + if subdomain ~= nil then + s=s:gsub('//[^/]+/', '//'..subdomain..'/') + end + s = set_https(s) + task.pagelinks.add(s) + end + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl) then + local x = TXQuery.Create(http.Document) + if http.get('https://ltn.'..domain..'/index-all.nozomi') then + local s = StreamToString(http.document) + for i=1,s:len(),4 do + local b1,b2,b3,b4=s:byte(i),s:byte(i+1),s:byte(i+2),s:byte(i+3) + local n = b4 + (b3 << 8) + (b2 << 16) + (b1 << 24) + links.add('https://'..domain..'/galleries/'..n..'.html') + names.add('') + end + return no_error + end + end + return net_problem +end + +function Init() + local m = NewModule() + m.website = 'HitomiLa' + m.rooturl = 'https://'..domain + m.category = 'H-Sites' + m.sortedlist=true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/HoduComics.lua b/lua/modules/HoduComics.lua new file mode 100644 index 000000000..0700fd75e --- /dev/null +++ b/lua/modules/HoduComics.lua @@ -0,0 +1,80 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//p[@class="title"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="episode_bnr"]/img/@src')) + mangainfo.genres=x.xpathstringall('//p[@class="category"]/span'):gsub('#', '') + mangainfo.summary=x.xpathstring('//p[@class="synop"]') + local v = x.xpath('//table[@class="episode_list"]//tr[contains(@class, "episode_tr") and contains(@class, "not_need_pay")]') + for i = 1, v.count do + local v1 = v.get(i) + local s = MaybeFillHost(module.RootURL, GetBetween('=\'', '\'', v1.getAttribute('onclick'))) + mangainfo.chapterlinks.add(s) + s = x.xpathstring('td[@class="toon_title"]/div[@class="episode_subtitle"]', v1) + mangainfo.chapternames.add(s) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + http.headers.values['Referer'] = module.rooturl .. task.link + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "toon_img")]') + x.parsehtml(DecodeBase64(GetBetween("toon_img = \"", "\";", s))) + local v = x.xpath('//img/@src') + for i = 1, v.count do + task.pagelinks.add(MaybeFillHost(module.RootURL, v.get(i).toString)) + end + task.pagecontainerlinks.values[0] = http.cookies.text + else + return false + end + return true +end + +local dirurls = { + '/manga', '/complete' +} + +function getnameandlink() + local lurl = dirurls[module.CurrentDirectoryIndex+1] + if http.get(module.rooturl .. lurl) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//ul[@id="comic_item_list"]/li/a') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getAttribute('href')) + names.add(x.xpathstring('div/div/span[@class="title"]', v1)) + end + return no_error + else + return net_problem + end +end + +function beforedownloadimage() + http.reset() + http.cookies.text = task.pagecontainerlinks.values[0] + http.headers.values['Referer'] = module.rooturl + return true +end + +function Init() + local m = NewModule() + m.category = 'Raw' + m.Website = 'HoduComics' + m.RootURL = 'https://hoducomics.com' + m.lastupdated='June 24, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.onbeforedownloadimage='beforedownloadimage' + m.totaldirectory = #dirurls +end diff --git a/lua/modules/IMangaScans.lua b/lua/modules/IMangaScans.lua new file mode 100644 index 000000000..f90ed14ff --- /dev/null +++ b/lua/modules/IMangaScans.lua @@ -0,0 +1,50 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//title'):gsub(' | Imangascans Reader', '') + x.xpathhrefall('//ul[@class="dropdown-menu"]/li/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "var pages")]') + x.parsehtml(SeparateRight(s, '=')) + local v = x.xpath('json(*)()') + local base = v.get(1).toString + for i = 2, v.count do + task.pagelinks.add(MaybeFillHost(module.RootURL, base .. '/' .. v.get(i).toString)) + end + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/series-list') then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//h4[@class="series-title"]/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'IMangaScans' + m.rooturl = 'https://reader.imangascans.org' + m.category = 'English-Scanlation' + m.lastupdated='April 13, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/Imgur.lua b/lua/modules/Imgur.lua new file mode 100644 index 000000000..b6dd684d0 --- /dev/null +++ b/lua/modules/Imgur.lua @@ -0,0 +1,54 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1[@class="post-title"]') + mangainfo.chapterlinks.add(url) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function taskstart() + task.pagelinks.clear() + return true +end + +function getpagenumber() + local hash = url:match('/a/(.+)/?') + if hash ~= nil then + -- album + if http.get(module.rooturl .. '/ajaxalbums/getimages/' .. hash .. '/hit.json') then + local x = TXQuery.Create(http.Document) + local v = x.xpath('json(*).data.images()') + for i = 1, v.count do + local v1 = v.get(i) + task.pagelinks.add('https://i.imgur.com/' .. x.xpathstring('hash', v1) .. x.xpathstring('ext', v1)) + end + return true + else + return false + end + else + -- single image + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + x.xpathStringAll('//div[contains(@class,"post-image")]/a/img/concat("https:",@src)', task.pagelinks) + return true + else + return false + end + end +end + +function Init() + m=NewModule() + m.website='Imgur' + m.rooturl='https://imgur.com' + m.lastupdated='February 6, 2018' + m.OnGetInfo='getinfo' + m.OnTaskStart='taskstart' + m.OnGetPageNumber='getpagenumber' +end diff --git a/lua/modules/InManga.lua b/lua/modules/InManga.lua new file mode 100644 index 000000000..fbe72a78d --- /dev/null +++ b/lua/modules/InManga.lua @@ -0,0 +1,73 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//meta[@property="og:image"]/@content')) + mangainfo.summary=x.xpathstring('//div/div[h1]/following-sibling::div[@class="panel-body"]') + local id = x.xpathstring('//input[@id="Identification"]/@value') + local base = x.xpathstring('//script[contains(., "var chapterUrl")]') + base = GetBetween("'", "'", base) + if http.get(module.RootURL .. '/chapter/getall?mangaIdentification=' .. id) then + x.parsehtml(http.document) + local root = x.xpath('json(json(*).data)') + local v = x.xpath('jn:members(result)', root) + local t = {} + for i = 1, v.count do + table.insert(t, tonumber(x.xpathstring('Number', v.get(i)))) + end + table.sort(t) + for _, k in ipairs(t) do + local chid = x.xpathstring('jn:members(result)[Number='..k..']/Identification', root) + local chnum = x.xpathstring('jn:members(result)[Number='..k..']/FriendlyChapterNumber', root) + mangainfo.chapterlinks.add(module.rooturl .. '/chapter/chapterIndexControls?identification=' .. chid) + mangainfo.chapternames.add('Capítulo: ' .. chnum) + end + end + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local v=x.xpath('//div[contains(@class,"PagesContainer")]/a/img/@id') + for i = 1, v.count do + local id = v.get(i).toString + task.pagelinks.add(MaybeFillHost(module.rooturl, '/page/getPageImage/?identification='..id)); + end + else + return false + end + return true +end + +function getnameandlink() + local data = 'filter%5Bgeneres%5D%5B%5D=-1&filter%5BqueryString%5D=&filter%5Bskip%5D=0&filter%5Btake%5D=10000&filter%5Bsortby%5D=5&filter%5BbroadcastStatus%5D=0' + if http.post(module.rooturl .. '/manga/getMangasConsultResult', data) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//a[contains(@class,"manga-result")]') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('.//h4', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'InManga' + m.rooturl = 'https://inmanga.com' + m.category = 'Spanish' + m.lastupdated='April 16, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/JapScan.lua b/lua/modules/JapScan.lua new file mode 100644 index 000000000..bb941538f --- /dev/null +++ b/lua/modules/JapScan.lua @@ -0,0 +1,78 @@ +local ALPHA_LIST_UP = '#ABCDEFGHIJKLMNOPQRSTUVWXYZ' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//h1') + mangainfo.title = string.gsub(mangainfo.title, '^Manga ', '') + mangainfo.title = string.gsub(mangainfo.title, '^Manhua ', '') + mangainfo.title = string.gsub(mangainfo.title, '^Manhwa ', '') + mangainfo.title = string.gsub(mangainfo.title, ' VF$', '') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@id="main"]//img/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstringall('//div[@id="main"]//p[contains(span, "Statut")]/text()', ''), 'En Cours', 'Termine') + mangainfo.authors=x.xpathstringall('//div[@id="main"]//p[contains(span, "Auteur")]/text()', '') + mangainfo.artists=x.xpathstringall('//div[@id="main"]//p[contains(span, "Artiste")]/text()', '') + mangainfo.genres=x.xpathstringall('//div[@id="main"]//p[contains(span, "Type(s)")]/text()', '') + mangainfo.summary=x.xpathstring('//div[@id="main"]//div[contains(text(), "Synopsis")]/following-sibling::*') + x.xpathhrefall('css("div#chapters_list div.chapters_list > a")', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + task.pagenumber = x.xpathcount('//select[@id="pages"]/option/@value') + else + return false + end + return true +end + +function getimageurl() + local s = AppendURLDelim(url)..(workid+1)..'.html' + if http.get(MaybeFillHost(module.rooturl,s)) then + task.pagelinks[workid]=TXQuery.create(http.document).xpathstring('//div[@id="image"]/@data-src') + return true + end + return false +end + +function getnameandlink() + local s = '0-9' + if module.CurrentDirectoryIndex ~= 0 then + s = ALPHA_LIST_UP:sub(module.CurrentDirectoryIndex+1,module.CurrentDirectoryIndex+1) + end + if http.get(MaybeFillHost(module.rooturl, '/mangas/' .. s .. '/' .. IncStr(url))) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@id="main"]//p/a[contains(@href, "/manga/")]', links, names) + local page = tonumber(x.XPathString('//ul[contains(@class, "pagination")]/li[last()]/a')) + if page == nil then + page = 1 + end + updatelist.CurrentDirectoryPageNumber = page + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='French' + m.website='Japscan' + m.rooturl='http://www.japscan.to' + m.lastupdated='April 6, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl='getimageurl' + m.totaldirectory=ALPHA_LIST_UP:len() +end diff --git a/lua/modules/KazeManga.lua b/lua/modules/KazeManga.lua new file mode 100644 index 000000000..236016339 --- /dev/null +++ b/lua/modules/KazeManga.lua @@ -0,0 +1,49 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//h1[@itemprop="headline"]'):gsub(' Bahasa Indonesia$', '') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('css("div.animeinfo img")/@src')) + mangainfo.authors = x.XPathStringAll('css("div.animeinfo > span")//span[contains(b, "Author")]/substring-after(text(),":")','') + mangainfo.summary = x.XPathString('css("div.sinopx > p")') + mangainfo.genres = x.XPathStringAll('css("div.animeinfo > span")//span[contains(b, "Genre")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('css("div.animeinfo > span")//span[contains(b, "Status")]')) + x.xpathhrefall('css("div.epl > ul > li a")', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('css("div.badan img")/@src', task.pagelinks) + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/komik-list/') then + local x=TXQuery.Create(http.Document) + x.xpathhrefall('css(".anime-list2 .a-z > li > a")', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Indonesian' + m.website='KazeManga' + m.rooturl='https://kazemanga.xyz' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' +end diff --git a/lua/modules/LHTranslation.lua b/lua/modules/LHTranslation.lua new file mode 100644 index 000000000..553a50a7d --- /dev/null +++ b/lua/modules/LHTranslation.lua @@ -0,0 +1,75 @@ +function GetInfo() + mangainfo.url = MaybeFillHost(module.RootURL, url) + if http.GET(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//h1[@class="postsby"]/substring-after(.,":")') + end + mangainfo.title = Trim(mangainfo.title) + mangainfo.coverLink = x.XPathString('(//div[@class="featured-thumbnail"])[1]/img/@src') + while true do + x.xpathhreftitleall('//h2[@class="title"]/a',mangainfo.chapterlinks,mangainfo.chapternames) + local nextpage = x.xpathstring('//nav/div[@class="nav-links"]/*[contains(@class, "current")]/following-sibling::a[1]/@href') + if nextpage == '' then break; end + if http.get(nextpage) then + x.parsehtml(http.document) + else + break + end + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +local readrooturl = 'http://read.lhtranslation.com' +function GetPageNumber() + local s = '/read-' .. url:gsub('/', '') .. '.html' + if http.get(MaybeFillHost(readrooturl, s)) then + local x=TXQuery.Create(http.document) + x.xpathstringall('//img[contains(@class,"chapter-img")]/@src',task.pagelinks) + if task.pagelinks.count > 0 then return true; end + end + s = s:gsub('(%d+)-(%d+)%.html$', '%1.%2.html') + if http.get(MaybeFillHost(readrooturl, s)) then + local x=TXQuery.Create(http.document) + x.xpathstringall('//img[contains(@class,"chapter-img")]/@src',task.pagelinks) + if task.pagelinks.count > 0 then return true; end + end + if http.get(MaybeFillHost(module.rooturl, url)) then + local x = TXQuery.Create(http.document) + if http.get(x.xpathstring('//div[@class="commentmetadata"][1]/p/a/@href')) then + x.parsehtml(http.document) + x.xpathstringall('//img[contains(@class,"chapter-img")]/@src',task.pagelinks) + if task.pagelinks.count > 0 then return true; end + end + end + return false +end + +function GetNameAndLink() + if http.GET(module.rooturl) then + local x=TXQuery.Create(http.document) + local v=x.xpath('//select[@id="cat"]/option[@value!="-1"]') + for i=1,v.count do + local v1=v.get(i) + links.add(module.rooturl..'/?cat='..v1.getattribute('value')) + names.add(Trim(v1.tostring:gsub('%(%d+%)%s*$', ''))) + end + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category = 'English-Scanlation' + m.Website = 'LHTranslation' + m.RootURL = 'http://lhtranslation.net' + m.OnGetNameAndLink = 'GetNameAndLink' + m.OnGetInfo = 'GetInfo' + m.OnGetPageNumber = 'GetPageNumber' +end diff --git a/lua/modules/LeitorNet.lua b/lua/modules/LeitorNet.lua new file mode 100644 index 000000000..ab61c0213 --- /dev/null +++ b/lua/modules/LeitorNet.lua @@ -0,0 +1,93 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//*[@id="series-data"]//*[@class="series-title"]/h1') + mangainfo.coverlink=x.xpathstring('//*[@id="series-data"]//img[@class="cover"]/@src') + mangainfo.authors=x.xpathstring('//*[@id="series-data"]//*[@class="series-author"]/normalize-space(text())') + mangainfo.genres=x.xpathstringall('//*[@id="series-data"]//ul[contains(@class, "tags")]/li/a') + if x.xpathstring('//*[@id="series-data"]//*[@class="complete-series"]') == '' then + mangainfo.status = '1' + else + mangainfo.status = '0' + end + mangainfo.summary=x.xpathstring('//*[@id="series-data"]//*[@class="series-desc"]') + + local id = x.xpathstring('//ul[@data-id-serie]/@data-id-serie') + local page = 1 + while true do + if http.xhr(module.RootURL..'/series/chapters_list.json?page='..tostring(page)..'&id_serie='..id) then + if http.terminated then break end + x=TXQuery.Create(http.document) + if x.xpathstring('json(*).chapters'):lower() == 'false' then break end + v=x.xpath('json(*).chapters()') + for i=1,v.count do + v1=v.get(i) + w=x.xpath('./releases/*', v1) + for j=1,w.count do + w1=w.get(j) + local s = x.xpathstring('./concat(number, " - ", chapter_name)', v1) + local sc = x.xpathstring('./scanlators[1]/name', w1) + if sc ~= '' then + s = s .. ' [' .. sc .. ']' + end + mangainfo.chapternames.add(s) + mangainfo.chapterlinks.add(x.xpathstring('./link', w1)) + end + end + page=page+1 + else + break + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + x=TXQuery.Create(http.Document) + s=x.xpathstring('//script[contains(@src, "token=")]/@src') + local token = s:match('%?token=(%w+)&?') + local id = s:match('&id_release=(%w+)&?') + if http.get(module.rooturl .. string.format('/leitor/pages/%s.json?key=%s', id, token)) then + x=TXQuery.Create(http.Document) + x.xpathstringall('json(*).images()', task.pagelinks) + else + return false + end + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl..'/lista-de-mangas/ordenar-por-nome/todos?page=' .. IncStr(url)) then + local x=TXQuery.Create(http.Document) + local p=x.xpathstring('//ul[contains(@class,"content-pagination")]/li[last()-1]/a') + p = tonumber(p) + if p ~= nil then + updatelist.CurrentDirectoryPageNumber = p + end + x.XPathHREFtitleAll('//ul[@class="seriesList"]/li/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Portugues' + m.website='LeitorNet' + m.rooturl='https://leitor.net' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/Lhscans.lua b/lua/modules/Lhscans.lua new file mode 100644 index 000000000..fe7c4b50b --- /dev/null +++ b/lua/modules/Lhscans.lua @@ -0,0 +1,82 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = Trim(SeparateLeft(x.XPathString('//title'), '- Raw')) + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//img[@class="thumbnail"]/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//ul[@class="manga-info"]/li[contains(., "Status")]//a')) + mangainfo.authors=x.xpathstring('//ul[@class="manga-info"]/li[contains(., "Author")]//a') + mangainfo.genres=x.xpathstringall('//ul[@class="manga-info"]/li[contains(., "Genre")]//a') + mangainfo.summary=x.xpathstring('//h3[text()="Description"]/following-sibling::p') + if mangainfo.summary == '' then + mangainfo.summary=x.xpathstring('//div[@class="detail"]/div[@class="content"]') + end + x.xpathhrefall('//div[@id="tab-chapper"]//table/tbody/tr/td/a', mangainfo.chapterlinks, mangainfo.chapternames) + if mangainfo.chapterlinks.count == 0 then + x.xpathhrefall('//div[@id="list-chapters"]//a[@class="chapter"]', mangainfo.chapterlinks, mangainfo.chapternames) + end + for i = 0, mangainfo.chapterlinks.count-1 do + mangainfo.chapterlinks[i] = module.RootURL .. '/' .. mangainfo.chapterlinks[i] + end + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + local u = MaybeFillHost(module.rooturl, url) + if http.get(u) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[@class="chapter-img"]/@src', task.pagelinks) + task.pagecontainerlinks.text = u + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.RootURL .. '/manga-list.html?listType=allABC') then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//span[@manga-slug]//a') + for i = 1, v.count do + local v1 = v.get(i) + names.Add(Trim(SeparateLeft(v1.toString, '- Raw'))); + links.Add(v1.getAttribute('href')); + end + return no_error + else + return net_problem + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = task.pagecontainerlinks.text + return true +end + +function AddWebsiteModule(name, url, cat) + local m = NewModule() + m.category = cat + m.Website = name + m.RootURL = url + m.LastUpdated = 'April 9, 2018' + m.totaldirectory=1 + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' + return m +end + +function Init() + local cat = 'Raw' + AddWebsiteModule('Lhscans', 'http://lhscan.net', cat) + AddWebsiteModule('RawQQ', 'https://rawqq.com', cat) + AddWebsiteModule('RawQV', 'http://rawqv.com', cat) +end diff --git a/lua/modules/Madara.lua b/lua/modules/Madara.lua new file mode 100644 index 000000000..78291ae06 --- /dev/null +++ b/lua/modules/Madara.lua @@ -0,0 +1,143 @@ +Modules = {} + +function Modules.Madara() + local Madara = {} + + function Madara:new() + local obj = {} + setmetatable(obj, self) + self.__index = self + return obj + end + + function Madara:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstringall('//div[@class="post-title"]/*[self::h1 or self::h2 or self::h3]/text()', '') + if string.match(mangainfo.title:upper(), ' RAW$') ~= nil then + mangainfo.title = mangainfo.title:sub(1, -5) + end + mangainfo.coverlink=x.xpathstring('//div[@class="summary_image"]/a/img/@data-src') + if mangainfo.coverlink == '' then + mangainfo.coverlink=x.xpathstring('//div[@class="summary_image"]/a/img/@src') + end + mangainfo.authors=x.xpathstringall('//div[@class="author-content"]/a') + mangainfo.artists=x.xpathstringall('//div[@class="artist-content"]/a') + mangainfo.genres=x.xpathstringall('//div[@class="genres-content"]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="summary-heading" and contains(h5, "Status")]/following-sibling::div/div/a')) + mangainfo.summary=x.xpathstring('//div[contains(@class,"summary__content")]/*') + x.XPathHREFAll('//li[@class="wp-manga-chapter"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function Madara:getpagenumber() + task.pagelinks.clear() + local aurl = MaybeFillHost(module.rooturl, url) + if Pos('style=list', aurl) == 0 then + aurl = aurl .. '?style=list' + end + if http.get(aurl) then + local x = TXQuery.Create(http.Document) + x.xpathstringall('//div[contains(@class, "page-break")]/img/@src', task.pagelinks) + return true + end + return false + end + + function Madara:getnameandlink() + local perpage = 100 + local q = 'action=madara_load_more&page='.. url ..'&template=madara-core%2Fcontent%2Fcontent-archive&vars%5Bpost_type%5D=wp-manga&vars%5Berror%5D=&vars%5Bm%5D=&vars%5Bp%5D=0&vars%5Bpost_parent%5D=&vars%5Bsubpost%5D=&vars%5Bsubpost_id%5D=&vars%5Battachment%5D=&vars%5Battachment_id%5D=0&vars%5Bname%5D=&vars%5Bstatic%5D=&vars%5Bpagename%5D=&vars%5Bpage_id%5D=0&vars%5Bsecond%5D=&vars%5Bminute%5D=&vars%5Bhour%5D=&vars%5Bday%5D=0&vars%5Bmonthnum%5D=0&vars%5Byear%5D=0&vars%5Bw%5D=0&vars%5Bcategory_name%5D=&vars%5Btag%5D=&vars%5Bcat%5D=&vars%5Btag_id%5D=&vars%5Bauthor%5D=&vars%5Bauthor_name%5D=&vars%5Bfeed%5D=&vars%5Btb%5D=&vars%5Bpaged%5D=1&vars%5Bmeta_key%5D=&vars%5Bmeta_value%5D=&vars%5Bpreview%5D=&vars%5Bs%5D=&vars%5Bsentence%5D=&vars%5Btitle%5D=&vars%5Bfields%5D=&vars%5Bmenu_order%5D=&vars%5Bembed%5D=&vars%5Bignore_sticky_posts%5D=false&vars%5Bsuppress_filters%5D=false&vars%5Bcache_results%5D=true&vars%5Bupdate_post_term_cache%5D=true&vars%5Blazy_load_term_meta%5D=true&vars%5Bupdate_post_meta_cache%5D=true&vars%5Bposts_per_page%5D='.. tostring(perpage) ..'&vars%5Bnopaging%5D=false&vars%5Bcomments_per_page%5D=50&vars%5Bno_found_rows%5D=false&vars%5Border%5D=ASC&vars%5Borderby%5D=post_title&vars%5Btemplate%5D=archive&vars%5Bsidebar%5D=full&vars%5Bpost_status%5D=publish' + if http.post(module.rooturl .. '/wp-admin/admin-ajax.php', q) then + if http.headers.values['Content-Length'] == '0' then return no_error end + local x = TXQuery.Create(http.Document) + if x.xpath('//div[contains(@class, "post-title")]/h5/a').count == 0 then return no_error end + x.XPathHREFAll('//div[contains(@class, "post-title")]/h5/a', links, names) + updatelist.CurrentDirectoryPageNumber = updatelist.CurrentDirectoryPageNumber + 1 + return no_error + else + return net_problem + end + end + + return Madara +end + +function Modules.ChibiManga() + local ChibiManga = {} + setmetatable(ChibiManga, { __index = Modules.Madara() }) + + function ChibiManga:getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x = TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "chapter_preloaded_images")]', task.pagelinks) + s = "{"..GetBetween("{", "}", s).."}" + x.parsehtml(s) + x.xpathstringall('let $c := json(*) return for $k in jn:keys($c) return $c($k)', task.pagelinks) + return true + end + return false + end + + return ChibiManga +end + +------------------------------------------------------------------------------- + +function createInstance() + local m = Modules[module.website] + if m ~= nil then + return m():new() + else + return Modules.Madara():new() + end +end + +------------------------------------------------------------------------------- + +function getinfo() + return createInstance():getinfo() +end + +function getpagenumber() + return createInstance():getpagenumber() +end + +function getnameandlink() + return createInstance():getnameandlink() +end + +function AddWebsiteModule(name, url, category) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = category + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + return m +end + +function Init() + local cat = 'Raw' + AddWebsiteModule('RawNeko', 'http://trueneko.online', cat) + + cat = 'English-Scanlation' + AddWebsiteModule('TrashScanlations', 'https://trashscanlations.com', cat) + AddWebsiteModule('ZeroScans', 'https://zeroscans.com', cat) + AddWebsiteModule('ChibiManga','http://www.cmreader.info', cat) + + cat = 'Indonesian' + AddWebsiteModule('MangaYosh', 'https://mangayosh.com', cat) + AddWebsiteModule('KomikGo', 'https://komikgo.com', cat) + + cat = 'H-Sites' + AddWebsiteModule('ManhwaHentai', 'https://manhwahentai.com', cat) + + cat = 'Spanish-Scanlation' + AddWebsiteModule('GodsRealmScan', 'https://godsrealmscan.com', cat) +end diff --git a/lua/modules/ManHuaGui.lua b/lua/modules/ManHuaGui.lua new file mode 100644 index 000000000..6935fab4e --- /dev/null +++ b/lua/modules/ManHuaGui.lua @@ -0,0 +1,106 @@ +local js = require 'modules.jsunpack' +local lz = require 'modules.lzstring' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="book-title"]/h1') + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//p[@class="hcover"]/img/@src')) + mangainfo.authors=SeparateRight(x.xpathstring('//ul[@class="detail-list cf"]/li[2]/span[2]'), '：') + mangainfo.genres=SeparateRight(x.xpathstring('//ul[@class="detail-list cf"]/li[2]/span[1]'), '：') + if Pos('连载中', x.xpathstring('//ul[@class="detail-list cf"]/li[@class="status"]')) > 0 then + mangainfo.status = '1' + else + mangainfo.status = '0' + end + mangainfo.summary=x.xpathstring('//div[@id="intro-all"]') + v=x.xpath('//div[contains(@id,"chapter-list")]/ul') + for i=v.count,1,-1 do + v1=v.get(i) + x.XPathHREFtitleAll('./li/a',mangainfo.chapterlinks,mangainfo.chapternames,v1) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + local servers = { + 'http://i.hamreus.com', + 'http://us.hamreus.com', + 'http://dx.hamreus.com', + 'http://eu.hamreus.com', + 'http://lt.hamreus.com', + } + + math.randomseed(os.time()) + math.random(); math.random(); math.random(); + + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "p,a,c,k")]') + s = SeparateRight(s, "}('") + local text = SeparateLeft(s, "',"); + local a = tonumber(GetBetween("',", ",", s)) + s = SeparateRight(s, "',") + local c = tonumber(GetBetween(",", ",'", s)) + local w = js.splitstr(lz.decompressFromBase64(GetBetween(",'", "'", s)), '|') + s = js.unpack36(text, a, c, w) + s = s:gsub('^var%s+.+=%s*{', '{'):gsub('||{};$', ''):gsub('"status":,', '') + x.parsehtml(s) + local cid = x.xpathstring('json(*).cid') + local md5 = x.xpathstring('json(*).sl.md5') + local path = x.xpathstring('json(*).path') + local srv = servers[math.random(#servers)] + v=x.xpath('json(*).files()') + for i=1,v.count do + v1=v.get(i) + task.pagelinks.add(srv .. path .. v1.toString .. '?cid=' .. cid .. '&md5=' .. md5) + end + return true + else + return false + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/list/') then + x = TXQuery.Create(http.Document) + local s = x.XPathString('//div[contains(@id, "AspNetPager")]/a[last()]/@href') + page = tonumber(s:match('%d+')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/list/index_p'..IncStr(url)..'.html') then + TXQuery.Create(http.document).xpathhrefall('//ul[@id="contList"]/li/p/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Raw' + m.website='ManHuaGui' + m.rooturl='http://www.manhuagui.com' + m.lastupdated='February 21, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' +end \ No newline at end of file diff --git a/lua/modules/ManHuaTai.lua b/lua/modules/ManHuaTai.lua new file mode 100644 index 000000000..ed2b447f2 --- /dev/null +++ b/lua/modules/ManHuaTai.lua @@ -0,0 +1,100 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[contains(@class, "mhjsbody")]/div/ul/li[contains(., "名称")]/substring-after(., "名称：")') + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//div[@class="comic-cover"]/img/@src')) + mangainfo.authors=x.xpathstring('//div[contains(@class, "mhjsbody")]/div/ul/li[contains(., "作者")]/substring-after(., "作者：")') + mangainfo.genres=x.xpathstring('//div[contains(@class, "mhjsbody")]/div/ul/li[contains(., "类型")]/substring-after(., "类型：")') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[contains(@class, "mhjsbody")]/div/ul/li[contains(., "状态")]/substring-after(., "状态：")'), '连载至', '已完结'); + mangainfo.summary=x.xpathstringall('//div[contains(@class,"wz")]/div/text()', '') + v=x.xpath('//div[@class="mhlistbody"]/ul') + for i=v.count,1,-1 do + v1=v.get(i) + w = x.xpath('./li/a', v1) + for j = 1, w.count do + w1 = w.get(j) + mangainfo.chapterlinks.add(mangainfo.url .. '/' .. w1.getAttribute('href')) + mangainfo.chapternames.add(w1.getAttribute('title')) + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + local servers = { + 'http://mhpic.mh51.com', + 'http://mhpic.manhualang.com', + 'http://mhpic.jumanhua.com', + 'http://mhpic.yyhao.com', + } + + math.randomseed(os.time()) + math.random(); math.random(); math.random(); + + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "mh_info")]') + local imgpath = GetBetween('imgpath:"', '",', s) + imgpath = imgpath:gsub('\\\\', '\\'):gsub("\\'", "'"):gsub('\\"', '"') + local pageid = tonumber(s:match('pageid:%s*(%d+)')) + local start = tonumber(s:match('startimg:%s*(%d+)')) + local total = tonumber(s:match('totalimg:%s*(%d+)')) + local size = GetBetween('comic_size:"', '",', s) + imgpath = imgpath:gsub('(.)', + function (a) + return string.char(string.byte(a) - pageid % 10) + end + ) + local srv = servers[math.random(#servers)] + for i=start,total do + local d = tostring(start+i-1) .. '.jpg' .. size + task.pagelinks.add(srv .. '/comic/' .. imgpath .. d) + end + return true + else + return false + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/all.html') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//div[@class="pages"]/a[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/all_p'..IncStr(url)..'.html') then + TXQuery.Create(http.document).XPathHREFtitleAll('//a[contains(div/ul/li/@class, "title")]',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Raw' + m.website='ManHuaTai' + m.rooturl='http://www.manhuatai.com' + m.lastupdated='February 21, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' +end \ No newline at end of file diff --git a/lua/modules/MangaDex.lua b/lua/modules/MangaDex.lua new file mode 100644 index 000000000..6bfbb94de --- /dev/null +++ b/lua/modules/MangaDex.lua @@ -0,0 +1,339 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + http.cookies.values['mangadex_h_toggle'] = '1' + local id = url:match('title/(%d+)') + if id == nil then id = url:match('manga/(%d+)'); end + delay() + if http.get(MaybeFillHost(module.rooturl, '/api/manga/' .. id)) then + local resp = HTMLEncode(StreamToString(http.document)) + local x = TXQuery.Create(resp) + + local info = x.xpath('json(*)') + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('manga/title', info) + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('manga/cover_url', info)) + mangainfo.authors = x.xpathstring('manga/author', info) + mangainfo.artists = x.xpathstring('manga/artist', info) + mangainfo.summary = x.xpathstring('manga/description', info) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('manga/status', info), '1', '2') + + local genres = '' + local v = x.xpath('jn:members(manga/genres)', info) + if v.count > 0 then genres = getgenre(v.get(1).toString); end + for i = 2, v.count do + local v1 = v.get(i) + genres = genres .. ', ' .. getgenre(v1.toString) + end + if x.xpathstring('manga/hentai', info) == '1' then + if genres ~= '' then genres = genres .. ', ' end + genres = genres .. 'Hentai' + end + mangainfo.genres = genres + + local selLang = module.getoption('lualang') + local selLangId = findlang(selLang) + local chapters = x.xpath('let $c := json(*).chapter return for $k in jn:keys($c) ' .. + 'return jn:object(object(("chapter_id", $k)), $c($k))') + for i = 1, chapters.count do + local v1 = chapters.get(i) + local lang = x.xpathstring('lang_code', v1) + local ts = tonumber(x.xpathstring('timestamp', v1)) + if (selLang == 0 or lang == selLangId) and (ts <= os.time()) then + mangainfo.chapterlinks.add('/chapter/' .. x.xpathstring('chapter_id', v1)) + + local s = '' + local vol = x.xpathstring('volume', v1) + local ch = x.xpathstring('chapter', v1) + if vol ~= '' then s = s .. string.format('Vol. %s', vol); end + if s ~= '' then s = s .. ' '; end + if ch ~= '' then s = s .. string.format('Ch. %s', ch); end + + local title = x.xpathstring('title', v1) + if title ~= '' then + if s ~= '' then s = s .. ' - '; end + s = s .. title + end + + if selLang == 0 then + s = string.format('%s [%s]', s, getlang(lang)) + end + + if module.getoption('luashowscangroup') then + local group = x.xpathstring('group_name', v1) + local group2 = x.xpathstring('group_name_2', v1) + local group3 = x.xpathstring('group_name_3', v1) + if group2:len() > 0 and group2 ~= 'null' then + group = group .. ' | ' .. group2 + end + if group3:len() > 0 and group3 ~= 'null' then + group = group .. ' | ' .. group3 + end + s = string.format('%s [%s]', s, group) + end + + mangainfo.chapternames.add(s) + end + end + + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getgenre(genre) + local genres = { + ["1"] = "4-koma", + ["2"] = "Action", + ["3"] = "Adventure", + ["4"] = "Award Winning", + ["5"] = "Comedy", + ["6"] = "Cooking", + ["7"] = "Doujinshi", + ["8"] = "Drama", + ["9"] = "Ecchi", + ["10"] = "Fantasy", + ["11"] = "Gyaru", + ["12"] = "Harem", + ["13"] = "Historical", + ["14"] = "Horror", + ["15"] = "Josei", + ["16"] = "Martial Arts", + ["17"] = "Mecha", + ["18"] = "Medical", + ["19"] = "Music", + ["20"] = "Mystery", + ["21"] = "Oneshot", + ["22"] = "Psychological", + ["23"] = "Romance", + ["24"] = "School Life", + ["25"] = "Sci-Fi", + ["26"] = "Seinen", + ["27"] = "Shoujo", + ["28"] = "Shoujo Ai", + ["29"] = "Shounen", + ["30"] = "Shounen Ai", + ["31"] = "Slice of Life", + ["32"] = "Smut", + ["33"] = "Sports", + ["34"] = "Supernatural", + ["35"] = "Tragedy", + ["36"] = "Long Strip", + ["37"] = "Yaoi", + ["38"] = "Yuri", + ["39"] = "[no chapters]", + ["40"] = "Video Games", + ["41"] = "Isekai", + ["42"] = "Adaptation", + ["43"] = "Anthology", + ["44"] = "Web Comic", + ["45"] = "Full Color", + ["46"] = "User Created", + ["47"] = "Official Colored", + ["48"] = "Fan Colored", + ["49"] = "Gore", + ["50"] = "Sexual Violence", + ["51"] = "Crime", + ["52"] = "Magical Girls", + ["53"] = "Philosophical", + ["54"] = "Superhero", + ["55"] = "Thriller", + ["56"] = "Wuxia", + ["57"] = "Aliens", + ["58"] = "Animals", + ["59"] = "Crossdressing", + ["60"] = "Demons", + ["61"] = "Delinquents", + ["62"] = "Genderswap", + ["63"] = "Ghosts", + ["64"] = "Monster Girls", + ["65"] = "Loli", + ["66"] = "Magic", + ["67"] = "Military", + ["68"] = "Monsters", + ["69"] = "Ninja", + ["70"] = "Office Workers", + ["71"] = "Police", + ["72"] = "Post-Apocalyptic", + ["73"] = "Reincarnation", + ["74"] = "Reverse Harem", + ["75"] = "Samurai", + ["76"] = "Shota", + ["77"] = "Survival", + ["78"] = "Time Travel", + ["79"] = "Vampires", + ["80"] = "Traditional Games", + ["81"] = "Virtual Reality", + ["82"] = "Zombies", + ["83"] = "Incest" + } + if genres[genre] ~= nil then + return genres[genre] + else + return genre + end +end + +local langs = { + ["sa"] = "Arabic", + ["bd"] = "Bengali", + ["bg"] = "Bulgarian", + ["mm"] = "Burmese", + ["ct"] = "Catalan", + ["cn"] = "Chinese (Simp)", + ["hk"] = "Chinese (Trad)", + ["cz"] = "Czech", + ["dk"] = "Danish", + ["nl"] = "Dutch", + ["gb"] = "English", + ["ph"] = "Filipino", + ["fi"] = "Finnish", + ["fr"] = "French", + ["de"] = "German", + ["gr"] = "Greek", + ["hu"] = "Hungarian", + ["id"] = "Indonesian", + ["it"] = "Italian", + ["jp"] = "Japanese", + ["kr"] = "Korean", + ["my"] = "Malay", + ["mn"] = "Mongolian", + ["ir"] = "Persian", + ["pl"] = "Polish", + ["br"] = "Portuguese (Br)", + ["pt"] = "Portuguese (Pt)", + ["ro"] = "Romanian", + ["ru"] = "Russian", + ["rs"] = "Serbo-Croatian", + ["es"] = "Spanish (Es)", + ["mx"] = "Spanish (LATAM)", + ["se"] = "Swedish", + ["th"] = "Thai", + ["tr"] = "Turkish", + ["ua"] = "Ukrainian", + ["vn"] = "Vietnamese" +} + +function getlang(lang) + if langs[lang] ~= nil then + return langs[lang] + else + return 'Unknown' + end +end + +function getlanglist() + local t = {} + for k, v in pairs(langs) do table.insert(t, v); end + table.sort(t) + return t +end + +function findlang(lang) + local t = getlanglist() + for i, v in ipairs(t) do + if i == lang then + lang = v + break + end + end + for k, v in pairs(langs) do + if v == lang then return k; end + end + return nil +end + +function getpagenumber() + http.cookies.values['mangadex_h_toggle'] = '1' + local chapterid = url:match('chapter/(%d+)') + delay() + if http.get(MaybeFillHost(module.rooturl,'/api/chapter/'..chapterid)) then + local x=TXQuery.Create(http.Document) + local hash = x.xpathstring('json(*).hash') + local srv = x.xpathstring('json(*).server') + local v = x.xpath('json(*).page_array()') + for i = 1, v.count do + local v1 = v.get(i) + local s = MaybeFillHost(module.rooturl, srv .. '/' .. hash .. '/' .. v1.toString) + task.pagelinks.add(s) + end + return true + else + return false + end + return true +end + +local dirurl='/titles/2' + +function getdirectorypagenumber() + http.cookies.values['mangadex_h_toggle'] = '1' + http.cookies.values['mangadex_title_mode'] = '2' + delay() + if http.GET(module.RootURL .. dirurl) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('(//ul[contains(@class,"pagination")]/li/a)[last()]/@href'):match('/2/(%d+)')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + http.cookies.values['mangadex_h_toggle'] = '1' + http.cookies.values['mangadex_title_mode'] = '2' + delay() + if http.GET(module.rooturl .. dirurl .. '/' .. IncStr(url) .. '/') then + local x = TXQuery.Create(http.document) + x.xpathhrefall('//a[contains(@class, "manga_title")]',links,names) + return no_error + else + return net_problem + end +end + +function delay() + local interval = tonumber(module.getoption('luainterval')) + local delay = tonumber(module.getoption('luadelay')) -- * module.ActiveConnectionCount + + if (interval == nil) or (interval < 0) then interval = 1000; end + if (delay == nil) or (delay < 0) then delay = 1000; end + + local lastDelay = module.storage['lastDelay'] + if lastDelay ~= '' then + lastDelay = tonumber(lastDelay) + if GetCurrentTime() - lastDelay < interval then + print(GetCurrentTime() - lastDelay) + Sleep(delay) + end + end + + module.storage['lastDelay'] = tostring(GetCurrentTime()) +end + +function Init() + m=NewModule() + m.category='English' + m.website='MangaDex' + m.rooturl='https://mangadex.org' + m.lastupdated='February 28, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + + m.maxtasklimit=1 + m.maxconnectionlimit=2 + + m.addoptionspinedit('luainterval', 'Min. interval between requests (ms)', 1000) + m.addoptionspinedit('luadelay', 'Delay (ms)', 1000) + m.addoptioncheckbox('luashowscangroup', 'Show scanlation group', false) + + local items = 'All' + local t = getlanglist() + for k, v in ipairs(t) do items = items .. '\r\n' .. v; end + m.addoptioncombobox('lualang', 'Language:', items, 11) +end diff --git a/lua/modules/MangaEden.lua b/lua/modules/MangaEden.lua new file mode 100644 index 000000000..f8e52eb04 --- /dev/null +++ b/lua/modules/MangaEden.lua @@ -0,0 +1,98 @@ +local diren = '/en/en-directory/?order=-0' +local dirit = '/en/it-directory/?order=-0' + +function GetInfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//*[@class="manga-title"]') + end + local coverlink = x.xpathstring('//div[@class="mangaImage2"]//img/@src') + if coverlink ~= '' then + if coverlink:find('^//') then coverlink = 'https:' .. coverlink; end + mangainfo.coverlink=MaybeFillHost(module.RootURL, coverlink) + end + mangainfo.authors=x.xpathstringall('//*[@class="rightBox"]/a[contains(@href,"/?author=")]') + mangainfo.artists=x.xpathstringall('//*[@class="rightBox"]/a[contains(@href,"/?artist=")]') + mangainfo.genres=x.xpathstringall('//*[@class="rightBox"]/a[contains(@href,"/?categories")]') + mangainfo.summary=x.xpathstring('//*[@id="mangaDescription"]') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//*[@class="rightBox"]'), 'Ongoing', 'Completed') + x.xpathhrefall('//table//tr/td/a[@class="chapterLink"]', mangainfo.chapterlinks, mangainfo.chapternames) + for i = 0, mangainfo.chapternames.count-1 do + mangainfo.chapternames[i] = mangainfo.chapternames[i]:gsub("Chapter", " ") + end + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "var pages")]') + s = GetBetween('=', ';', s) + x.parsehtml(s) + x.xpathstringall('json(*)().fs', task.PageLinks) + for i = 0, task.PageLinks.count-1 do + if string.find(task.PageLinks[i], '^//') then + task.PageLinks[i] = 'https:' .. task.PageLinks[i] + end; + end + return true + else + return false + end +end + +function GetDirUrl(website) + if module.website == 'MangaEden_IT' or module.website == 'PervEden_IT' then + return dirit + else + return diren + end +end + +function GetDirectoryPageNumber() + if http.GET(AppendURLDelim(module.RootURL)..GetDirUrl(module.website)) then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//*[@class="pagination pagination_bottom"]/a[last()-1]')) + if page == nil then + page = 1 + end + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..GetDirUrl(module.website).."?page="..IncStr(url)) then + x=TXQuery.Create(http.Document) + x.xpathhrefall('//table[@id="mangaList"]//tr/td[1]/a', links, names) + return no_error + else + return net_problem + end +end + +function InitModule(website, rooturl, category) + m=NewModule() + m.category=category + m.website=website + m.rooturl=rooturl + m.lastupdated='November 25, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.OnGetDirectoryPageNumber = 'GetDirectoryPageNumber' + m.ongetnameandlink='GetNameAndLink' +end + +function Init() + InitModule('MangaEden', 'http://www.mangaeden.com', 'English') + InitModule('MangaEden_IT', 'http://www.mangaeden.com', 'Italian') + InitModule('PervEden', 'http://www.perveden.com', 'H-Sites') + InitModule('PervEden_IT', 'http://www.perveden.com', 'H-Sites') +end diff --git a/lua/modules/MangaFreak.lua b/lua/modules/MangaFreak.lua new file mode 100644 index 000000000..2910cf415 --- /dev/null +++ b/lua/modules/MangaFreak.lua @@ -0,0 +1,65 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//div[@class="manga_series_data"]/h5') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//div[@class="manga_series_image"]/img/@src')) + --mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//ul[@class="manga-info"]/li[contains(., "Status")]//a')) + --mangainfo.authors=x.xpathstring('//ul[@class="manga-info"]/li[contains(., "Author")]//a') + mangainfo.genres=x.xpathstringall('//div[@class="series_sub_genre_list"]/a') + --mangainfo.summary=x.xpathstring('//h3[text()="Description"]/following-sibling::p') + x.xpathhrefall('//div[@class="manga_series_list"]/table/tbody/tr/td[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getimageurl() + local lurl=MaybeFillHost(module.rooturl,url) + if workid~=0 then lurl=lurl..'_'..workid+1 end + if http.get(lurl) then + x=TXQuery.Create(http.Document) + task.pagelinks[workid]=x.xpathstring('//div[@class="read_image"]//img/@src') + return true + else + return false + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + task.pagenumber = x.xpathcount('//div[@class="read_selector"]/select/option') + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.RootURL .. '/Mangalist') then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//div[@class="manga_list"]/div/div[@class="manga_item"]/div/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='English' + m.website='MangaFreak' + m.rooturl='http://www.mangafreak.net' + m.lastupdated='April 9, 2018' + m.totaldirectory=1 + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl='getimageurl' +end diff --git a/lua/modules/MangaGo.lua b/lua/modules/MangaGo.lua new file mode 100644 index 000000000..1b39b8e68 --- /dev/null +++ b/lua/modules/MangaGo.lua @@ -0,0 +1,271 @@ +local mgdirurl = '/list/directory/all/' +local rdirurl = '/directory/?gid=all&sindex=all&status=all&page=' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then mangainfo.title=x.xpathstring('//h1'):gsub(' manga$', ''); end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="left cover"]/img/@src')) + mangainfo.authors=x.xpathstring('//div[@class="manga_right"]//td/label[.="Author:"]/string-join(following-sibling::*/text(),", ")') + mangainfo.genres=x.xpathstring('//div[@class="manga_right"]//td/label[.="Genre(s):"]/string-join(following-sibling::*/text(),", ")') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="manga_right"]//td/label[.="Status:"]/following-sibling::*/text()')) + mangainfo.summary=x.xpathstring('//div[@class="manga_summary"]/string-join(text(),codepoints-to-string(10))') + x.xpathhrefall('//table[@id="chapter_table"]//td//a[not(@style)]', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + http.reset() + http.headers.values['Referer'] = mangainfo.url + return no_error + else + return net_problem + end +end + +function r_getinfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + if mangainfo.title == '' then mangainfo.title=x.XPathString('//div[@class="title"]/h1'); end + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//img[@class="pic"]/@src')) + mangainfo.authors = x.xpathstring('//div[@class="cartoon-intro"]//p[contains(span, "Author")]/text()') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="cartoon-intro"]//p/span[contains(., "Status")]/following-sibling::span[1]')) + mangainfo.genres = x.XPathStringAll('//div[@class="cartoon-intro"]//p[contains(span, "Author")]/a') + mangainfo.summary = x.xpathstring('//div[@class="summary"]') + x.XPathHREFAll('//table[@class="list_table"]//tr/td[@class="chapter_name_td"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + http.get(module.rooturl .. '/ywz.ico') + http.reset() + http.headers.values['Referer'] = mangainfo.url + return no_error + else + return net_error + end +end + +function getdirectorypagenumber() + http.headers.values['Referer'] = module.rooturl + local s = module.rooturl .. mgdirurl .. '1/' + if http.get(s) then + x=TXQuery.Create(http.document) + page=x.xpathcount('//div[@class="pagination"]//ol/li//select/option') + return true + else + return false + end +end + +function r_getdirectorypagenumber() + http.headers.values['Referer'] = module.rooturl + local s = module.rooturl .. rdirurl .. '1' + if http.get(s) then + x=TXQuery.Create(http.document) + page=x.xpathcount('//div[@class="pagination"]//ol/li//select/option') + return true + else + return false + end +end + +local js = require 'modules.jsunpack' +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + local rurl = MaybeFillHost(module.rooturl, url) + if http.get(rurl) then + x=TXQuery.Create(http.Document) + local cnt = x.xpathcount('//ul[@id="dropdown-menu-page"]/li/a') + local s = x.xpathstring('//script[contains(.,"imgsrcs")]') + if s == '' then return false; end + if Pos(' imgsrcs = new Array', s) > 0 then + s = GetBetween('(', ')', s) + else + s = GetBetween(' imgsrcs = \'', '\';', s) + end + s = s:gsub('\'', '') + local script = x.xpathstring('//script[contains(@src, "chapter.js")]/@src') + http.reset() + http.headers.values['Referer'] = rurl + if http.get(script) then + local function unp(script) + script = js.replacehex(script) + local a, c = script:match('[\'"]%s*,%s*(%d+)%s*,%s*(%d+)%s*,%s*[\'"]') + a, c = tonumber(a), tonumber(c) + local d = script:match('[\'"]%s*,%s*%d+%s*,%s*%d+%s*,%s*[\'"].+[\'"].+split.+%([\'"](.+)[\'"]%)') + local w = script:match('[\'"]%s*,%s*%d+%s*,%s*%d+%s*,%s*[\'"](.+)[\'"].+split') + w = js.splitstr(w, d) + local txt = script:match('}%s*%(%s*[\'"](.+)[\'"]%s*,%s*%d+%s*,%s*%d+%s*,%s*[\'"](.+)[\'"].+split') + return js.unpack36(txt, a, c, w) + end + local function d3(script, u) + local function _d(a, b) + local function rp(a, b, c) return a:sub(1, b) .. c .. a:sub(b+2); end + local c = a:len() + for j = 4,1,-1 do + for i = c-1,b[j],-1 do + if i%2 ~= 0 then + local tmp = string.char(a:byte(i-b[j]+1)) + a = rp(a, i-b[j], string.char(a:byte(i+1))) + a = rp(a, i, tmp) + end + end + end + return a + end + local bstr = script:match('%d+', script:find('dorder%s*%(%s*img')) + local b = {} + for i=1,bstr:len() do b[i] = bstr:byte(i) - 48; end + return _d(u, b) + end + module.storage['r'] = '1' + if Pos(',', s) == 0 then + script = unp(StreamToString(http.document)) + elseif Pos('http', s) == 0 then + script = unp(StreamToString(http.document)) + if script:match('referrerPolicy:"no%-referrer"') ~= nil then + module.storage['r'] = '0' + end + s = d3(script, s) + else + end + local a = js.splitstr(s, ',') + for i = 1, math.min(cnt, #a) do + task.pagelinks.add(SeparateRight(a[i], '//')) + end + if module.storage['loaded'] == '0' then filldict(script) end + end + else + return false + end + return true +end + +function beforedownloadimage() + if module.storage['r'] == '1' then + http.headers.values['Referer'] = module.rooturl + end + return true +end + +function filldef(m) + local dict = TStrings.create() + dict.values['60a2b0ed56cd458c4633d04b1b76b7e9'] = '18a72a69a64a13a1a43a3aa42a23a66a26a19a51a54a78a34a17a31a35a15a58a29a61a48a73a74a44a52a60a24a63a20a32a7a45a53a75a55a62a59a41a76a68a2a36a21a10a38a33a71a40a67a22a4a50a80a65a27a37a47a70a14a28a16a6a56a30a57a5a11a79a9a77a46a39a25a49a8a12' + dict.values['400df5e8817565e28b2e141c533ed7db'] = '61a74a10a45a3a37a72a22a57a39a25a56a52a29a70a60a67a41a63a55a27a28a43a18a5a9a8a40a17a48a44a79a38a47a32a73a4a6a13a34a33a49a2a42a50a76a54a36a35a14a58a7a69a46a16a30a21a11aa51a53a77a26a31a1a19a20a80a24a62a68a59a66a75a12a64a78a71a15a65a23' + dict.values['84ba0d8098f405b14f4dbbcc04c93bac'] = '61a26a35a16a55a10a72a37a2a60a66a65a33a44a7a28a70a62a32a56a30a40a58a15a74a47aa36a78a75a11a6a77a67a39a23a9a31a64a59a13a24a80a14a38a45a21a63a19a51a17a34a50a46a5a29a73a8a57a69a48a68a49a71a41a12a52a18a79a76a54a42a22a4a1a3a53a20a25a43a27' + dict.values['56665708741979f716e5bd64bf733c33'] = '23a7a41a48a57a27a69a36a76a62a40a75a26a2a51a6a10a65a43a24a1aa20a71a28a30a13a38a79a78a72a14a49a55a56a58a25a70a12a80a3a66a11a39a42a17a15a54a45a34a74a31a8a61a46a73a63a22a64a19a77a50a9a59a37a68a52a18a32a16a33a60a67a21a44a53a5a35a4a29a47' + dict.values['37abcb7424ce8df47ccb1d2dd9144b49'] = '67a45a39a72a35a38a61a11a51a60a13a22a31a25a75a30a74a43a69a50a6a26a16a49a77a68a59a64a17a56a18a1a10a54a44a62a53a80a5a23a48a32a29a79a24a70a28a58a71a3a52a42a55a9a14a36a73a34a2a27a57a0a21a41a33a37a76a8a40a65a7a20a12a19a47a4a78a15a63a66a46' + dict.values['874b83ba76a7e783d13abc2dabc08d76'] = '26a59a42a43a4a20a61a28a12a64a37a52a2a77a34a13a46a74a70a0a44a29a73a66a55a38a69a67a62a9a63a6a54a79a21a33a8a58a40a47a71a49a22a50a57a78a56a25a17a15a36a16a48a32a5a10a14a80a24a72a76a45a3a53a23a41a60a11a65a19a27a51a68a35a31a1a75a39a30a7a18' + dict.values['930b87ad89c2e2501f90d0f0e92a6b97'] = '9a29a49a67a62a40a28a50a64a77a46a31a16a73a14a45a51a44a7a76a22a78a68a37a74a69a25a65a41a11a52aa18a36a10a38a12a15a2a58a48a8a27a75a20a4a80a61a55a42a13a43a47a39a35a60a26a30a63a66a57a33a72a24a71a34a23a3a70a54a56a32a79a5a21a6a59a53a17a1a19' + dict.values['1269606c6c3d8bb6508426468216d6b1'] = '49a15a0a60a14a26a34a69a61a24a35a4a77a80a70a40a39a6a68a17a41a56a28a46a79a16a21a1a37a42a44a58a78a18a52a73a32a9a12a50a8a13a20a19a67a36a45a75a48a10a65a7a38a66a3a2a43a27a29a31a72a74a55a23a54a22a59a57a11a62a47a53a30a5a64a25a76a71a51a33a63' + dict.values['33a3b21bb2d14a09d15f995224ae4284'] = '30a59a35a34a42a8a10a56a70a64a48a69a26a18a6a16a54a24a73a79a68a33a32a2a63a53a31a14a17a57a41a80a76a40a60a12a43a29a39a4a77a58a66a36a38a52a13a19a0a75a28a55a25a61a71a11a67a49a23a45a5a15a1a50a51a9a44a47a65a74a72a27a7a37a46a20a22a62a78a21a3' + dict.values['9ae6640761b947e61624671ef841ee78'] = '62a25a21a75a42a61a73a59a23a19a66a38a71a70a6a55a3a16a43a32a53a37a41a28a49a63a47a17a7a30a78a46a20a67a56a79a65a14a69a60a8a52a22a9a24a2a4a13a36a27a0a18a33a12a44a5a76a26a29a40a1a11a64a48a39a51a80a72a68a10a58a35a77a54a34a74a57a31a50a45a15' + dict.values['a67e15ed870fe4aab0a502478a5c720f'] = '8a12a59a52a24a13a37a21a55a56a41a71a65a43a40a66a11a79a67a44a33a20a72a2a31a42a29a34a58a60a27a48a28a15a35a51a76a80a0a63a69a53a39a46a64a50a75a1a57a9a62a74a18a16a73a14a17a6a19a61a23a38a10a3a32a26a36a54a4a30a45a47a70a22a7a68a49a77a5a25a78' + dict.values['b6a2f75185754b691e4dfe50f84db57c'] = '47a63a76a58a37a4a56a21a1a48a62a2a36a44a34a42a23a9a60a72a11a74a70a20a77a16a15a35a69a0a55a46a24a6a32a75a68a43a41a78a31a71a52a33a67a25a80a30a5a28a40a65a39a14a29a64a3a53a49a59a12a66a38a27a79a45a18a22a8a61a50a17a51a10a26a13a57a19a7a54a73' + dict.values['db99689c5a26a09d126c7089aedc0d86'] = '57a31a46a61a55a41a26a2a39a24a75a4a45a13a23a51a15a8a64a37a72a34a12a3a79a42a80a17a62a49a19a77a48a68a78a65a14a10a29a16a20a76a38a36a54a30a53a40a33a21a44a22a32a5a1a7a70a67a58a0a71a74a43a66a6a63a35a56a73a9a27a25a59a47a52a11a50a18a28a60a69' + dict.values['d320d2647d70c068b89853e1a269c609'] = '77a38a53a40a16a3a20a18a63a9a24a64a50a61a45a59a27a37a8a34a11a55a79a13a47a68a12a22a46a33a1a69a52a54a31a23a62a43a0a2a35a28a57a36a51a78a70a5a32a75a41a30a4a80a19a21a42a71a49a10a56a74a17a7a25a6a14a73a29a44a48a39a60a58a15a66a67a72a65a76a26' + dict.values['c587e77362502aaedad5b7cddfbe3a0d'] = '50aa59a70a68a30a56a10a49a43a45a29a23a28a61a15a40a71a14a44a32a34a17a26a63a76a75a33a74a12a11a21a67a31a19a80a7a64a8a3a51a53a38a18a6a42a27a9a52a20a41a60a1a22a77a16a54a47a79a24a78a2a46a37a73a65a36a35a39a5a4a25a72a13a62a55a57a58a69a66a48' + dict.values['f4ab0903149b5d94baba796a5cf05938'] = '40a37a55a73a18a42a15a59a50a13a22a63a52a58a6a80a47a17a38a71a74a70a30a11a10a19a0a31a36a21a51a68a1a3a14a66a45a2a79a7a76a75a8a67a20a78a25a69a43a28a35a60a4a23a65a54a34a9a5a39a27a57a26a33a12a24a46a72a56a44a49a61a64a29a53a48a32a62a41a16a77' + dict.values['f5baf770212313f5e9532ec5e6103b61'] = '55a69a78a75a38a25a20a60a6a80a46a5a48a18a23a24a17a67a64a70a63a57a22a10a49a19a8a16a11a12a61a76a34a27a54a73a44a0a56a3a15a29a28a13a4a2a7a77a74a35a37a26a30a58a9a71a50a1a43a79a47a32a14a53a52a66a72a59a68a31a42a45a62a51a40a39a33a65a41a36a21' + dict.values['e2169a4bfd805e9aa21d3112d498d68c'] = '54a34a68a69a26a20a66a1a67a74a22a39a63a70a5a37a75a15a6a14a62a50a46a35a44a45a28a8a40a25a29a76a51a77a17a47a0a42a2a9a48a27a13a64a58a57a18a30a80a23a61a36a60a59a71a32a7a38a41a78a12a49a43a79a24a31a52a19a3a53a72a10a73a11a33a16a4a55a65a21a56' + m.storage['ik'] = '18a72a69a64a13a1a43a3aa42a23a66a26a19a51a54a78a34a17a31a35a15a58a29a61a48a73a74a44a52a60a24a63a20a32a7a45a53a75a55a62a59a41a76a68a2a36a21a10a38a33a71a40a67a22a4a50a80a65a27a37a47a70a14a28a16a6a56a30a57a5a11a79a9a77a46a39a25a49a8a12' + m.storage['dict'] = dict.text + m.storage['loaded'] = '0' +end + +function filldict(script) + local dict = TStrings.create() + dict.text = module.storage['dict'] + local dkvar = 'deskeys' + local function fill(p) + for k, v in script:gmatch(p) do + if (k ~= nil) and (v ~= nil) then dict.values[k] = v; end + end + end + fill(dkvar..'%s*%[%s*[\'"]([^"\']+)[\'"]%s*%]%s*=%s*["\']([^"\']+)["\']') + fill(dkvar..'%s*%.%s*([^"\']+)%s*=%s*["\']([^"\']+)["\']') + module.storage['dict'] = dict.text + local ik = module.storage['ik'] + local s = script:match('[%s;,][fg]%s*=%s*["\']([^\'"]+)["\']') + if s ~= nil then ik = s; end + module.storage['ik'] = ik + module.storage['loaded'] = '1' +end + +function downloadimage() + if http.get(url) then + if Pos('mangapicgallery.com/r/cspiclink', url:lower()) > 0 then + local ik = module.storage['ik'] + local dict = TStrings.create() + dict.text = module.storage['dict'] + for i = 0,dict.count-1 do + local t = js.splitstr(dict.get(i), dict.NameValueSeparator) + if Pos(t[1], url) > 0 then ik = t[2]; break; end + end + local a = js.splitstr(ik, 'a') + local s = TImagePuzzle.Create(9, 9) + for i = 1, #a do + local n = tonumber(a[i]) + if n == nil then n = 0 end + s.matrix[i-1] = n; + end + s.descramble(http.document, http.document) + end + else + return false + end + return true +end + +function getnameandlink() + local ref = module.rooturl + local s = module.rooturl + s = s .. mgdirurl .. IncStr(url) .. '/' + if url ~= '0' then ref = ref .. mgdirurl .. url .. '/'; end + http.headers.values['Referer'] = ref + if http.get(s) then + local x = TXQuery.Create(http.Document) + x.XPathHREFtitleAll('//div[@class="directory_left"]//li/h3/a', links, names) + return no_error + else + return net_problem + end +end + +function r_getnameandlink() + local ref = module.rooturl + local s = module.rooturl + s = s .. rdirurl .. IncStr(url) + if url ~= '0' then ref = ref .. rdirurl .. url; end + http.headers.values['Referer'] = ref + if http.get(s) then + local x = TXQuery.Create(http.Document) + x.XPathHREFtitleAll('//div[@id="sa-comic_show_list"]/ul/li/p/a[not(@class)]', links, names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + filldef(m) + m.website = name + m.rooturl = url + m.category = 'English' + m.lastupdated='March 2, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber = 'getpagenumber' + m.ongetnameandlink = 'getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + m.onbeforedownloadimage = 'beforedownloadimage' + m.ondownloadimage = 'downloadimage' + if name == 'Rocaca' then + m.ongetinfo = 'r_getinfo' + m.ongetnameandlink = 'r_getnameandlink' + m.ongetdirectorypagenumber = 'r_getdirectorypagenumber' + end + return m +end + +function Init() + AddWebsiteModule('MangaGo', 'http://www.mangago.me') + AddWebsiteModule('Rocaca', 'http://www.rocaca.com') +end diff --git a/lua/modules/MangaHasu.lua b/lua/modules/MangaHasu.lua new file mode 100644 index 000000000..ba3ca70bf --- /dev/null +++ b/lua/modules/MangaHasu.lua @@ -0,0 +1,68 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="info-title"]/h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[contains(@class, "info-img")]/img/@src')) + mangainfo.authors=x.xpathstringall('//div[contains(b, "Author")]/span/a') + mangainfo.artists=x.xpathstringall('//div[contains(b, "Artist")]/span/a') + mangainfo.genres=x.xpathstringall('//div[contains(b, "Genre")]/span/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[contains(b, "Status")]/span/a')) + mangainfo.summary=x.xpathstring('//h3[contains(.,"Summary")]/following-sibling::*') + x.xpathhrefall('//div[@class="list-chapter"]/table//td[@class="name"]/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function beforedownloadimage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="img"]/img/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/directory.html?page=' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//ul[@class="list_manga"]/li//a[@class="name-manga"]', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/directory.html') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//div[@class="pagination-ct"]/a[last()]/substring-after(@href,"=")')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'MangaHasu' + m.rooturl = 'http://mangahasu.se' + m.category = 'English' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.onbeforedownloadimage='beforedownloadimage' + m.ongetdirectorypagenumber='getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/MangaHere.lua b/lua/modules/MangaHere.lua new file mode 100644 index 000000000..003393f32 --- /dev/null +++ b/lua/modules/MangaHere.lua @@ -0,0 +1,93 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + http.cookies.values['isAdult'] = '1' + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + if mangainfo.title == '' then + mangainfo.title=x.XPathString('//span[@class="detail-info-right-title-font"]') + end + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//img[@class="detail-info-cover-img"]/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('css("table.table-borderless")//tr[th="Status"]/td')) + mangainfo.authors = x.XPathString('//p[@class="detail-info-right-say"]/a') + mangainfo.genres = x.XPathStringAll('//p[@class="detail-info-right-tag-list"]/a') + mangainfo.summary = x.XPathString('//p[@class="fullcontent"]') + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//span[@class="detail-info-right-title-tip"]')) + local v=x.xpath('//ul[@class="detail-main-list"]/li/a') + for i=1, v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getAttribute('href'):gsub('1%.html', '')) + mangainfo.chapternames.add(x.xpathstring('./div/p[@class="title3"]', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber = 0 + http.cookies.values['isAdult'] = '1' + local aurl = MaybeFillHost(module.rooturl, url) .. '1.html' + if http.get(aurl) then + local x=TXQuery.Create(http.Document) + local s = x.XPathString('//script[contains(., "eval")]') + s = 'var $=function(){return{val:function(){}}},newImgs,guidkey;' .. s + s = s .. ';newImgs||guidkey;' + local key = ExecJS(s) + if string.len(key) > 16 then + task.pagelinks.commatext = key + else + s = x.XPathString('//script[contains(., "chapterid")]'); + local cid = Trim(GetBetween('chapterid', ';', s):gsub('=', '')) + task.pagenumber = tonumber(Trim(GetBetween('imagecount', ';', s):gsub('=', ''))) + if task.pagenumber == nil then task.pagenumber = 1 end + local page = 1 + while page <= task.pagenumber do + http.reset() + http.headers.values['Pragma'] = 'no-cache' + http.headers.values['Cache-Control'] = 'no-cache' + http.headers.values['Referer'] = aurl + s = string.format('chapterfun.ashx?cid=%s&page=%d&key=%s', cid, page, key) + if http.xhr(MaybeFillHost(module.rooturl, url) .. s) then + s = Trim(StreamToString(http.document)) + if s ~= '' then + s = ExecJS(s .. ';d;') + local lst = TStrings.Create() + lst.commatext = s + if page > 1 then lst.delete(0) end + task.pagelinks.addtext(lst.text) + lst = nil + end + end + if task.pagelinks.count >= task.pagenumber then break end + page = page + 1 + Sleep(3000) + end + end + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/mangalist/') then + local x=TXQuery.Create(http.Document) + x.xpathhrefall('css(".browse-new-block > .browse-new-block-content > a")', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='English' + m.website='MangaHere' + m.rooturl='https://www.mangahere.cc' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' +end diff --git a/lua/modules/MangaHispano.lua b/lua/modules/MangaHispano.lua new file mode 100644 index 000000000..f3e96891c --- /dev/null +++ b/lua/modules/MangaHispano.lua @@ -0,0 +1,59 @@ +function getinfo() + mangainfo.url = MaybeFillHost(module.RootURL, url) + if http.GET(mangainfo.url) then + x = TXQuery.Create(http.Document) + mangainfo.coverLink = MaybeFillHost(module.RootURL, x.XPathString('//div[@class="boxed"]/img/@src')) + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//h1[contains(@class,"widget-title")]') + end + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//span[contains(., "Estado")]/span'), 'progres', 'final') + mangainfo.authors = x.XPathStringAll('//span[contains(., "Autor")]/span') + mangainfo.genres = x.XPathStringAll('//dd[@class="sintesis-cat"]/a') + mangainfo.summary = x.XPathString('//div[@class="well"]/p') + v = x.Xpath('//ul/li/*[self::h5 or self::h3 and contains(@class, "chapter-title")]') + for i = 1, v.Count do + v2 = v.Get(i) + mangainfo.chapterLinks.Add(x.XPathString('a/@href', v2)) + mangainfo.chapterNames.Add(x.XPathString('a||": "||em', v2)) + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + x = TXQuery.Create(http.Document) + s = x.xpathstring('//script[contains(., "var pages")]') + s = GetBetween('pages =', ';', s) + x.parsehtml(s) + x.XPathStringAll('json(*)().page_image', task.PageLinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/mangas') then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//div[@class="caption"]/h3/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.category = 'Spanish' + m.Website = 'MangaHispano' + m.RootURL = 'https://mangahis.com' + m.lastupdated='June 14, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/MangaHubIO.lua b/lua/modules/MangaHubIO.lua new file mode 100644 index 000000000..c77ce692c --- /dev/null +++ b/lua/modules/MangaHubIO.lua @@ -0,0 +1,109 @@ +local perpage = 30 +local apiurl = 'https://api.mangahub.io/graphql' +local cdnurl = 'https://cdn.mangahub.io/file/imghub/' + +function getx() + if module.website == 'MangaReaderSite' then + return "mr01" + elseif module.website == 'MangaFoxFun' then + return "mf01" + elseif module.website == 'MangaKakalotFun' then + return "mn01" + elseif module.website == 'MangaHereFun' then + return "mh01" + else + return "m01" + end +end + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@id="mangadetail"]//h1/text()') + mangainfo.coverlink=x.xpathstring('//div[@id="mangadetail"]//img/@src') + mangainfo.authors=x.xpathstring('//div[@id="mangadetail"]//div/span[contains(., "Author")]/following-sibling::span') + mangainfo.artists=x.xpathstring('//div[@id="mangadetail"]//div/span[contains(., "Artist")]/following-sibling::span') + mangainfo.genres=x.xpathstringall('//div[@id="mangadetail"]//div/p/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@id="mangadetail"]//div/span[contains(., "Status")]/following-sibling::span')) + mangainfo.summary=x.xpathstring('//div[contains(@id, "noanim-content-tab-pane")]/div/p') + v=x.xpath('//div[contains(@id, "noanim-content-tab-pane")]/ul/li/a') + for i=1,v.count do + v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('span', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + local chapter = url:match('/chapter%-(.+)$'):gsub('/$', '') + local slug = url:match('/chapter/(.+)/') + local q = '{"query":"{chapter(x:'..getx()..',slug:\\"'..slug..'\\",number:'..chapter..'){id,title,mangaID,number,slug,date,pages,manga{id,title,slug,mainSlug,isWebtoon,isYaoi}}}"}' + http.mimetype = 'application/json' + if http.post(apiurl, q) then + x=TXQuery.Create(http.Document) + v=x.xpath('json(json(*).data.chapter.pages)/*') + for i = 1, v.count do + v1=v.get(i) + task.pagelinks.add(cdnurl .. v1.toString) + end + else + return false + end + return true +end + +function getnameandlink() + local offset = perpage * tonumber(url) + local q = '{"query":"{search(x:'..getx()..',q:\\"\\",genre:\\"all\\",mod:ALPHABET,count:true,offset:'..tostring(offset)..'){rows{id,title, slug},count}}"}' + http.mimetype = 'application/json' + if http.post(apiurl, q) then + x = TXQuery.Create(http.Document) + x.xpathstringall('json(*).data.search.rows()/concat("'..module.rooturl..'/manga/", slug)', links) + x.xpathstringall('json(*).data.search.rows().title', names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + local q = '{"query":"{search(x:'..getx()..',q:\\"\\",genre:\\"all\\",mod:ALPHABET,count:true,offset:0){rows{id,title, slug},count}}"}' + http.mimetype = 'application/json' + if http.post(apiurl, q) then + x = TXQuery.Create(http.Document) + local total = tonumber(x.xpathstring('json(*).data.search.count')) + if total == nil then total = 1 end + page = math.floor(total / perpage) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'English' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + return m +end + +function Init() + AddWebsiteModule('MangaHubIO', 'https://mangahub.io') + AddWebsiteModule('MangaReaderSite', 'https://mangareader.site') + AddWebsiteModule('MangaFoxFun', 'https://mangafox.fun') + AddWebsiteModule('MangaKakalotFun', 'https://mangakakalot.fun') + AddWebsiteModule('MangaHereFun', 'https://mangahere.onl') +end diff --git a/lua/modules/MangaKakalot.lua b/lua/modules/MangaKakalot.lua new file mode 100644 index 000000000..ec864a990 --- /dev/null +++ b/lua/modules/MangaKakalot.lua @@ -0,0 +1,120 @@ +function GetRedirectUrl(document) + local x = TXQuery.Create(document) + local s = x.xpathstring('//script[contains(., "window.location.assign")]') + if (s ~= '') and (s ~= nil) then + return GetBetween('("', '")', s) + end + return '' +end + +function getinfo() + local u = MaybeFillHost(module.rooturl, url) + if http.get(u) then + local s = GetRedirectUrl(http.Document) + if (s ~= '') and (s ~= nil) then + u = s + if not http.GET(u) then return false; end + end + mangainfo.url=u + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//ul[@class="manga-info-text"]/li/h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="manga-info-pic"]/img/@src')) + mangainfo.authors=x.xpathstringall('//ul[@class="manga-info-text"]/li[contains(., "Author")]/a') + mangainfo.genres=x.xpathstringall('//ul[@class="manga-info-text"]/li[contains(., "Genre")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//ul[@class="manga-info-text"]/li[contains(., "Status")]')) + if (Pos('email', mangainfo.title) > 0) and (Pos('protected', mangainfo.title) > 0) then + mangainfo.title = Trim(x.xpathstring('//title/substring-after(substring-before(., "Manga Online"), "Read")')) + end + mangainfo.summary=x.xpathstringall('//div[@id="noidungm"]/text()', '') + x.xpathhrefall('//div[@class="chapter-list"]/div[@class="row"]/span/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + function spliturl(u) + local pos = 0 + for i = 1, 3 do + local p = string.find(u, '/', pos+1, true) + if p == nil then break; end + pos = p + end + return string.sub(u, 1, pos-1), string.sub(u, pos) + end + task.pagelinks.clear() + task.pagenumber=0 + local u = MaybeFillHost(module.rooturl, url) + if http.get(u) then + local s = GetRedirectUrl(http.document) + if (s ~= '') and (s ~= nil) then + local host, _ = spliturl(s) + local _, path = spliturl(u) + u = host .. path + if not http.get(u) then return false; end + end + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@id="vungdoc"]/img/@src', task.pagelinks) + if task.pagelinks.count == 0 then + x.xpathstringall('//div[@class="vung_doc"]/img/@src', task.pagelinks) + end + if task.pagelinks.count == 0 then + x.xpathstringall('//div[@id="list_chapter"]//img/@src', task.pagelinks) + end + return true + else + return false + end +end + +local dirurl = '/manga_list?type=newest&category=all&state=all&page=' +function getnameandlink() + local dir = dirurl + if http.get(module.rooturl .. dir .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="truyen-list"]/div[@class="list-truyen-item-wrap"]/h3/a', links, names) + if links.count == 0 then + x.XPathHREFAll('//div[contains(@class,"danh_sach")]/div[contains(@class,"list_category")]/h3/a', links, names) + end + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + page = 1 + if http.GET(module.RootURL .. dirurl .. '1') then + x = TXQuery.Create(http.Document) + local s = x.xpathstring('//div[@class="group-page"]/a[contains(., "Last")]/@href') + if s == '' then + s = x.xpathstring('//div[@class="phan-trang"]/a[contains(., "Last")]/@href') + end + page = tonumber(s:match('page=(%d+)')) + if page == nil then page = 1; end + return true + else + return false + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'English' + m.lastupdated = 'March 12, 2018' + m.sortedlist = true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + return m +end + +function Init() + AddWebsiteModule('MangaKakalot', 'http://mangakakalot.com') + AddWebsiteModule('MangaNelo', 'http://manganelo.com') +end diff --git a/lua/modules/MangaKu.lua b/lua/modules/MangaKu.lua new file mode 100644 index 000000000..e169257ee --- /dev/null +++ b/lua/modules/MangaKu.lua @@ -0,0 +1,66 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + + mangainfo.title=x.xpathstring('//title/text()') + :gsub('Baca', ''):gsub('Online Komik', ''):gsub('Komik -', ''):gsub('Komik', '') + :gsub('Manga -', ''):gsub('Manga', ''):gsub('Online -', ''):gsub('Terbaru', '') + :gsub('Bahasa Indonesia', ''):gsub('^%s*[�/]', '') + + mangainfo.coverlink=x.xpathstring('//a[@imageanchor]/img/@src') + mangainfo.authors=x.xpathstring('//*[contains(., "Author")]/following-sibling::text()'):gsub("^:", "") + mangainfo.artists=x.xpathstring('//*[contains(., "Artist")]/following-sibling::text()'):gsub("^:", "") + mangainfo.genres=x.xpathstring('//*[contains(., "Genre")]/following-sibling::text()'):gsub("^:", "") + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//*[contains(., "Episodes")]/following-sibling::text()')) + x.xpathhrefall('//div[contains(@style, "-moz-border-radius")]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="separator"]/a/img/@src', task.pagelinks) + if task.pagelinks.count == 0 then + x.xpathstringall('//img[./@*[starts-with(name(), "data-original")]]/@src', task.pagelinks) + end + if task.pagelinks.count == 0 then + if http.get(MaybeFillHost('http://mangaku.co',url)) then + x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="separator"]/a/img/@src', task.pagelinks) + return true + else + return false + end + else + return true + end + else + return false + end +end + +function getnameandlink() + if http.get(module.rooturl..'/daftar-komik-bahasa-indonesia/') then + TXQuery.Create(http.document).xpathhrefall('//a[@class="screenshot"]',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Indonesian' + m.website='MangaKu' + m.rooturl='http://mangaku.in' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/MangaLib.lua b/lua/modules/MangaLib.lua new file mode 100644 index 000000000..a34467f28 --- /dev/null +++ b/lua/modules/MangaLib.lua @@ -0,0 +1,68 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//*[@class="manga__title"]/h2') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@class="manga__cover"]/@src')) + mangainfo.authors=x.xpathstringall('//div[@class="manga-info"]//p[contains(*, "Автор")]/a') + mangainfo.artists=x.xpathstringall('//div[@class="manga-info"]//p[contains(*, "Художник")]/a') + mangainfo.genres=x.xpathstringall('//div[@class="manga-info"]//p[contains(*, "Жанры")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="manga-info"]//p[contains(*, "Перевод")]/span'), 'продолжается', 'завершен') + mangainfo.summary=x.xpathstringall('//div[contains(@class, "manga__desc")]/blockquote/text()', '') + x.xpathhrefall('//div[@class="chapters-list"]/div/div[@class="chapter-item__name"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "var pages")]') + local base = s:match('%.scan%-page.+src\'%s*,%s*\'([^\']+)\'') + s = GetBetween('var pages =', ';', s) + x.parsehtml(s) + local v = x.xpath('json(*)().page_image') + for i = 1,v.count do + local v1=v.get(i) + task.pagelinks.add(base .. '/' .. v1.tostring) + end + else + return false + end + return true +end + +function getnameandlink() + if tonumber(url) < 0 then return no_error end + if http.get(module.rooturl .. '/filterlist?page='..IncStr(url)..'&cat=&alpha=&sortBy=name&asc=true&author=&artist=') then + local x = TXQuery.Create(http.Document) + if x.xpathstring('//div/p[contains(., "Ничего не найдено")]') == '' then + local v = x.xpath('//ul[contains(@class, "manga-list")]/li/div/div[@class="heading"]/a[@class="ttl"]') + for i=1,v.count do + local v1=v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstringall('h2/text()', '', v1)) + end + updatelist.CurrentDirectoryPageNumber = updatelist.CurrentDirectoryPageNumber + 1 + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'MangaLib' + m.rooturl = 'https://mangalib.me' + m.category = 'Russian' + m.lastupdated='March 3, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/MangaOku.lua b/lua/modules/MangaOku.lua new file mode 100644 index 000000000..3bb518e1e --- /dev/null +++ b/lua/modules/MangaOku.lua @@ -0,0 +1,74 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//select[@name="manga"]/option[@selected]') + s=x.xpathstring('//select[@name="manga"]/option[@selected]/@value') + v=x.xpath('//select[@name="chapter"]/option') + for i = 1, v.count do + v1=v.get(i) + mangainfo.chapternames.add(v1.toString) + mangainfo.chapterlinks.add(module.rooturl .. '/' .. s .. '/' .. v1.getAttribute('value')) + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + task.pagenumber = x.xpath('//select[@name="page"]/option').count + return true + else + return false + end +end + +function getnameandlink() + if http.get(module.rooturl) then + x=TXQuery.Create(http.Document) + v=x.xpath('//select[@name="manga"]/option[@value!="0"]') + for i = 1, v.count do + v1=v.get(i) + names.add(v1.toString) + links.add(module.rooturl .. '/' .. v1.getAttribute('value')) + end + return no_error + else + return net_problem + end +end + +function getimageurl() + local s = MaybeFillHost(module.rooturl,url) .. '/' .. tostring(workid+1) + if http.get(s) then + x=TXQuery.Create(http.Document) + task.pagelinks[workid]=MaybeFillHost(module.rooturl,x.xpathstring('//img[@id="manga_img"]/@src')) + return true + else + return false + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'Turkish' + m.lastupdated = 'February 16, 2018' + m.OnGetInfo = 'getinfo' + m.OnGetPageNumber = 'getpagenumber' + m.OnGetImageURL = 'getimageurl' + m.OnGetNameAndLink = 'getnameandlink' + return m +end + +function Init() + AddWebsiteModule('MangaOku', 'http://www.mangaoku.net') + AddWebsiteModule('Turkcraft', 'http://turkcraft.com') +end \ No newline at end of file diff --git a/lua/modules/MangaOnlineBiz.lua b/lua/modules/MangaOnlineBiz.lua new file mode 100644 index 000000000..332c02294 --- /dev/null +++ b/lua/modules/MangaOnlineBiz.lua @@ -0,0 +1,76 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="item"]/div[@class="image"]/img/@src')) + mangainfo.genres=x.xpathstringall('//div[@class="extra"]/a') + mangainfo.summary=x.xpathstring('//div[@id="description"]') + local s = x.xpathstring('//script[contains(., "mangaChapterCollection")]') + local name = GetBetween('View.Manga(', ');', s) + name = name:match('mangaName:%s*[\'"]([^\'"]+)[\'"]') + s = GetBetween('MangaChapter(', ');', s) + x.parsehtml(s) + local v = x.xpath('json(*)()') + for i = 1, v.count do + local v1 = v.get(i) + s = string.format('/%s/%s/%s/1/', name, x.xpathstring('volume', v1), x.xpathstring('number', v1)) + mangainfo.chapterlinks.add(s) + mangainfo.chapternames.add(x.xpathstring('title', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "chapterRouter")]') + s = GetBetween('Chapter(', ');', s) + x.parsehtml(s) + local base = x.xpathstring('json(*).srcBaseUrl') + local v = x.xpath('json(*).pages/*/src') + for i = 1,v.count do + local v1=v.get(i) + task.pagelinks.add(base .. '/' .. v1.tostring) + end + else + return false + end + return true +end + +function getnameandlink() + if tonumber(url) < 0 then return no_error end + if http.get(module.rooturl .. '/genre/all/page/'..IncStr(url)) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//div[@class="genres"]/a[@class="genre"]') + for i=1,v.count do + local v1=v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('div/h2', v1)) + end + local page = tonumber(x.xpathstring('(//a[@class="ui button"])[last()]')) + if page == nil then page = 1; end + updatelist.CurrentDirectoryPageNumber = page + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'MangaOnlineBiz' + m.rooturl = 'https://manga-online.biz' + m.category = 'Russian' + m.lastupdated='March 3, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/MangaPark.lua b/lua/modules/MangaPark.lua new file mode 100644 index 000000000..0bbc67cd9 --- /dev/null +++ b/lua/modules/MangaPark.lua @@ -0,0 +1,82 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h2'):gsub(' Manga$', '') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[contains(@class, "cover")]/img/@src')) + mangainfo.authors=x.xpathstringall('//table[@class="attr"]//tr[contains(th,"Author")]/td/a') + mangainfo.artists=x.xpathstringall('//table[@class="attr"]//tr[contains(th,"Artist")]/td/a') + mangainfo.genres=x.xpathstringall('//table[@class="attr"]//tr[contains(th,"Genre")]/td/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//table[@class="attr"]//tr[contains(th,"Status")]/td')) + mangainfo.summary=x.xpathstring('//p[@class="summary"]') + local v = x.xpath('//div[@id="list"]/div[contains(@class, "stream")]') + for i = 1, v.count do + local v1 = v.get(i) + local stream = ' [' .. x.xpathstring('div[@id]//a/span', v1) .. ']' + local w = x.xpath('div/ul[@class="chapter"]/li', v1) + for j = 1, w.count do + local w1 = w.get(j) + local link = x.xpathstring('div/a/@href', w1) + local title = x.xpathstring('div/a', w1) .. x.xpathstring('div[contains(@class, "txt")]', w1) + mangainfo.chapterlinks.add(link:gsub('/%d+$', '')) + mangainfo.chapternames.add(title .. stream) + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//a[@class="img-link"]/img[@class="img"]/@src', task.pagelinks) + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/search?orderby=create') then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('(//div[@id="paging-bar"])[2]/ul/li[last()-2]/a/substring-after(@href, "page=")')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl .. '/search?orderby=create&page=' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="manga-list"]//table//h2/a', links, names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = 'English' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + m.sortedlist = true +end + +function Init() + AddWebsiteModule('MangaPark', 'https://mangapark.me') + AddWebsiteModule('MangaParkNet', 'https://mangapark.net') + AddWebsiteModule('MangaParkCom', 'https://mangapark.com') +end \ No newline at end of file diff --git a/lua/modules/MangaParkOrg.lua b/lua/modules/MangaParkOrg.lua new file mode 100644 index 000000000..0d65b7ff5 --- /dev/null +++ b/lua/modules/MangaParkOrg.lua @@ -0,0 +1,81 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + if mangainfo.title == '' then + mangainfo.title=x.XPathString('//h3') + end + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('css("img.img-fluid")/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('css("table.table-borderless")//tr[th="Status"]/td')) + mangainfo.authors = x.XPathString('css("table.table-borderless")//tr[th="Author(s)"]/td') + mangainfo.artists = x.XPathString('css("table.table-borderless")//tr[th="Artist(s)"]/td') + mangainfo.genres = x.XPathStringAll('css("table.table-borderless")//tr[th="Genre(s)"]/td') + mangainfo.genres = mangainfo.genres:gsub('%s+/%s+', ', ') + mangainfo.summary = x.XPathString('//h4[.="Summary"]/following-sibling::p') + local v=x.xpath('css("div.card-header")') + for i=1, v.count do + local v1=v.get(i) + local src = x.xpathstring('./div/a', v1) + local w = x.xpath('./following-sibling::div/ul/li//a', v1) + for j = 1, w.count do + local w1 = w.get(j) + mangainfo.chapterlinks.add(w1.getAttribute('href')) + mangainfo.chapternames.add(string.format('%s (%s)', w1.toString, src)) + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "var images")]') + s = GetBetween("var images =", ";", s) + x.parsehtml(s) + x.xpathstringall('json(*)()', task.pagelinks) + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/browse?order_by=create&page='..IncStr(url)) then + x=TXQuery.Create(http.Document) + x.xpathhrefall('css("#browse h6")/a', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/browse?order_by=create') then + local x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('css("#paging nav.d-none ul.pagination")/li[last()-1]/a')) + if page == nil then + page = 1 + end + return true + else + return false + end +end + +function Init() + m=NewModule() + m.category='English' + m.website='MangaParkOrg' + m.rooturl='https://mangapark.org' + m.sortedlist = true + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.ongetdirectorypagenumber='getdirectorypagenumber' +end diff --git a/lua/modules/MangaRoom.lua b/lua/modules/MangaRoom.lua new file mode 100644 index 000000000..6784dcf64 --- /dev/null +++ b/lua/modules/MangaRoom.lua @@ -0,0 +1,60 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//div[@class="col-md-12"]/h3') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//div[@class="col-md-12"]/div/img[contains(@class, "img")]/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//table[contains(@class, "info_list")]//tr[contains(td, "Status")]/td[2]')) + mangainfo.authors=x.xpathstring('//table[contains(@class, "info_list")]//tr[contains(td, "Author")]/td[2]') + mangainfo.artists=x.xpathstring('//table[contains(@class, "info_list")]//tr[contains(td, "Artist")]/td[2]') + mangainfo.genres=x.xpathstringall('//table[contains(@class, "info_list")]//tr[contains(td, "Genres")]/td[2]/a') + mangainfo.summary=x.xpathstring('//div[contains(@class, "summary")]/p') + x.xpathhrefall('//table[contains(@class,"chapter-list")]//tr/td[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, '/manga' .. url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="page_container"]/img[contains(@class, "manga_page")]/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + local dirurl = string.format('/search?search-words=&status=%d-page-%s', module.CurrentDirectoryIndex, IncStr(url)) + if http.get(module.rooturl..dirurl) then + local x = TXQuery.Create(http.document) + if updatelist.CurrentDirectoryPageNumber <= 1 then + local page = x.xpathstring('//ul[contains(@class,"pagination")]/li[last()-1]/a/@href') + page = tonumber(page:match('page%-(%d+)')) + if page == nil then page = 1 end + updatelist.CurrentDirectoryPageNumber = page + end + x.xpathhrefall('//div[@id="content_item"]//div[@class="manga_title"]/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='English' + m.website='MangaRoom' + m.rooturl='http://manga-room.com' + m.lastupdated='April 8, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.totaldirectory=2 +end diff --git a/lua/modules/MangaShiro.lua b/lua/modules/MangaShiro.lua new file mode 100644 index 000000000..ec24f03dd --- /dev/null +++ b/lua/modules/MangaShiro.lua @@ -0,0 +1,387 @@ +Modules = {} + +function Modules.MangaShiroBase() + local MangaShiroBase = {} + + function MangaShiroBase:new() + local obj = {} + setmetatable(obj, self) + self.__index = self + return obj + end + + function MangaShiroBase:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1[@itemprop="name"]') + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1') + end + mangainfo.title = mangainfo.title:gsub('Bahasa Indonesia$', '') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="imgdesc"]/img/@src')) + mangainfo.authors=x.xpathstring('//div[@class="listinfo"]//li[starts-with(.,"Author")]/substring-after(.,":")') + mangainfo.genres=x.xpathstring('//div[@class="listinfo"]//li[starts-with(.,"Genre")]/substring-after(.,":")') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[@class="listinfo"]//li[starts-with(.,"Status")]')) + mangainfo.summary=x.xpathstring('//*[@class="desc"]/string-join(.//text(),"")') + x.xpathhrefall('//div[@class="cl"]//li/span[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function MangaShiroBase:getpagenumber() + task.pagenumber=0 + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl,url)) then + TXQuery.Create(http.Document).xpathstringall('//*[@id="readerarea"]//img/@data-lazy-src', task.pagelinks) + if task.pagelinks.count < 1 then + TXQuery.Create(http.Document).xpathstringall('//*[@id="readerarea"]//img/@src', task.pagelinks) + end + return true + end + end + + function MangaShiroBase:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + TXQuery.Create(http.document).xpathhrefall('//*[@class="soralist"]//a', links, names) + return no_error + end + return net_problem + end + + function MangaShiroBase:getdirurl() + return '/manga-list/' + end + + return MangaShiroBase; +end + +function Modules.KomikCast() + local KomikCast = {} + setmetatable(KomikCast, { __index = Modules.MangaShiroBase() }) + + function KomikCast:getdirurl() + return '/list/' + end + + function KomikCast:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//div[@class="mangainfo"]/h1') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="topinfo"]/img/@src')) + mangainfo.authors=x.xpathstring('//div[@class="topinfo"]//tr[contains(th, "Author")]/td') + mangainfo.genres=x.xpathstringall('//div[@class="topinfo"]//tr[contains(th, "Genres")]/td/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[@class="topinfo"]//tr[contains(th, "Status")]/td')) + mangainfo.summary=x.xpathstringall('//*[@class="sin"]/p/text()', '') + x.xpathhrefall('//div[@class="cl"]//li/span[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function KomikCast:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + TXQuery.Create(http.document).xpathhrefall('//*[@class="jdlbar"]//a',links,names) + return no_error + end + return net_problem + end + + return KomikCast +end + +function Modules.WestManga() + local WestManga = {} + setmetatable(WestManga, { __index = Modules.KomikCast() }) + + function WestManga:getdirurl() + return '/manga-list/?list' + end + + return WestManga +end + +function Modules.MangaShiro() + local MangaShiro = {} + setmetatable(MangaShiro, { __index = Modules.MangaShiroBase() }) + + function MangaShiro:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1[@itemprop="headline"]') + mangainfo.title=mangainfo.title:gsub('Bahasa Indonesia$', '') + end + local img = x.xpathstring('//div[@itemprop="image"]/img/@data-lazy-src') + if img == '' then + img = x.xpathstring('//div[@itemprop="image"]/img/@src') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, img) + mangainfo.authors=x.xpathstring('//div[@class="listinfo"]//li[starts-with(.,"Author")]/substring-after(.,":")') + mangainfo.genres=x.xpathstringall('//div[contains(@class,"animeinfo")]/div[@class="gnr"]/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//div[@class="listinfo"]//li[starts-with(.,"Status")]')) + mangainfo.summary=x.xpathstring('//*[@class="desc"]/string-join(.//text(),"")') + x.xpathhrefall('//div[@class="bxcl"]//li//div[@class="lch"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function MangaShiro:getdirurl() + return '/daftar-manga/?list' + end + + return MangaShiro +end + +function Modules.Kiryuu() + local Kiryuu = {} + setmetatable(Kiryuu, { __index = Modules.MangaShiro() }) + + function Kiryuu:getdirurl() + return '/manga-lists/?list' + end + + return Kiryuu +end + +function Modules.MangaIndoNet() + local MangaIndoNet = {} + setmetatable(MangaIndoNet, { __index = Modules.MangaShiro() }) + + function MangaIndoNet:getdirurl() + return '/manga-list/?list' + end + + return MangaIndoNet +end + +function Modules.KomikIndo() + local KomikIndo = {} + setmetatable(KomikIndo, { __index = Modules.MangaShiro() }) + + function KomikIndo:getdirurl() + return '/manga-list/?list' + end + + return KomikIndo +end + +function Modules.PecintaKomik() + local PecintaKomik = {} + setmetatable(PecintaKomik, { __index = Modules.MangaShiroBase() }) + + function PecintaKomik:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1[@itemprop="headline"]/*') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@itemprop="image"]/img/@src')) + mangainfo.authors=x.xpathstring('//table[@class="listinfo"]//tr[contains(th, "Penulis")]/td') + mangainfo.genres=x.xpathstringall('//table[@class="listinfo"]//tr[contains(th, "Genre")]/td/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//table[@class="listinfo"]//tr[contains(th, "Status")]/td')) + mangainfo.summary=x.xpathstring('//*[@class="desc"]/string-join(.//text(),"")') + x.xpathhrefall('//div[@class="bxcl"]//li//*[@class="lchx"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function PecintaKomik:getdirurl() + return '/daftar-manga/?list' + end + + return PecintaKomik +end + +function Modules.MangaKita() + local MangaKita = {} + setmetatable(MangaKita, { __index = Modules.MangaShiroBase() }) + + function MangaKita:getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[contains(@class,"leftImage")]/img/@src')) + mangainfo.authors=x.xpathstring('//span[@class="details"]//div[starts-with(.,"Author")]/substring-after(.,":")') + mangainfo.genres=x.xpathstringall('//span[@class="details"]//div[starts-with(.,"Genre")]/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//span[@class="details"]//div[starts-with(.,"Status")]')) + mangainfo.summary=x.xpathstringall('//*[@class="description"]/text()', '') + local v = x.xpath('//div[contains(@class, "chapter-list")]/a') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(v1.getAttribute('href')) + mangainfo.chapternames.add(x.xpathstring('./span', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + end + return net_problem + end + + function MangaKita:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + TXQuery.Create(http.document).xpathhrefall('//*[@class="jdlbar"]//a',links,names) + return no_error + end + return net_problem + end + + return MangaKita +end + +function Modules.KomikStation() + local KomikStation = {} + setmetatable(KomikStation, { __index = Modules.MangaShiroBase() }) + + function KomikStation:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + TXQuery.Create(http.document).xpathhrefall('//*[@class="daftarkomik"]//a',links,names) + return no_error + end + return net_problem + end + + function KomikStation:getdirurl() + return '/daftar-komik/' + end + + return KomikStation +end + +function Modules.MangaKid() + local MangaKid = {} + setmetatable(MangaKid, { __index = Modules.MangaShiroBase() }) + + function MangaKid:getdirurl() + return '/manga-lists/' + end + + return MangaKid +end + +function Modules.MangaID() + local MangaID = {} + setmetatable(MangaID, { __index = Modules.PecintaKomik() }) + + function MangaID:getinfo() + Modules.PecintaKomik().getinfo() + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1[@itemprop="headline"]') + mangainfo.title=mangainfo.title:gsub('Bahasa Indonesia$', '') + end + mangainfo.authors=x.xpathstring('//table[@class="listinfo"]//tr[contains(th, "Author")]/td') + end + + function MangaID:getdirurl() + return '/daftar-manga/?list' + end + + return MangaID +end + +function Modules.OtakuFile() + local OtakuFile = {} + setmetatable(OtakuFile, { __index = Modules.MangaShiroBase() }) + + function OtakuFile:getinfo() + Modules.MangaShiroBase().getinfo() + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1[@itemprop="name"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="imgdesc"]/a/img/@src')) + x.xpathhrefall('//div[@class="epl"]//li/span[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + end + + function OtakuFile:getpagenumber() + task.pagenumber=0 + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl,url)) then + TXQuery.Create(http.Document).xpathstringall('//*[@id="wrap"]/p//img/@src', task.pagelinks) + return true + end + end + + function OtakuFile:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + TXQuery.Create(http.document).xpathhrefall('//*[@class="anilist-diatur"]//a',links,names) + return no_error + end + return net_problem + end + + function OtakuFile:getdirurl() + return '/daftar-komik/' + end + + return OtakuFile +end + +------------------------------------------------------------------------------- + +function createInstance() + local m = Modules[module.website] + if m ~= nil then + return m():new() + else + return Modules.MangaShiroBase():new() + end +end + +------------------------------------------------------------------------------- + +function getinfo() + return createInstance():getinfo() +end + +function getpagenumber() + return createInstance():getpagenumber() +end + +function getnameandlink() + return createInstance():getnameandlink() +end + +function AddWebsiteModule(site, url) + local m=NewModule() + m.category='Indonesian' + m.website=site + m.rooturl=url + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + return m +end + +function Init() + AddWebsiteModule('MangaShiro', 'https://mangashiro.net') + AddWebsiteModule('MangaKita', 'http://www.mangakita.net') + AddWebsiteModule('KomikStation', 'https://www.komikstation.com') + AddWebsiteModule('MangaKid', 'http://mgku.net') + AddWebsiteModule('KomikCast', 'https://komikcast.com') + AddWebsiteModule('WestManga', 'https://westmanga.info') + AddWebsiteModule('Kiryuu', 'https://kiryuu.co') + AddWebsiteModule('KomikOtaku', 'https://komikotaku.net') + AddWebsiteModule('PecintaKomik', 'https://www.pecintakomik.com') + AddWebsiteModule('MangaIndoNet', 'https://mangaindo.net') + AddWebsiteModule('KomikIndo', 'https://komikindo.co') + AddWebsiteModule('MangaID', 'https://mangaid.me') + AddWebsiteModule('OtakuFile', 'https://otakufile.com') +end diff --git a/lua/modules/MangaShow.lua b/lua/modules/MangaShow.lua new file mode 100644 index 000000000..764a30a79 --- /dev/null +++ b/lua/modules/MangaShow.lua @@ -0,0 +1,68 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('css("div.manga-subject")') + end + local img = x.xpathstring('css("div.manga-thumbnail")/@style') + img = GetBetween('url(', ')', img) + mangainfo.coverlink=MaybeFillHost(module.RootURL, img) + mangainfo.authors=x.xpathstringall('css("a.author")') + mangainfo.genres=x.xpathstringall('css("div.manga-tags > a")') + x.xpathhrefall('css("div.chapter-list > div.slot > a")', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s=x.xpathstring('//script[contains(., "img_list")]') + s = GetBetween('var img_list =', ';', s) + x.parsehtml(s) + x.xpathstringall('json(*)()', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/bbs/page.php?hid=manga_list&page=' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('css("div.manga-list-gallery div.manga-subject > a")', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/bbs/page.php?hid=manga_list') then + local x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//ul[@class="pagination"]/li[last()]/a/@href'):match('%((%d+)%)$')) + if page == nil then + page = 1 + end + return true + else + return false + end +end + +function Init() + local m = NewModule() + m.website = 'MangaShow' + m.rooturl = 'https://mangashow.me' + m.category = 'Raw' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' +end diff --git a/lua/modules/MangaStream.lua b/lua/modules/MangaStream.lua new file mode 100644 index 000000000..10f636be4 --- /dev/null +++ b/lua/modules/MangaStream.lua @@ -0,0 +1,54 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//h1') + x.xpathhrefall('//table//td/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + task.pagenumber=tonumber(x.xpathstring('//div[contains(@class,"btn-reader-page")]/ul[@class="dropdown-menu"]/li[last()]/substring-before(substring-after(.,"("),")")')) + return true + else + return false + end +end + +function GetImageURL() + if http.get(MaybeFillHost(module.rooturl,url):gsub('/1$','')..'/'..tostring(workid+1)) then + x=TXQuery.Create(http.Document) + task.pagelinks[workid]=x.xpathstring('//img[@id="manga-page"]/@src') + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/manga') then + x=TXQuery.Create(http.Document) + x.xpathhrefall('//table//tr/td[1]//a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='English-Scanlation' + m.website='MangaStream' + m.rooturl='https://readms.net' + m.lastupdated='February 8, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetimageurl='GetImageURL' + m.ongetnameandlink='GetNameAndLink' +end diff --git a/lua/modules/MangaTail.lua b/lua/modules/MangaTail.lua new file mode 100644 index 000000000..5855f4c6e --- /dev/null +++ b/lua/modules/MangaTail.lua @@ -0,0 +1,104 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + http.cookies.values['has_js'] = '1' + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = string.gsub(x.xpathstring('//h1[@class="page-header"]'), ' Manga$', '') + end + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//*[contains(@class,"field-status")]')) + x.xpathhrefall('//table[contains(@class,"chlist")]//tr/td[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + + local s = x.xpathstring('//script[contains(., "jQuery.extend(Drupal")]') + s = GetBetween('settings,', ');', s) + x.parsehtml(s) + local v = x.xpath('json(*)/authcacheP13nAjaxAssemblies') + local summaryQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-body', v) + local artistQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-field-artist', v) + local authorQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-field-author', v) + local genresQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-field-genres', v) + local coverQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-field-image2', v) + local statusQuery = x.xpathstring('./span.authcache-p13n-asm-field-node-field-status', v) + + function getField(aurl, query) + if aurl ~= '' then + http.reset() + http.headers.values['X-Authcache'] = '1' + if http.xhr(module.rooturl .. aurl) then + local s = GetBetween(':"', '"}', StreamToString(http.document)) + x.parsehtml(s:gsub('\\"', '"'):gsub('\\/', '/')) + return x.xpathstring(query) + end + end + return '' + end + + mangainfo.summary = getField(summaryQuery, '*') + mangainfo.authors = getField(authorQuery, '//div[contains(@class, "field-item")]') + mangainfo.artists = getField(artistQuery, '//div[contains(@class, "field-item")]') + mangainfo.coverlink = getField(coverQuery, '//img/@src') + mangainfo.genres = getField(genresQuery, 'string-join(//a, ", ")') + + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url .. '?page=all')) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//*[@id="images"]//img[not(contains(@src,"adsense"))]/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + local s = module.rooturl .. '/directory' + if url ~= '0' then s = s .. '?page=' .. url; end + if http.get(s) then + local x = TXQuery.Create(http.Document) + local i = 1 + local v = x.xpath('//ul[@class="pagination"]/li') + for j = 1, v.count do + local v1 = v.get(j) + local x = tonumber(v1.toString) + if (x ~= nil) and (x > i) then i = x; end + end + updatelist.CurrentDirectoryPageNumber = i - 1 + v = x.xpath('//table[contains(@class,"directory_list")]//tr/td[1]/a') + for j = 1, v.count do + local v1 = v.get(j) + local s = v1.toString + if string.match(s:upper(), ' MANGA$') ~= nil then + s = s:sub(1, -7) + end + links.add(v1.getAttribute('href')) + names.add(s) + end + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(site, url) + local m=NewModule() + m.category='English' + m.website=site + m.rooturl=url + m.lastupdated='April 5, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + return m +end + +function Init() + AddWebsiteModule('MangaTail', 'https://www.mangatail.me') + AddWebsiteModule('MangaSail', 'http://www.mangasail.com') +end \ No newline at end of file diff --git a/lua/modules/MangaTown.lua b/lua/modules/MangaTown.lua new file mode 100644 index 000000000..052704796 --- /dev/null +++ b/lua/modules/MangaTown.lua @@ -0,0 +1,76 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1') + mangainfo.coverlink=x.xpathstring('//*[@class="detail_info clearfix"]/img/@src') + mangainfo.authors=x.xpathstring('//*[@class="detail_info clearfix"]/ul/li[starts-with(.,"Author(s):")]/substring-after(.,":")') + mangainfo.artists=x.xpathstring('//*[@class="detail_info clearfix"]/ul/li[starts-with(.,"Artist(s):")]/substring-after(.,":")') + mangainfo.genres=x.xpathstring('//*[@class="detail_info clearfix"]/ul/li[starts-with(.,"Genre(s):")]/substring-after(.,":")') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('//*[@class="detail_info clearfix"]/ul/li[starts-with(.,"Status(s):")]')) + mangainfo.summary=x.xpathstring('//*[@class="detail_info clearfix"]/ul/li/span[@id="show"]/normalize-space(text())') + v=x.xpath('//ul[@class="chapter_list"]/li') + for i=1,v.count do + v2=v.get(i) + mangainfo.chapterlinks.add(x.xpathstring('a/@href',v2)) + mangainfo.chapternames.add(x.xpathstring('string-join((a/text(),span[not(@class)])," ")',v2)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + task.pagenumber=TXQuery.Create(http.Document).xpathcount('(//select[not(@id)])[1]/option[not(contains(@value,"featured.html"))]') + return true + else + return false + end + return true +end + +function getimageurl() + local s=url + if workid>0 then + s=AppendURLDelim(s)..(workid+1)..'.html' + end + if http.get(MaybeFillHost(module.rooturl,s)) then + task.pagelinks[workid]=TXQuery.create(http.document).xpathstring('//*[@id="viewer"]//img[@alt]/@src') + return true + end + return false +end + +function getdirectorypagenumber() + if http.get(module.rooturl..'/directory/?name.az') then + page=TXQuery.Create(http.document).xpathcount('(//select)[last()]/option') + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/directory/'..IncStr(url)..'.htm?name.az') then + TXQuery.Create(http.document).xpathhreftitleall('//ul[@class="manga_pic_list"]/li/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='English' + m.website='MangaTown' + m.rooturl='http://www.mangatown.com' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetimageurl='getimageurl' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/ManhwaCo.lua b/lua/modules/ManhwaCo.lua new file mode 100644 index 000000000..e8579c36a --- /dev/null +++ b/lua/modules/ManhwaCo.lua @@ -0,0 +1,60 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//h4[@class="card-title"]') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//img[contains(@class, "card-img-top")]/@src')) + mangainfo.summary = x.XPathString('//p[@class="card-text"]') + mangainfo.genres = x.XPathStringAll('//div[@class="chip"]') + v=x.xpath('//ul[contains(@class, "list-group")]/li/a') + for i=1,v.count do + v1=v.get(i) + mangainfo.chapterlinks.add(v1.getAttribute('href')) + mangainfo.chapternames.add(x.xpathstring('./text()', v1)) + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="container"]/div/div/img/@src', task.pagelinks) + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/series') then + x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="container"]/div[@class="row"]//h5', names) + x.xpathstringall('//div[@class="container"]//div[contains(@class,"card")]//div/a/@href', links) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + page=1 + return no_error +end + +function Init() + m=NewModule() + m.category='English-Scanlation' + m.website='ManhwaCo' + m.rooturl='https://sleepypandascans.co' + m.lastupdated='February 15, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/MerakiScans.lua b/lua/modules/MerakiScans.lua new file mode 100644 index 000000000..8fae86d3e --- /dev/null +++ b/lua/modules/MerakiScans.lua @@ -0,0 +1,71 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//*[@id="manga_name"]') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@id="cover_img"]/@src')) + mangainfo.authors=x.xpathstring('//ul[@id="detail_list"]/li[contains(., "Author")]/substring-after(., ":")') + mangainfo.artists=x.xpathstring('//ul[@id="detail_list"]/li[contains(., "Artist")]/substring-after(., ":")') + mangainfo.genres=x.xpathstringall('//ul[@id="detail_list"]/li[contains(., "Genres")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//ul[@id="detail_list"]/li[contains(., "Status")]')) + mangainfo.summary=x.xpathstring('//ul[@id="detail_list"]/span') + local v = x.xpath('//table[@id="chapter_table"]//tr') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(MaybeFillHost(module.RootURL, v1.getAttribute("data-href"))) + mangainfo.chapternames.add(x.xpathstring("./td[1]", v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x = TXQuery.Create(http.Document) + local curCh = x.xpathstring('//select[@id="chapter_select"]/option[@selected]/@value') + local s = x.xpathstring('//script[contains(., "images")]') + local slug = Trim(GetBetween("var manga_slug =", ";", s):gsub('"', '')) + s = GetBetween("var images =", ";", s) + x.parsehtml(s) + local v = x.xpath('json(*)()') + for i = 1, v.count do + s = string.format("/manga/%s/%s/%s", slug, curCh, v.get(i).toString) + task.pagelinks.add(MaybeFillHost(module.rooturl, s)) + end + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/manga/') then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//div[@id="all"]/div[@id="listitem"]/a') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getAttribute('href')) + names.add(x.xpathstring('./h1', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'MerakiScans' + m.rooturl = 'https://merakiscans.com' + m.category = 'English-Scanlation' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/Mexat.lua b/lua/modules/Mexat.lua new file mode 100644 index 000000000..3cac90655 --- /dev/null +++ b/lua/modules/Mexat.lua @@ -0,0 +1,60 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//h1[@class="page-title"]') + end + mangainfo.summary = x.xpathstring('//div[@class="archive-meta"]') + x.xpathhrefall('//div[@class="entry"]/table//tr/td[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagecontainerlinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//select[@id="manga_pid"]/option/@value', task.pagecontainerlinks) + task.pagenumber = task.pagecontainerlinks.count + else + return false + end + return true +end + +function getimageurl() + if http.GET(AppendURLDelim(MaybeFillHost(module.RootURL, url)) .. '?pid=' .. task.pagecontainerlinks[workid]) then + local x = TXQuery.Create(http.Document) + task.PageLinks[workid] = x.xpathstring('//div[@class="pic"]/a/img/@src') + return true + else + return false + end +end + +function getnameandlink() + if http.GET(module.RootURL .. '/%D9%82%D8%A7%D8%A6%D9%85%D8%A9-%D8%A7%D9%84%D9%85%D8%A7%D9%86%D8%AC%D8%A7/') then + TXQuery.Create(http.Document).XPathHREFAll('//ul[@class="MangaList"]/li//div[@class="SeriesName"]/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'Mexat' + m.rooturl = 'http://manga.mexat.com' + m.category = 'Arabic-Scanlation' + m.lastupdated='June 23, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.OnGetImageURL = 'getimageurl' +end diff --git a/lua/modules/MyReadingManga.lua b/lua/modules/MyReadingManga.lua new file mode 100644 index 000000000..e215ce6ed --- /dev/null +++ b/lua/modules/MyReadingManga.lua @@ -0,0 +1,82 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//*[contains(@class,"entry-content")]/h2') + if mangainfo.title == '' then + mangainfo.title = Trim(x.XPathString('//*[contains(@class,"entry-content")]/p[starts-with(.,"Title")]/substring-after(.,":")')) + end + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//*[contains(@class,"entry-content")]/p[1]/strong') + end + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//h1[@class="entry-title"]') + end + mangainfo.authors=Trim(x.xpathstring('//*[contains(@class,"entry-content")]/p[starts-with(.,"Author")]/substring-after(.,":")')) + mangainfo.genres=x.xpathstring('//header[@class="entry-header"]/string-join(./p[position()>1]//a,", ")') + mangainfo.chapterlinks.add(mangainfo.url) + mangainfo.chapternames.add(mangainfo.title) + local v = x.xpath('//*[contains(@class,"entry-pagination")]/a') + for i = 1, v.count do + local v1 = v.get(i) + if string.match(v1.toString, '^Next') == nil then + mangainfo.chapterlinks.add(v1.getAttribute('href')); + mangainfo.chapternames.add(mangainfo.title .. ' - ' .. v1.toString); + end + end + if mangainfo.chapternames.count > 1 then + mangainfo.chapternames[0] = mangainfo.chapternames[0] .. ' - 1' + end + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//*[contains(@class,"entry-content")]//img/@data-lazy-src', task.pagelinks) + if task.pagelinks.count == 0 then + x.xpathstringall('//div[@class="separator" and @style]//img/@data-lazy-src', task.pagelinks) + end + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('//*[contains(@class,"archive-pagination")]/ul/li[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl .. '/page/' .. IncStr(url) .. '/') then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//h2[@class="entry-title"]/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'MyReadingManga' + m.rooturl = 'https://myreadingmanga.info' + m.category = 'H-Sites' + m.lastupdated='April 10, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' + m.sortedlist = true +end diff --git a/lua/modules/NHentai.lua b/lua/modules/NHentai.lua new file mode 100644 index 000000000..0dd8e97f2 --- /dev/null +++ b/lua/modules/NHentai.lua @@ -0,0 +1,56 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1') + mangainfo.coverlink=x.xpathstring('//*[@id="cover"]//img/@data-src') + mangainfo.artists=x.xpathstringall('//*[@id="tags"]//a[contains(@href,"/artist/")]/text()') + mangainfo.genres=x.xpathstringall('//*[@id="tags"]//a/text()') + mangainfo.chapterlinks.add(url) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + TXQuery.Create(http.Document).xpathstringall('//*[@class="thumb-container"]//img/@data-src/replace(.,"//t\\.(.+\\d+)t\\.","//i.$1.")',task.pagelinks) + return true + else + return false + end + return true +end + +function getdirectorypagenumber() + if http.get(module.rooturl) then + page=tonumber(TXQuery.Create(http.document).xpathstring('//a[@class="last"]/@href/substring-after(.,"=")')) + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/?page='..IncStr(url)) then + TXQuery.Create(http.document).xpathhrefall('//*[@id="content"]/div/div[@class="gallery"]/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='H-Sites' + m.website='NHentai' + m.rooturl='https://nhentai.net' + m.lastupdated='February 17, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' + m.sortedlist=true +end diff --git a/lua/modules/NeuManga.lua b/lua/modules/NeuManga.lua new file mode 100644 index 000000000..d8505cf1c --- /dev/null +++ b/lua/modules/NeuManga.lua @@ -0,0 +1,61 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.Document) + if mangainfo.title == '' then + mangainfo.title=x.XPathString('//h1[@itemprop="headline"]') + mangainfo.title=mangainfo.title:gsub('^Baca Manga','') + mangainfo.title=mangainfo.title:gsub('Bahasa Indonesia$','') + end + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//img[@class="imagemg"]/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//span[@class="hentry"]/span[contains(., "Status")]/a')) + mangainfo.authors = x.XPathStringAll('//span[@class="hentry"]/span[contains(., "Author")]/a') + mangainfo.artists = x.XPathStringAll('//span[@class="hentry"]/span[contains(., "Artist")]/a') + mangainfo.genres = x.XPathStringAll('//span[@class="hentry"]/span[contains(., "Genre")]/a') + mangainfo.summary = x.XPathStringAll('//div[contains(@class,"summary")]/text()', '') + local v=x.xpath('//div[@id="scans"]//div[@class="item-content"]/a') + for i=1, v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getAttribute('href')) + mangainfo.chapternames.add(x.xpathstring('h3', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber = 0 + http.cookies.values['age_confirmed'] = '1' + local u = AppendURLDelim(MaybeFillHost(module.rooturl,url)) .. '_/1' + if http.get(u) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[@class="imagechap"]/@data-src', task.pagelinks) + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/manga') then + x=TXQuery.Create(http.Document) + x.xpathhrefall('//div[@class="alplist"]/li/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Indonesian' + m.website='NeuManga' + m.rooturl='https://neumanga.tv' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' +end \ No newline at end of file diff --git a/lua/modules/NiAdd.lua b/lua/modules/NiAdd.lua new file mode 100644 index 000000000..40e75e640 --- /dev/null +++ b/lua/modules/NiAdd.lua @@ -0,0 +1,75 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('css("h1.manga-title")') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('css("img.detail-cover")/@src')) + mangainfo.authors=x.xpathstringall('//*[@itemprop="author" and contains(span, "Author")]/a') + mangainfo.artists=x.xpathstringall('//*[@itemprop="author" and contains(span, "Artist")]/a') + mangainfo.genres=x.xpathstringall('//*[contains(span, "Genres")]/a') + mangainfo.status=MangaInfoStatusIfPos(x.xpathstring('css(".status-tag")')) + mangainfo.summary=x.xpathstring('css(".summary-box")/span[@itemprop]') + x.xpathhreftitleall('css("ul.detail-chlist > a")', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + task.pagenumber = x.xpathcount('(//div[contains(@class, "mangaread-pagenav")])[1]/select[@class="sl-page"]/option') + else + return false + end + return true +end + +function getnameandlink() + local s = string.format("/category/index_%s.html?sort=name", IncStr(url)) + if http.get(module.rooturl .. s) then + local x = TXQuery.Create(http.Document) + local p=x.xpathstring('//div[@class="page-nav"]/a[last()-1]') + p = tonumber(p) + if p ~= nil then + updatelist.CurrentDirectoryPageNumber = p + end + x.XPathHREFAll('css("p.title > a")', links, names) + return no_error + else + return net_problem + end +end + +function getimageurl() + local s = MaybeFillHost(module.RootURL, url) + s = string.format('%s-%s.html', s:gsub('/$', ''), IncStr(workid)) + if http.GET(s) then + local x = TXQuery.Create(http.Document) + task.pagelinks[workid] = x.xpathstring('css("img.manga_pic")/@src') + return true + else + return false + end +end + +function AddWebsiteModule(name, url, cat) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = cat + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl = 'getimageurl' +end + +function Init() + AddWebsiteModule('NiAdd', 'https://www.niadd.com', 'English') +end \ No newline at end of file diff --git a/lua/modules/PlusComico.lua b/lua/modules/PlusComico.lua new file mode 100644 index 000000000..da3061019 --- /dev/null +++ b/lua/modules/PlusComico.lua @@ -0,0 +1,169 @@ +function getinfo_store() + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="_title"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//meta[@property="og:image"]/@content')) + mangainfo.authors=x.xpathstring('//*[contains(@class,"__author")]') + mangainfo.genres=x.xpathstringall('//li[contains(@class,"__list-genre-item")]/p/a') + mangainfo.summary=x.xpathstring('//p[@class="_description"]') + local id = mangainfo.url:match('/(%d+)/?$') + http.reset() + if http.post(module.rooturl .. '/store/api/getTitleArticles.nhn', 'titleNo='..id) then + x.parsehtml(http.document) + local v = x.xpath('json(*).result.list().articleList()') + for i = 1, v.count do + local v1 = v.get(i) + if x.xpathstring('./freeFlg', v1) == 'Y' then + mangainfo.chapterlinks.add(x.xpathstring('./articleDetailUrl', v1)) + mangainfo.chapternames.add(x.xpathstring('./subtitle', v1)) + end + end + end +end + +function getinfo_manga() + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//*[contains(@class,"__ttl")]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//meta[@property="og:image"]/@content')) + mangainfo.authors=x.xpathstring('//*[contains(@class,"__author")]') + mangainfo.genres=x.xpathstringall('//*[contains(@class,"__meta")]//a') + mangainfo.summary=x.xpathstring('//*[contains(@class,"__description")]') + local id = mangainfo.url:match('/(%d+)/?$') + http.reset() + if http.post(module.rooturl .. '/api/getArticleList.nhn', 'titleNo='..id) then + x.parsehtml(http.document) + local v = x.xpath('json(*).result.list()') + for i = 1, v.count do + local v1 = v.get(i) + if x.xpathstring('./freeFlg', v1) == 'Y' then + mangainfo.chapterlinks.add(x.xpathstring('./articleDetailUrl', v1)) + mangainfo.chapternames.add(x.xpathstring('./subtitle', v1)) + end + end + end +end + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + if mangainfo.url:match('/store/') ~= nil then + getinfo_store() + else + getinfo_manga() + end + return no_error + else + return net_problem + end +end + +function getpagenumber_manga() + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "imageData:")]') + s = GetBetween('imageData:', ']', s) .. ']' + x.parsehtml(s) + x.xpathstringall('json(*)()', task.pagelinks) + return true +end + +function getpagenumber_store() + if http.lasturl:match('param=') == nil then return false; end + local base = SeparateLeft(http.lasturl, 'index.php') + local param = GetBetween('param=', '&', http.lasturl) + local ts = os.time() * 1000 + base = base .. string.format('diazepam_hybrid.php?reqtype=0¶m=%s&ts=%d&_=%d', param, ts, ts+1500) + math.randomseed(os.time()) + math.random(); math.random(); math.random(); + local tpurl = string.format('&mode=7&file=face.xml&callback=jQ%d_%d', math.random(1000), math.random(1000)) + if http.get(base .. tpurl) then + if http.terminated then return false; end + local s = GetBetween('("', '")', StreamToString(http.document)) + local x=TXQuery.Create(s) + local total_pages = tonumber(x.xpathstring('//TotalPage')) + if total_pages == nil then return false; end + for i = 0, total_pages-1 do + task.pagelinks.add(base .. string.format('&mode=8&file=%04d.xml', i)) + end + task.pagecontainerlinks.text = http.cookies.text + else + return false + end + return false +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + if url:match('/store/') ~= nil then + return getpagenumber_store() + else + return getpagenumber_manga() + end + else + return false + end +end + +local js = require 'modules.jsunpack' +function downloadimage() + if url:match('%.xml') == nil then return http.get(url); end + http.cookies.text = task.pagecontainerlinks.text + if http.get(url) then + local x = TXQuery.Create(http.Document) + local a = js.splitstr(x.xpathstring('//Scramble'), ',') + local imgurl = SeparateLeft(url, '&mode=') + imgurl = imgurl .. string.format('&mode=1&file=%04d_0000.bin', workid) + if http.get(imgurl) then + local s = TImagePuzzle.Create(4, 4) + s.multiply = 8 + local n = 0 + for i, v in ipairs(a) do + local j = tonumber(v) + if j == nil then j = 0 end + s.matrix[j] = n; + n = n + 1 + end + s.descramble(http.document, http.document) + return true + end + return false + end + return false +end + +local dirurls = { +-- '/store/ranking/list.nhn', + '/manga/ranking/list.nhn' +} + +function getnameandlink() + local lurl = dirurls[module.CurrentDirectoryIndex+1] + local data = 'page='..IncStr(url)..'&rankingType=original' + if http.post(module.rooturl .. lurl, data) then + local x = TXQuery.Create(http.Document) + local total = tonumber(x.xpathstring('json(*).result.totalPageCnt')) + if total == nil then total = 1 end + updatelist.CurrentDirectoryPageNumber = total + local v = x.xpath('json(*).result.list()') + for i = 1, v.count do + local v1 = v.get(i) + links.add(x.xpathstring('title_url', v1)) + names.add(x.xpathstring('title_name', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'PlusComico' + m.rooturl = 'http://plus.comico.jp' + m.category = 'Raw' + m.lastupdated='May 1, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.totaldirectory = #dirurls + m.ondownloadimage = 'downloadimage' +end diff --git a/lua/modules/Pururin.lua b/lua/modules/Pururin.lua new file mode 100644 index 000000000..33ab55f95 --- /dev/null +++ b/lua/modules/Pururin.lua @@ -0,0 +1,73 @@ +local domain = 'pururin.io' + +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//*[@class="title"]/h1') + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//*[@class="cover-wrapper"]//v-lazy-image/@src')) + mangainfo.artists = x.XPathStringAll('//table[contains(@class,"table-gallery-info")]//tr/td[contains(.,"Artist")]/following-sibling::td//a') + mangainfo.genres = x.XPathStringAll('//table[contains(@class,"table-gallery-info")]//tr/td[contains(.,"Contents")]/following-sibling::td//a') + mangainfo.chapterlinks.add(x.XPathString('//*[@class="gallery-action"]/a/@href')) + mangainfo.chapternames.add(mangainfo.title) + return no_error + else + return net_problem + end +end + +function GetPageNumber() + local path = 'https://api.' .. domain .. '/images' + if http.get(MaybeFillHost(module.rooturl,url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//gallery-read/@gallery') + x.parsehtml(s) + local ext = x.xpathstring('json(*).image_extension') + local cnt = x.xpathstring('json(*).total_pages') + local id = x.xpathstring('json(*).id') + for i = 1, cnt do + task.pagelinks.add(string.format('%s/%s/%d.%s', path, id, i, ext)) + end + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl..'/browse/newest?page='..IncStr(url)) then + local x=TXQuery.Create(http.Document) + local v=x.xpath('//*[@class="row-gallery"]/a') + for i=1,v.count do + local v1 = v.get(i) + links.add(v1.getAttribute('href')) + names.add(x.xpathstring('.//*[@class="title"]/text()[1]', v1)) + end + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//ul[contains(@class,"pagination")]/li[last()-1]')) + if page == nil then page = 1 end + return true + else + return false + end +end + +function Init() + m=NewModule() + m.category='H-Sites' + m.website='Pururin' + m.rooturl='https://' .. domain + m.sortedlist=true + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/ReadComicBooksOnline.lua b/lua/modules/ReadComicBooksOnline.lua new file mode 100644 index 000000000..3f6098e85 --- /dev/null +++ b/lua/modules/ReadComicBooksOnline.lua @@ -0,0 +1,75 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//h1[@class="page-title"]') + end + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[@class="series"]/@src')) + mangainfo.authors=x.xpathstringall('//li[@class="info" and contains(*, "Author")]/text()', '') + mangainfo.artists = mangainfo.authors + mangainfo.genres=x.xpathstringall('//li[@class="info" and contains(*, "Genre")]/text()', '') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstringall('//li[@class="info" and contains(*, "Status")]/text()', '')) + mangainfo.summary=x.xpathstringall('//li[@class="summary"]/text()', '') + x.xpathhrefall('//div[@id="chapterlist"]/li/a',mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + http.reset() + http.headers.values['Referer'] = mangainfo.url + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + task.pagenumber = x.xpathcount('(//select[@name="page"])[1]/option') + else + return false + end + return true +end + +function getimageurl() + local lurl=MaybeFillHost(module.rooturl,url) + if workid~=0 then lurl=lurl..'/'..(workid+1) end + if http.get(lurl) then + local x=TXQuery.Create(http.Document) + local base = x.xpathstring("//base/@href") + task.pagelinks[workid]=MaybeFillHost(base, x.xpathstring('//img[@class="picture"]/@src')) + return true + else + return false + end +end + +function beforedownloadimage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/comics-list') then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@id="content-wrap"]//table//tr/td/div/span/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'ReadComicBooksOnline' + m.rooturl = 'https://readcomicbooksonline.org' + m.category = 'English' + m.lastupdated='April 26, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl='getimageurl' + m.onbeforedownloadimage = 'beforedownloadimage' +end diff --git a/lua/modules/ReadMangaEU.lua b/lua/modules/ReadMangaEU.lua new file mode 100644 index 000000000..439c0b693 --- /dev/null +++ b/lua/modules/ReadMangaEU.lua @@ -0,0 +1,60 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1[@class="ebook_title"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//img[contains(@class, "ebook_cover")]/@src')) + mangainfo.authors=x.xpathstring('//table[@class="details_table"]/tbody/tr[contains(td, "Author")]/td[2]') + mangainfo.genres=x.xpathstringall('//table[@class="details_table"]/tbody/tr[contains(td, "Genres")]/td[2]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//table[@class="details_table"]/tbody/tr[contains(td, "Status")]/td[2]')) + mangainfo.summary=x.xpathstring('//*[@class="ebook_description"]') + x.xpathhrefall('//div[contains(@class,"chapters")]/span[not(@id="show_all")]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + task.pagenumber=TXQuery.Create(http.Document).xpathcount('//select[@id="jumpto"]/option') + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/manga-list') then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//ul[@class="ul_list"]/li/a', links, names) + return no_error + else + return net_problem + end +end + +function getimageurl() + if http.get(MaybeFillHost(module.rooturl,url):gsub('%d+$',tostring(workid+1))) then + local x = TXQuery.create(http.document) + local s = x.xpathstring('//img[contains(@class, "ebook_img")]/@src') + task.pagelinks[workid] = MaybeFillHost(module.rooturl, s) + return true + end + return false +end + +function Init() + local m = NewModule() + m.website = 'ReadMangaEU' + m.rooturl = 'http://www.readmanga.eu' + m.category = 'English' + m.lastupdated='March 1, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl='getimageurl' +end diff --git a/lua/modules/SKSubs.lua b/lua/modules/SKSubs.lua new file mode 100644 index 000000000..f49f2238f --- /dev/null +++ b/lua/modules/SKSubs.lua @@ -0,0 +1,74 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//div[contains(@class,"thumbnail")]/div[1]/img/@src')) + mangainfo.title=x.xpathstring('//div[contains(@class,"thumbnail")]/div[2]/div[1]/h1') + mangainfo.genres=x.xpathstring('//div[contains(@class,"thumbnail")]/div[2]/div[1]/string-join(./a,", ")') + mangainfo.summary=x.xpathstring('//div[contains(@class,"thumbnail")]/div[2]/div[1]/p/substring-after(.,"Sinopsis: ")') + local lurl='' + while true do + x.xpathstringall('//ul[contains(@class,"list-group")]/a/@href',mangainfo.chapterlinks) + x.xpathstringall('//ul[contains(@class,"list-group")]/a/text()[1]',mangainfo.chapternames) + lurl=x.xpathstring('//ul[@class="pagination"]/li[@class="active"]/following-sibling::li[not(@class)]/a/@href') + if http.terminated then break end; + if lurl~='' then + if http.get(MaybeFillHost(module.rooturl,lurl)) then + x.parsehtml(http.document) + else + break + end + else + break + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + task.pagenumber=tonumber(x.xpathstring('//ul[@class="pagination"]/li[not(./a/@rel)][last()]')) + return true + else + return false + end +end + +function getimageurl() + local lurl=MaybeFillHost(module.rooturl,url) + if workid~=0 then lurl=lurl..'/?page='..workid+1 end + if http.get(lurl) then + x=TXQuery.Create(http.Document) + task.pagelinks[workid]=MaybeFillHost(module.rooturl,x.xpathstring('//div[@class="card-body"]//img/@src')) + return true + else + return false + end +end + +function getnameandlink() + if http.get(module.rooturl..'/novelas') then + x=TXQuery.Create(http.Document) + x.xpathhrefall('//div[contains(@class,"thumbnail")]/div[2]/div[1]/a[1]', links, names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Spanish-Scanlation' + m.website='SKSubs' + m.rooturl='http://sksubs.com' + m.lastupdated='February 28, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetimageurl='getimageurl' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/Shakai.lua b/lua/modules/Shakai.lua new file mode 100644 index 000000000..aa0057598 --- /dev/null +++ b/lua/modules/Shakai.lua @@ -0,0 +1,100 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if Pos('/element-list', mangainfo.url) > 0 then + mangainfo.url = mangainfo.url:gsub('/element%-list$', '') + end + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//*[@class="wrapper__heading"]/h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="make__cover"]/img/@src')) + mangainfo.authors=x.xpathstringall('//table[@class="make__table-info"]//tr[contains(td, "Автор")]/td/a') + mangainfo.genres=x.xpathstringall('//table[@class="make__table-info"]//tr[contains(td, "Жанры")]/td/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//table[@class="make__table-info"]//tr[contains(td, "Выпуск")]/td'), 'продолжается', 'завершен') + mangainfo.summary=x.xpathstring('//div[@class="make__description"]') + if http.get(mangainfo.url .. '/element-list') then + x.parsehtml(http.document) + local v = x.xpath('//div[@class="post-element__description"]') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(x.xpathstring('div[@class="post-element__action"]/a/@href', v1)) + mangainfo.chapternames.add(x.xpathstring('div[@class="post-element__meta"]', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + local id, chapter = url:match('read/([^/]+)/([^/]+)/') + local data = 'dataRun=api-manga&dataRequest=' .. id + if http.post(module.rooturl .. '/take/api-manga/request/shakai', data) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('json(*).data()[data-first="' .. chapter .. '"].data-second()') + for i = 1, v.count do + local v1 = v.get(i) + task.pagelinks.add(v1.tostring) + end + else + return false + end + return true +end + +local cataloguri = '/take/catalog/request/shakai' +function getquery(page) + local query = 'dataRun=catalog&selectCatalog=manga&searchData=&' .. + 'selectPage=%s&' .. + '&itemMarker=%s&' .. + 'dataModeration=&dataSorting=po-alfavitu,false,false,false,false,false,false&' .. + 'dataType=false,false,false,false,false,false,false,false&dataStatus=false,false,false,false&' .. + 'dataList=&dataGenre=false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false,false&dataSeason=false,false,false,false,false,false' + return string.format(query, page, os.date("!%Y-%m-%d %X")) +end + +function getnameandlink() + if tonumber(url) < 0 then return no_error end + if http.post(module.RootURL .. cataloguri, getquery(IncStr(url))) then + local s = StreamToString(http.document):gsub('"', '\\"') + local x = TXQuery.Create(s) + local v = x.xpath('json(*).result()') + for i = 1, v.count do + local v1 = v.get(i) + links.add(x.xpathstring('output-link', v1)) + names.add(x.xpathstring('output-name', v1)) + end + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.post(module.RootURL .. cataloguri, getquery('1')) then + local s = StreamToString(http.document):gsub('"', '\\"') + local x = TXQuery.Create(s) + page = tonumber(x.xpathstring('json(*).create')) + if page == nil then page = 1; end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'Shakai' + m.rooturl = 'http://shakai.ru' + m.category = 'Russian' + m.lastupdated='March 6, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber = 'getdirectorypagenumber' +end \ No newline at end of file diff --git a/lua/modules/SiberOwl.lua b/lua/modules/SiberOwl.lua new file mode 100644 index 000000000..3dbbd4e39 --- /dev/null +++ b/lua/modules/SiberOwl.lua @@ -0,0 +1,64 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + local s = x.xpathstring('//script[contains(., "var description")]') + mangainfo.title = GetBetween('title="', '";', s) + mangainfo.coverlink = MaybeFillHost(module.rooturl, GetBetween('imageUrl="', '";', s)) + mangainfo.summary = GetBetween('description="', '";', s) + s = GetBetween('chapString="', '";', s) + x.parsehtml(s) + local v = x.xpath('//a') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(mangainfo.url .. '/' .. v1.getattribute('href')) + mangainfo.chapternames.add(v1.toString) + end + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "imageUrls")]') + x.parsehtml(GetBetween('imageUrls =', ';', s)) + local v = x.xpath('json(*)()') + for i = 1, v.count do + task.pagelinks.add(MaybeFillHost(module.rooturl, v.get(i).toString)) + end + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//div[@class="index-mangas"]/div/a') + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('.//div[@class="index-manga-title"]', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'SiberOwl' + m.rooturl = 'http://siberowl.com' + m.category = 'English-Scanlation' + m.lastupdated='April 10, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/SoManga.lua b/lua/modules/SoManga.lua new file mode 100644 index 000000000..30ec826e5 --- /dev/null +++ b/lua/modules/SoManga.lua @@ -0,0 +1,61 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[contains(@class, "manga")]//img/@src')) + mangainfo.authors=x.xpathstringall('//div[contains(@class, "manga")]//h5[contains(*, "Autor")]/text()', '') + mangainfo.artists=x.xpathstringall('//div[contains(@class, "manga")]//h5[contains(*, "Artista")]/text()', '') + mangainfo.genres=x.xpathstringall('//div[contains(@class, "manga")]//h5[contains(*, "Genero")]/span') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[contains(@class, "manga")]//h5[contains(*, "Status")]/text()'), 'Ativo', 'Completo') + mangainfo.summary=x.xpathstring('//div[contains(@class, "manga")]//div[contains(@style, "justify")]') + local v=x.xpath('//ul[@class="capitulos"]/li/a') + for i=1,v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('div/text()', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[contains(@class, "img-manga")]/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/php/busca-mangas.php') then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//ul/li[@class="mangas"]/div/a', links, names) + for i=1,v.count do + local v1=v.get(i) + links.add(v1.getattribute('href')) + names.add(x.xpathstring('div/h3', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'SoManga' + m.rooturl = 'http://somangas.net' + m.category = 'Portugues' + m.lastupdated='March 1, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/SubManga.lua b/lua/modules/SubManga.lua new file mode 100644 index 000000000..6bdab9b3b --- /dev/null +++ b/lua/modules/SubManga.lua @@ -0,0 +1,61 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = Trim(x.XPathString('//div[contains(@class, "col-md-3")]//h3/text()')) + end + mangainfo.coverlink = x.xpathstring('//div[contains(@class, "col-md-3")]//img[@class="img-responsive"]/@src') + mangainfo.authors=Trim(x.xpathstring('//span[@class="list-group-item" and contains(., "Autor")]/a')) + mangainfo.artists=Trim(x.xpathstring('//span[@class="list-group-item" and contains(., "Artist")]/a')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//span[@class="list-group-item" and contains(., "Estado")]')) + mangainfo.summary = x.xpathstringall('//span[@class="list-group-item" and contains(., "Resumen")]/text()', '') + x.xpathhrefall('//table//tr/td[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + http.reset() + http.headers.values['Referer'] = mangainfo.url + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagecontainerlinks.clear() + local url = MaybeFillHost(module.rooturl, url); + if http.get(url) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//*[@id="all"]/img/@data-src', task.pagelinks) + task.pagecontainerlinks.text = url + else + return false + end + return true +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = task.pagecontainerlinks.text + return true +end + +function getnameandlink() + if http.GET(module.RootURL .. '/changeMangaList?type=text') then + TXQuery.Create(http.Document).XPathHREFAll('//li/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'SubManga' + m.rooturl = 'https://submanga.online' + m.category = 'Spanish' + m.lastupdated='May 26, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' +end diff --git a/lua/modules/TenManga.lua b/lua/modules/TenManga.lua new file mode 100644 index 000000000..b64b2a03d --- /dev/null +++ b/lua/modules/TenManga.lua @@ -0,0 +1,84 @@ +local ALPHA_LIST_UP = '#ABCDEFGHIJKLMNOPQRSTUVWXYZ' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if Pos('waring', url) == 0 then mangainfo.url = mangainfo.url .. '?waring=1' end + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//div[@class="book-info"]/h1/substring-before(., " Manga")') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//div[@class="book-info"]//img/@src')) + mangainfo.authors=x.xpathstringall('//dd[@class="about-book"]/p[contains(span, "Author")]/a') + mangainfo.genres=x.xpathstringall('//div[@class="book-info"]/ul/li[position()>1]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//dd[@class="about-book"]/p[contains(span, "Status")]/a')) + mangainfo.summary=x.xpathstring('//dd[@class="short-info"]/p/span') + local v=x.xpath('//ul[@class="chapter-box"]/li/div[@class="chapter-name long"]/a') + for i=1,v.count do + local v1=v.get(i) + mangainfo.chapterlinks.add(v1.getattribute('href')) + mangainfo.chapternames.add(x.xpathstring('text()', v1)) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber=0 + if http.get(MaybeFillHost(module.rooturl, url)) then + task.pagenumber=TXQuery.Create(http.Document).xpathcount('(//select[@class="sl-page"])[1]/option') + module.storage.text = http.cookies.text + else + return false + end + return true +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getimageurl() + http.headers.values['Referer'] = module.rooturl + http.cookies.text = module.storage.text + if http.get(MaybeFillHost(module.rooturl,url):gsub('/?$','-'..(workid+1)..'.html')) then + task.pagelinks[workid]=TXQuery.create(http.document).xpathstring('//img[contains(@class, "manga_pic")]/@src') + return true + end + return false +end + +function getnameandlink() + local s = '0-9' + if module.CurrentDirectoryIndex ~= 0 then + s = ALPHA_LIST_UP:sub(module.CurrentDirectoryIndex+1,module.CurrentDirectoryIndex+1) + end + if http.get(module.rooturl .. '/category/' .. s .. '_views_' .. IncStr(url) .. '.html') then + local x = TXQuery.Create(http.Document) + local q = '//ul[@id="list_container"]/li/dl/dt/a' + x.XPathHREFtitleAll(q, links, names) + if x.xpathcount(q) > 0 then + updatelist.CurrentDirectoryPageNumber = updatelist.CurrentDirectoryPageNumber + 1 + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'TenManga' + m.rooturl = 'http://www.tenmanga.com' + m.category = 'English' + m.lastupdated='February 26, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetimageurl='getimageurl' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' + m.totaldirectory = ALPHA_LIST_UP:len() +end diff --git a/lua/modules/TimelessLeaf.lua b/lua/modules/TimelessLeaf.lua new file mode 100644 index 000000000..15ea47072 --- /dev/null +++ b/lua/modules/TimelessLeaf.lua @@ -0,0 +1,45 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h1[@class="entry-title"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//article//img/@src')) + mangainfo.summary=x.xpathstringall('//div[@class="entry-content page-content"]/p[not(contains(., "Chapter"))]/text()', '') + x.xpathhrefall('//div[@class="entry-content page-content"]/p/a',mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagenumber = 0 + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//figure[@class="gallery-item"]//img/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.rooturl .. '/comic-list') then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//a[.="Manga"]/following-sibling::ul//li/a[not(contains(@href,"more"))]', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'TimelessLeaf' + m.rooturl = 'https://timelessleaf.com' + m.category = 'English-Scanlation' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end \ No newline at end of file diff --git a/lua/modules/Toonkor.lua b/lua/modules/Toonkor.lua new file mode 100644 index 000000000..a239e83d1 --- /dev/null +++ b/lua/modules/Toonkor.lua @@ -0,0 +1,72 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//table[@class="bt_view1"]//td[@class="bt_title"]') + mangainfo.coverlink=MaybeFillHost(module.RootURL, x.xpathstring('//table[@class="bt_view1"]//td[@class="bt_thumb"]//img/@src')) + mangainfo.authors=x.xpathstring('//table[@class="bt_view1"]//span[.="작가"]/following-sibling::span[@class="bt_data"]') + mangainfo.summary=x.xpathstring('//table[@class="bt_view1"]//td[@class="bt_over"]') + local v = x.xpath('//table[@class="web_list"]//tr/td[@class="content__title"]') + for i = 1, v.count do + local v1 = v.get(i) + mangainfo.chapterlinks.add(v1.getAttribute('data-role')) + mangainfo.chapternames.add(v1.toString) + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "toon_img")]') + x.parsehtml(DecodeBase64(GetBetween("toon_img = '", "';", s))) + local v = x.xpath('//img/@src') + for i = 1, v.count do + task.pagelinks.add(MaybeFillHost(module.RootURL, v.get(i).toString)) + end + task.pagecontainerlinks.values[0] = http.cookies.text + else + return false + end + return true +end + +local dirurls = { + '/%EC%9B%B9%ED%88%B0' +} + +function getnameandlink() + local lurl = dirurls[module.CurrentDirectoryIndex+1] + if http.get(module.rooturl .. lurl) then + local x = TXQuery.Create(http.Document) + x.xpathhrefall('//ul[contains(@class, "homelist")]/li/div//a[@id="title"]', links, names) + return no_error + else + return net_problem + end +end + +function beforedownloadimage() + http.reset() + http.cookies.text = task.pagecontainerlinks.values[0] + http.headers.values['Referer'] = module.rooturl + return true +end + +function Init() + local m = NewModule() + m.category = 'Raw' + m.Website = 'Toonkor' + m.RootURL = 'https://toonkor.co' + m.lastupdated='June 6, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.onbeforedownloadimage='beforedownloadimage' + m.totaldirectory = #dirurls +end diff --git a/lua/modules/TruyenChon.lua b/lua/modules/TruyenChon.lua new file mode 100644 index 000000000..c72536ab2 --- /dev/null +++ b/lua/modules/TruyenChon.lua @@ -0,0 +1,77 @@ +local dirurl = { + ['TruyenChon'] = '/the-loai?status=-1&sort=15&page=%s', + ['NetTruyen'] = '/tim-truyen?status=-1&sort=15&page=%s' +} + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//h1[@class="title-detail"]') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//div[contains(@class, "col-image")]/img/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//li[contains(@class, "status")]/p[2]'), 'Đang tiến hành', 'Hoàn thành') + mangainfo.authors=x.xpathstring('//li[contains(@class, "author")]/p[2]') + mangainfo.artists=x.xpathstring('//h4[starts-with(./label,"Artista")]/substring-after(.,":")') + mangainfo.genres=x.xpathstringall('//li[contains(@class, "kind")]/p[2]/a') + mangainfo.summary=x.xpathstring('//div[@class="detail-content"]/p') + x.xpathhrefall('//div[@class="list-chapter"]//ul/li/div[contains(@class, "chapter")]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//div[@class="page-chapter"]/img/@data-original', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + if http.get(module.RootURL .. dirurl[module.website]:format(IncStr(url))) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[@class="item"]//h3/a', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. dirurl[module.website]:format('1')) then + local x = TXQuery.Create(http.Document) + local s = x.xpathstring('//ul[@class="pagination"]/li[last()]/a/@href') + page = tonumber(s:match('&page=(%d+)')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url) + local m=NewModule() + m.category='Vietnamese' + m.website=name + m.rooturl=url + m.lastupdated='June 15, 2018' + m.sortedlist = true + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber='getdirectorypagenumber' + return m +end + +function Init() + AddWebsiteModule('TruyenChon', 'http://truyenchon.com') + AddWebsiteModule('NetTruyen', 'http://www.nettruyen.com') +end diff --git a/lua/modules/TruyenTranhTuan.lua b/lua/modules/TruyenTranhTuan.lua new file mode 100644 index 000000000..6ca7370b0 --- /dev/null +++ b/lua/modules/TruyenTranhTuan.lua @@ -0,0 +1,78 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//h1[@itemprop="name"]') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//*[@class="manga-cover"]/img/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//li[contains(@class, "status")]/p[2]'), 'Đang tiến hành', 'Hoàn thành') + mangainfo.authors=x.xpathstringall('//p[@class="misc-infor" and starts-with(.,"Tác giả")]/a') + mangainfo.genres=x.xpathstringall('//p[@class="misc-infor" and starts-with(.,"Thể loại")]/a') + mangainfo.summary=x.xpathstring('//*[@id="manga-summary"]/p') + x.xpathhrefall('//*[@id="manga-chapter"]//*[@class="chapter-name"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x = TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(.,"var slides_page")]') + x.parsehtml(GetBetween('slides_page_path = ', ';', s)) + local v = x.xpath('json(*)()') + if v.count > 0 then + local tmp = {} + for i = 1, v.count do + table.insert(tmp, v.get(i).toString) + end + table.sort(tmp) + for i, link in ipairs(tmp) do + task.pagelinks.add(link) + end + else + x.parsehtml(GetBetween('slides_page_url_path = ', ';', s)) + local v = x.xpathstringall('json(*)()', task.pagelinks) + end + else + return false + end + return true +end + +function getnameandlink() + local s = module.RootURL + if url ~= '0' then + s = s .. '/page/' .. IncStr(url) + end + if http.get(s) then + local x = TXQuery.Create(http.Document) + local p = 1 + local v = x.xpath('//*[@id="page-nav"]//li') + for i = 1, v.count do + local tmp = tonumber(v.get(i).toString) + if tmp == nil then tmp = 1; end + if tmp > p then p = tmp; end + end + updatelist.CurrentDirectoryPageNumber = p + x.XPathHREFAll('//*[@id="story-list"]/div/span[1]/a', links, names) + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='Vietnamese' + m.website='TruyenTranhTuan' + m.rooturl='http://truyentranhtuan.com' + m.lastupdated='June 20, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/TuMangaOnline.lua b/lua/modules/TuMangaOnline.lua new file mode 100644 index 000000000..b9488c593 --- /dev/null +++ b/lua/modules/TuMangaOnline.lua @@ -0,0 +1,88 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = Trim(x.XPathString('//h1[contains(@class, "element-title")]/text()')) + end + mangainfo.coverlink = x.xpathstring('//img[contains(@class,"book-thumbnail")]/@src') + mangainfo.genres=x.xpathstringall('//a[contains(@class, "badge")]') + mangainfo.authors=Trim(x.xpathstring('//span[@class="list-group-item" and contains(., "Autor")]/a')) + mangainfo.artists=Trim(x.xpathstring('//span[@class="list-group-item" and contains(., "Artist")]/a')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//span[contains(@class, "book-status")]'), 'public', 'final') + mangainfo.summary = x.xpathstringall('//*[@class="element-description"]/text()', '') + local v = x.xpath('//div[contains(@class, "chapters")]/ul//li') + for i = 1, v.count do + local v1 = v.get(i) + local name = x.xpathstring('h4', v1) + local w = x.xpath('div//ul/li/div', v1) + for j = 1, w.count do + local w1 = w.get(j) + local scan = '[' .. x.xpathstring('div[1]', w1) .. ']' + mangainfo.chapterlinks.add(x.xpathstring('div[contains(@class, "text-right")]/a/@href', w1)) + mangainfo.chapternames.add(name .. ' ' .. scan) + end + end + if mangainfo.chapterlinks.count == 0 then + local w = x.xpath('//ul[contains(@class, "chapter-list")]/li/div') + for j = 1, w.count do + local w1 = w.get(j) + local scan = '[' .. x.xpathstring('div[1]', w1) .. ']' + mangainfo.chapterlinks.add(x.xpathstring('div[contains(@class, "text-right")]/a/@href', w1)) + mangainfo.chapternames.add(mangainfo.title .. ' ' .. scan) + end + end + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + task.pagecontainerlinks.clear() + http.headers.values['Referer'] = module.rooturl + if not http.get(MaybeFillHost(module.rooturl, url)) then return false; end + if http.lasturl:match('paginated$') ~= nil then + if not http.get(http.lasturl:gsub('paginated$', 'cascade')) then return false; end + end + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[contains(@class, "viewer-image")]/@src', task.pagelinks) + task.pagecontainerlinks.text = http.lasturl + return true +end + +function getnameandlink() + local s = '/library?order_item=alphabetically&order_dir=asc&filter_by=title&page='..IncStr(url) + if http.GET(module.RootURL .. s) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//*[@data-identifier]/a') + local hasTitles = false + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getAttribute('href')) + names.add(x.xpathstring('div/div[@class="thumbnail-title"]', v1)) + hasTitles = true + end + if hasTitles then + updatelist.CurrentDirectoryPageNumber = updatelist.CurrentDirectoryPageNumber + 1 + end + return no_error + else + return net_problem + end +end + +function Init() + local m = NewModule() + m.website = 'Tumangaonline' + m.rooturl = 'https://tmofans.com' + m.category = 'Spanish' + m.lastupdated='June 14, 2018' + m.maxtasklimit = 1 + m.maxconnectionlimit = 1 + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' +end diff --git a/lua/modules/UnionMangas.lua b/lua/modules/UnionMangas.lua new file mode 100644 index 000000000..4afdb2dcb --- /dev/null +++ b/lua/modules/UnionMangas.lua @@ -0,0 +1,68 @@ +local dirurl = '/mangas' + +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + local x=TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title = x.xpathstring('//title/substring-before(.," - Union Mangás")') + end + mangainfo.coverlink = MaybeFillHost(module.rooturl, x.xpathstring('//img[@class="img-thumbnail"]/@src')) + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="table"]/div[@class="row"]/div[6]'), 'En Cours', 'Termine') + mangainfo.authors=x.xpathstring('//h4[starts-with(./label,"Autor")]/substring-after(.,":")') + mangainfo.artists=x.xpathstring('//h4[starts-with(./label,"Artista")]/substring-after(.,":")') + mangainfo.genres=x.xpathstring('//h4[starts-with(./label,"Gênero")]/substring-after(.,":")') + mangainfo.summary=x.xpathstring('//*[@class="panel-body"]') + x.xpathhrefall('//*[contains(@class,"lancamento-linha")]/div[1]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + task.pagelinks.clear() + if http.get(MaybeFillHost(module.rooturl, url)) then + local x=TXQuery.Create(http.Document) + x.xpathstringall('//img[contains(@class, "img-manga") and contains(@src, "/leitor/")]/@src', task.pagelinks) + else + return false + end + return true +end + +function getnameandlink() + local s = module.RootURL .. dirurl + s = s .. '/a-z/' .. IncStr(url) .. '/*' + if http.get(s) then + local x = TXQuery.Create(http.Document) + x.XPathHREFAll('//div[contains(@class,"bloco-manga")]/a[2]', links, names) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. dirurl) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.xpathstring('//ul[@class="pagination"]/li[last()]/a/substring-before(substring-after(@href,"a-z/"),"/")')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function Init() + local m=NewModule() + m.category='Portugues' + m.website='UnionMangas' + m.rooturl='http://unionmangas.site' + m.lastupdated='April 6, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetnameandlink='getnameandlink' + m.ongetdirectorypagenumber='getdirectorypagenumber' +end diff --git a/lua/modules/VnSharing.lua b/lua/modules/VnSharing.lua new file mode 100644 index 000000000..5fab304d8 --- /dev/null +++ b/lua/modules/VnSharing.lua @@ -0,0 +1,72 @@ +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.title=x.XPathString('//p[@class="title"]') + mangainfo.coverLink=MaybeFillHost(module.rooturl, GetBetween("url('", "')", x.XPathString('//div[contains(@class, "info_ava")]/@style'))) + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//div[@class="info"]/span[contains(., "Status")]/a'), 'Đang tiến hành', 'Đang phát hành') + mangainfo.authors = x.XPathStringAll('//div[@id="manga_detail"]/ul/li[contains(b, "Tác giả")]/text()', '') + mangainfo.artists = x.XPathStringAll('//div[@class="info"]/span[contains(., "Artist")]/a') + mangainfo.genres = x.XPathStringAll('//div[@id="manga_detail"]/ul/li[contains(b, "Thể loại")]/a') + mangainfo.summary = x.XPathString('//p[@class="desc"]') + x.xpathhrefall('//ul[@id="manga-info-list"]/li[not(contains(@style, "none"))]/a[1]', mangainfo.chapterlinks,mangainfo.chapternames) + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getdirectorypagenumber() + -- TODO: dynamic page count + if http.GET(module.RootURL .. '/index/KhamPha/newest') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('(//div[@class="pagination_wrap"]/a)[last()-1]')) + if page == nil then page = 1 end + return no_error + else + return net_problem + end +end + +function GetPageNumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + x.xpathstringall('//img[@id="manga_page"]/@src', task.pagelinks) + return true + else + return false + end +end + +function GetNameAndLink() + if http.get(module.rooturl .. '/index/KhamPha/newest/' .. IncStr(url)) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('//ul[@id="browse_result_wrap"]/li[@class="browse_result_item"]/a[@class="title"]', links, names) + for i = 1, v.count do + local v1 = v.get(i) + links.add(v1.getattribute('href')) + names.add(v1.toString) + end + if v.count > 0 then + local page = tonumber(x.XPathString('(//div[@class="pagination_wrap"]/a)[last()-1]')) + if page == nil then page = 1 end + updatelist.CurrentDirectoryPageNumber = page + end + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Vietnamese' + m.website='VnSharing' + m.rooturl='http://truyen.vnsharing.site' + m.sortedlist=true + m.lastupdated='February 16, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' +end \ No newline at end of file diff --git a/lua/modules/WPManga.lua b/lua/modules/WPManga.lua new file mode 100644 index 000000000..d33e8a23c --- /dev/null +++ b/lua/modules/WPManga.lua @@ -0,0 +1,204 @@ +function getinfo() + local s = '' + mangainfo.url = MaybeFillHost(module.rooturl, url) + if http.get(mangainfo.url) then + x = TXQuery.Create(http.document) + mangainfo.coverLink = MaybeFillHost(module.rooturl, x.XPathString('//img[starts-with(@class,"cvr")]/@src')) + mangainfo.title = x.XPathString('//*[@itemprop="itemreviewed"]') + mangainfo.authors = x.XPathString('//*[contains(@class,"mng_det")]//*[self::p or self::li][starts-with(.,"Author")]/substring-after(normalize-space(.)," ")') + mangainfo.artists = x.XPathString('//*[contains(@class,"mng_det")]//*[self::p or self::li][starts-with(.,"Artist")]/substring-after(normalize-space(.)," ")') + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//*[contains(@class,"mng_det")]//*[self::p or self::li][starts-with(.,"Status")]/substring-after(normalize-space(.)," ")')) + mangainfo.summary = x.XPathString('//div[@class="det"]/p[1]') + if (module.website == 'ReadHentaiManga') or (module.website == 'HentaiRead') then + mangainfo.genres = x.XPathString('string-join(//*[contains(@class,"mng_det")]//*[self::p or self::li]//a,", ")') + else + mangainfo.genres = x.XPathString('//*[contains(@class,"mng_det")]//*[self::p or self::li][starts-with(.,"Category")]/string-join((./*[position()>1]),", ")') + end + if module.website == 'HentaiRead' then + mangainfo.chapterLinks.Add(x.XPathString('//a[@class="lst"]/@href')) + mangainfo.chapterNames.Add(mangainfo.title) + elseif module.website == 'MangaOnlineToday' then + mangainfo.summary = x.XPathString('//div[contains(@class,"mng_det")]/p[1]') + x.xpathhrefall('//ul[@class="chp_lst"]/li/a', mangainfo.chapterLinks, mangainfo.chapterNames) + else + while true do + v = x.XPath('//a[@class="lst"]') + for i = 1, v.count do + v2 = v.get(i) + mangainfo.chapterLinks.Add(v2.getAttribute('href')) + s = v2.getAttribute('title') + if s == '' then + s = x.XPathString('*[@class="val"]', v2) + end + if s == '' then + s = x.XPathString('text()[1]', v2) + end + mangainfo.chapterNames.Add(s) + end + if http.terminated then break end + s = Trim(x.XPathString('//*[@class="pgg"]//*[./a[@class="sel"]]/following-sibling::*[./a]/a/@href')) + if s == '' then break end + if http.GET(MaybeFillHost(module.rooturl, s)) then + x.ParseHTML(http.Document) + else + break + end + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + end + return no_error + else + return net_problem + end +end + +function getpagenumber() + local s = '' + local allnum = false + http.Cookies.Values['viewer'] = '1' + if http.GET(AppendURLDelim(MaybeFillHost(module.RootURL, url)) .. '1') then + -- multi page + x = TXQuery.Create(http.Document) + s = x.XPathString('//script[contains(.,"imglist")]/substring-after(substring-before(.,"]"),"[")') + if s ~= '' then + s = '[' .. s .. ']' + else + s = x.XPathString('//script[contains(.,"img_lst")]/substring-after(substring-before(.,"\')"),"(\'")') + if s ~= '' then + s = DecodeURL(s) + end + end + x.ParseHTML(s) + x.XPathStringAll('json(*)()("url")', task.PageLinks) + if task.PageLinks.Count == 0 then + x.XPathStringAll('json(*)()', task.PageLinks) + end + + -- single page + if task.PageLinks.Count == 0 then + x.ParseHTML(http.Document) + task.PageNumber = x.XPath('(//select[@class="cbo_wpm_pag"])[1]/option').Count + if task.PageNumber == 0 then + task.PageNumber = x.XPath('(//select[@name="page"])[1]/option').Count + end + if task.PageNumber == 0 then + v = x.XPath('//select') + for i = 1, v.count do + allnum = true + v2 = x.XPath('option', v.get(i)) + for i = 1, v2.count do + if tointeger(v2.toString) == -1 then + allnum = false + break + end + end + if allnum then + task.PageNumber = x.XPath('option', v).Count + break + end + end + end + end + return true + else + return false + end +end + +function getimageurl() + local s = '' + if http.GET(AppendURLDelim(MaybeFillHost(module.RootURL, url)) .. IncStr(workid) .. '/') then + x = TXQuery.Create(http.Document) + if module.Website == 'ReadHentaiManga' then + s = HTMLDecode(x.XPathString('//img[@id="main_img"]/@src')) + else + s = x.XPathString('//*[contains(@class,"mng_rdr")]//img/@src') + end + if s == '' then + s = x.XPathString('//*[@id="reader"]//img[@id="picture"]/@src') + end + task.PageLinks[workid] = s + return true + else + return false + end +end + +function getdirurl(website) + local result = '' + if (website == 'MangaSpy') or (website == 'MangaIce') then + result = 'manga_list' + elseif (website == 'ReadHentaiManga') then + result = 'hentai-manga-list' + elseif (website == 'HentaiRead') then + result = 'hentai-list' + else + result = 'manga-list' + end + return '/' .. result .. '/all/any/last-added/' +end + +function getdirectorypagenumber() + if http.GET(AppendURLDelim(module.RootURL) .. getdirurl(module.website)) then + x = TXQuery.Create(http.Document) + page = tonumber(ReplaceRegExpr('^.*\\/(\\d+)/.*$', x.XPathString('//ul[@class="pgg"]/li[last()]/a/@href'), '$1')) + if page == nil then + page = 1 + end + return true + else + return false + end +end + +function getnameandlink() + local w = { + ['MangaSpy'] = true, + ['MangaIce'] = true, + ['MangaDeep'] = true, + ['Manga99'] = true + } + if http.GET(AppendURLDelim(module.RootURL) .. getdirurl(module.website) .. IncStr(url) .. '/') then + x = TXQuery.Create(http.Document) + if w[module.website] then + x.XPathHREFAll('//*[contains(@id,"content")]//*[@class="det"]/a', links, names) + elseif module.website == 'MangaOnlineToday' then + x.XPathHREFAll('//*[contains(@id,"content")]//div[@class="box"]/ul/li/a', links, names) + else + x.XPathHREFtitleAll('//*[contains(@id,"content")]//a[./img]', links, names); + end + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url, category) + local m = NewModule() + m.website = name + m.rooturl = url + m.category = category + m.lastupdated = 'February 13, 2018' + m.sortedlist = true + m.OnGetInfo = 'getinfo' + m.OnGetPageNumber = 'getpagenumber' + m.OnGetImageURL = 'getimageurl' + m.OnGetDirectoryPageNumber = 'getdirectorypagenumber' + m.OnGetNameAndLink = 'getnameandlink' + return m +end + +function Init() + local cat = 'English' + AddWebsiteModule('Authrone', 'http://www.authrone.com', cat) + AddWebsiteModule('EyeOnManga', 'http://www.eyeonmanga.com', cat) + AddWebsiteModule('MangaDeep', 'http://www.mangadeep.com', cat) + AddWebsiteModule('Manga99', 'http://www.manga99.com', cat) + + cat = 'H-Sites' + AddWebsiteModule('ReadHentaiManga', 'http://readhentaimanga.com', cat) + AddWebsiteModule('HentaiRead', 'http://hentairead.com', cat) + + cat = "Arabic-Scanlation" + AddWebsiteModule('3asq', 'http://www.3asq.info', cat) +end diff --git a/lua/modules/WieManga.lua b/lua/modules/WieManga.lua new file mode 100644 index 000000000..f72c78618 --- /dev/null +++ b/lua/modules/WieManga.lua @@ -0,0 +1,95 @@ +local ALPHA_LIST_UP = '#ABCDEFGHIJKLMNOPQRSTUVWXYZ' + +function GetInfo() + mangainfo.url=MaybeFillHost(module.rooturl,url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.Document) + mangainfo.coverLink=MaybeFillHost(module.rooturl, x.XPathString('//div[@class="bookfrontpage"]/a/img/@src')) + if module.website == 'WieManga' then + mangainfo.title=x.XPathString('//div[@class="bookmessagebox"]/h1/substring-before(., " Manga")') + mangainfo.summary = x.xpathstring('//h4[text()="Beschreibung"]/following-sibling::text()') + mangainfo.artists = x.XPathStringAll('//div[@class="bookmessgae"]//dd[contains(span/text(), "Zeichner")]/a') + mangainfo.authors = x.XPathStringAll('//div[@class="bookmessgae"]//dd[contains(span/text(), "Autor")]/a') + mangainfo.genres = x.XPathStringAll('//div[@class="bookmessgae"]//dd[contains(span/text(), "Genre")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="bookmessgae"]//dd[contains(span/text(), "Status")]/a'), 'ongoing', 'finished') + elseif module.website == 'MangaRussia' then + mangainfo.title=x.XPathString('//div[@class="bookmessagebox"]/h1/substring-after(., "Манга ")') + mangainfo.summary = x.xpathstring('//h4[text()="Описание"]/following-sibling::text()') + mangainfo.authors = x.XPathStringAll('//div[@class="bookmessgae"]//dd[contains(span/text(), "Автор")]/a') + mangainfo.genres = x.XPathStringAll('//div[@class="bookmessgae"]//dd[contains(span/text(), "Жанры")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="bookmessgae"]//dd[contains(span/text(), "Перевод")]/a'), 'ongoing', 'finished') + end + x.XPathHREFAll('//div[@class="chapterlist"]/table//td[@class="col1"]/a', mangainfo.chapterlinks, mangainfo.chapternames) + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + else + return net_error + end +end + +function GetPageNumber() + task.pagelinks.clear() + task.pagenumber=0 + local s=MaybeFillHost(module.rooturl,url):gsub('/$', '') .. '-1.html' + if http.get(s) then + x=TXQuery.Create(http.Document) + task.pagenumber=x.xpath('(//select[@id="page"])[1]/option').count + return true + else + return false + end +end + +function GetImageURL() + local baseurl = MaybeFillHost(module.rooturl,url) + local s = baseurl:gsub('/$','') .. '-' .. tostring(workid+1) .. '.html' + http.headers.values['Referer'] = baseurl + if http.get(s) then + x=TXQuery.Create(http.Document) + task.pagelinks[workid]=x.xpathstring('//img[@id="comicpic"]/@src') + return true + else + return false + end +end + +function GetNameAndLink() + local s = '0-9' + if module.CurrentDirectoryIndex ~= 0 then + s = ALPHA_LIST_UP:sub(module.CurrentDirectoryIndex+1,module.CurrentDirectoryIndex+1) + end + if http.get(module.rooturl..'/category/' .. s .. '_'.. IncStr(url) .. '.html') then + x=TXQuery.Create(http.Document) + v=x.xpath('//*[@class="booklist"]//span[@class="pagetor"]//text()') + local i = 1 + for j=1,v.count do + v1 = v.get(j) + local tmp = tonumber(v1.toString) + if (tmp ~= nil) and (tmp > i) then i = tmp end + end + updatelist.CurrentDirectoryPageNumber = i + x.XPathHREFtitleAll('//*[@class="booklist"]/table//dl/dd/a[1]', links, names) + return no_error + else + return net_problem + end +end + +function AddWebsiteModule(name, url, category) + local m = NewModule() + m.category=category + m.website=name + m.rooturl=url + m.totaldirectory = ALPHA_LIST_UP:len() + m.lastupdated='February 19, 2018' + m.ongetinfo='GetInfo' + m.ongetpagenumber='GetPageNumber' + m.ongetnameandlink='GetNameAndLink' + m.OnGetImageURL='GetImageURL' + return m +end + +function Init() + AddWebsiteModule('WieManga', 'https://www.wiemanga.com', 'German') + AddWebsiteModule('MangaRussia', 'http://www.mangarussia.com', 'Russian') +end diff --git a/lua/modules/acqqcom.lua b/lua/modules/acqqcom.lua new file mode 100644 index 000000000..07b32619b --- /dev/null +++ b/lua/modules/acqqcom.lua @@ -0,0 +1,77 @@ +function getinfo() + mangainfo.url=MaybeFillHost(module.RootURL, url) + if http.get(mangainfo.url) then + x=TXQuery.Create(http.document) + mangainfo.title=x.xpathstring('//h2[contains(@class, "works-intro-title")]') + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//div[contains(@class,"works-cover")]/a/img/@src')) + mangainfo.authors=x.xpathstring('//p[@class="works-intro-digi"]/span[contains(., "作者")]/em/substring-before(., " ")') + mangainfo.summary=x.xpathstring('//p[contains(@class,"works-intro-short")]') + x.xpathhrefall('//div[@id="chapter"]//ol[contains(@class, "chapter-page-all")]/li//a', mangainfo.chapterlinks, mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function getpagenumber() + if http.get(MaybeFillHost(module.rooturl,url)) then + x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "window") and contains(., "eval")]') + local nonce = ExecJS('var window={};'..s..';window.nonce;'); + s = x.xpathstring('//script[contains(., "var DATA")]') + local data = ExecJS(s..';DATA;'); + local script = x.xpathstring('//script[contains(@src, "chapter")]/@src') + if http.get(script) then + s = StreamToString(http.document) + s = '!function(){eval'..GetBetween('!function(){eval', '))}();', s)..'))}();' + s = 'var W={nonce:"'..nonce..'",DATA:"'..data..'"};'..s..';JSON.stringify(_v);' + s = ExecJS(s) + x.parsehtml(s) + x.xpathstringall('json(*).picture().url', task.pagelinks) + return true + else + return false + end + else + return false + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = module.rooturl + return true +end + +function getdirectorypagenumber() + if http.GET(module.RootURL .. '/Comic/all/search/hot/page/1') then + x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('//span[contains(@class,"ret-result-num")]/em')) + if page == nil then page = 1 end + page = math.ceil(page / 12) + return no_error + else + return net_problem + end +end + +function getnameandlink() + if http.get(module.rooturl..'/Comic/all/search/hot/page/'..IncStr(url)) then + TXQuery.Create(http.document).XPathHREFAll('//ul[contains(@class, "ret-search-list")]/li//h3/a',links,names) + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Raw' + m.website='AcQQCom' + m.rooturl='https://ac.qq.com' + m.lastupdated='April 2, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' +end diff --git a/lua/modules/dm5.lua b/lua/modules/dm5.lua new file mode 100644 index 000000000..a603b5cd0 --- /dev/null +++ b/lua/modules/dm5.lua @@ -0,0 +1,150 @@ +function getinfo() + mangainfo.url = MaybeFillHost(module.RootURL, url) + http.cookies.values['isAdult'] = '1' + if http.get(mangainfo.url) then + local x = TXQuery.Create(http.document) + if mangainfo.title == '' then + mangainfo.title=x.xpathstring('//div[@class="banner_detail_form"]//p[@class="title"]/text()') + end + mangainfo.coverlink=MaybeFillHost(module.rooturl,x.xpathstring('//div[@class="cover"]/img/@src')) + mangainfo.authors=x.xpathstringall('//div[@class="info"]/p[@class="subtitle"]/a') + mangainfo.genres=x.xpathstringall('//div[@class="info"]/p[@class="tip"]/span[contains(., "题材")]/a') + mangainfo.status = MangaInfoStatusIfPos(x.xpathstring('//div[@class="info"]/p[@class="tip"]/span[contains(., "状态")]/span'), '连载中', '已完结'); + mangainfo.summary=x.xpathstring('//div[@class="info"]/p[@class="content"]') + v=x.xpath('//div[@id="chapterlistload"]/ul') + for i = 1, v.count do + local v1 = v.get(i) + local w = x.xpath('.//li/a', v1) + for j = 1, w.count do + local w1 = w.get(j) + mangainfo.chapterlinks.add(module.RootURL .. w1.getAttribute('href')) + mangainfo.chapternames.add(w1.toString) + end + end + InvertStrings(mangainfo.chapterlinks,mangainfo.chapternames) + return no_error + else + return net_problem + end +end + +function urlencode(str) + if (str) then + str = string.gsub (str, "\n", "\r\n") + str = string.gsub (str, "([^%w ])", + function (c) return string.format ("%%%02X", string.byte(c)) end) + str = string.gsub (str, " ", "+") + end + return str +end + +local js = require 'modules.jsunpack' +function gettext(s) + s = SeparateRight(s, "}('") + local text = SeparateLeft(s, "',") + local a = tonumber(GetBetween("',", ",", s)) + s = SeparateRight(s, "',") + local c = tonumber(GetBetween(",", ",'", s)) + local w = js.splitstr(GetBetween(",'", "'", s), '|') + return js.unpack36(text, a, c, w) +end + +function getpagenumber() + local u = MaybeFillHost(module.rooturl,url) + if http.get(u) then + local x=TXQuery.Create(http.Document) + local s = x.xpathstring('//script[contains(., "DM5_MID")]') + local dm5mid = GetBetween('DM5_MID=', ';', s) + local dm5cid = GetBetween('DM5_CID=', ';', s) + local dm5viewsign = GetBetween('DM5_VIEWSIGN="', '";', s) + local dm5viewsigndt = GetBetween('DM5_VIEWSIGN_DT="', '";', s) + local dm5key = x.xpathstring('//*[@id="dm5_key"]/@value') + local dm5page, cnt = 1, 0 + + local total = tonumber(x.xpathstring('(//div[@id="chapterpager"])[1]/a[last()]')) + if total == nil then total = 0 end + + while (cnt < total) and (dm5page <= total) do + local xhrurl = string.format('%s/chapterfun.ashx?cid=%s&page=%d&key=%s&language=1>k=6&_cid=%s&_mid=%s&_dt=%s&_sign=%s', + RemoveURLDelim(u), dm5cid, dm5page, dm5key, dm5cid, dm5mid, urlencode(dm5viewsigndt), dm5viewsign) + if http.terminated then break end + http.reset() + http.headers.values['Referer'] = u + if http.xhr(xhrurl) then + local s = gettext(StreamToString(http.document)) + local cid = GetBetween('cid=', ';', s) + local key = GetBetween("key=\\'", "\\';", s) + local pix = GetBetween('pix="', '";', s) + local pvalue = '[' .. GetBetween('pvalue=[', '];', s) .. ']' + x.parsehtml(pvalue) + local v = x.xpath('json(*)()') + for i = 1, v.count do + local v1 = v.get(i) + task.pagelinks.add(pix .. v1.toString .. string.format('?cid=%s&key=%s', cid, key)) + cnt = cnt + 1 + end + dm5page = dm5page + v.count + else + return false + end + end + task.pagecontainerlinks.text = u + return true + else + return false + end +end + +function BeforeDownloadImage() + http.headers.values['Referer'] = task.pagecontainerlinks.text + return true +end + +local perpage = 100 +function getdirectorypagenumber() + local u = string.format('%s/dm5.ashx?t=%d', module.rooturl, os.time()*1000) + local data = 'pagesize=1&pageindex=1&tagid=0&areaid=0&status=0&usergroup=0&pay=-1&char=&sort=18&action=getclasscomics' + if http.POST(u, data) then + local x = TXQuery.Create(http.Document) + page = tonumber(x.XPathString('json(*).Count')) + if page == nil then + page = 1 + else + page = math.ceil(page / perpage) + end + return no_error + else + return net_problem + end +end + +function getnameandlink() + local u = string.format('%s/dm5.ashx?t=%d', module.rooturl, os.time()*1000) + local data = string.format('pagesize=%d&pageindex=%d&tagid=0&areaid=0&status=0&usergroup=0&pay=-1&char=&sort=18&action=getclasscomics', perpage, IncStr(url)) + if http.post(u, data) then + local x = TXQuery.Create(http.Document) + local v = x.xpath('json(*).UpdateComicItems()') + for i = 1, v.count do + local v1 = v.get(i) + links.add(module.rooturl .. '/' .. x.xpathstring('UrlKey', v1) .. '/') + names.add(x.xpathstring('Title', v1)) + end + return no_error + else + return net_problem + end +end + +function Init() + m=NewModule() + m.category='Raw' + m.website='DM5' + m.rooturl='http://www.dm5.com' + m.lastupdated='May 23, 2018' + m.ongetinfo='getinfo' + m.ongetpagenumber='getpagenumber' + m.ongetdirectorypagenumber='getdirectorypagenumber' + m.ongetnameandlink='getnameandlink' + m.OnBeforeDownloadImage = 'BeforeDownloadImage' + m.sortedlist = true +end diff --git a/lua/modules/jsunpack.lua b/lua/modules/jsunpack.lua new file mode 100644 index 000000000..bff9f8f03 --- /dev/null +++ b/lua/modules/jsunpack.lua @@ -0,0 +1,77 @@ +local _M = {} + +local lookup36 = '0123456789abcdefghijklmnopqrstuvwxyz' + +function encode36(code) + local result = '' + local i = 0 + repeat + local digit = math.fmod(math.floor(code / (36^i)), 36) + result = string.char(string.byte(lookup36, digit+1)) .. result + code = code - digit * (36^i) + i = i + 1 + until code <= 0 + return result +end + +function getid(c, a) + local result = '' + if c < a then + result = '' + else + result = getid(math.floor(c / a), a) + end + c = math.fmod(c, a) + if c > 35 then + result = result .. string.char(c + 29) + else + result = result .. encode36(c) + end + return result +end + +function _M.unpack36(text, a, c, words) + if (a == nil) or (c == nil) then return '' end + if type(words) == 'string' then + words = splitstr(words, '|') + end + local dict = {} + while c ~= 0 do + c = c - 1 + dict[getid(c, a)] = words[c+1] + end + return text:gsub('%f[%w](%w+)%f[%W]', + function (w) + if (dict[w] ~= nil) and (dict[w] ~= '') then + return dict[w] + else + return w + end + end) +end + +function _M.replacehex(text) + return text:gsub('(\\x)([%da-f][%da-f]?)', + function (x, w) + return string.char(tonumber(w, 16)) + end + ) +end + +function _M.splitstr(str, delimiter) + local result = { } + local from = 1 + local delim_from, delim_to = string.find(str, delimiter, from) + while delim_from do + table.insert(result, string.sub(str, from , delim_from-1)) + from = delim_to + 1 + delim_from, delim_to = string.find(str, delimiter, from) + end + table.insert(result, string.sub(str, from)) + return result +end + +function Init() +end + +return _M diff --git a/lua/modules/lzstring.lua b/lua/modules/lzstring.lua new file mode 100644 index 000000000..da7d925c1 --- /dev/null +++ b/lua/modules/lzstring.lua @@ -0,0 +1,184 @@ +local _M = {} + +local keyStrBase64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=' +local dictBase64 = {} + +function filldict() + for i = 0, string.len(keyStrBase64)-1 do + dictBase64[string.char(string.byte(keyStrBase64, i+1))] = i + end +end + +function getval64(input, index) + return dictBase64[string.char(string.byte(input, index + 1))] +end + +function _M.decompressFromBase64(input) + if (not input) or (input == '') then return '' end + return _decompress(input, 32, getval64) +end + +function codepoint_to_utf8(c) + assert((55296 > c or c > 57343) and c < 1114112, "Bad Unicode code point: "..c..".") + if c < 128 then + return string.char(c) + elseif c < 2048 then + return string.char(math.floor(192 + c/64), 128 + c%64) + elseif c < 55296 or 57343 < c and c < 65536 then + return string.char(math.floor(224 + c/4096), math.floor(128 + c/64%64), 128 + c%64) + elseif c < 1114112 then + return string.char(math.floor(240 + c/262144), math.floor(128 + c/4096%64), math.floor(128 + c/64%64), 128 + c%64) + end +end + +function tochar(i) + return codepoint_to_utf8(i) +end + +function _decompress(input, rst, getval) + local result, enlargeIn, numBits = '', 4, 3 + local maxpower, power, bits = 2^2, 1, 0 + local dictionary = {[0] = '0', [1] = '1', [2] = '2'} + local dataval, datapos, dataindex = getval(input, 0), rst, 1 + local w, c, c2, entry, dsize = '\0', '\0', 0, '', 4 + + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + + if bits == 0 then + maxpower = 2^8 + power, bits = 1, 0 + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + c = tochar(bits) + elseif bits == 1 then + maxpower = 2^16 + power, bits = 1, 0 + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + c = tochar(bits) + elseif bits == 2 then + return '' + end + + dictionary[3] = c + w = c + result = result .. c + + while true do + if dataindex > string.len(input) then + return '' + end + maxpower = 2^numBits + power, bits = 1, 0 + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + + c2 = bits + if bits == 0 then + maxpower = 2^8 + power, bits = 1, 0 + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + dictionary[dsize] = tochar(bits) + c2 = dsize + dsize = dsize + 1 + enlargeIn = enlargeIn - 1; + elseif bits == 1 then + maxpower = 2^16 + power, bits = 1, 0 + while power ~= maxpower do + resb = dataval & datapos + datapos = datapos >> 1 + if datapos == 0 then + datapos = rst + dataval = getval(input, dataindex) + dataindex = dataindex + 1; + end + if resb > 0 then bits = bits | power end + power = power << 1 + end + dictionary[dsize] = tochar(bits) + c2 = dsize + dsize = dsize + 1 + enlargeIn = enlargeIn - 1; + elseif bits == 2 then + return result + end + + if enlargeIn == 0 then + enlargeIn = 2^numBits + numBits = numBits + 1 + end + + if dsize - 1 >= c2 then + entry = dictionary[c2] + elseif c2 == dsize then + entry = w .. string.char(string.byte(w,1)) + else + return '' + end + + result = result .. entry + dictionary[dsize] = w .. string.char(string.byte(entry,1)) + dsize = dsize + 1 + enlargeIn = enlargeIn - 1 + w = entry + if enlargeIn == 0 then + enlargeIn = 2^numBits + numBits = numBits + 1 + end + end +end + +function Init() +end + +filldict() + +return _M diff --git a/lua/modules/myReaderMangaCMS.lua b/lua/modules/myReaderMangaCMS.lua new file mode 100644 index 000000000..03a2d061e --- /dev/null +++ b/lua/modules/myReaderMangaCMS.lua @@ -0,0 +1,220 @@ +Modules = {} + +function Modules.myReaderMangaCMS() + local myReaderMangaCMS = {} + + function myReaderMangaCMS:new() + local obj = {} + setmetatable(obj, self) + self.__index = self + return obj + end + + function myReaderMangaCMS:getinfo() + mangainfo.url = MaybeFillHost(module.RootURL, url) + if http.GET(mangainfo.url) then + local x = TXQuery.Create(http.Document) + mangainfo.coverLink = MaybeFillHost(module.RootURL, x.XPathString('//div[@class="boxed"]/img/@src')) + if mangainfo.title == '' then + mangainfo.title = x.XPathString('//*[(self::h2 or self::h1) and contains(@class,"widget-title")]') + if mangainfo.title == '' then + mangainfo.title = mangainfo.url:match('/([^/]+)$') + end + end + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//dt[.=("Status","Estado","Statut")]/following-sibling::dd[1]')) + mangainfo.authors = x.XPathStringAll('//dt[.=("Author(s)","Yazar & Çizer:","Autor(es)","Auteur(s)")]/following-sibling::dd[1]/string-join(*,", ")') + mangainfo.artists = x.XPathStringAll('//dt[.=("Artist(s)","Artiste(s)")]/following-sibling::dd[1]/string-join(*,", ")') + mangainfo.genres = x.XPathStringAll('//dt[.=("Categories","Kategoriler:","Categorías","Catégories")]/following-sibling::dd[1]/string-join(*,", ")') + mangainfo.summary = x.XPathString('//div[@class="well"]/p') + local v = x.Xpath('//ul[@class="chapters"]/li/*[self::h5 or self::h3]') + for i = 1, v.Count do + local v2 = v.Get(i) + mangainfo.chapterLinks.Add(x.XPathString('a/@href', v2)) + mangainfo.chapterNames.Add(x.XPathString('normalize-space(.)', v2)) + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + return no_error + end + return net_problem + end + + function myReaderMangaCMS:getpagenumber() + local u = MaybeFillHost(module.RootURL, url) + if http.get(u) then + local x = TXQuery.Create(http.document) + x.xpathstringall('//div[@id="all"]/img/@data-src', task.pagelinks) + if task.pagelinks.Count == 0 then + x.xpathstringall('//div[@id="all"]/img/@src', task.pagelinks) + end + task.pagecontainerlinks.text = u + return true + end + return false + end + + function myReaderMangaCMS:getnameandlink() + if http.get(module.rooturl .. self.getdirurl()) then + local x = TXQuery.create(http.document) + x.xpathhrefall('//li/a', links, names) + return no_error + end + return net_problem + end + + function myReaderMangaCMS:getdirurl() + return '/changeMangaList?type=text' + end + + function myReaderMangaCMS:beforedownloadimage() + http.reset() + http.headers.values['Referer'] = task.pagecontainerlinks.text + return true + end + + return myReaderMangaCMS +end + +function Modules.WhiteCloudPavilion() + local WhiteCloudPavilion = {} + setmetatable(WhiteCloudPavilion, { __index = Modules.myReaderMangaCMS() }) + + function WhiteCloudPavilion:getdirurl() + return '/manga/free' .. Modules.myReaderMangaCMS().getdirurl() + end + + return WhiteCloudPavilion +end + +function Modules.GodsRealmScan() + local GodsRealmScan = {} + setmetatable(GodsRealmScan, { __index = Modules.myReaderMangaCMS() }) + + function GodsRealmScan:getdirurl() + return '/public' .. Modules.myReaderMangaCMS().getdirurl() + end + + return GodsRealmScan +end + +function Modules.MangaDenizi() + local MangaDenizi = {} + setmetatable(MangaDenizi, { __index = Modules.myReaderMangaCMS() }) + + function MangaDenizi:getinfo() + Modules.myReaderMangaCMS().getinfo() + local x=TXQuery.Create(http.document) + mangainfo.status = MangaInfoStatusIfPos(x.XPathString('//dt[.="Durum:"]/following-sibling::dd[1]'), 'Devam Ediyor', 'Tamamlandı') + end + + return MangaDenizi +end + +function Modules.FallenAngelsScans() + local FallenAngelsScans = {} + setmetatable(FallenAngelsScans, { __index = Modules.myReaderMangaCMS() }) + + function FallenAngelsScans:getinfo() + Modules.myReaderMangaCMS().getinfo() + if mangainfo.coverLink:match('^//') ~= nil then + mangainfo.coverLink = 'https:' .. mangainfo.coverLink + end + end + + return FallenAngelsScans +end + +function Modules.KomikGue() + local KomikGue = {} + setmetatable(KomikGue, { __index = Modules.myReaderMangaCMS() }) + + function KomikGue:getinfo() + Modules.myReaderMangaCMS().getinfo() + local x=TXQuery.Create(http.document) + mangainfo.artists = x.XPathStringAll('//dt[.="Artist(s)"]/following-sibling::dd[1]') + mangainfo.summary = x.XPathString('//div[@class="well"]/div') + local v = x.xpath('//div[@class="chapter-wrapper"]/table//td[@class="chapter"]/a') + for i = 1, v.Count do + local v2 = v.Get(i) + mangainfo.chapterLinks.Add(v2.getAttribute('href')) + mangainfo.chapterNames.Add(x.XPathString('normalize-space(.)', v2)) + end + InvertStrings(mangainfo.chapterLinks, mangainfo.chapterNames) + end + + return KomikGue +end + + +------------------------------------------------------------------------------- + +function createInstance() + local m = Modules[module.website] + if m ~= nil then + return m():new() + else + return Modules.myReaderMangaCMS():new() + end +end + +------------------------------------------------------------------------------- + +function getinfo() + return createInstance():getinfo() +end + +function getpagenumber() + return createInstance():getpagenumber() +end + +function getnameandlink() + return createInstance():getnameandlink() +end + +function beforedownloadimage() + return createInstance():beforedownloadimage() +end + +function AddWebsiteModule(name, url, cat) + local m = NewModule() + m.category = cat + m.website = name + m.rooturl = url + m.ongetnameandlink = 'getnameandlink' + m.ongetinfo = 'getinfo' + m.ongetpagenumber = 'getpagenumber' + m.onbeforedownloadimage='beforedownloadimage' + return m +end + +function Init() + local c='Spanish' + AddWebsiteModule('MangaDoor', 'http://mangadoor.com', c); + AddWebsiteModule('MangAs', 'https://mang.as', c); + + c='Indonesian' + AddWebsiteModule('Komikid', 'https://www.komikid.com', c); + AddWebsiteModule('KomikGue', 'https://www.komikgue.com', c); + + c='Raw' + AddWebsiteModule('RawMangaUpdate', 'http://rawmangaupdate.com', c); + AddWebsiteModule('MangaRawOnline', 'http://mangaraw.online', c); + AddWebsiteModule('RawMangaSite', 'https://rawmanga.site', c); + + c='Turkish' + AddWebsiteModule('MangaDenizi', 'http://www.mangadenizi.com', c); + AddWebsiteModule('MangaVadisi', 'http://manga-v2.mangavadisi.org', c); + + c='English-Scanlation' + AddWebsiteModule('FallenAngelsScans','https://manga.fascans.com', c); + AddWebsiteModule('WhiteCloudPavilion','https://whitecloudpavilion.com', c); + AddWebsiteModule('HatigarmScans', 'https://www.hatigarmscans.net', c) + AddWebsiteModule('WoweScans', 'https://wowescans.net', c) + + c='Spanish-Scanlation' + AddWebsiteModule('DarkSkyScan', 'https://darkskyprojects.org', c); + AddWebsiteModule('CoYuHi', 'http://www.universoyuri.com', c); + AddWebsiteModule('SOSScanlation', 'https://sosscanlation.com', c); + + c='French' + AddWebsiteModule('ScanFR', 'https://www.scan-fr.io', c); +end diff --git a/mangadownloader/forms/frmAccountManager.lfm b/mangadownloader/forms/frmAccountManager.lfm new file mode 100644 index 000000000..f74e52eda --- /dev/null +++ b/mangadownloader/forms/frmAccountManager.lfm @@ -0,0 +1,171 @@ +object AccountManagerForm: TAccountManagerForm + Left = 0 + Height = 316 + Top = 0 + Width = 392 + ActiveControl = vtAccountList + BorderStyle = bsNone + Caption = 'AccountManagerForm' + ClientHeight = 316 + ClientWidth = 392 + OnCreate = FormCreate + OnDestroy = FormDestroy + LCLVersion = '1.8.0.6' + object pnBtContainer: TPanel + Left = 307 + Height = 316 + Top = 0 + Width = 85 + Align = alRight + AutoSize = True + BorderSpacing.Left = 4 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 316 + ClientWidth = 85 + TabOrder = 1 + object btEdit: TBitBtn + Left = 0 + Height = 26 + Top = 0 + Width = 85 + Align = alTop + AutoSize = True + Caption = 'Edit' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000FF014B + 649A012E3C63010A0D350000002D0000002A00000026000000210000001D0000 + 001900000014000000100000000B000000080000000500000002015E7B85C2E6 + F2FF5591A5D1014C649A013141500000001500000013000000110000000F0000 + 000D0000000A0000000800000006000000040000000300000001016B8E3962A5 + BBC0C2E6F2FFA0CEDDF501596FC30060764701343E0000000000000000000000 + 000000000000000000000000000000000000000000000000000000759B060072 + 976CC0E4F1EF44BBCCFF58CEDFFF016379CA01687D47016F8500013C47000000 + 0000000000000000000000000000000000000000000000000000007CA500007C + A527018DA8A688EEFFFF5DD1E2FF5BD0E1FF016B80C80170864601788E000281 + 9700014550000000000000000000000000000000000000000000007CA500007D + A600019AB2400195ADB788EEFFFF63D5E6FF5FD3E4FF017389C701798F450281 + 97000289A0000291A800024D5800000000000000000000000000007CA500007D + A600019BB200019AB2400195ADB788EEFFFF69DAEBFF60D3E4FF027C92C50282 + 98450289A0000291A8000399AF000A0A0A000505050000000000007CA500007D + A600019BB200019BB200019AB2400195ADB788EEFFFF71DEEFFF60D3E4FF0285 + 9BC3028AA1450291A8000399AF000A0A0A000A0A0A000A0A0A00007CA500007D + A600019BB200019BB200019BB200019AB2400195ADB788EEFFFF78E3F4FF5DD2 + E3FF028DA4C20292A9440399AF000A0A0A000A0A0A000A0A0A00007CA500007D + A600019BB200019BB200019BB200019BB200019AB2400195ADB788EEFFFF7EE7 + F8FF5ACFE0FF0395ACC0039AB0430A0A0A000A0A0A000A0A0A00007CA500007D + A600019BB200019BB200019BB200019BB200019BB200019AB2400195ADB788EE + FFFF83EBFCFF56CDDEFF087A8CB00C0C0C2F0A0A0A000A0A0A00001F2A00005E + 7D00019BB200019BB200019BB200019BB200019BB200019BB200019AB2400195 + ADB788EEFFFF33AABBFFDDDDDDFF171717830909312905055500000000000000 + 000001272D0001758600019BB200019BB200019BB200019BB200019BB200019A + B240158395A3F6F6F6FFCCCCCCFFDDDDDDFF060683B50000A032000000000000 + 0000000000000000000001272D0001758600019BB200019BB200019BB200019B + B2005555552450505069F6F6F6FF6868F8FF5C5CF2FF0000A8B1000000000000 + 00000000000000000000000000000000000001272D0001758600019BB200019B + B200555555005555551F1515BC9D8888FFFF0101C5B90101B443000000000000 + 000000000000000000000000000000000000000000000000000001272D000175 + 860055555500555555000101E42B0101E09D0101D23F0101B600 + } + OnClick = btEditClick + TabOrder = 0 + end + object btRefresh: TBitBtn + Left = 0 + Height = 26 + Top = 30 + Width = 85 + Align = alTop + AutoSize = True + Caption = 'Refresh' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00000000000600000010000000190000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A000000190000001500000010FFFFFF000000 + 00000000000B0000002011090133391E013E532A014345240240733A02A6984D + 02CC984D02CC984D02CC984D02CC984D02CC733A02A30000001FFFFFFF000000 + 000028160200763D0419A2580842C47E174EE4A01C54FCB9203F9C5105CCFDBC + 28FFFCB81DFFFCB81DFFFDC033FF9C5105CC9C51055C00000000FFFFFF00A65B + 0D00A3580B22AB62105FF8BA346DF6B01C6DF7B11E6BF8B52740A2570ACCF8B6 + 2AFFF6AC14FFF8BA35FFA2570ACCA2570A84A15609002A170400FFFFFF00A95E + 0F10AD641378F3B84390EFAB2A90E7A83691BF7A2078A85D0E33A85D0ECCF2B3 + 39FFF3B943FFEEA824FFF2B339FFAD6210BFA95E0F1AAA5F1000FFFFFF00AF64 + 144DCC8B33A6E8A83BB4E4A845B2AF641488AE631332AC611100AF6414CCF0BD + 5CFFAF6414CCECB148FFE8A83BFFCD8D34E3AF64146CAF641400FFFFFF00B66B + 198CE0A751CFE3A84ED6C98734BBB56A194AAF641400B66B1900B66B19CCB66B + 19CCB66B1994C98734DCE3A84EFFE0A851F5B66B19A7B66B1900FFFFFF00BE73 + 1FC1E7B466F1E5B061F1BE731FC1BB701D00C0752100C0752000BD721E99BD72 + 1E5CBA6F1C00BE731FCCE5B061FFE7B466FFBE731FCCBE731F00FFFFFF00C57A + 25CCE8B86FFFE6B46CFFC57A25CCC97E2700C67B265CC67B2699C1762100BE73 + 1F00C87D2700C57A25C1E6B46CF1E8B86FF1C57A25C1C57A2500FFFFFF00CD82 + 2AA7E8B66CF5E8B570FFDA9B48DCCD822A94CD822ACCCD822ACCCD822A00CF84 + 2C00CE832B4ADA9B47BBE8B570D6E8B66CCFCD822A8CCD822A00FFFFFF00D489 + 306CE4AB59E3EDBC76FFF1C67EFFD48930CCF7D38AFFD48930CCD88D3200D58A + 3132D4893088EEBF75B2EDBC76B4E4A958A6D489304DD4893000FFFFFF00DA8F + 341ADC9339BFF7CD85FFF2C27AFFF9D38AFFF7CD85FFDB9034CCDB903433E4A5 + 4F78F3C67991F4C57D90F8D28990DD953A78DA8F3410D98E3300FFFFFF00E196 + 3900E1963984E19639CCFCD88EFFF9CC82FFFCD58AFFE19639CCFCD48940FBD0 + 866BFACF856DFCD88D6DE49E435FE0953922DC913500DC913500FFFFFF00E69B + 3D5CE59A3DCCFFE094FFFED98DFFFED98DFFFFDC91FFE59A3DCCFEDA8E3FF8CB + 7B54F0B7604EE79F4242E59A3D19E1963900DC913500DC913500FFFFFF00E99E + 4099E99E40CCE99E40CCE99E40CCE99E40CCE99E40CCE99E4099E99E4020E99E + 4025E99E4019E89D3F06E59A3D00E1963900DC913500DC913500FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btRefreshClick + TabOrder = 1 + end + end + object vtAccountList: TVirtualStringTree + Left = 0 + Height = 316 + Top = 0 + Width = 303 + Align = alClient + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + Header.AutoSizeIndex = 0 + Header.Columns = < + item + MinWidth = 25 + Options = [coAllowClick, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coFixed, coAllowFocus] + Position = 0 + Width = 25 + end + item + Position = 1 + Text = 'Website' + end + item + Position = 2 + Text = 'Username' + end + item + Position = 3 + Text = 'Status' + end> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + NodeDataSize = 1 + TabOrder = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toDisableAutoscrollOnFocus] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnBeforeCellPaint = vtAccountListBeforeCellPaint + OnChecked = vtAccountListChecked + OnCompareNodes = vtAccountListCompareNodes + OnDblClick = vtAccountListDblClick + OnGetText = vtAccountListGetText + OnPaintText = vtAccountListPaintText + OnHeaderClick = vtAccountListHeaderClick + end +end diff --git a/mangadownloader/forms/frmAccountManager.lrj b/mangadownloader/forms/frmAccountManager.lrj new file mode 100644 index 000000000..db0f01fb4 --- /dev/null +++ b/mangadownloader/forms/frmAccountManager.lrj @@ -0,0 +1,8 @@ +{"version":1,"strings":[ +{"hash":265040957,"name":"taccountmanagerform.caption","sourcebytes":[65,99,99,111,117,110,116,77,97,110,97,103,101,114,70,111,114,109],"value":"AccountManagerForm"}, +{"hash":310020,"name":"taccountmanagerform.btedit.caption","sourcebytes":[69,100,105,116],"value":"Edit"}, +{"hash":146640072,"name":"taccountmanagerform.btrefresh.caption","sourcebytes":[82,101,102,114,101,115,104],"value":"Refresh"}, +{"hash":230269173,"name":"taccountmanagerform.vtaccountlist.header.columns[1].text","sourcebytes":[87,101,98,115,105,116,101],"value":"Website"}, +{"hash":164185077,"name":"taccountmanagerform.vtaccountlist.header.columns[2].text","sourcebytes":[85,115,101,114,110,97,109,101],"value":"Username"}, +{"hash":95062979,"name":"taccountmanagerform.vtaccountlist.header.columns[3].text","sourcebytes":[83,116,97,116,117,115],"value":"Status"} +]} diff --git a/mangadownloader/forms/frmAccountManager.pas b/mangadownloader/forms/frmAccountManager.pas new file mode 100644 index 000000000..165bb8424 --- /dev/null +++ b/mangadownloader/forms/frmAccountManager.pas @@ -0,0 +1,341 @@ +unit frmAccountManager; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, + ExtCtrls, VirtualTrees, WebsiteModules, + FMDOptions, HTTPSendThread, BaseThread, frmAccountSet, SimpleException; + +type + + { TAccountManagerForm } + + TAccountManagerForm = class(TForm) + btRefresh: TBitBtn; + btEdit: TBitBtn; + pnBtContainer: TPanel; + vtAccountList: TVirtualStringTree; + procedure btEditClick(Sender: TObject); + procedure btRefreshClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure vtAccountListBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + procedure vtAccountListChecked(Sender: TBaseVirtualTree; Node: PVirtualNode + ); + procedure vtAccountListCompareNodes(Sender: TBaseVirtualTree; Node1, + Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); + procedure vtAccountListDblClick(Sender: TObject); + procedure vtAccountListGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); + {$if VTMajorVersion < 5} + procedure vtAccountListHeaderClick(Sender: TVTHeader; Column: TColumnIndex; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + {$else} + procedure vtAccountListHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + {$endif} + procedure vtAccountListPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); + private + + public + procedure LoadAccounts; + procedure SortList; + end; + + TAccountCheck = class; + + { TAccountCheckThread } + + TAccountCheckThread = class(TBaseThread) + private + fmodule: TModuleContainer; + fthreadlist: TAccountCheck; + fhttp: THTTPSendThread; + procedure SyncStatus; + protected + procedure Execute; override; + public + constructor Create(const AModule: TModuleContainer; AThreadList: TAccountCheck); + destructor Destroy; override; + end; + + TAccountCheck = class(TThreadList) + public + destructor Destroy; override; + procedure StopAll; + end; + +var + AccountManagerForm: TAccountManagerForm; + +const + CL_HLRedMarks = $008080FF; + +resourcestring + RS_Unknown = 'Unknown'; + RS_Checking = 'Checking'; + RS_Valid = 'OK'; + RS_Invalid = 'Invalid'; + RS_AccountDeleteConfirmation = 'Are you sure you want to delete this account?'; + +implementation + +uses frmCustomColor, math; + +var + AccountThreadList: TAccountCheck; + +{$R *.lfm} + +{ TAccountCheck } + +destructor TAccountCheck.Destroy; +begin + StopAll; + while LockList.Count <> 0 do + begin + UnlockList; + Sleep(250); + end; + inherited Destroy; +end; + +procedure TAccountCheck.StopAll; +var + i: Integer; +begin + with LockList do + try + for i := 0 to Count - 1 do + TAccountCheckThread(Items[i]).Terminate; + finally + UnlockList; + end; +end; + +{ TAccountCheckThread } + +procedure TAccountCheckThread.SyncStatus; +begin + AccountManagerForm.vtAccountList.Repaint; +end; + +procedure TAccountCheckThread.Execute; +begin + try + if fmodule.OnLogin<>nil then + fmodule.OnLogin(fhttp,fmodule); + Synchronize(@SyncStatus); + except + on E: Exception do + ExceptionHandle(Self, E); + end; +end; + +constructor TAccountCheckThread.Create(const AModule: TModuleContainer; + AThreadList: TAccountCheck); +begin + inherited Create(False); + FreeOnTerminate:=True; + fmodule:=AModule; + fthreadlist:=AThreadList; + fthreadlist.Add(Self); + fhttp:=THTTPSendThread.Create(Self); +end; + +destructor TAccountCheckThread.Destroy; +begin + if fthreadlist<>nil then + fthreadlist.Remove(Self); + fhttp.Free; + inherited Destroy; +end; + +{ TAccountManagerForm } + +procedure TAccountManagerForm.vtAccountListPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + if Node^.CheckState = csUncheckedNormal then + TargetCanvas.Font.Color := clGrayText; +end; + +procedure TAccountManagerForm.LoadAccounts; +var + i: Integer; + node: PVirtualNode; +begin + vtAccountList.BeginUpdate; + vtAccountList.Clear; + vtAccountList.NodeDataSize:=SizeOf(TModuleContainer); + for i:=0 to Modules.Count-1 do + with Modules[i] do + if Account<>nil then + begin + node:=vtAccountList.AddChild(nil, Modules[i]); + node^.CheckType:=ctCheckBox; + if Account.Enabled then + node^.CheckState:=csCheckedNormal + else + node^.CheckState:=csUncheckedNormal; + end; + vtAccountList.EndUpdate; +end; + +procedure TAccountManagerForm.SortList; +begin + with vtAccountList do + Sort(nil, Header.SortColumn, Header.SortDirection, False); +end; + +procedure TAccountManagerForm.vtAccountListGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + m: TModuleContainer; +begin + m:=PModuleContainer(Sender.GetNodeData(Node))^; + case Column of + 1:CellText:=m.Website; + 2:CellText:=m.Account.Username; + 3: case m.Account.Status of + asUnknown:CellText:=RS_Unknown; + asChecking:CellText:=RS_Checking; + asValid:CellText:=RS_Valid; + asInvalid:CellText:=RS_Invalid; + end; + end; +end; + +{$if VTMajorVersion < 5} +procedure TAccountManagerForm.vtAccountListHeaderClick(Sender: TVTHeader; + Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$else} +procedure TAccountManagerForm.vtAccountListHeaderClick(Sender: TVTHeader; + HitInfo: TVTHeaderHitInfo); +var + Column: TColumnIndex; + Button: TMouseButton; +{$endif} +begin + {$if VTMajorVersion >= 5} + Column := HitInfo.Column; + Button := HitInfo.Button; + {$endif} + if Sender.SortColumn <> Column then + Sender.SortColumn := Column + else + if Sender.SortDirection = sdAscending then + Sender.SortDirection := sdDescending + else + Sender.SortDirection := sdAscending; + SortList; +end; + +procedure TAccountManagerForm.vtAccountListBeforeCellPaint( + Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +begin + if PModuleContainer(Sender.GetNodeData(Node))^.Account.Status = asInvalid then + begin + TargetCanvas.Brush.Color:=CL_HLRedMarks; + TargetCanvas.FillRect(CellRect); + end; +end; + +procedure TAccountManagerForm.FormCreate(Sender: TObject); +begin + AddVT(vtAccountList); + AccountThreadList:=TAccountCheck.Create; +end; + +procedure TAccountManagerForm.FormDestroy(Sender: TObject); +begin + if AccountThreadList<>nil then + AccountThreadList.Free; + RemoveVT(vtAccountList); +end; + +procedure TAccountManagerForm.btEditClick(Sender: TObject); +var + m: TModuleContainer; +begin + if vtAccountList.SelectedCount=0 then Exit; + m:=PModuleContainer(vtAccountList.GetNodeData(vtAccountList.GetFirstSelected))^; + with TAccountSetForm.Create(Self) do + try + Caption:=m.Website; + with m.Account do + begin + edUsername.Text:=Username; + edPassword.Text:=Password; + if ShowModal = mrOK then + begin + if (edUsername.Text <> Username) or (edPassword.Text <> Password) then + begin + Username:=edUsername.Text; + Password:=edPassword.Text; + btRefreshClick(btRefresh); + end; + end; + end; + finally + Free; + end; +end; + +procedure TAccountManagerForm.btRefreshClick(Sender: TObject); +var + m: TModuleContainer; +begin + if vtAccountList.SelectedCount = 0 then Exit; + m:=PModuleContainer(vtAccountList.GetNodeData(vtAccountList.GetFirstSelected()))^; + if m.Account.Status=asChecking then Exit; + TAccountCheckThread.Create(m,AccountThreadList); +end; + +procedure TAccountManagerForm.vtAccountListChecked(Sender: TBaseVirtualTree; + Node: PVirtualNode); +begin + PModuleContainer(Sender.GetNodeData(Node))^.Account.Enabled:=Node^.CheckState=csCheckedNormal; +end; + +procedure TAccountManagerForm.vtAccountListCompareNodes( + Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; + var Result: Integer); +var + m1, m2: TModuleContainer; +begin + m1:=PModuleContainer(Sender.GetNodeData(Node1))^; + m2:=PModuleContainer(Sender.GetNodeData(Node2))^; + case Column of + 0: if m1.Account.Enabled=m2.Account.Enabled then + Result:=AnsiCompareStr(m1.Website,m2.Website) + else + Result:=ifthen(m1.Account.Enabled>m2.Account.Enabled,1,-1); + 1:Result:=AnsiCompareStr(m1.Website,m2.Website); + 2:Result:=AnsiCompareStr(m1.Account.Username,m2.Account.Username); + 3: if m1.Account.Status=m2.Account.Status then + Result:=AnsiCompareStr(m1.Website,m2.Website) + else + Result:=ifthen(m1.Account.Status>m2.Account.Status,1,-1); + end; +end; + +procedure TAccountManagerForm.vtAccountListDblClick(Sender: TObject); +begin + if vtAccountList.SelectedCount=0 then Exit; + btEditClick(btEdit); +end; + +end. + diff --git a/mangadownloader/forms/frmAccountSet.lfm b/mangadownloader/forms/frmAccountSet.lfm new file mode 100644 index 000000000..82984225a --- /dev/null +++ b/mangadownloader/forms/frmAccountSet.lfm @@ -0,0 +1,163 @@ +object AccountSetForm: TAccountSetForm + Left = 490 + Height = 234 + Top = 229 + Width = 269 + BorderStyle = bsDialog + Caption = 'Account' + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 234 + ClientWidth = 269 + Position = poMainFormCenter + LCLVersion = '1.8.0.6' + object Label2: TLabel + Left = 8 + Height = 15 + Top = 8 + Width = 253 + Align = alTop + Caption = 'Username' + ParentColor = False + end + object Label3: TLabel + Left = 8 + Height = 15 + Top = 58 + Width = 253 + Align = alTop + Caption = 'Password' + ParentColor = False + end + object edUsername: TEdit + Left = 8 + Height = 23 + Top = 29 + Width = 253 + Align = alTop + TabOrder = 0 + TextHint = 'Username' + end + object edPassword: TEdit + Left = 8 + Height = 23 + Top = 79 + Width = 253 + Align = alTop + EchoMode = emPassword + PasswordChar = '*' + TabOrder = 1 + TextHint = 'Password' + end + object ckShowPassword: TCheckBox + Left = 8 + Height = 19 + Top = 108 + Width = 253 + Align = alTop + Caption = 'Show password' + OnEditingDone = ckShowPasswordEditingDone + TabOrder = 2 + end + object btOk: TBitBtn + AnchorSideRight.Control = btCancel + AnchorSideBottom.Control = btCancel + AnchorSideBottom.Side = asrBottom + Left = 112 + Height = 26 + Top = 200 + Width = 61 + Anchors = [akRight, akBottom] + AutoSize = True + Caption = 'Ok' + Default = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00010000000800000010000000170000001A0000001900000017000000150000 + 00110000000D0000000A000000060000000300000001FFFFFF00FFFFFF000000 + 00020000000F0000001F0000002D02330066025F00CC012B0055000000290000 + 00220000001A000000130000000C0000000600000001FFFFFF00FFFFFF000000 + 0000000000000320000006570048077200CC16A60AE8087601C406570029021E + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000747 + 00000A6500000B8300480B8200CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85 + 001B0745000000000000000000000000000000000000FFFFFF00FFFFFF000E8D + 00000D8800480D8700CC43CA33F629C318FF39CC28FF28C217FF1EAA0FEA0D87 + 00AE0D8A00100F8F0000084A00000000000000000000FFFFFF00FFFFFF000E8E + 00480E8D00CC5FD94FF933BC22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA2 + 0FE40E8D009E0F8F00081094000010950000084B0000FFFFFF00FFFFFF000F92 + 00CC6DE55CFA59D048FF69E158FC0F9200CC0F92006D139504CB34B423F832B2 + 21FF1F9F0FDF0F92008C109400021095000010950000FFFFFF00FFFFFF001196 + 0048119700CC73EA62FD119700CC119600480F9300001196004C189D08D33DB6 + 2CFB37AF26FE1FA00EDA1197007B11980000129B0000FFFFFF00FFFFFF001197 + 0000129B0048129B00CC129B0048119700000F93000011970000129B006924AA + 13D857CF46FE55CD44FD21A710D6129C006313A00000FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000113A0 + 008533B820DE61D850FF5CD54BFA1EA80CD213A1004CFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000614A3009E43C631E56BE25AFF70E95FFB14A300CCFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000014A5001014A700B077EE66FF14A700CC14A70048FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000013A2000014A5000014A5000014A6 + 000015A8000015A9001F15AA00CC15AA004814A70000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btOkClick + TabOrder = 3 + end + object btCancel: TBitBtn + AnchorSideRight.Side = asrBottom + Left = 179 + Height = 26 + Top = 200 + Width = 82 + Anchors = [akRight, akBottom] + AutoSize = True + Caption = 'Cancel' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000E00000013000000190000001900000016000000120000000F0000000E0000 + 0011000000150000001900000019000000140000000EFFFFFF00FFFFFF000000 + 001C000000260000346400005FCC00003561000000240000001D0000001B0000 + 00210000366000005FCC00003464000000270000001CFFFFFF00FFFFFF000000 + 1E0000005748000072CC1111D8FF000072CC0000574800002000000020000000 + 5748000072CC1111D8FF000072CC0000574800001E00FFFFFF00FFFFFF000000 + 8200000082CC1111D0FF1111D0FF1111D0FF000082CC00008348000083480000 + 82CC1111D0FF1111D0FF1111D0FF000082CC00008200FFFFFF00FFFFFF000000 + 860000008748000087CC1111C4FF1111C4FF1111C4FF000087CC000087CC1111 + C4FF1111C4FF1111C4FF000087CC0000874800008600FFFFFF00FFFFFF000000 + 86000000870000008C4800008DCC1111B8FF1111B8FF1111B8FF1111B8FF1111 + B8FF1111B8FF00008DCC00008C480000870000008600FFFFFF00FFFFFF000000 + 86000000870000008D0000009148000092CC1515AFFF1111ACFF1111ACFF1111 + ACFF000092CC0000914800008D000000870000008600FFFFFF00FFFFFF000000 + A1000000A00000009B0000009848000097CC2525B4FF1111A2FF1111A2FF1414 + A5FF000097CC0000984800009B000000A0000000A100FFFFFF00FFFFFF000000 + A1000000A00000009C4800009BCC5353DBFF2E2EB7FF3D3DC6FF3131BAFF1515 + 9FFF1E1EA8FF00009BCC00009C480000A0000000A100FFFFFF00FFFFFF000000 + A1000000A1480000A0CC6767EFFF3636BEFF5E5EE6FF0000A0CC0000A0CC4F4F + D7FF3636BEFF4545CDFF0000A0CC0000A1480000A100FFFFFF00FFFFFF000000 + A3000000A3CC7676FEFF4C4CD4FF7272FAFF0000A3CC0000A3480000A3480000 + A3CC6262EAFF4C4CD4FF5C5CE4FF0000A3CC0000A300FFFFFF00FFFFFF000000 + A6000000A7480000A7CC7777FFFF0000A7CC0000A7480000A3000000A3000000 + A7480000A7CC7070F8FF0000A7CC0000A7480000A600FFFFFF00FFFFFF000000 + A6000000A7000000AA480000AACC0000AA480000A7000000A3000000A3000000 + A7000000AA480000AACC0000AA480000A7000000A600FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ModalResult = 2 + TabOrder = 4 + end +end diff --git a/mangadownloader/forms/frmAccountSet.lrj b/mangadownloader/forms/frmAccountSet.lrj new file mode 100644 index 000000000..cca69fd24 --- /dev/null +++ b/mangadownloader/forms/frmAccountSet.lrj @@ -0,0 +1,10 @@ +{"version":1,"strings":[ +{"hash":127560724,"name":"taccountsetform.caption","sourcebytes":[65,99,99,111,117,110,116],"value":"Account"}, +{"hash":164185077,"name":"taccountsetform.label2.caption","sourcebytes":[85,115,101,114,110,97,109,101],"value":"Username"}, +{"hash":145417188,"name":"taccountsetform.label3.caption","sourcebytes":[80,97,115,115,119,111,114,100],"value":"Password"}, +{"hash":164185077,"name":"taccountsetform.edusername.texthint","sourcebytes":[85,115,101,114,110,97,109,101],"value":"Username"}, +{"hash":145417188,"name":"taccountsetform.edpassword.texthint","sourcebytes":[80,97,115,115,119,111,114,100],"value":"Password"}, +{"hash":22827444,"name":"taccountsetform.ckshowpassword.caption","sourcebytes":[83,104,111,119,32,112,97,115,115,119,111,114,100],"value":"Show password"}, +{"hash":1371,"name":"taccountsetform.btok.caption","sourcebytes":[79,107],"value":"Ok"}, +{"hash":77089212,"name":"taccountsetform.btcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"} +]} diff --git a/mangadownloader/forms/frmAccountSet.pas b/mangadownloader/forms/frmAccountSet.pas new file mode 100644 index 000000000..984911b0f --- /dev/null +++ b/mangadownloader/forms/frmAccountSet.pas @@ -0,0 +1,63 @@ +unit frmAccountSet; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls, Buttons; + +type + + { TAccountSetForm } + + TAccountSetForm = class(TForm) + btOk: TBitBtn; + btCancel: TBitBtn; + ckShowPassword: TCheckBox; + edUsername: TEdit; + edPassword: TEdit; + Label2: TLabel; + Label3: TLabel; + procedure btOkClick(Sender: TObject); + procedure ckShowPasswordEditingDone(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + AccountSetForm: TAccountSetForm; + +resourcestring + RS_CantBeEmpty = 'Username or password can''t be empty!'; + +implementation + +{$R *.lfm} + +{ TAccountSetForm } + +procedure TAccountSetForm.btOkClick(Sender: TObject); +begin + if (edUsername.Text = '') or (edPassword.Text = '') then begin + MessageDlg(RS_CantBeEmpty, mtError, [mbOK], 0); + if edUsername.Text = '' then edUsername.SetFocus + else edPassword.SetFocus; + end + else + ModalResult := mrOK; +end; + +procedure TAccountSetForm.ckShowPasswordEditingDone(Sender: TObject); +begin + if ckShowPassword.Checked then + edPassword.PasswordChar:=#0 + else + edPassword.PasswordChar:='*'; +end; + +end. + diff --git a/mangadownloader/forms/frmCustomColor.lfm b/mangadownloader/forms/frmCustomColor.lfm new file mode 100644 index 000000000..f5766077d --- /dev/null +++ b/mangadownloader/forms/frmCustomColor.lfm @@ -0,0 +1,181 @@ +object CustomColorForm: TCustomColorForm + Left = 295 + Height = 352 + Top = 191 + Width = 535 + Caption = 'CustomColorForm' + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 352 + ClientWidth = 535 + OnCreate = FormCreate + LCLVersion = '1.7' + object CBColors: TColorBox + AnchorSideRight.Control = btColors + Left = 363 + Height = 22 + Top = 22 + Width = 136 + Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone, cbCustomColor, cbPrettyNames] + Anchors = [akTop, akRight] + ItemHeight = 16 + OnChange = CBColorsChange + TabOrder = 1 + end + object btColors: TColorButton + AnchorSideLeft.Control = CBColors + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = CBColors + AnchorSideBottom.Control = CBColors + AnchorSideBottom.Side = asrBottom + Left = 503 + Height = 22 + Top = 22 + Width = 24 + Anchors = [akTop, akRight, akBottom] + BorderWidth = 2 + ButtonColorSize = 16 + ButtonColor = clBlack + OnColorChanged = btColorsColorChanged + end + object pcCustomColorList: TPageControl + AnchorSideRight.Control = CBColors + Left = 0 + Height = 352 + Top = 0 + Width = 359 + ActivePage = tsBasicList + Align = alLeft + Anchors = [akTop, akLeft, akRight, akBottom] + TabIndex = 0 + TabOrder = 0 + object tsBasicList: TTabSheet + Caption = 'Basic list' + ClientHeight = 324 + ClientWidth = 351 + object VTBasicList: TVirtualStringTree + Left = 0 + Height = 324 + Top = 0 + Width = 351 + Align = alClient + Color = clWindow + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = -1 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + TabOrder = 0 + TextMargin = 0 + TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnBeforeCellPaint = VTBasicListBeforeCellPaint + OnDrawText = VTBasicListDrawText + OnFocusChanged = VTBasicListFocusChanged + OnGetText = VTBasicListGetText + OnPaintText = VTBasicListPaintText + end + end + object tsMangaList: TTabSheet + Caption = 'Manga list' + ClientHeight = 324 + ClientWidth = 351 + object VTMangaList: TVirtualStringTree + Left = 0 + Height = 324 + Top = 0 + Width = 351 + Align = alClient + Color = clWindow + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + TabOrder = 0 + TextMargin = 0 + TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnBeforeCellPaint = VTBasicListBeforeCellPaint + OnDrawText = VTBasicListDrawText + OnFocusChanged = VTBasicListFocusChanged + OnGetText = VTBasicListGetText + OnPaintText = VTBasicListPaintText + end + end + object tsFavoriteList: TTabSheet + Caption = 'Favorite list' + ClientHeight = 324 + ClientWidth = 351 + object VTFavoriteList: TVirtualStringTree + Left = 0 + Height = 324 + Top = 0 + Width = 351 + Align = alClient + Color = clWindow + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + TabOrder = 0 + TextMargin = 0 + TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnBeforeCellPaint = VTBasicListBeforeCellPaint + OnDrawText = VTBasicListDrawText + OnFocusChanged = VTBasicListFocusChanged + OnGetText = VTBasicListGetText + OnPaintText = VTBasicListPaintText + end + end + object tsChapterList: TTabSheet + Caption = 'Chapter list' + ClientHeight = 324 + ClientWidth = 351 + object VTChapterList: TVirtualStringTree + Left = 0 + Height = 324 + Top = 0 + Width = 351 + Align = alClient + Color = clWindow + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + TabOrder = 0 + TextMargin = 0 + TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnBeforeCellPaint = VTBasicListBeforeCellPaint + OnDrawText = VTBasicListDrawText + OnFocusChanged = VTBasicListFocusChanged + OnGetText = VTBasicListGetText + OnPaintText = VTBasicListPaintText + end + end + end +end diff --git a/mangadownloader/forms/frmCustomColor.lrj b/mangadownloader/forms/frmCustomColor.lrj new file mode 100644 index 000000000..5cd228657 --- /dev/null +++ b/mangadownloader/forms/frmCustomColor.lrj @@ -0,0 +1,7 @@ +{"version":1,"strings":[ +{"hash":164667949,"name":"tcustomcolorform.caption","sourcebytes":[67,117,115,116,111,109,67,111,108,111,114,70,111,114,109],"value":"CustomColorForm"}, +{"hash":257144884,"name":"tcustomcolorform.tsbasiclist.caption","sourcebytes":[66,97,115,105,99,32,108,105,115,116],"value":"Basic list"}, +{"hash":221522148,"name":"tcustomcolorform.tsmangalist.caption","sourcebytes":[77,97,110,103,97,32,108,105,115,116],"value":"Manga list"}, +{"hash":117201380,"name":"tcustomcolorform.tsfavoritelist.caption","sourcebytes":[70,97,118,111,114,105,116,101,32,108,105,115,116],"value":"Favorite list"}, +{"hash":148485892,"name":"tcustomcolorform.tschapterlist.caption","sourcebytes":[67,104,97,112,116,101,114,32,108,105,115,116],"value":"Chapter list"} +]} diff --git a/mangadownloader/forms/frmCustomColor.pas b/mangadownloader/forms/frmCustomColor.pas new file mode 100644 index 000000000..84356c2b2 --- /dev/null +++ b/mangadownloader/forms/frmCustomColor.pas @@ -0,0 +1,756 @@ +unit frmCustomColor; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Types, Forms, Graphics, Dialogs, ColorBox, ComCtrls, + VirtualTrees, FMDOptions, IniFiles; + +type + TColorItem = record + N: String; + C: TColor; + end; + + { TColorItems } + + TColorItems = class + private + FColors: array of TColorItem; + function GetC(Index: Integer): TColor; + function GetN(Index: Integer): String; + procedure SetC(Index: Integer; AValue: TColor); + procedure SetN(Index: Integer; AValue: String); + public + destructor Destroy; override; + public + function Count: Integer; + procedure Add(const AName: String; const AColor: TColor); + property N[Index: Integer]: String read GetN write SetN; + property C[Index: Integer]: TColor read GetC write SetC; default; + end; + + { TVirtualStringTree } + + TVirtualStringTree = class(VirtualTrees.TVirtualStringTree) + private + FCI: TColorItems; + procedure SetCI(AValue: TColorItems); + public + property CI: TColorItems read FCI write SetCI; + end; + + { TCustomColorForm } + + TCustomColorForm = class(TForm) + CBColors: TColorBox; + btColors: TColorButton; + pcCustomColorList: TPageControl; + tsChapterList: TTabSheet; + tsMangaList: TTabSheet; + tsFavoriteList: TTabSheet; + tsBasicList: TTabSheet; + VTBasicList: TVirtualStringTree; + VTChapterList: TVirtualStringTree; + VTMangaList: TVirtualStringTree; + VTFavoriteList: TVirtualStringTree; + procedure btColorsColorChanged(Sender: TObject); + procedure CBColorsChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure VTBasicListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; + CellRect: TRect; var ContentRect: TRect); + procedure VTBasicListDrawText(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const CellText: String; + const CellRect: TRect; var DefaultDraw: Boolean); + procedure VTBasicListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex); + procedure VTBasicListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + procedure VTBasicListPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + private + { private declarations } + procedure DrawBoxColorText(const TargetCanvas: TCanvas; const BoxColor: TColor; + const CellText: String; CellRect: TRect); + procedure SetSelectedColor(const AColor: TColor); + public + { public declarations } + end; + + TVTList = record + VT: VirtualTrees.TVirtualStringTree; + PaintText: TVTPaintText; + BeforeCellPaint: TVTBeforeCellPaintEvent; + PaintBackground: TVTBackgroundPaintEvent; + end; + + { TVTApplyList } + + TVTApplyList = class + private + FCount: Integer; + FVTList: array of TVTList; + private + procedure VTOnPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); + procedure VTOnBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; + Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + procedure VTOnPaintBackground(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; const R: TRect; + var Handled: Boolean); + private + procedure InstallCustomColors(Index: Integer); + function GetItems(Index: Integer): VirtualTrees.TVirtualStringTree; + procedure SetItems(Index: Integer; AValue: VirtualTrees.TVirtualStringTree); + public + constructor Create; + destructor Destroy; override; + function IndexOf(const AVT: VirtualTrees.TVirtualStringTree): Integer; + procedure Add(const AVT: VirtualTrees.TVirtualStringTree); + procedure Remove(const AVT: VirtualTrees.TVirtualStringTree); + property Items[Index: Integer]: VirtualTrees.TVirtualStringTree read GetItems write SetItems; default; + property Count: Integer read FCount; + end; + +procedure AddVT(const AVT: VirtualTrees.TVirtualStringTree); inline; +procedure RemoveVT(const AVT: VirtualTrees.TVirtualStringTree); inline; +procedure Apply; +procedure LoadFromIniFile(const IniFile: TIniFile); +procedure SaveToIniFile(const IniFile: TIniFile); + +var + CustomColorForm: TCustomColorForm; + +implementation + +const + TextStyleLeftCenter: TTextStyle = ( + Alignment: taLeftJustify; + Layout: tlCenter; + SingleLine: True; + Clipping: False; + ExpandTabs: True; + ShowPrefix: False; + Wordbreak: False; + Opaque: False; + SystemFont: False; + RightToLeft: False; + EndEllipsis: True); + +var + // color collection + BasicListColors, + MangaListColors, + FavoriteListColors, + ChapterListColor: TColorItems; + + // current selected color list + SelectedColorList: TVirtualStringTree; + + // vt list to apply + VTApplyList: TVTApplyList; + +procedure DoInit; +begin + BasicListColors := TColorItems.Create; + with BasicListColors do + begin + Add('BackgroundColor', clWindow); + Add('BorderColor', clBtnFace); + Add('DisabledColor', clBtnShadow); + Add('DropMarkColor', clHighlight); + Add('DropTargetColor', clHighLight); + Add('DropTargetBorderColor', clHotLight); + Add('FocusedSelectionColor', clHighLight); + Add('FocusedSelectionBorderColor', clHotLight); + Add('GridLineColor', clBtnFace); + Add('HeaderHotColor', clBtnShadow); + Add('HotColor', clWindowText); + Add('SelectionRectangleBlendColor', clHighlight); + Add('SelectionRectangleBorderColor', clHotLight); + Add('TreeLineColor', clBtnShadow); + Add('UnfocusedSelectionColor', clBtnFace); + Add('UnfocusedSelectionBorderColor', clBtnShadow); + Add('NormalTextColor', clWindowText); + Add('FocusedSelectionTextColor', clWindowText); + Add('UnfocusedSelectionTextColor', clWindowText); + Add('OddColor', CL_BSOdd); + Add('EvenColor', CL_BSEven); + Add('SortedColumnColor', CL_BSSortedColumn); + end; + + MangaListColors := TColorItems.Create; + with MangaListColors do + begin + Add('NewMangaColor', CL_MNNewManga); + Add('CompletedMangaColor', CL_MNCompletedManga); + end; + + FavoriteListColors := TColorItems.Create; + with FavoriteListColors do + begin + Add('BrokenFavoriteColor', CL_FVBrokenFavorite); + Add('CheckingColor', CL_FVChecking); + Add('NewChapterFoundColor', CL_FVNewChapterFound); + Add('CompletedSeriesColor', CL_FVCompletedManga); + Add('EmptyChapters', CL_FVEmptyChapters); + end; + + ChapterListColor := TColorItems.Create; + with ChapterListColor do + begin + Add('DownloadedColor', CL_CHDownloaded); + end; + + SelectedColorList := nil; + VTApplyList := TVTApplyList.Create; +end; + +procedure DoFinal; +begin + BasicListColors.Free; + MangaListColors.Free; + FavoriteListColors.Free; + ChapterListColor.Free; + VTApplyList.Free; +end; + +procedure ApplyBasicColorToVT(const AVT: VirtualTrees.TVirtualStringTree); +begin + with AVT.Colors do + begin + AVT.Color := BasicListColors[0]; + BorderColor := BasicListColors[1]; + DisabledColor := BasicListColors[2]; + DropMarkColor := BasicListColors[3]; + DropTargetColor := BasicListColors[4]; + DropTargetBorderColor := BasicListColors[5]; + FocusedSelectionColor := BasicListColors[6]; + FocusedSelectionBorderColor := BasicListColors[7]; + GridLineColor := BasicListColors[8]; + HeaderHotColor := BasicListColors[9]; + HotColor := BasicListColors[10]; + SelectionRectangleBlendColor := BasicListColors[11]; + SelectionRectangleBorderColor := BasicListColors[12]; + TreeLineColor := BasicListColors[13]; + UnfocusedSelectionColor := BasicListColors[14]; + UnfocusedSelectionBorderColor := BasicListColors[15]; + AVT.Repaint; + end; +end; + +procedure AddVT(const AVT: VirtualTrees.TVirtualStringTree); +begin + VTApplyList.Add(AVT); +end; + +procedure RemoveVT(const AVT: VirtualTrees.TVirtualStringTree); +begin + VTApplyList.Remove(AVT); +end; + +procedure ApplyToFMDOptions; +begin + //basiclist + CL_BSNormalText := BasicListColors[16]; + CL_BSFocusedSelectionText := BasicListColors[17]; + CL_BSUnfocesedSelectionText := BasicListColors[18]; + CL_BSOdd := BasicListColors[19]; + CL_BSEven := BasicListColors[20]; + CL_BSSortedColumn := BasicListColors[21]; + + //mangalist + CL_MNNewManga := MangaListColors[0]; + CL_MNCompletedManga := MangaListColors[1]; + + //favoritelist + CL_FVBrokenFavorite := FavoriteListColors[0]; + CL_FVChecking := FavoriteListColors[1]; + CL_FVNewChapterFound := FavoriteListColors[2]; + CL_FVCompletedManga := FavoriteListColors[3]; + CL_FVEmptyChapters := FavoriteListColors[4]; + + //chapterlist + CL_CHDownloaded := ChapterListColor[0]; +end; + +procedure Apply; +var + i: Integer; +begin + ApplyToFMDOptions; + if VTApplyList.Count > 0 then + for i := 0 to VTApplyList.Count - 1 do + ApplyBasicColorToVT(VTApplyList[i]); +end; + +procedure LoadFromIniFile(const IniFile: TIniFile); +var + i: Integer; +begin + with IniFile do + begin + //basiclist + for i := 0 to BasicListColors.Count - 1 do + BasicListColors[i] := StringToColor(ReadString('BasicListColors', BasicListColors.N[i], + ColorToString(BasicListColors[i]))); + + //mangalist + for i := 0 to MangaListColors.Count - 1 do + MangaListColors[i] := StringToColor(ReadString('MangaListColors', MangaListColors.N[i], + ColorToString(MangaListColors[i]))); + + //favoritelist + for i := 0 to FavoriteListColors.Count - 1 do + FavoriteListColors[i] := StringToColor(ReadString('FavoriteListColors', FavoriteListColors.N[i], + ColorToString(FavoriteListColors[i]))); + + //chapterlist + for i := 0 to ChapterListColor.Count - 1 do + ChapterListColor[i] := StringToColor(ReadString('ChapterListColor', ChapterListColor.N[i], + ColorToString(ChapterListColor[i]))); + + ApplyToFMDOptions; + end; +end; + +procedure SaveToIniFile(const IniFile: TIniFile); +var + i: Integer; +begin + with IniFile do + begin + //basiclist + for i := 0 to BasicListColors.Count - 1 do + WriteString('BasicListColors', BasicListColors.N[i], ColorToString(BasicListColors[i])); + + //mangalist + for i := 0 to MangaListColors.Count - 1 do + WriteString('MangaListColors', MangaListColors.N[i], ColorToString(MangaListColors[i])); + + //favoritelist + for i := 0 to FavoriteListColors.Count - 1 do + WriteString('FavoriteListColors', FavoriteListColors.N[i], ColorToString(FavoriteListColors[i])); + + //chapterlist + for i := 0 to ChapterListColor.Count - 1 do + WriteString('ChapterListColor', ChapterListColor.N[i], ColorToString(ChapterListColor[i])); + end; +end; + +{$R *.lfm} + +{ TVTApplyList } + +procedure TVTApplyList.VTOnPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + with VirtualTrees.TVirtualStringTree(Sender), TargetCanvas.Font do + begin + if Selected[Node] and + ((toFullRowSelect in TreeOptions.SelectionOptions) or (FocusedColumn = Column)) then + begin + if Focused then + Color := CL_BSFocusedSelectionText + else + Color := CL_BSUnfocesedSelectionText; + end + else + Color := CL_BSNormalText; + end; + + if Assigned(FVTList[Sender.Tag].PaintText) then + FVTList[Sender.Tag].PaintText(Sender, TargetCanvas, Node, Column, TextType); +end; + +function BlendColor(FG, BG: TColor; T: Byte): TColor; + function MixByte(B1, B2: Byte): Byte; + begin + Result := Byte(T * (B1 - B2) shr 8 + B2); + end; + +var + C1, C2: LongInt; +begin + C1 := ColorToRGB(FG); + C2 := ColorToRGB(BG); + Result := (MixByte(Byte(C1 shr 16), Byte(C2 shr 16)) shl 16) + + (MixByte(Byte(C1 shr 8), Byte(C2 shr 8)) shl 8) + + MixByte(Byte(C1), Byte(C2)); +end; + +procedure TVTApplyList.VTOnBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +var + isSortedColumn: Boolean; +begin + with VirtualTrees.TVirtualStringTree(Sender), TargetCanvas do + begin + if CellPaintMode = cpmPaint then + begin + if odd(Node^.Index) then + Brush.Color := CL_BSOdd + else + Brush.Color := CL_BSEven; + isSortedColumn := (Header.SortColumn <> -1) and (Header.SortColumn = Column); + if (not isSortedColumn) and (Brush.Color <> clNone) then + FillRect(CellRect); + end; + + if Assigned(FVTList[Sender.Tag].BeforeCellPaint) then + FVTList[Sender.Tag].BeforeCellPaint(Sender, TargetCanvas, Node, Column, CellPaintMode, + CellRect, ContentRect); + + if isSortedColumn and (CellPaintMode = cpmPaint) and (CL_BSSortedColumn <> clNone) then + begin + Brush.Color := BlendColor(CL_BSSortedColumn, Brush.Color, SelectionBlendFactor); + FillRect(CellRect); + Pen.Color := CL_BSSortedColumn; + Line(CellRect.Left, CellRect.Top, CellRect.Left, CellRect.Bottom); + Line(CellRect.Right - 1, CellRect.Top, CellRect.Right - 1, CellRect.Bottom); + end; + end; +end; + +procedure TVTApplyList.VTOnPaintBackground(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; const R: TRect; var Handled: Boolean); +var + AColumnRect: TRect; + i: Integer; +begin + with VirtualTrees.TVirtualStringTree(Sender) do + begin + if Header.Columns.Count <> 0 then + begin + Handled := True; + + // draw background + TargetCanvas.Brush.Color := Color; + TargetCanvas.FillRect(TargetCanvas.ClipRect); + + // draw vertgridline for each column + i := Header.Columns.GetFirstVisibleColumn(); + while i <> InvalidColumn do + begin + AColumnRect := R; + AColumnRect.Left := Header.Columns[i].Left; + AColumnRect.Right := AColumnRect.Left + (Header.Columns[i].Width - 1); + if toShowVertGridLines in TreeOptions.PaintOptions then + begin + TargetCanvas.Pen.Color := Colors.GridLineColor; + TargetCanvas.Line(AColumnRect.Right, AColumnRect.Top, AColumnRect.Right, AColumnRect.Bottom); + end; + // draw sorted column + if (i = Header.SortColumn) and (CL_BSSortedColumn <> clNone) then + begin + TargetCanvas.Brush.Color := + BlendColor(CL_BSSortedColumn, TargetCanvas.Brush.Color, SelectionBlendFactor); + TargetCanvas.FillRect(AColumnRect); + TargetCanvas.Pen.Color := CL_BSSortedColumn; + TargetCanvas.Line(AColumnRect.Left, AColumnRect.Top, AColumnRect.Left, AColumnRect.Bottom); + TargetCanvas.Line(AColumnRect.Right - 1, AColumnRect.Top, AColumnRect.Right - 1, + AColumnRect.Bottom); + end; + i := Header.Columns.GetNextVisibleColumn(i); + end; + + // draw fixed column on top of others + TargetCanvas.Brush.Color := Color; + TargetCanvas.Pen.Color := Colors.GridLineColor; + i := Header.Columns.GetFirstVisibleColumn(); + while i <> InvalidColumn do + begin + if coFixed in Header.Columns[i].Options then + begin + AColumnRect := R; + AColumnRect.Left := Header.Columns[i].Left; + AColumnRect.Right := AColumnRect.Left + (Header.Columns[i].Width - 1); + TargetCanvas.FillRect(AColumnRect); + if toShowVertGridLines in TreeOptions.PaintOptions then + TargetCanvas.Line(AColumnRect.Right, AColumnRect.Top, AColumnRect.Right, AColumnRect.Bottom); + end; + i := Header.Columns.GetNextVisibleColumn(i); + end; + end; + end; + + if Assigned(FVTList[Sender.Tag].PaintBackground) then + FVTList[Sender.Tag].PaintBackground(Sender, TargetCanvas, R, Handled); +end; + +procedure TVTApplyList.InstallCustomColors(Index: Integer); +begin + with FVTList[Index], VT do + begin + // set options + LineStyle := lsSolid; + if Color = clDefault then + Color := clWindow; + LineStyle:=lsDotted; + Header.Options:=Header.Options+[hoHotTrack]; + {$if VTMajorVersion < 5} + TreeOptions.PaintOptions:=TreeOptions.PaintOptions+[toUseExplorerTheme,toHotTrack]; + {$endif} + + // save original event + PaintText := OnPaintText; + BeforeCellPaint := OnBeforeCellPaint; + PaintBackground := OnPaintBackground; + + // set custom event + OnPaintText := @VTOnPaintText; + OnBeforeCellPaint := @VTOnBeforeCellPaint; + OnPaintBackground := @VTOnPaintBackground; + end; +end; + +function TVTApplyList.GetItems(Index: Integer): VirtualTrees.TVirtualStringTree; +begin + Result := FVTList[Index].VT; +end; + +procedure TVTApplyList.SetItems(Index: Integer; AValue: VirtualTrees.TVirtualStringTree); +begin + if FVTList[Index].VT <> AValue then + FVTList[Index].VT := AValue; +end; + +constructor TVTApplyList.Create; +begin + FCount := 0; +end; + +destructor TVTApplyList.Destroy; +begin + SetLength(FVTList, 0); + inherited Destroy; +end; + +function TVTApplyList.IndexOf(const AVT: VirtualTrees.TVirtualStringTree): Integer; +begin + Result := 0; + while (Result < FCount) and (FVTList[Result].VT <> AVT) do + Inc(Result); + if Result = FCount then + Result := -1; +end; + +procedure TVTApplyList.Add(const AVT: VirtualTrees.TVirtualStringTree); +begin + if IndexOf(AVT) = -1 then + begin + SetLength(FVTList, FCount + 1); + FVTList[FCount].VT := AVT; + AVT.Tag := FCount; + InstallCustomColors(FCount); + Inc(FCount); + end; +end; + +procedure TVTApplyList.Remove(const AVT: VirtualTrees.TVirtualStringTree); +var + i: Integer; +begin + i := IndexOf(AVT); + if i = -1 then Exit; + Dec(FCount); + if i <> FCount then + FVTList[i] := FVTList[FCount]; + SetLength(FVTList, FCount); +end; + +{ TVirtualStringTree } + +procedure TVirtualStringTree.SetCI(AValue: TColorItems); +begin + if FCI = AValue then Exit; + FCI := AValue; + RootNodeCount := FCI.Count; +end; + +{ TColorItems } + +function TColorItems.GetC(Index: Integer): TColor; +begin + Result := FColors[Index].C; +end; + +function TColorItems.GetN(Index: Integer): String; +begin + Result := FColors[Index].N; +end; + +procedure TColorItems.SetC(Index: Integer; AValue: TColor); +begin + if FColors[Index].C <> AValue then + FColors[Index].C := AValue; +end; + +procedure TColorItems.SetN(Index: Integer; AValue: String); +begin + if FColors[Index].N <> AValue then + FColors[Index].N := AValue; +end; + +destructor TColorItems.Destroy; +begin + SetLength(FColors, 0); + inherited Destroy; +end; + +function TColorItems.Count: Integer; +begin + Result := Length(FColors); +end; + +procedure TColorItems.Add(const AName: String; const AColor: TColor); +begin + SetLength(FColors, Length(FColors) + 1); + with FColors[High(FColors)] do + begin + N := AName; + C := AColor; + end; +end; + +{ TCustomColorForm } + +procedure TCustomColorForm.FormCreate(Sender: TObject); +begin + AddVT(VTBasicList); + AddVT(VTMangaList); + AddVT(VTFavoriteList); + AddVT(VTChapterList); + VTBasicList.CI := BasicListColors; + VTMangaList.CI := MangaListColors; + VTFavoriteList.CI := FavoriteListColors; + VTChapterList.CI := ChapterListColor; +end; + +procedure TCustomColorForm.VTBasicListBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +begin + with VirtualTrees.TVirtualStringTree(Sender), TargetCanvas do + begin + if odd(Node^.Index) then + Brush.Color := BasicListColors[19] + else + Brush.Color := BasicListColors[20]; + FillRect(CellRect); + end; +end; + +procedure TCustomColorForm.CBColorsChange(Sender: TObject); +begin + btColors.ButtonColor := CBColors.Selected; + SetSelectedColor(CBColors.Selected); +end; + +procedure TCustomColorForm.btColorsColorChanged(Sender: TObject); +begin + CBColors.Selected := btColors.ButtonColor; + SetSelectedColor(btColors.ButtonColor); +end; + +procedure TCustomColorForm.VTBasicListDrawText(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; const CellText: String; + const CellRect: TRect; var DefaultDraw: Boolean); +begin + DefaultDraw := False; + DrawBoxColorText(TargetCanvas, TVirtualStringTree(Sender).CI[Node^.Index], + CellText, CellRect); +end; + +procedure TCustomColorForm.VTBasicListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex); +begin + if SelectedColorList <> TVirtualStringTree(Sender) then + SelectedColorList := TVirtualStringTree(Sender); + CBColors.Selected := TVirtualStringTree(Sender).CI[Node^.Index]; + btColors.ButtonColor := CBColors.Selected; +end; + +procedure TCustomColorForm.VTBasicListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); +begin + CellText := TVirtualStringTree(Sender).CI.N[Node^.Index]; +end; + +procedure TCustomColorForm.VTBasicListPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + with TargetCanvas.Font do + begin + if Sender.Selected[Node] then + begin + if Sender.Focused then + Color := BasicListColors[17] + else + Color := BasicListColors[18]; + end + else + Color := BasicListColors[16]; + end; +end; + +procedure TCustomColorForm.DrawBoxColorText(const TargetCanvas: TCanvas; const BoxColor: TColor; + const CellText: String; CellRect: TRect); +var + ABoxRect: TRect; + ATextRect: TRect; +begin + with TargetCanvas do + begin + // box color rect + ABoxRect := CellRect; + InflateRect(ABoxRect, -2, -2); + ABoxRect.Left := CellRect.Left; + ABoxRect.Right := ABoxRect.Left + (ABoxRect.Bottom - ABoxRect.Top); + // text rect + ATextRect := CellRect; + ATextRect.Left := ABoxRect.Right + 4; + // box color + Brush.Style := bsSolid; + Pen.Color := clGray; + Brush.Color := BoxColor; + Rectangle(ABoxRect); + // extra border + Brush.Style := bsClear; + Pen.Color := clWhite; + InflateRect(ABoxRect, -1, -1); + Rectangle(ABoxRect); + // text + TextRect(ATextRect, ATextRect.Left, 0, CellText, TextStyleLeftCenter); + end; +end; + +procedure TCustomColorForm.SetSelectedColor(const AColor: TColor); +begin + if (SelectedColorList = nil) or (SelectedColorList.FocusedNode = nil) then Exit; + if SelectedColorList.CI[SelectedColorList.FocusedNode^.Index] = AColor then Exit; + SelectedColorList.CI[SelectedColorList.FocusedNode^.Index] := AColor; + if SelectedColorList = VTBasicList then + begin + ApplyBasicColorToVT(VTBasicList); + ApplyBasicColorToVT(VTMangaList); + ApplyBasicColorToVT(VTFavoriteList); + ApplyBasicColorToVT(VTChapterList); + end + else + SelectedColorList.Repaint; +end; + +initialization + DoInit; + +finalization + DoFinal; + +end. diff --git a/mangadownloader/forms/frmDropTarget.lfm b/mangadownloader/forms/frmDropTarget.lfm index 8c163d9f0..03e202be9 100644 --- a/mangadownloader/forms/frmDropTarget.lfm +++ b/mangadownloader/forms/frmDropTarget.lfm @@ -18,7 +18,8 @@ object FormDropTarget: TFormDropTarget OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp OnShow = FormShow - LCLVersion = '1.5' + LCLVersion = '1.7' + Visible = False object shBorder: TShape Left = 0 Height = 156 @@ -42,78 +43,456 @@ object FormDropTarget: TFormDropTarget OnMouseMove = FormMouseMove OnMouseUp = FormMouseUp Picture.Data = { - 1754506F727461626C654E6574776F726B47726170686963E408000089504E47 - 0D0A1A0A0000000D49484452000000660000006608030000000E011450000000 - 72504C54454A4B4FFFFFFFFCFCFE47484C44454945464B4C4D5150515557585C - F7F7F8F3F3F4707174525357E0E0E1FAFAFB4142465D5E62E6E6E7D3D3D5AFAF - B1EEEEEF6364676E6F72C4C4C6BCBDBF88898CCCCCCD8283868E8E9168696DDB - DCDC7A7B7E9A9B9EA7A7AAB7B8BA9D9EA1ACACAE94949701732EBB0000082D49 - 4441546881BD9AD902AB280C4045D0D65DEBAE55ABD6FFFFC581964D40DBDEB9 - 33796C9563421242C002FF8B58BF3C1CFB45168D44A2ACF0E3FF0253DC9A796B - A76A28CBB42C8760BA3FF27AF4FF26C68E9676B85E2C881064821CE88669F0A8 - 8BBF83F1C7B54C123CAAA50B844902A725F3FE2D265AFA3031118420946EDD07 - 9DCE31D15C59E81CF2520A857D730A3AC3146B697D6650EB5D82E68F30457E64 - 2DF3AF2899BAC3393AC2C4DD04D5E1B0A3610BBA97CBC5C513A23B050A1FD16F - 187FBE3A0A2281E9749F97A6EEBAAE6EF2B5AD429420E5A1A0FE0533EE55C16A - 5CFBFC5678318F7C3BF6FCAC5E0317ED5C0486AB31624D9878B9CA5F89DC61AB - 5F2FDB7B213F45799FCAD6834960329C01E33D5DE93D749996C8D61002E5DDD6 - 41D63D19BA6F30FE2A51209A483651745041D133959C1296BA6B6B98E22E1C16 - 3A65E329102FBA65B1A21B00D923147686E1F209534C89783C9D554DBC7C8089 - 1560B80A1A5B610498E4E718FF9E0855A69BF2D9D8A02F1746EEACCD15F0F314 - 49FAC427186F15AAC02DD3C65A2E90FED9E91CFB16084E5A1F6362E163F0BAA8 - 86B14136B17192DE5331E4FF3B0F2227BD1D62164E4165A7FB30B85DF9579491 - C1C5412CBC14A5D90166E4A3A0E1661AA5BB704C6A7A0073E6903D92B4BE11E3 - 739398295F606C39B6DDDC848967115F07634898ABF911ACCF93A5049876064C - C74C06AFBA1B7D8DC111F460B91D4D858629268779F27234C237181C402DE3C0 - 59C3E4DC1537CD934D98038DC963514527198699822998C9D0A44725C784DF60 - 6C50B3C1924DC1ACC9B90BFD82B1ED1989C7644C54D2019C393EFE4A09139E61 - 40C1CDB679328639332C8B1363C898FA4C1B50330CCD396F4C54B19969CE3E52 - 241BEB1C63C72DE5388F586016EEE9475EF62306DC529ACBD38863FCFECD8697 - 73537C8FB1FD8DD927E79891DA9C84ED5FC270A78615C7306F768FE25FC75CCE - 26913CCB2C642523C5D8D49BE1605A44644CFA35C6060DC3CC1413D11FD0761C - 33AF37470973AE38899D2B9B89F88D59A8CDD0277B4B980FF6254F33BF22BE46 - 30D4C7E1D5570B3D4578AE7861F6A26398D5B07D09A618A8763DD831FC2C7A49 - C6A4E824CCB378892FC48B773090315F5B5F18E63FB886931EF2EA7B3510A95E - 1210A92E1697A17F4BFB923B966DAD77E6F0E80AE6F43EC134F465B8CBCD6B48 - 36E70E9464B76F227B2A220EE202C35E8EBB78A59311640443D3264CA567C0F3 - C3F6D92878D7218FD1B0816F18136FCCF1448507B2F40F28C4404F09C366E3D2 - 618C4F1D0DDD45D480DAFD238A05A5740522EA5BD68231052DCF90B4A081E5CF - 94D925125C0BBF7D003D3126A36B8D5CD030B3FE3B4C410314ADB1255493B214 - 88AE7F3837728EF7EF14B361CC4863CEDDA51AB1CFF94D9BA71C38CCB9EE9EC0 - 5CE4228287F06F820639703C5A7FA29660DEBE0B7718EC6B97DF39D0DD45B8F7 - 8012C6A48DB4CAFE8259E511CC98FDDCD8A2DAF95A1CA560F5366A343237264F - 7B3BF58F18B51215814F3C2D0BA86AB9BD17B0FDE66D7056DE97025FCA02ABB2 - 44836C4067C32A8202A52CE20A38F92BA771B753D5697EF036E8AA55B598F586 - 6468EA0F4EE52B181E5F5F29B3AA6FB3929B94F578BDC9DFD998EC79D407B3E9 - 5B0EECF54A92EECC6039124CCD6A4EBDB091F6671F28A9BE118937BA7A4EAFD5 - 939545C96AA889BEF436A46F8B805FBD271DDE5FB5801F501F080C5550F195B7 - A1CAD72D31B2A5F1F9AED31EAC8436D4B6621F7F66B2D0B093047342FFECDE98 - 9A559DB9C16A5253EA1833EBEFD936ED47C1217B630AA67A6FD844496DA74393 - 9936DF20A236432DDB784CACDA3537843E74F0CDBB6AC076D349C3300BDB90AE - 862E197EC1396658AF8AC2F052C6FCEC52300CABCACC1B1C9EF50E2881EE6536 - 6924D2BF7BBE5BF336A68EE9C3CEBD0D5E8C962E58FE80B5D849B30D3F4C8D9D - 14D10333608C5E061AE60041213045CF9A2C0FA33A457F343DA65CB68BEA45EE - 72F05D41381A39B7D06C36532EB34568E2B41FC99882F576516B9C50FE9E2289 - D964A26B3AEF3B500D1BC655D7EAF78BBED1DB5060EA8AF0AA16AF01D91EC342 - F4B0277B2B75B31DF40885C7246C87CA31BCBB8402B3B7E586BD88D964BC6B87 - 064FC578A2137A574F34F6961026337B19DF6F439777F045E7360A78B37B3572 - 2265253D4881BC6567C187A763F8628DBF6236CE6CBEC718D70D9071A5C9E26C - C0C4AC4384A3E769D08757916C0E8DCB462BB7434D18BC5A738EFB34F52D646F - 33AF983C9D602F7B02334694D316840F53982E52FFE1A9FF2D3AD038FE5B7084 - 0152B7C469F54501787C1367C86520AE4B714ED417C718D088DC85AADAD6468A - E88928D24F2B40318BF5024EFBD34FF5086F11DD0D749DF52FAED3044194849D - FA07187BB198A37204A718900B7D201A6AEDEC317B4ED5342B89021055A413C9 - 523DC9D58F579754AC2D08B5375F3D5DB53DE55017D84533C8E7ABD3A80EAA63 - E23A95C203A55BED1D1E15BFB9D932B9D22B4EAF9F4A9B8EBE6FA9B4B840787D - 5FA03023801DCD959C8560D21AAE5B180FF2B3563EFC7E1DE33799F73E30E5E3 - 93C37C7F9C03777792EF5C9FA611CDF705E41359469AD6E6462E0B7944FC221B - BB7CABDCFDC5040827C3F1FA210607AA7AC70293ACEB30F5F7EDF1786CED1494 - 21444A2182DC47661EEEF0CA4831EB3746207410228D49E7757D48FD37A9EAA3 - 3B23271760B2EDAA0D752C8E552EC797874EAFF3745B6ABC93A40BB2AAF9C05E - 9F31C0BB3DD2CFB7862082C17274F5E51B0C0ED628AF92E41805718273FB8FD7 - BABEB93816CD537A2133AF12F02FE1D09EDF7EFA1E43746AD63E482F96D4DB76 - C372BA3FBBB319F91543C4CF6EDDF25CB73BE9D56F73DE7463F6ED65BBDFEE0E - 6289E35716887FB93888E51F9AD58D5F41B024670000000049454E44AE426082 + 1754506F727461626C654E6574776F726B477261706869631138000089504E47 + 0D0A1A0A0000000D4948445200000320000003200803000000ECAEF65A000000 + 0467414D410000AFC837058AE90000001974455874536F667477617265004164 + 6F626520496D616765526561647971C9653C00000018504C5445FFFFFF949497 + B2B2B4F0F0F1E1E1E2CDCDCE4A4B4F717275392F01A60000377F4944415478DA + 62601805A36014E0040001348A46C128C003000268148D825180070004D0281A + 05A3000F0008A051340A46011E001040A368148C023C0020804611FD0133330B + 2B2B2B1313132310B043001B3A808A8394005502D5B330338F061DFD0140008D + 227AE50A1656508EC096178807E01C03CC2E2CA379855E0020804611EDF30528 + 5BB0511B80B3CA684EA1390008A05144D38CC1467B309A51680A00026814511B + D02D6760CB27A3C14F6D001040A388BA59839DFE5903ADE1359A4DA80A000268 + 1451A54135F05903239B8C36BAA8020002681451236FB00D46309A4BA8010002 + 681451D2A61AAC790325978CB6B828010001348A28E86FB00D0D30DA2FA10000 + 04D0281A9615C76855422D001040A36804648ED14C423E0008A051344232C768 + 26210F0004D0282276B06A18640E4426191DDE22160004D0282202003BE46CC3 + 0D003BEEA3114B040008A0513412DA55A3AD2DB20140008D2202B9836D7883D1 + 3C42000004D028C2DDB01AB65507468F6434B2710280001A45C3BF4F3EDA6BA7 + 000004D0281AF1B963348FE0030001348A4673C7681EC103000268148DE68ED1 + 3C82070004D0281A79BDF2D13E3B0900208046112C77308DE60E781E199D4484 + 0380001A4520C0329A3B30F2C8E8FC08180004D0281AED788C7647F00080001A + AD3C462B8FD16A040F0008A0115E790CFBA524942F4519E1D50840008DE8CA63 + B4694554536B4457230001345A798C82D16A040F0008A0D19EC72818ED8DE001 + 00013432E73C46DB56A3F387440280001A6D5B8D82D196161E001040A36DAB51 + 30DAD2C203000268B46D350A465B5A780040008DACEC319AC0A9D1D21A515904 + 2080460E1AED7A50B1333272920D40008D989EF968DB8ABA9D9191D25F0708A0 + D1EC310A46B3081E001040A3D963148C66113C00208046C77547C1E8A82F1E00 + 1040A3D963148C66113C00208046B3C72818CD22780040008DF63D46C1685F04 + 0F0008A0D1EC310A46B3081E001040A3D963148C66113C00208086271ACD1E03 + 90458667520208A0E18846D75C0DCC029461B9460B208046B3C72818CD227800 + 40000DBB91DDD105ED03D9CE1A7E073C0004D068DF7C148CF6D6F10080001AED + 9B8F82D1DE3A1E001040A39D8F5130DA15C10300026818753E4653E6E0C922C3 + A72B021040A39D8F5130DA15C10300026898B4AE46B3C7A0CB22C3A49D051040 + A3ADAB5130DACEC203000268B475350A46DB59780040008D8E5D8D82D1F12C3C + 002080465B57A360B49D85070004D0E8CCE028189D37C403000268B4FA1805A3 + 95081E001040A3D5C72818AD44F00080001AED9C8F82D1CE3A1E001040A363BB + A36074C4170F0008A0D1EA63148C5622780040008D561FA360B412C103000268 + B4FA1805A395081E001040A38357A36074380B0F0008A0D1EA63148C56227800 + 40008D561FA360B412C10300026874EA7C80120A3B3B2323231310B0B2B2B2B0 + B030030162140208806240199002A03AA0EAE153890CAD897580001A52CD2BF6 + 219F2B4079029821C819CF616601E517506619EAA130A49A5900013484067719 + 8772C600E60B166A0D7302B30A30A70CE18CC23884067C010268B4774EEB9C41 + BD8C812DA30CCD7C3284FAEA000134DA3BA751D60036A658E9535032B3821A5E + A37D75DA0080001AED9DD3206F006B0DFA0711A83619EDAB531D0004D068EF9C + DA796320DBD7CC4328970C91BE3A40008D36AF8649DE187AB9646834B3000268 + B479459DCC31D81A0C2C4321930C85661640008D36AF865FE6183A99640834B3 + 000268B479353C33C710C92483BF99051040A39383C337730C894C32D8270D01 + 0268747290BCDCC13AB4E2959975D0E691413E69081040A3DD8F615C750C8D8A + 6470774400026830773F46AB8E1152910CE68E0840008D8EEE8E98DC3188F3C8 + 201EEF0508A0D1EE07F1B9631805EE60CB23833770010268B4FB31D272C7E0CC + 2383B623021040A3DD8F91D1B21AFC6DAD41DA110108A0D1D90F4295FF303ECE + 8999695085F4A00C6880001AED9EE39FE81DEEBD479641B454615076D5010268 + B4FB31823A1E83BD3B32183B220001349A3F4660D36AD036B506610E0108A041 + D73D671FAD3C46703532F8162F0204D0E8F015B6581A89DDC5417224F860CB21 + 0001343A7C35E22B8F41568D0CB2C12C80001A1DBE1A61C356837F506B700D66 + 0104D068F77CC4B7AD065D4B6B5075D5010268347F8CAE07C26C698DE6103800 + 08A0D1FC31DAF5187C9D91419443000268747817923D46DBBDE8FDC1818D9041 + 3398051040A3C3BBA33DF341D95F1F2C3904208046F3C768F6189C596490E410 + 80001A1403278C03993D4607AE06E990D6E098100108A0919D3F46B3C760CE22 + 8322870004D060E80E8E668FD12C3268A70C010268E4E68FD1BEC7E0EF8B0C82 + 1C02104023357F8C0EEC0E8941DF818F2580001AE8901F0DF8D1820C6F4136D0 + 1105104023327F8CCE9A9301066801CA40E71080001AD830671FCD1EA3596470 + 2F3B0108A011973F4687AE86DA80D6C0E61080001A61F96374E86A080E680D68 + 0E0108A091953F46FBE643B2B73E90390420804652FE185D443D1A7324038000 + 1A39A13CDAF918C25D9181CB2100013462F2C768EB6A48B7B3062C870004D008 + C91F833D7C41779B33B24342859D9D9191899565340607450C0204D0C01440EC + A3AD2BE4160BD6851C83FCAA37BAB7B30668C61020804642FE18CC3383CCF82E + 0E641FD4E79FD27BDE7060720840000DFFFC3198B737135E0438A81755D2B912 + 19901C021040C3BE8337881318912131882BC0111097000134CCC3947D5824AE + 419C30E8DB591F8080000820BAB7B919470394F43EEE201E65A06F8147FF5DB8 + 0001349CF307FB306A9B0CE276165D2B11BAE7108000A233621CAD3EC8ECDD0E + E2B106BA56228C74F61C4000D139618C0E5E915F8D0EE2C2939EC359748E5780 + 001AAEF963E80F5E8D0C3F0DFA1C021040C3337F0CEAB90FF24BDBC1BCDC828E + 95085D231720808665676E308F0652344D3A987308FD2A11BA860240000DC7FC + 3198D76750B88C807D50AF9A198E39042080865FFE18D4A147F1329B41BDDC62 + 38C63140000D9994312C265BA9300D34A82702E8D6CCA25F390110404327650C + F9DE390375A68106F74400BDFAEA742B2700026808A58CA15FF552A7913EB8CB + 007A35B3E8554E0004D0B01AE01DE46BD9A8D4CC1CE4A500BD9A59742A270002 + 6818E58FC17EAF1DD59A9983BD7941A766167DA21B2080864FAD3BE847369846 + 4CD2184E110E1040C326B806FD56012A8EE30DFA311CFA34B3E89243000268B8 + 0CF00EFE43AFA89966067D0F953E9386F42828000268780CF00E816BB559A8EA + E1C15F76D2A5234287DE1840000D8B01DEA150D752371C86C020275D5AD6B40F + 0780001A0E03584361A7320B95FD3C14BC4C8FB291E64D078000A27531325ACF + D2A6221D0A45275D5AD7B46E3C0004D090AF66D9874419C24CED80601F12AD6F + 3A744468DDBC0608A0A15EC90E91F0611DA125271D4A481A37B00102688877D0 + 874AF941FD901822DD537AE4109A7A0020808676077DA8941ECCD44F26EC4364 + 84930EAD089A36B20102684877D087CC30380B0D3C3F545A1674E8AAD3B21901 + 104043B9721D3A2507D3A8EF876A431B2080866EC1C13E846A565A9415EC43A8 + ADCD3E749B12000134643BE843AAD4A049088CB626E8D1510708A0A15AAD0EA9 + FCC132E25BDE34CF21346B4E0004D0100D90A1D5EAA44D69C13E9A20E8902000 + 02884645268D8363884D0ED12834865692A0719B9B564BDF01026848764086DA + E429DB6806A17D0EA1513704208086620764C88D598C66107A8C6BD2A61B0210 + 4043B0BD39F4C6F44633083D72086DBA21000134F43A204370CC7B3483D02787 + D0A2E50D104043AE03321417DE8C6610FA34BE69D10D0108A0A11606437261DA + 680619BAA903208086580764682EDC1CCD2074CA2134E8860004D0D06A660ED1 + 85CDA319845E3984FA1D5480001A521D90A1BAF07F3483D02F8750DBB5000144 + ED06D668FE18CD20039A43A8DDC80208A02134C23B744F7819CD20F4CB21D41E + EB0508A0A1D3C01AC227208D66103AE6102A37B2000268C8F87B289F10369A41 + 866E4A0108A0A132C23BA44FD01BCD20F4CC21D41DEB0508A021D2C01ADA274C + 8E6610BAE610AA36B2000268D4CBA31964B438C5030002684834B086FA29F7A3 + 19040BA0E19432351B5900013414FC3BE46F8118CD204337C50004D01068600D + FD5B52463308BD7308F51A59000134F81B588C43FF9EADD10C821DD06E172EF5 + 1A59000134E80B83E1700FDD6806C19543D8077DB3032080067B036B58DC643A + 9A41E8DFF0A056230B208006B93F87C74DBFA31964E8A61C80001ADC63DAC3E4 + 26ECD10C320039844A7367000134B81B584C0CA31964986790C19E7800026850 + 77B58649FE18CD20039243A833BC03104083B981C5C8309A4146400619DCE907 + 208006710930F427084733C8C0CE1150A30502104083B781351C26404633C890 + 4F42000134682BC8613280359A410672288B0A8D2C8000A2DC6FA3F96334830C + DA1C42792A0208A0C1DA7E646218CD20232883D0AA234B793F16208006ABC718 + 4633C888CA200C83B5A00508A0C1D9BD1A3E0358A31964609B2214F7D3010268 + 50E6FB613480359A4106BAACA5D059000134187BE8C3AA833E9A4106B8A34E61 + 62020820CAAA45F661D96E1CCD20C3A93FCB4E59731D208006A18F865DFE18CD + 2043383D0104D0E06B350EB30EFA680619E88E3A653D5A80001A743DF4E1D641 + 1FCD20035FE452E22480001A6C3DF461D7411FCD2003DF51A7244D0104D060AB + 4098184633C808CE20B4E9865052850004D0A8574633C8A00283ADD80508A0C1 + 35C43B1C3B20A31964E0BB21140CF50204D0A0AA408665076434830C826E08F9 + 550840000DAA8CCEC4309A41467C06A14DD14B76D30420800653539191613483 + 8C66904196B600026810D583C3B403329A410643EB84ECD63B40000DA24CCECA + 309A41463308B8F81D44550840000D1E1F30318C6690D10C42BB6E0899E52F40 + 000D9A0A64182EC11ACD20E4025A2CCA22B30A0108A0C192C1876F076434830C + 926E08794D148000222B7FB38F36B04633C8D02B83C96AA30004D020713C23C3 + 680619CD20346EC59355080304D0E0A8408675036B34830C9246165955084000 + 0D8E0A645837B04633C86069649193CC000268505420C3BB81359A41064B238B + 9C2A0420800643CE1EE60DACD10C32681A59645421000134189CCDCA309A4146 + 330826601D0C453140000D820A64B837B04633C8E06964915E850004D0C05720 + C3BE81359A418672620308A081AF40867D036B34830CA24616C9550840000D78 + 9E1EFE0DACD10C32881A59245721000134D015C80868608D6690C15420935A85 + 0004106988997DA85579A319646803EA97C824CE850004D0003B772434B04633 + C8A06A649158240304D0C05620ECACA319643483E0EFA7B30F6C15021040035B + 818C8806D6680619CA890E208006B602611ECD20A3196470A73A80001AD0BC3C + 321A58A31984C246D68056210001440AA27656666418CD20A31984FEFD747652 + 2C0708A001AC4046C414C86806A11C507D3284942A04208006302333318C6690 + D10C32104533294D1780001AB8A6E048E9A18F6690C1D74F27A1F30B10400357 + 81B0328C6690D10C3230853309550840000D2B378E6690D17E3AB54B6780001A + 28278E9C1EFA68061984FD74E28B6780001A281732318C6690D10C3260FD74E2 + CB6780001A360E1CCD20A355082D0A6880001AA071841155818C669041584213 + 3B860A104003E33C46E6D10C329A41482BA21907A6880608A081E9A2B3328C66 + 90D10C32A0C3A8C476D301026818386E34838C0EF5D2AE900608A0D10A643483 + 8C5621780040000DC410C248AB404633C8602CA6891C480508A001E8A28FAC21 + DED10C3258CB69E2BAE90001340063BC23AE0219CD2083B30A216A2815208046 + 2B90D10C325A85E001000144FF8CCBC4309A414633C86028AA896ACA00041031 + F976B40219CD20C3B20A2126290204D06805329A4146AB103C002080E8DD4567 + 671ECD20A319640825468000A277A61D8915C8680619AC550811A9112080E8DC + C21A9115C8680619AC5508116D2C8000A273177D445620A31964D0562184BBE9 + 0001445F078DCC0A6434830CDA2A8470810D104043CD3DA319648467107A97D8 + 00014408517509E5489C0319CD205406D49D0B21B8B01C2080E8DA451FA115C8 + 680619BC5508C16E3A4000D133BB8ED40A6434830CDE2A84609A0408A0A1945B + 4733C86806A17BAB06208008A0D10A6434830CF32A848065000144C72EFA88AD + 404633C860AE420874D30102888E2D2CD6D10C329A41A80258E9D8C6020820FA + B5B0466E05329A4106731542A08D051040F4CBA9ACA3196434830CC62A047FC2 + 0408A02191514733C8680619A8A60D4000E143545D66C2349A41463308D50035 + 3BC7F8979B000410BD2AB211BA4C713483D00650B5ECC6DBC60208207AB5B046 + 7205329A4106771582B78D05104074CAA5237792703483D0045073B2106FEB06 + 2080E8D4C2626418CD20A31964B08EF4E26B630104D0E076C2680619CD20035C + 7C0304109D5A580CA3196434830CDA915E7C6D2C8000A24F16651ACD20A31964 + 1077D3F134700002882E2DAC113DC63B9A4106FF482F9E361640000D5AFB4733 + C86806190C25384000D1A585C53A9A414633C8A0EEA6E34EA10001448FFC39D2 + 2B90D10C32E8AB10DC49142080E83148C0349A414633C8E0EEA6E31E66050820 + 3AD45F23BD8B3E9A418640371D671B0B2080465B58A31964B48D852791020410 + 1D5A58ACA3196434830CF66E3ACE36164000E1402C03D9BC1BCD20A31984EEC5 + 38AED5B4000144FBFE0FD3683C8E6690C1DF4DC7954C010288F6AD3B96D1781C + CD2034022CB4EF840004D020B37834838C6690C155900304D0680B6B34838CB6 + B1F024548000A275C61C9D0419CD203404549C0AC1D1D40108205A8F0E8CB6B0 + 4633C8D06863E1186D0508205A8F2F8F4E828C66105A029A27558000A271CB6E + B485359A41864A1B0B7B27042080685C6F8DB6B04633C8506963614FAB000184 + 35578EB6B04633C8086C63616DED0004106DED1C5D66329A41680DD8695B9A03 + 04D0680B6B34838CB6B1F0A45680001A24797234838C6690016F63616DEF0004 + 1016C432DAC21ACD2023B28D856DB5094000D1749077B485359A4186521B0BDB + 402F4000D1D4C2D116D66806194A6D2C6C053A4000D1B2CA1A9D251CCD207400 + D49B2BC4D6250008205A7641465B58A3196468B5B1B07442000288965D90D116 + D66806195A6D2C2C9D108000A2617E1C6D618D669021D6C6C2D2E60108201A76 + 41465B58A3196488B5B1B07442000288865D90D1BD84A319843E8089869D1080 + 001A58CB4633C86806A102A065A10E1040035B5DD1B327C7481A60A722A05106 + 193097B033320DAED28F86DD0280001A115D10665646B65140EDECC934784629 + 6958AA030410ED6AABC1127C2C8CECA3A99946798471904432F5067A316A4680 + 00A299558363909785693477D0B81E190C8D2DEA0DF462E4788000A2591F9D71 + B4F21829D508CB306A6361F4D2010268E06C1ACD1EA35964F00DF46294EB0001 + 44B33EFA408719F368E38A9E0DAD016E5053ADEB8CD14B0708A081B288F6A3BA + A3C9969E60A0BBEB342BD801026898764146AB0FFA5722C3B313021040C3B20B + C2325A7D0C44253290AD6A9A95EC0001341CBB20A3F963E4E5109AF50D000208 + AD673B1CBA20ACA3CDAB816A660D6047846A918E36DC001040349A26641CCD1F + A33964687642D0BC001040346AC9318DE68FD11C32343B21684917208068940D + 5946F3C7680E199A9D10B4C60F4000D1A62137605D1096D1FC31D03964A0CA46 + 1AA55D8000A24D1F7DA0BA20A3E35723772C8B6A518FDA4B070820DAF4D107AA + 0B329A3F06430E19E29D10D446224000D1C60E96211E46A360E8158F2CB4713E + 4000D1A4001EA02EC868077D4477D4A915FBA835204000D1DB0A5AAEDF1D6D60 + 0D964616F3506E5FA316EF000144930CC234DAC01A6D640DD9F847CD20000144 + 9356DC8054B1A323BC237CAC976A434C288E0708209AD830A46BD85130441BD9 + CC3429DF010288BE75D46805325A850CFE5E3A4A03112080685106338E5620A3 + 55C8104E02286E0708A0E1D2471FAD4046AB109AB48000028816196420FAE8A3 + 4358A30359ACB4C8200001448B41AC01E8A3338F562083AD0AA17F2AA05A2F1D + B9F60308203A66C02131C4370A683E1634F87BE9C84E0708201AB4528672FF6C + 140CE56E3AB5520172F3102080E867FC680B6BB48D35443AA2C8791B20806890 + 4158475B58A36040D2012B0D32084000D1A005378407F846C1901EC7A2D63013 + 722F1A2080A83F0630107DF4D116D6606C630DDD7480D43A040820EA67BF01E8 + 9C318FA6C6C108E8DF09A1562F01A911041040746BC08D7641463B2143268320 + B91C2080A8DF8E671AED828C82014A093448C30001342C06B14667410625601C + B24D092497030410F55319F36806190503944198A9EF728000A2FA08C0E820D6 + 28404A0ACC433225202562800042A0D151DE51303ACE0B0508130102883EB513 + 8DC1685A1C9C60E836B611151F4000517D1A846934838C8201CB20D41AC6424C + 84000410D50700584733C82818B00C42FD540C1040F4C87BA3196434830CB1D5 + 5888761040000D8751DED10C329A4168D6930608206A67900139F26734298E66 + 10EA0E6321320840000D876990D161DED1615E9A25638000A243D61BCD20A319 + 64A88DF3229C0E1040D46EA60CC8B1C5A34B4D06251888C2925A634D70030102 + 88DABD9BD10C320A864306818F35010410B5C7C706E460F7D1E5EE83120C4461 + 49AD8910F86C054000D1DCE0D10D5323160C446149F5821E2080685E350DA5D1 + EF514055C03C849302BCF60308202A679001BA9D7074186B74108BBA49019E41 + 00026838CC138E764246BB20349BAE0008202A679001BA237BB41332DA05A151 + 420608A0E1304F38DAC61A942D2CE6A19C41E04D218000A275D36D742664A402 + C621DDDA86671080001A2619846534418E7641689241000288CA2B4D581946DB + 58A3000C5806262150AB3B0A330F2080A83C7C3C601964B49B3EDAC2A26A4280 + F5A0000288CA198465A032C8682F64B48B4ED5C636CCFD0001445B63477B21A3 + 3D90213A950E2BEA010288B62DB7D12A64A4562003970EA8DC59000820EA6690 + 010C97D12A643001D6814B07ECD4F50140000D9F0C325A858CF6D06990410002 + 6858AC5584B63E47877A47F8102F2D66F4000288BA1964204B8ED1258BA31508 + 151B12B00C021040C329838CCE168EF81E3AF5330840000D8BC5BCA3B385A343 + BCB45ACE0B104034CD76A3FDF4D10A64A836B46119042080865706191DEA1DD9 + 43BC34C820000134BC32C8681532C27BE8D4CF200001343C56BB8FF6D3070F60 + 1E1E1904D6500408209ACEAE8C0EF58E56204375A4069641000268B86590D12A + 6444F7D0A99F41000268D86590D1A1DE113CC44B830C021040D4CD202C039F41 + 46FBE923BB02A1D64826CC27000134FC32C8E8318B237788970619042080865F + 0619AD4246700F9DFA19042080A068980CF18DF6D347F6102F355B1050E30002 + 68386690D1A1DE115C81503B830004D070CC20A355C888EDA1533F830004D0B0 + CC20A343BD237488970619042080A89B4118060918EDA78FD80A84DA69192080 + 86670619DD7D3B328778699096010268786690D12A6484F6D0A99F9601026898 + 6690D17E3ADD1B58CCC333830004D070CD20A3FDF411D943A77E5A0608A0E19A + 41461B5923B3874EF5B40C1040C336838CEEBE1D913D74AAA76580001AB61964 + B40A19913D74AAA76580001ABE1964B49F4E47C0326C330840000DCB99F4D125 + 5923B802A1F24C3A40000DE30C325A858CBC215EEA671080001ACE196474A877 + C40DF1523F830004D070CE20A3FDF41137C44BFD0C021040D46D8DB0300CCBB0 + 1A054365889781EA3B0A010268586790D12A64A4F5D0A99F41000268786790D1 + 7EFA081BE2A57E06010820EA2624D6C1964146877A475A0542ED73B100026898 + 6790D12A6464F5D0A99F41000268B86790D1A1DE9134C44B830C021040D4CD20 + 832EB446FBE923AD02A1F6E9EE000144DD64340833C8E850EF081AE2A5620681 + 75AD000268D86790D12A6424F5D0A99F41000268F86790D17E3A0D01F3B0CF20 + 000144DD0CC2381833C8683F7D245520D44ECA000144D36C37DAC81AEDA10FD5 + D8863586000268246490D1DDB7236588970619042080683A36365A858C562043 + B5CB09CB20000144D3D9954133D43BDA4F1F1943BC3498F30608A01191414697 + 648D941E3AF5330840005179A467906690D1A1DE9131C40B0254AE1E010288CA + FDD8411A68A343BD23A602A1D6CA09D8227E8000A2ADB1A3FDF4D11EFA101DB2 + 8415F5000144E50CC2CA30CCC36D140CF29866A57206010820DAB6DC46AB90D1 + 0A648866109879000144DBD1E3D17EFA68053234072CE1050040008D9C0C323A + D43BFC7BE834C820000144E50C3278036EB40AA166038B79D0C6322395330840 + 00D1760DE4E850EFF00483B8A140ED840C1040B4CE78A3FDF4D11EFA506C27C0 + 33084000D1BAE9361CE790467BE8C33F83C0EB488000A276179679B40A19EDA1 + 0F8342109E41000288DA0D7496C19C4146FBE9C33E8E59A85D49020410CD0D1E + EDA78F5620433086E185004000D1BC6A1A6D648D0EF10EC1D92EB82701028881 + CA6B4D067906195D9235CC63985A19046E204000D17C786CB40A191DE21DCAF3 + 84000144ED0C32C8C36F74F7EDF0EE64523F190304101DB2DEE892ACD11EFAD0 + 9D27040820AAB73D98194646108E0EF10EE769104406010820AA97AC2C833D83 + 8C0EF50EE30A845A83308891088000A27ABA611DEC1964B49F3E8C1BD0D44FC5 + 0001448FBC373AD43B3AC43BC47A988876104000D1A3F5365A858C5620432C6A + 113D69800062A0F64CE1E00FC4D17EFAF06D3E532B6611260204103D46904787 + 7A477BE843761A042080E8533B8D5621C3010CFE98A5413F012080A89F415887 + 4006191DEA1D9E15082BF5BD0A1040D46F77300D810C32DA4F1F6D3B13998601 + 02884EB96FB8D6C5A343BCC3B2DC436A05010410F5A70786440619AD42866305 + 42B558459A06010820EA17AA43222447FBE9C3B16B49B548451A8E0008201A98 + CE322432C8683F7DF8B50B586850C6030410BD1A70A38DACD121DE2139880510 + 403448314C0CA355C86805329407B1907D0B1040F4337EB40A19EDA10F911845 + 2EE20102880645EA1009CDD1DDB7C3AED5CC4E03EF0204100DBA3843A3BDCA30 + BA246BB8B509A836B9853CCC04104074CC80A343BDA315C890E855A234810002 + 8816E98569A86490D17EFAB0EA5432D122830004102DFA3843254047FBE9C4A5 + 17E611169B28E9172080E89A0387EDCCD2B00643A641409316104000D1A4C5C1 + 3C5A858C0EF10EDD3E3A4A970B208068529E0E995EFA683F7D184526D5CA7794 + 412C8000A26F1D353AD43BDA431F627D748000A24906193A813A5A85905F9C0E + D7E6326A060108207A5B313AD43B5A810CF2A20ED5CB0001449BF606CB10CA21 + A3FDF4E151D451AD078DDA41000820DA94A643A81332BAFB76B437896F540220 + 8068935686522764B40A191E6D65AA4523EA24054000D1A61937940276B49F3E + 2CC6EB69957601028846B97028754246FBE9C3A121C042234F0304108DDA714C + A355C8E810EFD0EC82A0255D8000A251593AA43A21A355C8684F1267B3122080 + 6834A233B43A21A3FDF4D18E24AE3E3A4000D1CA9A21D50919DD7D3BE49BC92C + B42A160002885645E9D0EA848C2EC91AEA1508D52210BD5D0910400364CF683F + 7D748877703692D14B7680001AA09A6AB49F3EDA431F9C051C7ADF00208006CC + A2D17EFAE006CC432AF66857B00304D0405555C33788472B9061D5050108A081 + B369B40A19EDA10F812E084000D1AC2DCECE3CD472C8683F7DC8D6FFD41BA6C7 + 189A000820DAB53458875A06191DEA1D1D62C1EC3A030410EDCAD121D7C61AAD + 42866CE1C648BB9201208006D4AED1A1DED11EFAE02ADA307D0E1040346C68B0 + 0CB91C32DA4F1F9ADD47EAF50B30FB5E000134B0960DB6BEDE68E6189215082D + 0B7580001AD8EA6AB40A19EDA10FF22E084000D1D236E6A1974346FBE94370F8 + 919996653A4000D1B2BE621D7A196474A8770856FCD41B5CC1D22B0008205AF6 + 7886601B6BB40A19D1632B58FC0E1040B44C2343B18DC53A5A818CDC1616B62E + 084000D134430EC136D648EFA70FC1428D95A685034000D1B41D3E14DB58237C + F72DD3482ED2B0791E2080683AEDC23E0433C8C8EEA70FC518A35E8986AD0B02 + 1040B4B57128B6B146743F7D0846182B6D4B078000A26D9D3514DB5823B99F3E + 14E38BC6A915208006499E1CEDA78F0EF10E78858FB5FA040820ACFDD4115D65 + 8FE0DDB78C23BBBEC73A8007104083A5D61AAD42467BE883B285051040341EC8 + 198A738523B69F3E048778A9392A8FDDFB000144EB6A6B48B6B146E650EF90AC + 40689E54010288D625E8D06C638DC82A644896658CB42E1F000288E6D60ECD36 + D6081CEA1D92451933CD8B728000A27913836968562123AF9F3E244B32DA2754 + 8000A2F940E7106D63318F562023AC1CC3310704104083CDE2D12A64B4873EA8 + 0A7280001A6455D7683F7D7488777025538000A27DD6641FA2198469B4021949 + 8518AE860E4000D1C16AD6D12A64748877B08F35E22C210002880E4DF021DA4D + 1F4943BD43348AE891480102881E99939961C487FFE810EFE09E04C15D850204 + 103D1A1843B59B3E6276DF0ED10A848ABD44DC2D2C80001A94D5D7683F7DB487 + 3E5892284000D1A5053E54BBE923A49F3E44A3873E29142080E8D2BE18B25508 + EB680532222A103CDD6480001ABCF68FF6D3472B904150820304107D4ACFA1DA + 4D1F09BB6F876AF5CE449F32022080E89343876A2D3E02AA90215BBBB3D3270C + 0002884E6963C876D3877D3F7DA856EEAC74AA44010268703B6174A877B4873E + C0C5374000D1A917C4CE325A858CF6D0A9D939A4570B0B2080E89549876C377D + 780FF58ECEE1120A048000A257D218BA23BDC3BA9F3E542B76AAAE02C25B8B02 + 0410DD5C3174AB10E6D10A64585720F8CB6E8000A25BD93974477A876F153274 + AB7576BA9512000144BFE6F7D01DE91DB6FDF4215BABD331610204D090C8A8A3 + 43BDA343BC03D5B40108203AA68CD12A6474887710562004AA518000A2A34B86 + 7015322C877A19472B10228A098000A263D13984270B87653F7DC846070B5553 + 2501CB0002889EADEF215C850CC3DDB7A31508512D2C8000A26B661DAD42467B + E883AD0221942601026828E5D6D17EFA685CD0BD5503104074ED9E0EE52A8475 + B40219861508E12E3A4000D1B7F13D94AB90E1D5C8621DAD40885B4B00104043 + CE3D0357728DF6D087DF7009E1121B2080E89C2E46AB90C10198472B102287BA + 010288CEE962285721C3A89F3E5A81101D0E000144EF2C3B94AB9061B3248B7D + 340E884E8D000144EF3C3B5A858C0EF10EA9C4081040746F7B0FE52A8475B402 + 19561508312D2C8000A2FBF0CD509E0B1926FDF4A13BC44BDD3910A2BAE80001 + C4305A859052C38FF6D0475A05021040F477D66815323AC43B382A10A28A6A80 + 00A27FCF68289760C3A19FCE385A3C91D24507082086D12A64640DF50EE11EFA + 805420000134102E1BAD42467BE883A00221AE9C0608A001697A0FE1481AEA43 + BDECA3214F5A310D104043DF6DA3FDF4D10A8486210110400CA355C8481AEA1D + 3D3883D4900008A081E99B32328F562103D2C01ABAE1CE4CE56027B68B0E1040 + 0333D23BA4670B87703F7D08073BD300151500013450EE1BCA43BD43B69F3E3A + C44B7A51011040C3C681A38DAC61DDF51BB0021A2080062A510CE92A6488EEBE + 651CAD40480F0A80001AB076C5E8502FDDC1E8B16464D4A5000134BCDC48B721 + 15F6D10A6428F7FA48080A80001A38470EE9BD8543704916FB6879444EE10C10 + 400358CD8D0EF58E0EF10E4C71444A0502104003E8CCD1A1DED10A64407AE824 + 951500013490A5E6683F7D74887720829AA4B202208006B4E13D94FBE9436CA8 + 77B4874E660502104003DA57621F5D92353AC43BC8531D40000DECD8CD683F7D + B40219E4890E20800638330FE546D6101AEA1DCADBA406B8020108A0014E13A3 + BB6F478778E9DC9225312C00026880DB83A3072D8E5620F42D9249AD40000268 + C0DD3B7A4AD6E8102F1DA740482E91010268C01D3C941B594364F7EDE8495814 + 14C8000134F03D53D6D12A84C660E80EA653BF114B7205021040035FE70DE946 + 16FB680532CC131B40000D82C1CDA1DCC81A02FDF421DC43671C04150840000D + 825C3DDAC81A1DE2A553E943460502104083617E6C2837B258462B9021541493 + 51580004D060980B19D28DACC15E85B08E862C4573200001342806B286F274E1 + 20DF7D3B74CB9E4192CC000268702489A1DCC81ADC4BB286EC102F0D1A586455 + 200001344892C4506E64B18F562043A3E94A560502104083A55531841B598378 + A877E8F6D06950089357810004D0A071FDE8A14DA33D749A36B0C82C83010268 + D02489217CE03BCB68038BDA6D14C6411318000134785A15A37B16A80E866CAD + CC34786A5380001A444962084FA8B38F562083BDFC2537300002885C2FD02049 + 0CE16EC8A01CEA1DB24762D0A20342F6E66E80001A4CAD0AC6D12A64B4CD3AD8 + D21640000DA65C3EBAAE6E74889746D531F9AD1380001A5CDE185D3834DAA563 + 1D5C452F4000913F12C73E3C323AB58263B4873E889B261474C700026890754C + 4797468CF4215E9A842305150840008D7A6578F6D3876A4933E88A5D80001A6C + 1DD3A1DB0D1954FDF4A1DA43A7490784A2EE1840000DBADA70E876430653236B + 8856C434E9805056810004D020F4CE909DDF1AAD40281DE91884452E40000DBE + 06E3E804D7881DE21D8CE909208006DF50EFD0CD218366F72DE368FEA0DA102F + 40000DC68EE990EDA80F96255943B3914A9B0E3AA5B52940000DCA56C590EDA8 + B38F562083AC474B71600004D020F5D510EDA80F8AA1DEA1D943671EA4652D40 + 000DD256C5509DE71A0CFD74A6D190A362600004D020CDF84376207FB402195C + 052DC54D1180001AACAD8AA1DA511FF82A6448061C8D3AE854080C80001AB449 + 62A8E69081EEA7338EE60FAA060640000DDA7EFA501DCA1AE8A1DEA138BC3198 + 931040000DE224314487B2D8472B9041D28FA54A471620800673BB7B680E650D + E850EF90ECA10FEAF403104083B9861C1DB01C112146AB1608751A58000134B8 + DBDD433287308F5620C328F10004D0E02E3487E650D6C055214330B868358045 + AD061640000D725F0ECD1C3250FD74C6D1FC41F59403104083BD9E1C92396480 + FAE943F028459AE50FAA35B0000268B08FD40DCDE99081A942865E8F8D66C33B + D49B230008A0C15F1430B28C5621C3B487CEC238F81B1E000134F8072386E484 + E140F4D3875C639476CD0E2A56A6000134147C3B0473C800ECBE651CCD1FB448 + 3100013414FA5B433187D07F4916CB68FEA045030B208086469A1882E397ECA3 + 15C880B542A9D9C00208A0512F0F8F7EFA901BE21D2AC52940000D8D91ACA198 + 43E8DB4F671ACD1FB469600104D09069780FB91C42D7DDB7ECA3F98346290520 + 80864EA9C9345A850C9B215E5AE60F2A37B0000288CAA526FB680E19887E3AE3 + 68FEA0D5CA0B80001A4A5DD3D176F6F018E2651A4A752940000DA97605D36815 + 320C2A10A62115140001446DC43C9A43E83ED4CB3E9A3F6837A50C1040436AAC + 77C8E510FAF4D39946F307ED4678010268A8B5BC87560E611EAD40867AEA0008 + A021576C328D562143788897B6F983161D1080001A6A63BD436DE522EDFBE943 + A8874EDB0E2A6D4678010268E8754386560EA1FD502FF368FEA0650704208086 + 62AA185239847DB402A14FFEA051E31B20808664D37B28EDC2A5F150EFD0E9A1 + B3300EC9920220808664376448E590D1310BBAE40F5A75400002686876438652 + 7B93A6BB6FD94713048D130440000DD5CEE9688F6C480DF1D23A7FD0AE260508 + A0213B0330847208FB886F77B30EDDA10A80001AB263166CEC43A6D0A05D3F7D + 880CE731D13C7FD02E2000026808971A43A75A1DE117A8D07C2E8896AD098000 + 1ABA039C43A8E0A0D1EEDBA1D14367A6FD721B5AE60F80001AD225C79019EE65 + 1CB9E98285F6F983A62D0980001AD21DF5A153B9B28FD40A8475A82F460308A0 + A15E7A0C911CC234422B107AE40FDAB622000268C887CF1019CC621F91052713 + FB902F21010268C877D48748579DEA0131048E52641E0EBB61000268E877D487 + 48254BEDC432F82B4E167AE40F9A070340000D838EFAD0A866A9BCFB76F0F7D0 + 59E971A60BEDDB990001343CEAD9A1D011611C592D0B26F6E1D1BA0608203AD4 + B474391D8A69F00715FB082A3999E972681E3D96B80304D070A96B874047849A + 696690170774E97ED0A7650D1040C3A6353A04828B7AA9866534C2E915E10001 + 346C86B2864047846AFDF441EE5126FA1CB94A9F5000082086619443067D338B + 4A932183BB03C242A76B1FE8943F000268180DF60E815A972AC130B8876E58E9 + 746237BD4A0980001A4E83BD83BF99458DFDE9837B0A9D895EF9835EA1001040 + C36BB077D037B328CF21833A7FD0AB7945C7015E80001A7655EF206F66515A50 + 0CEAFC311CE31820808661E80DEE4943CA72C8606E5930D3ED462D7AE60F8000 + 1A8EE5CBE06E6651D21D1BCCF9836ECD2BFAE60F80001A8683BD83BEAFCE341C + AB4626FA5D594AD7C805082086E1994306772542E67CC8202E3859E878E7357D + F3074000310CD71C32A82B11729A598379E0868ED507BDF3074000D119D1B1A0 + 196695C8206E5EB1D03556E9EC3980001A423DD4E1D599236DCC673067765676 + 7AE60F7A97130001C4309C73C8E0AE44882F78D9477B1F03963F0002689807E8 + 209F356424CE0F833855D0B5FA1888020F2080867B9133D8979E308D904A70C8 + C62540000D44A8D2B5D019F4DB44F0253246D6D19589033C8E0710400CC33F87 + 0093D920EF97B1624B69EC4C833B7730B0D2B7FA18A0FC0110400C232187B00F + FE231D9859589918D9C1E1C2CECEC8C4CA32D85DCCCCC43E22F20740008D84AE + DD705EBE33323AE703188300013452C277A474F08665E77C20F30740008D9812 + 6828B4B38608A07BEB6A20F30740008D9C3A7AB49D351A73640080001A51E13C + DACE1A8AADAB81CD1F000134B24A22603B6B348B50943D98D84758FE0008A011 + 56578F76458658E763C0F30740008DB856D6E09F371CBCD1C5C836F2F2074000 + 0D708D3D203964348B0C9DEC31E0F3830001C4302273C8686F7D28F4CD0745FE + 0008A0111BF0A35984A4581AB1051940008DD8A26974406B700F5D0D96FC0110 + 4023B7F21E1DD01ACC435783267F0004D060888101CB21A3596430678FC1B1BF + 1620801846760E19CD2283367B0C92FC011040830331B10D641619ADC8075BDF + 030406C9465080006218CD21A3596410668F41933F000268B0A0818D8DD141DF + 4133B00B2BB3064B400004D0A041AC031A21C02C323ABB8E14198C031C1B8327 + 320002886134878C2E40C1C81E031C1383297F000410C3680E191DD21A340357 + 83307F0004D0E06AF7B20D7C1619E16BE3063E7B0CB2E94180001A5CA5D7C0E7 + 9011DD1919E8AEC7609CFE0008A0D1E1DED196D6A0695B0DC6E15D80001A1DEE + 1DAD46064DE531188777010268B4AB8EABA61F41D5083313E3E008F441D83D07 + 08A0D1C1AC115F8D0C92CA6390E60F80001A1DCC1AD9835A2C4CEC8326B407E5 + F01540008D0E668DE0A6D6A0695A0DE2E12B80001A1DCC22A6A9351CA38E79F0 + 34AD06F3F01540008D76444666776490E58EC1DBFD0008A0C11B816C6CA37964 + 84E48EC1BC0E0E208046BBEA23ACADC53CF872C7A0EE9E0304D068476424E591 + 41993B0677F7032080463B22A4E791213AF6CBC2C4383803745037AF000268B4 + 2332222A92415A750C81EE0740008DCE880CFF8A64B0561D4362F6032080067D + 4764F046ED90C824833A730C85C589000134DA1119BE996490678EA1D1FD0008 + A0D1F1DEE19949067FE61822A3BB000134DACCA25E2619241D7766D6A1903986 + 4AF30A2080469B59C329970C95BC31849A57000134DACCA2492EA17FDB816508 + E58DA1D4BC0208A0D16616AD7209DD2A1350B5C138D48267C834AF000268E834 + B318D9861E6007D726B4CA27CCE05A837D0886CB109A1C0408A0D149433AE513 + 2A661450C618A23963E84D0E0204D0685F9DBE19059453C8CB2AC06C01CA1743 + 39630CC5DE3940008DF6D5072AAF00330B30B780F20B2B0B0B0B331020F20210 + 00C55841390294278099827DD8F87C88F5CE010268B4AF3E0A467BE778004000 + 8DF6D547C168EF1C0F0008A0D14A64148C561F780040008D5622A360B4FAC003 + 000268480EF88E562243B2FA189283BB0001345A898C82D1EA030F0008A0D14A + 64148C561F780040008D5622A360B4FAC00300026874386B148C0E5EE1010001 + 343AB13E0A685D7D0CE9A97380001AAD4446C168F581070004D06825320A46AB + 0F3C002080463BEBA360B4738E070004D0E888EF28181DDBC503000268B49D35 + 0A465B57780040000D9376D6682532E8AA8F61D2BA0208A0D176D628186D5DE1 + 01000134DACE1A05A3AD2B3C00208046C7B346C1E8D8151E001040A3F386A360 + 7466100F0008A0D1AEC82818ED7CE001000134FCBA22A3596400B3C7F0EB7C00 + 04D0685764148C763EF00080001AEDAD8F82D1EC81070004D0686F7D148CF6CD + F10080001AEDAD8F82D1BE391E001040A3035AA360347BE0010001345A8B8C82 + D1EC81070004D0F01EF31DCD2274C81EC37B6417208086FBB4C8681619CD1E14 + 0180001AAD4546C168F6C003000268B42F320A46FB1E780040008D76D747C168 + F6C003000268B4161905A3D9030F0008A09183984617A0506D51C9089A350708 + A0918446D76851277B8CA83557000134B210EBE862784ADB56232D7B0004D0E8 + A8EF28181DD7C50300026824F6D7475B5AE4763D4660CF1C2080465B5AA360B4 + 6D85070004D0684B6B148CB6ADF00080001A6D698D82D1B6151E00104023BA1A + 196D6911D5B61AD1950740008D5623A360B4F2C003000268B41A19ED8D8CF63C + F00080001A450CCCA3835A3886AD462B0F060680001A45A3D5C868E581070004 + D02882CD8D8CE611A4DC313AE701030001348A90F2C868536B7446101D0004D0 + 281AED8E8C763CF00080001A45A379643477E0010001348A46F3C868EEC00300 + 0268148DE691D1DC81070004D0281AF17DF6D15E393E001040A3081F6019F64B + 511847E73BF00380001A4584F308FBB0AD3A46730741001040A38898C6D630AC + 481847270389020001348A4660AF7DB44F4E3C0008A05134C25A5BA3ED2AD200 + 40008DA2119449463307E900208046D108C924A399833C001040A388CC4CC23A + 747209306FB08E660E320140008DA2E15D958C561C140280001A45140F6F0DD6 + 5C02AA384607AB28050001348AA8964B064F36611FCD1B54030001348AA8DC2F + 611FF8AC31DAA6A2220008A051448B6C32008D2E76C6D1AC410B001040A38846 + 8D2EBAE51348CE186D50D1080004D028A24B4661A745636A3463D0010004D028 + A2634E016715768A7205285B8CE60B3A0280001A4503905780998515985D80F9 + 059C63D8B1E51AA83848095025503D0BF368AE1800001040A368148C023C0020 + 8046D1281805780040008DA251300AF00080001A45A36014E0010001348A46C1 + 28C003000268148D825180070004D0281A05A3000F000830007D899E2A640A52 + 5F0000000049454E44AE426082 } PopupMenu = pmDropTarget Proportional = True @@ -146,8 +525,22 @@ object FormDropTarget: TFormDropTarget Stretch = True end object pmDropTarget: TPopupMenu - left = 188 - top = 120 + OnPopup = pmDropTargetPopup + Left = 188 + Top = 120 + object miDownloadAll: TMenuItem + Caption = 'Download all' + RadioItem = True + OnClick = miDownloadAllClick + end + object miAddToFavorites: TMenuItem + Caption = 'Add to favorites' + RadioItem = True + OnClick = miAddToFavoritesClick + end + object MenuItem1: TMenuItem + Caption = '-' + end object miClose: TMenuItem Caption = '&Close' OnClick = miCloseClick diff --git a/mangadownloader/forms/frmDropTarget.lrj b/mangadownloader/forms/frmDropTarget.lrj new file mode 100644 index 000000000..add1a15e6 --- /dev/null +++ b/mangadownloader/forms/frmDropTarget.lrj @@ -0,0 +1,5 @@ +{"version":1,"strings":[ +{"hash":29393692,"name":"tformdroptarget.midownloadall.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,97,108,108],"value":"Download all"}, +{"hash":215882787,"name":"tformdroptarget.miaddtofavorites.caption","sourcebytes":[65,100,100,32,116,111,32,102,97,118,111,114,105,116,101,115],"value":"Add to favorites"}, +{"hash":44709525,"name":"tformdroptarget.miclose.caption","sourcebytes":[38,67,108,111,115,101],"value":"&Close"} +]} diff --git a/mangadownloader/forms/frmDropTarget.pas b/mangadownloader/forms/frmDropTarget.pas index 5a822bb98..5c17cc1bd 100644 --- a/mangadownloader/forms/frmDropTarget.pas +++ b/mangadownloader/forms/frmDropTarget.pas @@ -6,7 +6,7 @@ interface uses Classes, Windows, SysUtils, ActiveX, comobj, Forms, Controls, - ExtCtrls, Menus, LCLType, DefaultTranslator; + ExtCtrls, Menus, LCLType, DefaultTranslator, uBaseUnit, XQueryEngineHTML; type @@ -15,6 +15,9 @@ interface TFormDropTarget = class(TForm, IDropTarget) ImResize: TImage; ImDropIcon: TImage; + MenuItem1: TMenuItem; + miDownloadAll: TMenuItem; + miAddToFavorites: TMenuItem; miClose: TMenuItem; pmDropTarget: TPopupMenu; shBorder: TShape; @@ -29,25 +32,34 @@ TFormDropTarget = class(TForm, IDropTarget) procedure FormShow(Sender: TObject); procedure ImResizeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + procedure miAddToFavoritesClick(Sender: TObject); procedure miCloseClick(Sender: TObject); + procedure miDownloadAllClick(Sender: TObject); + procedure pmDropTargetPopup(Sender: TObject); private { private declarations } md: Boolean; x0, y0: Integer; + FCanDrop: Boolean; // IDropTarget + function CursorEffect(const AllowedEffects: Cardinal; + const KeyState: Integer): Cardinal; + function CanDrop(const DataObj: IDataObject): Boolean; function DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; - pt: TPoint; var dwEffect: DWORD): HResult; stdcall; - function DragOver(grfKeyState: DWORD; pt: TPoint; + {%H-}pt: TPoint; var dwEffect: DWORD): HResult; stdcall; + function {%H-}DragOver(grfKeyState: DWORD; {%H-}pt: TPoint; var dwEffect: DWORD): HResult; stdcall; function DragLeave: HResult; stdcall; - function Drop(const dataObj: IDataObject; grfKeyState: DWORD; - pt: TPoint; var dwEffect: DWORD): HResult; stdcall; + function Drop(const dataObj: IDataObject; {%H-}grfKeyState: DWORD; + {%H-}pt: TPoint; var {%H-}dwEffect: DWORD): HResult; stdcall; protected procedure CreateParams(var Params: TCreateParams); override; public { public declarations } end; + function GetDropURLs(const DataObject: IDataObject): string; + var FormDropTarget: TFormDropTarget; FAlphaBlendValue: Integer = 255; @@ -62,8 +74,147 @@ implementation uses frmMain; +var + CF_HTML: TCLIPFORMAT; + {$R *.lfm} +function MakeFormatEtc(const Fmt: TCLIPFORMAT): TFormatEtc; +begin + Result.cfFormat := Fmt; + Result.ptd := nil; + Result.dwAspect := DVASPECT_CONTENT; + Result.lindex := -1; + Result.tymed := TYMED_HGLOBAL; +end; + +function GetTextFromObj(const DataObj: IDataObject; + const Fmt: TCLIPFORMAT): String; +var + Medium: TStgMedium; + PText: PChar; +begin + if DataObj.GetData(MakeFormatEtc(Fmt), Medium) = S_OK then + begin + Assert(Medium.tymed = MakeFormatEtc(Fmt).tymed); + try + PText := GlobalLock(Medium.hGlobal); + try + Result := PText; + finally + GlobalUnlock(Medium.hGlobal); + end; + finally + ReleaseStgMedium(Medium); + end; + end + else + Result := ''; +end; + +function GetWideTextFromObj(const DataObj: IDataObject; + const Fmt: TCLIPFORMAT): String; +var + Medium: TStgMedium; + PwText: PWideChar; +begin + if DataObj.GetData(MakeFormatEtc(Fmt), Medium) = S_OK then + begin + Assert(Medium.tymed = MakeFormatEtc(Fmt).tymed); + try + PwText := GlobalLock(Medium.hGlobal); + try + Result := PwText; + finally + GlobalUnlock(Medium.hGlobal); + end; + finally + ReleaseStgMedium(Medium); + end; + end + else + Result := ''; +end; + +function GetURLsFromHTML(const S: String): String; +var + URls: TStringList; +begin + Result := S; + if S = '' then Exit; + URLs := TStringList.Create; + try + XPathStringAll('//a[not(starts-with(@href,"javascript:"))]/@href', S, URls); + RemoveDuplicateStrings(URls); + Result := URls.Text + finally + URls.Free; + end; +end; + +function ParseDataObj(const DataObj: IDataObject; + const Fmt: TClipboardFormat): String; +begin + if Fmt = CF_HTML then + Result := GetURLsFromHTML(GetTextFromObj(DataObj, Fmt)) + else + if Fmt = CF_UNICODETEXT then + Result := GetWideTextFromObj(DataObj, Fmt) + else + if Fmt = CF_TEXT then + Result := GetTextFromObj(DataObj, Fmt) + else + Result := ''; + Result := Trim(Result); +end; + +function GetDropURLs(const DataObject: IDataObject): string; +var + Enum: IEnumFORMATETC; + FmtEtc: TFORMATETC; + url: String; + + function GetDataObjectFormat(Fmt: TCLIPFORMAT): Boolean; + begin + Result:=False; + Enum.Reset; + while Enum.Next(1,FmtEtc,nil)=S_OK do + if FmtEtc.CfFormat=Fmt then + begin + url:=ParseDataObj(DataObject,Fmt); + if url<>'' then + Result:=True; + Break; + end; + end; + + function GetDataObjectFormats(Fmts: array of TCLIPFORMAT): Boolean; + var + i: Integer; + begin + Result:=False; + if Length(Fmts)=0 then Exit; + for i:=Low(Fmts) to High(Fmts) do + if GetDataObjectFormat(Fmts[i]) then + begin + Result:=True; + Break; + end; + end; + +begin + Result:=''; + if DataObject=nil then Exit; + url:=Result; + OleCheck(DataObject.EnumFormatEtc(DATADIR_GET,Enum)); + if GetDataObjectFormats([ + CF_HTML, + CF_UNICODETEXT, + CF_TEXT + ]) then + Result:=url; +end; + { TFormDropTarget } procedure TFormDropTarget.FormCreate(Sender: TObject); @@ -80,6 +231,11 @@ procedure TFormDropTarget.FormCreate(Sender: TObject); procedure TFormDropTarget.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin + FAlphaBlendValue := AlphaBlendValue; + FWidth := Width; + FHeight := Height; + FLeft := Left; + FTop := Top; MainForm.SaveDropTargetFormInformation; CloseAction := caFree; end; @@ -89,7 +245,6 @@ procedure TFormDropTarget.FormDestroy(Sender: TObject); RevokeDragDrop(Handle); OleUninitialize; FormDropTarget := nil; - MainForm.ckDropTarget.Checked := False; end; procedure TFormDropTarget.FormMouseDown(Sender: TObject; Button: TMouseButton; @@ -146,22 +301,69 @@ procedure TFormDropTarget.ImResizeMouseMove(Sender: TObject; end; end; +procedure TFormDropTarget.miAddToFavoritesClick(Sender: TObject); +begin + miAddToFavorites.Checked := True; + MainForm.rgDropTargetMode.ItemIndex := 1; + MainForm.SaveDropTargetFormInformation; +end; + procedure TFormDropTarget.miCloseClick(Sender: TObject); begin + MainForm.ckDropTarget.Checked := False; Self.Close; end; +procedure TFormDropTarget.miDownloadAllClick(Sender: TObject); +begin + miDownloadAll.Checked := True; + MainForm.rgDropTargetMode.ItemIndex := 0; + MainForm.SaveDropTargetFormInformation; +end; + +procedure TFormDropTarget.pmDropTargetPopup(Sender: TObject); +begin + miDownloadAll.Checked := MainForm.rgDropTargetMode.ItemIndex = 0; + miAddToFavorites.Checked := not miDownloadAll.Checked; +end; + +function TFormDropTarget.CursorEffect(const AllowedEffects: Cardinal; + const KeyState: Integer): Cardinal; +begin + Result := DROPEFFECT_NONE; + if FCanDrop then + begin + if (KeyState and MK_SHIFT = MK_SHIFT) and + (DROPEFFECT_MOVE and AllowedEffects = DROPEFFECT_MOVE) then + Result := DROPEFFECT_MOVE + else if (DROPEFFECT_COPY and AllowedEffects = DROPEFFECT_COPY) then + Result := DROPEFFECT_COPY; + end; +end; + +function TFormDropTarget.CanDrop(const DataObj: IDataObject): Boolean; +begin + Result := DataObj.QueryGetData(MakeFormatEtc(CF_HTML)) = S_OK; + if not Result then + Result := DataObj.QueryGetData(MakeFormatEtc(CF_UNICODETEXT)) = S_OK; + if not Result then + Result := DataObj.QueryGetData(MakeFormatEtc(CF_TEXT)) = S_OK; +end; + function TFormDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; stdcall; begin - dwEffect := DROPEFFECT_COPY; + FCanDrop := CanDrop(dataObj); + if FCanDrop then + dwEffect:=DROPEFFECT_LINK; Result := S_OK; end; function TFormDropTarget.DragOver(grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; stdcall; begin - dwEffect := DROPEFFECT_COPY; + if FCanDrop then + dwEffect:=DROPEFFECT_LINK; Result := S_OK; end; @@ -172,37 +374,9 @@ function TFormDropTarget.DragLeave: HResult; stdcall; function TFormDropTarget.Drop(const dataObj: IDataObject; grfKeyState: DWORD; pt: TPoint; var dwEffect: DWORD): HResult; stdcall; -var - aFmtEtc: TFORMATETC; - aStgMed: TSTGMEDIUM; - pData: PChar; -begin - // Support dropping text on edit control - // Make certain the data rendering is available - if (dataObj = nil) then - raise Exception.Create('IDataObject Pointer is not valid!'); - with aFmtEtc do - begin - cfFormat := CF_TEXT; - ptd := nil; - dwAspect := DVASPECT_CONTENT; - lindex := -1; - tymed := TYMED_HGLOBAL; - end; - // Get the data - OleCheck(dataObj.GetData(aFmtEtc, aStgMed)); - try - // Lock the global memory handle to get a pointer to the data - pData := GlobalLock(aStgMed.hGlobal); - // Replace Text in the control you want - if Assigned(OnDropChekout) then - OnDropChekout(pData); - finally - // Finished with the pointer - GlobalUnlock(aStgMed.hGlobal); - // Free the memory - ReleaseStgMedium(aStgMed); - end; +begin + if Assigned(OnDropChekout) then + OnDropChekout(GetDropURLs(dataObj)); Result := S_OK; end; @@ -213,4 +387,7 @@ procedure TFormDropTarget.CreateParams(var Params: TCreateParams); Params.WndParent := GetDesktopWindow; end; +initialization + CF_HTML := RegisterClipboardFormat('HTML Format'); + end. diff --git a/mangadownloader/forms/frmImportFavorites.lfm b/mangadownloader/forms/frmImportFavorites.lfm index aff022c9e..2d7c179d5 100644 --- a/mangadownloader/forms/frmImportFavorites.lfm +++ b/mangadownloader/forms/frmImportFavorites.lfm @@ -1,184 +1,190 @@ -object ImportFavorites: TImportFavorites - Left = 480 - Height = 171 - Top = 298 - Width = 406 - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog - Caption = 'Import list ...' - ClientHeight = 171 - ClientWidth = 406 - OnCreate = FormCreate - Position = poDesktopCenter - LCLVersion = '1.5' - object cbSoftware: TComboBox - Left = 16 - Height = 23 - Top = 32 - Width = 371 - ItemHeight = 15 - ItemIndex = 0 - Items.Strings = ( - 'Domdomsoft Manga Downloader' - 'Free Manga Downloader' - ) - Style = csDropDownList - TabOrder = 0 - Text = 'Domdomsoft Manga Downloader' - end - object edPath: TEdit - Left = 16 - Height = 23 - Top = 72 - Width = 344 - TabOrder = 1 - Text = 'Path to the software (e.g. C:\MangaDownloader)' - end - object btImport: TBitBtn - Left = 152 - Height = 24 - Top = 128 - Width = 104 - Caption = '&OK' - Default = True - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000900000012010E - 0033024A0083025D00BC025D00CC025D00CC025D00CC025D00CC025D00CC025D - 00CC025D00CC025D00CC025D00BC024A0083010E003300000012021D0000066D - 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9 - 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073021D00000A7D00000A7D - 00BA25CA15F922D111FF22D111FF22D111FF22B611FF22D111FF22D111FF22D1 - 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BA0A7D00000C8400000C84 - 00CC2BCC1AFF22C811FF22C811FF22B211FFE6E6E6FF22B211FF22C811FF22C8 - 11FF22C811FF22C811FF22C811FF22C811FF0C8400CC0C8400000D8900000D89 - 00CC31C620FF22BE11FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE - 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CC0D8900000E8D00000E8D - 00CC41C330FF23AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 - 11FF22B411FF22B411FF22B411FF25B514FF0E8D00CC0E8D00000F9200000F92 - 00CC52C941FFA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 - E6FF22A311FF22AA11FF22AA11FF28AF17FF0F9200CC0F920000109600001096 - 00CC55CC44FF3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 - E2FFE6E6E6FF229E11FF22A111FF2CAA1BFF109600CC10960000119A0000119A - 00CC5AD149FF47BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 - E2FFE3E3E3FFE7E7E7FF269E15FF39B128FF119A00CC119A0000129E0000129E - 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB - 33FFFFFFFFFFA7E29EFF4EC53DFF58CF47FF129E00CC129E000013A2000013A2 - 00CC67DE56FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE - 46FF4AC139FF51C840FF57CE46FF60D74FFF13A200CC13A2000014A5000014A5 - 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD6 - 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BA14A5000014A8000014A8 - 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4 - 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A8007314A8000014A8000015A9 - 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA - 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000C14A80000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ModalResult = 1 - OnClick = btImportClick - TabOrder = 2 - end - object btCancel: TBitBtn - Left = 272 - Height = 24 - Top = 128 - Width = 104 - Caption = 'Cancel' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 - 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 - 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 - 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 - D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 - 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 - 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 - 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 - 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 - 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 - 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 - 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 - 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 - A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 - A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 - A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D - F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 - A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 - AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ModalResult = 2 - TabOrder = 3 - end - object lbSelectSoftware: TLabel - Left = 16 - Height = 15 - Top = 16 - Width = 49 - Caption = 'Software:' - ParentColor = False - end - object btBrowse: TSpeedButton - Left = 364 - Height = 23 - Top = 72 - Width = 23 - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF - F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF - EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 - F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 - F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB - F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 - F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 - F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 - FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 - FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED - FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC - DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 - FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 - FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 - CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 - F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 - CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 - CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btBrowseClick - end - object dlgPath: TSelectDirectoryDialog - left = 224 - top = 8 - end -end +object ImportFavorites: TImportFavorites + Left = 480 + Height = 127 + Top = 298 + Width = 426 + BorderIcons = [biSystemMenu] + Caption = 'Import list ...' + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 127 + ClientWidth = 426 + Position = poDesktopCenter + LCLVersion = '1.7' + Visible = False + object lbSelectSoftware: TLabel + Left = 8 + Height = 15 + Top = 8 + Width = 410 + Align = alTop + Caption = 'Software:' + ParentColor = False + end + object cbSoftware: TComboBox + Left = 8 + Height = 23 + Top = 29 + Width = 410 + Align = alTop + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'Domdomsoft Manga Downloader' + 'Free Manga Downloader' + ) + Style = csDropDownList + TabOrder = 0 + Text = 'Domdomsoft Manga Downloader' + end + object edPath: TDirectoryEdit + Left = 8 + Height = 23 + Top = 58 + Width = 410 + ShowHidden = False + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0046699C005C8BBF005C8BBF005C8BBF005C8BBF005C8BBF005C8BBF005C + 8BBF005C8BBF005C8BBF005C8BBF0046699C0000002C000000120000000A0000 + 0016006395B486CFF0FF81CBEDFF81CBEDFF81CBEDFF81CBEDFF81CBEDFF81CB + EDFF86CFF0FF4B8FB1FF86CFF0FF006395B4004060510000000A000000000052 + 7B00006CA3A884CEEEFF7CC7E8FF7CC7E8FF7CC7E8FF7CC7E8FF7CC7E8FF7CC7 + E8FF84CEEEFF579BBDFF84CEEEFFF4B62EFF006CA3A800527B00005681000072 + AB000072ABA087D0EFFF7FCAE9FF7FCAE9FF7FCAE9FF7FCAE9FF7FCAE9FF7FCA + E9FF87D0EFFF5FA3C5FF87D0EFFFFEC941FF0072ABA00072AB000074AE000074 + AE000074AE9D8AD3F0FF82CDEBFF82CDEBFF82CDEBFF82CDEBFF82CDEBFF82CD + EBFF8AD3F0FF62A6C8FF8AD3F0FFE9E9DBFF0074AE9D0074AE000076B1000076 + B1000076B19A8ED6F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 + EDFF8ED6F2FF66AACCFF8ED6F2FFF0F0E6FF0076B19A0076B1000079B5000079 + B5000079B59792DAF4FF8BD4F0FF8BD4F0FF8BD4F0FF8BD4F0FF8BD4F0FF8BD4 + F0FF92DAF4FF69ADCFFF92DAF4FFF8F8F3FF0079B5970079B500007BB800007B + B800007BB89497DEF6FF90D8F2FF90D8F2FF90D8F2FF90D8F2FF90D8F2FF90D8 + F2FF97DEF6FF79BDDCFF78BDDCFFFEFEFDFF007BB894007BB800007DBB00007D + BB00007DBB919BE1F7FF94DBF4FF94DBF4FF94DBF4FF94DBF4FF94DBF4FF94DB + F4FF94DBF4FF9EE4F9FF7CC0DEFF007DBB91007DBB33007CBA00007FBE00007F + BE00007FBE8E9EE5F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF + F6FF98DFF6FF98DFF6FFA1E8FAFF007FBE8E007EBE00007EBD000081C1000081 + C1000081C18BA3E8FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3 + F9FF9DE3F9FF9DE3F9FFA3E8FBFF0081C18B0081C1000081C1000083C4000083 + C4000083C489A6EBFCFFA1E6FBFFA1E6FBFFA1E6FBFFA1E6FBFFA1E6FBFFA1E6 + FBFFA1E6FBFFA1E6FBFFA6EBFCFF0083C4890083C4000083C4000084C6000084 + C6000084C686A9EEFDFFA4E9FCFFA4E9FCFFA4E9FCFFA4E9FCFFA4E9FCFFA4E9 + FCFFA4E9FCFFA4E9FCFFA9EEFDFF0084C6860084C6000084C6000086C9000086 + C9000086C984ACF1FFFFA7ECFEFFA7ECFEFFA7ECFEFFA7ECFEFFA7ECFEFFA7EC + FEFFA7ECFEFFA7ECFEFFACF1FFFF0086C9840086C9000086C9000087CA000087 + CA000087CA82B1F5FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2FFFFAEF2 + FFFFAEF2FFFFAEF2FFFFB1F5FFFF0087CA820087CA000087CA000088CB000088 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610088CB000088CB00 + } + NumGlyphs = 1 + Align = alTop + MaxLength = 0 + TabOrder = 1 + TextHint = 'Path to the software (e.g. C:\MangaDownloader)' + end + object btImport: TBitBtn + AnchorSideLeft.Control = lbSelectSoftware + Left = 8 + Height = 26 + Top = 92 + Width = 62 + Anchors = [akLeft, akBottom] + AutoSize = True + Caption = '&OK' + Default = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A000000160000000900000012010E + 0033024A0083025D00BC025D00CC025D00CC025D00CC025D00CC025D00CC025D + 00CC025D00CC025D00CC025D00BC024A0083010E003300000012021D0000066D + 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9 + 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073021D00000A7D00000A7D + 00BA25CA15F922D111FF22D111FF22D111FF22B611FF22D111FF22D111FF22D1 + 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BA0A7D00000C8400000C84 + 00CC2BCC1AFF22C811FF22C811FF22B211FFE6E6E6FF22B211FF22C811FF22C8 + 11FF22C811FF22C811FF22C811FF22C811FF0C8400CC0C8400000D8900000D89 + 00CC31C620FF22BE11FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE + 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CC0D8900000E8D00000E8D + 00CC41C330FF23AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 + 11FF22B411FF22B411FF22B411FF25B514FF0E8D00CC0E8D00000F9200000F92 + 00CC52C941FFA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 + E6FF22A311FF22AA11FF22AA11FF28AF17FF0F9200CC0F920000109600001096 + 00CC55CC44FF3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 + E2FFE6E6E6FF229E11FF22A111FF2CAA1BFF109600CC10960000119A0000119A + 00CC5AD149FF47BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 + E2FFE3E3E3FFE7E7E7FF269E15FF39B128FF119A00CC119A0000129E0000129E + 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB + 33FFFFFFFFFFA7E29EFF4EC53DFF58CF47FF129E00CC129E000013A2000013A2 + 00CC67DE56FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE + 46FF4AC139FF51C840FF57CE46FF60D74FFF13A200CC13A2000014A5000014A5 + 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD6 + 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BA14A5000014A8000014A8 + 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4 + 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A8007314A8000014A8000015A9 + 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA + 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000C14A80000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ModalResult = 1 + OnClick = btImportClick + TabOrder = 2 + end + object btCancel: TBitBtn + AnchorSideLeft.Control = btImport + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btImport + Left = 74 + Height = 26 + Top = 92 + Width = 82 + AutoSize = True + Caption = 'Cancel' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 + 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 + 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 + 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 + D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 + 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 + D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 + 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 + B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 + 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA + EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 + 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 + E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 + 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 + E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 + 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC + DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 + 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB + DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 + 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF + FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 + A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F + D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 + A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B + E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 + A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D + F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 + A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 + AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ModalResult = 2 + TabOrder = 3 + end +end diff --git a/mangadownloader/forms/frmImportFavorites.lrj b/mangadownloader/forms/frmImportFavorites.lrj new file mode 100644 index 000000000..91ddac3c2 --- /dev/null +++ b/mangadownloader/forms/frmImportFavorites.lrj @@ -0,0 +1,7 @@ +{"version":1,"strings":[ +{"hash":230544090,"name":"timportfavorites.lbselectsoftware.caption","sourcebytes":[83,111,102,116,119,97,114,101,58],"value":"Software:"}, +{"hash":148035954,"name":"timportfavorites.cbsoftware.text","sourcebytes":[68,111,109,100,111,109,115,111,102,116,32,77,97,110,103,97,32,68,111,119,110,108,111,97,100,101,114],"value":"Domdomsoft Manga Downloader"}, +{"hash":161483657,"name":"timportfavorites.edpath.texthint","sourcebytes":[80,97,116,104,32,116,111,32,116,104,101,32,115,111,102,116,119,97,114,101,32,40,101,46,103,46,32,67,58,92,77,97,110,103,97,68,111,119,110,108,111,97,100,101,114,41],"value":"Path to the software (e.g. C:\\MangaDownloader)"}, +{"hash":11067,"name":"timportfavorites.btimport.caption","sourcebytes":[38,79,75],"value":"&OK"}, +{"hash":77089212,"name":"timportfavorites.btcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"} +]} diff --git a/mangadownloader/forms/frmImportFavorites.pas b/mangadownloader/forms/frmImportFavorites.pas index dba70344f..c81f08ee9 100644 --- a/mangadownloader/forms/frmImportFavorites.pas +++ b/mangadownloader/forms/frmImportFavorites.pas @@ -11,24 +11,21 @@ interface uses - Classes, SysUtils, FileUtil, Forms, Dialogs, StdCtrls, - Buttons, DefaultTranslator, lazutf8classes, uBaseUnit, frmNewChapter; + Classes, SysUtils, Forms, Dialogs, StdCtrls, Buttons, DefaultTranslator, EditBtn, + lazutf8classes, LazFileUtils, uBaseUnit, WebsiteModules, FMDOptions, RegExpr, + frmNewChapter; type { TImportFavorites } TImportFavorites = class(TForm) - btBrowse: TSpeedButton; btImport: TBitBtn; btCancel: TBitBtn; cbSoftware: TComboBox; - edPath: TEdit; - dlgPath: TSelectDirectoryDialog; + edPath: TDirectoryEdit; lbSelectSoftware: TLabel; - procedure btBrowseClick(Sender: TObject); procedure btImportClick(Sender: TObject); - procedure FormCreate(Sender: TObject); private { private declarations } procedure DMDHandle; @@ -46,7 +43,7 @@ TImportFavorites = class(TForm) implementation uses - frmMain, uSilentThread; + frmMain, uSilentThread, FMDVars; {$R *.lfm} @@ -61,18 +58,20 @@ procedure TImportFavorites.DMDHandle; list, urlList, mangaList: TStringList; + host, + webs, path: String; - i, j: Cardinal; - isUnimported: Boolean; + i, j, m: Integer; + regx: TRegExpr; begin - if NOT FileExistsUTF8(CorrectFilePath(edPath.Text) + 'Config/Bookmarks') then + if NOT FileExistsUTF8(CleanAndExpandDirectory(edPath.Text) + 'Config/Bookmarks') then exit; list:= TStringList.Create; urlList:= TStringList.Create; mangaList:= TStringList.Create; unimportedMangas:= TStringList.Create; - fstream:= TFileStreamUTF8.Create(CorrectFilePath(edPath.Text) + 'Config/Bookmarks', fmOpenRead); + fstream:= TFileStreamUTF8.Create(CleanAndExpandDirectory(edPath.Text) + 'Config/Bookmarks', fmOpenRead); list.LoadFromStream(fstream); if list.Count > 0 then @@ -88,34 +87,36 @@ procedure TImportFavorites.DMDHandle; if urlList.Count > 0 then begin - path:= CorrectFilePath(MainForm.options.ReadString('saveto', 'SaveTo', '')); - for i:= 0 to urlList.Count-1 do - begin - urlList.Strings[i]:= - StringReplace(urlList.Strings[i], 'http://mangafox.com', WebsiteRoots[MANGAFOX_ID,1], []); - urlList.Strings[i]:= - StringReplace(urlList.Strings[i], 'http://www.mangafox.com', WebsiteRoots[MANGAFOX_ID,1], []); - urlList.Strings[i]:= - StringReplace(urlList.Strings[i], 'http://www.batoto.com', WebsiteRoots[BATOTO_ID,1], []); - isUnimported:= TRUE; - for j:= 0 to High(WebsiteRoots) do + path:= CleanAndExpandDirectory(configfile.ReadString('saveto', 'SaveTo', '')); + regx := TRegExpr.Create; + try + regx.Expression := REGEX_HOST; + for i:= 0 to urlList.Count-1 do begin - if (Pos(UpCase(WebsiteRoots[j,1]), UpCase(urlList.Strings[i])) > 0) AND - (Pos('comic/_/comics/double-marriage-r3713', urlList.Strings[i]) = 0) then + host := ''; + webs := ''; + host := LowerCase(regx.Replace(urlList[i], '$2', True)); + if host <> '' then + begin + m := Modules.LocateModuleByHost(host); + if m > -1 then + webs := Modules.Module[m].Website; + end; + + if webs <> '' then begin - MainForm.SilentThreadManager.Add( + SilentThreadManager.Add( MD_AddToFavorites, - WebsiteRoots[j,0], - mangaList.Strings[i], - StringReplace(urlList.Strings[i], WebsiteRoots[j,1], '', []), + webs, + mangaList[i], + RemoveHostFromURL(urlList[i]), path); - Sleep(16); - isUnimported:= FALSE; - break; - end; + end + else + unimportedMangas.Add(mangaList.Strings[i] + ' <' + urlList.Strings[i] + '>'); end; - if isUnimported then - unimportedMangas.Add(mangaList.Strings[i] + ' <' + urlList.Strings[i] + '>'); + finally + regx.Free; end; end; @@ -144,7 +145,7 @@ procedure TImportFavorites.DMDHandle; procedure TImportFavorites.FMDHandle; begin - MainForm.FavoriteManager.MergeWith(CorrectFilePath(edPath.Text) + 'works/favorites.ini'); + FavoriteManager.MergeWith(CleanAndExpandDirectory(edPath.Text) + 'works/favorites.ini'); MessageDlg('', RS_ImportCompleted, mtConfirmation, [mbYes], 0) @@ -160,22 +161,6 @@ procedure TImportFavorites.Run; { ----- public methods ----- } -procedure TImportFavorites.FormCreate(Sender: TObject); -begin - Caption:= MainForm.btFavoritesImport.Caption; - btImport.Caption:= RS_Import; - edPath.Text:= RS_SoftwarePath; - btCancel.Caption:= RS_Cancel; - lbSelectSoftware.Caption:= RS_Software; -end; - -procedure TImportFavorites.btBrowseClick(Sender: TObject); -begin - dlgPath.InitialDir:= CorrectFilePath(edPath.Text); - if dlgPath.Execute then - edPath.Text:= CorrectFilePath(dlgPath.FileName); -end; - procedure TImportFavorites.btImportClick(Sender: TObject); begin Run; diff --git a/mangadownloader/forms/frmLogger.lfm b/mangadownloader/forms/frmLogger.lfm new file mode 100644 index 000000000..28b2cf3d8 --- /dev/null +++ b/mangadownloader/forms/frmLogger.lfm @@ -0,0 +1,135 @@ +object FormLogger: TFormLogger + Left = 0 + Height = 283 + Top = 0 + Width = 457 + ActiveControl = tvLog + Caption = 'Log' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 283 + ClientWidth = 457 + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + Position = poMainFormCenter + LCLVersion = '1.7' + Visible = False + object tvLog: TLogTreeView + Left = 6 + Height = 237 + Top = 40 + Width = 445 + Align = alBottom + Anchors = [akTop, akLeft, akRight, akBottom] + DefaultItemHeight = 18 + HotTrack = True + PopupMenu = pmLog + ReadOnly = True + ScrollBars = ssAutoBoth + ShowTime = True + TabOrder = 3 + TimeFormat = 'hh:nn:ss:zzz' + Options = [tvoAllowMultiselect, tvoAutoItemHeight, tvoHideSelection, tvoHotTrack, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] + end + object ckStayOnTop: TCheckBox + Left = 6 + Height = 19 + Top = 8 + Width = 80 + Caption = 'Stay on top' + OnChange = ckStayOnTopChange + TabOrder = 0 + end + object seLogLimit: TSpinEdit + Left = 373 + Height = 23 + Top = 8 + Width = 78 + Anchors = [akTop, akRight] + Increment = 10 + MaxValue = 100000 + MinValue = 10 + TabOrder = 2 + Value = 1000 + end + object lbLogLimit: TLabel + AnchorSideTop.Control = seLogLimit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = seLogLimit + Left = 320 + Height = 15 + Top = 12 + Width = 47 + Anchors = [akTop, akRight] + Caption = 'Log limit' + ParentColor = False + end + object btnClearLog: TBitBtn + AnchorSideTop.Control = seLogLimit + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = lbLogLimit + Left = 241 + Height = 26 + Top = 6 + Width = 73 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Clear' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btnClearLogClick + TabOrder = 1 + end + object tmClearLog: TTimer + Interval = 2000 + OnTimer = tmClearLogTimer + left = 288 + top = 80 + end + object pmLog: TPopupMenu + OnPopup = pmLogPopup + left = 48 + top = 147 + object miCopy: TMenuItem + Caption = 'Copy' + OnClick = miCopyClick + end + end +end diff --git a/mangadownloader/forms/frmLogger.lrj b/mangadownloader/forms/frmLogger.lrj new file mode 100644 index 000000000..c69f54ac8 --- /dev/null +++ b/mangadownloader/forms/frmLogger.lrj @@ -0,0 +1,6 @@ +{"version":1,"strings":[ +{"hash":119198672,"name":"tformlogger.ckstayontop.caption","sourcebytes":[83,116,97,121,32,111,110,32,116,111,112],"value":"Stay on top"}, +{"hash":158511444,"name":"tformlogger.lbloglimit.caption","sourcebytes":[76,111,103,32,108,105,109,105,116],"value":"Log limit"}, +{"hash":4860802,"name":"tformlogger.btnclearlog.caption","sourcebytes":[67,108,101,97,114],"value":"Clear"}, +{"hash":304761,"name":"tformlogger.micopy.caption","sourcebytes":[67,111,112,121],"value":"Copy"} +]} diff --git a/mangadownloader/forms/frmLogger.pas b/mangadownloader/forms/frmLogger.pas new file mode 100644 index 000000000..2d500bb47 --- /dev/null +++ b/mangadownloader/forms/frmLogger.pas @@ -0,0 +1,121 @@ +unit frmLogger; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Spin, + ExtCtrls, Buttons, Menus, Clipbrd, ComCtrls, LogTreeView, MultiLog; + +type + + { TFormLogger } + + TFormLogger = class(TForm) + btnClearLog: TBitBtn; + ckStayOnTop: TCheckBox; + lbLogLimit: TLabel; + miCopy: TMenuItem; + pmLog: TPopupMenu; + seLogLimit: TSpinEdit; + tmClearLog: TTimer; + tvLog: TLogTreeView; + procedure btnClearLogClick(Sender: TObject); + procedure ckStayOnTopChange(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure miCopyClick(Sender: TObject); + procedure pmLogPopup(Sender: TObject); + procedure tmClearLogTimer(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + FormLogger: TFormLogger; + +implementation + +{$R *.lfm} + +{ TFormLogger } + +procedure TFormLogger.tmClearLogTimer(Sender: TObject); +begin + if tvLog.Items.TopLvlCount > seLogLimit.Value then + try + tvLog.BeginUpdate; + while tvLog.Items.TopLvlCount > seLogLimit.Value do + tvLog.Items.TopLvlItems[0].Delete; + finally + tvLog.EndUpdate; + end; +end; + +procedure TFormLogger.FormCreate(Sender: TObject); +begin + Logger.Channels.Add(tvLog.Channel); +end; + +procedure TFormLogger.ckStayOnTopChange(Sender: TObject); +begin + if ckStayOnTop.Checked then + FormStyle := fsStayOnTop + else + FormStyle := fsNormal; +end; + +procedure TFormLogger.btnClearLogClick(Sender: TObject); +begin + tvLog.Clear; +end; + +procedure TFormLogger.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + CloseAction := caHide; +end; + +procedure TFormLogger.FormDestroy(Sender: TObject); +begin + Logger.Channels.Remove(tvLog.Channel); +end; + +procedure TFormLogger.miCopyClick(Sender: TObject); + + procedure GetItemsText(const T: TTreeNode; var S: String; const Indent: Integer = 0); + var + i: Integer; + begin + if S <> '' then + S := S + LineEnding; + S := S + StringOfChar(' ', Indent) + T.Text; + if T.Count > 0 then + for i := 0 to T.Count - 1 do + begin + S := S + LineEnding + StringOfChar(' ', Indent + 2) + T.Items[i].Text; + if T.Items[i].Count > 0 then + GetItemsText(T.Items[i], S, Indent + 2); + end; + end; + +var + s: String; + i: Integer; +begin + if tvLog.SelectionCount = 0 then Exit; + s := ''; + for i := 0 to tvLog.SelectionCount - 1 do + GetItemsText(tvLog.Selections[i], s); + Clipboard.AsText := s; +end; + +procedure TFormLogger.pmLogPopup(Sender: TObject); +begin + miCopy.Enabled := tvLog.SelectionCount > 0; +end; + +end. diff --git a/mangadownloader/forms/frmLuaModulesUpdater.lfm b/mangadownloader/forms/frmLuaModulesUpdater.lfm new file mode 100644 index 000000000..fac4dd8ad --- /dev/null +++ b/mangadownloader/forms/frmLuaModulesUpdater.lfm @@ -0,0 +1,423 @@ +object LuaModulesUpdaterForm: TLuaModulesUpdaterForm + Left = 240 + Height = 394 + Top = 100 + Width = 580 + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 2 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 394 + ClientWidth = 580 + OnCreate = FormCreate + OnDestroy = FormDestroy + LCLVersion = '1.8.0.6' + object vtLuaModulesRepos: TVirtualStringTree + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = btCheckUpdate + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 4 + Height = 354 + Top = 36 + Width = 572 + Anchors = [akTop, akLeft, akRight, akBottom] + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'Filename' + Width = 150 + end + item + Position = 1 + Text = 'Last modified' + Width = 110 + end + item + Position = 2 + Text = 'Last message' + Width = 250 + end> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + HintMode = hmHint + Images = imStates + ParentShowHint = False + ShowHint = True + TabOrder = 3 + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnCompareNodes = vtLuaModulesReposCompareNodes + OnGetText = vtLuaModulesReposGetText + OnGetImageIndex = vtLuaModulesReposGetImageIndex + OnGetHint = vtLuaModulesReposGetHint + OnHeaderClick = vtLuaModulesReposHeaderClick + end + object btCheckUpdate: TBitBtn + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 4 + Height = 26 + Top = 4 + Width = 119 + AutoSize = True + Caption = 'Check update' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 20000000000000040000640000006400000000000000000000000000000E0000 + 0013000000170000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A000000150000000B00000002FFFFFF000000001C733A + 02A265330272000000332A1601436E380280934A02AB984D02CD984D02C29049 + 0291673502622111013A0000002A0000001500000003FFFFFF00281502009C51 + 05CC9C5105CC9C510585A35806BFC8841AE3EAA71FF5FCB920FFFCB920F1EAA6 + 1FCFC78219A6A3590978763D04222816020000000000FFFFFF00A2570A00A257 + 0ACCF9BF40FFA2570ACCF7B52AFFF6B01CFFF7B11EFFF8B527FFF8B527F1F7B1 + 1ED6F6B01CB4F8BA3490AB62105FA3580B19A65B0D00FFFFFF00A85D0E00A85D + 0ECCF2B339FFF3B844FFEEA824FFF2B339FFC37E23DCA85D0ECCA85D0EC1C27E + 22BAE7A937B2EFAB2A90F3B8436DAD631243A95E0F06FFFFFF00AF641400AF64 + 14CCECB149FFE6A334FFEEB752FFAF6414CCAF641494AD621200AA5F0F00AE63 + 134AAF641488E4A74491E8A83B6DCA88314EAF641419FFFFFF00B66B1900B66B + 19CCEBB861FFE7B057FFE7B057FFEEBF6AFFB66B19CCB76C1A5CB56A1800AF64 + 1400B56A1932C7843178E3A84E6CDCA24C54B66B1925FFFFFF00BC711D00BD72 + 1E99BE731FCCBE731FCCBE731FCCBE731FCCBE731FCCBD721E99C0752000C378 + 2300BD721E00BE731F33E5B06140E7B4663FBD721E20FFFFFF00C77C2600C67B + 2620E8B86F3FE6B46C40C57A2533C2782200BF752000C1762100C67B2699C57A + 25CCC57A25CCC57A25CCC57A25CCC57A25CCC67B2699FFFFFF00CD822A00CD82 + 2A25E6B16654E8B5706CD8984478CE832B32CF842C00CB802800CC81295CCD82 + 2ACCF3CD84FFECBD77FFECBD77FFF0C57EFFCD822ACCFFFFFF00D4893000D489 + 3019E2A7554EEDBC766DEEBE7491D4893088D58A314AD98E3300D3882F00D489 + 3094D48930CCF4CD84FFEAB772FFF1C67EFFD48930CCFFFFFF00D98E3300DA8F + 3406DD943A43F8D2896DF4C57D90F4C77AB2E5A852BADB9034C1DB9034CCE5A8 + 52DCF7CD85FFF2C27AFFF8D389FFF7CD85FFDB9034CCFFFFFF00DC913500DC91 + 3500E0953919E49E435FFCD88D90FACF85B4FBD086D6FCD489F1FCD489FFFBD0 + 86FFFACF85FFFBD389FFE19639CCFEDD92FFE19639CCFFFFFF00DC913500DC91 + 3500E1963900E59A3D22E79F4378F1B964A6FACF80CFFEDA8EF1FEDA8EFFFACF + 81F5F1BB65E3E79E42BFE59A3D85E59A3DCCE59A3DCCFFFFFF00DC913500DC91 + 3500E1963900E59A3D00E89D3F10E99E404DE99E408CE99E40C1E99E40CCE99E + 40A6E99E406CE89D3F1AE69B3D00E99E405CE99E4099FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btCheckUpdateClick + TabOrder = 0 + end + object btCheckUpdateTerminate: TSpeedButton + AnchorSideLeft.Control = btCheckUpdate + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btCheckUpdate + AnchorSideBottom.Control = btCheckUpdate + AnchorSideBottom.Side = asrBottom + Left = 125 + Height = 26 + Top = 4 + Width = 20 + Anchors = [akTop, akLeft, akBottom] + AutoSize = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000E00000013000000190000001900000016000000120000000F0000000E0000 + 0011000000150000001900000019000000140000000EFFFFFF00FFFFFF000000 + 001C000000260000346400005FCC00003561000000240000001D0000001B0000 + 00210000366000005FCC00003464000000270000001CFFFFFF00FFFFFF000000 + 1E0000005748000072CC1111D8FF000072CC0000574800002000000020000000 + 5748000072CC1111D8FF000072CC0000574800001E00FFFFFF00FFFFFF000000 + 8200000082CC1111D0FF1111D0FF1111D0FF000082CC00008348000083480000 + 82CC1111D0FF1111D0FF1111D0FF000082CC00008200FFFFFF00FFFFFF000000 + 860000008748000087CC1111C4FF1111C4FF1111C4FF000087CC000087CC1111 + C4FF1111C4FF1111C4FF000087CC0000874800008600FFFFFF00FFFFFF000000 + 86000000870000008C4800008DCC1111B8FF1111B8FF1111B8FF1111B8FF1111 + B8FF1111B8FF00008DCC00008C480000870000008600FFFFFF00FFFFFF000000 + 86000000870000008D0000009148000092CC1515AFFF1111ACFF1111ACFF1111 + ACFF000092CC0000914800008D000000870000008600FFFFFF00FFFFFF000000 + A1000000A00000009B0000009848000097CC2525B4FF1111A2FF1111A2FF1414 + A5FF000097CC0000984800009B000000A0000000A100FFFFFF00FFFFFF000000 + A1000000A00000009C4800009BCC5353DBFF2E2EB7FF3D3DC6FF3131BAFF1515 + 9FFF1E1EA8FF00009BCC00009C480000A0000000A100FFFFFF00FFFFFF000000 + A1000000A1480000A0CC6767EFFF3636BEFF5E5EE6FF0000A0CC0000A0CC4F4F + D7FF3636BEFF4545CDFF0000A0CC0000A1480000A100FFFFFF00FFFFFF000000 + A3000000A3CC7676FEFF4C4CD4FF7272FAFF0000A3CC0000A3480000A3480000 + A3CC6262EAFF4C4CD4FF5C5CE4FF0000A3CC0000A300FFFFFF00FFFFFF000000 + A6000000A7480000A7CC7777FFFF0000A7CC0000A7480000A3000000A3000000 + A7480000A7CC7070F8FF0000A7CC0000A7480000A600FFFFFF00FFFFFF000000 + A6000000A7000000AA480000AACC0000AA480000A7000000A3000000A3000000 + A7000000AA480000AACC0000AA480000A7000000A600FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btCheckUpdateTerminateClick + end + object ckShowUpdateWarning: TCheckBox + AnchorSideLeft.Control = btCheckUpdateTerminate + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btCheckUpdate + AnchorSideTop.Side = asrCenter + Left = 155 + Height = 19 + Top = 8 + Width = 135 + BorderSpacing.Left = 10 + Caption = 'Show update warning' + Checked = True + State = cbChecked + TabOrder = 1 + end + object ckAutoRestart: TCheckBox + AnchorSideLeft.Control = ckShowUpdateWarning + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = ckShowUpdateWarning + Left = 292 + Height = 19 + Top = 8 + Width = 82 + Caption = 'Auto restart' + TabOrder = 2 + end + object imStates: TImageList + left = 200 + top = 128 + Bitmap = { + 4C69070000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003B7F320015A9000015A9000015A9 + 000015A9000015AA009915AA00CC15AA00CC15AA009915A9000015A9000015A9 + 000015A90000094D0000FFFFFF00FFFFFF00119A0000129F000014A8000014A8 + 000014A8000014A800CC72E961FF71E860FF14A800CC14A8000014A8000014A8 + 0000129F0000119A0000FFFFFF00FFFFFF00119A0000119B0000129E000014A5 + 000014A5000014A500CC69E058FF69E058FF14A500CC14A5000014A50000129E + 0000119B0000119A0000FFFFFF00FFFFFF00119A0000119B0000119B0000129D + 000013A2000013A200CC62D951FF61D850FF13A200CC13A20000129D0000119B + 0000119B0000119A0000FFFFFF00FFFFFF00119A0000119B0000119B0000119B + 0000129C0000129E00CC5AD149FF59D048FF129E00CC129C0000119B0000119B + 0000119B0000119A0000FFFFFF00FFFFFF00119A0099119A00CC119A00CC119A + 00CC119A00CC119A00CC54CB43FF52C941FF119A00CC119A00CC119A00CC119A + 00CC119A00CC119A0099FFFFFF00FFFFFF00109600CC5ED54DFF55CC44FF54CB + 43FF53CA42FF52C941FF4BC23AFF4AC139FF4FC63EFF4EC53DFF4DC43CFF4CC3 + 3BFF4EC53DFF109600CCFFFFFF00FFFFFF000F9200CC59D048FF50C73FFF50C7 + 3FFF4FC63EFF4AC139FF3BB32AFF31A920FF31A920FF2CA51BFF2BA31AFF2DA5 + 1CFF33AB22FF0F9200CCFFFFFF00FFFFFF000E8E00990E8D00CC0E8D00CC0E8D + 00CC0E8D00CC0E8D00CC2DAE1CFF2BAC1AFF0E8D00CC0E8D00CC0E8D00CC0E8D + 00CC0E8D00CC0E8E0099FFFFFF00FFFFFF000E8D00000E8C00000E8C00000E8C + 00000E8B00000D8900CC29B618FF27B416FF0D8900CC0E8B00000E8C00000E8C + 00000E8C00000E8D0000FFFFFF00FFFFFF000E8D00000E8C00000E8C00000E8A + 00000C8400000C8400CC25C014FF24C013FF0C8400CC0C8400000E8A00000E8C + 00000E8C00000E8D0000FFFFFF00FFFFFF000747000000000000000000000320 + 00000A7D00000A7D00CC23CD12FF22CC11FF0A7D00CC0A7D0000032000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000000000000000 + 0000021D0000066D00CC22D811FF22D811FF066D00CC021D0000000000000000 + 00000000000000000000FFFFFF00FFFFFF0000000000000000040000001B0000 + 003000000033024700A6025D00CC025D00CC024700A600000033000000310000 + 001F0000000600000000FFFFFF00FFFFFF0000000000000000020000000E0000 + 00180000001A0000001A0000001A0000001A0000001A0000001A000000190000 + 00100000000300000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000063CE000065D0000064 + CF000069D400006AD548006AD5CC006AD5CC006AD5660069D4000064CF000065 + D0000063CE00FFFFFF00FFFFFF00FFFFFF00FFFFFF000063CE000065D01A0064 + CF000066D1000067D2CC38C1F8F938C7F8FD0067D2C90066D1000064CF000065 + D01A0063CE00FFFFFF00FFFFFF00FFFFFF00FFFFFF000063CE660063CECC0063 + CEB30062CD4D0063CECC3AC8F8FF2FC0F1FD0063CEB30062CD4D0063CEB30063 + CECC0063CE66FFFFFF00FFFFFF00FFFFFF00FFFFFF00005FCACC39C2F5FF34B8 + F2F9117AD7D9005FCACC38C1F4FF2AAFE9F9005FCAB71079D6D932B6F0F936BF + F3FF005FCACCFFFFFF00FFFFFF00FFFFFF00FFFFFF00005AC5CC27A4E3F92CAD + E7FF31B3ECFF1075D3D935B9F0FF249EE1F50F74D2D930B2EBFF2CADE7FF27A4 + E3F9005AC5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF000056C13E0055C0B31074 + CDE01A87D5EC2DAAE6FF2DA9E6FF28A3E1FF2DA9E6FF1A87D5EC1074CDE00055 + C0B30056C13EFFFFFF00FFFFFF00FFFFFF00FFFFFF000050BA000050BB000050 + BB480050BBCC1C8BD6F3249CDEFF249CDEFF1C8BD6F30050BBCC0050BB480050 + BB000050BA00FFFFFF00FFFFFF00FFFFFF00FFFFFF000049B33E004BB5B31474 + CCE01B87D6EC2099DDFF2099DDFF239EE1FF2099DDFF1884D3EC1070C9E0004B + B5B30049B33EFFFFFF00FFFFFF00FFFFFF00FFFFFF000045AFCC24A1E4F91C9D + E1FF1A9ADFFF075ABBD9158BD7F520A1E5FF075ABBD91A9ADFFF1B9BE0FF1C97 + DFF90045AFCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00003DA8CC139DE2FF1192 + DCF90554B6D9003DA8B71194DCF918A2E6FF003DA8CC0554B6D91192DCF9139D + E2FF003DA8CCFFFFFF00FFFFFF00FFFFFF00FFFFFF0000329D6600309BCC0030 + 9BB300339E4D00309BB30C9EE5FD0FA4E9FF00309BCC00339E4D00309BB30030 + 9BCC00329D66FFFFFF00FFFFFF00FFFFFF00FFFFFF0000184E0000154A1A0017 + 4C00000A250000248EC908A2E8FD0899E2F900248ECC000A250000174C000015 + 4A1A00184E00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000000D0000 + 00210000002700135E79002B91D1002B91D100104B6100000027000000230000 + 001000000001FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000080000 + 00160000001A0000001A0000001A0000001A0000001A0000001A000000170000 + 000A00000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000212121006565 + 65008B8B8B002502B0002502B2002502B3002602B5372602B47B2502B47C2502 + B3382502AF002402AC002302A800000000001D1D1D005C5C5C00808080008686 + 86008B8B8B002502B0002502B2002502B3382502B37CC9B8FDFFCAB9FEFF2502 + B17E2502AF392402AC002302A800525252007373730079797900808080008686 + 86008B8B8B002502B0002502B2392502B17EC6B5FCFFB6A5ECFFB8A7ECFFCAB9 + FEFF2402AD812402AC3B2302A8006C6C6C007373730079797900808080008686 + 86008B8B8B002502B0392502B07FC4B3FBFFB3A2EAFFB5A4EBFFB6A5ECFFB8A7 + ECFFCAB9FEFF2402A9862302A83D6C6C6C007373730079797900808080008686 + 86008A8A8A2F88888866C1B0F9FFB09FE9FFB2A1E9FFB3A2EAFFB5A4EBFFB6A5 + ECFF9887DCFFAA99EEFF2302A58A6C6C6C007373730079797900808080008585 + 852F83838366F8F8F8FFF5F5F5FFAE9DE8FFB09FE9FFB2A1E9FFB3A2EAFF9584 + D9FF9786DBFFA998EDFF2202A18D6C6C6C0073737300797979007F7F7F2F7D7D + 7D66F6F6F6FFF2F2F2FFF2F2F2FFF2F2F2FFAE9DE8FFB09FE9FF9281D6FF9483 + D8FFA695EAFF22029F9022029F416C6C6C00737373007878782F76767666F4F4 + F4FFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFF8E7DD2FF907FD4FFA392 + E7FF21029D9221029C4221029E006C6C6C007272722F70707066F3F3F3FFECEC + ECFFECECECFFECECECFFECECECFFECECECFFCECECEFFD0D0D0FF9F8EE3FF2102 + 9B9521029A4321029C0021029E006B6B6B2F69696966F1F1F1FFE9E9E9FFE9E9 + E9FFE9E9E9FFE9E9E9FFE9E9E9FFCACACAFFCCCCCCFFDCDCDCFF363636662003 + 98452102990021029C0021029E0063636366F0F0F0FFE6E6E6FFE6E6E6FFE6E6 + E6FFE6E6E6FFE6E6E6FFC6C6C6FFC8C8C8FFD8D8D8FF272727662323232F2003 + 9700210299001902750011014F0058585866F0F0F0FFE3E3E3FFE3E3E3FFE3E3 + E3FFE3E3E3FFC2C2C2FFC4C4C4FFD4D4D4FF1A1A1A661616162F202020001803 + 71000801260000000000000000004848482F3D3D3D66F0F0F0FFE1E1E1FFE1E1 + E1FFBFBFBFFFC0C0C0FFD1D1D1FF0F0F0F660C0C0C2F0F0F0F00080808000000 + 0000000000000000000000000000101010001E1E1E2F20202066DFDFDFFFCECE + CEFFCECECEFFCECECEFF050505660202022F0202020000000000000000000000 + 00000000000000000000000000000000001100000026090909480A0A0A660505 + 05660202026601010166000000400000001E00000019000000130000000E0000 + 000000000005000000020000000000000000000000130000001A000000190000 + 00180000001600000014000000120000000F0000000D0000000A000000070000 + 0005000000030000000100000000000000000000000000000000000000002222 + 2200696969002502B0002502B2002502B3002602B5372602B47B2502B47C2502 + B3382502AF002402AC002302A80000000000000000001F1F1F00616161008686 + 86008B8B8B002502B0002502B2002502B3382502B37CC9B8FDFFCAB9FEFF2502 + B17E2502AF392402AC002302A8001C1C1C005757570079797900808080008686 + 86008B8B8B002502B0002502B2392502B17EC6B5FCFFB6A5ECFFB8A7ECFFCAB9 + FEFF2402AD812402AC3B2302A8006C6C6C007373730079797900808080008686 + 86008B8B8B002502B0392502B07FC4B3FBFFB3A2EAFFB5A4EBFFB6A5ECFFB8A7 + ECFFCAB9FEFF2402A9862302A83D6C6C6C007373730079797900808080008686 + 86008A8A8A2F88888866C1B0F9FFB09FE9FFB2A1E9FFB3A2EAFFB5A4EBFFB6A5 + ECFF9887DCFFAA99EEFF2302A58A6C6C6C007373730079797900808080008585 + 852F83838366F8F8F8FFF5F5F5FFAE9DE8FFB09FE9FFB2A1E9FFB3A2EAFF9584 + D9FF9786DBFFA998EDFF2202A18D6C6C6C0073737300797979007F7F7F2F7D7D + 7D66F6F6F6FFF2F2F2FFF2F2F2FFF2F2F2FFAE9DE8FFB09FE9FF9281D6FF9483 + D8FFA695EAFF22029F9022029F416C6C6C00737373007878782F76767666F4F4 + F4FFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFF8E7DD2FF907FD4FFA392 + E7FF21029D9221029C4221029E006C6C6C007272722F70707066F3F3F3FFECEC + ECFFECECECFFECECECFFECECECFFECECECFFCECECEFFD0D0D0FF9F8EE3FF2102 + 9B9521029A4321029C0021029E006B6B6B2F69696966F1F1F1FFE9E9E9FFE9E9 + E9FFE9E9E9FFE9E9E9FFE9E9E9FFCACACAFFCCCCCCFFDCDCDCFF363636662003 + 984519029D000901A7000000A70063636366F0F0F0FFE6E6E6FFE6E6E6FFE6E6 + E6FFE6E6E6FFE6E6E6FFC6C6C6FFC8C8C8FFD8D8D8FF272727661A1A452F0801 + A5000000AA000000AA000000A70058585866F0F0F0FFE3E3E3FFE3E3E3FFE3E3 + E3FFE3E3E3FFC2C2C2FFC4C4C4FFD4D4D4FF0A0A7BC20202A1D50000A7CC0000 + A7CC0000A7CC0000A7CC0000A6994848482F3D3D3D66F0F0F0FFE1E1E1FFE1E1 + E1FFBFBFBFFFC0C0C0FFD1D1D1FF0F0F0F66010192D55E5EF7FF5E5EF7FF5E5E + F7FF5E5EF7FF5E5EF7FF000098CC101010001E1E1E2F20202066DFDFDFFFCECE + CEFFCECECEFFCECECEFF050505660202022F00006299000080CC000080CC0000 + 80CC000080CC000080CC000084990000001100000026090909480A0A0A660505 + 05660202026601010166000000400000001E00000019000000130000000E0000 + 000000000005000000020000400000000000000000130000001A000000190000 + 00180000001600000014000000120000000F0000000D0000000A000000070000 + 0005000000030000000100000000FFFFFF00E99E3F00E99E3F00E99E3F00EA9F + 4099EA9F40CCEA9F4099EA9F4000EA9F40CCEA9F4000E59A3D00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E69B3D00E69B3D00E69B3D00E69B + 3DCCFFE195FFE69B3DCCE4993C00E69B3D00E4993C00E3983B00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E3983B00E3983B00E3983B00E398 + 3B99E2973ACCE2973ACCE2973ACCE2973A99E2973A00E2973ACCE2973A00E297 + 3A00E2973A00FFFFFF00FFFFFF00FFFFFF00DD923600DD923600DD923600DD92 + 3600DD923600DD9236CCFEDC90FFDD9236CCDB903400DD923600DC913500DC91 + 3500DC913500FFFFFF00FFFFFF00FFFFFF00D68B3100D68B3100D68B3100D78C + 3299D88D32CCD88D32CCD88D32CCD88D32CCD88D32CCD78C3299D68B3100D68B + 3100D68B3100FFFFFF00FFFFFF00FFFFFF00D2872E00D2872E00D2872E00D287 + 2ECCFBD589FFD38930CEFAD488FFD2872ECCFAD286FFD2872ECCD2872E00D287 + 2E00D2872E00FFFFFF00FFFFFF00FFFFFF00B86D1A00C97E2700C97E2700CA7F + 2899D58E39D7D58E39D7D08731D2CB8029CCCB8029CCCA7F2899C97E2700C97E + 2700B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00BD721E00C57A2400C57A + 24CCF7CC80FFDA9645E3F6CA7EFFC87E29CFF6C97DFFC57A24CCC57A2400BD72 + 1E00B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00B96E1B00BB701D00BE73 + 1FCCEDB96CF8E1A153EFDB9949E8D4903FE1D4903FE1BD721F99B96E1B00B96E + 1B00B86D1A00FFFFFF00FFFFFF00FFFFFF00B76C1A99B86D1ACCB86D1ACCB86D + 1ACCF3C074FFE9AC60FAEEB266FFE4A659F5F2BD71FFB86D1ACCB86D1ACCB86D + 1ACCB76C1A99FFFFFF00FFFFFF00FFFFFF00B267165CB16615CCF7CB7FFFF2BF + 73FFF0B86CFFE9AD61FFDFA357FFD5994DFFD49B4FFFD6A054FFDDAB5FFFB166 + 15CCB267165CFFFFFF00FFFFFF00FFFFFF00B1661500AC61115CAB6010CCF2C3 + 77FFDB9E4CFFD09341FFCF9240FFCF9240FFCF9240FFDCA858FFAB6010CCAC61 + 115CB1661500FFFFFF00FFFFFF00FFFFFF00B1661500AB601000A65B0D5CA55A + 0CCCEAB44BFFE09E29FFE09E29FFE09E29FFE8AE43FFA55A0CCCA65B0D5CAB60 + 1000B1661500FFFFFF00FFFFFF00FFFFFF000000000000000000532D0600A156 + 095CA05508CCF7B92EFFF5AB0EFFF7B629FFA05508CCA156095C532D06000000 + 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 + 00196D39046E9B5005CCFFBB19FF9B5005CC6D39046E0000001A000000110000 + 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 + 00320000003363320274974C02CC633202740000003300000033000000220000 + 000800000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000013A2000014A5000014A5000014A6000015A8000015A9001F15AA + 00CC15AA004814A70000FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000014A5001014A700B077EE + 66FF14A700CC14A70048FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000614A3009E43C631E56BE2 + 5AFF70E95FFB14A300CCFFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000113A0008533B820DE61D850FF5CD5 + 4BFA1EA80CD213A1004CFFFFFF00FFFFFF0011970000129B0048129B00CC129B + 0048119700000F93000011970000129B006924AA13D857CF46FE55CD44FD21A7 + 10D6129C006313A00000FFFFFF00FFFFFF0011960048119700CC73EA62FD1197 + 00CC119600480F9300001196004C189D08D33DB62CFB37AF26FE1FA00EDA1197 + 007B11980000129B0000FFFFFF00FFFFFF000F9200CC6DE55CFA59D048FF69E1 + 58FC0F9200CC0F92006D139504CB34B423F832B221FF1F9F0FDF0F92008C1094 + 00021095000010950000FFFFFF00FFFFFF000E8E00480E8D00CC5FD94FF933BC + 22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA20FE40E8D009E0F8F00081094 + 000010950000084B0000FFFFFF00FFFFFF000E8D00000D8800480D8700CC43CA + 33F629C318FF39CC28FF28C217FF1EAA0FEA0D8700AE0D8A00100F8F0000084A + 00000000000000000000FFFFFF00FFFFFF00074700000A6500000B8300480B82 + 00CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85001B07450000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000032000000657 + 0048077200CC16A60AE8087601C406570029021E000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00000000020000000F0000001F0000 + 002D02330066025F00CC012B005500000029000000220000001A000000130000 + 000C0000000600000001FFFFFF00FFFFFF000000000100000008000000100000 + 00170000001A000000190000001700000015000000110000000D0000000A0000 + 00060000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 + A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 + A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 + AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 + A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B + E8F65F5FE7FF5B5BE3FF4949D1FF4949D1FF5B5BE3FF5F5FE7FF5858E4F60F0F + B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 + D9FF4F4FD7FF4040C8FFFFFFFFFFFFFFFFFF4040C8FF4F4FD7FF5050D8FF4F4F + DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 + CAFF4242CAFF3636BEFFFFFFFFFFFFFFFFFF3636BEFF4242CAFF4242CAFF4747 + CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 + BFFF3737BFFF2A2AB2FFE8E8E8FFDADADAFF15159EFF12129CFF12129CFF1616 + A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E + B8FF1D1DABFF1212A1FFCCCCCCFFD1D1D1FF1111A0FF1111A1FF1111A1FF1111 + A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 + ABFF1111AAFF1111A6FFD1D1D1FFDCDCDCFF1111A6FF1111AAFF1111AAFF1111 + AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 + B4FF1111B4FF1111B4FF1111A8FF1111A8FF1111B4FF1111B4FF1111B4FF1111 + B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 + BEFF1111BEFF1111B5FFE8E8E8FFEEEEEEFF1111B5FF1111BEFF1111BEFF1111 + BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 + C8FF1111C8FF1111BCFFEEEEEEFFEEEEEEFF1111BCFF1111C8FF1111C8FF0F0F + BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 + C4F61212D1FF1111D1FF1111B6FF1111B6FF1111D1FF1111D1FF0F0FC2F60303 + 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 + 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 + 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 + 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00 + } + end + object tmRepaintList: TTimer + Enabled = False + Interval = 500 + OnTimer = tmRepaintListTimer + left = 61 + top = 119 + end +end diff --git a/mangadownloader/forms/frmLuaModulesUpdater.lrj b/mangadownloader/forms/frmLuaModulesUpdater.lrj new file mode 100644 index 000000000..bac00db9b --- /dev/null +++ b/mangadownloader/forms/frmLuaModulesUpdater.lrj @@ -0,0 +1,8 @@ +{"version":1,"strings":[ +{"hash":2901221,"name":"tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text","sourcebytes":[70,105,108,101,110,97,109,101],"value":"Filename"}, +{"hash":119908548,"name":"tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text","sourcebytes":[76,97,115,116,32,109,111,100,105,102,105,101,100],"value":"Last modified"}, +{"hash":115487141,"name":"tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text","sourcebytes":[76,97,115,116,32,109,101,115,115,97,103,101],"value":"Last message"}, +{"hash":56103285,"name":"tluamodulesupdaterform.btcheckupdate.caption","sourcebytes":[67,104,101,99,107,32,117,112,100,97,116,101],"value":"Check update"}, +{"hash":47677607,"name":"tluamodulesupdaterform.ckshowupdatewarning.caption","sourcebytes":[83,104,111,119,32,117,112,100,97,116,101,32,119,97,114,110,105,110,103],"value":"Show update warning"}, +{"hash":205920740,"name":"tluamodulesupdaterform.ckautorestart.caption","sourcebytes":[65,117,116,111,32,114,101,115,116,97,114,116],"value":"Auto restart"} +]} diff --git a/mangadownloader/forms/frmLuaModulesUpdater.pas b/mangadownloader/forms/frmLuaModulesUpdater.pas new file mode 100644 index 000000000..0c269fd95 --- /dev/null +++ b/mangadownloader/forms/frmLuaModulesUpdater.pas @@ -0,0 +1,995 @@ +unit frmLuaModulesUpdater; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + Buttons, Menus, ExtCtrls, VirtualTrees, synautil, httpsendthread, BaseThread, + XQueryEngineHTML, fpjson, jsonparser, jsonscanner, dateutils; + +type + + TLuaModuleRepoFlag = (fNone, fNew, fUpdate, fDelete, fDeleted, fDownloading, + fDownloaded, fFailedDownload); + + PPLuaModuleRepo = ^PLuaModuleRepo; + PLuaModuleRepo = ^TLuaModuleRepo; + + { TLuaModuleRepo } + + TLuaModuleRepo = class + name: String; + sha: String; + size: Integer; + download_url: String; + last_modified: TDateTime; + last_message: String; + flag: TLuaModuleRepoFlag; + oflag: TLuaModuleRepoFlag; + function Clone: TLuaModuleRepo; + function SyncTo(const t: TLuaModuleRepo): Boolean; + end; + + { TLuaModulesRepos } + + TLuaModulesRepos = class + private + function GetCount: Integer; inline; + function GetRepo(const AIndex: Integer): TLuaModuleRepo; inline; + public + Items: TStringList; + + constructor Create; + destructor Destroy; override; + + procedure Clear; inline; + function Add(const AName: String): TLuaModuleRepo; overload; + procedure Add(const I: TLuaModuleRepo); overload; + procedure LoadFromRemote(const AHTTP: THTTPSendThread); + procedure LoadFromRemoteHTML(const AHTTP: THTTPSendThread); + procedure LoadFromFile(const AFilename: String); + procedure SaveToFile(const AFilename: String); + procedure Sort; + function Clone: TLuaModulesRepos; + property Count: Integer read GetCount; + property Repo[const AIndex: Integer]: TLuaModuleRepo read GetRepo; default; + end; + + TCheckUpdateThread = class; + + { TLuaModulesUpdaterForm } + + TLuaModulesUpdaterForm = class(TForm) + btCheckUpdate: TBitBtn; + ckShowUpdateWarning: TCheckBox; + ckAutoRestart: TCheckBox; + imStates: TImageList; + btCheckUpdateTerminate: TSpeedButton; + tmRepaintList: TTimer; + vtLuaModulesRepos: TVirtualStringTree; + procedure btCheckUpdateClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btCheckUpdateTerminateClick(Sender: TObject); + procedure tmRepaintListTimer(Sender: TObject); + procedure vtLuaModulesReposCompareNodes(Sender: TBaseVirtualTree; + Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); + procedure vtLuaModulesReposGetHint(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; + var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); + procedure vtLuaModulesReposGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: Integer); + procedure vtLuaModulesReposGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); + {$if VTMajorVersion < 5} + procedure vtLuaModulesReposHeaderClick(Sender: TVTHeader; Column: TColumnIndex; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + {$else} + procedure vtLuaModulesReposHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + {$endif} + private + FListCS: TRTLCriticalSection; + FListDirty: Boolean; + public + Repos: TLuaModulesRepos; + ThreadCheck: TCheckUpdateThread; + procedure ListDirty; + procedure LoadLocalRepos; + procedure ReinitList(const ASort: Boolean = True); + procedure SortList; + end; + + { TDownloadThread } + + TDownloadThread = class(TBaseThread) + private + FOwner: TCheckUpdateThread; + FModule: TLuaModuleRepo; + FHTTP: THTTPSendThread; + protected + procedure Execute; override; + public + constructor Create(const Owner: TCheckUpdateThread; const T: TLuaModuleRepo); + destructor Destroy; override; + end; + + { TCheckUpdateThread } + + TCheckUpdateThread = class(TBaseThread) + private + FOwner: TLuaModulesUpdaterForm; + FHTTP: THTTPSendThread; + FReposUp: TLuaModulesRepos; + FRepos: TLuaModulesRepos; + FMainRepos: TLuaModulesRepos; + FThreads: TFPList; + FThreadsCS: TRTLCriticalSection; + FDownloadedCount: Integer; + FProceed: Boolean; + FStatusList: TStringList; + procedure RemoveThread(const T: TDownloadThread); + procedure AddThread(const T: TDownloadThread); + protected + procedure SyncStartChecking; + procedure SyncFinishChecking; + procedure SyncAskToProceed; + procedure SyncStartDownload; + procedure SyncFinishDownload; + procedure SyncFinal; + function SyncRepos(const ARepos, AReposUp: TLuaModulesRepos): Boolean; + procedure Download; + procedure Execute; override; + public + constructor Create(const AOwner: TLuaModulesUpdaterForm); + destructor Destroy; override; + procedure AddStatus(const S: String); + end; + +var + LuaModulesUpdaterForm: TLuaModulesUpdaterForm; + +resourcestring + RS_CheckUpdate = 'Check update'; + RS_Checking = 'Checking...'; + RS_FinishChecking = 'Finish checking'; + RS_StartDownloading = 'Downloading...'; + RS_FinishDownload = 'Finish download'; + RS_NewUpdateFoundTitle = 'Modules update found!'; + RS_NewUpdateFoundLostChanges = 'Modules update found, any local changes will be lost, procced?'#13#10#13#10'%s'; + RS_ModulesUpdatedTitle = 'Modules updated!'; + RS_ModulesUpdatedRestart = 'Modules updated, restart now?'#13#10#13#10'%s'; + RS_StatusNew = '%s NEW*'; + RS_StatusUpdate = '%s UPDATE*'; + RS_StatusRedownloaded = '%s REDOWNLOAD*'; + RS_StatusFailed = '%s FAILED*'; + RS_StatusDelete = '%s DELETE*'; + +implementation + +uses frmCustomColor, FMDOptions; + +const + // RFC 3339 - ISO 8601 + DateTimeFormatStrDecode = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss'; + DateTimeFormatStrEncode = DateTimeFormatStrDecode + '"Z"'; + UnknownDateTime = 43101.0423726852; // 01/01/2018 01:01:01 + +function JSONToDateTime(const s: String): TDateTime; +begin + if Length(s) = 20 then + Result := ScanDateTime(DateTimeFormatStrDecode, s) + else + Result := UnknownDateTime; +end; + +function DateTimeToJSON(const d: TDateTime): String; +begin + Result := FormatDateTime(DateTimeFormatStrEncode, d); +end; + +{ TLuaModuleRepo } + +function TLuaModuleRepo.Clone: TLuaModuleRepo; +begin + Result := TLuaModuleRepo.Create; + Result.name := name; + Result.sha := sha; + Result.sha := sha; + Result.size := size; + Result.download_url := download_url; + Result.last_modified := last_modified; + Result.last_message := last_message; + Result.flag := flag; + Result.oflag := oflag; +end; + +function TLuaModuleRepo.SyncTo(const t: TLuaModuleRepo): Boolean; +begin + Result := name = t.name; + if not Result then + Exit; + if sha <> t.sha then + begin + t.sha := sha; + t.last_modified := last_modified; + t.last_message := last_message; + t.oflag := t.flag; + t.flag := fUpdate; + end; +end; + +{ TLuaModulesRepos } + +function TLuaModulesRepos.GetCount: Integer; +begin + Result := Items.Count; +end; + +function TLuaModulesRepos.GetRepo(const AIndex: Integer): TLuaModuleRepo; +begin + Result := TLuaModuleRepo(Items.Objects[AIndex]); +end; + +constructor TLuaModulesRepos.Create; +begin + Items := TStringList.Create; + Items.OwnsObjects := True; + Clear; +end; + +destructor TLuaModulesRepos.Destroy; +begin + Clear; + Items.Free; + inherited Destroy; +end; + +procedure TLuaModulesRepos.Clear; +begin + Items.Clear; +end; + +function TLuaModulesRepos.Add(const AName: String): TLuaModuleRepo; +begin + Result := TLuaModuleRepo.Create; + Result.name := AName; + Items.AddObject(AName, Result); +end; + +procedure TLuaModulesRepos.Add(const I: TLuaModuleRepo); +begin + Items.AddObject(I.name, I); +end; + +procedure TLuaModulesRepos.LoadFromRemote(const AHTTP: THTTPSendThread); +var + j: TJSONParser; + a: TJSONArray; + i: Integer; + o: TJSONObject; + m: TLuaModuleRepo; +begin + Clear; + + a := nil; + j := TJSONParser.Create(AHTTP.Document, [joUTF8]); + try + a := TJSONArray(j.Parse); + finally + j.Free; + end; + if a = nil then + Exit; + + try + for i := 0 to a.Count - 1 do + begin + o := TJSONObject(a.Items[i]); + m := Add(o.Get('name', '')); + m.sha := o.Get('sha', ''); + m.download_url := o.Get('download_url', ''); + m.size := o.Get('size', 0); + end; + finally + a.Free; + end; +end; + +procedure TLuaModulesRepos.LoadFromRemoteHTML(const AHTTP: THTTPSendThread); +var + v: IXQValue; + i: Integer; +begin + with TXQueryEngineHTML.Create(AHTTP.Document) do + try + v := XPath('//table[starts-with(@class,"files")]//tr[@class="js-navigation-item"]'); + if v.Count = Count then + for i := 1 to v.Count do + with Repo[i - 1] do + begin + last_message := XPathString('./td[@class="message"]/span/a/@title', v.get(i)); + last_modified := JSONToDateTime( + XPathString('./td[@class="age"]/span/time-ago/@datetime', v.get(i))); + end; + finally + Free; + end; + Sort; +end; + +procedure TLuaModulesRepos.LoadFromFile(const AFilename: String); +var + f: TFileStream; + j: TJSONParser; + a: TJSONArray; + o: TJSONObject; + i: Integer; + m: TLuaModuleRepo; +begin + if not FileExists(AFilename) then + Exit; + + a := nil; + f := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite); + try + j := TJSONParser.Create(f, [joUTF8]); + try + a := TJSONArray(j.Parse); + finally + j.Free; + end; + finally + f.Free; + end; + if a = nil then + Exit; + try + Self.Clear; + for i := 0 to a.Count - 1 do + begin + o := TJSONObject(a.Items[i]); + m := Add(o.Get('name', '')); + m.sha := o.Get('sha', ''); + m.download_url := o.Get('download_url', ''); + m.size := o.Get('size', 0); + m.last_modified := JSONToDateTime(o.Get('last_modified', '')); + m.last_message := o.Get('last_message', ''); + m.flag := TLuaModuleRepoFlag(o.Get('flag', 0)); + if (m.flag <> fFailedDownload) and + (not FileExists(LUA_WEBSITEMODULE_FOLDER + m.name)) then + m.flag := fFailedDownload; + end; + finally + a.Free; + end; + Sort; +end; + +procedure TLuaModulesRepos.SaveToFile(const AFilename: String); +var + a: TJSONArray; + o: TJSONObject; + i: Integer; + m: TLuaModuleRepo; + f: TFileStream; +begin + a := TJSONArray.Create; + try + for i := 0 to Items.Count - 1 do + begin + o := TJSONObject.Create; + m := Repo[i]; + o.Add('name', m.name); + o.Add('sha', m.sha); + o.Add('download_url', m.download_url); + o.Add('size', m.size); + o.Add('last_modified', DateTimeToJSON(m.last_modified)); + o.Add('last_message', m.last_message); + o.Add('flag', Integer(m.flag)); + a.Add(o); + end; + + if FileExists(AFilename) then + DeleteFile(AFilename); + f := TFileStream.Create(AFilename, fmCreate); + try + a.DumpJSON(f); + finally + f.Free; + end; + finally + a.Free; + end; +end; + +procedure TLuaModulesRepos.Sort; +begin + if Items.Count <> 0 then + Items.Sort; +end; + +function TLuaModulesRepos.Clone: TLuaModulesRepos; +var + i: Integer; +begin + Result := TLuaModulesRepos.Create; + for i := 0 to Items.Count - 1 do + Result.Items.AddObject(Items[i], Repo[i].Clone); +end; + +{ TDownloadThread } + +procedure TDownloadThread.Execute; +var + f: String; + c: Boolean; +begin + FModule.oflag := FModule.flag; + FModule.flag := fDownloading; + FOwner.FOwner.ListDirty; + if FHTTP.GET(FModule.download_url) then + begin + if ForceDirectories(LUA_WEBSITEMODULE_FOLDER) then + begin + f := LUA_WEBSITEMODULE_FOLDER + FModule.name; + c := True; + if FileExists(f) then + c := DeleteFile(f); + if c then + begin + FHTTP.Document.SaveToFile(f); + if FileExists(f) then + begin + case FModule.oflag of + fNew: FOwner.AddStatus(Format(RS_StatusNew, [FModule.name])); + fUpdate: FOwner.AddStatus(Format(RS_StatusUpdate, [FModule.name])); + fFailedDownload: FOwner.AddStatus(Format(RS_StatusRedownloaded, [FModule.name])); + end; + FModule.flag := fDownloaded; + FOwner.FDownloadedCount := InterLockedIncrement(FOwner.FDownloadedCount); + end; + end; + end; + end + else + begin + FOwner.AddStatus(Format(RS_StatusFailed, [FModule.name])); + FModule.flag := fFailedDownload; + end; + FOwner.FOwner.ListDirty; +end; + +constructor TDownloadThread.Create(const Owner: TCheckUpdateThread; const T: TLuaModuleRepo); +begin + inherited Create(False); + FHTTP := THTTPSendThread.Create(Self); + FOwner := Owner; + FModule := T; + FOwner.AddThread(Self); +end; + +destructor TDownloadThread.Destroy; +begin + FOwner.RemoveThread(Self); + FHTTP.Free; + inherited Destroy; +end; + +{ TCheckUpdateThread } + +procedure TCheckUpdateThread.RemoveThread(const T: TDownloadThread); +begin + EnterCriticalsection(FThreadsCS); + try + FThreads.Remove(T); + finally + LeaveCriticalsection(FThreadsCS); + end; +end; + +procedure TCheckUpdateThread.AddThread(const T: TDownloadThread); +begin + EnterCriticalsection(FThreadsCS); + try + FThreads.Add(T); + finally + LeaveCriticalsection(FThreadsCS); + end; +end; + +procedure TCheckUpdateThread.SyncStartChecking; +begin + FOwner.btCheckUpdate.Caption := RS_Checking; + FOwner.btCheckUpdateTerminate.Visible := True; + FOwner.tmRepaintList.Enabled := True; +end; + +procedure TCheckUpdateThread.SyncFinishChecking; +begin + FOwner.btCheckUpdate.Caption := RS_FinishChecking; + FOwner.vtLuaModulesRepos.BeginUpdate; + try + FMainRepos := FOwner.Repos; + FOwner.Repos := FRepos; + FOwner.ReinitList; + finally + FOwner.vtLuaModulesRepos.EndUpdate; + end; +end; + +procedure TCheckUpdateThread.SyncAskToProceed; +begin + FProceed := MessageDlg(RS_NewUpdateFoundTitle, + Format(RS_NewUpdateFoundLostChanges, [Trim(FStatusList.Text)]), + mtWarning, mbYesNo, 0) = mrYes; +end; + +procedure TCheckUpdateThread.SyncStartDownload; +begin + FOwner.btCheckUpdate.Caption := RS_StartDownloading; +end; + +procedure TCheckUpdateThread.SyncFinishDownload; +begin + FOwner.btCheckUpdate.Caption := RS_FinishDownload; +end; + +procedure TCheckUpdateThread.SyncFinal; +begin + FOwner.btCheckUpdateTerminate.Visible := False; + FOwner.btCheckUpdate.Caption := RS_CheckUpdate; + FOwner.ThreadCheck := nil; + FOwner.tmRepaintList.Enabled := False; + if FMainRepos <> nil then + try + FOwner.vtLuaModulesRepos.BeginUpdate; + FOwner.Repos := FMainRepos; + FOwner.ReinitList; + FMainRepos.SaveToFile(LUA_WEBSITEMODULE_FILE); + finally + FOwner.vtLuaModulesRepos.EndUpdate; + end; +end; + +function TCheckUpdateThread.SyncRepos(const ARepos, AReposUp: TLuaModulesRepos): Boolean; +var + i, j, imax, jmax, k, inew, iupdate: Integer; + newfound: Boolean; + m, u: TLuaModuleRepo; +begin + i := 0; + j := 0; + inew := 0; + iupdate := 0; + imax := ARepos.Items.Count; + jmax := AReposUp.Items.Count; + while (i < imax) or (j < jmax) do + begin + if i < imax then + m := ARepos[i] + else + m := nil; + if j < jmax then + u := AReposUp[j] + else + u := nil; + + if (m <> nil) and (u <> nil) then + begin + if u.SyncTo(m) then // look for new update + begin + Inc(i); + Inc(j); + if m.flag = fUpdate then + Inc(iupdate); + end + else + begin // scan remote ARepos till end + newfound := False; + for k := j + 1 to jmax - 1 do + begin + if m.name = AReposUp[k].name then // j to k-1 is new + begin + newfound := True; + Break; + end; + end; + if newfound then // add new + begin + for k := j to k - 1 do + begin + m := AReposUp[k].Clone; + m.flag := fNew; + ARepos.Add(m); + Inc(inew); + end; + j := k + 1; + end + else // current is marked to delete + begin + m.flag := fDelete; + Inc(iupdate); + Inc(i); + end; + end; + end + else + if m = nil then // new found + begin + m := u.Clone; + m.flag := fNew; + ARepos.Add(m); + Inc(inew); + Inc(j); + end + else + begin // current is marked to delete + m.flag := fDelete; + Inc(iupdate); + Inc(i); + end; + end; + if inew <> 0 then + ARepos.Items.Sort; + Result := inew + iupdate <> 0; +end; + +procedure TCheckUpdateThread.Download; +var + i, imax: Integer; + m: TLuaModuleRepo; + f: String; +begin + Synchronize(@SyncStartDownload); + + FStatusList.Clear; + i := 0; + imax := FRepos.Items.Count; + while i < imax do + begin + m := FRepos[i]; + if m.flag = fDelete then + begin + f := LUA_WEBSITEMODULE_FOLDER + m.name; + if FileExists(f) then + DeleteFile(f); + AddStatus(Format(RS_StatusDelete, [m.name])); + m.flag := fDeleted; + Inc(i); + end + else + if not (m.flag in [fNew, fUpdate, fFailedDownload]) then + Inc(i) + else + begin + while FThreads.Count >= OptionMaxThreads do + Sleep(SOCKHEARTBEATRATE); + if Terminated then + Break; + TDownloadThread.Create(Self, FRepos[i]); + Inc(i); + end; + end; + + while FThreads.Count <> 0 do + begin + if Terminated then + Break; + Sleep(SOCKHEARTBEATRATE); + end; + + EnterCriticalsection(FThreadsCS); + try + for i := 0 to FThreads.Count - 1 do + begin + TDownloadThread(FThreads[i]).Terminate; + end; + finally + LeaveCriticalsection(FThreadsCS); + end; + + while FThreads.Count <> 0 do + Sleep(SOCKHEARTBEATRATE); + Synchronize(@SyncFinishDownload); +end; + +procedure TCheckUpdateThread.Execute; +var + foundupdate: Boolean; + i, imax: Integer; + m: TLuaModuleRepo; + trepos: TLuaModulesRepos; +begin + Synchronize(@SyncStartChecking); + FReposUp := TLuaModulesRepos.Create; + if FHTTP.GET(MODULES_URL) then + begin + FReposUp.LoadFromRemote(FHTTP); + if FHTTP.GET(MODULES_URL2) then + FReposUp.LoadFromRemoteHTML(FHTTP); + end; + + if not Terminated then + begin + // check + FRepos := FOwner.Repos.Clone; + foundupdate := SyncRepos(FRepos, FReposUp); + + // look for missing local files and previously failed download + for i := 0 to FRepos.Items.Count - 1 do + begin + m := FRepos[i]; + if m.flag = fFailedDownload then + foundupdate := True + else + if (not (m.flag in [fNew, fUpdate])) and + (not FileExists(LUA_WEBSITEMODULE_FOLDER + m.name)) then + begin + m.flag := fFailedDownload; + foundupdate := True; + end; + case m.flag of + fNew: FStatusList.Add(Format(RS_StatusNew, [m.name])); + fUpdate: FStatusList.Add(Format(RS_StatusUpdate, [m.name])); + fDelete: FStatusList.Add(Format(RS_StatusDelete, [m.name])); + fFailedDownload: FStatusList.Add(Format(RS_StatusFailed, [m.name])); + end; + end; + + Synchronize(@SyncFinishChecking); + + if foundupdate and (not Terminated) then + begin + if OptionModulesUpdaterShowUpdateWarning then + Synchronize(@SyncAskToProceed) + else + begin + FProceed := True; + Sleep(1500); // delay to show the update status + end; + if FProceed then + Download; + end; + + // cleanup + i := 0; + imax := FRepos.Items.Count; + while i < imax do + begin + m := FRepos[i]; + if m.flag = fDeleted then + begin + FRepos.Items.Delete(i); + Dec(imax); + end + else + begin + if m.flag in [fNew, fUpdate, fFailedDownload] then + m.flag := fFailedDownload + else + m.flag := fNone; + Inc(i); + end; + end; + trepos := FMainRepos; + FMainRepos := FRepos; + FRepos := trepos; + end; + + if not Terminated then + Sleep(1000); + Synchronize(@SyncFinal); + + if not Terminated then + if (FDownloadedCount <> 0) and (OptionModulesUpdaterAutoRestart or + (MessageDlg(RS_ModulesUpdatedTitle, + Format(RS_ModulesUpdatedRestart, [Trim(FStatusList.Text)]), + mtConfirmation, mbYesNo, 0) = mrYes)) then + RestartFMD; +end; + +constructor TCheckUpdateThread.Create(const AOwner: TLuaModulesUpdaterForm); +begin + inherited Create(False); + InitCriticalSection(FThreadsCS); + FOwner := AOwner; + FHTTP := THTTPSendThread.Create(Self); + FThreads := TFPList.Create; + FDownloadedCount := 0; + FStatusList := TStringList.Create; +end; + +destructor TCheckUpdateThread.Destroy; +begin + if Assigned(FRepos) then + FRepos.Free; + if Assigned(FReposUp) then + FReposUp.Free; + FStatusList.Free; + FThreads.Free; + FHTTP.Free; + DoneCriticalsection(FThreadsCS); + inherited Destroy; +end; + +procedure TCheckUpdateThread.AddStatus(const S: String); +begin + EnterCriticalsection(FThreadsCS); + try + FStatusList.Add(S); + finally + LeaveCriticalsection(FThreadsCS); + end; +end; + +{$R *.lfm} + +{ TLuaModulesUpdaterForm } + +procedure TLuaModulesUpdaterForm.btCheckUpdateClick(Sender: TObject); +begin + if ThreadCheck = nil then + ThreadCheck := TCheckUpdateThread.Create(Self); +end; + +procedure TLuaModulesUpdaterForm.FormCreate(Sender: TObject); +begin + AddVT(vtLuaModulesRepos); + InitCriticalSection(FListCS); + Repos := TLuaModulesRepos.Create; + btCheckUpdate.Caption := RS_CheckUpdate; + btCheckUpdateTerminate.Visible := False; + vtLuaModulesRepos.NodeDataSize := SizeOf(TLuaModuleRepo); + LoadLocalRepos; +end; + +procedure TLuaModulesUpdaterForm.FormDestroy(Sender: TObject); +begin + if ThreadCheck <> nil then + begin + ThreadCheck.Terminate; + ThreadCheck.WaitFor; + end; + Repos.Free; + DoneCriticalsection(FListCS); + RemoveVT(vtLuaModulesRepos); +end; + +procedure TLuaModulesUpdaterForm.btCheckUpdateTerminateClick(Sender: TObject); +begin + ThreadCheck.Terminate; +end; + +procedure TLuaModulesUpdaterForm.tmRepaintListTimer(Sender: TObject); +begin + if FListDirty then + begin + vtLuaModulesRepos.Repaint; + EnterCriticalsection(FListCS); + try + FListDirty := False; + finally + LeaveCriticalsection(FListCS); + end; + end; +end; + +procedure TLuaModulesUpdaterForm.vtLuaModulesReposCompareNodes(Sender: TBaseVirtualTree; + Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); +var + m1, m2: TLuaModuleRepo; +begin + m1 := PLuaModuleRepo(Sender.GetNodeData(Node1))^; + m2 := PLuaModuleRepo(Sender.GetNodeData(Node2))^; + case Column of + 0: Result := AnsiCompareStr(m1.name, m2.name); + 1: + begin + if m1.last_modified > m2.last_modified then + Result := 1 + else + Result := -1; + end; + 2: Result := AnsiCompareStr(m1.last_message, m2.last_message); + end; +end; + +procedure TLuaModulesUpdaterForm.vtLuaModulesReposGetHint(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; + var HintText: String); +begin + with PLuaModuleRepo(Sender.GetNodeData(Node))^ do + begin + case Column of + 0: HintText := name; + 1: HintText := DateTimeToStr(last_modified); + 2: HintText := last_message; + end; + end; +end; + +procedure TLuaModulesUpdaterForm.vtLuaModulesReposGetImageIndex(Sender: TBaseVirtualTree; + Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: Integer); +begin + if Column <> 0 then + Exit; + ImageIndex := Integer(PLuaModuleRepo(Sender.GetNodeData(Node))^.flag) - 1; +end; + +procedure TLuaModulesUpdaterForm.vtLuaModulesReposGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); +begin + with PLuaModuleRepo(Sender.GetNodeData(Node))^ do + begin + case Column of + 0: CellText := name; + 1: CellText := DateTimeToStr(last_modified); + 2: CellText := last_message; + end; + end; +end; + +{$if VTMajorVersion < 5} +procedure TLuaModulesUpdaterForm.vtLuaModulesReposHeaderClick(Sender: TVTHeader; + Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +{$else} +procedure TLuaModulesUpdaterForm.vtLuaModulesReposHeaderClick(Sender: TVTHeader; + HitInfo: TVTHeaderHitInfo); +var + Column: TColumnIndex; + Button: TMouseButton; +{$endif} +begin + {$if VTMajorVersion >= 5} + Column := HitInfo.Column; + Button := HitInfo.Button; + {$endif} + if Sender.SortColumn <> Column then + Sender.SortColumn := Column + else + if Sender.SortDirection = sdAscending then + Sender.SortDirection := sdDescending + else + Sender.SortDirection := sdAscending; + SortList; +end; + +procedure TLuaModulesUpdaterForm.ListDirty; +begin + if TryEnterCriticalsection(FListCS) <> 0 then + try + FListDirty := True; + finally + LeaveCriticalsection(FListCS); + end; +end; + +procedure TLuaModulesUpdaterForm.LoadLocalRepos; +begin + Repos.LoadFromFile(LUA_WEBSITEMODULE_FILE); + ReinitList(False); +end; + +procedure TLuaModulesUpdaterForm.ReinitList(const ASort: Boolean); +var + i: Integer; +begin + vtLuaModulesRepos.Clear; + for i := 0 to Repos.Items.Count - 1 do + vtLuaModulesRepos.AddChild(nil, Repos[i]); + if ASort then + SortList; +end; + +procedure TLuaModulesUpdaterForm.SortList; +begin + with vtLuaModulesRepos do + Sort(nil, Header.SortColumn, Header.SortDirection, False); +end; + +end. diff --git a/mangadownloader/forms/frmMain.lfm b/mangadownloader/forms/frmMain.lfm index 7e4f697b5..2eeb0e2a7 100644 --- a/mangadownloader/forms/frmMain.lfm +++ b/mangadownloader/forms/frmMain.lfm @@ -1,5637 +1,7692 @@ -object MainForm: TMainForm - Left = 273 - Height = 575 - Top = 96 - Width = 819 - Align = alBottom - Caption = 'Free Manga Downloader' - ClientHeight = 575 - ClientWidth = 819 - OnClose = FormClose - OnCreate = FormCreate - OnDestroy = FormDestroy - OnShow = FormShow - OnWindowStateChange = FormWindowStateChange - LCLVersion = '1.5' - object sbUpdateList: TStatusBar - Left = 0 - Height = 30 - Top = 545 - Width = 819 - AutoSize = False - Panels = < - item - Width = 50 - end> - ParentShowHint = False - SimplePanel = False - SizeGrip = False - ShowHint = True - Visible = False - OnDrawPanel = sbUpdateListDrawPanel - end - object pcMain: TPageControl - Left = 201 - Height = 508 - Top = 11 - Width = 614 - ActivePage = tsDownload - Align = alClient - BorderSpacing.Top = 3 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 3 - ParentFont = False - TabIndex = 0 - TabOrder = 0 - OnChange = pcMainChange - object tsDownload: TTabSheet - Caption = 'Downloads' - ClientHeight = 480 - ClientWidth = 606 - object vtDownload: TVirtualStringTree - Left = 2 - Height = 445 - Top = 32 - Width = 600 - Align = alClient - BorderSpacing.Left = 2 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 3 - DefaultText = 'Node' - DragOperations = [doMove] - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Position = 0 - Text = 'Manga' - Width = 100 - end - item - Position = 1 - Text = 'Status' - Width = 200 - end - item - Position = 2 - Text = 'Progress' - Width = 55 - end - item - Position = 3 - Text = 'Transfer rate' - end - item - Position = 4 - Text = 'Website' - Width = 65 - end - item - Position = 5 - Text = 'Save to' - Width = 150 - end - item - Position = 6 - Text = 'Added' - Width = 80 - end> - Header.DefaultHeight = 17 - Header.Height = 25 - Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible] - HintMode = hmHintAndDefault - Images = IconDL - IncrementalSearch = isVisibleOnly - Margin = 2 - ParentFont = False - ParentShowHint = False - PopupMenu = pmDownload - ShowHint = True - TabOrder = 0 - TextMargin = 0 - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking] - TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag, toEditOnClick] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnAfterCellPaint = vtDownloadAfterCellPaint - OnColumnDblClick = vtDownloadColumnDblClick - OnDragAllowed = vtDownloadDragAllowed - OnDragOver = vtDownloadDragOver - OnDragDrop = vtDownloadDragDrop - OnFreeNode = vtDownloadFreeNode - OnGetText = vtDownloadGetText - OnGetImageIndex = vtDownloadGetImageIndex - OnGetHint = vtDownloadGetHint - OnHeaderClick = vtDownloadHeaderClick - OnInitNode = vtDownloadInitNode - OnKeyDown = vtDownloadKeyDown - OnKeyUp = vtDownloadKeyUp - end - object pnDownloadToolbar: TPanel - Left = 2 - Height = 28 - Top = 4 - Width = 600 - Align = alTop - BorderSpacing.Left = 2 - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 600 - TabOrder = 1 - object TransferRateGraph: TChart - Left = 339 - Height = 26 - Top = 0 - Width = 261 - AllowZoom = False - AxisList = < - item - Minors = <> - Title.LabelFont.Orientation = 900 - end - item - Alignment = calBottom - Minors = <> - end> - AxisVisible = False - BackColor = clDefault - Extent.UseXMin = True - Extent.UseYMin = True - Extent.XMin = 1 - Extent.YMin = 1 - Foot.Brush.Color = clBtnFace - Foot.Font.Color = clBlue - Frame.Color = clGreen - Frame.Visible = False - Legend.Alignment = laCenterRight - Legend.BackgroundBrush.Style = bsClear - Legend.Frame.Visible = False - Legend.MarginX = 0 - Legend.MarginY = 0 - Legend.Spacing = 0 - Legend.SymbolWidth = 0 - Legend.UseSidebar = False - Legend.Visible = True - Margins.Left = 0 - Margins.Top = 0 - Margins.Right = 0 - Margins.Bottom = 0 - MarginsExternal.Left = 0 - MarginsExternal.Top = 0 - MarginsExternal.Right = 0 - MarginsExternal.Bottom = 0 - Title.Brush.Color = clBtnFace - Title.Font.Color = clBlue - Title.Text.Strings = ( - 'TAChart' - ) - Align = alClient - BorderSpacing.Bottom = 2 - Visible = False - object TransferRateGraphArea: TAreaSeries - Transparency = 125 - AreaBrush.Color = 8453888 - AreaContourPen.Color = 5481984 - AreaLinesPen.Style = psClear - Source = TransferRateGraphList - end - end - object pnDownloadToolbarLeft: TPanel - Left = 0 - Height = 28 - Top = 0 - Width = 339 - Align = alLeft - AutoSize = True - BevelOuter = bvNone - ClientHeight = 28 - ClientWidth = 339 - TabOrder = 1 - object ToolBarDownload: TToolBar - Left = 0 - Height = 25 - Top = 0 - Width = 339 - AutoSize = True - ButtonHeight = 25 - EdgeBorders = [] - Images = IconList - List = True - ParentFont = False - ShowCaptions = True - TabOrder = 0 - TabStop = True - Transparent = True - object tbDownloadResumeAll: TToolButton - Left = 1 - Top = 0 - AutoSize = True - Caption = 'Resume All' - ImageIndex = 12 - OnClick = tbDownloadResumeAllClick - end - object tbDownloadStopAll: TToolButton - Left = 86 - Top = 0 - AutoSize = True - Caption = 'Stop All' - ImageIndex = 7 - OnClick = tbDownloadStopAllClick - end - object ToolButton1: TToolButton - Left = 153 - Height = 25 - Top = 0 - Width = 23 - Style = tbsDivider - end - object tbDownloadDeleteCompleted: TToolButton - Left = 176 - Top = 0 - AutoSize = True - Caption = 'Delete all completed tasks' - ImageIndex = 9 - OnClick = tbDownloadDeleteCompletedClick - end - end - end - end - end - object tsInformation: TTabSheet - Caption = 'Manga Info' - ClientHeight = 480 - ClientWidth = 606 - object sbInformation: TScrollBox - Left = 0 - Height = 480 - Top = 0 - Width = 606 - HorzScrollBar.Page = 214 - VertScrollBar.Page = 317 - Align = alClient - BorderStyle = bsNone - ClientHeight = 480 - ClientWidth = 606 - TabOrder = 0 - object pnInfomation: TPanel - Left = 0 - Height = 262 - Top = 0 - Width = 606 - Align = alTop - BevelOuter = bvNone - ClientHeight = 262 - ClientWidth = 606 - ParentFont = False - TabOrder = 0 - object rmInformation: TRichMemo - Left = 165 - Height = 222 - Top = 38 - Width = 436 - Anchors = [akTop, akLeft, akRight, akBottom] - Color = clWhite - HideSelection = False - ParentFont = False - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 1 - ZoomFactor = 1 - end - object edURL: TEdit - Left = 4 - Height = 23 - Top = 6 - Width = 554 - Anchors = [akTop, akLeft, akRight] - OnKeyPress = edURLKeyPress - PopupMenu = pmEditURL - TabOrder = 0 - TextHint = 'Input URL here' - end - object btDonate: TImage - Cursor = crHandPoint - Left = 2 - Height = 21 - Top = 14 - Width = 75 - Anchors = [akTop, akRight] - OnClick = btDonateClick - Stretch = True - Visible = False - end - object btURL: TSpeedButton - Left = 561 - Height = 23 - Top = 6 - Width = 40 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 0001000000070000000E000000150000001A0000001A0000001A0000001A0000 - 001A0000001A000000160000000F0000000800000002FFFFFF00FFFFFF000000 - 00020000000E0000001C0000002A000000330000003300000033733A02A66332 - 0274000000330000002B0000001D0000000F00000003FFFFFF00FFFFFF000000 - 00000000000000000000000000000000000000000000281502009D5206CC9D52 - 06CC763E055C29160300000000000000000000000000FFFFFF00FFFFFF005933 - 0B0058320A0058320A0058320A0058320A0058320A00A3580B00A3580BCCFFBA - 18FFA3580BCCA4590C5C7F470C002C19050000000000FFFFFF00FFFFFF00B166 - 1600AF641400AF641400AF641400AF641400AF641400AE631300AA5F10CCFFB9 - 12FFFFBC1EFFAA5F10CCAB60115CB1661600B96E1C00FFFFFF00FFFFFF00B267 - 1799B16616CCB16616CCB16616CCB16616CCB16616CCB16616CCB16616CCF7B5 - 25FFF5AB0EFFF7BA32FFB16616CCB267175CB96E1C00FFFFFF00FFFFFF00B96E - 1CCCF7CD81FFF4C276FFF3C071FFEEB85BFFE8B049FFE7AE45FFE6AD43FFE3A5 - 35FFE19E29FFE19E29FFEBB54DFFB96E1CCCBA6F1D5CFFFFFF00FFFFFF00C277 - 22CCF5C77BFFEEB266FFEEB266FFEEB266FFEAAE60FFE1A453FFD89B49FFD396 - 44FFD09341FFD09341FFD39644FFE8B868FFC27722CCFFFFFF00FFFFFF00CA7F - 28CCFAD589FFF6C97DFFF6C87CFFF5C77BFFF5C77BFFF5C67AFFF5C579FFF2BC - 70FFEFB468FFEFB468FFF8CF83FFCA7F28CCC97E275CFFFFFF00FFFFFF00D186 - 2D99D2872ECCD2872ECCD2872ECCD2872ECCD2872ECCD2872ECCD2872ECCF8CD - 81FFF4BE72FFFCD98DFFD2872ECCD1862D5CCA7F2800FFFFFF00FFFFFF00D287 - 2E00D3882F00D3882F00D3882F00D3882F00D3882F00D58A3100D98E33CCFCD5 - 89FFFEE094FFD98E33CCD88D335CD2872E00CA7F2800FFFFFF00FFFFFF00D287 - 2E00D3882F00D3882F00D3882F00D3882F00D78C3200E0953800E09538CCFFE4 - 98FFE09538CCDF94385CD98E3300D2872E00CA7F2800FFFFFF00FFFFFF00D287 - 2E00D3882F00D3882F00D3882F00D88D3300E59A3C00E59A3C00E59A3CCCE59A - 3CCCE59A3C5CE0953800D98E3300D2872E00CA7F2800FFFFFF00FFFFFF00D287 - 2E00D3882F00D3882F00D3882F00E89D3F00E89D3F00E89D3F00E99E4099E99E - 405CE59A3C00E0953800D98E3300D2872E00CA7F2800FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btURLClick - end - object pnThumbContainer: TPanel - Left = 4 - Height = 216 - Top = 38 - Width = 154 - BevelOuter = bvNone - BorderStyle = bsSingle - ClientHeight = 212 - ClientWidth = 150 - Color = clWhite - ParentColor = False - TabOrder = 2 - object imCover: TImage - Left = 0 - Height = 212 - Top = 0 - Width = 150 - AntialiasingMode = amOn - Align = alClient - Center = True - Proportional = True - Stretch = True - end - object pbWait: TPaintBox - Left = 0 - Height = 212 - Top = 0 - Width = 150 - Align = alClient - end - end - end - object spInfos: TSplitter - Cursor = crVSplit - Left = 0 - Height = 5 - Top = 262 - Width = 606 - Align = alTop - ResizeAnchor = akTop - end - object pnChapterList: TPanel - Left = 0 - Height = 213 - Top = 267 - Width = 606 - Align = alClient - BevelOuter = bvNone - ClientHeight = 213 - ClientWidth = 606 - TabOrder = 2 - object btDownload: TBitBtn - Left = 387 - Height = 30 - Top = 145 - Width = 101 - Anchors = [akRight, akBottom] - Caption = 'Download' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C0D0D0D581212128512121285121212851212128512121285121212851212 - 12851212128512121285121212850D0D0D580000002C00000012000000090000 - 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 - C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B - 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 - 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 - 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD - DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D - 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 - B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F - 4F005151510D5454545A54545467545454675454546754545467545454675454 - 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F - 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 - 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F - 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 - 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F - 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 - 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F - 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 - 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F - 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD - 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 - 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 - 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 - 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E - 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 - 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 - 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E - 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E - 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 - } - OnClick = btDownloadClick - TabOrder = 1 - end - object cbAddAsStopped: TCheckBox - Left = 4 - Height = 19 - Top = 182 - Width = 214 - Anchors = [akLeft, akBottom] - Caption = 'Add to download list as stopped task' - OnChange = cbAddAsStoppedChange - ParentFont = False - TabOrder = 3 - end - object clbChapterList: TVirtualStringTree - Left = 4 - Height = 125 - Top = 0 - Width = 563 - Anchors = [akTop, akLeft, akRight, akBottom] - Colors.UnfocusedSelectionColor = clHighlight - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = <> - Header.DefaultHeight = 17 - Header.MainColumn = -1 - IncrementalSearch = isVisibleOnly - Margin = 2 - ParentFont = False - PopupMenu = pmChapterList - TabOrder = 0 - TextMargin = 0 - TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnBeforeCellPaint = clbChapterListBeforeCellPaint - OnFreeNode = clbChapterListFreeNode - OnGetText = clbChapterListGetText - OnGetNodeDataSize = clbChapterListGetNodeDataSize - OnInitNode = clbChapterListInitNode - end - object btReadOnline: TBitBtn - Left = 493 - Height = 30 - Top = 145 - Width = 108 - Anchors = [akRight, akBottom] - Caption = 'Read online' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C0A0A0A660C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C - 0C770C0C0C770C0C0C776C3A07C94E2A06970000002C00000012000000090000 - 00161F1F1F74EBEBEBFFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6 - E6FFE6E6E6FFE6E6E6FFB47839FF99560FE3723F0A6E00000009000000002A2A - 2A0036363671E8E8E8FFB4B4B4FFBDBDBDFFC5C5C5FFBDBDBDFFBF9261FFBD81 - 40FFBD8140FFBD8140FFBF8342FFFFC538FFB56A18CCB76C195C343434004545 - 45004545456FEAEAEAFFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFC68A46FFFFE3 - 92FFFFD56AFFFFD15DFFFFD15DFFFFD15DFFFFD873FFC37923CC4B4B4B004B4B - 4B004B4B4B6EECECECFF8E8E8EFFA5A5A5FFA5A5A5FF8E8E8EFFD2A56FFFD599 - 53FFCF934CFFCD914AFFD79B55FFFFE597FFD2872ECCD0852D5C515151005151 - 51005151516DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 - E8FFD5D5D5FFD5D5D5FFE3A75CFFD18E3AE2DE93375CD2872E00575757005757 - 57005757576CF0F0F0FFBFBFBFFFC7C7C7FFD0D0D0FFC7C7C7FFD8D8D8FFEAEA - EAFFBFBFBFFFC7C7C7FFEABD85FF9E794BA29C764800957043005D5D5D005D5D - 5D005D5D5D6BF2F2F2FFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFEDED - EDFFDBDBDBFFDBDBDBFFF2F2F2FF5D5D5D6B5D5D5D005D5D5D00626262006262 - 62006262626BF5F5F5FF919191FFC4C4C4FFAAAAAAFFAAAAAAFF919191FFF1F1 - F1FFBBBBBBFFCCCCCCFFF5F5F5FF6262626B6262620062626200676767006767 - 67006767676AF7F7F7FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4 - F4FFF4F4F4FFF4F4F4FFF7F7F7FF6767676A67676700676767006C6C6C006C6C - 6C006C6C6C69F9F9F9FF03599DFF0961A5FF1A77BBFF2587CBFF1976BAFF2587 - CBFF1570B4FF055CA0FFF9F9F9FF6C6C6C696C6C6C006C6C6C00717171007171 - 710071717168FBFBFBFF03599DFFC2D8E9FF89B9DBFF90C3E5FFB6CFE0FF2587 - CBFF1570B4FF055CA0FFFBFBFBFF717171687171710071717100757575007575 - 750075757568FDFDFDFF03599DFF126CB0FF2484C8FF3096DAFF3196DAFF2587 - CBFF1570B4FF055CA0FFFDFDFDFF757575687575750075757500797979007979 - 790079797967FEFEFEFF02579BFF0961A5FF126DB1FF1876BAFF1976BAFF136E - B2FF0B63A7FF03599DFFFEFEFEFF7979796779797900797979007D7D7D007D7D - 7D007D7D7D67FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFF7D7D7D677D7D7D007D7D7D007F7F7F007F7F - 7F008080804D8080806680808066808080668080806680808066808080668080 - 80668080806680808066808080668080804D7F7F7F007F7F7F00 - } - OnClick = btReadOnlineClick - TabOrder = 2 - end - object btBrowse: TSpeedButton - Left = 360 - Height = 23 - Top = 148 - Width = 23 - Anchors = [akRight, akBottom] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF - F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF - EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 - F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 - F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB - F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 - F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 - F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 - FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 - FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED - FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC - DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 - FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 - FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 - CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 - F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 - CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 - CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btBrowseClick - end - object btChecks: TSpeedButton - Left = 571 - Height = 30 - Top = 0 - Width = 30 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000900000012010E - 0033024A0083025D00BC025D00CC025D00CC025D00CC025D00CC025D00CC025D - 00CC025D00CC025D00CC025D00BC024A0083010E003300000012021D0000066D - 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9 - 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073021D00000A7D00000A7D - 00BA25CA15F922D111FF22D111FF22D111FF22B611FF22D111FF22D111FF22D1 - 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BA0A7D00000C8400000C84 - 00CC2BCC1AFF22C811FF22C811FF22B211FFE6E6E6FF22B211FF22C811FF22C8 - 11FF22C811FF22C811FF22C811FF22C811FF0C8400CC0C8400000D8900000D89 - 00CC31C620FF22BE11FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE - 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CC0D8900000E8D00000E8D - 00CC41C330FF23AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 - 11FF22B411FF22B411FF22B411FF25B514FF0E8D00CC0E8D00000F9200000F92 - 00CC52C941FFA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 - E6FF22A311FF22AA11FF22AA11FF28AF17FF0F9200CC0F920000109600001096 - 00CC55CC44FF3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 - E2FFE6E6E6FF229E11FF22A111FF2CAA1BFF109600CC10960000119A0000119A - 00CC5AD149FF47BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 - E2FFE3E3E3FFE7E7E7FF269E15FF39B128FF119A00CC119A0000129E0000129E - 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB - 33FFFFFFFFFFA7E29EFF4EC53DFF58CF47FF129E00CC129E000013A2000013A2 - 00CC67DE56FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE - 46FF4AC139FF51C840FF57CE46FF60D74FFF13A200CC13A2000014A5000014A5 - 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD6 - 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BA14A5000014A8000014A8 - 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4 - 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A8007314A8000014A8000015A9 - 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA - 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000C14A80000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btChecksClick - end - object btAddToFavorites: TBitBtn - Left = 387 - Height = 30 - Top = 179 - Width = 214 - Anchors = [akRight, akBottom] - Caption = 'Add to favorites' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000050000 - 001E0000003200009CC9000054630000002E0000002B00000026000000220000 - 001D00000018054F00A1056800CF0550009D0000000500000002000000030000 - 000F000000190000A8C50000A8C500006D580000001600000013000000110000 - 000F0000000C0C8200CE2BDF1AFF0C8200CD000000030000000101018F000101 - 5F0001018C000000B6BF6969FFFF0000B6BF0000B84301016000074700000E8D - 00990E8C00CC0E8C00CC3DE22CFF0E8C00CC0E8C00CC0E8D00990101BFBB0101 - BFBB0101BFBB0101BFBB6262F8FF6C6CFFFF0101BFBB0101C042094B61001095 - 00CC52E741FF52E741FF52E741FF52E741FF52E741FF109500CC0101C3410101 - C3B96969FFFF6262F8FF5F5FF5FF5C5CF1FF6E6EFFFF0101C3B90101C441129C - 0099129D00CC129D00CC66EB55FF129D00CC129D00CC129C00990101C3000101 - C7410101C7B86C6CFFFF5C5CF1FF5D5DF2FF5F5FF3FF7171FFFF0101C7B80629 - 96410F79330014A400CC75EE64FF14A400CC13A10000129D00000101C3000101 - C7000101CB400101CBB66E6EFFFF5F5FF3FF6060F4FF6262F4FF7575FFFF0101 - CBB60101CC4015A9009915A900CC15A9009914A80000129D00000101C3000101 - C7000101CB000101CE400101CEB57171FFFF6262F4FF6464F5FF6565F6FF7878 - FFFF0101CEB5062C9B3F1080350015A9000014A80000129D00000101C3000101 - C7000101CB000101CE000101D23F0101D2B37575FFFF6565F6FF6767F7FF6868 - F8FF7B7BFFFF0101D2B30101D33F0101D5000101D9000101DC000101C3000101 - C7000101CB000101CE000101D2000101D53F0101D5B27878FFFF6868F8FF6A6A - F9FF6C6CF9FF7E7EFFFF0101D5B20101D63E0101D9000101DC000101C3000101 - C7000101CB000101CE000101D2000101D5000101D93E0101D9B17B7BFFFF6C6C - F9FF6D6DFAFF6F6FFBFF8181FFFF0101D9B10101D93E0101DC000101C3000101 - C7000101CB000101CE000101D2000101D5000101D9000101DC3E0101DCAF7E7E - FFFF6F6FFBFF7070FCFF7171FCFF8484FFFF0101DCAF0101DC3E000000000101 - 64000101CB000101CE000101D2000101D5000101D9000101DC000101DE3E0101 - DEAE8181FFFF7171FCFF7373FDFF7474FDFF8686FFFF0101DEAE000000000000 - 0000000000000101B4000101D2000101D5000101D9000101DC000101DE000101 - E13D0101E1AD8484FFFF7474FDFF8686FFFF0101E1AD0101E13D000000000000 - 0000000000000000990000002B0001016B000101D9000101DC000101DE000101 - E1000101E33C0101E3AC8686FFFF0101E3AC0101E33C0101E100000000000000 - 0000000000000000990000002B00000000000000000001016E000101DE000101 - E1000101E3000101E53C0101E5AB0101E53C0101E3000101E100 - } - OnClick = btAddToFavoritesClick - TabOrder = 4 - end - object edSaveTo: TEdit - Left = 4 - Height = 23 - Top = 148 - Width = 353 - Anchors = [akLeft, akRight, akBottom] - ParentFont = False - TabOrder = 5 - TextHint = 'Save to' - end - object lbSaveTo: TLabel - Left = 4 - Height = 15 - Top = 130 - Width = 41 - Anchors = [akLeft, akBottom] - Caption = 'Save to:' - ParentColor = False - ParentFont = False - end - end - end - end - object tsFilter: TTabSheet - Caption = 'Filter' - ClientHeight = 480 - ClientWidth = 606 - object sbFilter: TScrollBox - Left = 0 - Height = 480 - Top = 0 - Width = 606 - HorzScrollBar.Page = 568 - VertScrollBar.Page = 424 - Align = alClient - BorderStyle = bsNone - ClientHeight = 480 - ClientWidth = 606 - TabOrder = 0 - object pnGenres: TPanel - Left = 24 - Height = 180 - Top = 10 - Width = 582 - Align = alTop - AutoSize = True - BorderSpacing.Left = 24 - BorderSpacing.Top = 10 - BevelOuter = bvNone - ChildSizing.HorizontalSpacing = 10 - ChildSizing.VerticalSpacing = 4 - ChildSizing.Layout = cclTopToBottomThenLeftToRight - ChildSizing.ControlsPerLine = 8 - ClientHeight = 180 - ClientWidth = 582 - TabOrder = 0 - object ckFilterAction: TCheckBox - Left = 0 - Height = 19 - Hint = 'A work typically depicting fighting, violence, chaos, and fast paced motion.' - Top = 0 - Width = 75 - AllowGrayed = True - Caption = 'Action' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 0 - end - object ckFilterAdult: TCheckBox - Left = 0 - Height = 19 - Hint = 'Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity.' - Top = 23 - Width = 75 - AllowGrayed = True - Caption = 'Adult' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 1 - end - object ckFilterAdventure: TCheckBox - Left = 0 - Height = 19 - Hint = 'If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it''s up to your personal prejudice on this case.' - Top = 46 - Width = 75 - AllowGrayed = True - Caption = 'Adventure' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 2 - end - object ckFilterComedy: TCheckBox - Left = 0 - Height = 19 - Hint = 'A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict.' - Top = 69 - Width = 75 - AllowGrayed = True - Caption = 'Comedy' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 3 - end - object ckFilterDoujinshi: TCheckBox - Left = 0 - Height = 19 - Hint = 'Fan based work inpspired by official manga/anime.' - Top = 92 - Width = 75 - AllowGrayed = True - Caption = 'Doujinshi' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 4 - end - object ckFilterDrama: TCheckBox - Left = 0 - Height = 19 - Hint = 'A work meant to bring on an emotional response, such as instilling sadness or tension.' - Top = 115 - Width = 75 - AllowGrayed = True - Caption = 'Drama' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 5 - end - object ckFilterEchi: TCheckBox - Left = 0 - Height = 19 - Hint = 'Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans.' - Top = 138 - Width = 75 - AllowGrayed = True - Caption = 'Ecchi' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 6 - end - object ckFilterFantasy: TCheckBox - Left = 0 - Height = 19 - Hint = 'Anything that involves, but not limited to, magic, dream world, and fairy tales.' - Top = 161 - Width = 75 - AllowGrayed = True - Caption = 'Fantasy' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 7 - end - object ckFilterGenderBender: TCheckBox - Left = 85 - Height = 19 - Hint = 'Girls dressing up as guys, guys dressing up as girls.'#13#10'Guys turning into girls, girls turning into guys.' - Top = 0 - Width = 98 - AllowGrayed = True - Caption = 'Gender Bender' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 8 - end - object ckFilterHarem: TCheckBox - Left = 85 - Height = 19 - Hint = 'A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed.' - Top = 23 - Width = 98 - AllowGrayed = True - Caption = 'Harem' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 9 - end - object ckFilterHentai: TCheckBox - Left = 85 - Height = 19 - Hint = 'Hentai' - Top = 46 - Width = 98 - AllowGrayed = True - Caption = 'Hentai' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 10 - end - object ckFilterHistorical: TCheckBox - Left = 85 - Height = 19 - Hint = 'Having to do with old or ancient times.' - Top = 69 - Width = 98 - AllowGrayed = True - Caption = 'Historical' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 11 - end - object ckFilterHorror: TCheckBox - Left = 85 - Height = 19 - Hint = 'A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking.' - Top = 92 - Width = 98 - AllowGrayed = True - Caption = 'Horror' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 12 - end - object ckFilterJosei: TCheckBox - Left = 85 - Height = 19 - Hint = 'Literally "Woman". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature.' - Top = 115 - Width = 98 - AllowGrayed = True - Caption = 'Josei' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 13 - end - object ckFilterLolicon: TCheckBox - Left = 85 - Height = 19 - Hint = 'Representing a sexual attraction to young or under-age girls.' - Top = 138 - Width = 98 - AllowGrayed = True - Caption = 'Lolicon' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 14 - end - object ckFilterMartialArts: TCheckBox - Left = 85 - Height = 19 - Hint = 'As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth.' - Top = 161 - Width = 98 - AllowGrayed = True - Caption = 'Martial Arts' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 15 - end - object ckFilterMature: TCheckBox - Left = 193 - Height = 19 - Hint = 'Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language.' - Top = 0 - Width = 93 - AllowGrayed = True - Caption = 'Mature' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 16 - end - object ckFilterMecha: TCheckBox - Left = 193 - Height = 19 - Hint = 'A work involving and usually concentrating on all types of large robotic machines.' - Top = 23 - Width = 93 - AllowGrayed = True - Caption = 'Mecha' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 17 - end - object ckFilterMusical: TCheckBox - Left = 193 - Height = 19 - Hint = 'Musical' - Top = 46 - Width = 93 - AllowGrayed = True - Caption = 'Musical' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 18 - end - object ckFilterMystery: TCheckBox - Left = 193 - Height = 19 - Hint = 'Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it.' - Top = 69 - Width = 93 - AllowGrayed = True - Caption = 'Mystery' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 19 - end - object ckFilterPsychological: TCheckBox - Left = 193 - Height = 19 - Hint = 'Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology.' - Top = 92 - Width = 93 - AllowGrayed = True - Caption = 'Psychological' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 20 - end - object ckFilterRomance: TCheckBox - Left = 193 - Height = 19 - Hint = 'Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is.' - Top = 115 - Width = 93 - AllowGrayed = True - Caption = 'Romance' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 21 - end - object ckFilterSchoolLife: TCheckBox - Left = 193 - Height = 19 - Hint = 'Having a major setting of the story deal with some type of school.' - Top = 138 - Width = 93 - AllowGrayed = True - Caption = 'School Life' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 22 - end - object ckFilterSciFi: TCheckBox - Left = 193 - Height = 19 - Hint = 'Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world.' - Top = 161 - Width = 93 - AllowGrayed = True - Caption = 'Sci-Fi' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 23 - end - object ckFilterSeinen: TCheckBox - Left = 296 - Height = 19 - Hint = 'From Google: Seinen means ''young Man''. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood.' - Top = 0 - Width = 81 - AllowGrayed = True - Caption = 'Seinen' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 24 - end - object ckFilterShotacon: TCheckBox - Left = 296 - Height = 19 - Hint = 'Representing a sexual attraction to young or under-age boys.' - Top = 23 - Width = 81 - AllowGrayed = True - Caption = 'Shotacon' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 25 - end - object ckFilterShoujo: TCheckBox - Left = 296 - Height = 19 - Hint = 'A work intended and primarily written for females. Usually involves a lot of romance and strong character development.' - Top = 46 - Width = 81 - AllowGrayed = True - Caption = 'Shoujo' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 26 - end - object ckFilterShoujoAi: TCheckBox - Left = 296 - Height = 19 - Hint = 'Often synonymous with yuri, this can be thought of as somewhat less extreme. "Girl''''s Love", so to speak.' - Top = 69 - Width = 81 - AllowGrayed = True - Caption = 'Shoujo Ai' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 27 - end - object ckFilterShounen: TCheckBox - Left = 296 - Height = 19 - Hint = 'A work intended and primarily written for males. These works usually involve fighting and/or violence.' - Top = 92 - Width = 81 - AllowGrayed = True - Caption = 'Shounen' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 28 - end - object ckFilterShounenAi: TCheckBox - Left = 296 - Height = 19 - Hint = 'Often synonymous with yaoi, this can be thought of as somewhat less extreme. "Boy''''s Love", so to speak' - Top = 115 - Width = 81 - AllowGrayed = True - Caption = 'Shounen Ai' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 29 - end - object ckFilterSliceofLife: TCheckBox - Left = 296 - Height = 19 - Hint = 'As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own.' - Top = 138 - Width = 81 - AllowGrayed = True - Caption = 'Slice of Life' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 30 - end - object ckFilterSmut: TCheckBox - Left = 296 - Height = 19 - Hint = 'Deals with series that are considered profane or offensive, particularly with regards to sexual content.' - Top = 161 - Width = 81 - HelpType = htKeyword - AllowGrayed = True - Caption = 'Smut' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 31 - end - object ckFilterSports: TCheckBox - Left = 387 - Height = 19 - Hint = 'As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few.' - Top = 0 - Width = 87 - AllowGrayed = True - Caption = 'Sports' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 32 - end - object ckFilterSupernatural: TCheckBox - Left = 387 - Height = 19 - Hint = 'Usually entails amazing and unexplained powers or events which defy the laws of physics.' - Top = 23 - Width = 87 - AllowGrayed = True - Caption = 'Supernatural' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 33 - end - object ckFilterTragedy: TCheckBox - Left = 387 - Height = 19 - Hint = 'Contains events resulting in great loss and misfortune.' - Top = 46 - Width = 87 - AllowGrayed = True - Caption = 'Tragedy' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 34 - end - object ckFilterYaoi: TCheckBox - Left = 387 - Height = 19 - Hint = 'This work usually involves intimate relationships between men.' - Top = 69 - Width = 87 - AllowGrayed = True - Caption = 'Yaoi' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 35 - end - object ckFilterYuri: TCheckBox - Left = 387 - Height = 19 - Hint = 'This work usually involves intimate relationships between women.' - Top = 92 - Width = 87 - AllowGrayed = True - Caption = 'Yuri' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 36 - end - object ckFilterWeebtons: TCheckBox - Left = 387 - Height = 19 - Hint = 'Weebtoons' - Top = 115 - Width = 87 - AllowGrayed = True - Caption = 'Weebtoons' - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 37 - end - end - object pnFilter: TPanel - Left = 0 - Height = 192 - Top = 232 - Width = 606 - Align = alTop - BevelOuter = bvNone - ClientHeight = 192 - ClientWidth = 606 - ParentFont = False - TabOrder = 1 - object rbOne: TRadioButton - Left = 323 - Height = 19 - Top = 32 - Width = 169 - Caption = 'Have one of genres checked' - ParentFont = False - TabOrder = 1 - end - object rbAll: TRadioButton - Left = 323 - Height = 19 - Top = 8 - Width = 142 - Caption = 'Have all genre checked' - Checked = True - ParentFont = False - TabOrder = 0 - TabStop = True - end - object cbOnlyNew: TCheckBox - Left = 323 - Height = 19 - Top = 56 - Width = 146 - Caption = 'Search only new manga' - ParentFont = False - TabOrder = 2 - end - object edFilterTitle: TEdit - Left = 135 - Height = 23 - Top = 8 - Width = 175 - TabOrder = 3 - TextHint = 'Title' - end - object edFilterArtists: TEdit - Left = 135 - Height = 23 - Top = 56 - Width = 175 - TabOrder = 4 - TextHint = 'Artist' - end - object edFilterAuthors: TEdit - Left = 135 - Height = 23 - Top = 32 - Width = 175 - TabOrder = 5 - TextHint = 'Author' - end - object lbFilterTitle: TLabel - Left = 23 - Height = 17 - Top = 8 - Width = 28 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Title' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object lbFilterAuthors: TLabel - Left = 23 - Height = 17 - Top = 32 - Width = 43 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Author' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object lbFilterArtists: TLabel - Left = 23 - Height = 17 - Top = 56 - Width = 34 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Artist' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object cbFilterStatus: TComboBox - Left = 135 - Height = 23 - Top = 80 - Width = 175 - ItemHeight = 15 - ItemIndex = 2 - Items.Strings = ( - 'Completed' - 'Ongoing' - '' - ) - Style = csDropDownList - TabOrder = 6 - Text = '' - end - object lbFilterStatus: TLabel - Left = 23 - Height = 17 - Top = 80 - Width = 38 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Status' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object lbFilterSummary: TLabel - Left = 23 - Height = 17 - Top = 104 - Width = 59 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Summary' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object edFilterSummary: TEdit - Left = 135 - Height = 23 - Top = 104 - Width = 175 - TabOrder = 7 - TextHint = 'Part of summary' - end - object btRemoveFilterLarge: TBitBtn - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 191 - Height = 37 - Hint = 'Remove filter' - Top = 139 - Width = 136 - Caption = 'Remove filter' - Font.Height = -13 - Font.Style = [fsBold] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 00050000001E000000320000003300000082000000830101014E000000330000 - 003300000022000000080000000000005A000000770000008000000000000000 - 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 - 001A000000110000000400005A00000077000000770000008000000000000000 - 000000000000000000000202020002020272C4B5B5FF05050578040426000000 - 8499000080CC000080CC000080CC000080CC000080CC00008499000000000000 - 000000000000010101000101010001010174C4B5B5FF0909097E060651000000 - 98CC5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF000098CC000000000000 - 00000000000000000000000000000000007AC4B5B5FF0B0B0B87070759000000 - A6990000A7CC0000A7CC0000A7CC0000A7CC0000A7CC0000A699000000000000 - 00000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D0D000000 - A7000000AA000000AA000000AA000000AA000000AA000000A7001B1B1B001616 - 16000404040000000000000000000000007BC4B5B5FF0B0B0B89121212000C0C - 61000000AA000000AA000000AA000000AA000000AA000000A700363636002C2C - 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 - 250027275200101090000000AA000000AA000000AA000000A700363636002C2C - 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 - 252D353535004343430035355F00121291000000AA000000A700363636002C2C - 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 - 257E3535352A43434300464646004646460035355F0023237700363636002C2C - 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD - CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C - 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA - CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C - 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD - ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA - EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 - D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C - 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 - 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btRemoveFilterClick - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 8 - end - object cbSearchFromAllSites: TCheckBox - Left = 323 - Height = 19 - Top = 80 - Width = 149 - Caption = 'Search in all manga sites' - TabOrder = 9 - end - object btFilter: TBitBtn - Left = 39 - Height = 37 - Top = 139 - Width = 130 - Caption = 'Filter' - Font.Height = -13 - Font.Style = [fsBold] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 00050000001E000000320000003300000082000000830101014E000000330000 - 003300000022000000089C5106999C51065CA75C0D00B56A1800000000000000 - 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 - 001A0000001100000004A75C0DCCA75C0DCCA95E0E5CB56A1800000000000000 - 000000000000000000000202020002020272C4B5B5FF05050578B76C1999B56A - 18CCB56A18CCB56A18CCB56A18CCFFC538FFB56A18CCB76C195C000000000000 - 000000000000010101000101010001010174C4B5B5FF0909097EC37923CCFFE3 - 92FFFFD56AFFFFD15DFFFFD15DFFFFD15DFFFFD873FFC37923CC000000000000 - 00000000000000000000000000000000007AC4B5B5FF0B0B0B87D0852D99D287 - 2ECCD2872ECCD2872ECCD2872ECCFFE597FFD2872ECCD0852D5C000000000000 - 00000000000000000000000000000000007BC4B5B5FF0B0B0B89714C1F00D58A - 3100D58A3100D98E3400DF9438CCDF9438CCDE93375CD2872E001B1B1B001616 - 16000404040000000000000000000000007BC4B5B5FF0B0B0B8912121200A870 - 2D00D58A3100E69B3D00E79C3E99E79C3E5CDF943800D2872E00363636002C2C - 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 - 25005C4A3300E69B3D00E89D3F00E89D3F00DF943800D2872E00363636002C2C - 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 - 252D353535006B594100E89D3F00E89D3F00DF943800D2872E00363636002C2C - 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 - 257E3535352A434343006F5D450097724300936D3F008C673A00363636002C2C - 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD - CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C - 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA - CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C - 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD - ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA - EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 - D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C - 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 - 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btFilterClick - ParentFont = False - TabOrder = 10 - end - object btFilterReset: TBitBtn - Left = 345 - Height = 37 - Top = 139 - Width = 128 - Caption = 'Reset value' - Font.Height = -13 - Font.Style = [fsBold] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF000000 - 0000000000050000001E000000320000003300000082000000830101014E0000 - 003300000033000000220000000800000000FFFFFF00FFFFFF00FFFFFF000000 - 0000000000030000000F000000190000001A00000078D1C2C2FF0303037A0000 - 001A0000001A000000110000000400000000FFFFFF00FFFFFF00FFFFFF000000 - 00000000000000000000000000000202020002020272C4B5B5FF050505780505 - 050000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 - 00000000000000000000010101000101010001010174C4B5B5FF0909097E0A0A - 0A0008080800000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 - 0000000000000000000000000000000000000000007AC4B5B5FF0B0B0B870D0D - 0D000D0D0D000A0A0A000000000000000000FFFFFF00FFFFFF00FFFFFF000000 - 0000000000000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D - 0D000D0D0D000D0D0D000A0A0A0007070700FFFFFF00FFFFFF00FFFFFF001B1B - 1B00161616000404040000000000000000000000007BC4B5B5FF0B0B0B891212 - 12001919190021212100282828002A2A2A00FFFFFF00FFFFFF00FFFFFF003636 - 36002C2C2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717 - 172F25252500353535004343430046464600FFFFFF00FFFFFF00FFFFFF003636 - 36002C2C2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF1717 - 17852525252D353535004343430046464600FFFFFF00FFFFFF00FFFFFF003636 - 36002C2C2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7 - C7FF2525257E3535352A4343430046464600FFFFFF00FFFFFF00FFFFFF003636 - 36002C2C2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBC - BCFFDFCDCDFF353535774343432846464600FFFFFF00FFFFFF00FFFFFF004B4B - 4B002C2C2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5 - B5FFDCCACAFFEBDADAFF4343436F4E4E4E00FFFFFF00FFFFFF00FFFFFF004F4F - 4F662C2C2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C - 9CFFB6ADADFFC5BCBCFF4343436F4F4F4F69FFFFFF00FFFFFF00FFFFFF004F4F - 4F66EAEAEAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4 - C4FFE4D2D2FFF0DFDFFFF9E8E8FF4F4F4F69FFFFFF00FFFFFF00FFFFFF004F4F - 4F4D2C2C2C6608080866000000660000006A0000007B020202890B0B0B891717 - 17852525257E353535774343436F4F4F4F4FFFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btFilterResetClick - ParentFont = False - TabOrder = 11 - end - object cbUseRegExpr: TCheckBox - Left = 323 - Height = 19 - Top = 104 - Width = 118 - Caption = 'Regular Expression' - TabOrder = 12 - end - end - object pnCustomGenre: TPanel - Left = 0 - Height = 42 - Top = 190 - Width = 606 - Align = alTop - BevelOuter = bvNone - ClientHeight = 42 - ClientWidth = 606 - TabOrder = 2 - object lbFilterCustomGenres: TLabel - Left = 23 - Height = 17 - Top = 10 - Width = 93 - Alignment = taRightJustify - BidiMode = bdRightToLeft - Caption = 'Custom Genres' - Font.Height = -13 - Font.Style = [fsBold] - ParentBidiMode = False - ParentColor = False - ParentFont = False - end - object edCustomGenres: TEdit - Left = 135 - Height = 23 - Top = 10 - Width = 416 - ParentFont = False - TabOrder = 0 - TextHint = 'Input custom genres, separated by comma' - end - object lbFilterHint: TLabel - Left = 555 - Height = 15 - Hint = 'Genres:'#13#10'- Checked: Include this genre.'#13#10'- Unchecked: Exclude this genre.'#13#10'- Grayed: Doesn''t matter.'#13#10#13#10'Custom Genres:'#13#10'- Separate multiple genres with '',''.'#13#10'- Exclude a genre by placing ''''!'''' at the beginning of a genre.'#13#10'- Example: Adventure,!Ecchi,Comedy.' - Top = 13 - Width = 13 - Caption = '[?]' - Font.Color = clBlue - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object Bevel1: TBevel - Left = 0 - Height = 5 - Top = 37 - Width = 606 - Align = alBottom - Shape = bsBottomLine - end - end - end - end - object tsFavorites: TTabSheet - Caption = 'Favorites' - ClientHeight = 480 - ClientWidth = 606 - object btFavoritesCheckNewChapter: TBitBtn - Left = 33 - Height = 40 - Top = 400 - Width = 545 - Anchors = [akLeft, akRight, akBottom] - Caption = 'Check for new chapter' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C00000087000000E7702E00C7702E00C7702E00C72C6662E8157882F21578 - 82F2157882F2157882F2157882F2107B87EA008398D00066779A000000090000 - 0016000000DB606060FFCA9764FFC5925FFFC5925FFF4C9590FF32C6D1FF29DB - E9FF28DAE9FF79EDF5FF28DAE9FF28DAE9FF1CC7D8EA0198AF9F000000000101 - 0100010101CE626262FFC89562FFBD8A57FFBF8C59FF95906EFF3CA8ACFF42D9 - E0FF33D5DDFF000000FF33D5DDFF34D5DDFF0DACC1C7019EB63A010101000101 - 0100010101C9646464FFCA9764FFBE8B58FFC18E5BFFC18E5CFF509B94FF67D1 - D7FF46D3D7FF75B4B5FF40D0D2FF40C3C6F901A4BC9801A2BA01010101000101 - 0100010101C5676767FFCD9A67FFBF8C59FFC4915EFFC4915EFF919778FF56B6 - BAFF7CE4F1FF000000FF68D8E7FF38A6ABEE01A8C04301A7BF00010101000101 - 0100010101C16B6B6BFFD19E6BFFBF8C59FFC89562FFC89562FFC59563FF4FA3 - 9FFF90E3E9FF555555FF88E1E9FF2E8E8ADE01ABC40401ABC400010101000101 - 0100010101BE6E6E6EFFD4A16EFFBF8C59FFCB9865FFCB9865FFCB9865FF8F9F - 83FF6BC5C6FFABF5FCFF6CC7C8FF636E48C38F4F0D008F4F0D00010101000101 - 0100010101BB727272FFD8A572FFBF8C59FFCF9C69FFCF9C69FFCF9C69FFC99D - 6CFF50ACA8FFA2E5E7FF53AFABFF94500AA89B4B00009B4B0000010101000101 - 0100010101B8757575FFDBA875FFBE8B58FFD29F6CFFD29F6CFFD29F6CFFD29F - 6CFF84A791FF3FA6A6FF8CAF99FF9E4D00A39E4D00009E4D0000010101000101 - 0100010101B5797979FFDFAC79FFBE8B58FFD6A370FFD6A370FFD6A370FFD6A3 - 70FFD6A370FFBE8B58FFDFAC79FFA14F00A1A14F0000A14F0000010101000101 - 0100010101B27C7C7CFFE2AF7CFFBC8956FFE3B07DFFE3B07DFFE3B07DFFE3B0 - 7DFFE3B07DFFBC8956FFE2AF7CFFA451009FA4510000A4510000010101000101 - 0100010101B07E7E7EFFE4B17EFFBB8855FFBB8855FFBB8855FFBB8855FFBB88 - 55FFBB8855FFBB8855FFE4B17EFFA653009DA6530000A6530000010101000101 - 0100010101AE808080FFEAB784FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B2 - 7FFFE5B27FFFE5B27FFFEAB784FFA854009BA8540000A8540000010101000101 - 0100010101AC555555FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 - 66FFCC9966FFCC9966FFCC9966FFAA55009AAA550000AA550000040404000404 - 04000404048ABCBCABFFC1C1B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8 - E2FFEFEFECFFF7F7F4FFFCFCFCFF55552B6655552B0055552B00040404000404 - 0400040404460404048AAA550099AA550099AA550099AA550099AA550099AA55 - 0099AA550099AA550099AA550099AA550073AA550000AA550000 - } - OnClick = btFavoritesCheckNewChapterClick - TabOrder = 1 - end - object vtFavorites: TVirtualStringTree - Left = 2 - Height = 389 - Top = 4 - Width = 600 - Align = alTop - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Left = 2 - BorderSpacing.Top = 4 - BorderSpacing.Right = 4 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = < - item - Alignment = taRightJustify - Position = 0 - Text = '#' - end - item - Position = 1 - Text = 'Title' - Width = 150 - end - item - Position = 2 - Text = 'Current chapter' - Width = 100 - end - item - Position = 3 - Text = 'Website' - Width = 65 - end - item - Position = 4 - Text = 'Save to' - Width = 200 - end> - Header.DefaultHeight = 24 - Header.Height = 24 - Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible] - HintMode = hmHintAndDefault - Images = IconList - IncrementalSearch = isVisibleOnly - Margin = 0 - ParentFont = False - ParentShowHint = False - PopupMenu = pmFavorites - ShowHint = True - TabOrder = 0 - TextMargin = 2 - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] - OnBeforeCellPaint = vtFavoritesBeforeCellPaint - OnColumnDblClick = vtFavoritesColumnDblClick - OnFreeNode = vtFavoritesFreeNode - OnGetText = vtFavoritesGetText - OnGetImageIndex = vtFavoritesGetImageIndex - OnGetHint = vtFavoritesGetHint - OnHeaderClick = vtFavoritesHeaderClick - OnInitNode = vtFavoritesInitNode - end - object btFavoritesImport: TBitBtn - Left = 33 - Height = 24 - Top = 446 - Width = 545 - Anchors = [akLeft, akRight, akBottom] - Caption = 'Import list' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF000000001600000032000076A40000764D0000002D000000330000002D0000 - 764D000076A4000000330000001AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000000000B000000190000A8C50000A8C500007F450000590000007F450000 - A8C50000A8C50000001A0000000DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000000000000008A000000B6BF6868FFFF0000B6BF0000B6720000B6BF6868 - FFFF0000B6BF00008A0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00010190000101BF000101BFBB6262F8FF6A6AFFFF0101BFBB6A6AFFFF6262 - F8FF0101BFBB0101BF0001019000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101C3000101C3000101C3B96464F8FF5B5BF1FF6C6CFFFF5B5BF1FF6464 - F8FF0101C3B90101C3000101C300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101B7000101C7000101C7B86767F9FF2727BFFF1919B2FF4949DEFF6767 - F9FF0101C7B80101C7000101C700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000000A8000101AF000101CBB66A6AFAFF1A1AB3FFA6A6FFFF3636CDFF6161 - F2FF0101CBB60101CB000101CB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000000A9930000A8C40000A8C42121BAFF2121BAFF8484EEFF8E8EFBFF5E5E - EEFF0101CEB50101CE000101CE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000000B1C1AAAAFFFFAAAAFFFFAAAAFFFFAAAAFFFFA6A6FFFF9090FCFF7D7D - FCFF0101D2B30101D2000101D200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101BA8E0101BBBD0101BBBD3131CAFF3131CAFF8888F1FF9191FDFF6666 - F3FF0101D5B20101D5000101D500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101BB000101C4000101D9B17676FDFF3939D2FFA7A7FFFF4E4EE2FF7070 - F9FF0101D9B10101D9000101D900FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101CC000101DC000101DCAF7979FEFF4D4DE3FF4545DDFF6363F2FF7979 - FEFF0101DCAF0101DC000101DC00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101DE000101DE000101DEAE7C7CFEFF7373FDFF7373FDFF7373FDFF7C7C - FEFF0101DEAE0101DE000101DE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101E1000101E1000101E1AD7E7EFFFF7575FEFF7575FEFF7575FEFF7E7E - FFFF0101E1AD0101E1000101E100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101E3000101E3000101E3AC8484FFFF7F7FFFFF7F7FFFFF7F7FFFFF8484 - FFFF0101E3AC0101E3000101E300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000101E4000101E4000101E5810101E5AB0101E5AB0101E5AB0101E5AB0101 - E5AB0101E5810101E4000101E400FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btFavoritesImportClick - ParentFont = False - TabOrder = 2 - end - object btCancelFavoritesCheck: TSpeedButton - Left = 538 - Height = 40 - Top = 400 - Width = 40 - Anchors = [akRight, akBottom] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 - 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 - 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 - 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 - D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 - 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 - 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 - 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 - 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 - 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 - 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 - 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 - 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 - A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 - A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 - A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D - F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 - A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 - AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - Visible = False - OnClick = btCancelFavoritesCheckClick - end - end - object tsOption: TTabSheet - Caption = 'Options' - ClientHeight = 480 - ClientWidth = 606 - object pnOptions: TPageControl - Left = 9 - Height = 403 - Top = 8 - Width = 587 - ActivePage = tsGeneral - Anchors = [akTop, akLeft, akRight, akBottom] - ParentFont = False - TabIndex = 0 - TabOrder = 0 - object tsGeneral: TTabSheet - Caption = 'General' - ClientHeight = 375 - ClientWidth = 579 - object cbLanguages: TComboBox - Left = 20 - Height = 23 - Top = 34 - Width = 212 - ItemHeight = 15 - Items.Strings = ( - 'English' - ) - ParentFont = False - Style = csDropDownList - TabOrder = 0 - end - object lbOptionLanguage: TLabel - Left = 20 - Height = 15 - Top = 18 - Width = 55 - Caption = 'Language:' - ParentColor = False - end - object seOptionNewMangaTime: TSpinEdit - Left = 20 - Height = 23 - Top = 112 - Width = 58 - MaxValue = 365 - MinValue = 1 - ParentFont = False - TabOrder = 1 - Value = 1 - end - object lbOptionNewMangaTime: TLabel - Left = 86 - Height = 15 - Top = 115 - Width = 238 - Caption = 'New manga based on it''s update time (days)' - ParentColor = False - ParentFont = False - end - object cbOptionMinimizeToTray: TCheckBox - Left = 20 - Height = 19 - Top = 200 - Width = 106 - Caption = 'Minimize to tray' - ParentFont = False - TabOrder = 2 - end - object cbOptionLetFMDDo: TComboBox - Left = 20 - Height = 23 - Top = 80 - Width = 212 - ItemHeight = 15 - Items.Strings = ( - 'Do nothing' - 'Exit FMD' - 'Shutdown' - 'Hibernate' - ) - ParentFont = False - Style = csDropDownList - TabOrder = 3 - end - object lbOptionLetFMDDo: TLabel - Left = 20 - Height = 15 - Top = 64 - Width = 117 - Caption = 'After download finish:' - ParentColor = False - end - object gbOptionExternal: TGroupBox - Left = 20 - Height = 132 - Top = 228 - Width = 520 - Anchors = [akTop, akLeft, akRight] - Caption = 'External program' - ClientHeight = 112 - ClientWidth = 516 - ParentFont = False - TabOrder = 4 - object edOptionExternalParams: TEdit - Left = 13 - Height = 23 - Top = 74 - Width = 467 - Anchors = [akTop, akLeft, akRight] - TabOrder = 0 - TextHint = 'External program parameters' - end - object lbOptionExternal: TLabel - Left = 13 - Height = 15 - Top = 6 - Width = 213 - Caption = 'Open manga by using external program:' - ParentColor = False - end - object lbOptionExternalParamsHint: TLabel - Left = 485 - Height = 15 - Top = 77 - Width = 13 - Anchors = [akTop, akRight] - Caption = '[?]' - Font.Color = clBlue - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object lbOptionExternalParams: TLabel - Left = 13 - Height = 15 - Top = 56 - Width = 62 - Caption = 'Parameters:' - ParentColor = False - end - object edOptionExternalPath: TFileNameEdit - Left = 13 - Height = 23 - Top = 24 - Width = 491 - FilterIndex = 0 - HideDirectories = False - ButtonWidth = 23 - NumGlyphs = 1 - Anchors = [akTop, akLeft, akRight] - MaxLength = 0 - TabOrder = 1 - TextHint = 'External program path' - end - end - object cbOptionOneInstanceOnly: TCheckBox - Left = 20 - Height = 19 - Top = 176 - Width = 177 - Caption = 'Permit only one FMD running' - ParentFont = False - TabOrder = 5 - end - object cbOptionLiveSearch: TCheckBox - Left = 20 - Height = 19 - Top = 152 - Width = 210 - Caption = 'Enable live search (slow on long list)' - ParentFont = False - TabOrder = 6 - end - end - object tsView: TTabSheet - Caption = 'View' - ClientHeight = 375 - ClientWidth = 579 - object cbOptionShowDownloadToolbar: TCheckBox - Left = 16 - Height = 19 - Top = 232 - Width = 151 - Caption = 'Show downloads toolbar' - ParentFont = False - TabOrder = 0 - end - object gbDropTarget: TGroupBox - Left = 16 - Height = 200 - Top = 16 - Width = 312 - Caption = 'Drop Box' - ClientHeight = 180 - ClientWidth = 308 - TabOrder = 1 - object ckDropTarget: TCheckBox - Left = 16 - Height = 19 - Top = 9 - Width = 100 - Caption = 'Show Drop Box' - OnChange = ckDropTargetChange - ParentFont = False - TabOrder = 0 - end - object tbDropTargetOpacity: TTrackBar - Left = 16 - Height = 33 - Top = 128 - Width = 280 - Frequency = 15 - Max = 255 - Min = 5 - OnChange = tbDropTargetOpacityChange - Position = 200 - TabOrder = 1 - end - object lbDropTargetOpacity: TLabel - Left = 16 - Height = 15 - Top = 112 - Width = 41 - Caption = 'Opacity' - ParentColor = False - ParentFont = False - end - object rgDropTargetMode: TRadioGroup - Left = 16 - Height = 58 - Top = 40 - Width = 120 - AutoFill = True - AutoSize = True - Caption = 'Mode' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 1 - ClientHeight = 38 - ClientWidth = 116 - ItemIndex = 0 - Items.Strings = ( - 'Download all' - 'Add to favorites' - ) - ParentFont = False - TabOrder = 2 - end - end - object cbOptionEnableLoadCover: TCheckBox - Left = 16 - Height = 19 - Top = 256 - Width = 153 - Caption = 'Enable load manga cover' - ParentFont = False - TabOrder = 2 - end - end - object tsConnections: TTabSheet - Caption = 'Connections' - ClientHeight = 375 - ClientWidth = 579 - object sbDownloadConnections: TScrollBox - Left = 0 - Height = 375 - Top = 0 - Width = 579 - HorzScrollBar.Page = 455 - VertScrollBar.Page = 179 - Align = alClient - BorderStyle = bsNone - ClientHeight = 375 - ClientWidth = 579 - TabOrder = 0 - object cbOptionUseProxy: TCheckBox - Left = 12 - Height = 19 - Top = 160 - Width = 71 - Caption = 'Use proxy' - OnChange = cbOptionUseProxyChange - ParentFont = False - TabOrder = 0 - end - object gbOptionProxy: TGroupBox - Left = 12 - Height = 120 - Top = 184 - Width = 561 - Anchors = [akTop, akLeft, akRight] - Caption = 'Proxy config' - ClientHeight = 100 - ClientWidth = 557 - Enabled = False - ParentFont = False - TabOrder = 1 - object lbOptionHost: TLabel - Left = 16 - Height = 15 - Top = 40 - Width = 25 - Caption = 'Host' - ParentColor = False - ParentFont = False - end - object lbOptionPort: TLabel - Left = 16 - Height = 15 - Top = 72 - Width = 22 - Caption = 'Port' - ParentColor = False - end - object edOptionHost: TEdit - Left = 57 - Height = 23 - Top = 38 - Width = 154 - Font.CharSet = ANSI_CHARSET - Font.Height = -12 - Font.Name = 'Default' - ParentFont = False - TabOrder = 0 - TextHint = 'Proxy host/IP' - end - object edOptionPort: TEdit - Left = 57 - Height = 23 - Top = 70 - Width = 154 - Font.CharSet = ANSI_CHARSET - Font.Height = -12 - Font.Name = 'Default' - ParentFont = False - TabOrder = 1 - TextHint = 'Proxy Port' - end - object lbOptionUser: TLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 232 - Height = 15 - Top = 40 - Width = 53 - Caption = 'Username' - ParentColor = False - end - object lbOptionPass: TLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 233 - Height = 15 - Top = 72 - Width = 50 - Caption = 'Password' - ParentColor = False - end - object edOptionUser: TEdit - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 297 - Height = 23 - Top = 38 - Width = 154 - Font.CharSet = ANSI_CHARSET - Font.Height = -12 - Font.Name = 'Default' - ParentFont = False - TabOrder = 2 - TextHint = 'Proxy username' - end - object edOptionPass: TEdit - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 297 - Height = 23 - Top = 70 - Width = 154 - Font.CharSet = ANSI_CHARSET - Font.Height = -12 - Font.Name = 'Default' - ParentFont = False - TabOrder = 3 - TextHint = 'Proxy password' - end - object cbOptionProxyType: TComboBox - Left = 57 - Height = 23 - Top = 6 - Width = 154 - ItemHeight = 15 - ItemIndex = 0 - Items.Strings = ( - 'HTTP' - 'SOCKS4' - 'SOCKS5' - ) - Style = csDropDownList - TabOrder = 4 - Text = 'HTTP' - end - object lbOptionProxyType: TLabel - Left = 15 - Height = 15 - Top = 8 - Width = 26 - Caption = 'Type' - ParentColor = False - end - end - object seOptionMaxParallel: TSpinEdit - Left = 12 - Height = 23 - Top = 26 - Width = 48 - MaxValue = 8 - MinValue = 1 - ParentFont = False - ParentShowHint = False - TabOrder = 2 - Value = 1 - end - object lbOptionMaxParallel: TLabel - Left = 66 - Height = 15 - Top = 29 - Width = 292 - Caption = 'Number of downloaded tasks at the same time (Max: 8)' - ParentColor = False - ParentFont = False - end - object lbOptionMaxThread: TLabel - Left = 66 - Height = 15 - Top = 61 - Width = 337 - Caption = 'Number of downloaded files per task at the same time (Max: 32)' - ParentColor = False - ParentFont = False - end - object seOptionMaxThread: TSpinEdit - Left = 12 - Height = 23 - Top = 58 - Width = 48 - MaxValue = 32 - MinValue = 1 - ParentFont = False - ParentShowHint = False - TabOrder = 3 - Value = 1 - end - object seOptionMaxRetry: TSpinEdit - Left = 12 - Height = 23 - Top = 90 - Width = 48 - ParentFont = False - ParentShowHint = False - TabOrder = 4 - end - object lbOptionMaxRetry: TLabel - Left = 66 - Height = 15 - Top = 93 - Width = 386 - Caption = 'Number of retry times if tasks have download problems (0 = always retry)' - ParentColor = False - ParentFont = False - end - object seOptionConnectionTimeout: TSpinEdit - Left = 12 - Height = 23 - Top = 120 - Width = 48 - MaxValue = 300 - MinValue = 3 - ParentFont = False - ParentShowHint = False - TabOrder = 5 - Value = 30 - end - object lbOptionConnectionTimeout: TLabel - Left = 66 - Height = 15 - Top = 123 - Width = 161 - Caption = 'Connection timeout (seconds)' - ParentColor = False - ParentFont = False - end - end - end - object tsSaveTo: TTabSheet - Caption = 'Save to' - ClientHeight = 375 - ClientWidth = 579 - object rgOptionCompress: TRadioGroup - Left = 20 - Height = 60 - Top = 66 - Width = 520 - Anchors = [akTop, akLeft, akRight] - AutoFill = True - Caption = 'Save downloaded chapters as' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 4 - ClientHeight = 40 - ClientWidth = 516 - Columns = 4 - ItemIndex = 0 - Items.Strings = ( - 'None' - 'ZIP' - 'CBZ' - 'PDF' - ) - ParentFont = False - TabOrder = 0 - end - object gbOptionRenaming: TGroupBox - Left = 20 - Height = 196 - Top = 170 - Width = 520 - Anchors = [akTop, akLeft, akRight] - Caption = 'Renaming' - ClientHeight = 176 - ClientWidth = 516 - ParentFont = False - TabOrder = 1 - object cbOptionGenerateMangaFolderName: TCheckBox - Left = 22 - Height = 19 - Top = 36 - Width = 261 - Caption = 'Auto generate folder based on manga''s name' - ParentFont = False - TabOrder = 0 - end - object cbOptionGenerateChapterName: TCheckBox - Left = 294 - Height = 19 - Top = 52 - Width = 246 - Caption = 'Generate chapter folder with chapter name' - ParentFont = False - TabOrder = 1 - Visible = False - end - object cbOptionPathConvert: TCheckBox - Left = 22 - Height = 19 - Top = 14 - Width = 517 - Caption = 'Change all all unicode symbols to "_" (choose this when you have problem with unicode path)' - ParentFont = False - TabOrder = 2 - end - object cbOptionAutoNumberChapter: TCheckBox - Left = 294 - Height = 19 - Top = 36 - Width = 134 - Caption = 'Auto number chapter' - TabOrder = 3 - Visible = False - end - object edOptionCustomRename: TEdit - Left = 22 - Height = 23 - Top = 140 - Width = 434 - Anchors = [akTop, akLeft, akRight] - TabOrder = 4 - TextHint = 'Custom rename' - end - object lbOptionCustomRename: TLabel - Left = 22 - Height = 15 - Top = 124 - Width = 112 - Caption = 'Chapter folder name:' - ParentColor = False - end - object lbOptionCustomRenameHint: TLabel - Left = 462 - Height = 15 - Hint = '%WEBSITE% : Website name'#13#10'%MANGA% : Manga title'#13#10'%CHAPTER% : Chapter title'#13#10'%AUTHOR% : Author'#13#10'%ARTIST% : Artist'#13#10'%NUMBERING% : Numbering'#13#10#13#10'Note:'#13#10'Chapter folder name must have at least %CHAPTER% or %NUMBERING%.' - Top = 142 - Width = 13 - Anchors = [akTop, akRight] - Caption = '[?]' - Font.Color = clBlue - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object lbOptionRenameDigits: TLabel - Left = 22 - Height = 15 - Top = 68 - Width = 78 - Caption = 'Rename digits' - ParentColor = False - end - object seOptionDigitVolume: TSpinEdit - Left = 94 - Height = 23 - Top = 90 - Width = 50 - MaxValue = 10 - MinValue = 1 - TabOrder = 5 - Value = 1 - end - object seOptionDigitChapter: TSpinEdit - Left = 230 - Height = 23 - Top = 90 - Width = 50 - MaxValue = 10 - MinValue = 1 - TabOrder = 6 - Value = 1 - end - object cbOptionDigitVolume: TCheckBox - Left = 25 - Height = 19 - Top = 92 - Width = 61 - Caption = 'Volume' - OnChange = cbOptionDigitVolumeChange - TabOrder = 7 - end - object cbOptionDigitChapter: TCheckBox - Left = 158 - Height = 19 - Top = 92 - Width = 62 - Caption = 'Chapter' - OnChange = cbOptionDigitChapterChange - TabOrder = 8 - end - end - object seOptionPDFQuality: TSpinEdit - Left = 44 - Height = 23 - Hint = '100 = FlateEncode (lossless), lower = DCTEncode (lossy)' - Top = 132 - Width = 50 - MinValue = 5 - ParentFont = False - ParentShowHint = False - ShowHint = True - TabOrder = 2 - Value = 100 - end - object lbOptionPDFQuality: TLabel - Left = 103 - Height = 15 - Hint = '100 = FlateEncode (lossless), lower = DCTEncode (lossy)' - Top = 135 - Width = 119 - Caption = 'PDF compression level' - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object lbOptionCustomRenameHint1: TLabel - Left = 260 - Height = 15 - Hint = '100: FlateEncode (lossless), lower: DCTEncode (lossy)' - Top = 135 - Width = 13 - Caption = '[?]' - Font.Color = clBlue - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object btOptionBrowse: TSpeedButton - Left = 512 - Height = 23 - Top = 34 - Width = 23 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF - F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF - EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 - F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 - F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB - F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 - F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 - F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 - FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 - FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED - FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC - DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 - FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 - FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 - CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 - F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 - CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 - CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btOptionBrowseClick - end - object edOptionDefaultPath: TEdit - Left = 20 - Height = 23 - Top = 34 - Width = 490 - Anchors = [akTop, akLeft, akRight] - ParentFont = False - TabOrder = 3 - TextHint = 'Default download path' - end - object lbDefaultDownloadPath: TLabel - Left = 20 - Height = 15 - Top = 15 - Width = 186 - Caption = 'Choose the default download path:' - ParentColor = False - ParentFont = False - end - end - object tsUpdate: TTabSheet - Caption = 'Updates' - ClientHeight = 375 - ClientWidth = 579 - object cbOptionAutoCheckUpdate: TCheckBox - Left = 24 - Height = 19 - Top = 24 - Width = 140 - Caption = 'Check for new version ' - ParentFont = False - TabOrder = 0 - end - object gbOptionFavorites: TGroupBox - Left = 25 - Height = 138 - Top = 56 - Width = 520 - Anchors = [akTop, akLeft, akRight] - Caption = 'Favorites' - ClientHeight = 118 - ClientWidth = 516 - ParentFont = False - TabOrder = 1 - object cbOptionAutoCheckFavStartup: TCheckBox - Left = 16 - Height = 19 - Top = 40 - Width = 249 - Caption = 'Automatic check for new chapter at startup' - ParentFont = False - TabOrder = 0 - end - object seOptionCheckMinutes: TSpinEdit - Left = 16 - Height = 23 - Top = 8 - Width = 58 - MaxValue = 1440 - OnChange = seOptionCheckMinutesChange - TabOrder = 1 - end - object lbOptionAutoCheckMinutes: TLabel - Left = 82 - Height = 15 - Top = 12 - Width = 243 - Caption = 'Auto check for new chapter every %d minutes' - ParentColor = False - end - object cbOptionAutoRemoveCompletedManga: TCheckBox - Left = 16 - Height = 19 - Top = 88 - Width = 298 - Caption = 'Automatic remove completed manga from Favorites' - TabOrder = 2 - end - object cbOptionAutoDlFav: TCheckBox - Left = 16 - Height = 19 - Top = 64 - Width = 242 - Caption = 'Automatic download after finish checking' - ParentFont = False - TabOrder = 3 - end - end - object cbOptionUpdateListNoMangaInfo: TCheckBox - Left = 24 - Height = 19 - Top = 202 - Width = 407 - Caption = 'Don''t load manga information when updating list (filter will be not work!)' - ParentFont = False - TabOrder = 2 - end - object cbOptionUpdateListRemoveDuplicateLocalData: TCheckBox - Left = 24 - Height = 19 - Top = 226 - Width = 310 - Caption = 'Remove duplicate local data when updating manga list' - ParentFont = False - TabOrder = 3 - end - end - object tsDialogs: TTabSheet - Caption = 'Dialogs' - ClientHeight = 375 - ClientWidth = 579 - object gbDialogs: TGroupBox - Left = 10 - Height = 346 - Top = 14 - Width = 556 - Anchors = [akTop, akLeft, akRight, akBottom] - ClientHeight = 326 - ClientWidth = 552 - TabOrder = 0 - object cbOptionShowQuitDialog: TCheckBox - Left = 24 - Height = 19 - Top = 32 - Width = 66 - Caption = 'Exit FMD' - ParentFont = False - TabOrder = 0 - end - object lbOptionDialogs: TLabel - Left = 16 - Height = 15 - Top = 8 - Width = 165 - Caption = 'Show dialog confirmation for:' - ParentColor = False - end - object cbOptionShowDeleteTaskDialog: TCheckBox - Left = 24 - Height = 19 - Top = 56 - Width = 122 - Caption = 'Delete task/favorite' - ParentFont = False - TabOrder = 1 - end - end - end - object tsWebsites: TTabSheet - Caption = 'Websites' - ClientHeight = 375 - ClientWidth = 579 - object vtOptionMangaSiteSelection: TVirtualStringTree - Left = 2 - Height = 336 - Top = 35 - Width = 573 - Align = alClient - BorderSpacing.Top = 2 - BorderSpacing.Right = 2 - BorderSpacing.Bottom = 2 - BorderSpacing.Around = 2 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = <> - Header.DefaultHeight = 17 - Header.MainColumn = -1 - IncrementalSearch = isVisibleOnly - Margin = 0 - ParentFont = False - TabOrder = 0 - TextMargin = 0 - TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages] - OnChange = vtOptionMangaSiteSelectionChange - OnFocusChanged = vtOptionMangaSiteSelectionFocusChanged - OnFreeNode = vtOptionMangaSiteSelectionFreeNode - OnGetText = vtOptionMangaSiteSelectionGetText - OnGetNodeDataSize = vtOptionMangaSiteSelectionGetNodeDataSize - OnInitNode = vtOptionMangaSiteSelectionInitNode - end - object pnlWebsitesTool: TPanel - Left = 2 - Height = 23 - Top = 6 - Width = 573 - Align = alTop - BorderSpacing.Top = 4 - BorderSpacing.Right = 2 - BorderSpacing.Bottom = 4 - BorderSpacing.Around = 2 - BevelOuter = bvNone - ClientHeight = 23 - ClientWidth = 573 - TabOrder = 1 - object edWebsitesSearch: TEdit - Left = 0 - Height = 23 - Top = 0 - Width = 184 - Align = alLeft - BorderSpacing.Right = 2 - OnChange = edWebsitesSearchChange - TabOrder = 0 - TextHint = 'Search website...' - end - object btWebsitesSearchClear: TSpeedButton - Left = 186 - Height = 23 - Top = 0 - Width = 22 - Align = alLeft - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 - 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 - 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 - 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 - D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 - 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 - 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 - 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 - 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 - 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 - 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 - 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 - 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 - A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 - A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 - A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D - F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 - A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 - AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btWebsitesSearchClearClick - end - object pnlWebsitesToolRight: TPanel - Left = 403 - Height = 23 - Top = 0 - Width = 170 - Align = alRight - AutoSize = True - BevelOuter = bvNone - ClientHeight = 23 - ClientWidth = 170 - TabOrder = 1 - object ToolBarWebsites: TToolBar - Left = 0 - Height = 22 - Top = 0 - Width = 170 - AutoSize = True - EdgeBorders = [] - Images = IconList - List = True - ParentFont = False - ShowCaptions = True - TabOrder = 0 - Transparent = True - object tbWebsitesExpandAll: TToolButton - Left = 1 - Top = 0 - AutoSize = True - Caption = 'Expand All' - ImageIndex = 17 - OnClick = tbWebsitesExpandAllClick - end - object tbWebsitesCollapseAll: TToolButton - Left = 82 - Top = 0 - AutoSize = True - Caption = 'Collapse All' - ImageIndex = 18 - OnClick = tbWebsitesCollapseAllClick - end - end - end - end - end - object tsMisc: TTabSheet - Caption = 'Misc' - ClientHeight = 375 - ClientWidth = 579 - object gbMisc: TGroupBox - Left = 12 - Height = 349 - Top = 12 - Width = 556 - Anchors = [akTop, akLeft, akRight, akBottom] - ClientHeight = 329 - ClientWidth = 552 - TabOrder = 0 - object cbOptionShowAllLang: TCheckBox - Left = 16 - Height = 19 - Top = 40 - Width = 167 - Caption = '[Batoto] Show All Language' - ParentFont = False - TabOrder = 1 - end - object cbOptionShowBatotoSG: TCheckBox - Left = 16 - Height = 19 - Top = 16 - Width = 190 - Caption = '[Batoto] Show scan group name' - ParentFont = False - TabOrder = 0 - end - object cbOptionMangaFoxRemoveWatermarks: TCheckBox - Left = 16 - Height = 19 - Top = 88 - Width = 317 - Caption = '[Mangafox] Remove watermarks (Beware! Experimental!)' - ParentFont = False - TabOrder = 2 - Visible = False - end - end - end - end - object btOptionApply: TBitBtn - Left = 8 - Height = 41 - Top = 425 - Width = 128 - Anchors = [akLeft, akBottom] - Caption = 'Apply' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF000000 - 00020000000C000000160000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A000000170000000C00000002FFFFFF00FFFFFF000000 - 0004000000170000002B011A004302440080025A00AB025D00C4025D00C4025A - 00AB02440080011A00430000002D0000001800000004FFFFFF00FFFFFF000000 - 0000031F00000553004D087402BF139D08E31DC40EF521D411FD21D411FD1DC4 - 0EF5139D08E3087402BF0553004D031F000000000000FFFFFF00FFFFFF000B83 - 00000B7F004D0E8804CD21C411F623D112FF22B611FF22D111FF22D111FF22D1 - 11FF22D111FF1EC20FF60D8803CD0B7F004D0B830000FFFFFF00FFFFFF000C85 - 001A0F8A03BF27C017F623C812FF22B211FFE6E6E6FF22B211FF22C811FF22C8 - 11FF22C811FF22C811FF1FBC0FF60D8902BF0C85001AFFFFFF00FFFFFF000D89 - 006C22A813E326C015FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE - 11FF22BE11FF22BE11FF22BE11FF17A109E30D89006CFFFFFF00FFFFFF000E8D - 00A73BBD2BF523AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 - 11FF22B411FF22B411FF22B411FF21AF11F50E8D00A7FFFFFF00FFFFFF000F92 - 00C450C83FFDA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 - E6FF22A311FF22AA11FF22AA11FF28AE17FD0F9200C4FFFFFF00FFFFFF001096 - 00C453CB42FD3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 - E2FFE6E6E6FF229E11FF22A111FF2CAA1BFD109600C4FFFFFF00FFFFFF00119A - 00A751CB40F547BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 - E2FFE3E3E3FFE7E7E7FF269E15FF34B023F5119A00A7FFFFFF00FFFFFF00129E - 006C3DBF2CE354CB43FF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB - 33FFFFFFFFFFA7E29EFF52C941FF36B925E3129E006CFFFFFF00FFFFFF0013A1 - 001A1AA707BF5CD74BF658CF47FF57CE46FF57CE46FF57CE46FF57CE46FF57CE - 46FF4AC139FF52C941FF57D245F619A606BF13A1001AFFFFFF00FFFFFF0013A2 - 000014A5004D21AF0ECD5FDA4EF663DA52FF5FD64EFF5FD64EFF5FD64EFF5FD6 - 4EFF62D951FF5DD94BF620AE0DCD14A5004D13A20000FFFFFF00FFFFFF0013A2 - 000014A5000014A8004D1BAD08BF42C82FE35FDC4EF56BE35AFD6BE359FD5FDB - 4EF541C72EE31BAD07BF14A8004D14A5000013A20000FFFFFF00FFFFFF0013A2 - 000014A5000014A8000015A9001A15AA006C15AA00A615AA00C415AA00C415AA - 00A615AA006C15A9001A14A8000014A5000013A20000FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btOptionApplyClick - TabOrder = 1 - end - end - object tsAbout: TTabSheet - Caption = 'About' - ChildSizing.LeftRightSpacing = 2 - ChildSizing.TopBottomSpacing = 2 - ClientHeight = 480 - ClientWidth = 606 - object rmAbout: TRichMemo - Left = 2 - Height = 409 - Top = 4 - Width = 600 - Align = alTop - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Top = 2 - BorderSpacing.Right = 2 - BorderSpacing.Around = 2 - Color = clWhite - Font.Style = [fsBold] - HideSelection = False - ParentFont = False - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 0 - ZoomFactor = 1 - end - object btCheckVersion: TBitBtn - Left = 25 - Height = 40 - Top = 429 - Width = 208 - Anchors = [akLeft, akBottom] - Caption = 'Check for new version' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF000000 - 00000000000600000010000000190000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A000000190000001500000010FFFFFF000000 - 00000000000B0000002011090133391E013E532A014345240240733A02A6984D - 02CC984D02CC984D02CC984D02CC984D02CC733A02A30000001FFFFFFF000000 - 000028160200763D0419A2580842C47E174EE4A01C54FCB9203F9C5105CCFDBC - 28FFFCB81DFFFCB81DFFFDC033FF9C5105CC9C51055C00000000FFFFFF00A65B - 0D00A3580B22AB62105FF8BA346DF6B01C6DF7B11E6BF8B52740A2570ACCF8B6 - 2AFFF6AC14FFF8BA35FFA2570ACCA2570A84A15609002A170400FFFFFF00A95E - 0F10AD641378F3B84390EFAB2A90E7A83691BF7A2078A85D0E33A85D0ECCF2B3 - 39FFF3B943FFEEA824FFF2B339FFAD6210BFA95E0F1AAA5F1000FFFFFF00AF64 - 144DCC8B33A6E8A83BB4E4A845B2AF641488AE631332AC611100AF6414CCF0BD - 5CFFAF6414CCECB148FFE8A83BFFCD8D34E3AF64146CAF641400FFFFFF00B66B - 198CE0A751CFE3A84ED6C98734BBB56A194AAF641400B66B1900B66B19CCB66B - 19CCB66B1994C98734DCE3A84EFFE0A851F5B66B19A7B66B1900FFFFFF00BE73 - 1FC1E7B466F1E5B061F1BE731FC1BB701D00C0752100C0752000BD721E99BD72 - 1E5CBA6F1C00BE731FCCE5B061FFE7B466FFBE731FCCBE731F00FFFFFF00C57A - 25CCE8B86FFFE6B46CFFC57A25CCC97E2700C67B265CC67B2699C1762100BE73 - 1F00C87D2700C57A25C1E6B46CF1E8B86FF1C57A25C1C57A2500FFFFFF00CD82 - 2AA7E8B66CF5E8B570FFDA9B48DCCD822A94CD822ACCCD822ACCCD822A00CF84 - 2C00CE832B4ADA9B47BBE8B570D6E8B66CCFCD822A8CCD822A00FFFFFF00D489 - 306CE4AB59E3EDBC76FFF1C67EFFD48930CCF7D38AFFD48930CCD88D3200D58A - 3132D4893088EEBF75B2EDBC76B4E4A958A6D489304DD4893000FFFFFF00DA8F - 341ADC9339BFF7CD85FFF2C27AFFF9D38AFFF7CD85FFDB9034CCDB903433E4A5 - 4F78F3C67991F4C57D90F8D28990DD953A78DA8F3410D98E3300FFFFFF00E196 - 3900E1963984E19639CCFCD88EFFF9CC82FFFCD58AFFE19639CCFCD48940FBD0 - 866BFACF856DFCD88D6DE49E435FE0953922DC913500DC913500FFFFFF00E69B - 3D5CE59A3DCCFFE094FFFED98DFFFED98DFFFFDC91FFE59A3DCCFEDA8E3FF8CB - 7B54F0B7604EE79F4242E59A3D19E1963900DC913500DC913500FFFFFF00E99E - 4099E99E40CCE99E40CCE99E40CCE99E40CCE99E40CCE99E4099E99E4020E99E - 4025E99E4019E89D3F06E59A3D00E1963900DC913500DC913500FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btCheckVersionClick - TabOrder = 1 - end - object btVisitMyBlog: TBitBtn - Left = 249 - Height = 40 - Top = 429 - Width = 208 - Anchors = [akLeft, akBottom] - Caption = 'Visit my blog' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C0A0A0A660C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C - 0C770C0C0C770C0C0C770C0C0C770A0A0A660000002C00000012000000090000 - 00161F1F1F74EBEBEBFFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6 - E6FFE6E6E6FFE6E6E6FFEBEBEBFF1F1F1F740000001600000009000000002A2A - 2A0036363671E8E8E8FFB4B4B4FFBDBDBDFFC5C5C5FFBDBDBDFFCECECEFFE0E0 - E0FFE0E0E0FFE0E0E0FFE8E8E8FF363636712A2A2A0000000000343434004545 - 45004545456FEAEAEAFFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFE2E2 - E2FFE2E2E2FFE2E2E2FFEAEAEAFF4545456F45454500343434004B4B4B004B4B - 4B004B4B4B6EECECECFF8E8E8EFFA5A5A5FFA5A5A5FF8E8E8EFFD3D3D3FFE5E5 - E5FFC2C2C2FFB9B9B9FFECECECFF4B4B4B6E4B4B4B004B4B4B00515151005151 - 51005151516DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 - E8FFD5D5D5FFD5D5D5FFEEEEEEFF5151516D5151510051515100575757005757 - 57005757576CF0F0F0FFBFBFBFFFC7C7C7FFD0D0D0FFC7C7C7FFD8D8D8FFEAEA - EAFFBFBFBFFFC7C7C7FFF0F0F0FF5757576C57575700575757005D5D5D005D5D - 5D005D5D5D6BF2F2F2FFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFEDED - EDFFDBDBDBFFDBDBDBFFF2F2F2FF5D5D5D6B5D5D5D005D5D5D00626262006262 - 62006262626BF5F5F5FF919191FFC4C4C4FFAAAAAAFFAAAAAAFF919191FFF1F1 - F1FFBBBBBBFFCCCCCCFFF5F5F5FF6262626B6262620062626200676767006767 - 67006767676AF7F7F7FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4 - F4FFF4F4F4FFF4F4F4FFF7F7F7FF6767676A67676700676767006C6C6C006C6C - 6C006C6C6C69F9F9F9FFAE7B26FFB6832EFFCC9944FFDCA954FFCB9843FFDCA9 - 54FFC5923DFFB17E29FFF9F9F9FF6C6C6C696C6C6C006C6C6C00717171007171 - 710071717168FBFBFBFFAE7B26FFEDE0CBFFE3CA9FFFEED4AAFFE5D8C3FFDCA9 - 54FFC5923DFFB17E29FFFBFBFBFF717171687171710071717100757575007575 - 750075757568FDFDFDFFAE7B26FFC18E39FFD9A651FFEBB863FFEBB863FFDCA9 - 54FFC5923DFFB17E29FFFDFDFDFF757575687575750075757500797979007979 - 790079797967FEFEFEFFAC7924FFB6832EFFC28F3AFFCB9843FFCB9843FFC390 - 3BFFB88530FFAE7B26FFFEFEFEFF7979796779797900797979007D7D7D007D7D - 7D007D7D7D67FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFF7D7D7D677D7D7D007D7D7D007F7F7F007F7F - 7F008080804D8080806680808066808080668080806680808066808080668080 - 80668080806680808066808080668080804D7F7F7F007F7F7F00 - } - OnClick = btVisitMyBlogClick - TabOrder = 2 - end - end - end - object pnMainTop: TPanel - Left = 0 - Height = 8 - Top = 0 - Width = 819 - Align = alTop - TabOrder = 1 - Visible = False - end - object pcLeft: TPageControl - Left = 4 - Height = 506 - Top = 12 - Width = 195 - ActivePage = tsMangaList - Align = alLeft - BorderSpacing.Left = 4 - BorderSpacing.Top = 4 - BorderSpacing.Bottom = 4 - Images = IconList - TabIndex = 0 - TabOrder = 4 - object tsMangaList: TTabSheet - Caption = 'Manga List' - ChildSizing.LeftRightSpacing = 2 - ChildSizing.TopBottomSpacing = 3 - ClientHeight = 478 - ClientWidth = 187 - object lbMode: TLabel - Left = 3 - Height = 15 - Top = 68 - Width = 157 - Anchors = [akTop, akLeft, akRight] - Caption = 'Mode: Show all manga' - Font.Style = [fsBold] - ParentColor = False - ParentFont = False - end - object vtMangaList: TVirtualStringTree - Cursor = crHourGlass - Left = 2 - Height = 384 - Top = 91 - Width = 181 - Align = alBottom - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Right = 2 - BorderSpacing.Around = 2 - DefaultText = 'Node' - Header.AutoSizeIndex = 0 - Header.Columns = <> - Header.DefaultHeight = 17 - Header.MainColumn = -1 - HintMode = hmHint - IncrementalSearch = isAll - Margin = 0 - ParentShowHint = False - PopupMenu = pmMangaList - ShowHint = True - TabOrder = 0 - TextMargin = 3 - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes] - TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toThemeAware, toUseBlendedImages] - TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toRightClickSelect] - OnBeforeCellPaint = vtMangaListBeforeCellPaint - OnChange = vtMangaListChange - OnColumnDblClick = vtMangaListColumnDblClick - OnDragAllowed = vtMangaListDragAllowed - OnDragOver = vtMangaListDragOver - OnFreeNode = vtMangaListFreeNode - OnGetText = vtMangaListGetText - OnGetHint = vtMangaListGetHint - OnInitNode = vtMangaListInitNode - end - object edSearch: TEdit - Left = 3 - Height = 23 - Top = 36 - Width = 157 - Anchors = [akTop, akLeft, akRight] - OnChange = edSearchChange - OnKeyUp = edSearchKeyUp - TabOrder = 1 - TextHint = 'Search title...' - end - object cbSelectManga: TComboBox - Left = 3 - Height = 23 - Hint = 'For more manga sites, please go to Options->Manga sites' - Top = 8 - Width = 157 - Anchors = [akTop, akLeft, akRight] - ItemHeight = 15 - ItemIndex = 0 - Items.Strings = ( - '' - ) - OnChange = cbSelectMangaChange - ParentShowHint = False - ShowHint = True - Sorted = True - Style = csDropDownList - TabOrder = 2 - end - object btUpdateList: TSpeedButton - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 162 - Height = 23 - Hint = 'Update manga list' - Top = 8 - Width = 22 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 20000000000000040000640000006400000000000000000000000000001F0000 - 0084000000E4733100C5733100C5733100C5733100C5733100C5733100C57331 - 00C5582500A00000002200000000000000000000000000000000000000100101 - 01D1606060FFCA9764FFC69360FFC69360FFC69360FFC69360FFC69360FFCA97 - 64FF803A00BE0000002B0000001A000000110000000000000000010101000101 - 01C8646464FFCA9764FFBE8B58FFC18E5BFFC18E5BFFC18E5BFFBE8B58FFCA97 - 64FF9C5E28F7733100C5582500A0000000220000000000000000010101000101 - 01C3696969FFCF9C69FFBF8C59FFC69360FFC69360FFC69360FFBF8C59FFCF9C - 69FFAD713AFFCA9764FF803A00BE0000001A0000001A00000011010101000101 - 01BE6E6E6EFFD4A16EFFBF8C59FFCB9865FFCB9865FFCB9865FFBF8C59FFD4A1 - 6EFFB0733BFFCA9764FF9C5E28F7733100C5582500A000000022010101000101 - 01BA737373FFD9A673FFBF8C59FFD09D6AFFD09D6AFFD09D6AFFBF8C59FFD9A6 - 73FFB4783EFFCF9C69FFAD713AFFCA9764FF853D00B623100000010101000101 - 01B5787878FFDEAB78FFBE8B58FFE1AE7BFFE1AE7BFFE1AE7BFFBE8B58FFDEAB - 78FFB87B40FFD4A16EFFB0733BFFCA9764FF8E4200B08E420000010101000101 - 01B27C7C7CFFE2AF7CFFBC8956FFBC8956FFBC8956FFBC8956FFBC8956FFE2AF - 7CFFBB7E42FFD9A673FFB4783EFFCF9C69FF934600AC93460000010101000101 - 01AE808080FFEAB784FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 - 84FFBD8043FFDEAB78FFB87B40FFD4A16EFF984900A898490000010101000101 - 01AC555555FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 - 66FFBF8144FFE2AF7CFFBB7E42FFD9A673FF9C4C00A49C4C0000040404000404 - 048ABDBDACFFC3C3B4FFCCCCBEFFD6D6CBFFE0E0D8FFEAEAE5FFF3F3F1FFFBFB - FAFFB4A484FFEAB784FFBD8043FFDEAB78FFA04F00A1A04F0000040404000404 - 04460404048AA16A33EEAA7744FFC28548FFC28548FFC28548FFC28548FFC285 - 48FFC28548FFCC9966FFBF8144FFE2AF7CFFA451009EA4510000040404000404 - 0400040404000404048ABDBDACFFC3C3B4FFCCCCBEFFD6D6CBFFE0E0D8FFEAEA - E5FFF3F3F1FFFBFBFAFFB4A484FFEAB784FFA753009CA7530000040404000404 - 040004040400040404460404048AA16A33EEAA7744FFC28548FFC28548FFC285 - 48FFC28548FFC28548FFC28548FFCC9966FFAA55009AAA550000040404000404 - 04000404040004040400040404000404048ABDBDACFFC3C3B4FFCCCCBEFFD6D6 - CBFFE0E0D8FFEAEAE5FFF3F3F1FFFBFBFAFF55552B6655552B00000000000202 - 0200040404000404040004040400040404460404048AAA550099AA550099AA55 - 0099AA550099AA550099AA550099AA550099AA550073AA550000 - } - OnClick = btUpdateListClick - end - object btRemoveFilter: TSpeedButton - Left = 162 - Height = 23 - Top = 63 - Width = 22 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 00050000001E000000320000003300000082000000830101014E000000330000 - 003300000022000000080000000000005A000000770000008000000000000000 - 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 - 001A000000110000000400005A00000077000000770000008000000000000000 - 000000000000000000000202020002020272C4B5B5FF05050578040426000000 - 8499000080CC000080CC000080CC000080CC000080CC00008499000000000000 - 000000000000010101000101010001010174C4B5B5FF0909097E060651000000 - 98CC5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF000098CC000000000000 - 00000000000000000000000000000000007AC4B5B5FF0B0B0B87070759000000 - A6990000A7CC0000A7CC0000A7CC0000A7CC0000A7CC0000A699000000000000 - 00000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D0D000000 - A7000000AA000000AA000000AA000000AA000000AA000000A7001B1B1B001616 - 16000404040000000000000000000000007BC4B5B5FF0B0B0B89121212000C0C - 61000000AA000000AA000000AA000000AA000000AA000000A700363636002C2C - 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 - 250027275200101090000000AA000000AA000000AA000000A700363636002C2C - 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 - 252D353535004343430035355F00121291000000AA000000A700363636002C2C - 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 - 257E3535352A43434300464646004646460035355F0023237700363636002C2C - 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD - CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C - 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA - CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C - 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD - ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA - EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 - D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C - 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 - 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btRemoveFilterClick - end - object btSearchClear: TSpeedButton - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Side = asrBottom - Left = 162 - Height = 23 - Top = 36 - Width = 22 - Anchors = [akTop, akRight] - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 - 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 - 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 - 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 - D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 - 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 - 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 - 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 - 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 - 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 - 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 - 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 - 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 - A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 - A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 - A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D - F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 - A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 - AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btSearchClearClick - end - object btAbortUpdateList: TSpeedButton - Left = 136 - Height = 22 - Hint = 'Abort update list' - Top = 64 - Width = 23 - Flat = True - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF000000 - 00020000000C000000160000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A000000170000000C00000002FFFFFF00FFFFFF000000 - 0004000000170000002B00001A430000448000005AAB00005DC400005DC40000 - 5AAB0000448000001A430000002D0000001800000004FFFFFF00FFFFFF000000 - 000000001F000000534D020274BF08089DE30E0EC4F51111D4FD1111D4FD0E0E - C4F508089DE3020274BF0000534D00001F0000000000FFFFFF00FFFFFF000000 - 830000007F4D040488CD1212C4F61212B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF0F0FC2F6030388CD00007F4D00008300FFFFFF00FFFFFF000000 - 851A03038ABF1818C1F61212B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF0F0FBCF6020289BF0000851AFFFFFF00FFFFFF000000 - 896C1616AAE21616C1FFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF0909A1E30000896CFFFFFF00FFFFFF000000 - 8DA72E2EC0F51212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1212AFF500008DA7FFFFFF00FFFFFF000000 - 92C44444CDFD2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818AFFD000092C4FFFFFF00FFFFFF000000 - 96C44949D1FD3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFD000096C4FFFFFF00FFFFFF000000 - 9AA74747D3F53737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2727B4F500009AA7FFFFFF00FFFFFF000000 - 9E6C3232C6E34949D1FFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4747CFFF2A2ABDE300009E6CFFFFFF00FFFFFF000000 - A11A0808A8BF5656E2F65151D9FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF5050D8FF4F4FDCF60707A7BF0000A11AFFFFFF00FFFFFF000000 - A2000000A54D1010B1CD5B5BE8F65F5FE7FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5F5FE7FF5858E4F60F0FB0CD0000A54D0000A200FFFFFF00FFFFFF000000 - A2000000A5000000A84D0909AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5B - E9F53636CFE30909AEBF0000A84D0000A5000000A200FFFFFF00FFFFFF000000 - A2000000A5000000A8000000A91A0000AA6C0000AAA60000AAC40000AAC40000 - AAA60000AA6C0000A91A0000A8000000A5000000A200FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - OnClick = btAbortUpdateListClick - ShowCaption = False - ShowHint = True - ParentShowHint = False - end - end - object tsDownloadFilter: TTabSheet - Caption = '>>' - ClientHeight = 478 - ClientWidth = 187 - ImageIndex = 4 - object tvDownloadFilter: TTreeView - Left = 0 - Height = 478 - Top = 0 - Width = 187 - Align = alClient - AutoExpand = True - DefaultItemHeight = 18 - Images = IconList - ReadOnly = True - TabOrder = 0 - OnSelectionChanged = tvDownloadFilterSelectionChanged - Options = [tvoAutoExpand, tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] - end - end - end - object sbMain: TStatusBar - Left = 0 - Height = 23 - Top = 522 - Width = 819 - Panels = < - item - Width = 195 - end - item - Width = 100 - end> - SimplePanel = False - end - object spMainSplitter: TSplitter - Left = 199 - Height = 514 - Top = 8 - Width = 2 - OnMoved = spMainSplitterMoved - end - object dlgSaveTo: TSelectDirectoryDialog - left = 80 - top = 408 - end - object pmDownload: TPopupMenu - Images = IconList - OnPopup = pmDownloadPopup - left = 616 - top = 360 - object miDownloadStop: TMenuItem - Caption = 'Stop' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 0003000000110000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001300000004FFFFFF00FFFFFF00FFFFFF000000 - 000306063EA0080860CC080860CC080860CC080860CC080860CC080860CC0808 - 60CC080860CC080860CC06063EA100000004FFFFFF00FFFFFF00FFFFFF00FFFF - FF0009096ACC2727CDFF1C1CC9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717 - C8FF1717C8FF1919C8FF09096ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000A0A75CC2525CDFF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212 - C6FF1212C6FF1919C8FF0A0A75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000B0B84CC2C2CCFFF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414 - C6FF1414C6FF1E1ECAFF0B0B84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000D0D95CC3636D1FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717 - C8FF1717C8FF2727CDFF0D0D95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF000F0FA5CC5555DAFF2020CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1A - C9FF1A1AC9FF2E2ED0FF0F0FA5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF001010B9CC6767DFFF4B4BD8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1B - C9FF1B1BC9FF3434D1FF1010B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF001414C6CC6F6FE1FF5555DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3B - D3FF3838D3FF5252DAFF1414C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF001C1CC9CC7878E4FF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767 - DFFF6767DFFF7575E2FF1C1CC9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF002424CCCC8686E6FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080 - E5FF8080E5FF8484E5FF2424CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF002B2BCF992B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B - CFCC2B2BCFCC2B2BCFCC2B2BCF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 7 - OnClick = miDownloadStopClick - end - object miDownloadResume: TMenuItem - Caption = 'Resume' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 - 000000000001000000070000000E000000150000001A0000001A0000001A0000 - 001A0000001A0000001A000000160000000F0000000800000002000000000000 - 0000000000020000000E0000001C0000002A000000330000003300000033733A - 02A663320274000000330000002B0000001D0000000F00000003000000000000 - 0000000000000000000000000000000000000000000000000000281502009D52 - 06CC9D5206CC763E055C29160300000000000000000000000000B0651400A85D - 0E00A85D0E00553008007F470C00A85D0E007F470C00A85D0E00A65B0D00A358 - 0BCCFFB914FFA3580BCCA4590C5C7F470C002C19050000000000B4691700AA5F - 1000AA5F10CCAB601100AB601199AA5F10CCAB601199AA5F10CCAB601199AA5F - 10CCFFB810FFFFBB1BFFAA5F10CCAB60115CB1661600B96E1C00B76C1A00AF64 - 1400AF641400B3681700B16616CCF8BF3EFFB16616CCF7BC36FFD08613E1F6B4 - 24FFF5AF18FFF5AB0EFFF7B92EFFB16616CCB267175CB96E1C00B96E1CCCBA6F - 1D00BA6F1D99B96E1CCCB96E1CCCB96E1CCCB96E1CCCBD721DCFCB8422E1DA96 - 27F5E19E29FFE19E29FFE19E29FFEAB349FFB96E1CCCBA6F1D5CBF742000C378 - 2300C27722CCF8D084FFC27722CCF7CD81FFC77E2AD2EDC071FFD08D3BE8D396 - 44FFD09341FFD09341FFD39644FFD89B49FFECBB6CFFC27722CCCB802999CA7F - 28CCCA7F28CCCA7F28CCCA7F28CCCC812BCED38C37D7DC9947E3E5A556EFEBAE - 61FAEEB266FFEEB266FFEEB266FFF7CC80FFCA7F28CCC97E275CD2872ECCFBD9 - 8DFFD2872ECCD0852C00D2872ECCFBD68AFFDA933DD7FAD488FFF3C375F7F6C9 - 7DFFF4C175FFF2B96DFFFAD68AFFD2872ECCD1862D5CCA7F2800D88D3399D98E - 33CCD88D3399D78C3200D88D3399D98E33CCD88D3399D98E33CCD98E33CCD98E - 33CCFBD488FFFEDF93FFD98E33CCD88D335CD2872E00CA7F2800D98E3300DA8F - 3400D98E3300D78C3200D98E3300DA8F3400D98E3300DA8F3400DC913600E095 - 38CCFFE498FFE09538CCDF94385CD98E3300D2872E00CA7F2800D98E3300DA8F - 3400D98E3300D78C3200D98E3300DA8F3400D98E3300DD923700E59A3C00E59A - 3CCCE59A3CCCE59A3C5CE0953800D98E3300D2872E00CA7F2800D98E3300DA8F - 3400D98E3300D78C3200D98E3300DA8F3400D98E3300E89D3F00E89D3F00E99E - 4099E99E405CE59A3C00E0953800D98E3300D2872E00CA7F2800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 12 - OnClick = miDownloadResumeClick - end - object miDownloadDelete: TMenuItem - Caption = 'Delete' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 000E00000014000000190000001900000016000000100000000B000000080000 - 0007000000080000000B0000000E0000001100000013FFFFFF00FFFFFF000000 - 001C0000325E000059CC000057BC0000164200000020000000160000000F0000 - 000D00000010000000150000001B00001D3800002D4CFFFFFF00FFFFFF000000 - 180000005FCC1111DBFE0C0CAFEC00005F8B0000190000000000000000000000 - 000000000000000000000000320000005F7300004832FFFFFF00FFFFFF000000 - 66000000668C0A0A9FE51212DDFF030378D30000673300005100000000000000 - 00000000380000006A00000066840000668900006404FFFFFF00FFFFFF000000 - 6C0000006D1F00006ECC1515D1FB1111C3F400006EB400007011000070000000 - 78000000720000006E8200006EB800006D4100006C00FFFFFF00FFFFFF000000 - 700000007000000075670D0D96DC1717CCFF0F0FA2E50000777500007E000000 - 7A000000769104048AD5000076860000730000007200FFFFFF00FFFFFF000000 - 78000000780000007B0000007E911515A6E51D1DBEFD07078AD400007F630000 - 7EAE0A0A94DC00007EB600007A000000780000007800FFFFFF00FFFFFF000000 - 8000000080000000800000008215000086B01A1AA8E72222B4F907078ED21414 - 9FE105058DD20000820000007C000000780000007800FFFFFF00FFFFFF000000 - 9F0000009E00000098000000900000008D3300008ECC3131BCF33333BCFA0909 - 97D400008E0000008F0000008E0000008E000000A500FFFFFF00FFFFFF000000 - 9F0000009E00000098330000968A000096CC4141CDEE5151D9FD2727B7E32F2F - BEE3000096B100009A1800009F000000A4000000A500FFFFFF00FFFFFF000000 - 9F0000009F6600009ECC3737C9E56262EAFF5858E3FA1616AFD600009A330E0E - A99F2828BEDD00009EB400009F1F0000A4000000A500FFFFFF00FFFFFF000000 - A4000000A4CC7474FCFF6B6BF4FE3636CDE50000A4CC0000A10000009A000000 - 9E000000A3890606A8CF0000A4BD0000A54A0000A501FFFFFF00FFFFFF000000 - A8000000A9480000A9CC0000A9CC0000A9930000A7000000A20000009A000000 - 9E000000A4000000A82B0000A97E0000A9B00000A966FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 9 - object miDownloadDeleteTask: TMenuItem - Caption = 'Task only' - Enabled = False - OnClick = miDownloadDeleteTaskClick - end - object miDownloadDeleteTaskData: TMenuItem - Caption = 'Task + Data' - Enabled = False - OnClick = miDownloadDeleteTaskClick - end - end - object miDownloadDeleteCompleted: TMenuItem - Caption = 'Delete all completed tasks' - Enabled = False - OnClick = miDownloadDeleteCompletedClick - end - object MenuItem4: TMenuItem - Caption = '-' - end - object miDownloadMergeCompleted: TMenuItem - Caption = 'Merge completed tasks' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 - 000200000005000000090000000D0000001100000015000000180000001A0000 - 001A0000001A0000001A0000001A000000170000000F00000005000000000000 - 00040000000A0000001100000019000000220000002A00000030000000330000 - 003300000033733B03A6633303740000002E0000001D0000000A532E0700522D - 0600522D0600522D0600522D0600522D0600522D0600522D0600522D0600522D - 0600522D06009F5408CC9F5408CC783F065C2917030000000000A75C0E99A65B - 0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B - 0DCCA65B0DCCA65B0DCCFFB508FFA65B0DCCA75C0E5C824A0E00AF6414CCF9C6 - 60FFFFBE23FFFFBD1FFFFFBC1CFFFFBB19FFFFBA16FFFFB914FFFFB811FFFFB7 - 0FFFFFB70DFFFFB60BFFFFB200FFFFB609FFAF6414CCAF641448B96E1BCCF6CB - 7FFFF8C051FFF9BD36FFF8B92CFFF5AC10FFF5AB0EFFF5AC10FFF6B11BFFF7B5 - 23FFF7B523FFF7B421FFF5AB0EFFF6B11BFFB96E1BCCB96E1B48C1762199C277 - 22CCC27722CCC27722CCD5973FE0E3A538FEE4A533FFE2A743EFCF8C32D9C57C - 26CFC27722CCC27722CCE6A93CFFC27722CCC176215CBB701C00C2772200C479 - 2400CC812A2BD38E38CEF0BF71FBE0A856FFDCA04CE4CC8129AACB80283FC97E - 270FC77C2600CC8129CCCC8129CCCB80285CC2772200BB701C00CD822A00D58A - 3000D58A307BEBB865E8F7C579FFF0C070EFD58A30AAD0852D13CC812900C97E - 2700D2872E00D4892F99D4892F5CCC812900C2772200BB701C00DD923600DD92 - 3600DD9236AAF8D081F6FCD185FFE7A951D9DC91363FDB903500CC812900C97E - 2700D2872E00D58A3000D58A3000CC812900C2772200BB701C00E4993B00E499 - 3B00E4993BC5FEDF92FDFFDF93FFE69E42CFE4993B0FE4993B00E4993B00D085 - 2D00D2872E00D58A3000D58A3000CC812900C2772200BB701C00E89D3E00E89D - 3E00E99E3F99E99E3FCCE99E3FCCE99E3F85E59A3C00E59A3C00E59A3C00D78C - 3200D2872E00D58A3000D58A3000CC812900C2772200BB701C00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 10 - OnClick = miDownloadMergeCompletedClick - end - object MenuItem1: TMenuItem - Caption = '-' - end - object miDownloadViewMangaInfo: TMenuItem - Caption = 'View manga info' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000030000 - 0013000000260000003205050542090909650B0B0B7A0B0B0B880B0B0B880B0B - 0B7A090909650505054200000032000000270000001300000003000000020000 - 000A0707071C1313135D3D3A3A93B2A6A6DCEBDADAFFEBDADAFFEBDADAFFEBDA - DAFFB2A6A6DC3D3A3A931313135D0707071D0000000A00000002171717002121 - 21092626265C807979AFE4D6D6FFC69689FFAD644EFF943312FF943312FFAD64 - 4EFFC69689FFE3D6D6FF7F7979AF2626265C2121210917171700303030002F2F - 2F48827E7EACDBD1D1FFAC573CFFB6461FFFD6592AFFE56230FFE56230FFD659 - 2AFFB6461FFFAC573CFFDACFCFFF817C7CAC2F2F2F4830303000343434195351 - 5186D4CECEFFB35F44FFC9572FFFE16132FFD3592DFFEDEDEDFFEEEEEEFFD359 - 2DFFE15F30FFC8532AFFB35F44FFD0C9C9FF515050863434341937373747ACAA - AAD7C09789FFBF5631FFD85F33FFD55A2DFFCB542AFFE2E2E2FFEDEDEDFFCB54 - 2AFFD55A2DFFD55A2DFFBC4F29FFBF9588FFA29F9FD7373737473A3A3A61D0CF - CFFFB9745DFFCF643EFFC9542AFFC9542AFFC25028FFD6D6D6FFE2E2E2FFC250 - 28FFC9542AFFC9542AFFC5542CFFB9745DFFC2C0C0FF3A3A3A613E3E3E6ECCCC - CCFFB95737FFD5714DFFBF502AFFBD4E27FFB94B26FFCDCDCDFFD6D6D6FFB94B - 26FFBD4E27FFBD4E27FFC1542EFFB95737FFC0C0C0FF3E3E3E6E4242426CCFCF - CFFFBC5B3BFFDD7D5BFFC96240FFBD5330FFB24925FFCCCCCCFFCDCDCDFFB148 - 24FFB34925FFB34925FFBD5532FFBC5B3BFFC3C3C3FF4242426C4545455CDBDC - DCFFC07C65FFDF805EFFCF6947FFCF6947FFCA6442FFAE4826FFAC4523FFB049 - 27FFAD4624FFAD4624FFC3603EFFC07C65FFCBCCCCFF4545455C48484842BEBF - BFD4C9A295FFD57452FFE2815FFFD87250FFCD6745FFFFFFFFFFFFFFFFFFCD67 - 45FFD87250FFDF7C5AFFD16E4CFFC7A194FFB2B3B3D4484848424B4B4B176C6C - 6C7CDFE0E0FFC8755AFFE28361FFEB8A68FFD56F4DFFFFFFFFFFFFFFFFFFD56F - 4DFFEA8866FFDF7E5CFFC8755AFFD8D8D8FF6969697C4B4B4B174E4E4E004E4E - 4E3F9D9D9DA2DFDFDFFFCB795EFFDB7A58FFEE906EFFF49674FFF49573FFED8E - 6CFFDA7856FFCB795EFFDBDCDCFF999999A24E4E4E3F4E4E4E004F4F4F005050 - 50075151514D9F9F9FA1E6E6E6FFD7B0A3FFD08C75FFCD6C4BFFCD6C4BFFD08C - 75FFD6AFA2FFE3E4E4FF9D9D9DA15151514D505050074F4F4F004F4F4F005050 - 5000525252075353533D73737378C8C8C8D2EAEAEAFFE6E6E6FFE6E6E6FFEAEA - EAFFC7C7C7D2727272785353533D52525207505050004F4F4F004F4F4F005050 - 50005252520053535300545454155555553E5555555555555563555555635555 - 55555555553E545454155353530052525200505050004F4F4F00 - } - ImageIndex = 0 - OnClick = miDownloadViewMangaInfoClick - end - object miDownloadOpenFolder: TMenuItem - Caption = 'Open Folder' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF - F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF - EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 - F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 - F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB - F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 - F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 - F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 - FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 - FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED - FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC - DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 - FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 - FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 - CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 - F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 - CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 - CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 4 - OnClick = miDownloadOpenFolderClick - end - object miDownloadOpenWith: TMenuItem - Caption = 'Open ...' - Enabled = False - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 00000000000000000000000000100000001A0000001000000000000000000000 - 00000000000000000000000000000000000000000000000000001007000F220E - 00352A110048000000620000008F000000ED0000008F000000622A110048200D - 003A130800300703002A050200290502002906030023020100095322009A8550 - 27D78E623DDF67655AF7ACAA9AFD9B9B8AFFACAA9AFD67655AF78E623DDF8550 - 27D7793D12D0703104CC6F2F02CB6F2F02CB6F2F02CB5322009A793400C0C5C5 - B7FFCECEC1FFDDDDD0FFE7E7D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5 - B4FFBEBEAEFFBBBBAAFFBBBBAAFFBBBBAAFFBBBBAAFF793400C0873E00B5FFFF - FEFFF9F9F4FFF1F1E7FFE9E9DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6 - EAFFF8F8EFFFFBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFF873E00B58D4200B0FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFF8D4200B0914500ADFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBE - ADFFD2D2C1FFC4C4B3FFD9D9C8FFDCDCCBFFFFFFFEFF914500AD954700AAFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF954700AA994A00A7FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168B - A9FF1EA8C0FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFF994A00A79C4C00A4FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6 - DFFF49E0F1FFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF9C4C00A4A04E00A2FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1 - D3FF18B2D3FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFFA04E00A2A351009FFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA351009FA652009DFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBE - ADFFD2D2C1FFCDCDBCFFFBFBF6FFFDFDFAFFFFFFFEFFA652009DA854009BFEFE - FDFFF8F8F3FFF1F1E7FFE9E9D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA854009BAA55009AF6F6 - F3EBE8E8DDD7C9C9B2B49C9C78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEF - E2EBF6F6ECF9FBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFFAA55009A7F7F55497F7F - 55577F7F55497F7F552E7F7F550E7F7F55007F7F550E7F7F552E7F7F55497F7F - 55577F7F55617F7F55667F7F55667F7F55667F7F55667F7F554D - } - ImageIndex = 11 - OnClick = miDownloadOpenWithClick - end - end - object pmChapterList: TPopupMenu - left = 616 - top = 392 - object miChapterListCheckSelected: TMenuItem - Caption = 'Check selected' - OnClick = miChapterListCheckSelectedClick - end - object miChapterListUncheckSelected: TMenuItem - Caption = 'Uncheck selected' - OnClick = miChapterListUncheckSelectedClick - end - object miI1: TMenuItem - Caption = '-' - end - object miChapterListCheckAll: TMenuItem - Caption = 'Check all' - OnClick = miChapterListCheckAllClick - end - object miChapterListUncheckAll: TMenuItem - Caption = 'Uncheck all' - OnClick = miChapterListUncheckAllClick - end - object MenuItem6: TMenuItem - Caption = '-' - end - object miChapterListHighlight: TMenuItem - Caption = 'Highlight download chapters' - OnClick = miChapterListHighlightClick - end - end - object pmFavorites: TPopupMenu - Images = IconList - OnPopup = pmFavoritesPopup - left = 616 - top = 432 - object miFavoritesCheckNewChapter: TMenuItem - Caption = 'Check for new chapter' - ImageIndex = 21 - OnClick = miFavoritesCheckNewChapterClick - end - object miFavoritesStopCheckNewChapter: TMenuItem - Caption = 'Stop check for new chapter' - ImageIndex = 7 - OnClick = miFavoritesStopCheckNewChapterClick - end - object miFavoritesViewInfos: TMenuItem - Caption = 'View manga info' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0001000000050000000A0000000E0000001120140D214936273544312233160C - 061E000000110000000F0000000B000000060000000200000000B87E51000503 - 02000000000200000004301C0F0C91745D62BBA087C4CFB59EE6CFB7A2E3BBA4 - 91BC9278645C321E0F0D000000040000000200000000000000007B55391F825F - 44305E423304421A0005A9896D7CDABC9DF4F1D3B5FFF4DBC1FFEBD5C0FDE0CC - BAF6D2BEAEF0B0978389734B2E0B8562470000000000000000007B573C2AAD8A - 69CAB6916D9D9E7D617DD7B696F1F0D0ADFFF0D4B6FFD5BCA4DFAB8F796E9778 - 6137AE958058B09784BB92725A760600000178523500000000001E000005B48E - 69A8DEAF7DFFDBB58CFDECC9A3FEEFD0AEFFD6BBA1E69C7D6643FFFADF004422 - 1100A281650086654C187F5A3F88775134307852350000000000B69372009D78 - 5961D8AC7BFDEBC295FFEDCAA5FFEED1B1FFC8AE95D99E7F674E805D410DC5B0 - 9E0077513400754F3100744D3019765033407A54370178523500845F4300805C - 4025C9A37BE2EDC69CFFEECDA9FFEFD2B3FFE8CFB6FFCAB29DE891725987693F - 20120600000178563D1697775D3D8A674C3F5D33140277513400754E31002400 - 0005B39272AAD9B895FBCFB193DCC1A58BAFAF927A799A7B63599A7B6356AF92 - 7A71C1A58BA4CEB194D3D9B897F6B99778B34720060776503300775134000000 - 000089664A4098785D4A7F5D441E3B1B0B046339190C8F6F5679C9B19CE3E7CF - B7FFEFD3B5FFEFCEABFFEDC89EFFCEA880E68763462B8A66480078523500653C - 1E0076503339744D301E754F32007751340096765D007E5A3E099E7F6745C7AD - 95D1EED1B2FFEECCA7FFEBC498FFDBAE7EFEA27D5D66C39F7C00000000007852 - 350077503324805C40888A6A511EB3947800371A0D00EFD6BC009B7D663AD5BA - A1DFF0D1B0FFEDCBA5FEDEB890FDDFB17EFFB8916BAA27060005000000007852 - 3500FFFFFF0094745C67B29A87BEB39A875E9B7D6638AD927B6AD6BDA6DAF0D4 - B8FFF1D1AEFFDBBA9AF3A5836783BA95709FB38F6ECC7E5A3F2A000000000000 - 0000815D4200663D1D07B096827CD3BFAFEEE1CDBCF7EBD5C1FDF4DBC2FFF1D4 - B6FFDCBEA0F5AE8E72814F280E0665493905866449347C573A21000000000000 - 000000000000704A2F00532A0E04A3877049C5AD99ABD5BDA8D8D6BCA4DDC7AA - 91B9A5856C59603C230776533900785235007852350078523500000000000000 - 000000000000000000000000000089542E004F2B15077C583E1D826046216341 - 290CFFFFFF000901000000000000000000000000000000000000 - } - ImageIndex = 0 - SubMenuImages = IconList - OnClick = miFavoritesViewInfosClick - end - object miFavoritesDownloadAll: TMenuItem - Caption = 'Download all' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C0D0D0D581212128512121285121212851212128512121285121212851212 - 12851212128512121285121212850D0D0D580000002C00000012000000090000 - 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 - C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B - 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 - 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 - 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD - DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D - 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 - B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F - 4F005151510D5454545A54545467545454675454546754545467545454675454 - 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F - 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 - 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F - 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 - 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F - 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 - 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F - 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 - 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F - 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD - 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 - 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 - 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 - 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E - 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 - 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 - 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E - 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E - 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 - } - ImageIndex = 1 - OnClick = miFavoritesDownloadAllClick - end - object MenuItem7: TMenuItem - Caption = '-' - end - object miFavoritesDelete: TMenuItem - Caption = 'Delete' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 000E00000014000000190000001900000016000000100000000B000000080000 - 0007000000080000000B0000000E0000001100000013FFFFFF00FFFFFF000000 - 001C0000325E000059CC000057BC0000164200000020000000160000000F0000 - 000D00000010000000150000001B00001D3800002D4CFFFFFF00FFFFFF000000 - 180000005FCC1111DBFE0C0CAFEC00005F8B0000190000000000000000000000 - 000000000000000000000000320000005F7300004832FFFFFF00FFFFFF000000 - 66000000668C0A0A9FE51212DDFF030378D30000673300005100000000000000 - 00000000380000006A00000066840000668900006404FFFFFF00FFFFFF000000 - 6C0000006D1F00006ECC1515D1FB1111C3F400006EB400007011000070000000 - 78000000720000006E8200006EB800006D4100006C00FFFFFF00FFFFFF000000 - 700000007000000075670D0D96DC1717CCFF0F0FA2E50000777500007E000000 - 7A000000769104048AD5000076860000730000007200FFFFFF00FFFFFF000000 - 78000000780000007B0000007E911515A6E51D1DBEFD07078AD400007F630000 - 7EAE0A0A94DC00007EB600007A000000780000007800FFFFFF00FFFFFF000000 - 8000000080000000800000008215000086B01A1AA8E72222B4F907078ED21414 - 9FE105058DD20000820000007C000000780000007800FFFFFF00FFFFFF000000 - 9F0000009E00000098000000900000008D3300008ECC3131BCF33333BCFA0909 - 97D400008E0000008F0000008E0000008E000000A500FFFFFF00FFFFFF000000 - 9F0000009E00000098330000968A000096CC4141CDEE5151D9FD2727B7E32F2F - BEE3000096B100009A1800009F000000A4000000A500FFFFFF00FFFFFF000000 - 9F0000009F6600009ECC3737C9E56262EAFF5858E3FA1616AFD600009A330E0E - A99F2828BEDD00009EB400009F1F0000A4000000A500FFFFFF00FFFFFF000000 - A4000000A4CC7474FCFF6B6BF4FE3636CDE50000A4CC0000A10000009A000000 - 9E000000A3890606A8CF0000A4BD0000A54A0000A501FFFFFF00FFFFFF000000 - A8000000A9480000A9CC0000A9CC0000A9930000A7000000A20000009A000000 - 9E000000A4000000A82B0000A97E0000A9B00000A966FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 9 - SubMenuImages = IconList - OnClick = miFavoritesDeleteClick - end - object miFavoritesChangeCurrentChapter: TMenuItem - Caption = 'Change "Current chapter"' - Visible = False - OnClick = miFavoritesChangeCurrentChapterClick - end - object miFavoritesChangeSaveTo: TMenuItem - Caption = 'Change "Save to"' - OnClick = miFavoritesChangeSaveToClick - end - object MenuItem3: TMenuItem - Caption = '-' - end - object miFavoritesOpenFolder: TMenuItem - Caption = 'Open Folder' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00478BE6FF5191E5FF5191E5FF5191E5FF5191E5FF5191E5FF5191E5FF5191 - E5FF5191E5FF5191E5FF5191E5FF478BE6FFFFFFFF00FFFFFF00FFFFFF002784 - F7FF429BFFFF469DFFFF469DFFFF469DFFFF469DFFFF469DFFFF469DFFFF469D - FFFF469DFFFF469DFFFF469DFFFF429BFFFF2784F7FFFFFFFF00FFFFFF002479 - FFFF387AFFFF377BFFFF377BFFFF377BFFFF377BFFFF377BFFFF377BFFFF377B - FFFF377BFFFF377BFFFF377BFFFF387AFFFF2479FFFFFFFFFF00FFFFFF002173 - FFFF3B87FFFF3B87FFFF3B87FFFF3B87FFFF3B87FFFF3B87FFFF3B87FFFF3B87 - FFFF3B87FFFF3B87FFFF3B87FFFF3B87FFFF2172FFFFFFFFFF00FFFFFF002279 - FFFF3D8DFFFF3B8CFFFF3B8CFFFF3B8CFFFF3B8CFFFF3B8CFFFF3B8CFFFF3B8C - FFFF3B8CFFFF3B8CFFFF3B8CFFFF3D8DFFFF2279FFFFFFFFFF00FFFFFF002482 - FFFF3E95FFFF3D94FFFF3D94FFFF3D94FFFF3D94FFFF3D94FFFF3D94FFFF3D94 - FFFF3D94FFFF3D94FFFF3D94FFFF3E95FFFF2482FFFFFFFFFF00FFFFFF002488 - FFFF3E9BFFFF3D9AFFFF3D9AFFFF3D9AFFFF3D9AFFFF3D9AFFFF3D9AFFFF3D9A - FFFF3D9AFFFF3D9AFFFF3D9AFFFF3E9BFFFF2488FFFFFFFFFF00FFFFFF002690 - FFFF40A2FFFF3FA1FFFF3FA1FFFF3FA1FFFF3FA1FFFF3FA1FFFF3FA1FFFF3FA1 - FFFF3FA1FFFF3FA1FFFF3FA1FFFF40A2FFFF2690FFFFFFFFFF00FFFFFF002697 - FFFF40A9FFFF3FA8FFFF3FA8FFFF3FA8FFFF3FA8FFFF3FA8FFFF3FA8FFFF3FA8 - FFFF3FA8FFFF3FA8FFFF3FA7FFFF40A8FFFF2697FFFFFFFFFF00FFFFFF0029A0 - FFFF42B0FFFF41AFFFFF41AFFFFF41AFFFFF41B0FFFF41B0FFFF41AFFFFF41B0 - FFFF41B0FFFF41B0FFFF41B1FFFF43B2FFFF26A2FFFFFFFFFF00FFFFFF002AA6 - FFFF42B6FFFF41B5FFFF41B5FFFF41B6FFFF41B7FFFF45BAFFFF3EBBFFFF3FBD - FFFF3FBEFFFF3FBEFFFF3FBEFFFF3BBEFFFF2BA8FFFFFFFFFF00FFFFFF002BAD - FFFF43BDFFFF43BCFFFF43BCFFFF42BCFFFF45C1FFFF2CB1FFFF73CDFFFF6DCC - FFFF6DCCFFFF6DCCFFFF6DCCFFFF61C9FFFFFFFFFF00FFFFFF00FFFFFF002BB4 - FFFF44C2FFFF43BFFFFF43BFFFFF43C1FFFF46C6FFFF1CB0FFFFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002ABC - FFFF47D0FFFF47CEFFFF47CEFFFF49CFFFFF3FCBFFFF2BB8FFFFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF002EC9FFFF3BCCFFFF3BCCFFFF38CCFFFF45CCFFFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 4 - SubMenuImages = IconList - OnClick = miFavoritesOpenFolderClick - end - object miFavoritesOpenWith: TMenuItem - Caption = 'Open ...' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000000000 - 00000000000000000000000000100000001A0000001000000000000000000000 - 00000000000000000000000000000000000000000000000000001007000F220E - 00352A110048000000620000008F000000ED0000008F000000622A110048200D - 003A130800300703002A050200290502002906030023020100095322009A8550 - 27D78E623DDF67655AF7ACAA9AFD9B9B8AFFACAA9AFD67655AF78E623DDF8550 - 27D7793D12D0703104CC6F2F02CB6F2F02CB6F2F02CB5322009A793400C0C5C5 - B7FFCECEC1FFDDDDD0FFE7E7D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5 - B4FFBEBEAEFFBBBBAAFFBBBBAAFFBBBBAAFFBBBBAAFF793400C0873E00B5FFFF - FEFFF9F9F4FFF1F1E7FFE9E9DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6 - EAFFF8F8EFFFFBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFF873E00B58D4200B0FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFF8D4200B0914500ADFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBE - ADFFD2D2C1FFC4C4B3FFD9D9C8FFDCDCCBFFFFFFFEFF914500AD954700AAFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF954700AA994A00A7FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168B - A9FF1EA8C0FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFF994A00A79C4C00A4FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6 - DFFF49E0F1FFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF9C4C00A4A04E00A2FEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1 - D3FF18B2D3FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFFA04E00A2A351009FFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA351009FA652009DFEFE - FDFFF8F8F3FFF0F0E6FFE9E9DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBE - ADFFD2D2C1FFCDCDBCFFFBFBF6FFFDFDFAFFFFFFFEFFA652009DA854009BFEFE - FDFFF8F8F3FFF1F1E7FFE9E9D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4 - E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA854009BAA55009AF6F6 - F3EBE8E8DDD7C9C9B2B49C9C78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEF - E2EBF6F6ECF9FBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFFAA55009A7F7F55497F7F - 55577F7F55497F7F552E7F7F550E7F7F55007F7F550E7F7F552E7F7F55497F7F - 55577F7F55617F7F55667F7F55667F7F55667F7F55667F7F554D - } - ImageIndex = 11 - OnClick = miFavoritesOpenWithClick - end - end - object pmMangaList: TPopupMenu - Images = IconList - OnPopup = pmMangaListPopup - left = 128 - top = 272 - object miMangaListViewInfos: TMenuItem - Caption = 'View manga infos' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF000000 - 0000000000020000000E000000180000001A0000001A0000001A0000001A0000 - 001A0000001A00000019000000100000000300000000FFFFFF00FFFFFF000000 - 0000000000040000001B481F1546B24C3399E96443D4EE6644F5EE6644F5E964 - 43D4B24C3399471F15470000001F0000000600000000FFFFFF00FFFFFF007432 - 210077332200B34D3360EF6F4FEBF5A28FFFFAD1CAFFFCE7E5FFFCE6E5FFF9D1 - C9FFF4A18EFFEF6E4EEBB34D33603C1A110000000000FFFFFF00FFFFFF00E863 - 4100EE664460EF7659F9F7D4CEFFF7E9E9FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8 - E8FFF7E9E9FFF6D1CAFFEF7658F9EE664460E8634100FFFFFF00FFFFFF00E360 - 3E20E66A4AEBF3D3CDFFF0E5E5FFEFE4E4FFEFE4E4FFE5613FFFE5613FFFEFE4 - E4FFEFE4E4FFEFE4E4FFEFCDC7FFE66A4AEBE3603E20FFFFFF00FFFFFF00D659 - 3787E59D8AFFEAE2E2FFE7DFDFFFE7DFDFFFE7DFDFFFD65937FFD65937FFE7DF - DFFFE7DFDFFFE7DFDFFFE8E0E0FFE19784FFD6593787FFFFFF00FFFFFF00C550 - 2ED0EAD0C8FFE1DADAFFE0D9D9FFE0D9D9FFE0D9D9FFC5502EFFC5502EFFE0D9 - D9FFE0D9D9FFE0D9D9FFE0D9D9FFE1C4BDFFC5502ED0FFFFFF00FFFFFF00B748 - 26F5F4EEEDFFE7E5E5FFDAD6D6FFD8D4D4FFD8D4D4FFB74826FFB74826FFD8D4 - D4FFD8D4D4FFD8D4D4FFD8D4D4FFE1D8D6FFB74826F5FFFFFF00FFFFFF00AD44 - 22F5F4EFEDFFEEEEEEFFEAEAEAFFDCDBDBFFD3D1D1FFAD4422FFAD4422FFD2D0 - D0FFD2D0D0FFD2D0D0FFD2D0D0FFDFD8D7FFAD4422F5FFFFFF00FFFFFF00AB46 - 24D0EAD5CDFFF0F0F0FFF0F0F0FFF0F0F0FFEBEBEBFFE9E9E9FFE7E6E6FFD2D1 - D1FFCECECEFFCECECEFFD2D1D1FFDCC7C0FFAB4624D0FFFFFF00FFFFFF00B34F - 2D87D49D8AFFF5F5F5FFF3F3F3FFF3F3F3FFF3F3F3FFB34F2DFFB34F2DFFF3F3 - F3FFF3F3F3FFF3F3F3FFF5F5F5FFD49C89FFB34F2D87FFFFFF00FFFFFF00BF5C - 3A20C56747EBF2DFD9FFF8F8F8FFF7F7F7FFF7F7F7FFC15D3BFFC15D3BFFF7F7 - F7FFF7F7F7FFF8F8F8FFF2DFD9FFC56747EBBF5C3A20FFFFFF00FFFFFF00C461 - 3F00CF6B4960D77F61F9F6E3DCFFFCFCFCFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB - FBFFFCFCFCFFF6E3DCFFD77F61F9CF6B4960C4613F00FFFFFF00FFFFFF00C461 - 3F00D16D4B00DF7A5860E38464EBEFB7A4FFFAE4DDFFFEF9F7FFFEF9F7FFFAE4 - DDFFEFB7A4FFE38464EBDF7A5860D16D4B00C4613F00FFFFFF00FFFFFF00C461 - 3F00D16D4B00E17C5A00EA846220EC866487EC8664D0EC8664F5EC8664F5EC86 - 64D0EC866487EA846220E17C5A00D16D4B00C4613F00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 13 - SubMenuImages = IconList - OnClick = miMangaListViewInfosClick - end - object miMangaListDownloadAll: TMenuItem - Caption = 'Download all' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000818181007F7F - 7FFF7C7C7CFF7A7A7AFF787878FF777777FF757575FF767676FFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00868686FFBFBF - BFFFBDBDBDFFBCBCBCFFBBBBBBFFBBBBBBFFBABABAFF81818100FFFFFF00FFFF - FF002A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008A8A8AFFC0C0 - C0FFB0B0B0FFB0B0B0FFB0B0B0FFB1B1B1FFC0C0C0FF989898FFFFFFFF002A89 - 27FF3F993CFF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF008E8E8EFFC2C2 - C2FFD2D2D2FFD2D2D2FFD3D3D3FFD6D6D6FFCCCCCCFFD7D7D7FF2A8927FF419B - 3DFF61B45DFF419B3DFF2A8927FFFFFFFF00FFFFFF00FFFFFF00939393FFC4C4 - C4FFD2D2D2FFD3D3D3FFD6D6D6FFDDDDDDFFDDDDDDFF2A8927FF429C3FFF65B8 - 61FF65B861FF65B861FF429C3FFF2A8927FFFFFFFF00FFFFFF00979797FFC6C6 - C6FFD2D2D2FFD4D4D4FFDADADAFFE6E6E6FF2A8927FF449E41FF6ABB66FF69BB - 65FF69BB65FF69BB65FF6ABB66FF449E41FF2A8927FFFFFFFF009C9C9CFFC9C9 - C9FFC7C7C7FFCACACAFFD4D4D4FF2A8927FF5DAA5BFFA7D9A5FFA7D9A5FF8FCE - 8CFF6DBF69FF8FCE8CFFA7D9A5FFA7D9A5FF5DAA5BFF2A8927FFA0A0A0FFCBCB - CBFFC9C9C9FFCBCBCBFFD4D4D4FF2A8927FF2A8927FF2A8927FF2A8927FF5FAB - 5CFF72C36EFF5FAB5CFF2A8927FF2A8927FF2A8927FF2A8927FFA4A4A4FFCCCC - CCFFCBCBCBFFCCCCCCFFD1D1D1FFD7D7D7FFDCDCDCFFC9C9C9FFFFFFFF002A89 - 27FF76C772FF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00A8A8A8FFCECE - CEFFB0B0B0FFB1B1B1FFB4B4B4FFB7B7B7FFCECECEFFB1B1B1FFFFFFFF002A89 - 27FF79CA75FF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00ACACACFFD0D0 - D0FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFCACACAFFA7A7A7FFFFFFFF002A89 - 27FF7CCE79FF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00AFAFAFFFD2D2 - D2FFB0B0B0FFB0B0B0FFB0B0B0FFB0B0B0FFCCCCCCFFABABABFFFFFFFF002A89 - 27FF7FD17BFF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00B2B2B2FFD2D2 - D2FFD2D2D2FFD2D2D2FFD2D2D2FFD2D2D2FFCDCDCDFFADADADFFFFFFFF002A89 - 27FFB3E5B1FF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00B4B4B4FFD4D4 - D4FFD3D3D3FFD2D2D2FFD2D2D2FFD1D1D1FFD0D0D0FFAEAEAEFFFFFFFF002A89 - 27FF2A8927FF2A8927FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00B4B4B4FFD4D4 - D4FFD4D4D4FFD4D4D4FFD2D2D2FFD2D2D2FFD1D1D1FFAEAEAEFFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B4B4B4FFB4B4 - B4FFB4B4B4FFB4B4B4FFB2B2B2FFB1B1B1FFAFAFAFFFAEAEAEFFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ImageIndex = 1 - SubMenuImages = IconList - OnClick = miMangaListDownloadAllClick - end - object miMangaListAddToFavorites: TMenuItem - Caption = 'Add to Favorites' - Bitmap.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0058B754FF5AB856FFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF001DB31BFF04C302FF03C200FF1EB31EFFFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF0041BB42FF08BF09FF1EB720FF1EB720FF06BE08FF42BB44FFFFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF0020B828FF08C313FF20B929FF1EBD28FF1EBB27FF20BA29FF08C313FF21B8 - 29FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0045C1 - 50FF0AC71CFF20BD2EFF1FBF2DFF1FC02FFF1FC02EFF1FBE2EFF20BE2EFF0AC6 - 1BFF43BF4FFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0003BF - 1CFF23C238FF21C337FF21C338FF21C338FF21C338FF21C437FF21C137FF23BF - 38FF0CCA25FF23BE37FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0027BF - 42FF11C331FF24CA42FF22C63FFF21C53FFF21C63FFF21C63FFF21C63FFF21C4 - 3EFF22C33FFF0CCE2FFF43C45BFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF0022C547FF11C73BFF26CE4DFF24CB49FF23CA49FF23C949FF23CA49FF23CA - 4AFF24CB4AFF26C74BFF10D23CFF22C346FFFFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF0023C84FFF14CD45FF27D152FF25CD50FF25CD50FF25CF51FF28D5 - 55FF14D045FF00C032FF16C644FF11D644FF4DCD6EFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF0025CB59FF16CE4EFF29D45DFF27D15AFF29D75FFF0AC8 - 45FF79E19AFFFFFFFF006FDC90FF18C34CFF11CC4AFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF0027CF60FF19D357FF2AD865FF21D35DFF2BC8 - 60FFFFFFFF00FFFFFF00FFFFFF004DD27AFF11C24DFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0028D168FF19D660FF20D465FF35BD - 69FFFFFFFF00FFFFFF00FFFFFF0056C880FF14C557FFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0029D46DFF1AD464FF11CF - 5CFF9BCEAFFFFFFFFF0091CFAAFF1BC960FF19C75EFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0029D674FF15D5 - 69FF04E765FF00EC63FF07E767FF19DE6FFF1FD16BFFFFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0075E7 - A8FF5CE79AFF60ED9FFF5FE89CFF5AE598FFFFFFFF00FFFFFF00 - } - ImageIndex = 2 - SubMenuImages = IconList - OnClick = miMangaListAddToFavoritesClick - end - object miI2: TMenuItem - Caption = '-' - end - object miHighlightNewManga: TMenuItem - Caption = 'Highlight new manga' - OnClick = miHighlightNewMangaClick - end - end - object TrayIcon: TTrayIcon - BalloonFlags = bfInfo - BalloonTimeout = 5000 - BalloonTitle = 'Free Manga Downloader' - Hint = 'Free Manga Downloader' - OnDblClick = TrayIconDblClick - left = 32 - top = 448 - end - object pmUpdate: TPopupMenu - ParentBidiMode = False - left = 128 - top = 144 - object mnUpdateList: TMenuItem - Caption = 'Update manga list' - OnClick = mnUpdateListClick - end - object mnUpdateDownFromServer: TMenuItem - Caption = 'Download manga list from server' - OnClick = mnUpdateDownFromServerClick - end - object MenuItem5: TMenuItem - Caption = '-' - end - object mnUpdate1Click: TMenuItem - Caption = 'Update all lists at once' - OnClick = mnUpdate1ClickClick - end - object mnDownload1Click: TMenuItem - Caption = 'Download all lists from server at once' - OnClick = mnDownload1ClickClick - end - end - object itAnimate: TIdleTimer - Enabled = False - Interval = 48 - OnTimer = itAnimateTimer - left = 752 - top = 72 - end - object itCheckForChapters: TIdleTimer - Enabled = False - Interval = 600000 - OnTimer = itCheckForChaptersTimer - left = 760 - top = 256 - end - object itRefreshDLInfo: TIdleTimer - Enabled = False - OnTimer = itRefreshDLInfoTimer - OnStartTimer = itRefreshDLInfoStartTimer - OnStopTimer = itRefreshDLInfoStopTimer - left = 696 - top = 168 - end - object IconList: TImageList - left = 24 - top = 136 - Bitmap = { - 4C691600000010000000100000004F4F4F005050500052525200535353005454 - 54155555553E555555555555556355555563555555555555553E545454155353 - 530052525200505050004F4F4F004F4F4F0050505000525252075353533D7373 - 7378C8C8C8D2EAEAEAFFE6E6E6FFE6E6E6FFEAEAEAFFC7C7C7D2727272785353 - 533D52525207505050004F4F4F004F4F4F00505050075151514D9F9F9FA1E6E6 - E6FFD7B0A3FFD08C75FFCD6C4BFFCD6C4BFFD08C75FFD6AFA2FFE3E4E4FF9D9D - 9DA15151514D505050074F4F4F004E4E4E004E4E4E3F9D9D9DA2DFDFDFFFCB79 - 5EFFDB7A58FFEE906EFFF49674FFF49573FFED8E6CFFDA7856FFCB795EFFDBDC - DCFF999999A24E4E4E3F4E4E4E004B4B4B176C6C6C7CDFE0E0FFC8755AFFE283 - 61FFEB8A68FFD56F4DFFFFFFFFFFFFFFFFFFD56F4DFFEA8866FFDF7E5CFFC875 - 5AFFD8D8D8FF6969697C4B4B4B1748484842BEBFBFD4C9A295FFD57452FFE281 - 5FFFD87250FFCD6745FFFFFFFFFFFFFFFFFFCD6745FFD87250FFDF7C5AFFD16E - 4CFFC7A194FFB2B3B3D4484848424545455CDBDCDCFFC07C65FFDF805EFFCF69 - 47FFCF6947FFCA6442FFAE4826FFAC4523FFB04927FFAD4624FFAD4624FFC360 - 3EFFC07C65FFCBCCCCFF4545455C4242426CCFCFCFFFBC5B3BFFDD7D5BFFC962 - 40FFBD5330FFB24925FFCCCCCCFFCDCDCDFFB14824FFB34925FFB34925FFBD55 - 32FFBC5B3BFFC3C3C3FF4242426C3E3E3E6ECCCCCCFFB95737FFD5714DFFBF50 - 2AFFBD4E27FFB94B26FFCDCDCDFFD6D6D6FFB94B26FFBD4E27FFBD4E27FFC154 - 2EFFB95737FFC0C0C0FF3E3E3E6E3A3A3A61D0CFCFFFB9745DFFCF643EFFC954 - 2AFFC9542AFFC25028FFD6D6D6FFE2E2E2FFC25028FFC9542AFFC9542AFFC554 - 2CFFB9745DFFC2C0C0FF3A3A3A6137373747ACAAAAD7C09789FFBF5631FFD85F - 33FFD55A2DFFCB542AFFE2E2E2FFEDEDEDFFCB542AFFD55A2DFFD55A2DFFBC4F - 29FFBF9588FFA29F9FD7373737473434341953515186D4CECEFFB35F44FFC957 - 2FFFE16132FFD3592DFFEDEDEDFFEEEEEEFFD3592DFFE15F30FFC8532AFFB35F - 44FFD0C9C9FF5150508634343419303030002F2F2F48827E7EACDBD1D1FFAC57 - 3CFFB6461FFFD6592AFFE56230FFE56230FFD6592AFFB6461FFFAC573CFFDACF - CFFF817C7CAC2F2F2F483030300017171700212121092626265C807979AFE4D6 - D6FFC69689FFAD644EFF943312FF943312FFAD644EFFC69689FFE3D6D6FF7F79 - 79AF2626265C2121210917171700000000020000000A0707071C1313135D3D3A - 3A93B2A6A6DCEBDADAFFEBDADAFFEBDADAFFEBDADAFFB2A6A6DC3D3A3A931313 - 135D0707071D0000000A00000002000000030000001300000026000000320505 - 0542090909650B0B0B7A0B0B0B880B0B0B880B0B0B7A09090965050505420000 - 0032000000270000001300000003E99E3F00E99E3F00E99E3F00E99E3F00E99E - 3F00E99E3F00E99E3F33FFE39E40FED18540E99E3F33E99E3F00E99E3F00E99E - 3F00E99E3F00E99E3F00E99E3F00D2872E00D2872E00D2872E00D3892F00E297 - 3A00E2973A00E2973A6AFCDC9884F5BF7385E2973A6AE2973A00E2973A00D389 - 2F00D2872E00D2872E00D2872E00BF752000BF752000BF752000C2782200CB80 - 2900D98E3300D98E33ABF9D591D5EEB367D5D98E33AAD98E3300CB802900C278 - 2200BF752000BF752000BF752000BF752000BF752000BF752000C2782200C57A - 2400C87D2700CE832BCCF1CA83FFD89B4AFFCE832BCCC87D2700C57A2400C278 - 2200BF752000BF752000BF752000BF752000BF752000BF752000C177218FC278 - 22B8C27822B8C27822CCEEC26AFFDE9C2CFFC27822CCC27822B8C27822B8C177 - 218FBF752000BF752000BF752000BA6F1C00BA6F1C00BA6F1C00B96E1B5CC27B - 23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD3FFFF7C554FFC0781FD4B96E - 1B5CBA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F1C00B76C1A00AD62 - 125CB97117D4FECB4DFFFEB714FFFEB102FFFEC02CFFB86F15D4AD62125CB76C - 1A00BA6F1C00BA6F1C00BA6F1C00855F3600855F3600866037009E662800AC61 - 1100A3580B5CB0670ED4FFC53AFFFFBD20FFB0660DD4A3580B5CAC6111009E66 - 280086603700855F3600855F36004F4F4F004F4F4F0051515100555555006A58 - 44008E561D009B50055CA95F07D3A95F06D39B50055C8E561D006A5844005555 - 5500515151004F4F4F004F4F4F004F4F4F004F4F4F0051515100555555005555 - 5500555555006653410075502B1F75502B1F6653410055555500555555005555 - 5500515151004F4F4F004F4F4F004F4F4F004F4F4F005151510D5454545A5454 - 5467545454675454546754545467545454675454546754545467545454675454 - 545A5151510D4F4F4F004F4F4F004D4D4D004D4D4D004D4D4D5DC3C3C3DAD1D1 - D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3B3FFB9B3B3FFBFB3B3FFB5A9 - A9DA4D4D4D5D4D4D4D004D4D4D0033333300434343004343436EFAFAFAFFF8F8 - F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDDDDFFE2DDDDFFD7CCCCFFE8D9 - D9FF4343436E4343430033333300000000002B2B2B0038383873E9E9E9FFB0B0 - B0FF858585FF7E7F7FFF787979FF787777FF7E7777FF857777FF66FF66FFD7C8 - C8FF383838732B2B2B000000000000000009000000162A2A2A7AB3B3B3DFDBDB - DBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4C4FFC9C4C4FFC6BBBBFFA59A - 9ADF2A2A2A7A0000001600000009000000120000002C0D0D0D58121212851212 - 1285121212851212128512121285121212851212128512121285121212851212 - 12850D0D0D580000002C00000012000000000000000000000000000099000000 - 2B00000000000000000001016E000101DE000101E1000101E3000101E53C0101 - E5AB0101E53C0101E3000101E100000000000000000000000000000099000000 - 2B0001016B000101D9000101DC000101DE000101E1000101E33C0101E3AC8686 - FFFF0101E3AC0101E33C0101E1000000000000000000000000000101B4000101 - D2000101D5000101D9000101DC000101DE000101E13D0101E1AD8484FFFF7474 - FDFF8686FFFF0101E1AD0101E13D00000000010164000101CB000101CE000101 - D2000101D5000101D9000101DC000101DE3E0101DEAE8181FFFF7171FCFF7373 - FDFF7474FDFF8686FFFF0101DEAE0101C3000101C7000101CB000101CE000101 - D2000101D5000101D9000101DC3E0101DCAF7E7EFFFF6F6FFBFF7070FCFF7171 - FCFF8484FFFF0101DCAF0101DC3E0101C3000101C7000101CB000101CE000101 - D2000101D5000101D93E0101D9B17B7BFFFF6C6CF9FF6D6DFAFF6F6FFBFF8181 - FFFF0101D9B10101D93E0101DC000101C3000101C7000101CB000101CE000101 - D2000101D53F0101D5B27878FFFF6868F8FF6A6AF9FF6C6CF9FF7E7EFFFF0101 - D5B20101D63E0101D9000101DC000101C3000101C7000101CB000101CE000101 - D23F0101D2B37575FFFF6565F6FF6767F7FF6868F8FF7B7BFFFF0101D2B30101 - D33F0101D5000101D9000101DC000101C3000101C7000101CB000101CE400101 - CEB57171FFFF6262F4FF6464F5FF6565F6FF7878FFFF0101CEB5062C9B3F1080 - 350015A9000014A80000129D00000101C3000101C7000101CB400101CBB66E6E - FFFF5F5FF3FF6060F4FF6262F4FF7575FFFF0101CBB60101CC4015A9009915A9 - 00CC15A9009914A80000129D00000101C3000101C7410101C7B86C6CFFFF5C5C - F1FF5D5DF2FF5F5FF3FF7171FFFF0101C7B8062996410F79330014A400CC75EE - 64FF14A400CC13A10000129D00000101C3410101C3B96969FFFF6262F8FF5F5F - F5FF5C5CF1FF6E6EFFFF0101C3B90101C441129C0099129D00CC129D00CC66EB - 55FF129D00CC129D00CC129C00990101BFBB0101BFBB0101BFBB0101BFBB6262 - F8FF6C6CFFFF0101BFBB0101C042094B6100109500CC52E741FF52E741FF52E7 - 41FF52E741FF52E741FF109500CC01018F0001015F0001018C000000B6BF6969 - FFFF0000B6BF0000B84301016000074700000E8D00990E8C00CC0E8C00CC3DE2 - 2CFF0E8C00CC0E8C00CC0E8D0099000000030000000F000000190000A8C50000 - A8C500006D580000001600000013000000110000000F0000000C0C8200CE2BDF - 1AFF0C8200CD0000000300000001000000050000001E0000003200009CC90000 - 54630000002E0000002B00000026000000220000001D00000018054F00A10568 - 00CF0550009D0000000500000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 - A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 - A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 - AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 - A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B - E8F65F5FE7FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5F5FE7FF5858E4F60F0F - B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 - D9FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF5050D8FF4F4F - DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 - CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4747 - CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 - BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616A0FF12129CFF12129CFF1616 - A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFFF8F8 - F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8E8FFEEEEEEFFEEEEEEFF1111 - A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FFD0D0 - D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEEEEFFEEEEEEFFEEEEEEFF1111 - AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 - A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111 - B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 - BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111 - BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 - C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF0F0F - BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 - C4F61212D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF0F0FC2F60303 - 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 - 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 - 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 - 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 - 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF000087CA000087CA000087CA000087CA000087 - CA000087CA000087CA000088CC2E0088CC810088CC810088CC810088CC810088 - CC810088CC810088CC2E0087CA000087CA630087CA830087CA830087CA830087 - CA830087CA830087CA830087CA83FEFEFDFFF8F8F3FFF0F0E6FFE9E9DBFFFEC9 - 41FFF4B62EFF0087CA830087CA630085C785AEF3FFFFABF0FEFFABF0FEFFABF0 - FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0FEFFABF0FEFFABF0FEFFABF0 - FEFFABF0FEFFAEF3FFFF0085C7850083C488A8EDFDFFA2E7FBFFA2E7FBFFA2E7 - FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BCDEFF78BCDEFF78BCDEFF78BC - DEFF78BCDEFF78BCDEFF0083C4880081C18BA3E9FBFF9DE3F9FF9DE3F9FF9DE3 - F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9 - FAFFA3E9FAFFA6ECFBFF0081C18B007FBD8E9FE5F9FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF - F6FF98DFF6FF9FE5F9FF007FBD8E007CBA9299E0F6FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA - F3FF92DAF3FF99E0F6FF007CBA920079B69594DBF4FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 - F0FF8DD5F0FF94DBF4FF0079B6950076B2998FD7F2FF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 - EDFF87D0EDFF8FD7F2FF0076B2990074AD9D8AD3F0FF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC - EBFF82CCEBFF8AD3F0FF0074AD9D0070A9A286CFEEFF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 - E8FF7DC8E8FF86CFEEFF0070A9A200679AB086CFF0FF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB - EDFF82CBEDFF86CFF0FF00679AB000476A91005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D - 8CBD005D8CBD005D8CBD00476A9100000006000000160000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001600000006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000013A2000014A5000014A5000014A6000015A8000015A9001F15AA - 00CC15AA004814A70000FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000013A2000014A5001014A700B077EE - 66FF14A700CC14A70048FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000013A2000614A3009E43C631E56BE2 - 5AFF70E95FFB14A300CCFFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000113A0008533B820DE61D850FF5CD5 - 4BFA1EA80CD213A1004CFFFFFF00FFFFFF0011970000129B0048129B00CC129B - 0048119700000F93000011970000129B006924AA13D857CF46FE55CD44FD21A7 - 10D6129C006313A00000FFFFFF00FFFFFF0011960048119700CC73EA62FD1197 - 00CC119600480F9300001196004C189D08D33DB62CFB37AF26FE1FA00EDA1197 - 007B11980000129B0000FFFFFF00FFFFFF000F9200CC6DE55CFA59D048FF69E1 - 58FC0F9200CC0F92006D139504CB34B423F832B221FF1F9F0FDF0F92008C1094 - 00021095000010950000FFFFFF00FFFFFF000E8E00480E8D00CC5FD94FF933BC - 22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA20FE40E8D009E0F8F00081094 - 000010950000084B0000FFFFFF00FFFFFF000E8D00000D8800480D8700CC43CA - 33F629C318FF39CC28FF28C217FF1EAA0FEA0D8700AE0D8A00100F8F0000084A - 00000000000000000000FFFFFF00FFFFFF00074700000A6500000B8300480B82 - 00CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85001B07450000000000000000 - 00000000000000000000FFFFFF00FFFFFF000000000000000000032000000657 - 0048077200CC16A60AE8087601C406570029021E000000000000000000000000 - 00000000000000000000FFFFFF00FFFFFF00000000020000000F0000001F0000 - 002D02330066025F00CC012B005500000029000000220000001A000000130000 - 000C0000000600000001FFFFFF00FFFFFF000000000100000008000000100000 - 00170000001A000000190000001700000015000000110000000D0000000A0000 - 00060000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E99E3F00E99E3F00E99E3F00EA9F - 4099EA9F40CCEA9F4099EA9F4000EA9F40CCEA9F4000E59A3D00E3983B00E398 - 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E69B3D00E69B3D00E69B3D00E69B - 3DCCFFE195FFE69B3DCCE4993C00E69B3D00E4993C00E3983B00E3983B00E398 - 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E3983B00E3983B00E3983B00E398 - 3B99E2973ACCE2973ACCE2973ACCE2973A99E2973A00E2973ACCE2973A00E297 - 3A00E2973A00FFFFFF00FFFFFF00FFFFFF00DD923600DD923600DD923600DD92 - 3600DD923600DD9236CCFEDC90FFDD9236CCDB903400DD923600DC913500DC91 - 3500DC913500FFFFFF00FFFFFF00FFFFFF00D68B3100D68B3100D68B3100D78C - 3299D88D32CCD88D32CCD88D32CCD88D32CCD88D32CCD78C3299D68B3100D68B - 3100D68B3100FFFFFF00FFFFFF00FFFFFF00D2872E00D2872E00D2872E00D287 - 2ECCFBD589FFD38930CEFAD488FFD2872ECCFAD286FFD2872ECCD2872E00D287 - 2E00D2872E00FFFFFF00FFFFFF00FFFFFF00B86D1A00C97E2700C97E2700CA7F - 2899D58E39D7D58E39D7D08731D2CB8029CCCB8029CCCA7F2899C97E2700C97E - 2700B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00BD721E00C57A2400C57A - 24CCF7CC80FFDA9645E3F6CA7EFFC87E29CFF6C97DFFC57A24CCC57A2400BD72 - 1E00B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00B96E1B00BB701D00BE73 - 1FCCEDB96CF8E1A153EFDB9949E8D4903FE1D4903FE1BD721F99B96E1B00B96E - 1B00B86D1A00FFFFFF00FFFFFF00FFFFFF00B76C1A99B86D1ACCB86D1ACCB86D - 1ACCF3C074FFE9AC60FAEEB266FFE4A659F5F2BD71FFB86D1ACCB86D1ACCB86D - 1ACCB76C1A99FFFFFF00FFFFFF00FFFFFF00B267165CB16615CCF7CB7FFFF2BF - 73FFF0B86CFFE9AD61FFDFA357FFD5994DFFD49B4FFFD6A054FFDDAB5FFFB166 - 15CCB267165CFFFFFF00FFFFFF00FFFFFF00B1661500AC61115CAB6010CCF2C3 - 77FFDB9E4CFFD09341FFCF9240FFCF9240FFCF9240FFDCA858FFAB6010CCAC61 - 115CB1661500FFFFFF00FFFFFF00FFFFFF00B1661500AB601000A65B0D5CA55A - 0CCCEAB44BFFE09E29FFE09E29FFE09E29FFE8AE43FFA55A0CCCA65B0D5CAB60 - 1000B1661500FFFFFF00FFFFFF00FFFFFF000000000000000000532D0600A156 - 095CA05508CCF7B92EFFF5AB0EFFF7B629FFA05508CCA156095C532D06000000 - 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 - 00196D39046E9B5005CCFFBB19FF9B5005CC6D39046E0000001A000000110000 - 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 - 00320000003363320274974C02CC633202740000003300000033000000220000 - 000800000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B2BCF992B2BCFCC2B2B - CFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B - CF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002424CCCC8686E6FF8080 - E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8484E5FF2424 - CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C1CC9CC7878E4FF6767 - DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF7575E2FF1C1C - C9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001414C6CC6F6FE1FF5555 - DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3BD3FF3838D3FF5252DAFF1414 - C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001010B9CC6767DFFF4B4B - D8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1BC9FF1B1BC9FF3434D1FF1010 - B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000F0FA5CC5555DAFF2020 - CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF2E2ED0FF0F0F - A5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000D0D95CC3636D1FF1717 - C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF2727CDFF0D0D - 95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000B0B84CC2C2CCFFF1414 - C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1E1ECAFF0B0B - 84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000A0A75CC2525CDFF1212 - C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1919C8FF0A0A - 75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0009096ACC2727CDFF1C1C - C9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717C8FF1717C8FF1919C8FF0909 - 6ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF000000000306063EA0080860CC0808 - 60CC080860CC080860CC080860CC080860CC080860CC080860CC080860CC0606 - 3EA100000004FFFFFF00FFFFFF00FFFFFF0000000003000000110000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001300000004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A480 - 0000A984004AA98400A6A98400CCA98400A6A984004AA4800000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A37F - 004AB18E11D0E5C657F3EFD166FDE4C556F3B08D10D0A37F004AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009D7B - 00A6D9BA4DF3CAAC42FFBFA137FFBA9C32FFC4A537F39D7B00A6FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009574 - 00CCCAAB3DFDA98916FFA58511FFA58511FFB0901DFD957400CCFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C6D - 00A6BD9A1FF3BC9712FFBB9611FFBB9612FFB38F10F38C6D00A6FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008467 - 004A8E7004D0C09910F3CEA511FDBF980EF38D6F03D0634D004AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 000941330061654F00AB695200CC654F00AB4032006500000013FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 0005000000170000001A0000001A0000001A000000190000000AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A8000000A9480000A9CC0000 - A9CC0000A9930000A7000000A20000009A0000009E000000A4000000A82B0000 - A97E0000A9B00000A966FFFFFF00FFFFFF000000A4000000A4CC7474FCFF6B6B - F4FE3636CDE50000A4CC0000A10000009A0000009E000000A3890606A8CF0000 - A4BD0000A54A0000A501FFFFFF00FFFFFF0000009F0000009F6600009ECC3737 - C9E56262EAFF5858E3FA1616AFD600009A330E0EA99F2828BEDD00009EB40000 - 9F1F0000A4000000A500FFFFFF00FFFFFF0000009F0000009E00000098330000 - 968A000096CC4141CDEE5151D9FD2727B7E32F2FBEE3000096B100009A180000 - 9F000000A4000000A500FFFFFF00FFFFFF0000009F0000009E00000098000000 - 900000008D3300008ECC3131BCF33333BCFA090997D400008E0000008F000000 - 8E0000008E000000A500FFFFFF00FFFFFF000000800000008000000080000000 - 8215000086B01A1AA8E72222B4F907078ED214149FE105058DD2000082000000 - 7C000000780000007800FFFFFF00FFFFFF00000078000000780000007B000000 - 7E911515A6E51D1DBEFD07078AD400007F6300007EAE0A0A94DC00007EB60000 - 7A000000780000007800FFFFFF00FFFFFF000000700000007000000075670D0D - 96DC1717CCFF0F0FA2E50000777500007E0000007A000000769104048AD50000 - 76860000730000007200FFFFFF00FFFFFF0000006C0000006D1F00006ECC1515 - D1FB1111C3F400006EB40000701100007000000078000000720000006E820000 - 6EB800006D4100006C00FFFFFF00FFFFFF00000066000000668C0A0A9FE51212 - DDFF030378D3000067330000510000000000000000000000380000006A000000 - 66840000668900006404FFFFFF00FFFFFF000000180000005FCC1111DBFE0C0C - AFEC00005F8B0000190000000000000000000000000000000000000000000000 - 320000005F7300004832FFFFFF00FFFFFF000000001C0000325E000059CC0000 - 57BC0000164200000020000000160000000F0000000D00000010000000150000 - 001B00001D3800002D4CFFFFFF00FFFFFF000000000E00000014000000190000 - 001900000016000000100000000B0000000800000007000000080000000B0000 - 000E0000001100000013FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E89D3E00E99E3F99E99E3FCCE99E - 3FCCE99E3F85E59A3C00E59A3C00E59A3C00D78C3200D2872E00D58A3000D58A - 3000CC812900C2772200BB701C00E4993B00E4993B00E4993BC5FEDF92FDFFDF - 93FFE69E42CFE4993B0FE4993B00E4993B00D0852D00D2872E00D58A3000D58A - 3000CC812900C2772200BB701C00DD923600DD923600DD9236AAF8D081F6FCD1 - 85FFE7A951D9DC91363FDB903500CC812900C97E2700D2872E00D58A3000D58A - 3000CC812900C2772200BB701C00CD822A00D58A3000D58A307BEBB865E8F7C5 - 79FFF0C070EFD58A30AAD0852D13CC812900C97E2700D2872E00D4892F99D489 - 2F5CCC812900C2772200BB701C00C2772200C4792400CC812A2BD38E38CEF0BF - 71FBE0A856FFDCA04CE4CC8129AACB80283FC97E270FC77C2600CC8129CCCC81 - 29CCCB80285CC2772200BB701C00C1762199C27722CCC27722CCC27722CCD597 - 3FE0E3A538FEE4A533FFE2A743EFCF8C32D9C57C26CFC27722CCC27722CCE6A9 - 3CFFC27722CCC176215CBB701C00B96E1BCCF6CB7FFFF8C051FFF9BD36FFF8B9 - 2CFFF5AC10FFF5AB0EFFF5AC10FFF6B11BFFF7B523FFF7B523FFF7B421FFF5AB - 0EFFF6B11BFFB96E1BCCB96E1B48AF6414CCF9C660FFFFBE23FFFFBD1FFFFFBC - 1CFFFFBB19FFFFBA16FFFFB914FFFFB811FFFFB70FFFFFB70DFFFFB60BFFFFB2 - 00FFFFB609FFAF6414CCAF641448A75C0E99A65B0DCCA65B0DCCA65B0DCCA65B - 0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCFFB5 - 08FFA65B0DCCA75C0E5C824A0E00532E0700522D0600522D0600522D0600522D - 0600522D0600522D0600522D0600522D0600522D0600522D06009F5408CC9F54 - 08CC783F065C291703000000000000000000000000040000000A000000110000 - 0019000000220000002A00000030000000330000003300000033733B03A66333 - 03740000002E0000001D0000000A000000000000000200000005000000090000 - 000D0000001100000015000000180000001A0000001A0000001A0000001A0000 - 001A000000170000000F00000005FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF007F7F55497F7F55577F7F55497F7F552E7F7F - 550E7F7F55007F7F550E7F7F552E7F7F55497F7F55577F7F55617F7F55667F7F - 55667F7F55667F7F55667F7F554DAA55009AF6F6F3EBE8E8DDD7C9C9B2B49C9C - 78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEFE2EBF6F6ECF9FBFBF4FFFCFC - F7FFFEFEFBFFFFFFFEFFAA55009AA854009BFEFEFDFFF8F8F3FFF1F1E7FFE9E9 - D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB - F6FFFDFDFAFFFFFFFEFFA854009BA652009DFEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBEADFFD2D2C1FFCDCDBCFFFBFB - F6FFFDFDFAFFFFFFFEFFA652009DA351009FFEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB - F6FFFDFDFAFFFFFFFEFFA351009FA04E00A2FEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1D3FF18B2D3FFF9F9F2FFD9D9 - C8FFD4D4C3FFFFFFFEFFA04E00A29C4C00A4FEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6DFFF49E0F1FFF9F9F2FFEAEA - D9FFEDEDDCFFFFFFFEFF9C4C00A4994A00A7FEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168BA9FF1EA8C0FFF9F9F2FFD9D9 - C8FFD4D4C3FFFFFFFEFF994A00A7954700AAFEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFEAEA - D9FFEDEDDCFFFFFFFEFF954700AA914500ADFEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBEADFFD2D2C1FFC4C4B3FFD9D9 - C8FFDCDCCBFFFFFFFEFF914500AD8D4200B0FEFEFDFFF8F8F3FFF0F0E6FFE9E9 - DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB - F6FFFDFDFAFFFFFFFEFF8D4200B0873E00B5FFFFFEFFF9F9F4FFF1F1E7FFE9E9 - DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6EAFFF8F8EFFFFBFBF4FFFCFC - F7FFFEFEFBFFFFFFFEFF873E00B5793400C0C5C5B7FFCECEC1FFDDDDD0FFE7E7 - D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5B4FFBEBEAEFFBBBBAAFFBBBB - AAFFBBBBAAFFBBBBAAFF793400C05322009A855027D78E623DDF67655AF7ACAA - 9AFD9B9B8AFFACAA9AFD67655AF78E623DDF855027D7793D12D0703104CC6F2F - 02CB6F2F02CB6F2F02CB5322009A1007000F220E00352A110048000000620000 - 008F000000ED0000008F000000622A110048200D003A130800300703002A0502 - 0029050200290603002302010009000000000000000000000000000000000000 - 00100000001A0000001000000000000000000000000000000000000000000000 - 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00D98E3300DA8F3400D98E3300D78C3200D98E - 3300DA8F3400D98E3300E89D3F00E89D3F00E99E4099E99E405CE59A3C00E095 - 3800D98E3300D2872E00CA7F2800D98E3300DA8F3400D98E3300D78C3200D98E - 3300DA8F3400D98E3300DD923700E59A3C00E59A3CCCE59A3CCCE59A3C5CE095 - 3800D98E3300D2872E00CA7F2800D98E3300DA8F3400D98E3300D78C3200D98E - 3300DA8F3400D98E3300DA8F3400DC913600E09538CCFFE498FFE09538CCDF94 - 385CD98E3300D2872E00CA7F2800D88D3399D98E33CCD88D3399D78C3200D88D - 3399D98E33CCD88D3399D98E33CCD98E33CCD98E33CCFBD488FFFEDF93FFD98E - 33CCD88D335CD2872E00CA7F2800D2872ECCFBD98DFFD2872ECCD0852C00D287 - 2ECCFBD68AFFDA933DD7FAD488FFF3C375F7F6C97DFFF4C175FFF2B96DFFFAD6 - 8AFFD2872ECCD1862D5CCA7F2800CB802999CA7F28CCCA7F28CCCA7F28CCCA7F - 28CCCC812BCED38C37D7DC9947E3E5A556EFEBAE61FAEEB266FFEEB266FFEEB2 - 66FFF7CC80FFCA7F28CCC97E275CBF742000C3782300C27722CCF8D084FFC277 - 22CCF7CD81FFC77E2AD2EDC071FFD08D3BE8D39644FFD09341FFD09341FFD396 - 44FFD89B49FFECBB6CFFC27722CCB96E1CCCBA6F1D00BA6F1D99B96E1CCCB96E - 1CCCB96E1CCCB96E1CCCBD721DCFCB8422E1DA9627F5E19E29FFE19E29FFE19E - 29FFEAB349FFB96E1CCCBA6F1D5CB76C1A00AF641400AF641400B3681700B166 - 16CCF8BF3EFFB16616CCF7BC36FFD08613E1F6B424FFF5AF18FFF5AB0EFFF7B9 - 2EFFB16616CCB267175CB96E1C00B4691700AA5F1000AA5F10CCAB601100AB60 - 1199AA5F10CCAB601199AA5F10CCAB601199AA5F10CCFFB810FFFFBB1BFFAA5F - 10CCAB60115CB1661600B96E1C00B0651400A85D0E00A85D0E00553008007F47 - 0C00A85D0E007F470C00A85D0E00A65B0D00A3580BCCFFB914FFA3580BCCA459 - 0C5C7F470C002C19050000000000000000000000000000000000000000000000 - 0000000000000000000000000000281502009D5206CC9D5206CC763E055C2916 - 03000000000000000000000000000000000000000000000000020000000E0000 - 001C0000002A000000330000003300000033733A02A663320274000000330000 - 002B0000001D0000000F00000003000000000000000000000001000000070000 - 000E000000150000001A0000001A0000001A0000001A0000001A0000001A0000 - 00160000000F0000000800000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C4613F00D16D4B00E17C5A00EA84 - 6220EC866487EC8664D0EC8664F5EC8664F5EC8664D0EC866487EA846220E17C - 5A00D16D4B00C4613F00FFFFFF00FFFFFF00C4613F00D16D4B00DF7A5860E384 - 64EBEFB7A4FFFAE4DDFFFEF9F7FFFEF9F7FFFAE4DDFFEFB7A4FFE38464EBDF7A - 5860D16D4B00C4613F00FFFFFF00FFFFFF00C4613F00CF6B4960D77F61F9F6E3 - DCFFFCFCFCFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFCFCFCFFF6E3DCFFD77F - 61F9CF6B4960C4613F00FFFFFF00FFFFFF00BF5C3A20C56747EBF2DFD9FFF8F8 - F8FFF7F7F7FFF7F7F7FFC15D3BFFC15D3BFFF7F7F7FFF7F7F7FFF8F8F8FFF2DF - D9FFC56747EBBF5C3A20FFFFFF00FFFFFF00B34F2D87D49D8AFFF5F5F5FFF3F3 - F3FFF3F3F3FFF3F3F3FFB34F2DFFB34F2DFFF3F3F3FFF3F3F3FFF3F3F3FFF5F5 - F5FFD49C89FFB34F2D87FFFFFF00FFFFFF00AB4624D0EAD5CDFFF0F0F0FFF0F0 - F0FFF0F0F0FFEBEBEBFFE9E9E9FFE7E6E6FFD2D1D1FFCECECEFFCECECEFFD2D1 - D1FFDCC7C0FFAB4624D0FFFFFF00FFFFFF00AD4422F5F4EFEDFFEEEEEEFFEAEA - EAFFDCDBDBFFD3D1D1FFAD4422FFAD4422FFD2D0D0FFD2D0D0FFD2D0D0FFD2D0 - D0FFDFD8D7FFAD4422F5FFFFFF00FFFFFF00B74826F5F4EEEDFFE7E5E5FFDAD6 - D6FFD8D4D4FFD8D4D4FFB74826FFB74826FFD8D4D4FFD8D4D4FFD8D4D4FFD8D4 - D4FFE1D8D6FFB74826F5FFFFFF00FFFFFF00C5502ED0EAD0C8FFE1DADAFFE0D9 - D9FFE0D9D9FFE0D9D9FFC5502EFFC5502EFFE0D9D9FFE0D9D9FFE0D9D9FFE0D9 - D9FFE1C4BDFFC5502ED0FFFFFF00FFFFFF00D6593787E59D8AFFEAE2E2FFE7DF - DFFFE7DFDFFFE7DFDFFFD65937FFD65937FFE7DFDFFFE7DFDFFFE7DFDFFFE8E0 - E0FFE19784FFD6593787FFFFFF00FFFFFF00E3603E20E66A4AEBF3D3CDFFF0E5 - E5FFEFE4E4FFEFE4E4FFE5613FFFE5613FFFEFE4E4FFEFE4E4FFEFE4E4FFEFCD - C7FFE66A4AEBE3603E20FFFFFF00FFFFFF00E8634100EE664460EF7659F9F7D4 - CEFFF7E9E9FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8E8FFF7E9E9FFF6D1CAFFEF76 - 58F9EE664460E8634100FFFFFF00FFFFFF007432210077332200B34D3360EF6F - 4FEBF5A28FFFFAD1CAFFFCE7E5FFFCE6E5FFF9D1C9FFF4A18EFFEF6E4EEBB34D - 33603C1A110000000000FFFFFF00FFFFFF0000000000000000040000001B481F - 1546B24C3399E96443D4EE6644F5EE6644F5E96443D4B24C3399471F15470000 - 001F0000000600000000FFFFFF00FFFFFF0000000000000000020000000E0000 - 00180000001A0000001A0000001A0000001A0000001A0000001A000000190000 - 00100000000300000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00B82F0300B92F030BBA30036ABA3003ACBA30 - 03BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA30 - 03ACBA30036AB92F030BB82F0300B82F0300B82F036BD25B33D3F1916EF7F698 - 76FFF69876FFF69876FFF69876FFF59876FFF59775FFF59775FFF59674FFF08E - 6BF7D15931D3B82F036BB82F0300B52D0300B52D03ADF08F6CF7E7815FFFE781 - 5FFFE7815FFFE7815FFFD87250FFD87250FFE7815FFFE7815FFFE7815FFFE781 - 5FFFEB8865F7B52D03ADB52D0300B22C0300B22C03BFEF906EFFDF7957FFDF79 - 57FFDF7957FFD26C4AFFFFFFFFFFFFFFFFFFD26C4AFFDF7957FFDF7957FFDF79 - 57FFE88765FFB22C03BFB22C0300AF2A0300AF2A03BFE88A68FFD6704EFFD670 - 4EFFD6704EFFCC6644FFFFFFFFFFFFFFFFFFCC6644FFD6704EFFD6704EFFD670 - 4EFFE07E5CFFAF2A03BFAF2A0300AB270200AB2702C0E28260FFCF6947FFCF69 - 47FFCF6947FFCA6442FFAE4826FFAC4523FFB04A27FFAD4624FFAD4624FFB04A - 27FFC25F3CFFAB2702C0AB270200A7250200A72502C1DD7D5BFFCC6644FFC962 - 40FFBD5431FFB24926FFCCCCCCFFCDCDCDFFB14825FFB44A26FFB44A26FFB44A - 26FFBD5532FFA72502C1A7250200A3230200A32302C1DA7957FFC85F3BFFC052 - 2CFFBE502AFFB94E28FFCDCDCDFFD6D6D6FFB94E28FFBE502AFFBE502AFFBE50 - 2AFFC35631FFA32302C1A32302009F2002009F2002C2D86F4BFFCB5930FFCB58 - 2FFFCB582FFFC3542CFFD6D6D6FFE2E2E2FFC3542CFFCB582FFFCB582FFFCB58 - 2FFFCC5B32FF9F2002C29F2002009B1E02009B1E02C3DE6C42FFD86035FFD860 - 35FFD86035FFCD5930FFE2E2E2FFEDEDEDFFCD5930FFD86035FFD86035FFD860 - 35FFD86035FF9B1E02C39B1E0200961B0200961B02C4E86E42FFE5673AFFE567 - 3AFFE5673AFFD75F34FFEDEDEDFFEEEEEEFFD75F34FFE5673AFFE5673AFFE567 - 3AFFE5673AFF961B02C4961B020090170200901702B3E7693CF8F16F3EFFF16F - 3EFFF16F3EFFF16F3EFFCF5A31FFCF5A31FFF16F3EFFF16F3EFFF16F3EFFF16F - 3EFFE66538F8901702B39017020021040100800E0170AB331ADBEC693CF8FA74 - 42FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFEC69 - 3BF8AB3218DB800E01702104010000000012120100335A040082710500BA7205 - 00CB720500CB720500CB720500CB720500CB720500CB720500CB720500CB7105 - 00BA5A040082120100330000001200000009000000160000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A00000016000000090404040004040400040404460404048AAA55 - 0099AA550099AA550099AA550099AA550099AA550099AA550099AA550099AA55 - 0099AA550073AA550000AA55000004040400040404000404048ABCBCABFFC1C1 - B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8E2FFEFEFECFFF7F7F4FFFCFC - FCFF55552B6655552B0055552B000101010001010100010101AC555555FFCC99 - 66FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 - 66FFAA55009AAA550000AA5500000101010001010100010101AE808080FFEAB7 - 84FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 - 84FFA854009BA8540000A85400000101010001010100010101B07E7E7EFFE4B1 - 7EFFD7A674FFCF9F6FFFCC9D6DFFCC9D6DFFCF9F6EFFD7A573FFDBA875FFE4B1 - 7EFFA653009DA6530000A65300000101010001010100010101B27C7C7CFFE2AF - 7CFFD09F6EFFFFEEDDFFFFEEDDFFFFEEDDFFFFEEDDFFD7AF87FFD7A472FFE2AF - 7CFFA451009FA4510000A45100000101010001010100010101B5797979FFDFAC - 79FFD19F6DFFD4AC84FFCFA982FFD2B293FFFBEAD9FFDEBF9FFFD3A16EFFDFAC - 79FFA14F00A1A14F0000A14F00000101010001010100010101B8757575FFDBA8 - 75FFD29F6CFFD19E6CFFC99968FFD2B291FFF7E6D5FFD5B18EFFD09E6BFFDBA8 - 75FF9E4D00A39E4D00009E4D00000101010001010100010101BB727272FFD8A5 - 72FFCF9C69FFCB9967FFCCA681FFF1E0CEFFE4CCB4FFC59564FFCF9C69FFD8A5 - 72FF9B4B00A59B4B00009B4B00000101010001010100010101BE6E6E6EFFD4A1 - 6EFFCB9865FFC39261FFEDDCCBFFEDDCCBFFBC8D5EFFCA9765FFCB9865FFD4A1 - 6EFF984900A898490000984900000101010001010100010101C16B6B6BFFD19E - 6BFFC89562FFC2915FFFB38658FFB38658FFC2915FFFC89562FFC89562FFD19E - 6BFF954700AB95470000954700000101010001010100010101C5676767FFCD9A - 67FFC4915EFFBA8A5AFFF8E7D6FFEAD9C8FFBA8A5AFFC4915EFFC4915EFFCD9A - 67FF914500AD91450000914500000101010001010100010101C9646464FFCA97 - 64FFC18E5BFFB78757FFE7D6C5FFDFCEBDFFB78757FFC18E5BFFC18E5BFFCA97 - 64FF8D4200B08D4200006A3200000000000001010100010101CE626262FFC895 - 62FFBF8C59FFBC8A58FFB58554FFB58554FFBC8A58FFBF8C59FFBF8C59FFC895 - 62FF893F00B467300000000000000000000900000016000000DB606060FFCA97 - 64FFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFCA97 - 64FF7C3600BE0000001600000009000000120000002C00000087000000E7702E - 00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E - 00C7552300A20000002C00000012FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 - A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 - A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 - AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 - A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B - E8F65F5FE7FF5B5BE3FF4949D1FF4949D1FF5B5BE3FF5F5FE7FF5858E4F60F0F - B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 - D9FF4F4FD7FF4040C8FFFFFFFFFFFFFFFFFF4040C8FF4F4FD7FF5050D8FF4F4F - DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 - CAFF4242CAFF3636BEFFFFFFFFFFFFFFFFFF3636BEFF4242CAFF4242CAFF4747 - CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 - BFFF3737BFFF2A2AB2FFE8E8E8FFDADADAFF15159EFF12129CFF12129CFF1616 - A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E - B8FF1D1DABFF1212A1FFCCCCCCFFD1D1D1FF1111A0FF1111A1FF1111A1FF1111 - A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 - ABFF1111AAFF1111A6FFD1D1D1FFDCDCDCFF1111A6FF1111AAFF1111AAFF1111 - AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 - B4FF1111B4FF1111B4FF1111A8FF1111A8FF1111B4FF1111B4FF1111B4FF1111 - B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 - BEFF1111BEFF1111B5FFE8E8E8FFEEEEEEFF1111B5FF1111BEFF1111BEFF1111 - BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 - C8FF1111C8FF1111BCFFEEEEEEFFEEEEEEFF1111BCFF1111C8FF1111C8FF0F0F - BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 - C4F61212D1FF1111D1FF1111B6FF1111B6FF1111D1FF1111D1FF0F0FC2F60303 - 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 - 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 - 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 - 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 - 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00E7815F00E983610FED876590ED8765E8ED87 - 65FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED87 - 65E8ED876590E983610FE7815F00E47F5D00E47F5D90EEA992FFFCEFEAFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCEF - EAFFEEA992FFE47F5D90E47F5D00D9745200D97452E8F9ECE8FFFBFBFBFFFBFB - FBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB - FBFFF8EBE7FFD97452E8D9745200CC674500CC6745FFFBFBFBFFF7F7F7FFF7F7 - F7FFF7F7F7FFF7F7F7FFCC6745FFCC6745FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7 - F7FFFAFAFAFFCC6745FFCC674500BE5B3900BE5B39FFF9F9F9FFF3F3F3FFF3F3 - F3FFF3F3F3FFF3F3F3FFBE5B39FFBE5B39FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3 - F3FFF6F6F6FFBE5B39FFBE5B3900B4502E00B4502EFFF6F6F6FFF0F0F0FFF0F0 - F0FFF0F0F0FFEBEBEBFFB4502EFFB4502EFFD2D1D1FFCECECEFFCECECEFFD2D1 - D1FFDEDDDDFFB4502EFFB4502E00AC482600AC4826FFF4F4F4FFEEEEEEFFAC48 - 26FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFD2D0 - D0FFD7D6D6FFAC4826FFAC482600AB442200AB4422FFF3F3F3FFE7E5E5FFEE66 - 44FFEE6644FFEE6644FFAB4422FFAB4422FFEE6644FFEE6644FFEE6644FFD8D4 - D4FFDBD8D8FFAB4422FFAB442200AF452300AF4523FFEDEAEAFFE1DADAFFF1ED - EDFFF1EDEDFFF1EDEDFFAF4523FFAF4523FFF1EDEDFFF1EDEDFFF1EDEDFFE0D9 - D9FFE1DBDBFFAF4523FFAF452300B8492700B84927FFEBE4E4FFE7DFDFFFE7DF - DFFFE7DFDFFFE7DFDFFFB84927FFB84927FFE7DFDFFFE7DFDFFFE7DFDFFFE7DF - DFFFE7DFDFFFB84927FFB8492700C54F2D00C54F2DFFF1E7E7FFEFE4E4FFEFE4 - E4FFEFE4E4FFEFE4E4FFEE6644FFEE6644FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4 - E4FFEFE4E4FFC54F2DFFC54F2D00D2563400D25634E8F3D7D3FFF7E8E8FFF7E8 - E8FFF7E8E8FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8 - E8FFF2D5D1FFD25634E8D256340037170F00DF5E3C90E98D76FFF9DAD6FFFCEC - ECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFF9DA - D6FFE98C75FFDF5E3C9037170F000000001226100B36BF51359FE86341E9E963 - 41FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE863 - 41E9BF51359F26100B360000001200000000000000160000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001600000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00E7815F00E983610FED876590ED8765E8ED87 - 65FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED87 - 65E8ED876590E983610FE7815F00E47F5D00E47F5D90EEA992FFFCEFEAFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCEF - EAFFEEA992FFE47F5D90E47F5D00D9745200D97452E8F9ECE8FFFBFBFBFFFBFB - FBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB - FBFFF8EBE7FFD97452E8D9745200CC674500CC6745FFFBFBFBFFF7F7F7FFF7F7 - F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7 - F7FFFAFAFAFFCC6745FFCC674500BE5B3900BE5B39FFF9F9F9FFF3F3F3FFF3F3 - F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3 - F3FFF6F6F6FFBE5B39FFBE5B3900B4502E00B4502EFFF6F6F6FFF0F0F0FFF0F0 - F0FFF0F0F0FFEBEBEBFFE0E0E0FFD7D6D6FFD2D1D1FFCECECEFFCECECEFFD2D1 - D1FFDEDDDDFFB4502EFFB4502E00AC482600AC4826FFF4F4F4FFEEEEEEFFAC48 - 26FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFD2D0 - D0FFD7D6D6FFAC4826FFAC482600AB442200AB4422FFF3F3F3FFE7E5E5FFEE66 - 44FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFD8D4 - D4FFDBD8D8FFAB4422FFAB442200AF452300AF4523FFEDEAEAFFE1DADAFFF1ED - EDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFE0D9 - D9FFE1DBDBFFAF4523FFAF452300B8492700B84927FFEBE4E4FFE7DFDFFFE7DF - DFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DF - DFFFE7DFDFFFB84927FFB8492700C54F2D00C54F2DFFF1E7E7FFEFE4E4FFEFE4 - E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4 - E4FFEFE4E4FFC54F2DFFC54F2D00D2563400D25634E8F3D7D3FFF7E8E8FFF7E8 - E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8 - E8FFF2D5D1FFD25634E8D256340037170F00DF5E3C90E98D76FFF9DAD6FFFCEC - ECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFF9DA - D6FFE98C75FFDF5E3C9037170F000000001226100B36BF51359FE86341E9E963 - 41FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE863 - 41E9BF51359F26100B360000001200000000000000160000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A00000016000000001975BA001975BA001770B7900B56A4C60142 - 96CC003F94CC002A80CC00166BCC021C70CB072D7DC80D4390C51259A3C1176C - B290186FB500186FB500FFFFFF0098763200987632009876325BF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29876 - 325B9876320098763200FFFFFF0097753100977531009775315CF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29775 - 315C9775310097753100FFFFFF0096743000967430009674305DF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29674 - 305D9674300096743000FFFFFF0095732F0095732F0095732F5FF8F0E9DCCCCB - C3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391AFF9C7C6BDCEF7EEE5DC9573 - 2F5F95732F0095732F00FFFFFF0094722E0094722E0094722E3094722E60F1E3 - D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3BBCEF1E2D3D394722E609472 - 2E3094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D319371 - 2D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3D5D293712D6293712D319472 - 2E0094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D00916F - 2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F2B63916F2B3293712D009472 - 2E0094722E0094722E00FFFFFF008C6A26008C6A26008D6B27008E6C2800906E - 2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E2A65906E2A338E6C28008D6B - 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27008E6C28348E6C - 2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3D5D28E6C28678E6C28348D6B - 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27358D6B2769F1E3 - D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFF1E2D3D38D6B27698D6B - 27358C6A26008C6A2600FFFFFF008B6925008B6925008B69256AF8F0E9DCEAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F7EEE5DC8B69 - 256A8B6925008B692500FFFFFF00674E1B00896723008967236CF5EAE0D276AF - CBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F65B95B0F66BA4BFF6F3E7DBD28967 - 236C89672300674E1B00FFFFFF0000000000654B180085631F70F5EAE0D299BB - C7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E386A8B5E391B3BFE3F3E7DBD28563 - 1F70654B180000000000FFFFFF000000000A000000177F5D1977F5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD27F5D - 1977000000170000000AFFFFFF00000000000000002D002C6CA600277CCC0016 - 6BCC001569CC000955CC000041CC000546CC001155CC001F68CC002E7CCC002B - 69A60000002E00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001FA4 - 000020A9004A20A900A620A900CC20A900A620A9004A1FA40000FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001FA3 - 004A2FB111D072E557F380EF66FD71E456F32EB010D01FA3004AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001D9D - 00A667D94DF35BCA42FF50BF37FF4BBA32FF51C437F31D9D00A6FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C95 - 00CC57CA3DFD32A916FF2CA511FF2CA511FF39B01DFD1C9500CCFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001A8C - 00A63DBD1FF331BC12FF30BB11FF32BB12FF2FB310F31A8C00A6FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001984 - 004A1D8E04D032C010F334CE11FD2FBF0EF31C8D03D01363004AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 00090C410061136500AB146900CC136500AB0C40006500000013FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 - 0005000000170000001A0000001A0000001A000000190000000AFFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF000404040004040400040404460404048AAA55 - 0099AA550099AA550099AA550099AA550099AA550099AA550099AA550099AA55 - 0099AA550073AA550000AA55000004040400040404000404048ABCBCABFFC1C1 - B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8E2FFEFEFECFFF7F7F4FFFCFC - FCFF55552B6655552B0055552B000101010001010100010101AC555555FFCC99 - 66FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 - 66FFAA55009AAA550000AA5500000101010001010100010101AE808080FFEAB7 - 84FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 - 84FFA854009BA8540000A85400000101010001010100010101B07E7E7EFFE4B1 - 7EFFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFE4B1 - 7EFFA653009DA6530000A65300000101010001010100010101B27C7C7CFFE2AF - 7CFFBC8956FFE3B07DFFE3B07DFFE3B07DFFE3B07DFFE3B07DFFBC8956FFE2AF - 7CFFA451009FA4510000A45100000101010001010100010101B5797979FFDFAC - 79FFBE8B58FFD6A370FFD6A370FFD6A370FFD6A370FFD6A370FFBE8B58FFDFAC - 79FFA14F00A1A14F0000A14F00000101010001010100010101B8757575FFDBA8 - 75FFBE8B58FFD29F6CFFD29F6CFFD29F6CFFD29F6CFF84A791FF3FA6A6FF8CAF - 99FF9E4D00A39E4D00009E4D00000101010001010100010101BB727272FFD8A5 - 72FFBF8C59FFCF9C69FFCF9C69FFCF9C69FFC99D6CFF50ACA8FFA2E5E7FF53AF - ABFF94500AA89B4B00009B4B00000101010001010100010101BE6E6E6EFFD4A1 - 6EFFBF8C59FFCB9865FFCB9865FFCB9865FF8F9F83FF6BC5C6FFABF5FCFF6CC7 - C8FF636E48C38F4F0D008F4F0D000101010001010100010101C16B6B6BFFD19E - 6BFFBF8C59FFC89562FFC89562FFC59563FF4FA39FFF90E3E9FF555555FF88E1 - E9FF2E8E8ADE01ABC40401ABC4000101010001010100010101C5676767FFCD9A - 67FFBF8C59FFC4915EFFC4915EFF919778FF56B6BAFF7CE4F1FF000000FF68D8 - E7FF38A6ABEE01A8C04301A7BF000101010001010100010101C9646464FFCA97 - 64FFBE8B58FFC18E5BFFC18E5CFF509B94FF67D1D7FF46D3D7FF75B4B5FF40D0 - D2FF40C3C6F901A4BC9801A2BA010000000001010100010101CE626262FFC895 - 62FFBD8A57FFBF8C59FF95906EFF3CA8ACFF42D9E0FF33D5DDFF000000FF33D5 - DDFF34D5DDFF0DACC1C7019EB63A0000000900000016000000DB606060FFCA97 - 64FFC5925FFFC5925FFF4C9590FF32C6D1FF29DBE9FF28DAE9FF79EDF5FF28DA - E9FF28DAE9FF1CC7D8EA0198AF9F000000000000002C00000087000000E7702E - 00C7702E00C7702E00C72C6662E8157882F2157882F2157882F2157882F21578 - 82F2107B87EA008398D00066779A - } - end - object itSaveDownloadedList: TIdleTimer - Interval = 300000 - OnTimer = itSaveDownloadedListTimer - left = 752 - top = 120 - end - object IconDL: TImageList - left = 24 - top = 184 - Bitmap = { - 4C69080000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B2BCF992B2BCFCC2B2B - CFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B - CF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002424CCCC8686E6FF8080 - E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8484E5FF2424 - CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C1CC9CC7878E4FF6767 - DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF7575E2FF1C1C - C9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001414C6CC6F6FE1FF5555 - DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3BD3FF3838D3FF5252DAFF1414 - C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001010B9CC6767DFFF4B4B - D8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1BC9FF1B1BC9FF3434D1FF1010 - B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000F0FA5CC5555DAFF2020 - CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF2E2ED0FF0F0F - A5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000D0D95CC3636D1FF1717 - C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF2727CDFF0D0D - 95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000B0B84CC2C2CCFFF1414 - C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1E1ECAFF0B0B - 84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000A0A75CC2525CDFF1212 - C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1919C8FF0A0A - 75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0009096ACC2727CDFF1C1C - C9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717C8FF1717C8FF1919C8FF0909 - 6ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF000000000306063EA0080860CC0808 - 60CC080860CC080860CC080860CC080860CC080860CC080860CC080860CC0606 - 3EA100000004FFFFFF00FFFFFF00FFFFFF0000000003000000110000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001300000004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF001975BA001975BA001770B7900B56A4C60142 - 96CC003F94CC002A80CC00166BCC021C70CB072D7DC80D4390C51259A3C1176C - B290186FB500186FB500FFFFFF0098763200987632009876325BF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29876 - 325B9876320098763200FFFFFF0097753100977531009775315CF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29775 - 315C9775310097753100FFFFFF0096743000967430009674305DF5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29674 - 305D9674300096743000FFFFFF0095732F0095732F0095732F5FF8F0E9DCCCCB - C3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391AFF9C7C6BDCEF7EEE5DC9573 - 2F5F95732F0095732F00FFFFFF0094722E0094722E0094722E3094722E60F1E3 - D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3BBCEF1E2D3D394722E609472 - 2E3094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D319371 - 2D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3D5D293712D6293712D319472 - 2E0094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D00916F - 2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F2B63916F2B3293712D009472 - 2E0094722E0094722E00FFFFFF008C6A26008C6A26008D6B27008E6C2800906E - 2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E2A65906E2A338E6C28008D6B - 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27008E6C28348E6C - 2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3D5D28E6C28678E6C28348D6B - 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27358D6B2769F1E3 - D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFF1E2D3D38D6B27698D6B - 27358C6A26008C6A2600FFFFFF008B6925008B6925008B69256AF8F0E9DCEAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F7EEE5DC8B69 - 256A8B6925008B692500FFFFFF00674E1B00896723008967236CF5EAE0D276AF - CBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F65B95B0F66BA4BFF6F3E7DBD28967 - 236C89672300674E1B00FFFFFF0000000000654B180085631F70F5EAE0D299BB - C7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E386A8B5E391B3BFE3F3E7DBD28563 - 1F70654B180000000000FFFFFF000000000A000000177F5D1977F5EAE0D2EAD4 - BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD27F5D - 1977000000170000000AFFFFFF00000000130000002D002C6CA600277CCC0016 - 6BCC001569CC000955CC000041CC000546CC001155CC001F68CC002E7CCC002B - 69A60000002E00000013FFFFFF00FFFFFF0043DBE50043DBE50043DBE50044DC - E69944DCE6CC44DCE69944DCE60044DCE6CC44DCE60041D8E1003FD6DF003FD6 - DF003FD6DF00FFFFFF00FFFFFF00FFFFFF0041D9E20041D9E20041D9E20041D9 - E2CC97E6FCFF41D9E2CC40D7E00041D9E20040D7E0003FD6DF003FD6DF003FD6 - DF003FD6DF00FFFFFF00FFFFFF00FFFFFF003FD6DF003FD6DF003FD6DF003FD6 - DF993ED5DECC3ED5DECC3ED5DECC3ED5DE993ED5DE003ED5DECC3ED5DE003ED5 - DE003ED5DE00FFFFFF00FFFFFF00FFFFFF003AD1D9003AD1D9003AD1D9003AD1 - D9003AD1D9003AD1D9CC92E7FBFF3AD1D9CC38CFD7003AD1D90039D0D80039D0 - D80039D0D800FFFFFF00FFFFFF00FFFFFF0035CBD20035CBD20035CBD20036CC - D39936CCD4CC36CCD4CC36CCD4CC36CCD4CC36CCD4CC36CCD39935CBD20035CB - D20035CBD200FFFFFF00FFFFFF00FFFFFF0032C7CE0032C7CE0032C7CE0032C7 - CECC8BE6F8FF34C8CFCE8AE5F7FF32C7CECC88E6F7FF32C7CECC32C7CE0032C7 - CE0032C7CE00FFFFFF00FFFFFF00FFFFFF001DB0B4002BBFC5002BBFC5002CC0 - C6993CCAD1D73CCAD1D734C5CCD22DC1C7CC2DC1C7CC2CC0C6992BBFC5002BBF - C5001DB0B400FFFFFF00FFFFFF00FFFFFF001DB0B40021B4B90028BCC10028BC - C1CC83E4F4FF48CFD6E381E3F3FF2CBFC4CF80E4F3FF28BCC1CC28BCC10021B4 - B9001DB0B400FFFFFF00FFFFFF00FFFFFF001DB0B4001EB1B50020B3B70022B5 - BACC6FDEEAF856D6DDEF4CD0D7E842C9D0E142C9D0E122B5B9991EB1B5001EB1 - B5001DB0B400FFFFFF00FFFFFF00FFFFFF001DAFB3991DB0B4CC1DB0B4CC1DB0 - B4CC77E4F0FF63DFE6FA69E3EBFF5CD9E0F574E4EFFF1DB0B4CC1DB0B4CC1DB0 - B4CC1DAFB399FFFFFF00FFFFFF00FFFFFF0019ABAE5C18AAADCC82E4F4FF76E3 - EFFF6FE3EDFF64DEE6FF5AD4DCFF50CAD2FF52C8D1FF57C8D3FF62CDDAFF18AA - ADCC19ABAE5CFFFFFF00FFFFFF00FFFFFF0018AAAD0014A5A85C13A4A7CC7AE1 - EFFF4FCDD7FF44C2CCFF43C1CBFF43C1CBFF43C1CBFF5BCBD9FF13A4A7CC14A5 - A85C18AAAD00FFFFFF00FFFFFF00FFFFFF0018AAAD0013A4A70010A0A25C0F9F - A1CC4ECEE6FF2DC3DBFF2DC3DBFF2DC3DBFF47CDE4FF0F9FA1CC10A0A25C13A4 - A70018AAAD00FFFFFF00FFFFFF00FFFFFF000000000000000000085051000C9C - 9D5C0B9B9CCC32CDF2FF13C7EFFF2ECDF2FF0B9B9CCC0C9C9D5C085051000000 - 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 - 001906696A6E089796CC1ECCF9FF089796CC06696A6E0000001A000000110000 - 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 - 00320000003304605F74059392CC04605F740000003300000033000000220000 - 000800000000FFFFFF00FFFFFF00FFFFFF00E99E3F00E99E3F00E99E3F00EA9F - 4099EA9F40CCEA9F4099EA9F4000EA9F40CCEA9F4000E59A3D00E3983B00E398 - 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E69B3D00E69B3D00E69B3D00E69B - 3DCCFFE195FFE69B3DCCE4993C00E69B3D00E4993C00E3983B00E3983B00E398 - 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E3983B00E3983B00E3983B00E398 - 3B99E2973ACCE2973ACCE2973ACCE2973A99E2973A00E2973ACCE2973A00E297 - 3A00E2973A00FFFFFF00FFFFFF00FFFFFF00DD923600DD923600DD923600DD92 - 3600DD923600DD9236CCFEDC90FFDD9236CCDB903400DD923600DC913500DC91 - 3500DC913500FFFFFF00FFFFFF00FFFFFF00D68B3100D68B3100D68B3100D78C - 3299D88D32CCD88D32CCD88D32CCD88D32CCD88D32CCD78C3299D68B3100D68B - 3100D68B3100FFFFFF00FFFFFF00FFFFFF00D2872E00D2872E00D2872E00D287 - 2ECCFBD589FFD38930CEFAD488FFD2872ECCFAD286FFD2872ECCD2872E00D287 - 2E00D2872E00FFFFFF00FFFFFF00FFFFFF00B86D1A00C97E2700C97E2700CA7F - 2899D58E39D7D58E39D7D08731D2CB8029CCCB8029CCCA7F2899C97E2700C97E - 2700B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00BD721E00C57A2400C57A - 24CCF7CC80FFDA9645E3F6CA7EFFC87E29CFF6C97DFFC57A24CCC57A2400BD72 - 1E00B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00B96E1B00BB701D00BE73 - 1FCCEDB96CF8E1A153EFDB9949E8D4903FE1D4903FE1BD721F99B96E1B00B96E - 1B00B86D1A00FFFFFF00FFFFFF00FFFFFF00B76C1A99B86D1ACCB86D1ACCB86D - 1ACCF3C074FFE9AC60FAEEB266FFE4A659F5F2BD71FFB86D1ACCB86D1ACCB86D - 1ACCB76C1A99FFFFFF00FFFFFF00FFFFFF00B267165CB16615CCF7CB7FFFF2BF - 73FFF0B86CFFE9AD61FFDFA357FFD5994DFFD49B4FFFD6A054FFDDAB5FFFB166 - 15CCB267165CFFFFFF00FFFFFF00FFFFFF00B1661500AC61115CAB6010CCF2C3 - 77FFDB9E4CFFD09341FFCF9240FFCF9240FFCF9240FFDCA858FFAB6010CCAC61 - 115CB1661500FFFFFF00FFFFFF00FFFFFF00B1661500AB601000A65B0D5CA55A - 0CCCEAB44BFFE09E29FFE09E29FFE09E29FFE8AE43FFA55A0CCCA65B0D5CAB60 - 1000B1661500FFFFFF00FFFFFF00FFFFFF000000000000000000532D0600A156 - 095CA05508CCF7B92EFFF5AB0EFFF7B629FFA05508CCA156095C532D06000000 - 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 - 00196D39046E9B5005CCFFBB19FF9B5005CC6D39046E0000001A000000110000 - 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 - 00320000003363320274974C02CC633202740000003300000033000000220000 - 000800000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000013A2000014A5000014A5000014A6000015A8000015A9001F15AA - 00CC15AA004814A70000FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000013A2000014A5001014A700B077EE - 66FF14A700CC14A70048FFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000013A2000614A3009E43C631E56BE2 - 5AFF70E95FFB14A300CCFFFFFF00FFFFFF0011970000129B0000129C0000129B - 00001197000011990000129F0000129F000113A0008533B820DE61D850FF5CD5 - 4BFA1EA80CD213A1004CFFFFFF00FFFFFF0011970000129B0048129B00CC129B - 0048119700000F93000011970000129B006924AA13D857CF46FE55CD44FD21A7 - 10D6129C006313A00000FFFFFF00FFFFFF0011960048119700CC73EA62FD1197 - 00CC119600480F9300001196004C189D08D33DB62CFB37AF26FE1FA00EDA1197 - 007B11980000129B0000FFFFFF00FFFFFF000F9200CC6DE55CFA59D048FF69E1 - 58FC0F9200CC0F92006D139504CB34B423F832B221FF1F9F0FDF0F92008C1094 - 00021095000010950000FFFFFF00FFFFFF000E8E00480E8D00CC5FD94FF933BC - 22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA20FE40E8D009E0F8F00081094 - 000010950000084B0000FFFFFF00FFFFFF000E8D00000D8800480D8700CC43CA - 33F629C318FF39CC28FF28C217FF1EAA0FEA0D8700AE0D8A00100F8F0000084A - 00000000000000000000FFFFFF00FFFFFF00074700000A6500000B8300480B82 - 00CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85001B07450000000000000000 - 00000000000000000000FFFFFF00FFFFFF000000000000000000032000000657 - 0048077200CC16A60AE8087601C406570029021E000000000000000000000000 - 00000000000000000000FFFFFF00FFFFFF00000000020000000F0000001F0000 - 002D02330066025F00CC012B005500000029000000220000001A000000130000 - 000C0000000600000001FFFFFF00FFFFFF000000000100000008000000100000 - 00170000001A000000190000001700000015000000110000000D0000000A0000 - 00060000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF000462BF000462BF040462C0680462C08B0462 - C08B0462C08B004080CC004080CC004080CC004080CC0462C08B0462C08B0462 - C08B0462C0680462BF040462BF000461BE000461BE232A7CCCA589BCEFFF88BB - EEFF88BBEEFF35689BFF35689BFF35689BFF35689BFF88BBEEFF88BBEEFF89BC - EFFF2A7CCCA50461BE230461BE00045FBB000460BC474D94D9C489BCEFFF88BB - EEFF88BBEEFF4174A7FF4174A7FF4174A7FF3E71A4FF88BBEEFF88BBEEFF89BC - EFFF4D94D9C40460BC47045FBB00045FB900045FB96D6BA6DFE080B3E6FF80B3 - E6FF80B3E6FF4E81B4FF4E81B4FF4E81B4FF487BAEFF80B3E6FF80B3E6FF80B3 - E6FF6BA6DFE0045FB96D045FB900035DB600035DB695A7DBFEFDAADDFFFFAADD - FFFFAADDFFFF77AADDFF77AADDFF77AADDFF6699CCFFAADDFFFFAADDFFFFAADD - FFFFA7DBFEFD035DB695035DB600035BB300035BB3989FD2F9FF95C8F3FF95C8 - F3FF95C8F3FF5588BBFF4477AAFF5588BBFF4073A6FF95C8F3FF95C8F3FF95C8 - F3FF9FD2F9FF035BB398035BB300035AB000035AB09B9BCEF6FF91C4F0FF91C4 - F0FF91C4F0FF4477AAFF91C4F0FF4477AAFF91C4F0FF91C4F0FF91C4F0FF91C4 - F0FF9BCEF6FF035AB09B035AB0000358AC000358AC9F96C9F2FF8CBFECFF8CBF - ECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBF - ECFF96C9F2FF0358AC9F0358AC000356A8000356A8A38FC2EEFFBBBBBBFF87BA - E9FFBBBBBBFF87BAE9FFBBBBBBFF999999FFBBBBBBFFBBBBBBFFBBBBBBFFBBBB - BBFF999999FF02417F940356A800040404000404048ABBBBBBFF777777FFBBBB - BBFF777777FFBBBBBBFF777777FF82B5E5FF999999FFEEEEEEFFDDDDDDFFCCCC - CCFFBBBBBBFF00000066000000000251A0000251A0AB777777FF7DB0E1FF7777 - 77FF7DB0E1FF777777FF999999FF777777FF777777FF777777FF777777FF7777 - 77FF999999FF023D789B0251A00001132600014A94B87BAEE0FF7AADDFFF7AAD - DFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AAD - DFFF7BAEE0FF014A94B8011326000000001E0133669E014487C5014487C50144 - 87C5014487C5014487C5014487C5014487C5014487C5014487C5014487C50144 - 87C5014487C50133669E0000001E0000000F000000170000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A000000170000000FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0001B0C90001B2CB0001B3CC0001B3 - CC1601B3CC5B01B3CC8B01B3CCA401B3CCA401B3CC8B01B3CC5B01B3CC1601B3 - CC0001B2CB0001B0C900FFFFFF00FFFFFF0001B0C90001B2CB0001B3CC4011B9 - D0A361D8E5D097EEF7EEA5F5FDFBA5F4FDFB95EDF7EE5DD6E5D011B9D0A301B3 - CC4001B2CB0001B0C900FFFFFF00FFFFFF0001B0C90001B2CB411EBDD2B297EE - F6F08DEDFCFF81EAFBFF81EAFBFF81EAFBFF81EAFBFF8BEDFCFF8FEBF6F01BBC - D2B201B2CB4101B0C900FFFFFF00FFFFFF0001B0C91611B6CDA593EBF5F07DE8 - F8FF79E6F7FF79E6F7FF757575FF757575FF79E6F7FF79E6F7FF7CE7F8FF84E7 - F3F00EB5CDA501B0C916FFFFFF00FFFFFF0001AEC75D5AD2E1D27DE6F5FF70E2 - F3FF70E2F3FF70E2F3FF666666FF666666FF70E2F3FF70E2F3FF70E2F3FF78E5 - F5FF49CDDFD201AEC75DFFFFFF00FFFFFF0001ABC49082E4EFEF69DFF0FF69DF - F0FF69DFF0FF63DCEBFF303030FF181818FF48CCD4FF45C9D2FF45C9D2FF48CC - D4FF58D3DCEF01ABC490FFFFFF00FFFFFF0001A8C1AB85E7F3FC66DDEEFF61DB - EAFF4DD4DAFF42CFD0FF000000FF000000FF40CFCFFF40CFCFFF40CFCFFF40CF - CFFF4FD4D4FC01A8C1ABFFFFFF00FFFFFF0001A5BEAD80E5F1FC56D9E5FF3FD2 - D6FF3CD1D4FF3CD1D4FF000000FF000000FF3CD1D4FF3CD1D4FF3CD1D4FF3CD1 - D4FF44D2D6FC01A5BEADFFFFFF00FFFFFF0001A2BA945DD8E2F038D4D9FF37D4 - D9FF37D4D9FF37D4D9FF81EAEDFF81EAEDFF37D4D9FF37D4D9FF37D4D9FF37D4 - D9FF32CDD5F001A2BA94FFFFFF00FFFFFF00019FB7622DBFCED739D8DFFF32D6 - DEFF32D6DEFF32D6DEFF000000FF000000FF32D6DEFF32D6DEFF32D6DEFF32D6 - DEFF19BAC9D7019FB762FFFFFF00FFFFFF00019CB41807A1B7B136D3DEF22ED9 - E4FF2DD9E3FF2DD9E3FF000000FF000000FF2DD9E3FF2DD9E3FF2DD9E3FF26CF - DCF205A0B7B1019CB418FFFFFF00FFFFFF00019AB2000097AE47089EB4C127D0 - DFF329DBE8FF28DBE8FF7AEDF4FF7AEDF4FF28DBE8FF28DBE8FF22CFDEF3069E - B4C10097AE47019AB200FFFFFF00FFFFFF000000000000252A000067784A038E - A5BA12AFC2E01ECCDDF423D9E9FD23D9E9FD1ECCDDF412AFC2E0038EA5BA0067 - 784A00252A0000000000FFFFFF00FFFFFF0000000004000000170000002B0023 - 2943005D6D7F007C91AB008096C4008096C4007C91AB005D6D7F002329430000 - 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 - A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 - A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 - AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 - A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B - E8F65F5FE7FF5B5BE3FF4949D1FF4949D1FF5B5BE3FF5F5FE7FF5858E4F60F0F - B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 - D9FF4F4FD7FF4040C8FFFFFFFFFFFFFFFFFF4040C8FF4F4FD7FF5050D8FF4F4F - DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 - CAFF4242CAFF3636BEFFFFFFFFFFFFFFFFFF3636BEFF4242CAFF4242CAFF4747 - CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 - BFFF3737BFFF2A2AB2FFE8E8E8FFDADADAFF15159EFF12129CFF12129CFF1616 - A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E - B8FF1D1DABFF1212A1FFCCCCCCFFD1D1D1FF1111A0FF1111A1FF1111A1FF1111 - A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 - ABFF1111AAFF1111A6FFD1D1D1FFDCDCDCFF1111A6FF1111AAFF1111AAFF1111 - AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 - B4FF1111B4FF1111B4FF1111A8FF1111A8FF1111B4FF1111B4FF1111B4FF1111 - B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 - BEFF1111BEFF1111B5FFE8E8E8FFEEEEEEFF1111B5FF1111BEFF1111BEFF1111 - BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 - C8FF1111C8FF1111BCFFEEEEEEFFEEEEEEFF1111BCFF1111C8FF1111C8FF0F0F - BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 - C4F61212D1FF1111D1FF1111B6FF1111B6FF1111D1FF1111D1FF0F0FC2F60303 - 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 - 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 - 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 - 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 - 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 - 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 00170000000C00000002FFFFFF00 - } - end - object IconMed: TImageList - Height = 48 - Width = 48 - left = 27 - top = 268 - Bitmap = { - 4C69010000003000000030000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004D6BEC004D6BEC004D6BEC004D6B - EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B - EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC104D6BEC4E4D6BEC8C4D6B - ECBA4D6BECD84D6BECEE4D6BECF94D6BECF94D6BECEE4D6BECD84D6BECBA4D6B - EC8C4D6BEC4F4D6BEC104D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B - EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B - EC004D6BEC004D6BEC00FFFFFF00FFFFFF004D6AEB004D6AEB004D6AEB004D6A - EB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6A - EB004D6AEB004D6AEB074D6AEB5B4D6AEBB74D6AEBFC4D6AEBFF4D6AEBFF4D6A - EBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6A - EBFF4D6AEBFF4D6AEBFC4D6AEBB84D6AEB5B4D6AEB074D6AEB004D6AEB004D6A - EB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6A - EB004D6AEB004D6AEB00FFFFFF00FFFFFF004C6AEA004C6AEA004C6AEA004C6A - EA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6A - EA094C6AEA724C6AEAE44C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6A - EAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6A - EAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAE54C6AEA724C6AEA094C6A - EA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6A - EA004C6AEA004C6AEA00FFFFFF00FFFFFF004C69E9004C69E9004C69E9004C69 - E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9494C69 - E9DC4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9FF617BECFF8095F1FF92A4 - F4FF9DAEF6FFA6B5F7FFAAB8F8FFAAB8F8FFA6B5F7FF9DAEF6FF92A4F4FF8095 - F1FF617BECFF4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9DC4C69 - E9494C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69 - E9004C69E9004C69E900FFFFFF00FFFFFF004B68E8004B68E8004B68E8004B68 - E8004B68E8004B68E8004B68E8004B68E8004B68E8084B68E8964B68E8FF4B68 - E8FF4B68E8FF4B68E8FF5872EAFF8498F1FFA7B5F7FFACB9F8FFACB9F8FFACB9 - F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9 - F8FFACB9F8FFA8B6F7FF8498F1FF5873EAFF4B68E8FF4B68E8FF4B68E8FF4B68 - E8FF4B68E8964B68E8084B68E8004B68E8004B68E8004B68E8004B68E8004B68 - E8004B68E8004B68E800FFFFFF00FFFFFF004A67E7004A67E7004A67E7004A67 - E7004A67E7004A67E7004A67E7004A67E7174A67E7CB4A67E7FF4A67E7FF4A67 - E7FF536FE9FF8C9FF3FFAAB9F8FFAAB9F8FFAAB9F8FF9FAFF7FF8DA0F5FF7C92 - F4FF748CF3FF6F88F3FF6C85F3FF6C85F3FF6F88F3FF748CF3FF7C92F4FF8DA0 - F5FF9FAFF7FFAAB9F8FFAAB9F8FFAAB9F8FF8C9FF3FF536FE9FF4A67E7FF4A67 - E7FF4A67E7FF4A67E7CD4A67E7174A67E7004A67E7004A67E7004A67E7004A67 - E7004A67E7004A67E700FFFFFF00FFFFFF004966E5004966E5004966E5004966 - E5004966E5004966E5004966E5224966E5DB4966E5FF4966E5FF4966E5FF7188 - ECFFA4B3F6FFAAB8F7FFAAB8F7FF91A3F5FF7189F2FF647EF1FF647EF1FF647E - F1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647E - F1FF647EF1FF7189F2FF91A3F5FFAAB8F7FFAAB8F7FFA4B3F6FF7188ECFF4966 - E5FF4966E5FF4966E5FF4966E5DB4966E5214966E5004966E5004966E5004966 - E5004966E5004966E500FFFFFF00FFFFFF004965E4004965E4004965E4004965 - E4004965E4004965E41C4965E4DF4965E4FF4965E4FF4965E4FF8599F0FFA9B8 - F7FFA9B8F7FF94A6F5FF6C84F1FF637DF0FF637DF0FF637DF0FF637DF0FF637D - F0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637D - F0FF637DF0FF637DF0FF637DF0FF6C84F1FF94A6F5FFA9B8F7FFA9B8F7FF8699 - F0FF4965E4FF4965E4FF4965E4FF4965E4DF4965E41C4965E4004965E4004965 - E4004965E4004965E400FFFFFF00FFFFFF004864E2004864E2004864E2004864 - E2004864E20A4864E2CE4864E2FF4864E2FF4864E2FF8B9DF0FFA9B7F6FFA9B7 - F6FF7B91F2FF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627C - EFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627C - EFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF7B91F2FFA7B6F6FFA9B7 - F6FF8B9DF0FF4864E2FF4864E2FF4864E2FF4864E2CE4864E20A4864E2004864 - E2004864E2004864E200FFFFFF00FFFFFF004763E1004763E1004763E1004763 - E1004763E19A4763E1FF4763E1FF4763E1FF8B9DF0FFA8B6F6FFA3B2F5FF758B - F0FF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF617A - EEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF758BF0FFA3B2 - F5FFA8B6F6FF8B9DF0FF4763E1FF4763E1FF4763E1FF4763E19B4763E1004763 - E1004763E1004763E100FFFFFF00FFFFFF004662DF004662DF004662DF004662 - DF4A4662DFFF4662DFFF4662DFFF8497EDFFA7B5F5FFA0B0F4FF7188EFFF5F79 - EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5F79 - EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF7188 - EFFFA0B0F4FFA7B5F5FF8497EDFF4662DFFF4662DFFF4662DFFF4662DF4A4662 - DF004662DF004662DF00FFFFFF00FFFFFF004561DE004561DE004561DE084561 - DEDC4561DEFF4561DEFF6F85E8FFA7B5F5FFA5B3F4FF7188EEFF5E78ECFF5E78 - ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5E78 - ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78 - ECFF7188EEFFA5B3F4FFA7B5F5FF7086E8FF4561DEFF4561DEFF4561DEDD4561 - DE084561DE004561DE00FFFFFF00FFFFFF004460DC004460DC004460DC714460 - DCFF4460DCFF4E68DEFFA0AFF2FFA6B4F4FF768CEEFF5C76EBFF5C76EBFF5C76 - EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5C76 - EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76 - EBFF5C76EBFF768CEEFFA6B4F4FFA0AFF2FF4E69DEFF4460DCFF4460DCFF4460 - DC714460DC004460DC00FFFFFF00FFFFFF00435EDA00435EDA07435EDAE5435E - DAFF435EDAFF8598EBFFA5B3F3FF8EA0F1FF5B74EAFF5B74EAFF5B74EAFF5B74 - EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5B74 - EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74 - EAFF5B74EAFF5B74EAFF8EA0F1FFA5B3F3FF8598EBFF435EDAFF435EDAFF435E - DAE6435EDA08435EDA00FFFFFF00FFFFFF00425DD800425DD85B425DD8FF425D - D8FF4F68DBFFA4B2F2FFA4B2F2FF627BE9FF5973E8FF5973E8FF5973E8FF5973 - E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5973 - E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973 - E8FF5973E8FF5973E8FF627BE9FFA4B2F2FFA4B2F2FF4F69DCFF425DD8FF425D - D8FF425DD85B425DD800FFFFFF00FFFFFF00415CD700415CD7B8415CD7FF415C - D7FF7B8EE7FFA3B1F2FF889AEEFF5871E7FF5871E7FF5871E7FF5871E7FF5871 - E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FFFFFF - FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5871 - E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871 - E7FF5871E7FF5871E7FF5871E7FF889AEEFFA3B1F2FF7B8EE7FF415CD7FF415C - D7FF415CD7B8415CD700FFFFFF00FFFFFF00405BD510405BD5FC405BD5FF405B - D5FF9EACF0FFA2B0F1FF657CE8FF5670E6FF5670E6FF5670E6FF5670E6FF5670 - E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FFFAFB - FEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF9FAFEFF5670 - E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670 - E6FF5670E6FF5670E6FF5670E6FF657CE8FFA2B0F1FF9EACF0FF405BD5FF405B - D5FF405BD5FC405BD510FFFFFF00FFFFFF003F59D34F3F59D3FF3F59D3FF556C - DAFFA1AFF1FF94A5EFFF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546E - E5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FFE8EC - FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8ECFCFF546E - E5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546E - E5FF546EE5FF546EE5FF546EE5FF546EE5FF94A5EFFFA1AFF1FF556CDAFF3F59 - D3FF3F59D3FF3F59D34FFFFFFF00FFFFFF003E58D18B3E58D1FF3E58D1FF7487 - E2FFA1AEF0FF8092EAFF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536C - E3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FFD8DE - F9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFD8DEF9FF536C - E3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536C - E3FF536CE3FF536CE3FF536CE3FF536CE3FF8092EAFFA1AEF0FF7487E2FF3E58 - D1FF3E58D1FF3E58D18CFFFFFF00FFFFFF003D57CFB43D57CFFF3D57CFFF8294 - E6FF9FAEEFFF6D83E7FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516B - E2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FFC6CF - F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6CFF6FF516B - E2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516B - E2FF516BE2FF516BE2FF516BE2FF516BE2FF6D83E7FF9FAEEFFF8395E6FF3D57 - CFFF3D57CFFF3D57CFB5FFFFFF00FFFFFF003C55CDD93C55CDFF3C55CDFF8FA0 - EAFF9EADEFFF6078E4FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69 - E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FFB5C0 - F2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB4BFF2FF4F69 - E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69 - E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF6078E4FF9EADEFFF8FA0EAFF3C55 - CDFF3C55CDFF3C55CDD9FFFFFF00FFFFFF003B54CBF13B54CBFF3B54CBFF98A7 - ECFF9DACEEFF576FE2FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67 - E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FFA4B1 - EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4B1EFFF4D67 - E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67 - E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF5971E2FF9DACEEFF96A6ECFF3B54 - CBFF3B54CBFF3B54CBEDFFFFFF00FFFFFF003953C9FF3953C9FF3953C9FF9DAA - EDFF9DAAEDFF526ADFFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65 - DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF91A0 - EBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF91A0EBFF4C65 - DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65 - DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF546CDFFF9DAAEDFF9BA8ECFF3953 - C9FF3953C9FF3953C9F9FFFFFF00FFFFFF003851C7FF3851C7FF3851C7FF9CAA - ECFF9CAAECFF5069DEFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64 - DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF7E90 - E7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7F91E7FF4A64 - DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64 - DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF526BDEFF9CAAECFF9AA8EBFF3851 - C7FF3851C7FF3851C7F9FFFFFF00FFFFFF003750C6F13750C6FF3750C6FF96A4 - EAFF9BA9ECFF526BDEFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862 - DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF6D81 - E3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6D81E3FF4862 - DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862 - DCFF4862DCFF4862DCFF4862DCFF4862DCFF546CDEFF9BA9ECFF94A3E9FF3750 - C6FF3750C6FF3750C6EDFFFFFF00FFFFFF00364FC4D9364FC4FF364FC4FF8B9B - E5FF9AA8EBFF5970DEFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760 - DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF586F - DDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF586FDDFF4760 - DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760 - DAFF4760DAFF4760DAFF4760DAFF4760DAFF5970DEFF9AA8EBFF8B9BE5FF364F - C4FF364FC4FF364FC4D9FFFFFF00FFFFFF00354DC2B4354DC2FF354DC2FF7C8D - DEFF99A7EAFF6378DFFF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455E - D9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF4760 - D9FFFDFDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFDFFFF4760D9FF455E - D9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455E - D9FF455ED9FF455ED9FF455ED9FF455ED9FF6378DFFF99A7EAFF7C8DDEFF354D - C2FF354DC2FF354DC2B5FFFFFF00FFFFFF00344CC08C344CC0FF344CC0FF6B7D - D7FF98A6EAFF7486E2FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C - D8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C - D8FFEDF0FBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEEF0FBFF435CD8FF435C - D8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C - D8FF435CD8FF435CD8FF435CD8FF435CD8FF7486E2FF98A6EAFF6B7DD7FF344C - C0FF344CC0FF344CC08CFFFFFF00FFFFFF00334BBE4F334BBEFF334BBEFF495F - C8FF97A5E9FF8999E6FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B - D7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B - D7FFDADFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDADFF7FF415BD7FF415B - D7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B - D7FF415BD7FF415BD7FF415BD7FF415BD7FF8999E6FF97A5E9FF495FC8FF334B - BEFF334BBEFF334BBE4FFFFFFF00FFFFFF00324ABC10324ABCFC324ABCFF324A - BCFF92A0E6FF96A4E8FF5067D9FF4059D5FF4059D5FF4059D5FF4059D5FF4059 - D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059 - D5FF677BDEFF7385E0FF7385E0FF7385E0FF7385E0FF677BDEFF4059D5FF4059 - D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059 - D5FF4059D5FF4059D5FF4059D5FF5067D9FF96A4E8FF92A0E6FF324ABCFF324A - BCFF324ABCFC324ABC11FFFFFF00FFFFFF003148BA003148BAB83148BAFF3148 - BAFF6C7ED5FF95A3E7FF7688E0FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 - D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 - D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 - D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 - D4FF3E57D4FF3E57D4FF3E57D4FF7688E0FF95A3E7FF6D7ED5FF3148BAFF3148 - BAFF3148BAB93148BA00FFFFFF00FFFFFF003047B8003047B85B3047B8FF3047 - B8FF3E53BEFF94A2E7FF94A2E7FF475FD5FF3C56D3FF3C56D3FF3C56D3FF3C56 - D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56 - D3FF92A0E6FF97A5E8FF97A5E8FF97A5E8FF97A5E8FF97A5E8FF475FD5FF3C56 - D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56 - D3FF3C56D3FF3C56D3FF475FD5FF94A2E7FF94A2E7FF3E53BEFF3047B8FF3047 - B8FF3047B85C3047B800FFFFFF00FFFFFF002F46B7002F46B7082F46B7E62F46 - B7FF2F46B7FF7384D7FF93A1E6FF788AE0FF3B54D2FF3B54D2FF3B54D2FF3B54 - D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54 - D2FFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5268D7FF3B54 - D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54 - D2FF3B54D2FF3B54D2FF788AE0FF93A1E6FF7384D7FF2F46B7FF2F46B7FF2F46 - B7E62F46B7082F46B700FFFFFF00FFFFFF002E45B5002E45B5002E45B5712E45 - B5FF2E45B5FF384EBAFF8C9BE2FF92A1E5FF576DD7FF3953D0FF3953D0FF3953 - D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953 - D0FFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5067D6FF3953 - D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953 - D0FF3953D0FF576DD7FF92A1E5FF8C9CE2FF384EBAFF2E45B5FF2E45B5FF2E45 - B5722E45B5002E45B500FFFFFF00FFFFFF002D43B3002D43B3002D43B3082D43 - B3DD2D43B3FF2D43B3FF596BC9FF929FE5FF8F9DE4FF4F65D5FF3851CFFF3851 - CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851 - CFFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4F65D5FF3851 - CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851 - CFFF4F65D5FF8F9DE4FF929FE5FF5A6CC9FF2D43B3FF2D43B3FF2D43B3DD2D43 - B3082D43B3002D43B300FFFFFF00FFFFFF002C42B1002C42B1002C42B1002C42 - B14A2C42B1FF2C42B1FF2C42B1FF6D7DD2FF919EE4FF8897E2FF4C62D3FF364F - CEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364F - CEFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4E64D4FF364F - CEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF4C62 - D3FF8897E2FF919EE4FF6D7DD2FF2C42B1FF2C42B1FF2C42B1FF2C42B14B2C42 - B1002C42B1002C42B100FFFFFF00FFFFFF002B41B0002B41B0002B41B0002B41 - B0002B41B09C2B41B0FF2B41B0FF2B41B0FF7283D5FF909EE4FF8A98E2FF4F65 - D3FF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354E - CDFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D63D3FF354E - CDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF4F65D3FF8A98 - E2FF909EE4FF7283D5FF2B41B0FF2B41B0FF2B41B0FF2B41B09E2B41B0002B41 - B0002B41B0002B41B000FFFFFF00FFFFFF002A40AE002A40AE002A40AE002A40 - AE002A40AE0A2A40AECF2A40AEFF2A40AEFF2A40AEFF7081D3FF8F9DE3FF8D9B - E2FF546AD4FF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334D - CCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334D - CCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF546AD4FF8D9BE2FF8F9D - E3FF7081D3FF2A40AEFF2A40AEFF2A40AEFF2A40AECF2A40AE0A2A40AE002A40 - AE002A40AE002A40AE00FFFFFF00FFFFFF00293FAD00293FAD00293FAD00293F - AD00293FAD00293FAD1C293FADE0293FADFF293FADFF293FADFF697ACEFF8E9C - E2FF8E9CE2FF7283DBFF3D55CEFF324BCBFF324BCBFF324BCBFF324BCBFF324B - CBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324B - CBFF324BCBFF324BCBFF324BCBFF3D55CEFF7283DBFF8E9CE2FF8E9CE2FF697A - CEFF293FADFF293FADFF293FADFF293FADE0293FAD1C293FAD00293FAD00293F - AD00293FAD00293FAD00FFFFFF00FFFFFF00283EAB00283EAB00283EAB00283E - AB00283EAB00283EAB00283EAB22283EABDD283EABFF283EABFF283EABFF5466 - C3FF8896DFFF8E9CE2FF8E9CE2FF6D7FD9FF435ACFFF314ACAFF314ACAFF314A - CAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314A - CAFF314ACAFF435ACFFF6D7FD9FF8E9CE2FF8E9CE2FF8796DEFF5366C2FF283E - ABFF283EABFF283EABFF283EABDD283EAB22283EAB00283EAB00283EAB00283E - AB00283EAB00283EAB00FFFFFF00FFFFFF00273DAA00273DAA00273DAA00273D - AA00273DAA00273DAA00273DAA00273DAA18273DAACD273DAAFF273DAAFF273D - AAFF3146AFFF6D7DD0FF8D9BE1FF8D9BE1FF8D9BE1FF7E8EDDFF6678D7FF5166 - D2FF475DCFFF3E55CDFF3951CBFF3951CBFF3E55CDFF475DCFFF5166D2FF6678 - D7FF7E8EDDFF8D9BE1FF8D9BE1FF8D9BE1FF6D7DD0FF3146AFFF273DAAFF273D - AAFF273DAAFF273DAACD273DAA18273DAA00273DAA00273DAA00273DAA00273D - AA00273DAA00273DAA00FFFFFF00FFFFFF00273CA800273CA800273CA800273C - A800273CA800273CA800273CA800273CA800273CA808273CA899273CA8FF273C - A8FF273CA8FF273CA8FF3549B0FF6374CAFF8998DFFF8D9BE1FF8D9BE1FF8D9B - E1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9B - E1FF8D9BE1FF8998DFFF6374CAFF3549B0FF273CA8FF273CA8FF273CA8FF273C - A8FF273CA898273CA808273CA800273CA800273CA800273CA800273CA800273C - A800273CA800273CA800FFFFFF00FFFFFF00263BA700263BA700263BA700263B - A700263BA700263BA700263BA700263BA700263BA700263BA700263BA74A263B - A7DC263BA7FF263BA7FF263BA7FF263BA7FF263BA7FF3D50B4FF5E6FC7FF6E7E - D0FF7C8BD8FF8594DDFF8A98E0FF8A98E0FF8594DDFF7C8BD8FF6E7ED0FF5E6F - C7FF3D50B4FF263BA7FF263BA7FF263BA7FF263BA7FF263BA7FF263BA7DC263B - A749263BA700263BA700263BA700263BA700263BA700263BA700263BA700263B - A700263BA700263BA700FFFFFF00FFFFFF00253AA600253AA600253AA600253A - A600253AA600253AA600253AA600253AA600253AA600253AA600253AA600253A - A609253AA672253AA6E6253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253A - A6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253A - A6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6E6253AA672253AA609253A - A600253AA600253AA600253AA600253AA600253AA600253AA600253AA600253A - A600253AA600253AA600FFFFFF00FFFFFF002439A5002439A5002439A5002439 - A5002439A5002439A5002439A5002439A5002439A5002439A5002439A5002439 - A5002439A5002439A5072439A55B2439A5BA2439A5FC2439A5FF2439A5FF2439 - A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439 - A5FF2439A5FF2439A5FC2439A5BA2439A55B2439A5072439A5002439A5002439 - A5002439A5002439A5002439A5002439A5002439A5002439A5002439A5002439 - A5002439A5002439A500FFFFFF00FFFFFF002439A4002439A4002439A4002439 - A4002439A4002439A4002439A4002439A4002439A4002439A4002439A4002439 - A4002439A4002439A4002439A4002439A4002439A4112439A4502439A48B2439 - A4B52439A4D72439A4EE2439A4FA2439A4FA2439A4EE2439A4D72439A4B52439 - A48B2439A4502439A4112439A4002439A4002439A4002439A4002439A4002439 - A4002439A4002439A4002439A4002439A4002439A4002439A4002439A4002439 - A4002439A4002439A400FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00 - } - end - object IconSmall: TImageList - left = 27 - top = 328 - Bitmap = { - 4C69030000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D898 - 5223D4964D7DD2924CDBCD8C45F3CB8B41F3C98B40DBC78B407DC5873D23FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6974F53D191 - 49E6D0A06AFFE0BFA0FFE3C5AEFFE3C5AEFFDFBC9FFFC89762FFBD7D35E6BC7E - 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4964D53CF8D47F4D9B2 - 8CFFE6CDB8FFE0BA9DFFD7AB85FFD6A982FFD9B391FFE1C2ABFFD4AE86FFB16B - 35F4B16F3553FFFFFF00FFFFFF00FFFFFF00D2934C22CE8E47E5D9B28CFFE6CA - B3FFD6A97DFFD1A579FFE2C4A8FFE1C3A8FFD0A276FFD1A477FFDDBDA2FFD0AC - 85FFAB6635E5A9653522FFFFFF00FFFFFF00CE91477ECD9C68FFE7CBB4FFD4A5 - 7AFFD0A077FFCF9E74FFFBF8F5FFFBF8F5FFCB9E71FFCB9D71FFCDA177FFDFC0 - A5FFB98A5BFFA45C347EFFFFFF00FFFFFF00CB8E41DBE0BC9FFFDBB393FFCFA0 - 75FFCD9E72FFCB9C71FFDDBFA3FFDDBFA2FFC5996BFFC5996BFFC4986BFFD1AB - 85FFD8BA97FF9E5635DBFFFFFF00FFFFFF00C5853BF6E4C9B0FFD0A37AFFCC9D - 71FFC79A6CFFC5986BFFFFFFFFFFFFFFFEFFC39669FFC19468FFC29468FFC398 - 6DFFDFC5ABFF955334F6FFFFFF00FFFFFF00BF7E35F6E3C7AFFFD0A276FFC599 - 6BFFC4976AFFC49669FFEEE0D4FFFBF7F4FFBF9066FFBE8F65FFBE8F64FFBE92 - 69FFDFC6AAFF925034F6FFFFFF00FFFFFF00BC7E35DBDBBC9CFFD5AD89FFC798 - 6CFFC39569FFC19367FFEDDFD3FFFAF7F4FFBB8B63FFB98A63FFB88A62FFC59D - 78FFD2B893FF905135DBFFFFFF00FFFFFF00B878357EBF915EFFE0C2A8FFC596 - 6CFFC29169FFE1CBB8FFFEFDFCFFFFFFFEFFEADCD0FFB4855EFFB3855EFFD4B5 - 99FFAE7B56FF8F51357EFFFFFF00FFFFFF00AF703522AB6935E5CFAA81FFDABC - A2FFBE9166FFBA8C62FFB7895FFFB3845EFFB1835DFFB0835CFFCDAA8DFFC6A5 - 79FF895034E589503522FFFFFF00FFFFFF00FFFFFF00A76234539F5533F4CBA7 - 7DFFD8BB9FFFC39C77FFB68A62FFB48660FFBE9672FFD1B397FFC5A377FF844F - 35F489503553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009F5634539955 - 34E6B28057FFD5B793FFDBC3A6FFDAC3A6FFD2B490FFAB7A52FF864F34E68850 - 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009754 - 35239453347D925234DB8A5034F3884F34F3895035DB8950357D84503623FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006A85 - FC236984FA7D6782F9DB6580F7F3637EF5F3617CF3DB5F7AF17D5D77EF23FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006984FA536C85 - F9E76E83EEFF92A6F4FFA0B4F8FFA0B4F8FF91A6F3FF687DE9FF5D76EBE65671 - E953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006883F953748DF9F58497 - F1FFA9BDFBFF8AA3F8FF6B89F6FF6B89F6FF89A2F8FFA8BCFAFF7F92ECFF6279 - E6F54F69E253FFFFFF00FFFFFF00FFFFFF006781F8226983F6E68397F0FFACBF - FBFF6382F5FF6382F5FF6382F5FF617EF3FF617EF3FF607CF3FFA6B9F9FF7B8D - EAFF4D66DFE54862DB22FFFFFF00FFFFFF00637EF57E6C81ECFFA9BDFBFF6382 - F5FF8099F7FFA4B6F9FF6280F4FF607BF1FFA5B4F7FF7B8FF3FF5D76EFFFA5B5 - F8FF5D70DDFF435DD77EFFFFFF00FFFFFF005F7AF1DB91A6F3FF88A1F8FF6280 - F4FFA4B5F8FFE7EBFDFFA8B8F8FFABB8F7FFE7EBFDFF9EACF5FF5B70ECFF8293 - F1FF8998ECFF3E58D2DBFFFFFF00FFFFFF005B76EDF6A1B6F8FF6784F4FF607C - F3FF5F7AF1FFA8B5F7FFE7EBFDFFE7EAFCFFA1ADF4FF5A6EEBFF596CEAFF5F6F - E9FF9BA8F1FF3A53CEF6FFFFFF00FFFFFF005771E9F6A0B3F7FF6580F2FF5F78 - F0FF5E77EFFFAAB6F6FFE7EAFCFFE6E9FCFFA5AFF4FF5869E8FF5767E7FF5D6C - E7FF99A5F1FF354FCAF6FFFFFF00FFFFFF00526DE5DB8E9FF0FF8499F4FF5C73 - EEFFA4AFF4FFE6E9FCFFA1ADF4FFA3ACF2FFE6E8FBFF9CA5F0FF5562E5FF7D89 - EBFF8591E7FF314AC6DBFFFFFF00FFFFFF004E68E17E6073E0FFA4B3F7FF5A6E - EBFF7685EEFF9BA5F1FF5869E8FF5562E5FF9CA3F0FF6F7AE8FF535FE2FF9FA9 - F2FF5061D1FF2D46C27EFFFFFF00FFFFFF004963DC224B64DBE67888E6FFA7B3 - F5FF5767E7FF5665E6FF5665E6FF535FE2FF535FE2FF525DE1FF9FA9F2FF6F7D - DDFF2D46C1E52942BE22FFFFFF00FFFFFF00FFFFFF00425CD5533F59D3F47584 - E3FFA1ACF4FF7F8BECFF5C67E4FF5B66E3FF7D87EAFF9FA8F1FF6F7CDDFF2943 - BFF42741BD53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003A54CF533852 - CCE65264D4FF8490E7FF95A0EEFF959FEDFF838EE5FF4C5DCEFF2841BDE6263F - BB53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00334D - C823314BC67D2F48C4DB2C46C2F32A44C0F32842BEDB2640BC7D243EBA23FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0040C9 - 62233BC55E7D39C25BDB31BD54F32DBB52F32BB952DB2BB7527D28B44E23FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003DC7605336C2 - 59E659C274FF96D7A3FFA5DCAEFFA5DCAEFF95D6A1FF50B96AFF1FAB42E61FA9 - 4253FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003BC55E5334C055F47FCE - 90FFAFE1B7FF92D89DFF77CE83FF77CE83FF92D89DFFAEE1B5FF78C88BFF1D9D - 32F41D9D3653FFFFFF00FFFFFF00FFFFFF0039C25C2234BE55E57FCE90FFAEE1 - B5FF6DCC7AFF6ACA76FF68C872FF68C874FF68C875FF6BC979FFACDFB4FF76C4 - 89FF1C962DE51C942D22FFFFFF00FFFFFF0034BE597E57BF70FFAFE1B7FF6DCC - 7AFF68C872FF65C770FF63C56EFF62C46EFF63C471FFB6E3BEFF6FC77EFFACDF - B5FF48A95EFF1C8F267EFFFFFF00FFFFFF002DBB54DB95D7A1FF91D79BFF69C9 - 76FF64C66FFF61C46EFF61C36FFF61C26FFFB9E4C0FFFFFFFFFFE3F4E6FF8BD1 - 99FF8BCE9DFF1C8820DBFFFFFF00FFFFFF0026B44BF6A7DDB1FF72CC80FF66C7 - 73FFB0E1B7FFD2EED6FF63C170FFB8E3BFFFFFFFFFFFFBFDFCFF8CD099FF69C1 - 7EFFA1D7AEFF1B7F1EF6FFFFFF00FFFFFF001FAD42F6A6DCAFFF70CA7FFF73CA - 80FFF0F9F1FFFFFFFFFFEBF7EDFFFFFFFFFFFBFDFCFF88CD96FF5BB971FF67BE - 7DFFA0D7AFFF1B7A1EF6FFFFFF00FFFFFF001FA942DB91D29FFF8DD49AFF64C3 - 74FF79C987FFF2FAF4FFFFFFFFFFFDFEFDFF86CB96FF57B76DFF5BB972FF85CC - 97FF87C79AFF1B781FDBFFFFFF00FFFFFF001EA43D7E4CB064FFAADDB4FF64C1 - 79FF5FBE71FF75C585FFD4ECD9FF8ACD99FF56B66CFF58B56EFF5CB774FFA6DA - B4FF419B4EFF1B771F7EFFFFFF00FFFFFF001D9B36221C962FE572C287FFA8DB - B2FF60BC77FF5CBA73FF59B870FF59B56FFF58B56FFF5BB774FFA5D9B3FF69B8 - 7FFF1A711EE51B711F22FFFFFF00FFFFFF00FFFFFF001C912B531B8A20F46DBE - 83FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB98FFA5D9B4FF66B77DFF1A6C - 1DF41B711F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C8A21531B83 - 1FE642A052FF87CA9AFF9BD3ABFF9BD2ABFF83C796FF3D974CFF1A6E1EE61B70 - 1F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C81 - 1F231B7E1F7D1B7A1FDB1A731EF31A701EF31B711FDB1B711F7D1B6C1F23FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00 - } - end - object pmEditURL: TPopupMenu - OnPopup = pmEditURLPopup - left = 592 - top = 136 - object medURLUndo: TMenuItem - Caption = 'Undo' - OnClick = medURLUndoClick - end - object MenuItem9: TMenuItem - Caption = '-' - end - object medURLCut: TMenuItem - Caption = 'Cut' - OnClick = medURLCutClick - end - object medURLCopy: TMenuItem - Caption = 'Copy' - OnClick = medURLCopyClick - end - object medURLPaste: TMenuItem - Caption = 'Paste' - OnClick = medURLPasteClick - end - object medURLPasteandgo: TMenuItem - Caption = 'Paste and go' - OnClick = medURLPasteandgoClick - end - object medtURLDelete: TMenuItem - Caption = 'Delete' - OnClick = medtURLDeleteClick - end - object MenuItem15: TMenuItem - Caption = '-' - end - object medURLSelectAll: TMenuItem - Caption = 'Select all' - OnClick = medURLSelectAllClick - end - end - object appPropertiesMain: TApplicationProperties - CaptureExceptions = False - OnShowHint = appPropertiesMainShowHint - left = 80 - top = 448 - end - object itStartup: TIdleTimer - Enabled = False - Interval = 500 - OnTimer = itStartupTimer - left = 696 - top = 72 - end - object tmBackup: TIdleTimer - Interval = 60000 - OnTimer = tmBackupTimer - left = 696 - top = 120 - end - object itMonitor: TTimer - Enabled = False - Interval = 1500 - OnTimer = itMonitorTimer - left = 760 - top = 296 - end - object TransferRateGraphList: TListChartSource - DataPoints.Strings = ( - '1|0|?|' - ) - left = 648 - top = 72 - end -end +object MainForm: TMainForm + Left = 297 + Height = 587 + Top = 66 + Width = 771 + ActiveControl = pcMain + Caption = 'Free Manga Downloader' + ClientHeight = 587 + ClientWidth = 771 + Color = clWindow + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnWindowStateChange = FormWindowStateChange + ShowHint = True + LCLVersion = '1.8.0.6' + object sbUpdateList: TStatusBar + AnchorSideBottom.Control = sbMain + Left = 0 + Height = 30 + Top = 534 + Width = 771 + AutoSize = False + Panels = < + item + Width = 50 + end> + ParentShowHint = False + SimplePanel = False + SizeGrip = False + ShowHint = True + Visible = False + OnDrawPanel = sbUpdateListDrawPanel + end + object pcMain: TPageControl + Left = 2 + Height = 526 + Top = 8 + Width = 769 + ActivePage = tsDownload + Align = alClient + ParentFont = False + TabIndex = 0 + TabOrder = 0 + OnChange = pcMainChange + object tsDownload: TTabSheet + Caption = 'Downloads' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 498 + ClientWidth = 761 + object psDownloads: TPairSplitter + Left = 0 + Height = 490 + Top = 4 + Width = 761 + Align = alClient + Position = 200 + object pssDownloadsFilter: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 490 + Top = 0 + Width = 200 + ClientWidth = 200 + ClientHeight = 490 + object tvDownloadFilter: TTreeView + Left = 0 + Height = 490 + Top = 0 + Width = 200 + Align = alClient + AutoExpand = True + Images = IconList + ReadOnly = True + TabOrder = 0 + OnSelectionChanged = tvDownloadFilterSelectionChanged + Options = [tvoAutoExpand, tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] + end + end + object pssDownloads: TPairSplitterSide + Cursor = crArrow + Left = 205 + Height = 490 + Top = 0 + Width = 556 + ChildSizing.HorizontalSpacing = 4 + ClientWidth = 556 + ClientHeight = 490 + object pnDownloadToolbar: TPanel + AnchorSideBottom.Control = edDownloadsSearch + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 26 + Top = 0 + Width = 556 + Align = alTop + BevelOuter = bvNone + ClientHeight = 26 + ClientWidth = 556 + TabOrder = 0 + object TransferRateGraph: TChart + AnchorSideLeft.Control = pnDownloadToolbarLeft + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edDownloadsSearch + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = pnDownloadToolbar + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Side = asrBottom + Left = 475 + Height = 25 + Top = 0 + Width = 81 + AllowZoom = False + AxisList = < + item + Minors = <> + Title.LabelFont.Orientation = 900 + end + item + Alignment = calBottom + Minors = <> + end> + AxisVisible = False + BackColor = clDefault + Extent.UseXMin = True + Extent.UseYMin = True + Extent.XMin = 1 + Extent.YMin = 1 + Foot.Brush.Color = clBtnFace + Foot.Font.Color = clBlue + Frame.Color = clGreen + Frame.Visible = False + Legend.Alignment = laCenterRight + Legend.BackgroundBrush.Style = bsClear + Legend.Frame.Visible = False + Legend.MarginX = 0 + Legend.MarginY = 0 + Legend.Spacing = 2 + Legend.SymbolWidth = 0 + Legend.UseSidebar = False + Legend.Visible = True + Margins.Left = 0 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 0 + MarginsExternal.Left = 0 + MarginsExternal.Top = 0 + MarginsExternal.Right = 0 + MarginsExternal.Bottom = 0 + Title.Brush.Color = clBtnFace + Title.Font.Color = clBlue + Title.Text.Strings = ( + 'TAChart' + ) + Toolset = TransferRateToolset + Anchors = [akTop, akLeft, akRight] + Visible = False + object TransferRateGraphArea: TAreaSeries + Transparency = 125 + AreaBrush.Color = 8453888 + AreaContourPen.Color = 5481984 + AreaLinesPen.Style = psClear + Source = TransferRateGraphList + end + end + object pnDownloadToolbarLeft: TPanel + AnchorSideLeft.Control = edDownloadsSearch + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edDownloadsSearch + AnchorSideTop.Side = asrCenter + Left = 150 + Height = 25 + Top = 0 + Width = 321 + AutoSize = True + BorderSpacing.Right = 4 + BevelOuter = bvNone + ClientHeight = 25 + ClientWidth = 321 + TabOrder = 1 + object ToolBarDownload: TToolBar + Left = 0 + Height = 25 + Top = 0 + Width = 321 + AutoSize = True + ButtonHeight = 25 + ButtonWidth = 23 + EdgeBorders = [] + Images = IconList + List = True + ParentFont = False + ShowCaptions = True + TabOrder = 0 + TabStop = True + Transparent = True + object tbDownloadResumeAll: TToolButton + Left = 1 + Top = 0 + AutoSize = True + Caption = 'Resume All' + ImageIndex = 12 + OnClick = tbDownloadResumeAllClick + end + object tbDownloadStopAll: TToolButton + Left = 86 + Top = 0 + AutoSize = True + Caption = 'Stop All' + ImageIndex = 7 + OnClick = tbDownloadStopAllClick + end + object tbSeparator1: TToolButton + Left = 153 + Height = 25 + Top = 0 + Style = tbsDivider + Visible = False + end + object tbDownloadDeleteCompleted: TToolButton + Left = 158 + Top = 0 + AutoSize = True + Caption = 'Delete all completed tasks' + ImageIndex = 9 + OnClick = tbDownloadDeleteCompletedClick + Visible = False + end + end + end + object edDownloadsSearch: TEditButton + Left = 0 + Height = 23 + Top = 1 + Width = 150 + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edDownloadsSearchButtonClick + OnChange = edDownloadsSearchChange + PasswordChar = #0 + TabOrder = 2 + TextHint = 'Search downloads...' + end + end + object pnDownloadList: TPanel + AnchorSideLeft.Side = asrBottom + Left = 0 + Height = 464 + Top = 26 + Width = 556 + Align = alClient + Anchors = [akTop, akLeft, akRight] + BevelOuter = bvNone + ClientHeight = 464 + ClientWidth = 556 + ParentBidiMode = False + TabOrder = 1 + object ToolBarDownloadLeft: TToolBar + Left = 0 + Height = 464 + Top = 0 + Width = 25 + Align = alLeft + AutoSize = True + BorderSpacing.Right = 4 + ButtonHeight = 24 + ButtonWidth = 24 + Color = clWindow + EdgeBorders = [] + EdgeInner = esNone + EdgeOuter = esNone + Images = IconDLLeft + ParentColor = False + TabOrder = 0 + object tbmiDownloadMoveTop: TToolButton + Left = 1 + Hint = 'Move selected item(s) to top' + Top = 0 + AutoSize = True + ImageIndex = 0 + OnClick = tbmiDownloadMoveTopClick + end + object tbmiDownloadMoveUp: TToolButton + Left = 1 + Hint = 'Move selected item(s) up' + Top = 28 + AutoSize = True + ImageIndex = 1 + OnClick = tbmiDownloadMoveUpClick + end + object tbmiDownloadMoveDown: TToolButton + Left = 1 + Hint = 'Move selected item(s) down' + Top = 56 + AutoSize = True + ImageIndex = 2 + OnClick = tbmiDownloadMoveDownClick + end + object tbmiDownloadMoveBottom: TToolButton + Left = 1 + Hint = 'Move selected item(s) to bottom' + Top = 84 + AutoSize = True + ImageIndex = 3 + OnClick = tbmiDownloadMoveBottomClick + end + end + object vtDownload: TVirtualStringTree + Left = 29 + Height = 464 + Top = 0 + Width = 527 + Align = alClient + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + DragOperations = [doMove] + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Text = 'Manga' + Width = 100 + end + item + Position = 1 + Text = 'Status' + Width = 200 + end + item + Position = 2 + Text = 'Progress' + Width = 55 + end + item + Position = 3 + Text = 'Transfer rate' + end + item + Position = 4 + Text = 'Website' + Width = 65 + end + item + Position = 5 + Text = 'Save to' + Width = 150 + end + item + Position = 6 + Text = 'Added' + Width = 80 + end> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible] + HintMode = hmHintAndDefault + Images = IconDL + Margin = 2 + ParentFont = False + ParentShowHint = False + PopupMenu = pmDownload + ShowHint = True + TabOrder = 1 + TextMargin = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking, toDisableAutoscrollOnFocus] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnColumnDblClick = vtDownloadColumnDblClick + OnDragAllowed = vtDownloadDragAllowed + OnDragOver = vtDownloadDragOver + OnDragDrop = vtDownloadDragDrop + OnDrawText = vtDownloadDrawText + OnFocusChanged = vtDownloadFocusChanged + OnGetText = vtDownloadGetText + OnPaintText = vtDownloadPaintText + OnGetImageIndex = vtDownloadGetImageIndex + OnGetHint = vtDownloadGetHint + OnHeaderClick = vtDownloadHeaderClick + OnKeyAction = vtDownloadKeyAction + OnKeyDown = vtDownloadKeyDown + OnKeyUp = vtDownloadKeyUp + end + end + end + end + end + object tsInformation: TTabSheet + Caption = 'Manga Info' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 498 + ClientWidth = 761 + object psInfo: TPairSplitter + Left = 0 + Height = 490 + Top = 4 + Width = 761 + Align = alClient + Position = 200 + object pssInfoList: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 490 + Top = 0 + Width = 200 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientWidth = 200 + ClientHeight = 490 + object vtMangaList: TVirtualStringTree + AnchorSideTop.Control = lbMode + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 409 + Top = 81 + Width = 200 + Align = alBottom + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + DragOperations = [] + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.MainColumn = -1 + HintMode = hmHint + Margin = 0 + ParentShowHint = False + PopupMenu = pmMangaList + ShowHint = True + TabOrder = 2 + TextMargin = 3 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect, toRightClickSelect] + OnBeforeCellPaint = vtMangaListBeforeCellPaint + OnChange = vtMangaListChange + OnColumnDblClick = vtMangaListColumnDblClick + OnFreeNode = vtMangaListFreeNode + OnGetText = vtMangaListGetText + OnGetHint = vtMangaListGetHint + OnGetNodeDataSize = vtMangaListGetNodeDataSize + OnInitNode = vtMangaListInitNode + end + object btAbortUpdateList: TSpeedButton + Left = 104 + Height = 22 + Hint = 'Abort update list' + Top = 104 + Width = 23 + Flat = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00020000000C000000160000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A000000170000000C00000002FFFFFF00FFFFFF000000 + 0004000000170000002B00001A430000448000005AAB00005DC400005DC40000 + 5AAB0000448000001A430000002D0000001800000004FFFFFF00FFFFFF000000 + 000000001F000000534D020274BF08089DE30E0EC4F51111D4FD1111D4FD0E0E + C4F508089DE3020274BF0000534D00001F0000000000FFFFFF00FFFFFF000000 + 830000007F4D040488CD1212C4F61212B6FF1111D1FF1111D1FF1111D1FF1111 + D1FF1111B6FF0F0FC2F6030388CD00007F4D00008300FFFFFF00FFFFFF000000 + 851A03038ABF1818C1F61212B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 + B2FFEEEEEEFF1111B2FF0F0FBCF6020289BF0000851AFFFFFF00FFFFFF000000 + 896C1616AAE21616C1FFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA + EAFFEEEEEEFFEEEEEEFF1111BEFF0909A1E30000896CFFFFFF00FFFFFF000000 + 8DA72E2EC0F51212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 + E6FFEAEAEAFF1111B4FF1111B4FF1212AFF500008DA7FFFFFF00FFFFFF000000 + 92C44444CDFD2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 + E2FF1111AAFF1111AAFF1111AAFF1818AFFD000092C4FFFFFF00FFFFFF000000 + 96C44949D1FD3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC + DCFF11119EFF1111A1FF1111A1FF1D1DACFD000096C4FFFFFF00FFFFFF000000 + 9AA74747D3F53737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB + DBFFDDDDDDFF11119BFF1616A0FF2727B4F500009AA7FFFFFF00FFFFFF000000 + 9E6C3232C6E34949D1FFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF + FFFFFFFFFFFFFFFFFFFF4747CFFF2A2ABDE300009E6CFFFFFF00FFFFFF000000 + A11A0808A8BF5656E2F65151D9FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F + D7FFFFFFFFFF5050D8FF4F4FDCF60707A7BF0000A11AFFFFFF00FFFFFF000000 + A2000000A54D1010B1CD5B5BE8F65F5FE7FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B + E3FF5F5FE7FF5858E4F60F0FB0CD0000A54D0000A200FFFFFF00FFFFFF000000 + A2000000A5000000A84D0909AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5B + E9F53636CFE30909AEBF0000A84D0000A5000000A200FFFFFF00FFFFFF000000 + A2000000A5000000A8000000A91A0000AA6C0000AAA60000AAC40000AAC40000 + AAA60000AA6C0000A91A0000A8000000A5000000A200FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btAbortUpdateListClick + ShowCaption = False + ShowHint = True + ParentShowHint = False + end + object cbSelectManga: TComboBox + AnchorSideRight.Control = btUpdateList + Left = 0 + Height = 23 + Hint = 'For more manga sites, please go to Options->Manga sites' + Top = 0 + Width = 171 + Anchors = [akTop, akLeft, akRight] + AutoComplete = True + AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + '' + ) + OnEditingDone = cbSelectMangaEditingDone + OnKeyDown = cbSelectMangaKeyDown + OnMouseDown = cbSelectMangaMouseDown + ParentShowHint = False + ShowHint = True + Sorted = True + TabOrder = 0 + end + object btUpdateList: TSpeedButton + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbSelectManga + AnchorSideRight.Control = vtMangaList + AnchorSideRight.Side = asrBottom + Left = 175 + Height = 23 + Hint = 'Update manga list' + Top = 0 + Width = 25 + Anchors = [akTop, akRight] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 20000000000000040000640000006400000000000000000000000000001F0000 + 0084000000E4733100C5733100C5733100C5733100C5733100C5733100C57331 + 00C5582500A00000002200000000000000000000000000000000000000100101 + 01D1606060FFCA9764FFC69360FFC69360FFC69360FFC69360FFC69360FFCA97 + 64FF803A00BE0000002B0000001A000000110000000000000000010101000101 + 01C8646464FFCA9764FFBE8B58FFC18E5BFFC18E5BFFC18E5BFFBE8B58FFCA97 + 64FF9C5E28F7733100C5582500A0000000220000000000000000010101000101 + 01C3696969FFCF9C69FFBF8C59FFC69360FFC69360FFC69360FFBF8C59FFCF9C + 69FFAD713AFFCA9764FF803A00BE0000001A0000001A00000011010101000101 + 01BE6E6E6EFFD4A16EFFBF8C59FFCB9865FFCB9865FFCB9865FFBF8C59FFD4A1 + 6EFFB0733BFFCA9764FF9C5E28F7733100C5582500A000000022010101000101 + 01BA737373FFD9A673FFBF8C59FFD09D6AFFD09D6AFFD09D6AFFBF8C59FFD9A6 + 73FFB4783EFFCF9C69FFAD713AFFCA9764FF853D00B623100000010101000101 + 01B5787878FFDEAB78FFBE8B58FFE1AE7BFFE1AE7BFFE1AE7BFFBE8B58FFDEAB + 78FFB87B40FFD4A16EFFB0733BFFCA9764FF8E4200B08E420000010101000101 + 01B27C7C7CFFE2AF7CFFBC8956FFBC8956FFBC8956FFBC8956FFBC8956FFE2AF + 7CFFBB7E42FFD9A673FFB4783EFFCF9C69FF934600AC93460000010101000101 + 01AE808080FFEAB784FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 + 84FFBD8043FFDEAB78FFB87B40FFD4A16EFF984900A898490000010101000101 + 01AC555555FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 + 66FFBF8144FFE2AF7CFFBB7E42FFD9A673FF9C4C00A49C4C0000040404000404 + 048ABDBDACFFC3C3B4FFCCCCBEFFD6D6CBFFE0E0D8FFEAEAE5FFF3F3F1FFFBFB + FAFFB4A484FFEAB784FFBD8043FFDEAB78FFA04F00A1A04F0000040404000404 + 04460404048AA16A33EEAA7744FFC28548FFC28548FFC28548FFC28548FFC285 + 48FFC28548FFCC9966FFBF8144FFE2AF7CFFA451009EA4510000040404000404 + 0400040404000404048ABDBDACFFC3C3B4FFCCCCBEFFD6D6CBFFE0E0D8FFEAEA + E5FFF3F3F1FFFBFBFAFFB4A484FFEAB784FFA753009CA7530000040404000404 + 040004040400040404460404048AA16A33EEAA7744FFC28548FFC28548FFC285 + 48FFC28548FFC28548FFC28548FFCC9966FFAA55009AAA550000040404000404 + 04000404040004040400040404000404048ABDBDACFFC3C3B4FFCCCCBEFFD6D6 + CBFFE0E0D8FFEAEAE5FFF3F3F1FFFBFBFAFF55552B6655552B00000000000202 + 0200040404000404040004040400040404460404048AAA550099AA550099AA55 + 0099AA550099AA550099AA550099AA550099AA550073AA550000 + } + OnClick = btUpdateListClick + ShowCaption = False + end + object edMangaListSearch: TEdit + AnchorSideLeft.Control = cbSelectManga + AnchorSideTop.Control = cbSelectManga + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = cbSelectManga + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 23 + Top = 27 + Width = 171 + Anchors = [akTop, akLeft, akRight] + OnChange = edMangaListSearchChange + OnKeyDown = edMangaListSearchKeyDown + TabOrder = 1 + TextHint = 'Search title...' + end + object btMangaListSearchClear: TSpeedButton + AnchorSideLeft.Control = edMangaListSearch + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edMangaListSearch + AnchorSideTop.Side = asrCenter + Left = 175 + Height = 23 + Top = 27 + Width = 25 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btMangaListSearchClearClick + ShowCaption = False + end + object lbMode: TLabel + AnchorSideLeft.Control = edMangaListSearch + AnchorSideTop.Control = edMangaListSearch + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edMangaListSearch + AnchorSideRight.Side = asrBottom + Left = 0 + Height = 15 + Top = 58 + Width = 171 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + Caption = 'Mode: Show all (0)' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object btRemoveFilter: TSpeedButton + AnchorSideLeft.Control = lbMode + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbMode + AnchorSideTop.Side = asrCenter + Left = 175 + Height = 23 + Top = 54 + Width = 25 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 00050000001E000000320000003300000082000000830101014E000000330000 + 003300000022000000080000000000005A000000770000008000000000000000 + 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 + 001A000000110000000400005A00000077000000770000008000000000000000 + 000000000000000000000202020002020272C4B5B5FF05050578040426000000 + 8499000080CC000080CC000080CC000080CC000080CC00008499000000000000 + 000000000000010101000101010001010174C4B5B5FF0909097E060651000000 + 98CC5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF000098CC000000000000 + 00000000000000000000000000000000007AC4B5B5FF0B0B0B87070759000000 + A6990000A7CC0000A7CC0000A7CC0000A7CC0000A7CC0000A699000000000000 + 00000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D0D000000 + A7000000AA000000AA000000AA000000AA000000AA000000A7001B1B1B001616 + 16000404040000000000000000000000007BC4B5B5FF0B0B0B89121212000C0C + 61000000AA000000AA000000AA000000AA000000AA000000A700363636002C2C + 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 + 250027275200101090000000AA000000AA000000AA000000A700363636002C2C + 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 + 252D353535004343430035355F00121291000000AA000000A700363636002C2C + 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 + 257E3535352A43434300464646004646460035355F0023237700363636002C2C + 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD + CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C + 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA + CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C + 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD + ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA + EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 + D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C + 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 + 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btRemoveFilterClick + ShowCaption = False + end + end + object pssInfo: TPairSplitterSide + Cursor = crArrow + Left = 205 + Height = 490 + Top = 0 + Width = 556 + ClientWidth = 556 + ClientHeight = 490 + object pcInfo: TPageControl + Left = 0 + Height = 490 + Top = 0 + Width = 556 + ActivePage = tsInfoManga + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tsInfoManga: TTabSheet + Caption = 'Info' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 462 + ClientWidth = 548 + object sbInformation: TScrollBox + Left = 0 + Height = 454 + Top = 4 + Width = 548 + HorzScrollBar.Page = 308 + VertScrollBar.Page = 401 + Align = alClient + Anchors = [akRight, akBottom] + BorderStyle = bsNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 454 + ClientWidth = 548 + TabOrder = 0 + object pnInfomation: TPanel + Left = 0 + Height = 248 + Top = 0 + Width = 548 + Align = alTop + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 248 + ClientWidth = 548 + ParentFont = False + TabOrder = 0 + object edURL: TEditButton + Left = 0 + Height = 23 + Top = 0 + Width = 548 + Align = alTop + ButtonWidth = 30 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0001000000070000000E000000150000001A0000001A0000001A0000001A0000 + 001A0000001A000000160000000F0000000800000002FFFFFF00FFFFFF000000 + 00020000000E0000001C0000002A000000330000003300000033733A02A66332 + 0274000000330000002B0000001D0000000F00000003FFFFFF00FFFFFF000000 + 00000000000000000000000000000000000000000000281502009D5206CC9D52 + 06CC763E055C29160300000000000000000000000000FFFFFF00FFFFFF005933 + 0B0058320A0058320A0058320A0058320A0058320A00A3580B00A3580BCCFFBA + 18FFA3580BCCA4590C5C7F470C002C19050000000000FFFFFF00FFFFFF00B166 + 1600AF641400AF641400AF641400AF641400AF641400AE631300AA5F10CCFFB9 + 12FFFFBC1EFFAA5F10CCAB60115CB1661600B96E1C00FFFFFF00FFFFFF00B267 + 1799B16616CCB16616CCB16616CCB16616CCB16616CCB16616CCB16616CCF7B5 + 25FFF5AB0EFFF7BA32FFB16616CCB267175CB96E1C00FFFFFF00FFFFFF00B96E + 1CCCF7CD81FFF4C276FFF3C071FFEEB85BFFE8B049FFE7AE45FFE6AD43FFE3A5 + 35FFE19E29FFE19E29FFEBB54DFFB96E1CCCBA6F1D5CFFFFFF00FFFFFF00C277 + 22CCF5C77BFFEEB266FFEEB266FFEEB266FFEAAE60FFE1A453FFD89B49FFD396 + 44FFD09341FFD09341FFD39644FFE8B868FFC27722CCFFFFFF00FFFFFF00CA7F + 28CCFAD589FFF6C97DFFF6C87CFFF5C77BFFF5C77BFFF5C67AFFF5C579FFF2BC + 70FFEFB468FFEFB468FFF8CF83FFCA7F28CCC97E275CFFFFFF00FFFFFF00D186 + 2D99D2872ECCD2872ECCD2872ECCD2872ECCD2872ECCD2872ECCD2872ECCF8CD + 81FFF4BE72FFFCD98DFFD2872ECCD1862D5CCA7F2800FFFFFF00FFFFFF00D287 + 2E00D3882F00D3882F00D3882F00D3882F00D3882F00D58A3100D98E33CCFCD5 + 89FFFEE094FFD98E33CCD88D335CD2872E00CA7F2800FFFFFF00FFFFFF00D287 + 2E00D3882F00D3882F00D3882F00D3882F00D78C3200E0953800E09538CCFFE4 + 98FFE09538CCDF94385CD98E3300D2872E00CA7F2800FFFFFF00FFFFFF00D287 + 2E00D3882F00D3882F00D3882F00D88D3300E59A3C00E59A3C00E59A3CCCE59A + 3CCCE59A3C5CE0953800D98E3300D2872E00CA7F2800FFFFFF00FFFFFF00D287 + 2E00D3882F00D3882F00D3882F00E89D3F00E89D3F00E89D3F00E99E4099E99E + 405CE59A3C00E0953800D98E3300D2872E00CA7F2800FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edURLButtonClick + OnKeyDown = edURLKeyDown + OnKeyPress = edURLKeyPress + PasswordChar = #0 + PopupMenu = pmEditURL + TabOrder = 0 + TextHint = 'Input URL here' + end + object rmInformation: TRichMemo + AnchorSideLeft.Control = pnThumbContainer + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edURL + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edURL + AnchorSideRight.Side = asrBottom + Left = 158 + Height = 219 + Top = 27 + Width = 390 + Anchors = [akTop, akLeft, akRight, akBottom] + HideSelection = False + ReadOnly = True + ScrollBars = ssAutoVertical + TabOrder = 2 + ZoomFactor = 1 + end + object btDonate: TImage + Cursor = crHandPoint + Left = -56 + Height = 21 + Top = 14 + Width = 75 + Anchors = [akTop, akRight] + OnClick = btDonateClick + Stretch = True + Visible = False + end + object pnThumbContainer: TPanel + AnchorSideLeft.Control = edURL + AnchorSideTop.Control = edURL + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 216 + Top = 27 + Width = 154 + BevelOuter = bvNone + BorderStyle = bsSingle + ClientHeight = 212 + ClientWidth = 150 + Color = clWhite + ParentColor = False + TabOrder = 1 + object imCover: TImage + Left = 0 + Height = 212 + Top = 0 + Width = 150 + AntialiasingMode = amOn + Align = alClient + Center = True + Proportional = True + Stretch = True + end + object pbWait: TPaintBox + Left = 0 + Height = 212 + Top = 0 + Width = 150 + Align = alClient + end + end + end + object spInfos: TSplitter + Cursor = crVSplit + Left = 0 + Height = 5 + Top = 252 + Width = 548 + Align = alTop + ResizeAnchor = akTop + end + object pnChapterList: TPanel + Left = 0 + Height = 193 + Top = 261 + Width = 548 + Align = alClient + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 193 + ClientWidth = 548 + TabOrder = 2 + object clbChapterList: TVirtualStringTree + AnchorSideLeft.Control = edFilterMangaInfoChapters + AnchorSideTop.Control = edFilterMangaInfoChapters + AnchorSideRight.Control = btChecks + AnchorSideBottom.Control = btDownload + Left = 0 + Height = 103 + Top = 0 + Width = 518 + Anchors = [akTop, akLeft, akRight, akBottom] + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.MainColumn = -1 + Margin = 2 + ParentFont = False + PopupMenu = pmChapterList + TabOrder = 0 + TextMargin = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnBeforeCellPaint = clbChapterListBeforeCellPaint + OnGetText = clbChapterListGetText + OnInitNode = clbChapterListInitNode + OnKeyDown = clbChapterListKeyDown + end + object btDownload: TBitBtn + AnchorSideLeft.Control = btAddToFavorites + AnchorSideTop.Control = btDownloadSplit + AnchorSideRight.Control = btDownloadSplit + AnchorSideBottom.Control = btReadOnline + Left = 418 + Height = 26 + Top = 107 + Width = 100 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + Caption = 'Download' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0D0D0D581212128512121285121212851212128512121285121212851212 + 12851212128512121285121212850D0D0D580000002C00000012000000090000 + 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 + C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B + 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 + 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 + 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD + DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D + 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 + B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F + 4F005151510D5454545A54545467545454675454546754545467545454675454 + 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F + 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 + 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F + 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 + 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F + 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 + 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F + 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 + 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F + 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD + 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 + 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 + 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 + 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E + 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 + 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 + 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E + 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 + } + OnClick = btDownloadClick + TabOrder = 3 + end + object cbAddAsStopped: TCheckBox + AnchorSideLeft.Control = edSaveTo + AnchorSideTop.Control = btAddToFavorites + AnchorSideRight.Control = edSaveTo + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btAddToFavorites + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 19 + Top = 167 + Width = 414 + Anchors = [akTop, akLeft, akRight] + Caption = 'Add to download list as stopped task' + OnChange = cbAddAsStoppedChange + ParentFont = False + TabOrder = 2 + end + object btReadOnline: TBitBtn + AnchorSideLeft.Control = btAddToFavorites + AnchorSideTop.Control = btDownload + AnchorSideRight.Control = btChecks + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btAddToFavorites + Left = 418 + Height = 26 + Top = 137 + Width = 130 + Anchors = [akLeft, akRight, akBottom] + AutoSize = True + Caption = 'Read online' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0A0A0A660C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C + 0C770C0C0C770C0C0C776C3A07C94E2A06970000002C00000012000000090000 + 00161F1F1F74EBEBEBFFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6 + E6FFE6E6E6FFE6E6E6FFB47839FF99560FE3723F0A6E00000009000000002A2A + 2A0036363671E8E8E8FFB4B4B4FFBDBDBDFFC5C5C5FFBDBDBDFFBF9261FFBD81 + 40FFBD8140FFBD8140FFBF8342FFFFC538FFB56A18CCB76C195C343434004545 + 45004545456FEAEAEAFFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFC68A46FFFFE3 + 92FFFFD56AFFFFD15DFFFFD15DFFFFD15DFFFFD873FFC37923CC4B4B4B004B4B + 4B004B4B4B6EECECECFF8E8E8EFFA5A5A5FFA5A5A5FF8E8E8EFFD2A56FFFD599 + 53FFCF934CFFCD914AFFD79B55FFFFE597FFD2872ECCD0852D5C515151005151 + 51005151516DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 + E8FFD5D5D5FFD5D5D5FFE3A75CFFD18E3AE2DE93375CD2872E00575757005757 + 57005757576CF0F0F0FFBFBFBFFFC7C7C7FFD0D0D0FFC7C7C7FFD8D8D8FFEAEA + EAFFBFBFBFFFC7C7C7FFEABD85FF9E794BA29C764800957043005D5D5D005D5D + 5D005D5D5D6BF2F2F2FFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFEDED + EDFFDBDBDBFFDBDBDBFFF2F2F2FF5D5D5D6B5D5D5D005D5D5D00626262006262 + 62006262626BF5F5F5FF919191FFC4C4C4FFAAAAAAFFAAAAAAFF919191FFF1F1 + F1FFBBBBBBFFCCCCCCFFF5F5F5FF6262626B6262620062626200676767006767 + 67006767676AF7F7F7FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4 + F4FFF4F4F4FFF4F4F4FFF7F7F7FF6767676A67676700676767006C6C6C006C6C + 6C006C6C6C69F9F9F9FF03599DFF0961A5FF1A77BBFF2587CBFF1976BAFF2587 + CBFF1570B4FF055CA0FFF9F9F9FF6C6C6C696C6C6C006C6C6C00717171007171 + 710071717168FBFBFBFF03599DFFC2D8E9FF89B9DBFF90C3E5FFB6CFE0FF2587 + CBFF1570B4FF055CA0FFFBFBFBFF717171687171710071717100757575007575 + 750075757568FDFDFDFF03599DFF126CB0FF2484C8FF3096DAFF3196DAFF2587 + CBFF1570B4FF055CA0FFFDFDFDFF757575687575750075757500797979007979 + 790079797967FEFEFEFF02579BFF0961A5FF126DB1FF1876BAFF1976BAFF136E + B2FF0B63A7FF03599DFFFEFEFEFF7979796779797900797979007D7D7D007D7D + 7D007D7D7D67FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFF7D7D7D677D7D7D007D7D7D007F7F7F007F7F + 7F008080804D8080806680808066808080668080806680808066808080668080 + 80668080806680808066808080668080804D7F7F7F007F7F7F00 + } + OnClick = btReadOnlineClick + TabOrder = 4 + end + object btChecks: TSpeedButton + AnchorSideLeft.Control = clbChapterList + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = clbChapterList + Left = 522 + Height = 26 + Top = 0 + Width = 26 + Anchors = [akTop, akRight] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A000000160000000900000012010E + 0033024A0083025D00BC025D00CC025D00CC025D00CC025D00CC025D00CC025D + 00CC025D00CC025D00CC025D00BC024A0083010E003300000012021D0000066D + 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9 + 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073021D00000A7D00000A7D + 00BA25CA15F922D111FF22D111FF22D111FF22B611FF22D111FF22D111FF22D1 + 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BA0A7D00000C8400000C84 + 00CC2BCC1AFF22C811FF22C811FF22B211FFE6E6E6FF22B211FF22C811FF22C8 + 11FF22C811FF22C811FF22C811FF22C811FF0C8400CC0C8400000D8900000D89 + 00CC31C620FF22BE11FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE + 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CC0D8900000E8D00000E8D + 00CC41C330FF23AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 + 11FF22B411FF22B411FF22B411FF25B514FF0E8D00CC0E8D00000F9200000F92 + 00CC52C941FFA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 + E6FF22A311FF22AA11FF22AA11FF28AF17FF0F9200CC0F920000109600001096 + 00CC55CC44FF3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 + E2FFE6E6E6FF229E11FF22A111FF2CAA1BFF109600CC10960000119A0000119A + 00CC5AD149FF47BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 + E2FFE3E3E3FFE7E7E7FF269E15FF39B128FF119A00CC119A0000129E0000129E + 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB + 33FFFFFFFFFFA7E29EFF4EC53DFF58CF47FF129E00CC129E000013A2000013A2 + 00CC67DE56FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF57CE + 46FF4AC139FF51C840FF57CE46FF60D74FFF13A200CC13A2000014A5000014A5 + 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD64EFF5FD6 + 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BA14A5000014A8000014A8 + 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4 + 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A8007314A8000014A8000015A9 + 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA + 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000C14A80000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btChecksClick + end + object btAddToFavorites: TBitBtn + AnchorSideLeft.Control = btDownload + AnchorSideTop.Control = btReadOnline + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = btChecks + AnchorSideRight.Side = asrBottom + Left = 418 + Height = 26 + Top = 167 + Width = 130 + Anchors = [akRight, akBottom] + AutoSize = True + Caption = 'Add to favorites' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000050000 + 001E0000003200009CC9000054630000002E0000002B00000026000000220000 + 001D00000018054F00A1056800CF0550009D0000000500000002000000030000 + 000F000000190000A8C50000A8C500006D580000001600000013000000110000 + 000F0000000C0C8200CE2BDF1AFF0C8200CD000000030000000101018F000101 + 5F0001018C000000B6BF6969FFFF0000B6BF0000B84301016000074700000E8D + 00990E8C00CC0E8C00CC3DE22CFF0E8C00CC0E8C00CC0E8D00990101BFBB0101 + BFBB0101BFBB0101BFBB6262F8FF6C6CFFFF0101BFBB0101C042094B61001095 + 00CC52E741FF52E741FF52E741FF52E741FF52E741FF109500CC0101C3410101 + C3B96969FFFF6262F8FF5F5FF5FF5C5CF1FF6E6EFFFF0101C3B90101C441129C + 0099129D00CC129D00CC66EB55FF129D00CC129D00CC129C00990101C3000101 + C7410101C7B86C6CFFFF5C5CF1FF5D5DF2FF5F5FF3FF7171FFFF0101C7B80629 + 96410F79330014A400CC75EE64FF14A400CC13A10000129D00000101C3000101 + C7000101CB400101CBB66E6EFFFF5F5FF3FF6060F4FF6262F4FF7575FFFF0101 + CBB60101CC4015A9009915A900CC15A9009914A80000129D00000101C3000101 + C7000101CB000101CE400101CEB57171FFFF6262F4FF6464F5FF6565F6FF7878 + FFFF0101CEB5062C9B3F1080350015A9000014A80000129D00000101C3000101 + C7000101CB000101CE000101D23F0101D2B37575FFFF6565F6FF6767F7FF6868 + F8FF7B7BFFFF0101D2B30101D33F0101D5000101D9000101DC000101C3000101 + C7000101CB000101CE000101D2000101D53F0101D5B27878FFFF6868F8FF6A6A + F9FF6C6CF9FF7E7EFFFF0101D5B20101D63E0101D9000101DC000101C3000101 + C7000101CB000101CE000101D2000101D5000101D93E0101D9B17B7BFFFF6C6C + F9FF6D6DFAFF6F6FFBFF8181FFFF0101D9B10101D93E0101DC000101C3000101 + C7000101CB000101CE000101D2000101D5000101D9000101DC3E0101DCAF7E7E + FFFF6F6FFBFF7070FCFF7171FCFF8484FFFF0101DCAF0101DC3E000000000101 + 64000101CB000101CE000101D2000101D5000101D9000101DC000101DE3E0101 + DEAE8181FFFF7171FCFF7373FDFF7474FDFF8686FFFF0101DEAE000000000000 + 0000000000000101B4000101D2000101D5000101D9000101DC000101DE000101 + E13D0101E1AD8484FFFF7474FDFF8686FFFF0101E1AD0101E13D000000000000 + 0000000000000000990000002B0001016B000101D9000101DC000101DE000101 + E1000101E33C0101E3AC8686FFFF0101E3AC0101E33C0101E100000000000000 + 0000000000000000990000002B00000000000000000001016E000101DE000101 + E1000101E3000101E53C0101E5AB0101E53C0101E3000101E100 + } + OnClick = btAddToFavoritesClick + TabOrder = 5 + end + object lbSaveTo: TLabel + AnchorSideLeft.Control = clbChapterList + AnchorSideTop.Control = btDownload + AnchorSideBottom.Control = edSaveTo + Left = 0 + Height = 15 + Top = 118 + Width = 41 + Anchors = [akLeft, akBottom] + Caption = 'Save to:' + ParentColor = False + ParentFont = False + end + object edFilterMangaInfoChapters: TEditButton + Left = 0 + Height = 23 + Top = 0 + Width = 250 + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edFilterMangaInfoChaptersButtonClick + OnChange = edFilterMangaInfoChaptersChange + PasswordChar = #0 + TabOrder = 5 + TextHint = 'Filter' + Visible = False + end + object edSaveTo: TEditButton + AnchorSideLeft.Control = lbSaveTo + AnchorSideTop.Control = btReadOnline + AnchorSideRight.Control = btReadOnline + AnchorSideBottom.Control = cbAddAsStopped + Left = 0 + Height = 23 + Top = 137 + Width = 414 + Anchors = [akTop, akLeft, akRight] + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000002E45000064970000629300005E8E30005C8C7C00598792000000070028 + 3C00005B8900005B8900005B8900002E45000000000000000000000000000000 + 0000002E450000659950006497991C7AA9C052A5CDE0005B89C10000001A0028 + 3C07005B8900005B8900005B8900002E45000000000000000000000000110000 + 002400466A983590BDF269B8DDFA82CBECFF85CEEEFF005C8BEF005079C40050 + 79C4005D8CBE005D8CBE005D8CBE00466A980000002400000011000000090000 + 0012006699B288D0EFFF7FCAE9FF7FCAE9FF87D0EFFF267DA9FF7FBCDBFF7FBC + DBFF8DD1F3FF8DD1F3FF90D4F5FF006699B20042634D00000009000000000054 + 7E00006FA7A48AD3F0FF82CDEBFF82CDEBFF8AD3F0FF267EABFF7CB9D8FF7CB9 + D8FF8ACEF0FF8ACEF0FF8FD3F4FFF4B62EFF006FA7A400547E00005782000073 + AC000073AC9E8ED6F2FF87D0EDFF87D0EDFF8ED6F2FF2882AFFF7DBAD8FF7DBA + D8FF8BCFF1FF8BCFF1FF91D5F5FFFEC941FF0073AC9E0073AC000076B0000076 + B0000076B09B92DAF4FF8BD4F0FF8BD4F0FF92DAF4FF2B85B3FF7FBCDAFF7FBC + DAFF8DD1F3FF8DD1F3FF93D7F6FFEBEBDDFF0076B09B0076B0000078B4000078 + B4000078B49797DEF6FF90D8F2FF90D8F2FF97DEF6FF2D89B7FF80BDDCFF80BD + DCFF8FD3F5FF8FD3F5FF95D9F8FFF5F5EEFF0078B4970078B400007BB800007B + B800007BB8949BE1F7FF94DBF4FF94DBF4FF9BE1F7FF308DBCFF81BEDDFF81BE + DDFF90D4F6FF90D4F6FF97DBF9FFFEFEFDFF007BB894007BB800007DBB00007D + BB00007DBB909EE5F9FF98DFF6FF98DFF6FF9EE5F9FF3290C0FF83C0DFFF83C0 + DFFF92D6F8FF92D6F8FF99DDFAFF007DBB90007DBB33007CBA00007FBF00007F + BF00007FBF8DA3E8FBFF9DE3F9FF9DE3F9FFA3E8FBFF3594C5FF85C2E1FF85C2 + E1FF94D8FAFF94D8FAFF9BDFFCFF007FBF8D007FBE00007EBD000082C2000082 + C2000082C28AA6EBFCFFA1E6FBFFA1E6FBFFA6EBFCFF3C9DCFFF87C4E2FF87C4 + E2FF96DAFCFF96DAFCFF9EE2FDFF0082C28A0082C2000082C2000084C5000084 + C5000084C587A9EEFDFFA4E9FCFFA4E9FCFFAAEFFDFF42A1D1FF90D1F1FF96DA + FBFF97DBFDFF97DBFDFF9FE3FEFF0084C5870084C5000084C5000085C8000085 + C8000085C885ADF1FFFFABEFFEFF95E2F8FF6EC9EDFF48A9D9FF98DCFEFF98DC + FEFF98DCFEFF98DCFEFFA1E5FFFF0085C8850085C8000085C8000087CA000087 + CA000087CA8388DCF4FF60C0E9FF5FBFEAFF80D3F4FF9CE3FDFFA2E6FFFFA2E6 + FFFFA2E6FFFFA2E6FFFFA6EAFFFF0087CA830087CA000087CA000087CB000087 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610087CB000087CB00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edSaveToButtonClick + ParentFont = False + PasswordChar = #0 + TabOrder = 1 + TextHint = 'Save to' + end + object btDownloadSplit: TSpeedButton + AnchorSideLeft.Control = btDownload + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btDownload + AnchorSideRight.Control = btChecks + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btReadOnline + Left = 522 + Height = 26 + Hint = 'Split download' + Top = 107 + Width = 26 + Anchors = [akTop, akRight, akBottom] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 000800000010000000170000001A00000016000000120000000E0000000E0000 + 0012000000160000001A000000180000001000000008FFFFFF00FFFFFF000000 + 00100000001F64330270984D02CC64330270000000230000001B0000001C0000 + 002364330270984D02CC643302710000002000000010FFFFFF00FFFFFF002815 + 0200753D045C9C5105CCFFB811FF9C5105CC753D045C2815020028150200753D + 045C9C5105CCFFB508FF9C5105CC753D045C28150200FFFFFF00FFFFFF00A257 + 0A5CA15609CCFFB917FFFFB201FFFFB814FFA15609CCA1560948A1560948A156 + 09CCFFB60DFFFFB201FFFFB50BFFA15609CCA2570A5CFFFFFF00FFFFFF00BF74 + 1599BF7415CCBF7415CCFBC23EFFBF7415CCBF7415CCBF741566BF741566BF74 + 15CCBF7415CCFABA27FFBF7415CCBF7415CCBF741599FFFFFF00FFFFFF00BF74 + 1500BB701500AD6212C9F2BC49FDB36A18D0B2671320BF741500BF741500B267 + 1320B36916D0F0B435FDAD6212C9BB701500BF741500FFFFFF00FFFFFF00BA6F + 1700B4691700B46917B4E3AA46F4C6842DDBB56A185EB56A1800B56A1800B56A + 185EC58128DBE1A53BF6B46917B9B4691700BA6F1700FFFFFF00FFFFFF00BA6F + 1C00BA6F1C00BA6F1C86D59A45E6DAA24CEFBA6F1CB8BE731F0ABE731F0ABA6F + 1CB8D89D45EFD3963FE8BA6F1C8CBA6F1C00BA6F1C00FFFFFF00FFFFFF00C075 + 2000C0752000C176213CC7802CD2EDC577FECD8C39D9C1772271C1772270CC89 + 37D9E7BB6DFFC8822ED4C0762148BF752000BF752000FFFFFF00FFFFFF00C77C + 2500C77C2500C77C2502C97E27A1DCA452E6E9BE70F6C97E27C6C97E27C6E6B8 + 6AF6DAA050E9C97E27ACC77C2505C77C2500C77C2500FFFFFF00FFFFFF00CC81 + 2900CC812900CC812900CF842C2CD18831CDF2C679FBDC9D49DBDB9B47DCE6B8 + 6BFCD28932CFCE832C36CD822B00CD822B00CD822B00FFFFFF00FFFFFF00D489 + 3000D4893000D4893000D4893000D68B3190E9B461E6EEB86AF4EEB869F4EAB3 + 61E7D68B3197D3882F00D2872F00D2872F00D2872F00FFFFFF00FFFFFF00DA8F + 3400DA8F3400DA8F3400DA8F3400DB903547E4A44DD8F6C679FEF5C679FEE4A4 + 4DD8DB903549DA8F3400DA8F3400DA8F3400DA8F3400FFFFFF00FFFFFF00E196 + 3900E1963900E1963900E1963900E1963917E39B3FCFFCD488FFFCD387FFE39C + 40CFE1963918E1963900E1963900E1963900E1963900FFFFFF00FFFFFF00E69B + 3D00E69B3D00E69B3D00E69B3D00E69B3D04E69B3DCCFFE094FFFFDF93FFE69B + 3DCCE69B3D04E69B3D00E69B3D00E69B3D00E69B3D00FFFFFF00FFFFFF003A27 + 1000AE752E00E79C3D00E79C3D00E79C3D00E99E4099E99E40CCE99E40CCE99E + 4099E79C3D00E79C3D00E79C3D00AE752E003A271000FFFFFF00 + } + OnClick = btDownloadSplitClick + end + end + end + end + object tsinfoFilterAdv: TTabSheet + Caption = 'Filter' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 456 + ClientWidth = 544 + object sbFilter: TScrollBox + Left = 0 + Height = 448 + Top = 4 + Width = 544 + HorzScrollBar.Page = 488 + VertScrollBar.Page = 416 + Align = alClient + BorderStyle = bsNone + ClientHeight = 448 + ClientWidth = 544 + TabOrder = 0 + object pnCustomGenre: TPanel + Left = 8 + Height = 23 + Top = 196 + Width = 528 + Align = alTop + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.ControlsPerLine = 3 + ClientHeight = 23 + ClientWidth = 528 + TabOrder = 1 + object lbFilterCustomGenres: TLabel + Left = 0 + Height = 23 + Top = 0 + Width = 93 + Align = alLeft + Caption = 'Custom Genres' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object edCustomGenres: TEdit + Left = 97 + Height = 23 + Top = 0 + Width = 414 + Align = alClient + BorderSpacing.Left = 4 + ParentFont = False + TabOrder = 0 + TextHint = 'Input custom genres, separated by comma' + end + object lbFilterHint: TLabel + AnchorSideLeft.Control = edCustomGenres + AnchorSideLeft.Side = asrBottom + Left = 515 + Height = 23 + Hint = 'Genres:'#13#10'- Checked: Include this genre.'#13#10'- Unchecked: Exclude this genre.'#13#10'- Grayed: Doesn''t matter.'#13#10#13#10'Custom Genres:'#13#10'- Separate multiple genres with '',''.'#13#10'- Exclude a genre by placing ''!'' or ''-'' at the beginning of a genre.'#13#10'- Example: Adventure,!Ecchi,Comedy.' + Top = 0 + Width = 13 + Align = alRight + BorderSpacing.Left = 4 + Caption = '[?]' + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + end + object pnFilter: TPanel + Left = 8 + Height = 136 + Top = 237 + Width = 528 + Align = alTop + BorderSpacing.Top = 10 + BorderSpacing.Around = 8 + BevelOuter = bvNone + ClientHeight = 136 + ClientWidth = 528 + ParentFont = False + TabOrder = 2 + object Panel1: TPanel + Left = 0 + Height = 136 + Top = 0 + Width = 299 + Align = alLeft + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 136 + ClientWidth = 299 + TabOrder = 0 + object lbFilterTitle: TLabel + Left = 0 + Height = 23 + Top = 0 + Width = 110 + Caption = 'Title' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object edFilterTitle: TEdit + Left = 114 + Height = 23 + Top = 0 + Width = 185 + TabOrder = 0 + TextHint = 'Title' + end + object lbFilterAuthors: TLabel + Left = 0 + Height = 23 + Top = 27 + Width = 110 + Caption = 'Author' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object edFilterAuthors: TEdit + Left = 114 + Height = 23 + Top = 27 + Width = 185 + TabOrder = 1 + TextHint = 'Author' + end + object lbFilterArtists: TLabel + Left = 0 + Height = 23 + Top = 54 + Width = 110 + Caption = 'Artist' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object edFilterArtists: TEdit + Left = 114 + Height = 23 + Top = 54 + Width = 185 + TabOrder = 2 + TextHint = 'Artist' + end + object lbFilterStatus: TLabel + Left = 0 + Height = 23 + Top = 81 + Width = 110 + Caption = 'Status' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object cbFilterStatus: TComboBox + Left = 114 + Height = 23 + Top = 81 + Width = 185 + ItemHeight = 15 + ItemIndex = 2 + Items.Strings = ( + 'Completed' + 'Ongoing' + '' + ) + Style = csDropDownList + TabOrder = 3 + Text = '' + end + object lbFilterSummary: TLabel + Left = 0 + Height = 23 + Top = 108 + Width = 110 + Caption = 'Summary' + Font.Height = -13 + Font.Style = [fsBold] + ParentBidiMode = False + ParentColor = False + ParentFont = False + end + object edFilterSummary: TEdit + Left = 114 + Height = 23 + Top = 108 + Width = 185 + TabOrder = 4 + TextHint = 'Part of summary' + end + end + object Panel2: TPanel + Left = 303 + Height = 136 + Top = 0 + Width = 225 + Align = alClient + AutoSize = True + BorderSpacing.Left = 4 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ClientHeight = 136 + ClientWidth = 225 + TabOrder = 1 + object rbOne: TRadioButton + Left = 0 + Height = 19 + Top = 0 + Width = 169 + Caption = 'Have one of genres checked' + ParentFont = False + TabOrder = 0 + end + object rbAll: TRadioButton + Left = 0 + Height = 19 + Top = 23 + Width = 169 + Caption = 'Have all genre checked' + Checked = True + ParentFont = False + TabOrder = 1 + TabStop = True + end + object cbOnlyNew: TCheckBox + Left = 0 + Height = 19 + Top = 46 + Width = 169 + Caption = 'Search only new manga' + ParentFont = False + TabOrder = 2 + end + object cbSearchFromAllSites: TCheckBox + Left = 0 + Height = 19 + Top = 69 + Width = 169 + Caption = 'Search in all manga sites' + TabOrder = 3 + end + object cbUseRegExpr: TCheckBox + Left = 0 + Height = 19 + Top = 92 + Width = 169 + Caption = 'Regular Expression' + TabOrder = 4 + end + end + end + object pnGenres: TPanel + Left = 8 + Height = 180 + Top = 8 + Width = 528 + Align = alTop + AutoSize = True + BorderSpacing.Around = 8 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 8 + ClientHeight = 180 + ClientWidth = 528 + PopupMenu = pmFilterGenreAll + TabOrder = 0 + object ckFilterAction: TCheckBox + Left = 0 + Height = 19 + Hint = 'A work typically depicting fighting, violence, chaos, and fast paced motion.' + Top = 0 + Width = 91 + AllowGrayed = True + Caption = 'Action' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 0 + end + object ckFilterAdult: TCheckBox + Left = 0 + Height = 19 + Hint = 'Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity.' + Top = 23 + Width = 91 + AllowGrayed = True + Caption = 'Adult' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 1 + end + object ckFilterAdventure: TCheckBox + Left = 0 + Height = 19 + Hint = 'If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it''s up to your personal prejudice on this case.' + Top = 46 + Width = 91 + AllowGrayed = True + Caption = 'Adventure' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 2 + end + object ckFilterComedy: TCheckBox + Left = 0 + Height = 19 + Hint = 'A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict.' + Top = 69 + Width = 91 + AllowGrayed = True + Caption = 'Comedy' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 3 + end + object ckFilterDoujinshi: TCheckBox + Left = 0 + Height = 19 + Hint = 'Fan based work inpspired by official manga/anime.' + Top = 92 + Width = 91 + AllowGrayed = True + Caption = 'Doujinshi' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 4 + end + object ckFilterDrama: TCheckBox + Left = 0 + Height = 19 + Hint = 'A work meant to bring on an emotional response, such as instilling sadness or tension.' + Top = 115 + Width = 91 + AllowGrayed = True + Caption = 'Drama' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 5 + end + object ckFilterEchi: TCheckBox + Left = 0 + Height = 19 + Hint = 'Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans.' + Top = 138 + Width = 91 + AllowGrayed = True + Caption = 'Ecchi' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 6 + end + object ckFilterFantasy: TCheckBox + Left = 0 + Height = 19 + Hint = 'Anything that involves, but not limited to, magic, dream world, and fairy tales.' + Top = 161 + Width = 91 + AllowGrayed = True + Caption = 'Fantasy' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 7 + end + object ckFilterGenderBender: TCheckBox + Left = 95 + Height = 19 + Hint = 'Girls dressing up as guys, guys dressing up as girls.'#13#10'Guys turning into girls, girls turning into guys.' + Top = 0 + Width = 114 + AllowGrayed = True + Caption = 'Gender Bender' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 8 + end + object ckFilterHarem: TCheckBox + Left = 95 + Height = 19 + Hint = 'A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed.' + Top = 23 + Width = 114 + AllowGrayed = True + Caption = 'Harem' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 9 + end + object ckFilterHentai: TCheckBox + Left = 95 + Height = 19 + Hint = 'Hentai' + Top = 46 + Width = 114 + AllowGrayed = True + Caption = 'Hentai' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 10 + end + object ckFilterHistorical: TCheckBox + Left = 95 + Height = 19 + Hint = 'Having to do with old or ancient times.' + Top = 69 + Width = 114 + AllowGrayed = True + Caption = 'Historical' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 11 + end + object ckFilterHorror: TCheckBox + Left = 95 + Height = 19 + Hint = 'A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking.' + Top = 92 + Width = 114 + AllowGrayed = True + Caption = 'Horror' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 12 + end + object ckFilterJosei: TCheckBox + Left = 95 + Height = 19 + Hint = 'Literally "Woman". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature.' + Top = 115 + Width = 114 + AllowGrayed = True + Caption = 'Josei' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 13 + end + object ckFilterLolicon: TCheckBox + Left = 95 + Height = 19 + Hint = 'Representing a sexual attraction to young or under-age girls.' + Top = 138 + Width = 114 + AllowGrayed = True + Caption = 'Lolicon' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 14 + end + object ckFilterMartialArts: TCheckBox + Left = 95 + Height = 19 + Hint = 'As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth.' + Top = 161 + Width = 114 + AllowGrayed = True + Caption = 'Martial Arts' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 15 + end + object ckFilterMature: TCheckBox + Left = 213 + Height = 19 + Hint = 'Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language.' + Top = 0 + Width = 109 + AllowGrayed = True + Caption = 'Mature' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 16 + end + object ckFilterMecha: TCheckBox + Left = 213 + Height = 19 + Hint = 'A work involving and usually concentrating on all types of large robotic machines.' + Top = 23 + Width = 109 + AllowGrayed = True + Caption = 'Mecha' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 17 + end + object ckFilterMusical: TCheckBox + Left = 213 + Height = 19 + Hint = 'Musical' + Top = 46 + Width = 109 + AllowGrayed = True + Caption = 'Musical' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 18 + end + object ckFilterMystery: TCheckBox + Left = 213 + Height = 19 + Hint = 'Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it.' + Top = 69 + Width = 109 + AllowGrayed = True + Caption = 'Mystery' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 19 + end + object ckFilterPsychological: TCheckBox + Left = 213 + Height = 19 + Hint = 'Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology.' + Top = 92 + Width = 109 + AllowGrayed = True + Caption = 'Psychological' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 20 + end + object ckFilterRomance: TCheckBox + Left = 213 + Height = 19 + Hint = 'Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is.' + Top = 115 + Width = 109 + AllowGrayed = True + Caption = 'Romance' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 21 + end + object ckFilterSchoolLife: TCheckBox + Left = 213 + Height = 19 + Hint = 'Having a major setting of the story deal with some type of school.' + Top = 138 + Width = 109 + AllowGrayed = True + Caption = 'School Life' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 22 + end + object ckFilterSciFi: TCheckBox + Left = 213 + Height = 19 + Hint = 'Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world.' + Top = 161 + Width = 109 + AllowGrayed = True + Caption = 'Sci-Fi' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 23 + end + object ckFilterSeinen: TCheckBox + Left = 326 + Height = 19 + Hint = 'From Google: Seinen means ''young Man''. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood.' + Top = 0 + Width = 97 + AllowGrayed = True + Caption = 'Seinen' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 24 + end + object ckFilterShotacon: TCheckBox + Left = 326 + Height = 19 + Hint = 'Representing a sexual attraction to young or under-age boys.' + Top = 23 + Width = 97 + AllowGrayed = True + Caption = 'Shotacon' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 25 + end + object ckFilterShoujo: TCheckBox + Left = 326 + Height = 19 + Hint = 'A work intended and primarily written for females. Usually involves a lot of romance and strong character development.' + Top = 46 + Width = 97 + AllowGrayed = True + Caption = 'Shoujo' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 26 + end + object ckFilterShoujoAi: TCheckBox + Left = 326 + Height = 19 + Hint = 'Often synonymous with yuri, this can be thought of as somewhat less extreme. "Girl''''s Love", so to speak.' + Top = 69 + Width = 97 + AllowGrayed = True + Caption = 'Shoujo Ai' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 27 + end + object ckFilterShounen: TCheckBox + Left = 326 + Height = 19 + Hint = 'A work intended and primarily written for males. These works usually involve fighting and/or violence.' + Top = 92 + Width = 97 + AllowGrayed = True + Caption = 'Shounen' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 28 + end + object ckFilterShounenAi: TCheckBox + Left = 326 + Height = 19 + Hint = 'Often synonymous with yaoi, this can be thought of as somewhat less extreme. "Boy''''s Love", so to speak' + Top = 115 + Width = 97 + AllowGrayed = True + Caption = 'Shounen Ai' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 29 + end + object ckFilterSliceofLife: TCheckBox + Left = 326 + Height = 19 + Hint = 'As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own.' + Top = 138 + Width = 97 + AllowGrayed = True + Caption = 'Slice of Life' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 30 + end + object ckFilterSmut: TCheckBox + Left = 326 + Height = 19 + Hint = 'Deals with series that are considered profane or offensive, particularly with regards to sexual content.' + Top = 161 + Width = 97 + HelpType = htKeyword + AllowGrayed = True + Caption = 'Smut' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 31 + end + object ckFilterSports: TCheckBox + Left = 427 + Height = 19 + Hint = 'As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few.' + Top = 0 + Width = 101 + AllowGrayed = True + Caption = 'Sports' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 32 + end + object ckFilterSupernatural: TCheckBox + Left = 427 + Height = 19 + Hint = 'Usually entails amazing and unexplained powers or events which defy the laws of physics.' + Top = 23 + Width = 101 + AllowGrayed = True + Caption = 'Supernatural' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 33 + end + object ckFilterTragedy: TCheckBox + Left = 427 + Height = 19 + Hint = 'Contains events resulting in great loss and misfortune.' + Top = 46 + Width = 101 + AllowGrayed = True + Caption = 'Tragedy' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 34 + end + object ckFilterYaoi: TCheckBox + Left = 427 + Height = 19 + Hint = 'This work usually involves intimate relationships between men.' + Top = 69 + Width = 101 + AllowGrayed = True + Caption = 'Yaoi' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 35 + end + object ckFilterYuri: TCheckBox + Left = 427 + Height = 19 + Hint = 'This work usually involves intimate relationships between women.' + Top = 92 + Width = 101 + AllowGrayed = True + Caption = 'Yuri' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 36 + end + object ckFilterWeebtons: TCheckBox + Left = 427 + Height = 19 + Hint = 'Weebtoons' + Top = 115 + Width = 101 + AllowGrayed = True + Caption = 'Weebtoons' + ParentFont = False + ParentShowHint = False + PopupMenu = pmFilterGenreAll + ShowHint = True + TabOrder = 37 + end + end + object Panel3: TPanel + Left = 0 + Height = 35 + Top = 381 + Width = 544 + Align = alTop + AutoSize = True + BevelOuter = bvNone + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 35 + ClientWidth = 544 + TabOrder = 3 + object btFilter: TBitBtn + Left = 4 + Height = 27 + Top = 4 + Width = 78 + Caption = 'Filter' + Font.Height = -13 + Font.Style = [fsBold] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 00050000001E000000320000003300000082000000830101014E000000330000 + 003300000022000000089C5106999C51065CA75C0D00B56A1800000000000000 + 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 + 001A0000001100000004A75C0DCCA75C0DCCA95E0E5CB56A1800000000000000 + 000000000000000000000202020002020272C4B5B5FF05050578B76C1999B56A + 18CCB56A18CCB56A18CCB56A18CCFFC538FFB56A18CCB76C195C000000000000 + 000000000000010101000101010001010174C4B5B5FF0909097EC37923CCFFE3 + 92FFFFD56AFFFFD15DFFFFD15DFFFFD15DFFFFD873FFC37923CC000000000000 + 00000000000000000000000000000000007AC4B5B5FF0B0B0B87D0852D99D287 + 2ECCD2872ECCD2872ECCD2872ECCFFE597FFD2872ECCD0852D5C000000000000 + 00000000000000000000000000000000007BC4B5B5FF0B0B0B89714C1F00D58A + 3100D58A3100D98E3400DF9438CCDF9438CCDE93375CD2872E001B1B1B001616 + 16000404040000000000000000000000007BC4B5B5FF0B0B0B8912121200A870 + 2D00D58A3100E69B3D00E79C3E99E79C3E5CDF943800D2872E00363636002C2C + 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 + 25005C4A3300E69B3D00E89D3F00E89D3F00DF943800D2872E00363636002C2C + 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 + 252D353535006B594100E89D3F00E89D3F00DF943800D2872E00363636002C2C + 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 + 257E3535352A434343006F5D450097724300936D3F008C673A00363636002C2C + 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD + CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C + 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA + CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C + 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD + ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA + EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 + D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C + 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 + 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btFilterClick + ParentFont = False + TabOrder = 0 + end + object btRemoveFilterLarge: TBitBtn + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Side = asrBottom + Left = 86 + Height = 27 + Hint = 'Remove filter' + Top = 4 + Width = 129 + Caption = 'Remove filter' + Font.Height = -13 + Font.Style = [fsBold] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 00050000001E000000320000003300000082000000830101014E000000330000 + 003300000022000000080000000000005A000000770000008000000000000000 + 00030000000F000000190000001A00000078D1C2C2FF0303037A0000001A0000 + 001A000000110000000400005A00000077000000770000008000000000000000 + 000000000000000000000202020002020272C4B5B5FF05050578040426000000 + 8499000080CC000080CC000080CC000080CC000080CC00008499000000000000 + 000000000000010101000101010001010174C4B5B5FF0909097E060651000000 + 98CC5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF5E5EF7FF000098CC000000000000 + 00000000000000000000000000000000007AC4B5B5FF0B0B0B87070759000000 + A6990000A7CC0000A7CC0000A7CC0000A7CC0000A7CC0000A699000000000000 + 00000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D0D000000 + A7000000AA000000AA000000AA000000AA000000AA000000A7001B1B1B001616 + 16000404040000000000000000000000007BC4B5B5FF0B0B0B89121212000C0C + 61000000AA000000AA000000AA000000AA000000AA000000A700363636002C2C + 2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717172F2525 + 250027275200101090000000AA000000AA000000AA000000A700363636002C2C + 2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF171717852525 + 252D353535004343430035355F00121291000000AA000000A700363636002C2C + 2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7C7FF2525 + 257E3535352A43434300464646004646460035355F0023237700363636002C2C + 2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBCBCFFDFCD + CDFF3535357743434328464646004646460046464600464646004B4B4B002C2C + 2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5B5FFDCCA + CAFFEBDADAFF4343436F4E4E4E005151510051515100515151004F4F4F662C2C + 2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C9CFFB6AD + ADFFC5BCBCFF4343436F4F4F4F695151510051515100515151004F4F4F66EAEA + EAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4C4FFE4D2 + D2FFF0DFDFFFF9E8E8FF4F4F4F695151510051515100515151004F4F4F4D2C2C + 2C6608080866000000660000006A0000007B020202890B0B0B89171717852525 + 257E353535774343436F4F4F4F4F515151005151510051515100FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btRemoveFilterClick + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object btFilterReset: TBitBtn + Left = 219 + Height = 27 + Top = 4 + Width = 116 + Caption = 'Reset value' + Font.Height = -13 + Font.Style = [fsBold] + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 0000000000050000001E000000320000003300000082000000830101014E0000 + 003300000033000000220000000800000000FFFFFF00FFFFFF00FFFFFF000000 + 0000000000030000000F000000190000001A00000078D1C2C2FF0303037A0000 + 001A0000001A000000110000000400000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000000000000202020002020272C4B5B5FF050505780505 + 050000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 00000000000000000000010101000101010001010174C4B5B5FF0909097E0A0A + 0A0008080800000000000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000007AC4B5B5FF0B0B0B870D0D + 0D000D0D0D000A0A0A000000000000000000FFFFFF00FFFFFF00FFFFFF000000 + 0000000000000000000000000000000000000000007BC4B5B5FF0B0B0B890D0D + 0D000D0D0D000D0D0D000A0A0A0007070700FFFFFF00FFFFFF00FFFFFF001B1B + 1B00161616000404040000000000000000000000007BC4B5B5FF0B0B0B891212 + 12001919190021212100282828002A2A2A00FFFFFF00FFFFFF00FFFFFF003636 + 36002C2C2C000808080000000000000000260000007BC4B5B5FF0B0B0B891717 + 172F25252500353535004343430046464600FFFFFF00FFFFFF00FFFFFF003636 + 36002C2C2C0008080800000000240000006AC7C6C6FFAFA4A4FFC4B2B2FF1717 + 17852525252D353535004343430046464600FFFFFF00FFFFFF00FFFFFF003636 + 36002C2C2C000808082400000066CBCBCBFFC1C0C0FFAEA1A1FFBEACACFFD8C7 + C7FF2525257E3535352A4343430046464600FFFFFF00FFFFFF00FFFFFF003636 + 36002C2C2C2408080866D1D1D1FFC3C3C3FFBBBABAFFAC9E9EFFB8A6A6FFCEBC + BCFFDFCDCDFF353535774343432846464600FFFFFF00FFFFFF00FFFFFF004B4B + 4B002C2C2C66E2E2E2FFCFCFCFFFBDBDBDFFB7B5B5FFAB9C9CFFB4A2A2FFC7B5 + B5FFDCCACAFFEBDADAFF4343436F4E4E4E00FFFFFF00FFFFFF00FFFFFF004F4F + 4F662C2C2C66C1C1C1FFB4B4B4FFA9A9A9FF9D9C9CFF918A8AFF978E8EFFA59C + 9CFFB6ADADFFC5BCBCFF4343436F4F4F4F69FFFFFF00FFFFFF00FFFFFF004F4F + 4F66EAEAEAFFE6E6E6FFDEDEDEFFD5D5D5FFCECACAFFC4B5B5FFC9B8B8FFD6C4 + C4FFE4D2D2FFF0DFDFFFF9E8E8FF4F4F4F69FFFFFF00FFFFFF00FFFFFF004F4F + 4F4D2C2C2C6608080866000000660000006A0000007B020202890B0B0B891717 + 17852525257E353535774343436F4F4F4F4FFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btFilterResetClick + ParentFont = False + TabOrder = 2 + end + end + end + end + end + end + end + end + object tsFavorites: TTabSheet + Caption = 'Favorites' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 498 + ClientWidth = 761 + object vtFavorites: TVirtualStringTree + AnchorSideTop.Control = edFavoritesSearch + AnchorSideTop.Side = asrBottom + Left = 0 + Height = 464 + Top = 30 + Width = 761 + Align = alBottom + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 3 + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Alignment = taRightJustify + Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coFixed] + Position = 0 + Text = '#' + end + item + Position = 1 + Text = 'Title' + Width = 150 + end + item + Position = 2 + Text = 'Current chapter' + Width = 100 + end + item + Position = 3 + Text = 'Website' + Width = 65 + end + item + Position = 4 + Text = 'Save to' + Width = 200 + end> + Header.DefaultHeight = 24 + Header.Height = 23 + Header.Options = [hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible] + HintMode = hmHintAndDefault + Images = IconList + Margin = 0 + ParentFont = False + ParentShowHint = False + PopupMenu = pmFavorites + ShowHint = True + TabOrder = 3 + TextMargin = 2 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking, toDisableAutoscrollOnFocus] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] + TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] + OnBeforeCellPaint = vtFavoritesBeforeCellPaint + OnColumnDblClick = vtFavoritesColumnDblClick + OnDragOver = vtFavoritesDragOver + OnDragDrop = vtFavoritesDragDrop + OnFocusChanged = vtDownloadFocusChanged + OnGetText = vtFavoritesGetText + OnPaintText = vtFavoritesPaintText + OnGetImageIndex = vtFavoritesGetImageIndex + OnGetHint = vtFavoritesGetHint + OnHeaderClick = vtFavoritesHeaderClick + end + object btFavoritesImport: TBitBtn + AnchorSideTop.Control = edFavoritesSearch + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = vtFavorites + AnchorSideRight.Side = asrBottom + Left = 661 + Height = 26 + Top = 2 + Width = 100 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Import list' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF000000001600000032000076A40000764D0000002D000000330000002D0000 + 764D000076A4000000330000001AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000000B000000190000A8C50000A8C500007F450000590000007F450000 + A8C50000A8C50000001A0000000DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000000000008A000000B6BF6868FFFF0000B6BF0000B6720000B6BF6868 + FFFF0000B6BF00008A0000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00010190000101BF000101BFBB6262F8FF6A6AFFFF0101BFBB6A6AFFFF6262 + F8FF0101BFBB0101BF0001019000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101C3000101C3000101C3B96464F8FF5B5BF1FF6C6CFFFF5B5BF1FF6464 + F8FF0101C3B90101C3000101C300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101B7000101C7000101C7B86767F9FF2727BFFF1919B2FF4949DEFF6767 + F9FF0101C7B80101C7000101C700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000A8000101AF000101CBB66A6AFAFF1A1AB3FFA6A6FFFF3636CDFF6161 + F2FF0101CBB60101CB000101CB00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000A9930000A8C40000A8C42121BAFF2121BAFF8484EEFF8E8EFBFF5E5E + EEFF0101CEB50101CE000101CE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000000B1C1AAAAFFFFAAAAFFFFAAAAFFFFAAAAFFFFA6A6FFFF9090FCFF7D7D + FCFF0101D2B30101D2000101D200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101BA8E0101BBBD0101BBBD3131CAFF3131CAFF8888F1FF9191FDFF6666 + F3FF0101D5B20101D5000101D500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101BB000101C4000101D9B17676FDFF3939D2FFA7A7FFFF4E4EE2FF7070 + F9FF0101D9B10101D9000101D900FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101CC000101DC000101DCAF7979FEFF4D4DE3FF4545DDFF6363F2FF7979 + FEFF0101DCAF0101DC000101DC00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101DE000101DE000101DEAE7C7CFEFF7373FDFF7373FDFF7373FDFF7C7C + FEFF0101DEAE0101DE000101DE00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101E1000101E1000101E1AD7E7EFFFF7575FEFF7575FEFF7575FEFF7E7E + FFFF0101E1AD0101E1000101E100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101E3000101E3000101E3AC8484FFFF7F7FFFFF7F7FFFFF7F7FFFFF8484 + FFFF0101E3AC0101E3000101E300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000101E4000101E4000101E5810101E5AB0101E5AB0101E5AB0101E5AB0101 + E5AB0101E5810101E4000101E400FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btFavoritesImportClick + ParentFont = False + TabOrder = 2 + end + object btCancelFavoritesCheck: TSpeedButton + AnchorSideLeft.Control = btFavoritesCheckNewChapter + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btFavoritesCheckNewChapter + AnchorSideBottom.Control = btFavoritesCheckNewChapter + AnchorSideBottom.Side = asrBottom + Left = 321 + Height = 26 + Top = 2 + Width = 20 + Anchors = [akTop, akLeft, akBottom] + AutoSize = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 + 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 + 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 + 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 + D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 + 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 + D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 + 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 + B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 + 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA + EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 + 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 + E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 + 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 + E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 + 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC + DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 + 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB + DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 + 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF + FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 + A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F + D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 + A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B + E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 + A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D + F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 + A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 + AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Visible = False + OnClick = btCancelFavoritesCheckClick + end + object btFavoritesCheckNewChapter: TBitBtn + AnchorSideLeft.Control = edFavoritesSearch + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edFavoritesSearch + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = btCancelFavoritesCheck + Left = 156 + Height = 26 + Top = 2 + Width = 165 + AutoSize = True + BorderSpacing.Left = 6 + Caption = 'Check for new chapter' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C00000087000000E7702E00C7702E00C7702E00C72C6662E8157882F21578 + 82F2157882F2157882F2157882F2107B87EA008398D00066779A000000090000 + 0016000000DB606060FFCA9764FFC5925FFFC5925FFF4C9590FF32C6D1FF29DB + E9FF28DAE9FF79EDF5FF28DAE9FF28DAE9FF1CC7D8EA0198AF9F000000000101 + 0100010101CE626262FFC89562FFBD8A57FFBF8C59FF95906EFF3CA8ACFF42D9 + E0FF33D5DDFF000000FF33D5DDFF34D5DDFF0DACC1C7019EB63A010101000101 + 0100010101C9646464FFCA9764FFBE8B58FFC18E5BFFC18E5CFF509B94FF67D1 + D7FF46D3D7FF75B4B5FF40D0D2FF40C3C6F901A4BC9801A2BA01010101000101 + 0100010101C5676767FFCD9A67FFBF8C59FFC4915EFFC4915EFF919778FF56B6 + BAFF7CE4F1FF000000FF68D8E7FF38A6ABEE01A8C04301A7BF00010101000101 + 0100010101C16B6B6BFFD19E6BFFBF8C59FFC89562FFC89562FFC59563FF4FA3 + 9FFF90E3E9FF555555FF88E1E9FF2E8E8ADE01ABC40401ABC400010101000101 + 0100010101BE6E6E6EFFD4A16EFFBF8C59FFCB9865FFCB9865FFCB9865FF8F9F + 83FF6BC5C6FFABF5FCFF6CC7C8FF636E48C38F4F0D008F4F0D00010101000101 + 0100010101BB727272FFD8A572FFBF8C59FFCF9C69FFCF9C69FFCF9C69FFC99D + 6CFF50ACA8FFA2E5E7FF53AFABFF94500AA89B4B00009B4B0000010101000101 + 0100010101B8757575FFDBA875FFBE8B58FFD29F6CFFD29F6CFFD29F6CFFD29F + 6CFF84A791FF3FA6A6FF8CAF99FF9E4D00A39E4D00009E4D0000010101000101 + 0100010101B5797979FFDFAC79FFBE8B58FFD6A370FFD6A370FFD6A370FFD6A3 + 70FFD6A370FFBE8B58FFDFAC79FFA14F00A1A14F0000A14F0000010101000101 + 0100010101B27C7C7CFFE2AF7CFFBC8956FFE3B07DFFE3B07DFFE3B07DFFE3B0 + 7DFFE3B07DFFBC8956FFE2AF7CFFA451009FA4510000A4510000010101000101 + 0100010101B07E7E7EFFE4B17EFFBB8855FFBB8855FFBB8855FFBB8855FFBB88 + 55FFBB8855FFBB8855FFE4B17EFFA653009DA6530000A6530000010101000101 + 0100010101AE808080FFEAB784FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B2 + 7FFFE5B27FFFE5B27FFFEAB784FFA854009BA8540000A8540000010101000101 + 0100010101AC555555FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 + 66FFCC9966FFCC9966FFCC9966FFAA55009AAA550000AA550000040404000404 + 04000404048ABCBCABFFC1C1B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8 + E2FFEFEFECFFF7F7F4FFFCFCFCFF55552B6655552B0055552B00040404000404 + 0400040404460404048AAA550099AA550099AA550099AA550099AA550099AA55 + 0099AA550099AA550099AA550099AA550073AA550000AA550000 + } + OnClick = btFavoritesCheckNewChapterClick + TabOrder = 1 + end + object edFavoritesSearch: TEditButton + Left = 0 + Height = 23 + Top = 4 + Width = 150 + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edFavoritesSearchButtonClick + OnChange = edFavoritesSearchChange + PasswordChar = #0 + TabOrder = 0 + TextHint = 'Search favorites...' + end + end + object tsOption: TTabSheet + Caption = 'Options' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 498 + ClientWidth = 761 + object pcOptions: TPageControl + Left = 0 + Height = 400 + Top = 4 + Width = 761 + ActivePage = tsGeneral + Align = alTop + Anchors = [akTop, akLeft, akRight, akBottom] + ParentFont = False + TabIndex = 0 + TabOrder = 0 + object tsGeneral: TTabSheet + Caption = 'General' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 753 + object cbOptionMinimizeToTray: TCheckBox + AnchorSideLeft.Control = seOptionNewMangaTime + AnchorSideTop.Control = cbOptionMinimizeOnStart + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 182 + Width = 106 + Caption = 'Minimize to tray' + ParentFont = False + TabOrder = 4 + end + object cbOptionOneInstanceOnly: TCheckBox + AnchorSideLeft.Control = cbOptionMinimizeToTray + AnchorSideTop.Control = cbOptionMinimizeToTray + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 205 + Width = 177 + Caption = 'Permit only one FMD running' + ParentFont = False + TabOrder = 5 + end + object cbOptionLiveSearch: TCheckBox + AnchorSideLeft.Control = cbOptionOneInstanceOnly + AnchorSideTop.Control = cbOptionOneInstanceOnly + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 228 + Width = 210 + Caption = 'Enable live search (slow on long list)' + ParentFont = False + TabOrder = 6 + end + object gbOptionExternal: TGroupBox + AnchorSideLeft.Control = cbOptionLiveSearch + AnchorSideTop.Control = cbOptionDeleteCompletedTasksOnClose + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 118 + Top = 290 + Width = 742 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 20 + Caption = 'External program' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 98 + ClientWidth = 738 + ParentFont = False + TabOrder = 8 + object lbOptionExternal: TLabel + Left = 4 + Height = 15 + Top = 4 + Width = 730 + Align = alTop + Caption = 'Open manga by using external program:' + ParentColor = False + end + object lbOptionExternalParams: TLabel + Left = 4 + Height = 15 + Top = 50 + Width = 730 + Align = alTop + Caption = 'Parameters:' + ParentColor = False + end + object edOptionExternalParams: TEdit + AnchorSideLeft.Control = lbOptionExternalParams + AnchorSideTop.Control = lbOptionExternalParams + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 69 + Width = 703 + Anchors = [akTop, akLeft, akRight] + TabOrder = 1 + TextHint = 'External program parameters' + end + object lbOptionExternalParamsHint: TLabel + AnchorSideLeft.Control = edOptionExternalParams + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edOptionExternalParams + AnchorSideTop.Side = asrCenter + Left = 711 + Height = 15 + Top = 73 + Width = 13 + Caption = '[?]' + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object edOptionExternalPath: TEditButton + Left = 4 + Height = 23 + Top = 23 + Width = 730 + Align = alTop + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000002E45000064970000629300005E8E30005C8C7C005884950000001F0000 + 001A0000001A0000001A0000001A0000001A0000001A00000011000000000000 + 0000002E450000659950006497991C7AA9C052A5CDE0075477E225250A932B2B + 0C8A2D2D0D872D2D0D872D2D0D872D2D0D872D2D0D8723230B6A000000110000 + 002400466A983590BDF269B8DDFA82CBECFF85CEEEFF4186A8FFE5E5E5FFE5E5 + E4FFFEFEFDFFFEFEFCFFFDFDFAFFFCFCF9FFFEFEF9FF3B3B1B88000000090000 + 0012006699B288D0EFFF7FCAE9FF7FCAE9FF87D0EFFF4489ACFFE4E4E4FFE3E3 + E2FFFCFCFBFFFBFBF8FFFAFAF6FFF8F8F4FFFBFBF5FF4F4F2C7D000000000054 + 7E00006FA7A48AD3F0FF82CDEBFF82CDEBFF8AD3F0FF468BAFFFE3E3E2FFE2E2 + E1FFFBFBF8FFFAFAF6FFF8F8F4FFF7F7F1FFFAFAF4FF58583276005782000073 + AC000073AC9E8ED6F2FF87D0EDFF87D0EDFF8ED6F2FF488FB2FFE2E2E1FFE1E1 + DFFFFAFAF6FFF8F8F4FFF7F7F1FFF5F5EFFFFAFAF2FF5D5D37740076B0000076 + B0000076B09B92DAF4FF8BD4F0FF8BD4F0FF92DAF4FF4C92B6FFE1E1DFFFE1E1 + DDFFF8F8F4FFF7F7F1FFF5F5EFFFF4F4ECFFF8F8EEFF62623C720078B4000078 + B4000078B49797DEF6FF90D8F2FF90D8F2FF97DEF6FF4F96B8FFE1E1DDFFDFDF + DBFFF7F7F1FFF5F5EFFFF4F4ECFFF0F0E6FFF6F6E8FF67674070007BB800007B + B800007BB8949BE1F7FF94DBF4FF94DBF4FF9BE1F7FF5299BCFFDFDFDBFFDEDE + D9FFF5F5EFFFF4F4ECFFF0F0E6FFEBEBDDFFF3F3E3FF6C6C446E007DBB00007D + BB00007DBB909EE5F9FF98DFF6FF98DFF6FF9EE5F9FF569CBFFFDEDED9FFDCDC + D7FFF4F4ECFFF0F0E6FFEBEBDDFFE7E7D6FFF2F2E1FF7171486C007FBF00007F + BF00007FBF8DA3E8FBFF9DE3F9FF9DE3F9FFA3E8FBFF589FC2FFDCDCD7FFDBDB + D4FFF0F0E6FFEBEBDDFFA4A493FFA4A493FFA4A493FF4949257C0082C2000082 + C2000082C28AA6EBFCFFA1E6FBFFA1E6FBFFA6EBFCFF62A8C9FFDBDBD4FFD8D8 + CFFFEBEBDDFFE7E7D6FFB6B6A5FFFFFFFFFF79795069797950250084C5000084 + C5000084C587A9EEFDFFA4E9FCFFA4E9FCFFAAEFFDFF6DAFCDFFEDEDE4FFF4F4 + E7FFF4F4E3FFF2F2E1FFC2C2B1FF467F85B87C7C5225797950000085C8000085 + C8000085C885ADF1FFFFABEFFEFF94E2F8FF6EC8EDFF4397B9FF8EB7BAFF8EB7 + BAFF8EB7BAFF8EB7BAFF93BCBBFF1B84B0963E818E003D7F8C000087CA000087 + CA000087CA8388DBF4FF60C1E9FF5FBFEAFF80D3F4FF9CE3FDFFA2E6FFFFA2E6 + FFFFA2E6FFFFA2E6FFFFA6EAFFFF0087CA830087CA000087CA000087CB000087 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610087CB000087CB00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edOptionExternalPathButtonClick + PasswordChar = #0 + TabOrder = 0 + TextHint = 'External program path' + end + end + object lbOptionLanguage: TLabel + Left = 4 + Height = 15 + Top = 8 + Width = 745 + Align = alTop + Caption = 'Language:' + ParentColor = False + end + object cbLanguages: TComboBox + AnchorSideLeft.Control = lbOptionLanguage + AnchorSideTop.Control = lbOptionLanguage + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 27 + Width = 224 + ItemHeight = 15 + Items.Strings = ( + 'English' + ) + ParentFont = False + Style = csDropDownList + TabOrder = 0 + end + object lbOptionLetFMDDo: TLabel + AnchorSideLeft.Control = cbLanguages + AnchorSideTop.Control = cbLanguages + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 54 + Width = 117 + Caption = 'After download finish:' + ParentColor = False + end + object cbOptionLetFMDDo: TComboBox + AnchorSideLeft.Control = lbOptionLetFMDDo + AnchorSideTop.Control = lbOptionLetFMDDo + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 73 + Width = 224 + ItemHeight = 15 + Items.Strings = ( + 'Do nothing' + 'Exit FMD' + 'Shutdown' + 'Hibernate' + ) + ParentFont = False + Style = csDropDownList + TabOrder = 1 + end + object seOptionNewMangaTime: TSpinEdit + AnchorSideLeft.Control = cbOptionLetFMDDo + AnchorSideTop.Control = cbOptionLetFMDDo + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 116 + Width = 50 + BorderSpacing.Top = 20 + MaxValue = 365 + MinValue = 1 + ParentFont = False + TabOrder = 2 + Value = 1 + end + object lbOptionNewMangaTime: TLabel + AnchorSideLeft.Control = seOptionNewMangaTime + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionNewMangaTime + AnchorSideTop.Side = asrCenter + Left = 58 + Height = 15 + Top = 120 + Width = 238 + Caption = 'New manga based on it''s update time (days)' + ParentColor = False + ParentFont = False + end + object cbOptionMinimizeOnStart: TCheckBox + AnchorSideLeft.Control = seOptionNewMangaTime + AnchorSideTop.Control = seOptionNewMangaTime + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 159 + Width = 112 + BorderSpacing.Top = 20 + Caption = 'Minimize on start' + ParentFont = False + TabOrder = 3 + end + object cbOptionDeleteCompletedTasksOnClose: TCheckBox + AnchorSideLeft.Control = tsGeneral + AnchorSideTop.Control = cbOptionLiveSearch + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 251 + Width = 189 + Caption = 'Delete completed tasks on close' + TabOrder = 7 + end + end + object tsView: TTabSheet + Caption = 'View' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 753 + object cbOptionShowDownloadToolbar: TCheckBox + Left = 4 + Height = 19 + Top = 177 + Width = 745 + Align = alTop + Caption = 'Show downloads toolbar' + ParentFont = False + TabOrder = 1 + end + object gbDropTarget: TGroupBox + Left = 4 + Height = 165 + Top = 8 + Width = 745 + Align = alTop + AutoSize = True + Caption = 'Drop Box' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 145 + ClientWidth = 741 + TabOrder = 0 + object ckDropTarget: TCheckBox + Left = 4 + Height = 19 + Top = 4 + Width = 733 + Align = alTop + Caption = 'Show Drop Box' + ParentFont = False + TabOrder = 0 + end + object tbDropTargetOpacity: TTrackBar + AnchorSideLeft.Control = lbDropTargetOpacity + AnchorSideTop.Control = lbDropTargetOpacity + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 33 + Top = 108 + Width = 280 + Frequency = 15 + Max = 255 + Min = 5 + OnChange = tbDropTargetOpacityChange + Position = 200 + TabOrder = 2 + end + object lbDropTargetOpacity: TLabel + AnchorSideLeft.Control = rgDropTargetMode + AnchorSideTop.Control = rgDropTargetMode + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 89 + Width = 41 + Caption = 'Opacity' + ParentColor = False + ParentFont = False + end + object rgDropTargetMode: TRadioGroup + AnchorSideLeft.Control = ckDropTarget + AnchorSideTop.Control = ckDropTarget + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 58 + Top = 27 + Width = 120 + AutoFill = True + AutoSize = True + Caption = 'Mode' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 38 + ClientWidth = 116 + ItemIndex = 0 + Items.Strings = ( + 'Download all' + 'Add to favorites' + ) + ParentFont = False + TabOrder = 1 + end + end + object cbOptionEnableLoadCover: TCheckBox + Left = 4 + Height = 19 + Top = 246 + Width = 745 + Align = alTop + Caption = 'Enable load manga cover' + ParentFont = False + TabOrder = 4 + end + object cbOptionShowDownloadToolbarDeleteAll: TCheckBox + Left = 4 + Height = 19 + Top = 200 + Width = 745 + Align = alTop + Caption = 'Show "Delete all completed tasks" in downloads toolbar' + ParentFont = False + TabOrder = 2 + end + object cbOptionShowBalloonHint: TCheckBox + Left = 4 + Height = 19 + Top = 269 + Width = 745 + Align = alTop + Caption = 'Show balloon hint' + ParentFont = False + TabOrder = 5 + end + object cbOptionShowDownloadToolbarLeft: TCheckBox + Left = 4 + Height = 19 + Top = 223 + Width = 745 + Align = alTop + Caption = 'Show left downloads toolbar' + ParentFont = False + TabOrder = 3 + end + end + object tsConnections: TTabSheet + Caption = 'Connections' + ClientHeight = 372 + ClientWidth = 753 + object sbDownloadConnections: TScrollBox + Left = 0 + Height = 372 + Top = 0 + Width = 753 + HorzScrollBar.Page = 455 + VertScrollBar.Page = 334 + Align = alClient + BorderStyle = bsNone + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 753 + TabOrder = 0 + object cbOptionUseProxy: TCheckBox + AnchorSideLeft.Control = ckOptionsAlwaysStartTaskFromFailedChapters + AnchorSideTop.Control = ckOptionsAlwaysStartTaskFromFailedChapters + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 198 + Width = 71 + BorderSpacing.Top = 20 + Caption = 'Use proxy' + OnChange = cbOptionUseProxyChange + ParentFont = False + TabOrder = 6 + end + object gbOptionProxy: TGroupBox + AnchorSideLeft.Control = cbOptionUseProxy + AnchorSideTop.Control = cbOptionUseProxy + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 105 + Top = 221 + Width = 426 + AutoSize = True + Caption = 'Proxy config' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 12 + ChildSizing.VerticalSpacing = 12 + ClientHeight = 85 + ClientWidth = 422 + Enabled = False + ParentFont = False + TabOrder = 7 + object lbOptionHost: TLabel + AnchorSideLeft.Control = lbOptionProxyType + AnchorSideTop.Control = lbOptionProxyType + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 35 + Width = 25 + Caption = 'Host' + ParentColor = False + ParentFont = False + end + object edOptionHost: TEdit + AnchorSideLeft.Control = cbOptionProxyType + AnchorSideTop.Control = lbOptionHost + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = cbOptionProxyType + AnchorSideRight.Side = asrBottom + Left = 41 + Height = 23 + Top = 31 + Width = 150 + Anchors = [akTop, akLeft, akRight] + AutoSize = False + Font.CharSet = ANSI_CHARSET + Font.Height = -12 + Font.Name = 'Default' + ParentFont = False + TabOrder = 1 + TextHint = 'Proxy host/IP' + end + object lbOptionUser: TLabel + AnchorSideLeft.Control = cbOptionProxyType + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbOptionHost + Left = 203 + Height = 15 + Top = 35 + Width = 53 + Caption = 'Username' + ParentColor = False + end + object edOptionUser: TEdit + AnchorSideLeft.Control = lbOptionUser + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbOptionUser + AnchorSideTop.Side = asrCenter + Left = 268 + Height = 23 + Top = 31 + Width = 150 + Font.CharSet = ANSI_CHARSET + Font.Height = -12 + Font.Name = 'Default' + ParentFont = False + TabOrder = 3 + TextHint = 'Proxy username' + end + object lbOptionPort: TLabel + AnchorSideLeft.Control = lbOptionHost + AnchorSideTop.Control = lbOptionHost + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 62 + Width = 22 + Caption = 'Port' + ParentColor = False + end + object lbOptionPass: TLabel + AnchorSideLeft.Control = lbOptionUser + AnchorSideTop.Control = lbOptionUser + AnchorSideTop.Side = asrBottom + Left = 203 + Height = 15 + Top = 62 + Width = 50 + Caption = 'Password' + ParentColor = False + end + object edOptionPass: TEdit + AnchorSideLeft.Control = edOptionUser + AnchorSideTop.Control = lbOptionPass + AnchorSideTop.Side = asrCenter + AnchorSideRight.Control = edOptionUser + AnchorSideRight.Side = asrBottom + Left = 268 + Height = 23 + Top = 58 + Width = 150 + Anchors = [akTop, akLeft, akRight] + Font.CharSet = ANSI_CHARSET + Font.Height = -12 + Font.Name = 'Default' + ParentFont = False + TabOrder = 4 + TextHint = 'Proxy password' + end + object lbOptionProxyType: TLabel + Left = 4 + Height = 15 + Top = 8 + Width = 25 + Caption = 'Type' + ParentColor = False + end + object cbOptionProxyType: TComboBox + AnchorSideLeft.Control = lbOptionProxyType + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbOptionProxyType + AnchorSideTop.Side = asrCenter + Left = 41 + Height = 23 + Top = 4 + Width = 150 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'HTTP' + 'SOCKS4' + 'SOCKS5' + ) + Style = csDropDownList + TabOrder = 0 + Text = 'HTTP' + end + object edOptionPort: TSpinEdit + AnchorSideLeft.Control = edOptionHost + AnchorSideTop.Control = lbOptionPort + AnchorSideTop.Side = asrCenter + Left = 41 + Height = 23 + Top = 58 + Width = 67 + Font.CharSet = ANSI_CHARSET + Font.Height = -12 + Font.Name = 'Default' + MaxValue = 999999 + MinValue = 1 + ParentFont = False + TabOrder = 2 + Value = 8080 + end + end + object seOptionMaxParallel: TSpinEdit + Left = 4 + Height = 23 + Top = 8 + Width = 52 + MaxValue = 8 + MinValue = 1 + ParentFont = False + ParentShowHint = False + TabOrder = 0 + Value = 1 + end + object lbOptionMaxParallel: TLabel + AnchorSideLeft.Control = seOptionMaxParallel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionMaxParallel + AnchorSideTop.Side = asrCenter + Left = 60 + Height = 15 + Top = 12 + Width = 247 + Caption = 'Number of downloaded tasks at the same time' + ParentColor = False + ParentFont = False + end + object seOptionMaxThread: TSpinEdit + AnchorSideLeft.Control = seOptionMaxParallel + AnchorSideTop.Control = seOptionMaxParallel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seOptionMaxParallel + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 23 + Top = 35 + Width = 52 + Anchors = [akTop, akLeft, akRight] + MaxValue = 32 + MinValue = 1 + ParentFont = False + ParentShowHint = False + TabOrder = 1 + Value = 1 + end + object lbOptionMaxThread: TLabel + AnchorSideLeft.Control = seOptionMaxThread + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionMaxThread + AnchorSideTop.Side = asrCenter + Left = 60 + Height = 15 + Top = 39 + Width = 286 + Caption = 'Number of downloaded files per task at the same time' + ParentColor = False + ParentFont = False + end + object seOptionMaxRetry: TSpinEdit + AnchorSideLeft.Control = seOptionMaxParallel + AnchorSideTop.Control = seOptionMaxThread + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seOptionMaxParallel + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 23 + Top = 62 + Width = 52 + Anchors = [akTop, akLeft, akRight] + MinValue = -1 + ParentFont = False + ParentShowHint = False + TabOrder = 2 + end + object lbOptionMaxRetry: TLabel + AnchorSideLeft.Control = seOptionMaxRetry + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionMaxRetry + AnchorSideTop.Side = asrCenter + Left = 60 + Height = 15 + Top = 66 + Width = 391 + Caption = 'Number of retry times if tasks have download problems (-1 = always retry)' + ParentColor = False + ParentFont = False + end + object seOptionConnectionTimeout: TSpinEdit + AnchorSideLeft.Control = seOptionMaxRetry + AnchorSideTop.Control = seOptionMaxRetry + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seOptionMaxRetry + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 23 + Top = 89 + Width = 52 + Anchors = [akTop, akLeft, akRight] + MaxValue = 300 + MinValue = 1 + ParentFont = False + ParentShowHint = False + TabOrder = 3 + Value = 30 + end + object lbOptionConnectionTimeout: TLabel + AnchorSideLeft.Control = seOptionConnectionTimeout + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionConnectionTimeout + AnchorSideTop.Side = asrCenter + Left = 60 + Height = 15 + Top = 93 + Width = 161 + Caption = 'Connection timeout (seconds)' + ParentColor = False + ParentFont = False + end + object lbOptionRetryFailedTask: TLabel + AnchorSideLeft.Control = seOptionRetryFailedTask + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionRetryFailedTask + AnchorSideTop.Side = asrCenter + Left = 60 + Height = 15 + Top = 120 + Width = 183 + Caption = 'Number of retry times if task failed' + ParentColor = False + ParentFont = False + end + object seOptionRetryFailedTask: TSpinEdit + AnchorSideLeft.Control = seOptionConnectionTimeout + AnchorSideTop.Control = seOptionConnectionTimeout + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = seOptionMaxRetry + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 23 + Top = 116 + Width = 52 + Anchors = [akTop, akLeft, akRight] + ParentFont = False + ParentShowHint = False + TabOrder = 4 + Value = 1 + end + object ckOptionsAlwaysStartTaskFromFailedChapters: TCheckBox + AnchorSideLeft.Control = seOptionRetryFailedTask + AnchorSideTop.Control = seOptionRetryFailedTask + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 159 + Width = 216 + BorderSpacing.Top = 20 + Caption = 'Always start task from failed chapters' + TabOrder = 5 + end + end + end + object tsSaveTo: TTabSheet + Caption = 'Save to' + ClientHeight = 372 + ClientWidth = 753 + object sbSaveTo: TScrollBox + Left = 0 + Height = 372 + Top = 0 + Width = 753 + HorzScrollBar.Page = 198 + VertScrollBar.Page = 372 + Align = alClient + BorderStyle = bsNone + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 736 + TabOrder = 0 + object rgOptionCompress: TRadioGroup + AnchorSideLeft.Control = lbDefaultDownloadPath + AnchorSideTop.Control = edOptionDefaultPath + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = lbDefaultDownloadPath + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 60 + Top = 54 + Width = 728 + Anchors = [akTop, akLeft, akRight] + AutoFill = True + BorderSpacing.Top = 4 + Caption = 'Save downloaded chapters as' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 5 + ClientHeight = 40 + ClientWidth = 724 + Columns = 5 + ItemIndex = 0 + Items.Strings = ( + 'None' + 'ZIP' + 'CBZ' + 'PDF' + 'EPUB' + ) + OnSelectionChanged = rgOptionCompressSelectionChanged + ParentFont = False + TabOrder = 2 + end + object gbOptionRenaming: TGroupBox + AnchorSideLeft.Control = lbDefaultDownloadPath + AnchorSideTop.Control = gbImageConversion + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = lbDefaultDownloadPath + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 302 + Top = 271 + Width = 728 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + BorderSpacing.Top = 4 + Caption = 'Renaming' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 282 + ClientWidth = 724 + ParentFont = False + TabOrder = 5 + object cbOptionChangeUnicodeCharacter: TCheckBox + Left = 4 + Height = 19 + Hint = 'Enable this if you have problem with unicode character in path.' + Top = 4 + Width = 200 + Caption = 'Replace all unicode character with' + OnChange = cbOptionChangeUnicodeCharacterChange + ParentFont = False + TabOrder = 0 + end + object cbOptionGenerateMangaFolder: TCheckBox + AnchorSideLeft.Control = cbOptionChangeUnicodeCharacter + AnchorSideTop.Control = cbOptionChangeUnicodeCharacter + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 27 + Width = 261 + Caption = 'Auto generate folder based on manga''s name' + OnChange = cbOptionGenerateMangaFolderChange + ParentFont = False + TabOrder = 2 + end + object lbOptionMangaCustomRename: TLabel + AnchorSideLeft.Control = cbOptionGenerateMangaFolder + AnchorSideTop.Control = cbOptionGenerateMangaFolder + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 50 + Width = 107 + Caption = 'Manga folder name:' + Enabled = False + ParentColor = False + end + object edOptionMangaCustomRename: TEdit + AnchorSideLeft.Control = lbOptionMangaCustomRename + AnchorSideTop.Control = lbOptionMangaCustomRename + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = lbOptionMangaCustomRename + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 23 + Top = 69 + Width = 308 + Enabled = False + TabOrder = 3 + TextHint = 'Custom rename' + end + object lbOptionMangaCustomRenameHint: TLabel + AnchorSideLeft.Control = edOptionMangaCustomRename + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edOptionMangaCustomRename + AnchorSideTop.Side = asrCenter + Left = 316 + Height = 15 + Hint = '%WEBSITE% : Website name'#13#10'%MANGA% : Manga title'#13#10'%AUTHOR% : Author'#13#10'%ARTIST% : Artist'#13#10#13#10'Note:'#13#10'Manga folder name must have at least %MANGA%.' + Top = 73 + Width = 13 + Caption = '[?]' + Enabled = False + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object cbOptionRemoveMangaNameFromChapter: TCheckBox + AnchorSideLeft.Control = lbOptionMangaCustomRename + AnchorSideTop.Control = edOptionMangaCustomRename + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 96 + Width = 208 + Caption = 'Remove manga name from chapter' + ParentFont = False + TabOrder = 4 + end + object cbOptionGenerateChapterFolder: TCheckBox + AnchorSideLeft.Control = cbOptionRemoveMangaNameFromChapter + AnchorSideTop.Control = cbOptionRemoveMangaNameFromChapter + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 119 + Width = 172 + Caption = 'Auto generate chapter folder' + Checked = True + ParentFont = False + State = cbChecked + TabOrder = 5 + end + object lbOptionChapterCustomRename: TLabel + AnchorSideLeft.Control = cbOptionGenerateChapterFolder + AnchorSideTop.Control = cbOptionGenerateChapterFolder + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 142 + Width = 78 + Caption = 'Chapter name:' + ParentColor = False + end + object edOptionChapterCustomRename: TEdit + AnchorSideLeft.Control = lbOptionChapterCustomRename + AnchorSideTop.Control = lbOptionChapterCustomRename + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 161 + Width = 308 + TabOrder = 6 + TextHint = 'Custom rename' + end + object lbOptionChapterCustomRenameHint: TLabel + AnchorSideLeft.Control = edOptionChapterCustomRename + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edOptionChapterCustomRename + AnchorSideTop.Side = asrCenter + Left = 316 + Height = 15 + Hint = '%WEBSITE% : Website name'#13#10'%MANGA% : Manga title'#13#10'%CHAPTER% : Chapter title'#13#10'%AUTHOR% : Author'#13#10'%ARTIST% : Artist'#13#10'%NUMBERING% : Numbering'#13#10#13#10'Note:'#13#10'Chapter folder name must have at least %CHAPTER% or %NUMBERING%.' + Top = 165 + Width = 13 + Caption = '[?]' + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object lbOptionRenameDigits: TLabel + AnchorSideLeft.Control = edOptionChapterCustomRename + AnchorSideTop.Control = edOptionChapterCustomRename + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 188 + Width = 78 + Caption = 'Rename digits' + ParentColor = False + end + object cbOptionDigitVolume: TCheckBox + AnchorSideLeft.Control = lbOptionRenameDigits + AnchorSideTop.Control = lbOptionRenameDigits + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 207 + Width = 61 + Caption = 'Volume' + OnChange = cbOptionDigitVolumeChange + TabOrder = 7 + end + object seOptionDigitVolume: TSpinEdit + AnchorSideLeft.Control = cbOptionDigitVolume + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbOptionDigitVolume + Left = 69 + Height = 23 + Top = 207 + Width = 50 + BorderSpacing.Left = 4 + MaxValue = 10 + MinValue = 1 + TabOrder = 8 + Value = 1 + end + object cbOptionDigitChapter: TCheckBox + AnchorSideLeft.Control = seOptionDigitVolume + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionDigitVolume + Left = 139 + Height = 19 + Top = 207 + Width = 62 + BorderSpacing.Left = 20 + Caption = 'Chapter' + OnChange = cbOptionDigitChapterChange + TabOrder = 9 + end + object seOptionDigitChapter: TSpinEdit + AnchorSideLeft.Control = cbOptionDigitChapter + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbOptionDigitChapter + Left = 205 + Height = 23 + Top = 207 + Width = 50 + BorderSpacing.Left = 4 + MaxValue = 10 + MinValue = 1 + TabOrder = 10 + Value = 1 + end + object lbOptionFilenameCustomRenameHint: TLabel + AnchorSideLeft.Control = edOptionFilenameCustomRename + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = edOptionFilenameCustomRename + AnchorSideTop.Side = asrCenter + Left = 316 + Height = 15 + Hint = '%WEBSITE% : Website name'#13#10'%MANGA% : Manga title'#13#10'%CHAPTER% : Chapter title'#13#10'%FILENAME% : Filename'#13#10#13#10'Note:'#13#10'Filename must have at least %FILENAME%' + Top = 259 + Width = 13 + Caption = '[?]' + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object edOptionFilenameCustomRename: TEdit + AnchorSideLeft.Control = lbOptionFilenameCustomRename + AnchorSideTop.Control = lbOptionFilenameCustomRename + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 255 + Width = 308 + TabOrder = 11 + TextHint = 'Custom rename' + end + object lbOptionFilenameCustomRename: TLabel + AnchorSideLeft.Control = cbOptionGenerateChapterFolder + AnchorSideTop.Control = cbOptionDigitVolume + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 236 + Width = 51 + BorderSpacing.Top = 10 + Caption = 'Filename:' + ParentColor = False + end + object edOptionChangeUnicodeCharacterStr: TEdit + AnchorSideLeft.Control = cbOptionChangeUnicodeCharacter + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbOptionChangeUnicodeCharacter + Left = 208 + Height = 23 + Top = 4 + Width = 80 + Enabled = False + TabOrder = 1 + end + end + object lbDefaultDownloadPath: TLabel + Left = 4 + Height = 15 + Top = 8 + Width = 728 + Align = alTop + Caption = 'Choose the default download path:' + ParentColor = False + ParentFont = False + end + object Panel8: TPanel + Left = 4 + Height = 0 + Top = 54 + Width = 728 + Align = alTop + AutoSize = True + BevelOuter = bvNone + TabOrder = 0 + end + object lbOptionPDFQualityHint: TLabel + AnchorSideLeft.Control = lbOptionPDFQuality + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbOptionPDFQuality + Left = 181 + Height = 15 + Top = 122 + Width = 13 + BorderSpacing.Left = 4 + Caption = '[?]' + Enabled = False + Font.Color = clBlue + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object seOptionPDFQuality: TSpinEdit + AnchorSideLeft.Control = lbDefaultDownloadPath + AnchorSideTop.Control = rgOptionCompress + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Hint = '100 = FlateEncode (lossless), lower = DCTEncode (lossy)' + Top = 118 + Width = 50 + BorderSpacing.Top = 4 + Enabled = False + MinValue = 5 + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 3 + Value = 100 + end + object lbOptionPDFQuality: TLabel + AnchorSideLeft.Control = seOptionPDFQuality + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionPDFQuality + AnchorSideTop.Side = asrCenter + Left = 58 + Height = 15 + Hint = '100 = FlateEncode (lossless), lower = DCTEncode (lossy)' + Top = 122 + Width = 119 + BorderSpacing.Left = 4 + Caption = 'PDF compression level' + Enabled = False + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object edOptionDefaultPath: TEditButton + Left = 4 + Height = 23 + Top = 27 + Width = 728 + Align = alTop + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000002E45000064970000629300005E8E30005C8C7C00598792000000070028 + 3C00005B8900005B8900005B8900002E45000000000000000000000000000000 + 0000002E450000659950006497991C7AA9C052A5CDE0005B89C10000001A0028 + 3C07005B8900005B8900005B8900002E45000000000000000000000000110000 + 002400466A983590BDF269B8DDFA82CBECFF85CEEEFF005C8BEF005079C40050 + 79C4005D8CBE005D8CBE005D8CBE00466A980000002400000011000000090000 + 0012006699B288D0EFFF7FCAE9FF7FCAE9FF87D0EFFF267DA9FF7FBCDBFF7FBC + DBFF8DD1F3FF8DD1F3FF90D4F5FF006699B20042634D00000009000000000054 + 7E00006FA7A48AD3F0FF82CDEBFF82CDEBFF8AD3F0FF267EABFF7CB9D8FF7CB9 + D8FF8ACEF0FF8ACEF0FF8FD3F4FFF4B62EFF006FA7A400547E00005782000073 + AC000073AC9E8ED6F2FF87D0EDFF87D0EDFF8ED6F2FF2882AFFF7DBAD8FF7DBA + D8FF8BCFF1FF8BCFF1FF91D5F5FFFEC941FF0073AC9E0073AC000076B0000076 + B0000076B09B92DAF4FF8BD4F0FF8BD4F0FF92DAF4FF2B85B3FF7FBCDAFF7FBC + DAFF8DD1F3FF8DD1F3FF93D7F6FFEBEBDDFF0076B09B0076B0000078B4000078 + B4000078B49797DEF6FF90D8F2FF90D8F2FF97DEF6FF2D89B7FF80BDDCFF80BD + DCFF8FD3F5FF8FD3F5FF95D9F8FFF5F5EEFF0078B4970078B400007BB800007B + B800007BB8949BE1F7FF94DBF4FF94DBF4FF9BE1F7FF308DBCFF81BEDDFF81BE + DDFF90D4F6FF90D4F6FF97DBF9FFFEFEFDFF007BB894007BB800007DBB00007D + BB00007DBB909EE5F9FF98DFF6FF98DFF6FF9EE5F9FF3290C0FF83C0DFFF83C0 + DFFF92D6F8FF92D6F8FF99DDFAFF007DBB90007DBB33007CBA00007FBF00007F + BF00007FBF8DA3E8FBFF9DE3F9FF9DE3F9FFA3E8FBFF3594C5FF85C2E1FF85C2 + E1FF94D8FAFF94D8FAFF9BDFFCFF007FBF8D007FBE00007EBD000082C2000082 + C2000082C28AA6EBFCFFA1E6FBFFA1E6FBFFA6EBFCFF3C9DCFFF87C4E2FF87C4 + E2FF96DAFCFF96DAFCFF9EE2FDFF0082C28A0082C2000082C2000084C5000084 + C5000084C587A9EEFDFFA4E9FCFFA4E9FCFFAAEFFDFF42A1D1FF90D1F1FF96DA + FBFF97DBFDFF97DBFDFF9FE3FEFF0084C5870084C5000084C5000085C8000085 + C8000085C885ADF1FFFFABEFFEFF95E2F8FF6EC9EDFF48A9D9FF98DCFEFF98DC + FEFF98DCFEFF98DCFEFFA1E5FFFF0085C8850085C8000085C8000087CA000087 + CA000087CA8388DCF4FF60C0E9FF5FBFEAFF80D3F4FF9CE3FDFFA2E6FFFFA2E6 + FFFFA2E6FFFFA2E6FFFFA6EAFFFF0087CA830087CA000087CA000087CB000087 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610087CB000087CB00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edOptionDefaultPathButtonClick + ParentFont = False + PasswordChar = #0 + TabOrder = 1 + TextHint = 'Default download path' + end + object gbImageConversion: TGroupBox + AnchorSideLeft.Control = lbDefaultDownloadPath + AnchorSideTop.Control = seOptionPDFQuality + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = sbSaveTo + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 122 + Top = 145 + Width = 728 + Anchors = [akTop, akLeft, akRight] + AutoSize = True + Caption = 'Image Conversion' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 102 + ClientWidth = 724 + TabOrder = 4 + object lbWebPSaveAs: TLabel + AnchorSideLeft.Control = gbImageConversion + AnchorSideTop.Control = ckPNGSaveAsJPEG + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 29 + Width = 72 + Caption = 'Save WebP as' + ParentColor = False + end + object cbWebPSaveAs: TComboBox + AnchorSideLeft.Control = lbWebPSaveAs + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbWebPSaveAs + AnchorSideTop.Side = asrCenter + Left = 82 + Height = 23 + Top = 25 + Width = 76 + ItemHeight = 15 + ItemIndex = 1 + Items.Strings = ( + 'WebP' + 'PNG' + 'JPEG' + ) + Style = csDropDownList + TabOrder = 1 + Text = 'PNG' + end + object lbPNGCompressionLevel: TLabel + AnchorSideLeft.Control = lbWebPSaveAs + AnchorSideTop.Control = cbWebPSaveAs + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 54 + Width = 124 + Caption = 'PNG Compression level' + ParentColor = False + end + object cbPNGCompressionLevel: TComboBox + AnchorSideLeft.Control = lbPNGCompressionLevel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbPNGCompressionLevel + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 134 + Height = 23 + Top = 50 + Width = 100 + ItemHeight = 15 + ItemIndex = 1 + Items.Strings = ( + 'None' + 'Fastest' + 'Default' + 'Maximum' + ) + Style = csDropDownList + TabOrder = 2 + Text = 'Fastest' + end + object lbJPEGQuality: TLabel + AnchorSideLeft.Control = lbWebPSaveAs + AnchorSideTop.Control = cbPNGCompressionLevel + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 79 + Width = 64 + Caption = 'JPEG quality' + ParentColor = False + end + object seJPEGQuality: TSpinEdit + AnchorSideLeft.Control = lbJPEGQuality + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbJPEGQuality + AnchorSideTop.Side = asrCenter + AnchorSideRight.Side = asrBottom + Left = 74 + Height = 23 + Top = 75 + Width = 47 + MinValue = 1 + TabOrder = 3 + Value = 80 + end + object ckPNGSaveAsJPEG: TCheckBox + AnchorSideLeft.Control = gbImageConversion + AnchorSideTop.Control = gbImageConversion + Left = 4 + Height = 19 + Top = 4 + Width = 113 + Caption = 'Save PNG as JPEG' + TabOrder = 0 + end + end + end + end + object tsUpdate: TTabSheet + Caption = 'Updates' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 392 + ClientWidth = 753 + object cbOptionAutoCheckLatestVersion: TCheckBox + Left = 4 + Height = 19 + Top = 8 + Width = 745 + Align = alTop + Caption = 'Auto check for latest version ' + ParentFont = False + TabOrder = 0 + end + object gbOptionFavorites: TGroupBox + Left = 4 + Height = 166 + Top = 31 + Width = 745 + Align = alTop + AutoSize = True + Caption = 'Favorites' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 146 + ClientWidth = 741 + ParentFont = False + TabOrder = 1 + object cbOptionAutoCheckFavStartup: TCheckBox + Left = 4 + Height = 19 + Top = 4 + Width = 733 + Align = alTop + Caption = 'Auto check for new chapter at startup' + OnChange = cbOptionAutoCheckFavStartupChange + ParentFont = False + TabOrder = 0 + end + object seOptionAutoCheckFavIntervalMinutes: TSpinEdit + AnchorSideLeft.Control = cbOptionAutoCheckFavInterval + AnchorSideTop.Control = cbOptionAutoCheckFavInterval + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 73 + Width = 58 + MaxValue = 1440 + MinValue = 1 + OnChange = seOptionAutoCheckFavIntervalMinutesChange + TabOrder = 3 + Value = 1 + end + object lbOptionAutoCheckFavIntervalMinutes: TLabel + AnchorSideLeft.Control = seOptionAutoCheckFavIntervalMinutes + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = seOptionAutoCheckFavIntervalMinutes + AnchorSideTop.Side = asrCenter + Left = 66 + Height = 15 + Top = 77 + Width = 243 + Caption = 'Auto check for new chapter every %d minutes' + ParentColor = False + end + object cbOptionAutoCheckFavRemoveCompletedManga: TCheckBox + AnchorSideLeft.Control = cbOptionAutoCheckFavDownload + AnchorSideTop.Control = cbOptionAutoCheckFavDownload + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 123 + Width = 298 + Caption = 'Automatic remove completed manga from Favorites' + TabOrder = 5 + end + object cbOptionAutoCheckFavDownload: TCheckBox + AnchorSideLeft.Control = seOptionAutoCheckFavIntervalMinutes + AnchorSideTop.Control = seOptionAutoCheckFavIntervalMinutes + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 19 + Top = 100 + Width = 242 + Caption = 'Automatic download after finish checking' + ParentFont = False + TabOrder = 4 + end + object cbOptionAutoCheckFavInterval: TCheckBox + Left = 4 + Height = 19 + Top = 50 + Width = 733 + Align = alTop + Caption = 'Auto check for new chapter in an interval' + OnChange = cbOptionAutoCheckFavIntervalChange + ParentFont = False + TabOrder = 2 + end + object cbOptionAutoOpenFavStartup: TCheckBox + Left = 4 + Height = 19 + Top = 27 + Width = 733 + Align = alTop + Caption = 'Open Favorites at startup' + ParentFont = False + TabOrder = 1 + end + end + object cbOptionUpdateListNoMangaInfo: TCheckBox + Left = 4 + Height = 19 + Top = 201 + Width = 745 + Align = alTop + Caption = 'Don''t load manga information when updating list (filter will be not work!)' + ParentFont = False + TabOrder = 2 + end + object cbOptionUpdateListRemoveDuplicateLocalData: TCheckBox + Left = 4 + Height = 19 + Top = 224 + Width = 745 + Align = alTop + Caption = 'Remove duplicate local data when updating manga list' + ParentFont = False + TabOrder = 3 + Visible = False + end + end + object tsDialogs: TTabSheet + Caption = 'Dialogs' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 392 + ClientWidth = 753 + object gbDialogs: TGroupBox + Left = 4 + Height = 93 + Top = 8 + Width = 745 + Align = alTop + AutoSize = True + Caption = 'Show dialog confirmation for' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 73 + ClientWidth = 741 + TabOrder = 0 + object cbOptionShowQuitDialog: TCheckBox + Left = 4 + Height = 19 + Top = 4 + Width = 733 + Align = alTop + Caption = 'Exit FMD' + ParentFont = False + TabOrder = 0 + end + object cbOptionShowDeleteTaskDialog: TCheckBox + Left = 4 + Height = 19 + Top = 27 + Width = 733 + Align = alTop + Caption = 'Delete task/favorite' + ParentFont = False + TabOrder = 1 + end + object cbOptionShowDownloadMangalistDialog: TCheckBox + Left = 4 + Height = 19 + Top = 50 + Width = 733 + Align = alTop + Caption = 'Download manga list if empty' + ParentFont = False + TabOrder = 2 + end + end + end + object tsWebsites: TTabSheet + Caption = 'Websites' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 753 + object pcWebsiteOptions: TPageControl + Left = 4 + Height = 356 + Top = 8 + Width = 745 + ActivePage = tsWebsiteSelection + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tsWebsiteSelection: TTabSheet + Caption = 'Websites' + ClientHeight = 328 + ClientWidth = 737 + object vtOptionMangaSiteSelection: TVirtualStringTree + Left = 0 + Height = 293 + Top = 35 + Width = 737 + Align = alClient + Colors.DropTargetBorderColor = clHotLight + Colors.FocusedSelectionBorderColor = clHotLight + Colors.SelectionRectangleBorderColor = clHotLight + Colors.UnfocusedSelectionBorderColor = clBtnShadow + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.MainColumn = -1 + Margin = 1 + ParentFont = False + TabOrder = 1 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages] + OnFreeNode = vtOptionMangaSiteSelectionFreeNode + OnGetText = vtOptionMangaSiteSelectionGetText + OnGetNodeDataSize = vtOptionMangaSiteSelectionGetNodeDataSize + end + object pnlWebsitesTool: TPanel + Left = 2 + Height = 23 + Top = 6 + Width = 731 + Align = alTop + BorderSpacing.Top = 4 + BorderSpacing.Right = 2 + BorderSpacing.Bottom = 4 + BorderSpacing.Around = 2 + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 23 + ClientWidth = 731 + TabOrder = 0 + object pnlWebsitesToolRight: TPanel + Left = 561 + Height = 23 + Top = 0 + Width = 170 + Align = alRight + AutoSize = True + BevelOuter = bvNone + ClientHeight = 23 + ClientWidth = 170 + TabOrder = 0 + object ToolBarWebsites: TToolBar + Left = 0 + Height = 22 + Top = 0 + Width = 170 + AutoSize = True + EdgeBorders = [] + Images = IconList + List = True + ParentFont = False + ShowCaptions = True + TabOrder = 0 + Transparent = True + object tbWebsitesExpandAll: TToolButton + Left = 1 + Top = 0 + AutoSize = True + Caption = 'Expand All' + ImageIndex = 17 + OnClick = tbWebsitesExpandAllClick + end + object tbWebsitesCollapseAll: TToolButton + Left = 82 + Top = 0 + AutoSize = True + Caption = 'Collapse All' + ImageIndex = 18 + OnClick = tbWebsitesCollapseAllClick + end + end + end + object edWebsitesSearch: TEditButton + Left = 0 + Height = 23 + Top = 0 + Width = 184 + Align = alLeft + BorderSpacing.Right = 2 + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edWebsitesSearchButtonClick + OnChange = edWebsitesSearchChange + PasswordChar = #0 + TabOrder = 1 + TextHint = 'Search website...' + end + end + end + object tsAccounts: TTabSheet + Caption = 'Accounts' + end + object tsWebsiteOptions: TTabSheet + Caption = 'Options' + ClientHeight = 328 + ClientWidth = 737 + object sbWebsiteOptions: TScrollBox + Left = 0 + Height = 328 + Top = 0 + Width = 737 + HorzScrollBar.Increment = 1 + HorzScrollBar.Page = 1 + HorzScrollBar.Smooth = True + HorzScrollBar.Tracking = True + VertScrollBar.Increment = 1 + VertScrollBar.Page = 1 + VertScrollBar.Smooth = True + VertScrollBar.Tracking = True + Align = alClient + BorderStyle = bsNone + TabOrder = 0 + end + end + object tsWebsiteAdvanced: TTabSheet + Caption = 'Advanced' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + end + object tsWebsiteModules: TTabSheet + Caption = 'Modules' + end + end + end + object tsMisc: TTabSheet + Caption = 'Misc' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 372 + ClientWidth = 753 + object pcMisc: TPageControl + Left = 4 + Height = 356 + Top = 8 + Width = 745 + ActivePage = tsCustomColor + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tsCustomColor: TTabSheet + Caption = 'Custom color' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + end + object tsLog: TTabSheet + Caption = 'Log' + ChildSizing.LeftRightSpacing = 4 + ChildSizing.TopBottomSpacing = 4 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 343 + ClientWidth = 515 + object ckEnableLogging: TCheckBox + Left = 4 + Height = 19 + Top = 4 + Width = 99 + Caption = 'Enable logging' + TabOrder = 0 + end + object btClearLogFile: TBitBtn + AnchorSideLeft.Control = ckEnableLogging + AnchorSideTop.Control = edLogFileName + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 26 + Top = 73 + Width = 112 + AutoSize = True + Caption = 'Clear log file' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btClearLogFileClick + TabOrder = 2 + end + object lbLogFileName: TLabel + AnchorSideLeft.Control = ckEnableLogging + AnchorSideTop.Control = ckEnableLogging + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 15 + Top = 27 + Width = 42 + Caption = 'Log file:' + ParentColor = False + end + object btOpenLog: TBitBtn + AnchorSideLeft.Control = ckEnableLogging + AnchorSideTop.Control = btClearLogFile + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 26 + Top = 103 + Width = 95 + AutoSize = True + Caption = 'Open log' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A00000016000000090D0D0D671010 + 1085101010851010108510101085101010851010108510101085101010851010 + 108510101085101010851010108510101085101010850D0D0D672727277BEBEB + EBFFE7E7E7FFE7E7E7FFE7E7E7FFE7E7E7FFE7E7E7FFE7E7E7FFE7E7E7FFE7E7 + E7FFE7E7E7FFE7E7E7FFE7E7E7FFE7E7E7FFEBEBEBFF2727277B32323276EAEA + EAFF777777FFE2E2E2FFACACACFFC5C5C5FFACACACFFBDBDBDFFBDBDBDFFBDBD + BDFFB4B4B4FFBDBDBDFFE2E2E2FFE2E2E2FFEAEAEAFF3232327638383873EDED + EDFFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6 + E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFEDEDEDFF383838733E3E3E71F0F0 + F0FFFF9966FFEBEBEBFFC2C2C2FFB1B1B1FFC2C2C2FFC2C2C2FFB1B1B1FFC2C2 + C2FFCECECEFFEBEBEBFFEBEBEBFFEBEBEBFFF0F0F0FF3E3E3E714444446EF3F3 + F3FFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEF + EFFFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFF3F3F3FF4444446E4949496CF7F7 + F7FF6E71C2FFF4F4F4FFB6B6B6FFC7C7C7FFC7C7C7FFC7C7C7FFBFBFBFFFC7C7 + C7FFBFBFBFFFC7C7C7FFC7C7C7FFD0D0D0FFF7F7F7FF4949496C4D4D4D6AFAFA + FAFFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8 + F8FFF8F8F8FFF8F8F8FFF8F8F8FFF8F8F8FFFAFAFAFF4D4D4D6A51515168FDFD + FDFF22AA33FFFCFCFCFFC3C3C3FFCCCCCCFFCCCCCCFFCCCCCCFFBBBBBBFFCCCC + CCFFE4E4E4FFFCFCFCFFFCFCFCFFFCFCFCFFFDFDFDFF5151516855555567FFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5555556750505069BBBB + BBFFBABABAFFB8B8B8FFB6B6B6FFB3B3B3FFB0B0B0FFAEAEAEFFABABABFFA8A8 + A8FFA6A6A6FFA3A3A3FFA0A0A0FF9E9E9EFF9C9C9CFF030303665252525BC6C6 + C6D4DCDCDCFFD8D9D9FFD5D5D5FFD0D1D1FFCCCCCCFFC8C8C8FFC6C6C6FFC6C5 + C5FFC9C5C5FFCDC6C6FFD1C7C7FFD7CBCBFFC4B8B8D45252525B555555225555 + 5559555555665555556655555566555555665555556655555566555555665555 + 5566555555665555556655555566555555665555555955555522FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btOpenLogClick + TabOrder = 3 + end + object edLogFileName: TEditButton + AnchorSideLeft.Control = ckEnableLogging + AnchorSideTop.Control = lbLogFileName + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 23 + Top = 46 + Width = 506 + Anchors = [akTop, akLeft, akRight] + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000002E45000064970000629300005E8E30005C8C7C005884950000001F0000 + 001A0000001A0000001A0000001A0000001A0000001A00000011000000000000 + 0000002E450000659950006497991C7AA9C052A5CDE0075477E225250A932B2B + 0C8A2D2D0D872D2D0D872D2D0D872D2D0D872D2D0D8723230B6A000000110000 + 002400466A983590BDF269B8DDFA82CBECFF85CEEEFF4186A8FFE5E5E5FFE5E5 + E4FFFEFEFDFFFEFEFCFFFDFDFAFFFCFCF9FFFEFEF9FF3B3B1B88000000090000 + 0012006699B288D0EFFF7FCAE9FF7FCAE9FF87D0EFFF4489ACFFE4E4E4FFE3E3 + E2FFFCFCFBFFFBFBF8FFFAFAF6FFF8F8F4FFFBFBF5FF4F4F2C7D000000000054 + 7E00006FA7A48AD3F0FF82CDEBFF82CDEBFF8AD3F0FF468BAFFFB7B7A8FFB6B6 + A7FFDBDBCAFFD1D1C0FFF8F8F4FFF7F7F1FFFAFAF4FF58583276005782000073 + AC000073AC9E8ED6F2FF87D0EDFF87D0EDFF8ED6F2FF488FB2FFD5D5C6FFD4D4 + C5FFEBEBDAFFE9E9D8FFF7F7F1FFF5F5EFFFFAFAF2FF5D5D37740076B0000076 + B0000076B09B92DAF4FF8BD4F0FF8BD4F0FF92DAF4FF4C92B6FFB5B5A6FFC4C4 + B4FFC7C7B6FFD6D6C5FFD4D4C3FFCACAB9FFF8F8EEFF62623C720078B4000078 + B4000078B49797DEF6FF90D8F2FF90D8F2FF97DEF6FF4F96B8FFD3D3C4FFD1D1 + C2FFE7E7D6FFE5E5D4FFE4E4D3FFE2E2D1FFF6F6E8FF67674070007BB800007B + B800007BB8949BE1F7FF94DBF4FF94DBF4FF9BE1F7FF5299BCFFB3B3A3FFC0C0 + B1FFC3C3B2FFC2C2B1FFC0C0AFFFBEBEADFFF3F3E3FF6C6C446E007DBB00007D + BB00007DBB909EE5F9FF98DFF6FF98DFF6FF9EE5F9FF569CBFFFCFCFC0FFCECE + BEFFE4E4D3FFF0F0E6FFEBEBDDFFE7E7D6FFF2F2E1FF7171486C007FBF00007F + BF00007FBF8DA3E8FBFF9DE3F9FF9DE3F9FFA3E8FBFF589FC2FFAFAFA0FFBDBD + AEFFC8C8B7FFEBEBDDFFA4A493FFA4A493FFA4A493FF4949257C0082C2000082 + C2000082C28AA6EBFCFFA1E6FBFFA1E6FBFFA6EBFCFF62A8C9FFDBDBD4FFD8D8 + CFFFEBEBDDFFE7E7D6FFB6B6A5FFFFFFFFFF79795069797950250084C5000084 + C5000084C587A9EEFDFFA4E9FCFFA4E9FCFFAAEFFDFF6DAFCDFFEDEDE4FFF4F4 + E7FFF4F4E3FFF2F2E1FFC2C2B1FF467F85B87C7C5225797950000085C8000085 + C8000085C885ADF1FFFFABEFFEFF94E2F8FF6EC8EDFF4397B9FF8EB7BAFF8EB7 + BAFF8EB7BAFF8EB7BAFF93BCBBFF1B84B0963E818E003D7F8C000087CA000087 + CA000087CA8388DBF4FF60C1E9FF5FBFEAFF80D3F4FF9CE3FDFFA2E6FFFFA2E6 + FFFFA2E6FFFFA2E6FFFFA6EAFFFF0087CA830087CA000087CA000087CB000087 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610087CB000087CB00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edLogFileNameButtonClick + PasswordChar = #0 + TabOrder = 1 + end + end + end + end + end + object btOptionApply: TBitBtn + Left = 8 + Height = 45 + Top = 440 + Width = 125 + Anchors = [akLeft, akBottom] + AutoSize = True + Caption = 'Apply' + Constraints.MinHeight = 45 + Constraints.MinWidth = 125 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00020000000C000000160000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A000000170000000C00000002FFFFFF00FFFFFF000000 + 0004000000170000002B011A004302440080025A00AB025D00C4025D00C4025A + 00AB02440080011A00430000002D0000001800000004FFFFFF00FFFFFF000000 + 0000031F00000553004D087402BF139D08E31DC40EF521D411FD21D411FD1DC4 + 0EF5139D08E3087402BF0553004D031F000000000000FFFFFF00FFFFFF000B83 + 00000B7F004D0E8804CD21C411F623D112FF22B611FF22D111FF22D111FF22D1 + 11FF22D111FF1EC20FF60D8803CD0B7F004D0B830000FFFFFF00FFFFFF000C85 + 001A0F8A03BF27C017F623C812FF22B211FFE6E6E6FF22B211FF22C811FF22C8 + 11FF22C811FF22C811FF1FBC0FF60D8902BF0C85001AFFFFFF00FFFFFF000D89 + 006C22A813E326C015FF22AD11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE + 11FF22BE11FF22BE11FF22BE11FF17A109E30D89006CFFFFFF00FFFFFF000E8D + 00A73BBD2BF523AE12FFD5D5D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A8 + 11FF22B411FF22B411FF22B411FF21AF11F50E8D00A7FFFFFF00FFFFFF000F92 + 00C450C83FFDA9D7A2FFD5D5D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6 + E6FF22A311FF22AA11FF22AA11FF28AE17FD0F9200C4FFFFFF00FFFFFF001096 + 00C453CB42FD3CB32BFFF8F8F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2 + E2FFE6E6E6FF229E11FF22A111FF2CAA1BFD109600C4FFFFFF00FFFFFF00119A + 00A751CB40F547BE36FF3EB52DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2 + E2FFE3E3E3FFE7E7E7FF269E15FF34B023F5119A00A7FFFFFF00FFFFFF00129E + 006C3DBF2CE354CB43FF4EC53DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB + 33FFFFFFFFFFA7E29EFF52C941FF36B925E3129E006CFFFFFF00FFFFFF0013A1 + 001A1AA707BF5CD74BF658CF47FF57CE46FF57CE46FF57CE46FF57CE46FF57CE + 46FF4AC139FF52C941FF57D245F619A606BF13A1001AFFFFFF00FFFFFF0013A2 + 000014A5004D21AF0ECD5FDA4EF663DA52FF5FD64EFF5FD64EFF5FD64EFF5FD6 + 4EFF62D951FF5DD94BF620AE0DCD14A5004D13A20000FFFFFF00FFFFFF0013A2 + 000014A5000014A8004D1BAD08BF42C82FE35FDC4EF56BE35AFD6BE359FD5FDB + 4EF541C72EE31BAD07BF14A8004D14A5000013A20000FFFFFF00FFFFFF0013A2 + 000014A5000014A8000015A9001A15AA006C15AA00A615AA00C415AA00C415AA + 00A615AA006C15A9001A14A8000014A5000013A20000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btOptionApplyClick + TabOrder = 1 + end + end + object tsAbout: TTabSheet + Caption = 'About' + ChildSizing.TopBottomSpacing = 4 + ClientHeight = 498 + ClientWidth = 761 + object btCheckLatestVersion: TBitBtn + Left = 0 + Height = 40 + Top = 452 + Width = 208 + Anchors = [akLeft, akBottom] + BorderSpacing.Top = 3 + Caption = 'Check for latest version' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 00000000000600000010000000190000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A000000190000001500000010FFFFFF000000 + 00000000000B0000002011090133391E013E532A014345240240733A02A6984D + 02CC984D02CC984D02CC984D02CC984D02CC733A02A30000001FFFFFFF000000 + 000028160200763D0419A2580842C47E174EE4A01C54FCB9203F9C5105CCFDBC + 28FFFCB81DFFFCB81DFFFDC033FF9C5105CC9C51055C00000000FFFFFF00A65B + 0D00A3580B22AB62105FF8BA346DF6B01C6DF7B11E6BF8B52740A2570ACCF8B6 + 2AFFF6AC14FFF8BA35FFA2570ACCA2570A84A15609002A170400FFFFFF00A95E + 0F10AD641378F3B84390EFAB2A90E7A83691BF7A2078A85D0E33A85D0ECCF2B3 + 39FFF3B943FFEEA824FFF2B339FFAD6210BFA95E0F1AAA5F1000FFFFFF00AF64 + 144DCC8B33A6E8A83BB4E4A845B2AF641488AE631332AC611100AF6414CCF0BD + 5CFFAF6414CCECB148FFE8A83BFFCD8D34E3AF64146CAF641400FFFFFF00B66B + 198CE0A751CFE3A84ED6C98734BBB56A194AAF641400B66B1900B66B19CCB66B + 19CCB66B1994C98734DCE3A84EFFE0A851F5B66B19A7B66B1900FFFFFF00BE73 + 1FC1E7B466F1E5B061F1BE731FC1BB701D00C0752100C0752000BD721E99BD72 + 1E5CBA6F1C00BE731FCCE5B061FFE7B466FFBE731FCCBE731F00FFFFFF00C57A + 25CCE8B86FFFE6B46CFFC57A25CCC97E2700C67B265CC67B2699C1762100BE73 + 1F00C87D2700C57A25C1E6B46CF1E8B86FF1C57A25C1C57A2500FFFFFF00CD82 + 2AA7E8B66CF5E8B570FFDA9B48DCCD822A94CD822ACCCD822ACCCD822A00CF84 + 2C00CE832B4ADA9B47BBE8B570D6E8B66CCFCD822A8CCD822A00FFFFFF00D489 + 306CE4AB59E3EDBC76FFF1C67EFFD48930CCF7D38AFFD48930CCD88D3200D58A + 3132D4893088EEBF75B2EDBC76B4E4A958A6D489304DD4893000FFFFFF00DA8F + 341ADC9339BFF7CD85FFF2C27AFFF9D38AFFF7CD85FFDB9034CCDB903433E4A5 + 4F78F3C67991F4C57D90F8D28990DD953A78DA8F3410D98E3300FFFFFF00E196 + 3900E1963984E19639CCFCD88EFFF9CC82FFFCD58AFFE19639CCFCD48940FBD0 + 866BFACF856DFCD88D6DE49E435FE0953922DC913500DC913500FFFFFF00E69B + 3D5CE59A3DCCFFE094FFFED98DFFFED98DFFFFDC91FFE59A3DCCFEDA8E3FF8CB + 7B54F0B7604EE79F4242E59A3D19E1963900DC913500DC913500FFFFFF00E99E + 4099E99E40CCE99E40CCE99E40CCE99E40CCE99E40CCE99E4099E99E4020E99E + 4025E99E4019E89D3F06E59A3D00E1963900DC913500DC913500FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btCheckLatestVersionClick + TabOrder = 1 + end + object btAbortCheckLatestVersion: TSpeedButton + AnchorSideLeft.Control = btCheckLatestVersion + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btCheckLatestVersion + Left = 212 + Height = 35 + Top = 452 + Width = 40 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 4 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 + 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 + 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 + 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 + D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 + 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 + D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 + 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 + B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 + 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA + EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 + 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 + E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 + 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 + E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 + 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC + DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 + 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB + DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 + 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF + FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 + A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F + D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 + A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B + E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 + A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D + F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 + A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 + AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + Visible = False + OnClick = btAbortCheckLatestVersionClick + end + object btVisitMyBlog: TBitBtn + AnchorSideLeft.Control = btAbortCheckLatestVersion + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = btCheckLatestVersion + Left = 256 + Height = 35 + Top = 452 + Width = 208 + Anchors = [akTop, akLeft, akBottom] + BorderSpacing.Left = 4 + Caption = 'Visit my blog' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0A0A0A660C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C0C770C0C + 0C770C0C0C770C0C0C770C0C0C770A0A0A660000002C00000012000000090000 + 00161F1F1F74EBEBEBFFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6E6FFE6E6 + E6FFE6E6E6FFE6E6E6FFEBEBEBFF1F1F1F740000001600000009000000002A2A + 2A0036363671E8E8E8FFB4B4B4FFBDBDBDFFC5C5C5FFBDBDBDFFCECECEFFE0E0 + E0FFE0E0E0FFE0E0E0FFE8E8E8FF363636712A2A2A0000000000343434004545 + 45004545456FEAEAEAFFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFD0D0D0FFE2E2 + E2FFE2E2E2FFE2E2E2FFEAEAEAFF4545456F45454500343434004B4B4B004B4B + 4B004B4B4B6EECECECFF8E8E8EFFA5A5A5FFA5A5A5FF8E8E8EFFD3D3D3FFE5E5 + E5FFC2C2C2FFB9B9B9FFECECECFF4B4B4B6E4B4B4B004B4B4B00515151005151 + 51005151516DEEEEEEFFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8E8FFE8E8 + E8FFD5D5D5FFD5D5D5FFEEEEEEFF5151516D5151510051515100575757005757 + 57005757576CF0F0F0FFBFBFBFFFC7C7C7FFD0D0D0FFC7C7C7FFD8D8D8FFEAEA + EAFFBFBFBFFFC7C7C7FFF0F0F0FF5757576C57575700575757005D5D5D005D5D + 5D005D5D5D6BF2F2F2FFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFDBDBDBFFEDED + EDFFDBDBDBFFDBDBDBFFF2F2F2FF5D5D5D6B5D5D5D005D5D5D00626262006262 + 62006262626BF5F5F5FF919191FFC4C4C4FFAAAAAAFFAAAAAAFF919191FFF1F1 + F1FFBBBBBBFFCCCCCCFFF5F5F5FF6262626B6262620062626200676767006767 + 67006767676AF7F7F7FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4 + F4FFF4F4F4FFF4F4F4FFF7F7F7FF6767676A67676700676767006C6C6C006C6C + 6C006C6C6C69F9F9F9FFAE7B26FFB6832EFFCC9944FFDCA954FFCB9843FFDCA9 + 54FFC5923DFFB17E29FFF9F9F9FF6C6C6C696C6C6C006C6C6C00717171007171 + 710071717168FBFBFBFFAE7B26FFEDE0CBFFE3CA9FFFEED4AAFFE5D8C3FFDCA9 + 54FFC5923DFFB17E29FFFBFBFBFF717171687171710071717100757575007575 + 750075757568FDFDFDFFAE7B26FFC18E39FFD9A651FFEBB863FFEBB863FFDCA9 + 54FFC5923DFFB17E29FFFDFDFDFF757575687575750075757500797979007979 + 790079797967FEFEFEFFAC7924FFB6832EFFC28F3AFFCB9843FFCB9843FFC390 + 3BFFB88530FFAE7B26FFFEFEFEFF7979796779797900797979007D7D7D007D7D + 7D007D7D7D67FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFF7D7D7D677D7D7D007D7D7D007F7F7F007F7F + 7F008080804D8080806680808066808080668080806680808066808080668080 + 80668080806680808066808080668080804D7F7F7F007F7F7F00 + } + OnClick = btVisitMyBlogClick + TabOrder = 2 + Visible = False + end + object pcAbout: TPageControl + Left = 0 + Height = 432 + Top = 4 + Width = 761 + ActivePage = tsAboutText + Align = alTop + Anchors = [akTop, akLeft, akRight, akBottom] + TabIndex = 0 + TabOrder = 0 + object tsAboutText: TTabSheet + Caption = 'About FMD' + ClientHeight = 404 + ClientWidth = 753 + object rmAbout: TRichMemo + Left = 0 + Height = 396 + Top = 4 + Width = 753 + Align = alClient + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 4 + Color = clWhite + Font.Style = [fsBold] + HideSelection = False + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + ZoomFactor = 1 + end + object pnAboutComp: TPanel + Left = 0 + Height = 0 + Top = 404 + Width = 753 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 4 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 10 + TabOrder = 1 + end + end + object tsChangelogText: TTabSheet + Caption = 'Changelog' + ClientHeight = 404 + ClientWidth = 753 + object mmChangelog: TMemo + Left = 0 + Height = 396 + Top = 4 + Width = 753 + Align = alClient + BorderSpacing.Top = 4 + BorderSpacing.Bottom = 4 + Font.CharSet = ANSI_CHARSET + Font.Height = -12 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqDraft + ParentFont = False + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 0 + end + end + end + end + end + object pnMainTop: TPanel + Left = 0 + Height = 8 + Top = 0 + Width = 771 + Align = alTop + TabOrder = 1 + Visible = False + end + object sbMain: TStatusBar + Left = 0 + Height = 23 + Top = 564 + Width = 771 + Panels = < + item + Width = 195 + end + item + Width = 100 + end> + PopupMenu = pmSbMain + SimplePanel = False + end + object spMainSplitter: TSplitter + Left = 0 + Height = 526 + Top = 8 + Width = 2 + OnMoved = spMainSplitterMoved + end + object dlgSaveTo: TSelectDirectoryDialog + left = 272 + top = 336 + end + object pmDownload: TPopupMenu + Images = IconList + OnPopup = pmDownloadPopup + left = 592 + top = 184 + object miDownloadStop: TMenuItem + Caption = 'Stop' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0003000000110000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001300000004FFFFFF00FFFFFF00FFFFFF000000 + 000306063EA0080860CC080860CC080860CC080860CC080860CC080860CC0808 + 60CC080860CC080860CC06063EA100000004FFFFFF00FFFFFF00FFFFFF00FFFF + FF0009096ACC2727CDFF1C1CC9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717 + C8FF1717C8FF1919C8FF09096ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000A0A75CC2525CDFF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212 + C6FF1212C6FF1919C8FF0A0A75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000B0B84CC2C2CCFFF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414 + C6FF1414C6FF1E1ECAFF0B0B84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000D0D95CC3636D1FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717 + C8FF1717C8FF2727CDFF0D0D95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000F0FA5CC5555DAFF2020CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1A + C9FF1A1AC9FF2E2ED0FF0F0FA5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001010B9CC6767DFFF4B4BD8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1B + C9FF1B1BC9FF3434D1FF1010B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001414C6CC6F6FE1FF5555DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3B + D3FF3838D3FF5252DAFF1414C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001C1CC9CC7878E4FF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767 + DFFF6767DFFF7575E2FF1C1CC9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002424CCCC8686E6FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080 + E5FF8080E5FF8484E5FF2424CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002B2BCF992B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B + CFCC2B2BCFCC2B2BCFCC2B2BCF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 7 + OnClick = miDownloadStopClick + end + object miDownloadResume: TMenuItem + Caption = 'Resume' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000000000001000000070000000E000000150000001A0000001A0000001A0000 + 001A0000001A0000001A000000160000000F0000000800000002000000000000 + 0000000000020000000E0000001C0000002A000000330000003300000033733A + 02A663320274000000330000002B0000001D0000000F00000003000000000000 + 0000000000000000000000000000000000000000000000000000281502009D52 + 06CC9D5206CC763E055C29160300000000000000000000000000B0651400A85D + 0E00A85D0E00553008007F470C00A85D0E007F470C00A85D0E00A65B0D00A358 + 0BCCFFB914FFA3580BCCA4590C5C7F470C002C19050000000000B4691700AA5F + 1000AA5F10CCAB601100AB601199AA5F10CCAB601199AA5F10CCAB601199AA5F + 10CCFFB810FFFFBB1BFFAA5F10CCAB60115CB1661600B96E1C00B76C1A00AF64 + 1400AF641400B3681700B16616CCF8BF3EFFB16616CCF7BC36FFD08613E1F6B4 + 24FFF5AF18FFF5AB0EFFF7B92EFFB16616CCB267175CB96E1C00B96E1CCCBA6F + 1D00BA6F1D99B96E1CCCB96E1CCCB96E1CCCB96E1CCCBD721DCFCB8422E1DA96 + 27F5E19E29FFE19E29FFE19E29FFEAB349FFB96E1CCCBA6F1D5CBF742000C378 + 2300C27722CCF8D084FFC27722CCF7CD81FFC77E2AD2EDC071FFD08D3BE8D396 + 44FFD09341FFD09341FFD39644FFD89B49FFECBB6CFFC27722CCCB802999CA7F + 28CCCA7F28CCCA7F28CCCA7F28CCCC812BCED38C37D7DC9947E3E5A556EFEBAE + 61FAEEB266FFEEB266FFEEB266FFF7CC80FFCA7F28CCC97E275CD2872ECCFBD9 + 8DFFD2872ECCD0852C00D2872ECCFBD68AFFDA933DD7FAD488FFF3C375F7F6C9 + 7DFFF4C175FFF2B96DFFFAD68AFFD2872ECCD1862D5CCA7F2800D88D3399D98E + 33CCD88D3399D78C3200D88D3399D98E33CCD88D3399D98E33CCD98E33CCD98E + 33CCFBD488FFFEDF93FFD98E33CCD88D335CD2872E00CA7F2800D98E3300DA8F + 3400D98E3300D78C3200D98E3300DA8F3400D98E3300DA8F3400DC913600E095 + 38CCFFE498FFE09538CCDF94385CD98E3300D2872E00CA7F2800D98E3300DA8F + 3400D98E3300D78C3200D98E3300DA8F3400D98E3300DD923700E59A3C00E59A + 3CCCE59A3CCCE59A3C5CE0953800D98E3300D2872E00CA7F2800D98E3300DA8F + 3400D98E3300D78C3200D98E3300DA8F3400D98E3300E89D3F00E89D3F00E99E + 4099E99E405CE59A3C00E0953800D98E3300D2872E00CA7F2800FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 12 + OnClick = miDownloadResumeClick + end + object miDownloadEnable: TMenuItem + Caption = 'Enable' + OnClick = miDownloadEnableClick + end + object miDownloadDisable: TMenuItem + Caption = 'Disable' + ShowAlwaysCheckable = True + OnClick = miDownloadEnableClick + end + object miDownloadDelete: TMenuItem + Caption = 'Delete' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000E00000014000000190000001900000016000000100000000B000000080000 + 0007000000080000000B0000000E0000001100000013FFFFFF00FFFFFF000000 + 001C0000325E000059CC000057BC0000164200000020000000160000000F0000 + 000D00000010000000150000001B00001D3800002D4CFFFFFF00FFFFFF000000 + 180000005FCC1111DBFE0C0CAFEC00005F8B0000190000000000000000000000 + 000000000000000000000000320000005F7300004832FFFFFF00FFFFFF000000 + 66000000668C0A0A9FE51212DDFF030378D30000673300005100000000000000 + 00000000380000006A00000066840000668900006404FFFFFF00FFFFFF000000 + 6C0000006D1F00006ECC1515D1FB1111C3F400006EB400007011000070000000 + 78000000720000006E8200006EB800006D4100006C00FFFFFF00FFFFFF000000 + 700000007000000075670D0D96DC1717CCFF0F0FA2E50000777500007E000000 + 7A000000769104048AD5000076860000730000007200FFFFFF00FFFFFF000000 + 78000000780000007B0000007E911515A6E51D1DBEFD07078AD400007F630000 + 7EAE0A0A94DC00007EB600007A000000780000007800FFFFFF00FFFFFF000000 + 8000000080000000800000008215000086B01A1AA8E72222B4F907078ED21414 + 9FE105058DD20000820000007C000000780000007800FFFFFF00FFFFFF000000 + 9F0000009E00000098000000900000008D3300008ECC3131BCF33333BCFA0909 + 97D400008E0000008F0000008E0000008E000000A500FFFFFF00FFFFFF000000 + 9F0000009E00000098330000968A000096CC4141CDEE5151D9FD2727B7E32F2F + BEE3000096B100009A1800009F000000A4000000A500FFFFFF00FFFFFF000000 + 9F0000009F6600009ECC3737C9E56262EAFF5858E3FA1616AFD600009A330E0E + A99F2828BEDD00009EB400009F1F0000A4000000A500FFFFFF00FFFFFF000000 + A4000000A4CC7474FCFF6B6BF4FE3636CDE50000A4CC0000A10000009A000000 + 9E000000A3890606A8CF0000A4BD0000A54A0000A501FFFFFF00FFFFFF000000 + A8000000A9480000A9CC0000A9CC0000A9930000A7000000A20000009A000000 + 9E000000A4000000A82B0000A97E0000A9B00000A966FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 9 + object miDownloadDeleteTask: TMenuItem + Caption = 'Task only' + Enabled = False + OnClick = miDownloadDeleteTaskClick + end + object miDownloadDeleteTaskData: TMenuItem + Caption = 'Task + Data' + Enabled = False + OnClick = miDownloadDeleteTaskClick + end + object miDownloadDeleteTaskDataFavorite: TMenuItem + Caption = 'Task + Data + Favorite' + OnClick = miDownloadDeleteTaskClick + end + end + object miDownloadDeleteCompleted: TMenuItem + Caption = 'Delete all completed tasks' + Enabled = False + OnClick = miDownloadDeleteCompletedClick + end + object MenuItem4: TMenuItem + Caption = '-' + end + object miDownloadMergeCompleted: TMenuItem + Caption = 'Merge completed tasks' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000200000005000000090000000D0000001100000015000000180000001A0000 + 001A0000001A0000001A0000001A000000170000000F00000005000000000000 + 00040000000A0000001100000019000000220000002A00000030000000330000 + 003300000033733B03A6633303740000002E0000001D0000000A532E0700522D + 0600522D0600522D0600522D0600522D0600522D0600522D0600522D0600522D + 0600522D06009F5408CC9F5408CC783F065C2917030000000000A75C0E99A65B + 0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B + 0DCCA65B0DCCA65B0DCCFFB508FFA65B0DCCA75C0E5C824A0E00AF6414CCF9C6 + 60FFFFBE23FFFFBD1FFFFFBC1CFFFFBB19FFFFBA16FFFFB914FFFFB811FFFFB7 + 0FFFFFB70DFFFFB60BFFFFB200FFFFB609FFAF6414CCAF641448B96E1BCCF6CB + 7FFFF8C051FFF9BD36FFF8B92CFFF5AC10FFF5AB0EFFF5AC10FFF6B11BFFF7B5 + 23FFF7B523FFF7B421FFF5AB0EFFF6B11BFFB96E1BCCB96E1B48C1762199C277 + 22CCC27722CCC27722CCD5973FE0E3A538FEE4A533FFE2A743EFCF8C32D9C57C + 26CFC27722CCC27722CCE6A93CFFC27722CCC176215CBB701C00C2772200C479 + 2400CC812A2BD38E38CEF0BF71FBE0A856FFDCA04CE4CC8129AACB80283FC97E + 270FC77C2600CC8129CCCC8129CCCB80285CC2772200BB701C00CD822A00D58A + 3000D58A307BEBB865E8F7C579FFF0C070EFD58A30AAD0852D13CC812900C97E + 2700D2872E00D4892F99D4892F5CCC812900C2772200BB701C00DD923600DD92 + 3600DD9236AAF8D081F6FCD185FFE7A951D9DC91363FDB903500CC812900C97E + 2700D2872E00D58A3000D58A3000CC812900C2772200BB701C00E4993B00E499 + 3B00E4993BC5FEDF92FDFFDF93FFE69E42CFE4993B0FE4993B00E4993B00D085 + 2D00D2872E00D58A3000D58A3000CC812900C2772200BB701C00E89D3E00E89D + 3E00E99E3F99E99E3FCCE99E3FCCE99E3F85E59A3C00E59A3C00E59A3C00D78C + 3200D2872E00D58A3000D58A3000CC812900C2772200BB701C00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 10 + OnClick = miDownloadMergeCompletedClick + end + object MenuItem1: TMenuItem + Caption = '-' + end + object miDownloadViewMangaInfo: TMenuItem + Caption = 'View manga info' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000030000 + 0013000000260000003205050542090909650B0B0B7A0B0B0B880B0B0B880B0B + 0B7A090909650505054200000032000000270000001300000003000000020000 + 000A0707071C1313135D3D3A3A93B2A6A6DCEBDADAFFEBDADAFFEBDADAFFEBDA + DAFFB2A6A6DC3D3A3A931313135D0707071D0000000A00000002171717002121 + 21092626265C807979AFE4D6D6FFC69689FFAD644EFF943312FF943312FFAD64 + 4EFFC69689FFE3D6D6FF7F7979AF2626265C2121210917171700303030002F2F + 2F48827E7EACDBD1D1FFAC573CFFB6461FFFD6592AFFE56230FFE56230FFD659 + 2AFFB6461FFFAC573CFFDACFCFFF817C7CAC2F2F2F4830303000343434195351 + 5186D4CECEFFB35F44FFC9572FFFE16132FFD3592DFFEDEDEDFFEEEEEEFFD359 + 2DFFE15F30FFC8532AFFB35F44FFD0C9C9FF515050863434341937373747ACAA + AAD7C09789FFBF5631FFD85F33FFD55A2DFFCB542AFFE2E2E2FFEDEDEDFFCB54 + 2AFFD55A2DFFD55A2DFFBC4F29FFBF9588FFA29F9FD7373737473A3A3A61D0CF + CFFFB9745DFFCF643EFFC9542AFFC9542AFFC25028FFD6D6D6FFE2E2E2FFC250 + 28FFC9542AFFC9542AFFC5542CFFB9745DFFC2C0C0FF3A3A3A613E3E3E6ECCCC + CCFFB95737FFD5714DFFBF502AFFBD4E27FFB94B26FFCDCDCDFFD6D6D6FFB94B + 26FFBD4E27FFBD4E27FFC1542EFFB95737FFC0C0C0FF3E3E3E6E4242426CCFCF + CFFFBC5B3BFFDD7D5BFFC96240FFBD5330FFB24925FFCCCCCCFFCDCDCDFFB148 + 24FFB34925FFB34925FFBD5532FFBC5B3BFFC3C3C3FF4242426C4545455CDBDC + DCFFC07C65FFDF805EFFCF6947FFCF6947FFCA6442FFAE4826FFAC4523FFB049 + 27FFAD4624FFAD4624FFC3603EFFC07C65FFCBCCCCFF4545455C48484842BEBF + BFD4C9A295FFD57452FFE2815FFFD87250FFCD6745FFFFFFFFFFFFFFFFFFCD67 + 45FFD87250FFDF7C5AFFD16E4CFFC7A194FFB2B3B3D4484848424B4B4B176C6C + 6C7CDFE0E0FFC8755AFFE28361FFEB8A68FFD56F4DFFFFFFFFFFFFFFFFFFD56F + 4DFFEA8866FFDF7E5CFFC8755AFFD8D8D8FF6969697C4B4B4B174E4E4E004E4E + 4E3F9D9D9DA2DFDFDFFFCB795EFFDB7A58FFEE906EFFF49674FFF49573FFED8E + 6CFFDA7856FFCB795EFFDBDCDCFF999999A24E4E4E3F4E4E4E004F4F4F005050 + 50075151514D9F9F9FA1E6E6E6FFD7B0A3FFD08C75FFCD6C4BFFCD6C4BFFD08C + 75FFD6AFA2FFE3E4E4FF9D9D9DA15151514D505050074F4F4F004F4F4F005050 + 5000525252075353533D73737378C8C8C8D2EAEAEAFFE6E6E6FFE6E6E6FFEAEA + EAFFC7C7C7D2727272785353533D52525207505050004F4F4F004F4F4F005050 + 50005252520053535300545454155555553E5555555555555563555555635555 + 55555555553E545454155353530052525200505050004F4F4F00 + } + ImageIndex = 0 + OnClick = miDownloadViewMangaInfoClick + end + object miDownloadOpenFolder: TMenuItem + Caption = 'Open Folder' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D + 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D + 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF + F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB + EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF + EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 + E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 + F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC + EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 + F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 + EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB + F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 + F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 + F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA + F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 + F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF + F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 + FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 + FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED + FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC + DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 + FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 + FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 + CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 + F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 + CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 + CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 4 + OnClick = miDownloadOpenFolderClick + end + object miDownloadOpenWith: TMenuItem + Caption = 'Open ...' + Enabled = False + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 00000000000000000000000000100000001A0000001000000000000000000000 + 00000000000000000000000000000000000000000000000000001007000F220E + 00352A110048000000620000008F000000ED0000008F000000622A110048200D + 003A130800300703002A050200290502002906030023020100095322009A8550 + 27D78E623DDF67655AF7ACAA9AFD9B9B8AFFACAA9AFD67655AF78E623DDF8550 + 27D7793D12D0703104CC6F2F02CB6F2F02CB6F2F02CB5322009A793400C0C5C5 + B7FFCECEC1FFDDDDD0FFE7E7D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5 + B4FFBEBEAEFFBBBBAAFFBBBBAAFFBBBBAAFFBBBBAAFF793400C0873E00B5FFFF + FEFFF9F9F4FFF1F1E7FFE9E9DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6 + EAFFF8F8EFFFFBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFF873E00B58D4200B0FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFF8D4200B0914500ADFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBE + ADFFD2D2C1FFC4C4B3FFD9D9C8FFDCDCCBFFFFFFFEFF914500AD954700AAFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF954700AA994A00A7FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168B + A9FF1EA8C0FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFF994A00A79C4C00A4FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6 + DFFF49E0F1FFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF9C4C00A4A04E00A2FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1 + D3FF18B2D3FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFFA04E00A2A351009FFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA351009FA652009DFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBE + ADFFD2D2C1FFCDCDBCFFFBFBF6FFFDFDFAFFFFFFFEFFA652009DA854009BFEFE + FDFFF8F8F3FFF1F1E7FFE9E9D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA854009BAA55009AF6F6 + F3EBE8E8DDD7C9C9B2B49C9C78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEF + E2EBF6F6ECF9FBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFFAA55009A7F7F55497F7F + 55577F7F55497F7F552E7F7F550E7F7F55007F7F550E7F7F552E7F7F55497F7F + 55577F7F55617F7F55667F7F55667F7F55667F7F55667F7F554D + } + ImageIndex = 11 + OnClick = miDownloadOpenWithClick + end + end + object pmChapterList: TPopupMenu + left = 592 + top = 224 + object miChapterListCheckSelected: TMenuItem + Caption = 'Check selected' + OnClick = miChapterListCheckSelectedClick + end + object miChapterListUncheckSelected: TMenuItem + Caption = 'Uncheck selected' + OnClick = miChapterListUncheckSelectedClick + end + object miI1: TMenuItem + Caption = '-' + end + object miChapterListCheckAll: TMenuItem + Caption = 'Check all' + OnClick = miChapterListCheckAllClick + end + object miChapterListUncheckAll: TMenuItem + Caption = 'Uncheck all' + OnClick = miChapterListUncheckAllClick + end + object MenuItem6: TMenuItem + Caption = '-' + end + object miChapterListHighlight: TMenuItem + Caption = 'Highlight downloaded chapters' + OnClick = miChapterListHighlightClick + end + object miChapterListHideDownloaded: TMenuItem + Caption = 'Hide downloaded chapters' + OnClick = miChapterListHideDownloadedClick + end + object MenuItem2: TMenuItem + Caption = '-' + end + object miChapterListFilter: TMenuItem + AutoCheck = True + Caption = 'Filter' + OnClick = miChapterListFilterClick + end + object MenuItem11: TMenuItem + Caption = '-' + end + object miChapterListAscending: TMenuItem + Caption = 'Ascending' + RadioItem = True + ShowAlwaysCheckable = True + OnClick = miChapterListAscendingClick + end + object miChapterListDescending: TMenuItem + Caption = 'Descending' + RadioItem = True + ShowAlwaysCheckable = True + OnClick = miChapterListAscendingClick + end + end + object pmFavorites: TPopupMenu + Images = IconList + OnPopup = pmFavoritesPopup + left = 520 + top = 212 + object miFavoritesCheckNewChapter: TMenuItem + Caption = 'Check for new chapter' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 002C00000087000000E7702E00C7702E00C7702E00C7702E00C7702E00C7702E + 00C7702E00C72D5500E9175F00F4124A00C40000002C00000000000000090000 + 0016000000DB606060FFCA9764FFC5925FFFC5925FFFC5925FFFC5925FFFC592 + 5FFFC5925FFF318613FF2BDF1AFF1E7700F20000001600000009000000000101 + 0100010101CE626262FFC89562FFBD8A57FFBF8C59FFBF8C59FFBF8C59FF548D + 24FF318C12FF318C11FF3DE22CFF208100F00E8C00CC0E8D0099010101000101 + 0100010101C9646464FFCA9764FFBE8B58FFC18E5BFFC18E5BFFC18E5BFF3394 + 12FF52E741FF52E741FF52E741FF52E741FF52E741FF109500CC010101000101 + 0100010101C5676767FFCD9A67FFBF8C59FFC4915EFFC4915EFFC4915EFF5A98 + 26FF369B13FF359A12FF66EB55FF249000EF129D00CC129C0099010101000101 + 0100010101C16B6B6BFFD19E6BFFBF8C59FFC89562FFC89562FFC89562FFC895 + 62FFC89562FF369F12FF75EE64FF269700EE179E0000129D0000010101000101 + 0100010101BE6E6E6EFFD4A16EFFBF8C59FFCB9865FFCB9865FFCB9865FFCB98 + 65FFCB9865FF599D24FF3BA816FF448700DC6072000056730000010101000101 + 0100010101BB727272FFD8A572FFBF8C59FFCF9C69FFCF9C69FFCF9C69FFCF9C + 69FFCF9C69FFBF8C59FFD8A572FF9B4B00A59B4B00009B4B0000010101000101 + 0100010101B8757575FFDBA875FFBE8B58FFD29F6CFFD29F6CFFD29F6CFFD29F + 6CFFD29F6CFFBE8B58FFDBA875FF9E4D00A39E4D00009E4D0000010101000101 + 0100010101B5797979FFDFAC79FFBE8B58FFD6A370FFD6A370FFD6A370FFD6A3 + 70FFD6A370FFBE8B58FFDFAC79FFA14F00A1A14F0000A14F0000010101000101 + 0100010101B27C7C7CFFE2AF7CFFBC8956FFE3B07DFFE3B07DFFE3B07DFFE3B0 + 7DFFE3B07DFFBC8956FFE2AF7CFFA451009FA4510000A4510000010101000101 + 0100010101B07E7E7EFFE4B17EFFBB8855FFBB8855FFBB8855FFBB8855FFBB88 + 55FFBB8855FFBB8855FFE4B17EFFA653009DA6530000A6530000010101000101 + 0100010101AE808080FFEAB784FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B2 + 7FFFE5B27FFFE5B27FFFEAB784FFA854009BA8540000A8540000010101000101 + 0100010101AC555555FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 + 66FFCC9966FFCC9966FFCC9966FFAA55009AAA550000AA550000040404000404 + 04000404048ABCBCABFFC1C1B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8 + E2FFEFEFECFFF7F7F4FFFCFCFCFF55552B6655552B0055552B00040404000404 + 0400040404460404048AAA550099AA550099AA550099AA550099AA550099AA55 + 0099AA550099AA550099AA550099AA550073AA550000AA550000 + } + ImageIndex = 21 + OnClick = miFavoritesCheckNewChapterClick + end + object miFavoritesStopCheckNewChapter: TMenuItem + Caption = 'Stop check for new chapter' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0003000000110000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001300000004FFFFFF00FFFFFF00FFFFFF000000 + 000306063EA0080860CC080860CC080860CC080860CC080860CC080860CC0808 + 60CC080860CC080860CC06063EA100000004FFFFFF00FFFFFF00FFFFFF00FFFF + FF0009096ACC2727CDFF1C1CC9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717 + C8FF1717C8FF1919C8FF09096ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000A0A75CC2525CDFF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212 + C6FF1212C6FF1919C8FF0A0A75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000B0B84CC2C2CCFFF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414 + C6FF1414C6FF1E1ECAFF0B0B84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000D0D95CC3636D1FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717 + C8FF1717C8FF2727CDFF0D0D95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF000F0FA5CC5555DAFF2020CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1A + C9FF1A1AC9FF2E2ED0FF0F0FA5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001010B9CC6767DFFF4B4BD8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1B + C9FF1B1BC9FF3434D1FF1010B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001414C6CC6F6FE1FF5555DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3B + D3FF3838D3FF5252DAFF1414C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF001C1CC9CC7878E4FF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767 + DFFF6767DFFF7575E2FF1C1CC9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002424CCCC8686E6FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080 + E5FF8080E5FF8484E5FF2424CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF002B2BCF992B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B + CFCC2B2BCFCC2B2BCFCC2B2BCF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 7 + OnClick = miFavoritesStopCheckNewChapterClick + end + object miFavoritesEnable: TMenuItem + Caption = 'Enable' + OnClick = miFavoritesEnableClick + end + object miFavoritesDisable: TMenuItem + Caption = 'Disable' + OnClick = miFavoritesEnableClick + end + object miFavoritesViewInfos: TMenuItem + Caption = 'View manga info' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000030000 + 0013000000260000003205050542090909650B0B0B7A0B0B0B880B0B0B880B0B + 0B7A090909650505054200000032000000270000001300000003000000020000 + 000A0707071C1313135D3D3A3A93B2A6A6DCEBDADAFFEBDADAFFEBDADAFFEBDA + DAFFB2A6A6DC3D3A3A931313135D0707071D0000000A00000002171717002121 + 21092626265C807979AFE4D6D6FFC69689FFAD644EFF943312FF943312FFAD64 + 4EFFC69689FFE3D6D6FF7F7979AF2626265C2121210917171700303030002F2F + 2F48827E7EACDBD1D1FFAC573CFFB6461FFFD6592AFFE56230FFE56230FFD659 + 2AFFB6461FFFAC573CFFDACFCFFF817C7CAC2F2F2F4830303000343434195351 + 5186D4CECEFFB35F44FFC9572FFFE16132FFD3592DFFEDEDEDFFEEEEEEFFD359 + 2DFFE15F30FFC8532AFFB35F44FFD0C9C9FF515050863434341937373747ACAA + AAD7C09789FFBF5631FFD85F33FFD55A2DFFCB542AFFE2E2E2FFEDEDEDFFCB54 + 2AFFD55A2DFFD55A2DFFBC4F29FFBF9588FFA29F9FD7373737473A3A3A61D0CF + CFFFB9745DFFCF643EFFC9542AFFC9542AFFC25028FFD6D6D6FFE2E2E2FFC250 + 28FFC9542AFFC9542AFFC5542CFFB9745DFFC2C0C0FF3A3A3A613E3E3E6ECCCC + CCFFB95737FFD5714DFFBF502AFFBD4E27FFB94B26FFCDCDCDFFD6D6D6FFB94B + 26FFBD4E27FFBD4E27FFC1542EFFB95737FFC0C0C0FF3E3E3E6E4242426CCFCF + CFFFBC5B3BFFDD7D5BFFC96240FFBD5330FFB24925FFCCCCCCFFCDCDCDFFB148 + 24FFB34925FFB34925FFBD5532FFBC5B3BFFC3C3C3FF4242426C4545455CDBDC + DCFFC07C65FFDF805EFFCF6947FFCF6947FFCA6442FFAE4826FFAC4523FFB049 + 27FFAD4624FFAD4624FFC3603EFFC07C65FFCBCCCCFF4545455C48484842BEBF + BFD4C9A295FFD57452FFE2815FFFD87250FFCD6745FFFFFFFFFFFFFFFFFFCD67 + 45FFD87250FFDF7C5AFFD16E4CFFC7A194FFB2B3B3D4484848424B4B4B176C6C + 6C7CDFE0E0FFC8755AFFE28361FFEB8A68FFD56F4DFFFFFFFFFFFFFFFFFFD56F + 4DFFEA8866FFDF7E5CFFC8755AFFD8D8D8FF6969697C4B4B4B174E4E4E004E4E + 4E3F9D9D9DA2DFDFDFFFCB795EFFDB7A58FFEE906EFFF49674FFF49573FFED8E + 6CFFDA7856FFCB795EFFDBDCDCFF999999A24E4E4E3F4E4E4E004F4F4F005050 + 50075151514D9F9F9FA1E6E6E6FFD7B0A3FFD08C75FFCD6C4BFFCD6C4BFFD08C + 75FFD6AFA2FFE3E4E4FF9D9D9DA15151514D505050074F4F4F004F4F4F005050 + 5000525252075353533D73737378C8C8C8D2EAEAEAFFE6E6E6FFE6E6E6FFEAEA + EAFFC7C7C7D2727272785353533D52525207505050004F4F4F004F4F4F005050 + 50005252520053535300545454155555553E5555555555555563555555635555 + 55555555553E545454155353530052525200505050004F4F4F00 + } + ImageIndex = 0 + SubMenuImages = IconList + OnClick = miFavoritesViewInfosClick + end + object miFavoritesDownloadAll: TMenuItem + Caption = 'Download all' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0D0D0D581212128512121285121212851212128512121285121212851212 + 12851212128512121285121212850D0D0D580000002C00000012000000090000 + 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 + C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B + 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 + 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 + 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD + DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D + 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 + B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F + 4F005151510D5454545A54545467545454675454546754545467545454675454 + 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F + 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 + 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F + 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 + 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F + 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 + 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F + 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 + 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F + 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD + 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 + 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 + 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 + 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E + 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 + 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 + 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E + 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 + } + ImageIndex = 1 + OnClick = miFavoritesDownloadAllClick + end + object miFavoritesRename: TMenuItem + Caption = 'Rename' + OnClick = miFavoritesRenameClick + end + object miFavoritesTransferWebsite: TMenuItem + Caption = 'Transfer website' + OnClick = miFavoritesTransferWebsiteClick + end + object MenuItem7: TMenuItem + Caption = '-' + end + object miFavoritesDelete: TMenuItem + Caption = 'Delete' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000E00000014000000190000001900000016000000100000000B000000080000 + 0007000000080000000B0000000E0000001100000013FFFFFF00FFFFFF000000 + 001C0000325E000059CC000057BC0000164200000020000000160000000F0000 + 000D00000010000000150000001B00001D3800002D4CFFFFFF00FFFFFF000000 + 180000005FCC1111DBFE0C0CAFEC00005F8B0000190000000000000000000000 + 000000000000000000000000320000005F7300004832FFFFFF00FFFFFF000000 + 66000000668C0A0A9FE51212DDFF030378D30000673300005100000000000000 + 00000000380000006A00000066840000668900006404FFFFFF00FFFFFF000000 + 6C0000006D1F00006ECC1515D1FB1111C3F400006EB400007011000070000000 + 78000000720000006E8200006EB800006D4100006C00FFFFFF00FFFFFF000000 + 700000007000000075670D0D96DC1717CCFF0F0FA2E50000777500007E000000 + 7A000000769104048AD5000076860000730000007200FFFFFF00FFFFFF000000 + 78000000780000007B0000007E911515A6E51D1DBEFD07078AD400007F630000 + 7EAE0A0A94DC00007EB600007A000000780000007800FFFFFF00FFFFFF000000 + 8000000080000000800000008215000086B01A1AA8E72222B4F907078ED21414 + 9FE105058DD20000820000007C000000780000007800FFFFFF00FFFFFF000000 + 9F0000009E00000098000000900000008D3300008ECC3131BCF33333BCFA0909 + 97D400008E0000008F0000008E0000008E000000A500FFFFFF00FFFFFF000000 + 9F0000009E00000098330000968A000096CC4141CDEE5151D9FD2727B7E32F2F + BEE3000096B100009A1800009F000000A4000000A500FFFFFF00FFFFFF000000 + 9F0000009F6600009ECC3737C9E56262EAFF5858E3FA1616AFD600009A330E0E + A99F2828BEDD00009EB400009F1F0000A4000000A500FFFFFF00FFFFFF000000 + A4000000A4CC7474FCFF6B6BF4FE3636CDE50000A4CC0000A10000009A000000 + 9E000000A3890606A8CF0000A4BD0000A54A0000A501FFFFFF00FFFFFF000000 + A8000000A9480000A9CC0000A9CC0000A9930000A7000000A20000009A000000 + 9E000000A4000000A82B0000A97E0000A9B00000A966FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 9 + SubMenuImages = IconList + OnClick = miFavoritesDeleteClick + end + object miFavoritesChangeCurrentChapter: TMenuItem + Caption = 'Change "Current chapter"' + Visible = False + OnClick = miFavoritesChangeCurrentChapterClick + end + object miFavoritesChangeSaveTo: TMenuItem + Caption = 'Change "Save to"' + OnClick = miFavoritesChangeSaveToClick + end + object MenuItem3: TMenuItem + Caption = '-' + end + object miFavoritesOpenFolder: TMenuItem + Caption = 'Open Folder' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000060000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A000000160000000600476A91005D + 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D + 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD00476A9100679AB086CF + F0FF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB + EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF86CFF0FF00679AB00070A9A286CF + EEFF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 + E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF86CFEEFF0070A9A20074AD9D8AD3 + F0FF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC + EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF8AD3F0FF0074AD9D0076B2998FD7 + F2FF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 + EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF8FD7F2FF0076B2990079B69594DB + F4FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 + F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF94DBF4FF0079B695007CBA9299E0 + F6FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA + F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF99E0F6FF007CBA92007FBD8E9FE5 + F9FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF + F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF9FE5F9FF007FBD8E0081C18BA3E9 + FBFF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9 + FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA6ECFBFF0081C18B0083C488A8ED + FDFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BC + DEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF78BCDEFF0083C4880085C785AEF3 + FFFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0 + FEFFABF0FEFFABF0FEFFABF0FEFFABF0FEFFAEF3FFFF0085C7850087CA630087 + CA830087CA830087CA830087CA830087CA830087CA830087CA83FEFEFDFFF8F8 + F3FFF0F0E6FFE9E9DBFFFEC941FFF4B62EFF0087CA830087CA630087CA000087 + CA000087CA000087CA000087CA000087CA000087CA000088CC2E0088CC810088 + CC810088CC810088CC810088CC810088CC810088CC2E0087CA00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 4 + SubMenuImages = IconList + OnClick = miFavoritesOpenFolderClick + end + object miFavoritesOpenWith: TMenuItem + Caption = 'Open ...' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 00000000000000000000000000100000001A0000001000000000000000000000 + 00000000000000000000000000000000000000000000000000001007000F220E + 00352A110048000000620000008F000000ED0000008F000000622A110048200D + 003A130800300703002A050200290502002906030023020100095322009A8550 + 27D78E623DDF67655AF7ACAA9AFD9B9B8AFFACAA9AFD67655AF78E623DDF8550 + 27D7793D12D0703104CC6F2F02CB6F2F02CB6F2F02CB5322009A793400C0C5C5 + B7FFCECEC1FFDDDDD0FFE7E7D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5 + B4FFBEBEAEFFBBBBAAFFBBBBAAFFBBBBAAFFBBBBAAFF793400C0873E00B5FFFF + FEFFF9F9F4FFF1F1E7FFE9E9DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6 + EAFFF8F8EFFFFBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFF873E00B58D4200B0FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFF8D4200B0914500ADFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBE + ADFFD2D2C1FFC4C4B3FFD9D9C8FFDCDCCBFFFFFFFEFF914500AD954700AAFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF954700AA994A00A7FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168B + A9FF1EA8C0FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFF994A00A79C4C00A4FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6 + DFFF49E0F1FFF9F9F2FFEAEAD9FFEDEDDCFFFFFFFEFF9C4C00A4A04E00A2FEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1 + D3FF18B2D3FFF9F9F2FFD9D9C8FFD4D4C3FFFFFFFEFFA04E00A2A351009FFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA351009FA652009DFEFE + FDFFF8F8F3FFF0F0E6FFE9E9DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBE + ADFFD2D2C1FFCDCDBCFFFBFBF6FFFDFDFAFFFFFFFEFFA652009DA854009BFEFE + FDFFF8F8F3FFF1F1E7FFE9E9D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4 + E8FFF6F6EDFFF9F9F2FFFBFBF6FFFDFDFAFFFFFFFEFFA854009BAA55009AF6F6 + F3EBE8E8DDD7C9C9B2B49C9C78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEF + E2EBF6F6ECF9FBFBF4FFFCFCF7FFFEFEFBFFFFFFFEFFAA55009A7F7F55497F7F + 55577F7F55497F7F552E7F7F550E7F7F55007F7F550E7F7F552E7F7F55497F7F + 55577F7F55617F7F55667F7F55667F7F55667F7F55667F7F554D + } + ImageIndex = 11 + OnClick = miFavoritesOpenWithClick + end + end + object pmMangaList: TPopupMenu + Images = IconList + OnPopup = pmMangaListPopup + left = 382 + top = 238 + object miMangaListViewInfos: TMenuItem + Caption = 'View manga infos' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF000000 + 0000000000020000000E000000180000001A0000001A0000001A0000001A0000 + 001A0000001A00000019000000100000000300000000FFFFFF00FFFFFF000000 + 0000000000040000001B481F1546B24C3399E96443D4EE6644F5EE6644F5E964 + 43D4B24C3399471F15470000001F0000000600000000FFFFFF00FFFFFF007432 + 210077332200B34D3360EF6F4FEBF5A28FFFFAD1CAFFFCE7E5FFFCE6E5FFF9D1 + C9FFF4A18EFFEF6E4EEBB34D33603C1A110000000000FFFFFF00FFFFFF00E863 + 4100EE664460EF7659F9F7D4CEFFF7E9E9FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8 + E8FFF7E9E9FFF6D1CAFFEF7658F9EE664460E8634100FFFFFF00FFFFFF00E360 + 3E20E66A4AEBF3D3CDFFF0E5E5FFEFE4E4FFEFE4E4FFE5613FFFE5613FFFEFE4 + E4FFEFE4E4FFEFE4E4FFEFCDC7FFE66A4AEBE3603E20FFFFFF00FFFFFF00D659 + 3787E59D8AFFEAE2E2FFE7DFDFFFE7DFDFFFE7DFDFFFD65937FFD65937FFE7DF + DFFFE7DFDFFFE7DFDFFFE8E0E0FFE19784FFD6593787FFFFFF00FFFFFF00C550 + 2ED0EAD0C8FFE1DADAFFE0D9D9FFE0D9D9FFE0D9D9FFC5502EFFC5502EFFE0D9 + D9FFE0D9D9FFE0D9D9FFE0D9D9FFE1C4BDFFC5502ED0FFFFFF00FFFFFF00B748 + 26F5F4EEEDFFE7E5E5FFDAD6D6FFD8D4D4FFD8D4D4FFB74826FFB74826FFD8D4 + D4FFD8D4D4FFD8D4D4FFD8D4D4FFE1D8D6FFB74826F5FFFFFF00FFFFFF00AD44 + 22F5F4EFEDFFEEEEEEFFEAEAEAFFDCDBDBFFD3D1D1FFAD4422FFAD4422FFD2D0 + D0FFD2D0D0FFD2D0D0FFD2D0D0FFDFD8D7FFAD4422F5FFFFFF00FFFFFF00AB46 + 24D0EAD5CDFFF0F0F0FFF0F0F0FFF0F0F0FFEBEBEBFFE9E9E9FFE7E6E6FFD2D1 + D1FFCECECEFFCECECEFFD2D1D1FFDCC7C0FFAB4624D0FFFFFF00FFFFFF00B34F + 2D87D49D8AFFF5F5F5FFF3F3F3FFF3F3F3FFF3F3F3FFB34F2DFFB34F2DFFF3F3 + F3FFF3F3F3FFF3F3F3FFF5F5F5FFD49C89FFB34F2D87FFFFFF00FFFFFF00BF5C + 3A20C56747EBF2DFD9FFF8F8F8FFF7F7F7FFF7F7F7FFC15D3BFFC15D3BFFF7F7 + F7FFF7F7F7FFF8F8F8FFF2DFD9FFC56747EBBF5C3A20FFFFFF00FFFFFF00C461 + 3F00CF6B4960D77F61F9F6E3DCFFFCFCFCFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB + FBFFFCFCFCFFF6E3DCFFD77F61F9CF6B4960C4613F00FFFFFF00FFFFFF00C461 + 3F00D16D4B00DF7A5860E38464EBEFB7A4FFFAE4DDFFFEF9F7FFFEF9F7FFFAE4 + DDFFEFB7A4FFE38464EBDF7A5860D16D4B00C4613F00FFFFFF00FFFFFF00C461 + 3F00D16D4B00E17C5A00EA846220EC866487EC8664D0EC8664F5EC8664F5EC86 + 64D0EC866487EA846220E17C5A00D16D4B00C4613F00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ImageIndex = 13 + SubMenuImages = IconList + OnClick = miMangaListViewInfosClick + end + object miMangaListDownloadAll: TMenuItem + Caption = 'Download all' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0D0D0D581212128512121285121212851212128512121285121212851212 + 12851212128512121285121212850D0D0D580000002C00000012000000090000 + 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 + C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B + 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 + 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 + 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD + DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D + 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 + B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F + 4F005151510D5454545A54545467545454675454546754545467545454675454 + 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F + 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 + 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F + 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 + 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F + 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 + 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F + 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 + 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F + 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD + 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 + 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 + 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 + 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E + 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 + 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 + 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E + 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 + } + ImageIndex = 1 + SubMenuImages = IconList + OnClick = miMangaListDownloadAllClick + end + object miMangaListAddToFavorites: TMenuItem + Caption = 'Add to Favorites' + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000050000 + 001E0000003200009CC9000054630000002E0000002B00000026000000220000 + 001D00000018054F00A1056800CF0550009D0000000500000002000000030000 + 000F000000190000A8C50000A8C500006D580000001600000013000000110000 + 000F0000000C0C8200CE2BDF1AFF0C8200CD000000030000000101018F000101 + 5F0001018C000000B6BF6969FFFF0000B6BF0000B84301016000074700000E8D + 00990E8C00CC0E8C00CC3DE22CFF0E8C00CC0E8C00CC0E8D00990101BFBB0101 + BFBB0101BFBB0101BFBB6262F8FF6C6CFFFF0101BFBB0101C042094B61001095 + 00CC52E741FF52E741FF52E741FF52E741FF52E741FF109500CC0101C3410101 + C3B96969FFFF6262F8FF5F5FF5FF5C5CF1FF6E6EFFFF0101C3B90101C441129C + 0099129D00CC129D00CC66EB55FF129D00CC129D00CC129C00990101C3000101 + C7410101C7B86C6CFFFF5C5CF1FF5D5DF2FF5F5FF3FF7171FFFF0101C7B80629 + 96410F79330014A400CC75EE64FF14A400CC13A10000129D00000101C3000101 + C7000101CB400101CBB66E6EFFFF5F5FF3FF6060F4FF6262F4FF7575FFFF0101 + CBB60101CC4015A9009915A900CC15A9009914A80000129D00000101C3000101 + C7000101CB000101CE400101CEB57171FFFF6262F4FF6464F5FF6565F6FF7878 + FFFF0101CEB5062C9B3F1080350015A9000014A80000129D00000101C3000101 + C7000101CB000101CE000101D23F0101D2B37575FFFF6565F6FF6767F7FF6868 + F8FF7B7BFFFF0101D2B30101D33F0101D5000101D9000101DC000101C3000101 + C7000101CB000101CE000101D2000101D53F0101D5B27878FFFF6868F8FF6A6A + F9FF6C6CF9FF7E7EFFFF0101D5B20101D63E0101D9000101DC000101C3000101 + C7000101CB000101CE000101D2000101D5000101D93E0101D9B17B7BFFFF6C6C + F9FF6D6DFAFF6F6FFBFF8181FFFF0101D9B10101D93E0101DC000101C3000101 + C7000101CB000101CE000101D2000101D5000101D9000101DC3E0101DCAF7E7E + FFFF6F6FFBFF7070FCFF7171FCFF8484FFFF0101DCAF0101DC3E000000000101 + 64000101CB000101CE000101D2000101D5000101D9000101DC000101DE3E0101 + DEAE8181FFFF7171FCFF7373FDFF7474FDFF8686FFFF0101DEAE000000000000 + 0000000000000101B4000101D2000101D5000101D9000101DC000101DE000101 + E13D0101E1AD8484FFFF7474FDFF8686FFFF0101E1AD0101E13D000000000000 + 0000000000000000990000002B0001016B000101D9000101DC000101DE000101 + E1000101E33C0101E3AC8686FFFF0101E3AC0101E33C0101E100000000000000 + 0000000000000000990000002B00000000000000000001016E000101DE000101 + E1000101E3000101E53C0101E5AB0101E53C0101E3000101E100 + } + ImageIndex = 2 + SubMenuImages = IconList + OnClick = miMangaListAddToFavoritesClick + end + object miMangaListDelete: TMenuItem + Caption = 'Delete' + OnClick = miMangaListDeleteClick + end + object miI2: TMenuItem + Caption = '-' + end + object miHighlightNewManga: TMenuItem + Caption = 'Highlight new manga' + OnClick = miHighlightNewMangaClick + end + end + object TrayIcon: TTrayIcon + BalloonFlags = bfInfo + BalloonTimeout = 5000 + BalloonTitle = 'Free Manga Downloader' + PopUpMenu = pmTray + Hint = 'Free Manga Downloader' + OnDblClick = TrayIconDblClick + left = 288 + top = 432 + end + object pmUpdate: TPopupMenu + ParentBidiMode = False + left = 382 + top = 110 + object mnUpdateList: TMenuItem + Caption = 'Update manga list' + OnClick = mnUpdateListClick + end + object mnUpdateDownFromServer: TMenuItem + Caption = 'Download manga list from server' + OnClick = mnUpdateDownFromServerClick + end + object MenuItem5: TMenuItem + Caption = '-' + end + object mnUpdate1Click: TMenuItem + Caption = 'Update all lists at once' + OnClick = mnUpdate1ClickClick + end + object mnDownload1Click: TMenuItem + Caption = 'Download all lists from server at once' + OnClick = mnDownload1ClickClick + end + end + object IconList: TImageList + left = 278 + top = 102 + Bitmap = { + 4C691700000010000000100000004F4F4F005050500052525200535353005454 + 54155555553E555555555555556355555563555555555555553E545454155353 + 530052525200505050004F4F4F004F4F4F0050505000525252075353533D7373 + 7378C8C8C8D2EAEAEAFFE6E6E6FFE6E6E6FFEAEAEAFFC7C7C7D2727272785353 + 533D52525207505050004F4F4F004F4F4F00505050075151514D9F9F9FA1E6E6 + E6FFD7B0A3FFD08C75FFCD6C4BFFCD6C4BFFD08C75FFD6AFA2FFE3E4E4FF9D9D + 9DA15151514D505050074F4F4F004E4E4E004E4E4E3F9D9D9DA2DFDFDFFFCB79 + 5EFFDB7A58FFEE906EFFF49674FFF49573FFED8E6CFFDA7856FFCB795EFFDBDC + DCFF999999A24E4E4E3F4E4E4E004B4B4B176C6C6C7CDFE0E0FFC8755AFFE283 + 61FFEB8A68FFD56F4DFFFFFFFFFFFFFFFFFFD56F4DFFEA8866FFDF7E5CFFC875 + 5AFFD8D8D8FF6969697C4B4B4B1748484842BEBFBFD4C9A295FFD57452FFE281 + 5FFFD87250FFCD6745FFFFFFFFFFFFFFFFFFCD6745FFD87250FFDF7C5AFFD16E + 4CFFC7A194FFB2B3B3D4484848424545455CDBDCDCFFC07C65FFDF805EFFCF69 + 47FFCF6947FFCA6442FFAE4826FFAC4523FFB04927FFAD4624FFAD4624FFC360 + 3EFFC07C65FFCBCCCCFF4545455C4242426CCFCFCFFFBC5B3BFFDD7D5BFFC962 + 40FFBD5330FFB24925FFCCCCCCFFCDCDCDFFB14824FFB34925FFB34925FFBD55 + 32FFBC5B3BFFC3C3C3FF4242426C3E3E3E6ECCCCCCFFB95737FFD5714DFFBF50 + 2AFFBD4E27FFB94B26FFCDCDCDFFD6D6D6FFB94B26FFBD4E27FFBD4E27FFC154 + 2EFFB95737FFC0C0C0FF3E3E3E6E3A3A3A61D0CFCFFFB9745DFFCF643EFFC954 + 2AFFC9542AFFC25028FFD6D6D6FFE2E2E2FFC25028FFC9542AFFC9542AFFC554 + 2CFFB9745DFFC2C0C0FF3A3A3A6137373747ACAAAAD7C09789FFBF5631FFD85F + 33FFD55A2DFFCB542AFFE2E2E2FFEDEDEDFFCB542AFFD55A2DFFD55A2DFFBC4F + 29FFBF9588FFA29F9FD7373737473434341953515186D4CECEFFB35F44FFC957 + 2FFFE16132FFD3592DFFEDEDEDFFEEEEEEFFD3592DFFE15F30FFC8532AFFB35F + 44FFD0C9C9FF5150508634343419303030002F2F2F48827E7EACDBD1D1FFAC57 + 3CFFB6461FFFD6592AFFE56230FFE56230FFD6592AFFB6461FFFAC573CFFDACF + CFFF817C7CAC2F2F2F483030300017171700212121092626265C807979AFE4D6 + D6FFC69689FFAD644EFF943312FF943312FFAD644EFFC69689FFE3D6D6FF7F79 + 79AF2626265C2121210917171700000000020000000A0707071C1313135D3D3A + 3A93B2A6A6DCEBDADAFFEBDADAFFEBDADAFFEBDADAFFB2A6A6DC3D3A3A931313 + 135D0707071D0000000A00000002000000030000001300000026000000320505 + 0542090909650B0B0B7A0B0B0B880B0B0B880B0B0B7A09090965050505420000 + 0032000000270000001300000003E99E3F00E99E3F00E99E3F00E99E3F00E99E + 3F00E99E3F00E99E3F33FFE39E40FED18540E99E3F33E99E3F00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00D2872E00D2872E00D2872E00D3892F00E297 + 3A00E2973A00E2973A6AFCDC9884F5BF7385E2973A6AE2973A00E2973A00D389 + 2F00D2872E00D2872E00D2872E00BF752000BF752000BF752000C2782200CB80 + 2900D98E3300D98E33ABF9D591D5EEB367D5D98E33AAD98E3300CB802900C278 + 2200BF752000BF752000BF752000BF752000BF752000BF752000C2782200C57A + 2400C87D2700CE832BCCF1CA83FFD89B4AFFCE832BCCC87D2700C57A2400C278 + 2200BF752000BF752000BF752000BF752000BF752000BF752000C177218FC278 + 22B8C27822B8C27822CCEEC26AFFDE9C2CFFC27822CCC27822B8C27822B8C177 + 218FBF752000BF752000BF752000BA6F1C00BA6F1C00BA6F1C00B96E1B5CC27B + 23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD3FFFF7C554FFC0781FD4B96E + 1B5CBA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F1C00B76C1A00AD62 + 125CB97117D4FECB4DFFFEB714FFFEB102FFFEC02CFFB86F15D4AD62125CB76C + 1A00BA6F1C00BA6F1C00BA6F1C00855F3600855F3600866037009E662800AC61 + 1100A3580B5CB0670ED4FFC53AFFFFBD20FFB0660DD4A3580B5CAC6111009E66 + 280086603700855F3600855F36004F4F4F004F4F4F0051515100555555006A58 + 44008E561D009B50055CA95F07D3A95F06D39B50055C8E561D006A5844005555 + 5500515151004F4F4F004F4F4F004F4F4F004F4F4F0051515100555555005555 + 5500555555006653410075502B1F75502B1F6653410055555500555555005555 + 5500515151004F4F4F004F4F4F004F4F4F004F4F4F005151510D5454545A5454 + 5467545454675454546754545467545454675454546754545467545454675454 + 545A5151510D4F4F4F004F4F4F004D4D4D004D4D4D004D4D4D5DC3C3C3DAD1D1 + D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3B3FFB9B3B3FFBFB3B3FFB5A9 + A9DA4D4D4D5D4D4D4D004D4D4D0033333300434343004343436EFAFAFAFFF8F8 + F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDDDDFFE2DDDDFFD7CCCCFFE8D9 + D9FF4343436E4343430033333300000000002B2B2B0038383873E9E9E9FFB0B0 + B0FF858585FF7E7F7FFF787979FF787777FF7E7777FF857777FF66FF66FFD7C8 + C8FF383838732B2B2B000000000000000009000000162A2A2A7AB3B3B3DFDBDB + DBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4C4FFC9C4C4FFC6BBBBFFA59A + 9ADF2A2A2A7A0000001600000009000000120000002C0D0D0D58121212851212 + 1285121212851212128512121285121212851212128512121285121212851212 + 12850D0D0D580000002C00000012000000000000000000000000000099000000 + 2B00000000000000000001016E000101DE000101E1000101E3000101E53C0101 + E5AB0101E53C0101E3000101E100000000000000000000000000000099000000 + 2B0001016B000101D9000101DC000101DE000101E1000101E33C0101E3AC8686 + FFFF0101E3AC0101E33C0101E1000000000000000000000000000101B4000101 + D2000101D5000101D9000101DC000101DE000101E13D0101E1AD8484FFFF7474 + FDFF8686FFFF0101E1AD0101E13D00000000010164000101CB000101CE000101 + D2000101D5000101D9000101DC000101DE3E0101DEAE8181FFFF7171FCFF7373 + FDFF7474FDFF8686FFFF0101DEAE0101C3000101C7000101CB000101CE000101 + D2000101D5000101D9000101DC3E0101DCAF7E7EFFFF6F6FFBFF7070FCFF7171 + FCFF8484FFFF0101DCAF0101DC3E0101C3000101C7000101CB000101CE000101 + D2000101D5000101D93E0101D9B17B7BFFFF6C6CF9FF6D6DFAFF6F6FFBFF8181 + FFFF0101D9B10101D93E0101DC000101C3000101C7000101CB000101CE000101 + D2000101D53F0101D5B27878FFFF6868F8FF6A6AF9FF6C6CF9FF7E7EFFFF0101 + D5B20101D63E0101D9000101DC000101C3000101C7000101CB000101CE000101 + D23F0101D2B37575FFFF6565F6FF6767F7FF6868F8FF7B7BFFFF0101D2B30101 + D33F0101D5000101D9000101DC000101C3000101C7000101CB000101CE400101 + CEB57171FFFF6262F4FF6464F5FF6565F6FF7878FFFF0101CEB5062C9B3F1080 + 350015A9000014A80000129D00000101C3000101C7000101CB400101CBB66E6E + FFFF5F5FF3FF6060F4FF6262F4FF7575FFFF0101CBB60101CC4015A9009915A9 + 00CC15A9009914A80000129D00000101C3000101C7410101C7B86C6CFFFF5C5C + F1FF5D5DF2FF5F5FF3FF7171FFFF0101C7B8062996410F79330014A400CC75EE + 64FF14A400CC13A10000129D00000101C3410101C3B96969FFFF6262F8FF5F5F + F5FF5C5CF1FF6E6EFFFF0101C3B90101C441129C0099129D00CC129D00CC66EB + 55FF129D00CC129D00CC129C00990101BFBB0101BFBB0101BFBB0101BFBB6262 + F8FF6C6CFFFF0101BFBB0101C042094B6100109500CC52E741FF52E741FF52E7 + 41FF52E741FF52E741FF109500CC01018F0001015F0001018C000000B6BF6969 + FFFF0000B6BF0000B84301016000074700000E8D00990E8C00CC0E8C00CC3DE2 + 2CFF0E8C00CC0E8C00CC0E8D0099000000030000000F000000190000A8C50000 + A8C500006D580000001600000013000000110000000F0000000C0C8200CE2BDF + 1AFF0C8200CD0000000300000001000000050000001E0000003200009CC90000 + 54630000002E0000002B00000026000000220000001D00000018054F00A10568 + 00CF0550009D0000000500000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 + A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 + A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 + AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 + A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B + E8F65F5FE7FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5F5FE7FF5858E4F60F0F + B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 + D9FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF5050D8FF4F4F + DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 + CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4747 + CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 + BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616A0FF12129CFF12129CFF1616 + A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFFF8F8 + F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8E8FFEEEEEEFFEEEEEEFF1111 + A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FFD0D0 + D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEEEEFFEEEEEEFFEEEEEEFF1111 + AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 + A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111 + B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 + BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111 + BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 + C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF0F0F + BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 + C4F61212D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF0F0FC2F60303 + 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 + 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 + 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 + 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000087CA000087CA000087CA000087CA000087 + CA000087CA000087CA000088CC2E0088CC810088CC810088CC810088CC810088 + CC810088CC810088CC2E0087CA000087CA630087CA830087CA830087CA830087 + CA830087CA830087CA830087CA83FEFEFDFFF8F8F3FFF0F0E6FFE9E9DBFFFEC9 + 41FFF4B62EFF0087CA830087CA630085C785AEF3FFFFABF0FEFFABF0FEFFABF0 + FEFFABF0FEFFAEF3FFFF89CDE9FF89CDE9FFABF0FEFFABF0FEFFABF0FEFFABF0 + FEFFABF0FEFFAEF3FFFF0085C7850083C488A8EDFDFFA2E7FBFFA2E7FBFFA2E7 + FBFFA2E7FBFFA2E7FBFFABF0FDFF85CAE6FF78BCDEFF78BCDEFF78BCDEFF78BC + DEFF78BCDEFF78BCDEFF0083C4880081C18BA3E9FBFF9DE3F9FF9DE3F9FF9DE3 + F9FF9DE3F9FF9DE3F9FF9DE3F9FFA3E9FAFFA3E9FAFFA3E9FAFFA3E9FAFFA3E9 + FAFFA3E9FAFFA6ECFBFF0081C18B007FBD8E9FE5F9FF98DFF6FF98DFF6FF98DF + F6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DFF6FF98DF + F6FF98DFF6FF9FE5F9FF007FBD8E007CBA9299E0F6FF92DAF3FF92DAF3FF92DA + F3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DAF3FF92DA + F3FF92DAF3FF99E0F6FF007CBA920079B69594DBF4FF8DD5F0FF8DD5F0FF8DD5 + F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5F0FF8DD5 + F0FF8DD5F0FF94DBF4FF0079B6950076B2998FD7F2FF87D0EDFF87D0EDFF87D0 + EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0EDFF87D0 + EDFF87D0EDFF8FD7F2FF0076B2990074AD9D8AD3F0FF82CCEBFF82CCEBFF82CC + EBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CCEBFF82CC + EBFF82CCEBFF8AD3F0FF0074AD9D0070A9A286CFEEFF7DC8E8FF7DC8E8FF7DC8 + E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8E8FF7DC8 + E8FF7DC8E8FF86CFEEFF0070A9A200679AB086CFF0FF82CBEDFF82CBEDFF82CB + EDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CBEDFF82CB + EDFF82CBEDFF86CFF0FF00679AB000476A91005D8CBD005D8CBD005D8CBD005D + 8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D8CBD005D + 8CBD005D8CBD005D8CBD00476A9100000006000000160000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001600000006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000013A2000014A5000014A5000014A6000015A8000015A9001F15AA + 00CC15AA004814A70000FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000014A5001014A700B077EE + 66FF14A700CC14A70048FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000614A3009E43C631E56BE2 + 5AFF70E95FFB14A300CCFFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000113A0008533B820DE61D850FF5CD5 + 4BFA1EA80CD213A1004CFFFFFF00FFFFFF0011970000129B0048129B00CC129B + 0048119700000F93000011970000129B006924AA13D857CF46FE55CD44FD21A7 + 10D6129C006313A00000FFFFFF00FFFFFF0011960048119700CC73EA62FD1197 + 00CC119600480F9300001196004C189D08D33DB62CFB37AF26FE1FA00EDA1197 + 007B11980000129B0000FFFFFF00FFFFFF000F9200CC6DE55CFA59D048FF69E1 + 58FC0F9200CC0F92006D139504CB34B423F832B221FF1F9F0FDF0F92008C1094 + 00021095000010950000FFFFFF00FFFFFF000E8E00480E8D00CC5FD94FF933BC + 22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA20FE40E8D009E0F8F00081094 + 000010950000084B0000FFFFFF00FFFFFF000E8D00000D8800480D8700CC43CA + 33F629C318FF39CC28FF28C217FF1EAA0FEA0D8700AE0D8A00100F8F0000084A + 00000000000000000000FFFFFF00FFFFFF00074700000A6500000B8300480B82 + 00CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85001B07450000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000032000000657 + 0048077200CC16A60AE8087601C406570029021E000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00000000020000000F0000001F0000 + 002D02330066025F00CC012B005500000029000000220000001A000000130000 + 000C0000000600000001FFFFFF00FFFFFF000000000100000008000000100000 + 00170000001A000000190000001700000015000000110000000D0000000A0000 + 00060000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E99E3F00E99E3F00E99E3F00EA9F + 4099EA9F40CCEA9F4099EA9F4000EA9F40CCEA9F4000E59A3D00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E69B3D00E69B3D00E69B3D00E69B + 3DCCFFE195FFE69B3DCCE4993C00E69B3D00E4993C00E3983B00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E3983B00E3983B00E3983B00E398 + 3B99E2973ACCE2973ACCE2973ACCE2973A99E2973A00E2973ACCE2973A00E297 + 3A00E2973A00FFFFFF00FFFFFF00FFFFFF00DD923600DD923600DD923600DD92 + 3600DD923600DD9236CCFEDC90FFDD9236CCDB903400DD923600DC913500DC91 + 3500DC913500FFFFFF00FFFFFF00FFFFFF00D68B3100D68B3100D68B3100D78C + 3299D88D32CCD88D32CCD88D32CCD88D32CCD88D32CCD78C3299D68B3100D68B + 3100D68B3100FFFFFF00FFFFFF00FFFFFF00D2872E00D2872E00D2872E00D287 + 2ECCFBD589FFD38930CEFAD488FFD2872ECCFAD286FFD2872ECCD2872E00D287 + 2E00D2872E00FFFFFF00FFFFFF00FFFFFF00B86D1A00C97E2700C97E2700CA7F + 2899D58E39D7D58E39D7D08731D2CB8029CCCB8029CCCA7F2899C97E2700C97E + 2700B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00BD721E00C57A2400C57A + 24CCF7CC80FFDA9645E3F6CA7EFFC87E29CFF6C97DFFC57A24CCC57A2400BD72 + 1E00B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00B96E1B00BB701D00BE73 + 1FCCEDB96CF8E1A153EFDB9949E8D4903FE1D4903FE1BD721F99B96E1B00B96E + 1B00B86D1A00FFFFFF00FFFFFF00FFFFFF00B76C1A99B86D1ACCB86D1ACCB86D + 1ACCF3C074FFE9AC60FAEEB266FFE4A659F5F2BD71FFB86D1ACCB86D1ACCB86D + 1ACCB76C1A99FFFFFF00FFFFFF00FFFFFF00B267165CB16615CCF7CB7FFFF2BF + 73FFF0B86CFFE9AD61FFDFA357FFD5994DFFD49B4FFFD6A054FFDDAB5FFFB166 + 15CCB267165CFFFFFF00FFFFFF00FFFFFF00B1661500AC61115CAB6010CCF2C3 + 77FFDB9E4CFFD09341FFCF9240FFCF9240FFCF9240FFDCA858FFAB6010CCAC61 + 115CB1661500FFFFFF00FFFFFF00FFFFFF00B1661500AB601000A65B0D5CA55A + 0CCCEAB44BFFE09E29FFE09E29FFE09E29FFE8AE43FFA55A0CCCA65B0D5CAB60 + 1000B1661500FFFFFF00FFFFFF00FFFFFF000000000000000000532D0600A156 + 095CA05508CCF7B92EFFF5AB0EFFF7B629FFA05508CCA156095C532D06000000 + 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 + 00196D39046E9B5005CCFFBB19FF9B5005CC6D39046E0000001A000000110000 + 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 + 00320000003363320274974C02CC633202740000003300000033000000220000 + 000800000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B2BCF992B2BCFCC2B2B + CFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B + CF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002424CCCC8686E6FF8080 + E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8484E5FF2424 + CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C1CC9CC7878E4FF6767 + DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF7575E2FF1C1C + C9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001414C6CC6F6FE1FF5555 + DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3BD3FF3838D3FF5252DAFF1414 + C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001010B9CC6767DFFF4B4B + D8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1BC9FF1B1BC9FF3434D1FF1010 + B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000F0FA5CC5555DAFF2020 + CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF2E2ED0FF0F0F + A5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000D0D95CC3636D1FF1717 + C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF2727CDFF0D0D + 95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000B0B84CC2C2CCFFF1414 + C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1E1ECAFF0B0B + 84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000A0A75CC2525CDFF1212 + C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1919C8FF0A0A + 75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0009096ACC2727CDFF1C1C + C9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717C8FF1717C8FF1919C8FF0909 + 6ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF000000000306063EA0080860CC0808 + 60CC080860CC080860CC080860CC080860CC080860CC080860CC080860CC0606 + 3EA100000004FFFFFF00FFFFFF00FFFFFF0000000003000000110000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001300000004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A480 + 0000A984004AA98400A6A98400CCA98400A6A984004AA4800000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A37F + 004AB18E11D0E5C657F3EFD166FDE4C556F3B08D10D0A37F004AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009D7B + 00A6D9BA4DF3CAAC42FFBFA137FFBA9C32FFC4A537F39D7B00A6FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009574 + 00CCCAAB3DFDA98916FFA58511FFA58511FFB0901DFD957400CCFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008C6D + 00A6BD9A1FF3BC9712FFBB9611FFBB9612FFB38F10F38C6D00A6FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008467 + 004A8E7004D0C09910F3CEA511FDBF980EF38D6F03D0634D004AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000941330061654F00AB695200CC654F00AB4032006500000013FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0005000000170000001A0000001A0000001A000000190000000AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A8000000A9480000A9CC0000 + A9CC0000A9930000A7000000A20000009A0000009E000000A4000000A82B0000 + A97E0000A9B00000A966FFFFFF00FFFFFF000000A4000000A4CC7474FCFF6B6B + F4FE3636CDE50000A4CC0000A10000009A0000009E000000A3890606A8CF0000 + A4BD0000A54A0000A501FFFFFF00FFFFFF0000009F0000009F6600009ECC3737 + C9E56262EAFF5858E3FA1616AFD600009A330E0EA99F2828BEDD00009EB40000 + 9F1F0000A4000000A500FFFFFF00FFFFFF0000009F0000009E00000098330000 + 968A000096CC4141CDEE5151D9FD2727B7E32F2FBEE3000096B100009A180000 + 9F000000A4000000A500FFFFFF00FFFFFF0000009F0000009E00000098000000 + 900000008D3300008ECC3131BCF33333BCFA090997D400008E0000008F000000 + 8E0000008E000000A500FFFFFF00FFFFFF000000800000008000000080000000 + 8215000086B01A1AA8E72222B4F907078ED214149FE105058DD2000082000000 + 7C000000780000007800FFFFFF00FFFFFF00000078000000780000007B000000 + 7E911515A6E51D1DBEFD07078AD400007F6300007EAE0A0A94DC00007EB60000 + 7A000000780000007800FFFFFF00FFFFFF000000700000007000000075670D0D + 96DC1717CCFF0F0FA2E50000777500007E0000007A000000769104048AD50000 + 76860000730000007200FFFFFF00FFFFFF0000006C0000006D1F00006ECC1515 + D1FB1111C3F400006EB40000701100007000000078000000720000006E820000 + 6EB800006D4100006C00FFFFFF00FFFFFF00000066000000668C0A0A9FE51212 + DDFF030378D3000067330000510000000000000000000000380000006A000000 + 66840000668900006404FFFFFF00FFFFFF000000180000005FCC1111DBFE0C0C + AFEC00005F8B0000190000000000000000000000000000000000000000000000 + 320000005F7300004832FFFFFF00FFFFFF000000001C0000325E000059CC0000 + 57BC0000164200000020000000160000000F0000000D00000010000000150000 + 001B00001D3800002D4CFFFFFF00FFFFFF000000000E00000014000000190000 + 001900000016000000100000000B0000000800000007000000080000000B0000 + 000E0000001100000013FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E89D3E00E99E3F99E99E3FCCE99E + 3FCCE99E3F85E59A3C00E59A3C00E59A3C00D78C3200D2872E00D58A3000D58A + 3000CC812900C2772200BB701C00E4993B00E4993B00E4993BC5FEDF92FDFFDF + 93FFE69E42CFE4993B0FE4993B00E4993B00D0852D00D2872E00D58A3000D58A + 3000CC812900C2772200BB701C00DD923600DD923600DD9236AAF8D081F6FCD1 + 85FFE7A951D9DC91363FDB903500CC812900C97E2700D2872E00D58A3000D58A + 3000CC812900C2772200BB701C00CD822A00D58A3000D58A307BEBB865E8F7C5 + 79FFF0C070EFD58A30AAD0852D13CC812900C97E2700D2872E00D4892F99D489 + 2F5CCC812900C2772200BB701C00C2772200C4792400CC812A2BD38E38CEF0BF + 71FBE0A856FFDCA04CE4CC8129AACB80283FC97E270FC77C2600CC8129CCCC81 + 29CCCB80285CC2772200BB701C00C1762199C27722CCC27722CCC27722CCD597 + 3FE0E3A538FEE4A533FFE2A743EFCF8C32D9C57C26CFC27722CCC27722CCE6A9 + 3CFFC27722CCC176215CBB701C00B96E1BCCF6CB7FFFF8C051FFF9BD36FFF8B9 + 2CFFF5AC10FFF5AB0EFFF5AC10FFF6B11BFFF7B523FFF7B523FFF7B421FFF5AB + 0EFFF6B11BFFB96E1BCCB96E1B48AF6414CCF9C660FFFFBE23FFFFBD1FFFFFBC + 1CFFFFBB19FFFFBA16FFFFB914FFFFB811FFFFB70FFFFFB70DFFFFB60BFFFFB2 + 00FFFFB609FFAF6414CCAF641448A75C0E99A65B0DCCA65B0DCCA65B0DCCA65B + 0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCA65B0DCCFFB5 + 08FFA65B0DCCA75C0E5C824A0E00532E0700522D0600522D0600522D0600522D + 0600522D0600522D0600522D0600522D0600522D0600522D06009F5408CC9F54 + 08CC783F065C291703000000000000000000000000040000000A000000110000 + 0019000000220000002A00000030000000330000003300000033733B03A66333 + 03740000002E0000001D0000000A000000000000000200000005000000090000 + 000D0000001100000015000000180000001A0000001A0000001A0000001A0000 + 001A000000170000000F00000005FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF007F7F55497F7F55577F7F55497F7F552E7F7F + 550E7F7F55007F7F550E7F7F552E7F7F55497F7F55577F7F55617F7F55667F7F + 55667F7F55667F7F55667F7F554DAA55009AF6F6F3EBE8E8DDD7C9C9B2B49C9C + 78767F7F55319B9B7776C7C7ADB4E3E3D2D7EFEFE2EBF6F6ECF9FBFBF4FFFCFC + F7FFFEFEFBFFFFFFFEFFAA55009AA854009BFEFEFDFFF8F8F3FFF1F1E7FFE9E9 + D9F27F7F5566ECECD9F2F1F1E1FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB + F6FFFDFDFAFFFFFFFEFFA854009BA652009DFEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFCCCCBBFFEFEFDEFFF0F0E0FFBCBCABFFBEBEADFFD2D2C1FFCDCDBCFFFBFB + F6FFFDFDFAFFFFFFFEFFA652009DA351009FFEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFC8C8B7FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB + F6FFFDFDFAFFFFFFFEFFA351009FA04E00A2FEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFC4C4B3FFEFEFDEFFF0F0E0FF17B0D2FF18B1D3FF18B2D3FFF9F9F2FFD9D9 + C8FFD4D4C3FFFFFFFEFFA04E00A29C4C00A4FEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFBFBFAEFFEFEFDEFFF0F0E0FF2F5C7CFF3DC6DFFF49E0F1FFF9F9F2FFEAEA + D9FFEDEDDCFFFFFFFEFF9C4C00A4994A00A7FEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFBABAA9FFEFEFDEFFF0F0E0FF0B7395FF168BA9FF1EA8C0FFF9F9F2FFD9D9 + C8FFD4D4C3FFFFFFFEFF994A00A7954700AAFEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFB4B4A3FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFEAEA + D9FFEDEDDCFFFFFFFEFF954700AA914500ADFEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFAFAF9EFFEFEFDEFFF0F0E0FFBCBCABFFBEBEADFFD2D2C1FFC4C4B3FFD9D9 + C8FFDCDCCBFFFFFFFEFF914500AD8D4200B0FEFEFDFFF8F8F3FFF0F0E6FFE9E9 + DBFFA9A998FFEFEFDEFFF0F0E0FFF2F2E4FFF4F4E8FFF6F6EDFFF9F9F2FFFBFB + F6FFFDFDFAFFFFFFFEFF8D4200B0873E00B5FFFFFEFFF9F9F4FFF1F1E7FFE9E9 + DBFFA4A493FFEFEFDEFFF0F0E1FFF3F3E6FFF6F6EAFFF8F8EFFFFBFBF4FFFCFC + F7FFFEFEFBFFFFFFFEFF873E00B5793400C0C5C5B7FFCECEC1FFDDDDD0FFE7E7 + D7FF9F9F8EFFEAEAD9FFDCDCCCFFCDCDBDFFC5C5B4FFBEBEAEFFBBBBAAFFBBBB + AAFFBBBBAAFFBBBBAAFF793400C05322009A855027D78E623DDF67655AF7ACAA + 9AFD9B9B8AFFACAA9AFD67655AF78E623DDF855027D7793D12D0703104CC6F2F + 02CB6F2F02CB6F2F02CB5322009A1007000F220E00352A110048000000620000 + 008F000000ED0000008F000000622A110048200D003A130800300703002A0502 + 0029050200290603002302010009000000000000000000000000000000000000 + 00100000001A0000001000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00D98E3300DA8F3400D98E3300D78C3200D98E + 3300DA8F3400D98E3300E89D3F00E89D3F00E99E4099E99E405CE59A3C00E095 + 3800D98E3300D2872E00CA7F2800D98E3300DA8F3400D98E3300D78C3200D98E + 3300DA8F3400D98E3300DD923700E59A3C00E59A3CCCE59A3CCCE59A3C5CE095 + 3800D98E3300D2872E00CA7F2800D98E3300DA8F3400D98E3300D78C3200D98E + 3300DA8F3400D98E3300DA8F3400DC913600E09538CCFFE498FFE09538CCDF94 + 385CD98E3300D2872E00CA7F2800D88D3399D98E33CCD88D3399D78C3200D88D + 3399D98E33CCD88D3399D98E33CCD98E33CCD98E33CCFBD488FFFEDF93FFD98E + 33CCD88D335CD2872E00CA7F2800D2872ECCFBD98DFFD2872ECCD0852C00D287 + 2ECCFBD68AFFDA933DD7FAD488FFF3C375F7F6C97DFFF4C175FFF2B96DFFFAD6 + 8AFFD2872ECCD1862D5CCA7F2800CB802999CA7F28CCCA7F28CCCA7F28CCCA7F + 28CCCC812BCED38C37D7DC9947E3E5A556EFEBAE61FAEEB266FFEEB266FFEEB2 + 66FFF7CC80FFCA7F28CCC97E275CBF742000C3782300C27722CCF8D084FFC277 + 22CCF7CD81FFC77E2AD2EDC071FFD08D3BE8D39644FFD09341FFD09341FFD396 + 44FFD89B49FFECBB6CFFC27722CCB96E1CCCBA6F1D00BA6F1D99B96E1CCCB96E + 1CCCB96E1CCCB96E1CCCBD721DCFCB8422E1DA9627F5E19E29FFE19E29FFE19E + 29FFEAB349FFB96E1CCCBA6F1D5CB76C1A00AF641400AF641400B3681700B166 + 16CCF8BF3EFFB16616CCF7BC36FFD08613E1F6B424FFF5AF18FFF5AB0EFFF7B9 + 2EFFB16616CCB267175CB96E1C00B4691700AA5F1000AA5F10CCAB601100AB60 + 1199AA5F10CCAB601199AA5F10CCAB601199AA5F10CCFFB810FFFFBB1BFFAA5F + 10CCAB60115CB1661600B96E1C00B0651400A85D0E00A85D0E00553008007F47 + 0C00A85D0E007F470C00A85D0E00A65B0D00A3580BCCFFB914FFA3580BCCA459 + 0C5C7F470C002C19050000000000000000000000000000000000000000000000 + 0000000000000000000000000000281502009D5206CC9D5206CC763E055C2916 + 03000000000000000000000000000000000000000000000000020000000E0000 + 001C0000002A000000330000003300000033733A02A663320274000000330000 + 002B0000001D0000000F00000003000000000000000000000001000000070000 + 000E000000150000001A0000001A0000001A0000001A0000001A0000001A0000 + 00160000000F0000000800000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C4613F00D16D4B00E17C5A00EA84 + 6220EC866487EC8664D0EC8664F5EC8664F5EC8664D0EC866487EA846220E17C + 5A00D16D4B00C4613F00FFFFFF00FFFFFF00C4613F00D16D4B00DF7A5860E384 + 64EBEFB7A4FFFAE4DDFFFEF9F7FFFEF9F7FFFAE4DDFFEFB7A4FFE38464EBDF7A + 5860D16D4B00C4613F00FFFFFF00FFFFFF00C4613F00CF6B4960D77F61F9F6E3 + DCFFFCFCFCFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFCFCFCFFF6E3DCFFD77F + 61F9CF6B4960C4613F00FFFFFF00FFFFFF00BF5C3A20C56747EBF2DFD9FFF8F8 + F8FFF7F7F7FFF7F7F7FFC15D3BFFC15D3BFFF7F7F7FFF7F7F7FFF8F8F8FFF2DF + D9FFC56747EBBF5C3A20FFFFFF00FFFFFF00B34F2D87D49D8AFFF5F5F5FFF3F3 + F3FFF3F3F3FFF3F3F3FFB34F2DFFB34F2DFFF3F3F3FFF3F3F3FFF3F3F3FFF5F5 + F5FFD49C89FFB34F2D87FFFFFF00FFFFFF00AB4624D0EAD5CDFFF0F0F0FFF0F0 + F0FFF0F0F0FFEBEBEBFFE9E9E9FFE7E6E6FFD2D1D1FFCECECEFFCECECEFFD2D1 + D1FFDCC7C0FFAB4624D0FFFFFF00FFFFFF00AD4422F5F4EFEDFFEEEEEEFFEAEA + EAFFDCDBDBFFD3D1D1FFAD4422FFAD4422FFD2D0D0FFD2D0D0FFD2D0D0FFD2D0 + D0FFDFD8D7FFAD4422F5FFFFFF00FFFFFF00B74826F5F4EEEDFFE7E5E5FFDAD6 + D6FFD8D4D4FFD8D4D4FFB74826FFB74826FFD8D4D4FFD8D4D4FFD8D4D4FFD8D4 + D4FFE1D8D6FFB74826F5FFFFFF00FFFFFF00C5502ED0EAD0C8FFE1DADAFFE0D9 + D9FFE0D9D9FFE0D9D9FFC5502EFFC5502EFFE0D9D9FFE0D9D9FFE0D9D9FFE0D9 + D9FFE1C4BDFFC5502ED0FFFFFF00FFFFFF00D6593787E59D8AFFEAE2E2FFE7DF + DFFFE7DFDFFFE7DFDFFFD65937FFD65937FFE7DFDFFFE7DFDFFFE7DFDFFFE8E0 + E0FFE19784FFD6593787FFFFFF00FFFFFF00E3603E20E66A4AEBF3D3CDFFF0E5 + E5FFEFE4E4FFEFE4E4FFE5613FFFE5613FFFEFE4E4FFEFE4E4FFEFE4E4FFEFCD + C7FFE66A4AEBE3603E20FFFFFF00FFFFFF00E8634100EE664460EF7659F9F7D4 + CEFFF7E9E9FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8E8FFF7E9E9FFF6D1CAFFEF76 + 58F9EE664460E8634100FFFFFF00FFFFFF007432210077332200B34D3360EF6F + 4FEBF5A28FFFFAD1CAFFFCE7E5FFFCE6E5FFF9D1C9FFF4A18EFFEF6E4EEBB34D + 33603C1A110000000000FFFFFF00FFFFFF0000000000000000040000001B481F + 1546B24C3399E96443D4EE6644F5EE6644F5E96443D4B24C3399471F15470000 + 001F0000000600000000FFFFFF00FFFFFF0000000000000000020000000E0000 + 00180000001A0000001A0000001A0000001A0000001A0000001A000000190000 + 00100000000300000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00B82F0300B92F030BBA30036ABA3003ACBA30 + 03BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA3003BDBA30 + 03ACBA30036AB92F030BB82F0300B82F0300B82F036BD25B33D3F1916EF7F698 + 76FFF69876FFF69876FFF69876FFF59876FFF59775FFF59775FFF59674FFF08E + 6BF7D15931D3B82F036BB82F0300B52D0300B52D03ADF08F6CF7E7815FFFE781 + 5FFFE7815FFFE7815FFFD87250FFD87250FFE7815FFFE7815FFFE7815FFFE781 + 5FFFEB8865F7B52D03ADB52D0300B22C0300B22C03BFEF906EFFDF7957FFDF79 + 57FFDF7957FFD26C4AFFFFFFFFFFFFFFFFFFD26C4AFFDF7957FFDF7957FFDF79 + 57FFE88765FFB22C03BFB22C0300AF2A0300AF2A03BFE88A68FFD6704EFFD670 + 4EFFD6704EFFCC6644FFFFFFFFFFFFFFFFFFCC6644FFD6704EFFD6704EFFD670 + 4EFFE07E5CFFAF2A03BFAF2A0300AB270200AB2702C0E28260FFCF6947FFCF69 + 47FFCF6947FFCA6442FFAE4826FFAC4523FFB04A27FFAD4624FFAD4624FFB04A + 27FFC25F3CFFAB2702C0AB270200A7250200A72502C1DD7D5BFFCC6644FFC962 + 40FFBD5431FFB24926FFCCCCCCFFCDCDCDFFB14825FFB44A26FFB44A26FFB44A + 26FFBD5532FFA72502C1A7250200A3230200A32302C1DA7957FFC85F3BFFC052 + 2CFFBE502AFFB94E28FFCDCDCDFFD6D6D6FFB94E28FFBE502AFFBE502AFFBE50 + 2AFFC35631FFA32302C1A32302009F2002009F2002C2D86F4BFFCB5930FFCB58 + 2FFFCB582FFFC3542CFFD6D6D6FFE2E2E2FFC3542CFFCB582FFFCB582FFFCB58 + 2FFFCC5B32FF9F2002C29F2002009B1E02009B1E02C3DE6C42FFD86035FFD860 + 35FFD86035FFCD5930FFE2E2E2FFEDEDEDFFCD5930FFD86035FFD86035FFD860 + 35FFD86035FF9B1E02C39B1E0200961B0200961B02C4E86E42FFE5673AFFE567 + 3AFFE5673AFFD75F34FFEDEDEDFFEEEEEEFFD75F34FFE5673AFFE5673AFFE567 + 3AFFE5673AFF961B02C4961B020090170200901702B3E7693CF8F16F3EFFF16F + 3EFFF16F3EFFF16F3EFFCF5A31FFCF5A31FFF16F3EFFF16F3EFFF16F3EFFF16F + 3EFFE66538F8901702B39017020021040100800E0170AB331ADBEC693CF8FA74 + 42FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFFA7442FFEC69 + 3BF8AB3218DB800E01702104010000000012120100335A040082710500BA7205 + 00CB720500CB720500CB720500CB720500CB720500CB720500CB720500CB7105 + 00BA5A040082120100330000001200000009000000160000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A00000016000000090404040004040400040404460404048AAA55 + 0099AA550099AA550099AA550099AA550099AA550099AA550099AA550099AA55 + 0099AA550073AA550000AA55000004040400040404000404048ABCBCABFFC1C1 + B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8E2FFEFEFECFFF7F7F4FFFCFC + FCFF55552B6655552B0055552B000101010001010100010101AC555555FFCC99 + 66FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 + 66FFAA55009AAA550000AA5500000101010001010100010101AE808080FFEAB7 + 84FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 + 84FFA854009BA8540000A85400000101010001010100010101B07E7E7EFFE4B1 + 7EFFD7A674FFCF9F6FFFCC9D6DFFCC9D6DFFCF9F6EFFD7A573FFDBA875FFE4B1 + 7EFFA653009DA6530000A65300000101010001010100010101B27C7C7CFFE2AF + 7CFFD09F6EFFFFEEDDFFFFEEDDFFFFEEDDFFFFEEDDFFD7AF87FFD7A472FFE2AF + 7CFFA451009FA4510000A45100000101010001010100010101B5797979FFDFAC + 79FFD19F6DFFD4AC84FFCFA982FFD2B293FFFBEAD9FFDEBF9FFFD3A16EFFDFAC + 79FFA14F00A1A14F0000A14F00000101010001010100010101B8757575FFDBA8 + 75FFD29F6CFFD19E6CFFC99968FFD2B291FFF7E6D5FFD5B18EFFD09E6BFFDBA8 + 75FF9E4D00A39E4D00009E4D00000101010001010100010101BB727272FFD8A5 + 72FFCF9C69FFCB9967FFCCA681FFF1E0CEFFE4CCB4FFC59564FFCF9C69FFD8A5 + 72FF9B4B00A59B4B00009B4B00000101010001010100010101BE6E6E6EFFD4A1 + 6EFFCB9865FFC39261FFEDDCCBFFEDDCCBFFBC8D5EFFCA9765FFCB9865FFD4A1 + 6EFF984900A898490000984900000101010001010100010101C16B6B6BFFD19E + 6BFFC89562FFC2915FFFB38658FFB38658FFC2915FFFC89562FFC89562FFD19E + 6BFF954700AB95470000954700000101010001010100010101C5676767FFCD9A + 67FFC4915EFFBA8A5AFFF8E7D6FFEAD9C8FFBA8A5AFFC4915EFFC4915EFFCD9A + 67FF914500AD91450000914500000101010001010100010101C9646464FFCA97 + 64FFC18E5BFFB78757FFE7D6C5FFDFCEBDFFB78757FFC18E5BFFC18E5BFFCA97 + 64FF8D4200B08D4200006A3200000000000001010100010101CE626262FFC895 + 62FFBF8C59FFBC8A58FFB58554FFB58554FFBC8A58FFBF8C59FFBF8C59FFC895 + 62FF893F00B467300000000000000000000900000016000000DB606060FFCA97 + 64FFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFCA97 + 64FF7C3600BE0000001600000009000000120000002C00000087000000E7702E + 00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E + 00C7552300A20000002C00000012FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 + A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 + A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 + AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 + A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B + E8F65F5FE7FF5B5BE3FF4949D1FF4949D1FF5B5BE3FF5F5FE7FF5858E4F60F0F + B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 + D9FF4F4FD7FF4040C8FFFFFFFFFFFFFFFFFF4040C8FF4F4FD7FF5050D8FF4F4F + DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 + CAFF4242CAFF3636BEFFFFFFFFFFFFFFFFFF3636BEFF4242CAFF4242CAFF4747 + CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 + BFFF3737BFFF2A2AB2FFE8E8E8FFDADADAFF15159EFF12129CFF12129CFF1616 + A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E + B8FF1D1DABFF1212A1FFCCCCCCFFD1D1D1FF1111A0FF1111A1FF1111A1FF1111 + A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 + ABFF1111AAFF1111A6FFD1D1D1FFDCDCDCFF1111A6FF1111AAFF1111AAFF1111 + AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 + B4FF1111B4FF1111B4FF1111A8FF1111A8FF1111B4FF1111B4FF1111B4FF1111 + B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 + BEFF1111BEFF1111B5FFE8E8E8FFEEEEEEFF1111B5FF1111BEFF1111BEFF1111 + BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 + C8FF1111C8FF1111BCFFEEEEEEFFEEEEEEFF1111BCFF1111C8FF1111C8FF0F0F + BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 + C4F61212D1FF1111D1FF1111B6FF1111B6FF1111D1FF1111D1FF0F0FC2F60303 + 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 + 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 + 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 + 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00E7815F00E983610FED876590ED8765E8ED87 + 65FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED87 + 65E8ED876590E983610FE7815F00E47F5D00E47F5D90EEA992FFFCEFEAFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCEF + EAFFEEA992FFE47F5D90E47F5D00D9745200D97452E8F9ECE8FFFBFBFBFFFBFB + FBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB + FBFFF8EBE7FFD97452E8D9745200CC674500CC6745FFFBFBFBFFF7F7F7FFF7F7 + F7FFF7F7F7FFF7F7F7FFCC6745FFCC6745FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7 + F7FFFAFAFAFFCC6745FFCC674500BE5B3900BE5B39FFF9F9F9FFF3F3F3FFF3F3 + F3FFF3F3F3FFF3F3F3FFBE5B39FFBE5B39FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3 + F3FFF6F6F6FFBE5B39FFBE5B3900B4502E00B4502EFFF6F6F6FFF0F0F0FFF0F0 + F0FFF0F0F0FFEBEBEBFFB4502EFFB4502EFFD2D1D1FFCECECEFFCECECEFFD2D1 + D1FFDEDDDDFFB4502EFFB4502E00AC482600AC4826FFF4F4F4FFEEEEEEFFAC48 + 26FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFD2D0 + D0FFD7D6D6FFAC4826FFAC482600AB442200AB4422FFF3F3F3FFE7E5E5FFEE66 + 44FFEE6644FFEE6644FFAB4422FFAB4422FFEE6644FFEE6644FFEE6644FFD8D4 + D4FFDBD8D8FFAB4422FFAB442200AF452300AF4523FFEDEAEAFFE1DADAFFF1ED + EDFFF1EDEDFFF1EDEDFFAF4523FFAF4523FFF1EDEDFFF1EDEDFFF1EDEDFFE0D9 + D9FFE1DBDBFFAF4523FFAF452300B8492700B84927FFEBE4E4FFE7DFDFFFE7DF + DFFFE7DFDFFFE7DFDFFFB84927FFB84927FFE7DFDFFFE7DFDFFFE7DFDFFFE7DF + DFFFE7DFDFFFB84927FFB8492700C54F2D00C54F2DFFF1E7E7FFEFE4E4FFEFE4 + E4FFEFE4E4FFEFE4E4FFEE6644FFEE6644FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4 + E4FFEFE4E4FFC54F2DFFC54F2D00D2563400D25634E8F3D7D3FFF7E8E8FFF7E8 + E8FFF7E8E8FFF7E8E8FFFCF4F4FFFCF4F4FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8 + E8FFF2D5D1FFD25634E8D256340037170F00DF5E3C90E98D76FFF9DAD6FFFCEC + ECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFF9DA + D6FFE98C75FFDF5E3C9037170F000000001226100B36BF51359FE86341E9E963 + 41FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE863 + 41E9BF51359F26100B360000001200000000000000160000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001600000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00E7815F00E983610FED876590ED8765E8ED87 + 65FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED8765FFED87 + 65E8ED876590E983610FE7815F00E47F5D00E47F5D90EEA992FFFCEFEAFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFCEF + EAFFEEA992FFE47F5D90E47F5D00D9745200D97452E8F9ECE8FFFBFBFBFFFBFB + FBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFB + FBFFF8EBE7FFD97452E8D9745200CC674500CC6745FFFBFBFBFFF7F7F7FFF7F7 + F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7F7FFF7F7 + F7FFFAFAFAFFCC6745FFCC674500BE5B3900BE5B39FFF9F9F9FFF3F3F3FFF3F3 + F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3F3FFF3F3 + F3FFF6F6F6FFBE5B39FFBE5B3900B4502E00B4502EFFF6F6F6FFF0F0F0FFF0F0 + F0FFF0F0F0FFEBEBEBFFE0E0E0FFD7D6D6FFD2D1D1FFCECECEFFCECECEFFD2D1 + D1FFDEDDDDFFB4502EFFB4502E00AC482600AC4826FFF4F4F4FFEEEEEEFFAC48 + 26FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFAC4826FFD2D0 + D0FFD7D6D6FFAC4826FFAC482600AB442200AB4422FFF3F3F3FFE7E5E5FFEE66 + 44FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFEE6644FFD8D4 + D4FFDBD8D8FFAB4422FFAB442200AF452300AF4523FFEDEAEAFFE1DADAFFF1ED + EDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFF1EDEDFFE0D9 + D9FFE1DBDBFFAF4523FFAF452300B8492700B84927FFEBE4E4FFE7DFDFFFE7DF + DFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DFDFFFE7DF + DFFFE7DFDFFFB84927FFB8492700C54F2D00C54F2DFFF1E7E7FFEFE4E4FFEFE4 + E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4E4FFEFE4 + E4FFEFE4E4FFC54F2DFFC54F2D00D2563400D25634E8F3D7D3FFF7E8E8FFF7E8 + E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8E8FFF7E8 + E8FFF2D5D1FFD25634E8D256340037170F00DF5E3C90E98D76FFF9DAD6FFFCEC + ECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFFCECECFFF9DA + D6FFE98C75FFDF5E3C9037170F000000001226100B36BF51359FE86341E9E963 + 41FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE96341FFE863 + 41E9BF51359F26100B360000001200000000000000160000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A00000016000000001975BA001975BA001770B7900B56A4C60142 + 96CC003F94CC002A80CC00166BCC021C70CB072D7DC80D4390C51259A3C1176C + B290186FB500186FB500FFFFFF0098763200987632009876325BF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29876 + 325B9876320098763200FFFFFF0097753100977531009775315CF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29775 + 315C9775310097753100FFFFFF0096743000967430009674305DF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29674 + 305D9674300096743000FFFFFF0095732F0095732F0095732F5FF8F0E9DCCCCB + C3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391AFF9C7C6BDCEF7EEE5DC9573 + 2F5F95732F0095732F00FFFFFF0094722E0094722E0094722E3094722E60F1E3 + D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3BBCEF1E2D3D394722E609472 + 2E3094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D319371 + 2D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3D5D293712D6293712D319472 + 2E0094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D00916F + 2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F2B63916F2B3293712D009472 + 2E0094722E0094722E00FFFFFF008C6A26008C6A26008D6B27008E6C2800906E + 2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E2A65906E2A338E6C28008D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27008E6C28348E6C + 2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3D5D28E6C28678E6C28348D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27358D6B2769F1E3 + D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFF1E2D3D38D6B27698D6B + 27358C6A26008C6A2600FFFFFF008B6925008B6925008B69256AF8F0E9DCEAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F7EEE5DC8B69 + 256A8B6925008B692500FFFFFF00674E1B00896723008967236CF5EAE0D276AF + CBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F65B95B0F66BA4BFF6F3E7DBD28967 + 236C89672300674E1B00FFFFFF0000000000654B180085631F70F5EAE0D299BB + C7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E386A8B5E391B3BFE3F3E7DBD28563 + 1F70654B180000000000FFFFFF000000000A000000177F5D1977F5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD27F5D + 1977000000170000000AFFFFFF00000000000000002D002C6CA600277CCC0016 + 6BCC001569CC000955CC000041CC000546CC001155CC001F68CC002E7CCC002B + 69A60000002E00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001FA4 + 000020A9004A20A900A620A900CC20A900A620A9004A1FA40000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001FA3 + 004A2FB111D072E557F380EF66FD71E456F32EB010D01FA3004AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001D9D + 00A667D94DF35BCA42FF50BF37FF4BBA32FF51C437F31D9D00A6FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C95 + 00CC57CA3DFD32A916FF2CA511FF2CA511FF39B01DFD1C9500CCFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001A8C + 00A63DBD1FF331BC12FF30BB11FF32BB12FF2FB310F31A8C00A6FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001984 + 004A1D8E04D032C010F334CE11FD2FBF0EF31C8D03D01363004AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00090C410061136500AB146900CC136500AB0C40006500000013FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 0005000000170000001A0000001A0000001A000000190000000AFFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000404040004040400040404460404048AAA55 + 0099AA550099AA550099AA550099AA550099AA550099AA550099AA550099AA55 + 0099AA550073AA550000AA55000004040400040404000404048ABCBCABFFC1C1 + B1FFC7C7B9FFCFCFC3FFD7D7CDFFDFDFD7FFE8E8E2FFEFEFECFFF7F7F4FFFCFC + FCFF55552B6655552B0055552B000101010001010100010101AC555555FFCC99 + 66FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC9966FFCC99 + 66FFAA55009AAA550000AA5500000101010001010100010101AE808080FFEAB7 + 84FFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFE5B27FFFEAB7 + 84FFA854009BA8540000A85400000101010001010100010101B07E7E7EFFE4B1 + 7EFFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFBB8855FFE4B1 + 7EFFA653009DA6530000A65300000101010001010100010101B27C7C7CFFE2AF + 7CFFBC8956FFE3B07DFFE3B07DFFE3B07DFFE3B07DFFE3B07DFFBC8956FFE2AF + 7CFFA451009FA4510000A45100000101010001010100010101B5797979FFDFAC + 79FFBE8B58FFD6A370FFD6A370FFD6A370FFD6A370FFD6A370FFBE8B58FFDFAC + 79FFA14F00A1A14F0000A14F00000101010001010100010101B8757575FFDBA8 + 75FFBE8B58FFD29F6CFFD29F6CFFD29F6CFFD29F6CFFD29F6CFFBE8B58FFDBA8 + 75FF9E4D00A39E4D00009E4D00000101010001010100010101BB727272FFD8A5 + 72FFBF8C59FFCF9C69FFCF9C69FFCF9C69FFCF9C69FFCF9C69FFBF8C59FFD8A5 + 72FF9B4B00A59B4B00009B4B00000101010001010100010101BE6E6E6EFFD4A1 + 6EFFBF8C59FFCB9865FFCB9865FFCB9865FFCB9865FFCB9865FF599D24FF3BA8 + 16FF448700DC60720000567300000101010001010100010101C16B6B6BFFD19E + 6BFFBF8C59FFC89562FFC89562FFC89562FFC89562FFC89562FF369F12FF75EE + 64FF269700EE179E0000129D00000101010001010100010101C5676767FFCD9A + 67FFBF8C59FFC4915EFFC4915EFFC4915EFF5A9826FF369B13FF359A12FF66EB + 55FF249000EF129D00CC129C00990101010001010100010101C9646464FFCA97 + 64FFBE8B58FFC18E5BFFC18E5BFFC18E5BFF339412FF52E741FF52E741FF52E7 + 41FF52E741FF52E741FF109500CC0000000001010100010101CE626262FFC895 + 62FFBD8A57FFBF8C59FFBF8C59FFBF8C59FF548D24FF318C12FF318C11FF3DE2 + 2CFF208100F00E8C00CC0E8D00990000000900000016000000DB606060FFCA97 + 64FFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFFC5925FFF318613FF2BDF + 1AFF1E7700F20000001600000009000000000000002C00000087000000E7702E + 00C7702E00C7702E00C7702E00C7702E00C7702E00C7702E00C72D5500E9175F + 00F4124A00C40000002C00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0088888899888888CC8888 + 88CC888888CC888888CC888888CC888888CC888888CC888888CC888888CC8888 + 8899FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00838383CCBCBCBCFFB9B9 + B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFBBBBBBFF8383 + 83CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7FCCB5B5B5FFABAB + ABFFABABABFFABABABFFABABABFFABABABFFABABABFFABABABFFB3B3B3FF7F7F + 7FCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00797979CCAFAFAFFFA0A0 + A0FFA0A0A0FFA0A0A0FF9B9B9BFF969696FF919191FF909090FF9F9F9FFF7979 + 79CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00727272CCABABABFF9B9B + 9BFF909090FF848484FF7F7F7FFF7E7E7EFF7E7E7EFF7E7E7EFF8D8D8DFF7272 + 72CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00686868CCA0A0A0FF8181 + 81FF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF8A8A8AFF6868 + 68CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00606060CC8E8E8EFF7C7C + 7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF858585FF6060 + 60CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00575757CC888888FF7979 + 79FF797979FF797979FF797979FF797979FF797979FF797979FF808080FF5757 + 57CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00505050CC848484FF7878 + 78FF787878FF787878FF787878FF787878FF787878FF787878FF7D7D7DFF5050 + 50CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4ACC858585FF7F7F + 7FFF7E7E7EFF7E7E7EFF7D7D7DFF7C7C7CFF7C7C7CFF7C7C7CFF7D7D7DFF4A4A + 4ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF0016161603353535A0454545CC4545 + 45CC454545CC454545CC454545CC454545CC454545CC454545CC454545CC3535 + 35A116161604FFFFFF00FFFFFF00FFFFFF0016161603161616111616161A1616 + 161A1616161A1616161A1616161A1616161A1616161A1616161A1616161A1616 + 161316161604FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object IconDL: TImageList + left = 278 + top = 150 + Bitmap = { + 4C69090000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B2BCF992B2BCFCC2B2B + CFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2BCFCC2B2B + CF99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002424CCCC8686E6FF8080 + E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8080E5FF8484E5FF2424 + CCCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C1CC9CC7878E4FF6767 + DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF6767DFFF7575E2FF1C1C + C9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001414C6CC6F6FE1FF5555 + DAFF5555DAFF5555DAFF4D4DD8FF4343D6FF3B3BD3FF3838D3FF5252DAFF1414 + C6CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001010B9CC6767DFFF4B4B + D8FF3838D3FF2525CDFF1C1CC9FF1B1BC9FF1B1BC9FF1B1BC9FF3434D1FF1010 + B9CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000F0FA5CC5555DAFF2020 + CAFF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF1A1AC9FF2E2ED0FF0F0F + A5CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000D0D95CC3636D1FF1717 + C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF1717C8FF2727CDFF0D0D + 95CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000B0B84CC2C2CCFFF1414 + C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1414C6FF1E1ECAFF0B0B + 84CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000A0A75CC2525CDFF1212 + C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1212C6FF1919C8FF0A0A + 75CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0009096ACC2727CDFF1C1C + C9FF1B1BC9FF1A1AC9FF1919C8FF1717C8FF1717C8FF1717C8FF1919C8FF0909 + 6ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF000000000306063EA0080860CC0808 + 60CC080860CC080860CC080860CC080860CC080860CC080860CC080860CC0606 + 3EA100000004FFFFFF00FFFFFF00FFFFFF0000000003000000110000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001300000004FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF001975BA001975BA001770B7900B56A4C60142 + 96CC003F94CC002A80CC00166BCC021C70CB072D7DC80D4390C51259A3C1176C + B290186FB500186FB500FFFFFF0098763200987632009876325BF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29876 + 325B9876320098763200FFFFFF0097753100977531009775315CF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29775 + 315C9775310097753100FFFFFF0096743000967430009674305DF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29674 + 305D9674300096743000FFFFFF0095732F0095732F0095732F5FF8F0E9DCCCCB + C3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391AFF9C7C6BDCEF7EEE5DC9573 + 2F5F95732F0095732F00FFFFFF0094722E0094722E0094722E3094722E60F1E3 + D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3BBCEF1E2D3D394722E609472 + 2E3094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D319371 + 2D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3D5D293712D6293712D319472 + 2E0094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D00916F + 2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F2B63916F2B3293712D009472 + 2E0094722E0094722E00FFFFFF008C6A26008C6A26008D6B27008E6C2800906E + 2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E2A65906E2A338E6C28008D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27008E6C28348E6C + 2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3D5D28E6C28678E6C28348D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27358D6B2769F1E3 + D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFF1E2D3D38D6B27698D6B + 27358C6A26008C6A2600FFFFFF008B6925008B6925008B69256AF8F0E9DCEAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F7EEE5DC8B69 + 256A8B6925008B692500FFFFFF00674E1B00896723008967236CF5EAE0D276AF + CBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F65B95B0F66BA4BFF6F3E7DBD28967 + 236C89672300674E1B00FFFFFF0000000000654B180085631F70F5EAE0D299BB + C7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E386A8B5E391B3BFE3F3E7DBD28563 + 1F70654B180000000000FFFFFF000000000A000000177F5D1977F5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD27F5D + 1977000000170000000AFFFFFF00000000130000002D002C6CA600277CCC0016 + 6BCC001569CC000955CC000041CC000546CC001155CC001F68CC002E7CCC002B + 69A60000002E00000013FFFFFF00FFFFFF0043DBE50043DBE50043DBE50044DC + E69944DCE6CC44DCE69944DCE60044DCE6CC44DCE60041D8E1003FD6DF003FD6 + DF003FD6DF00FFFFFF00FFFFFF00FFFFFF0041D9E20041D9E20041D9E20041D9 + E2CC97E6FCFF41D9E2CC40D7E00041D9E20040D7E0003FD6DF003FD6DF003FD6 + DF003FD6DF00FFFFFF00FFFFFF00FFFFFF003FD6DF003FD6DF003FD6DF003FD6 + DF993ED5DECC3ED5DECC3ED5DECC3ED5DE993ED5DE003ED5DECC3ED5DE003ED5 + DE003ED5DE00FFFFFF00FFFFFF00FFFFFF003AD1D9003AD1D9003AD1D9003AD1 + D9003AD1D9003AD1D9CC92E7FBFF3AD1D9CC38CFD7003AD1D90039D0D80039D0 + D80039D0D800FFFFFF00FFFFFF00FFFFFF0035CBD20035CBD20035CBD20036CC + D39936CCD4CC36CCD4CC36CCD4CC36CCD4CC36CCD4CC36CCD39935CBD20035CB + D20035CBD200FFFFFF00FFFFFF00FFFFFF0032C7CE0032C7CE0032C7CE0032C7 + CECC8BE6F8FF34C8CFCE8AE5F7FF32C7CECC88E6F7FF32C7CECC32C7CE0032C7 + CE0032C7CE00FFFFFF00FFFFFF00FFFFFF001DB0B4002BBFC5002BBFC5002CC0 + C6993CCAD1D73CCAD1D734C5CCD22DC1C7CC2DC1C7CC2CC0C6992BBFC5002BBF + C5001DB0B400FFFFFF00FFFFFF00FFFFFF001DB0B40021B4B90028BCC10028BC + C1CC83E4F4FF48CFD6E381E3F3FF2CBFC4CF80E4F3FF28BCC1CC28BCC10021B4 + B9001DB0B400FFFFFF00FFFFFF00FFFFFF001DB0B4001EB1B50020B3B70022B5 + BACC6FDEEAF856D6DDEF4CD0D7E842C9D0E142C9D0E122B5B9991EB1B5001EB1 + B5001DB0B400FFFFFF00FFFFFF00FFFFFF001DAFB3991DB0B4CC1DB0B4CC1DB0 + B4CC77E4F0FF63DFE6FA69E3EBFF5CD9E0F574E4EFFF1DB0B4CC1DB0B4CC1DB0 + B4CC1DAFB399FFFFFF00FFFFFF00FFFFFF0019ABAE5C18AAADCC82E4F4FF76E3 + EFFF6FE3EDFF64DEE6FF5AD4DCFF50CAD2FF52C8D1FF57C8D3FF62CDDAFF18AA + ADCC19ABAE5CFFFFFF00FFFFFF00FFFFFF0018AAAD0014A5A85C13A4A7CC7AE1 + EFFF4FCDD7FF44C2CCFF43C1CBFF43C1CBFF43C1CBFF5BCBD9FF13A4A7CC14A5 + A85C18AAAD00FFFFFF00FFFFFF00FFFFFF0018AAAD0013A4A70010A0A25C0F9F + A1CC4ECEE6FF2DC3DBFF2DC3DBFF2DC3DBFF47CDE4FF0F9FA1CC10A0A25C13A4 + A70018AAAD00FFFFFF00FFFFFF00FFFFFF000000000000000000085051000C9C + 9D5C0B9B9CCC32CDF2FF13C7EFFF2ECDF2FF0B9B9CCC0C9C9D5C085051000000 + 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 + 001906696A6E089796CC1ECCF9FF089796CC06696A6E0000001A000000110000 + 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 + 00320000003304605F74059392CC04605F740000003300000033000000220000 + 000800000000FFFFFF00FFFFFF00FFFFFF00E99E3F00E99E3F00E99E3F00EA9F + 4099EA9F40CCEA9F4099EA9F4000EA9F40CCEA9F4000E59A3D00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E69B3D00E69B3D00E69B3D00E69B + 3DCCFFE195FFE69B3DCCE4993C00E69B3D00E4993C00E3983B00E3983B00E398 + 3B00E3983B00FFFFFF00FFFFFF00FFFFFF00E3983B00E3983B00E3983B00E398 + 3B99E2973ACCE2973ACCE2973ACCE2973A99E2973A00E2973ACCE2973A00E297 + 3A00E2973A00FFFFFF00FFFFFF00FFFFFF00DD923600DD923600DD923600DD92 + 3600DD923600DD9236CCFEDC90FFDD9236CCDB903400DD923600DC913500DC91 + 3500DC913500FFFFFF00FFFFFF00FFFFFF00D68B3100D68B3100D68B3100D78C + 3299D88D32CCD88D32CCD88D32CCD88D32CCD88D32CCD78C3299D68B3100D68B + 3100D68B3100FFFFFF00FFFFFF00FFFFFF00D2872E00D2872E00D2872E00D287 + 2ECCFBD589FFD38930CEFAD488FFD2872ECCFAD286FFD2872ECCD2872E00D287 + 2E00D2872E00FFFFFF00FFFFFF00FFFFFF00B86D1A00C97E2700C97E2700CA7F + 2899D58E39D7D58E39D7D08731D2CB8029CCCB8029CCCA7F2899C97E2700C97E + 2700B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00BD721E00C57A2400C57A + 24CCF7CC80FFDA9645E3F6CA7EFFC87E29CFF6C97DFFC57A24CCC57A2400BD72 + 1E00B86D1A00FFFFFF00FFFFFF00FFFFFF00B86D1A00B96E1B00BB701D00BE73 + 1FCCEDB96CF8E1A153EFDB9949E8D4903FE1D4903FE1BD721F99B96E1B00B96E + 1B00B86D1A00FFFFFF00FFFFFF00FFFFFF00B76C1A99B86D1ACCB86D1ACCB86D + 1ACCF3C074FFE9AC60FAEEB266FFE4A659F5F2BD71FFB86D1ACCB86D1ACCB86D + 1ACCB76C1A99FFFFFF00FFFFFF00FFFFFF00B267165CB16615CCF7CB7FFFF2BF + 73FFF0B86CFFE9AD61FFDFA357FFD5994DFFD49B4FFFD6A054FFDDAB5FFFB166 + 15CCB267165CFFFFFF00FFFFFF00FFFFFF00B1661500AC61115CAB6010CCF2C3 + 77FFDB9E4CFFD09341FFCF9240FFCF9240FFCF9240FFDCA858FFAB6010CCAC61 + 115CB1661500FFFFFF00FFFFFF00FFFFFF00B1661500AB601000A65B0D5CA55A + 0CCCEAB44BFFE09E29FFE09E29FFE09E29FFE8AE43FFA55A0CCCA65B0D5CAB60 + 1000B1661500FFFFFF00FFFFFF00FFFFFF000000000000000000532D0600A156 + 095CA05508CCF7B92EFFF5AB0EFFF7B629FFA05508CCA156095C532D06000000 + 000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000030000000F0000 + 00196D39046E9B5005CCFFBB19FF9B5005CC6D39046E0000001A000000110000 + 000400000000FFFFFF00FFFFFF00FFFFFF0000000000000000050000001D0000 + 00320000003363320274974C02CC633202740000003300000033000000220000 + 000800000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000013A2000014A5000014A5000014A6000015A8000015A9001F15AA + 00CC15AA004814A70000FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000014A5001014A700B077EE + 66FF14A700CC14A70048FFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000013A2000614A3009E43C631E56BE2 + 5AFF70E95FFB14A300CCFFFFFF00FFFFFF0011970000129B0000129C0000129B + 00001197000011990000129F0000129F000113A0008533B820DE61D850FF5CD5 + 4BFA1EA80CD213A1004CFFFFFF00FFFFFF0011970000129B0048129B00CC129B + 0048119700000F93000011970000129B006924AA13D857CF46FE55CD44FD21A7 + 10D6129C006313A00000FFFFFF00FFFFFF0011960048119700CC73EA62FD1197 + 00CC119600480F9300001196004C189D08D33DB62CFB37AF26FE1FA00EDA1197 + 007B11980000129B0000FFFFFF00FFFFFF000F9200CC6DE55CFA59D048FF69E1 + 58FC0F9200CC0F92006D139504CB34B423F832B221FF1F9F0FDF0F92008C1094 + 00021095000010950000FFFFFF00FFFFFF000E8E00480E8D00CC5FD94FF933BC + 22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA20FE40E8D009E0F8F00081094 + 000010950000084B0000FFFFFF00FFFFFF000E8D00000D8800480D8700CC43CA + 33F629C318FF39CC28FF28C217FF1EAA0FEA0D8700AE0D8A00100F8F0000084A + 00000000000000000000FFFFFF00FFFFFF00074700000A6500000B8300480B82 + 00CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85001B07450000000000000000 + 00000000000000000000FFFFFF00FFFFFF000000000000000000032000000657 + 0048077200CC16A60AE8087601C406570029021E000000000000000000000000 + 00000000000000000000FFFFFF00FFFFFF00000000020000000F0000001F0000 + 002D02330066025F00CC012B005500000029000000220000001A000000130000 + 000C0000000600000001FFFFFF00FFFFFF000000000100000008000000100000 + 00170000001A000000190000001700000015000000110000000D0000000A0000 + 00060000000300000001FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF000462BF000462BF040462C0680462C08B0462 + C08B0462C08B004080CC004080CC004080CC004080CC0462C08B0462C08B0462 + C08B0462C0680462BF040462BF000461BE000461BE232A7CCCA589BCEFFF88BB + EEFF88BBEEFF35689BFF35689BFF35689BFF35689BFF88BBEEFF88BBEEFF89BC + EFFF2A7CCCA50461BE230461BE00045FBB000460BC474D94D9C489BCEFFF88BB + EEFF88BBEEFF4174A7FF4174A7FF4174A7FF3E71A4FF88BBEEFF88BBEEFF89BC + EFFF4D94D9C40460BC47045FBB00045FB900045FB96D6BA6DFE080B3E6FF80B3 + E6FF80B3E6FF4E81B4FF4E81B4FF4E81B4FF487BAEFF80B3E6FF80B3E6FF80B3 + E6FF6BA6DFE0045FB96D045FB900035DB600035DB695A7DBFEFDAADDFFFFAADD + FFFFAADDFFFF77AADDFF77AADDFF77AADDFF6699CCFFAADDFFFFAADDFFFFAADD + FFFFA7DBFEFD035DB695035DB600035BB300035BB3989FD2F9FF95C8F3FF95C8 + F3FF95C8F3FF5588BBFF4477AAFF5588BBFF4073A6FF95C8F3FF95C8F3FF95C8 + F3FF9FD2F9FF035BB398035BB300035AB000035AB09B9BCEF6FF91C4F0FF91C4 + F0FF91C4F0FF4477AAFF91C4F0FF4477AAFF91C4F0FF91C4F0FF91C4F0FF91C4 + F0FF9BCEF6FF035AB09B035AB0000358AC000358AC9F96C9F2FF8CBFECFF8CBF + ECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBFECFF8CBF + ECFF96C9F2FF0358AC9F0358AC000356A8000356A8A38FC2EEFFBBBBBBFF87BA + E9FFBBBBBBFF87BAE9FFBBBBBBFF999999FFBBBBBBFFBBBBBBFFBBBBBBFFBBBB + BBFF999999FF02417F940356A800040404000404048ABBBBBBFF777777FFBBBB + BBFF777777FFBBBBBBFF777777FF82B5E5FF999999FFEEEEEEFFDDDDDDFFCCCC + CCFFBBBBBBFF00000066000000000251A0000251A0AB777777FF7DB0E1FF7777 + 77FF7DB0E1FF777777FF999999FF777777FF777777FF777777FF777777FF7777 + 77FF999999FF023D789B0251A00001132600014A94B87BAEE0FF7AADDFFF7AAD + DFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AADDFFF7AAD + DFFF7BAEE0FF014A94B8011326000000001E0133669E014487C5014487C50144 + 87C5014487C5014487C5014487C5014487C5014487C5014487C5014487C50144 + 87C5014487C50133669E0000001E0000000F000000170000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A000000170000000FFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0001B0C90001B2CB0001B3CC0001B3 + CC1601B3CC5B01B3CC8B01B3CCA401B3CCA401B3CC8B01B3CC5B01B3CC1601B3 + CC0001B2CB0001B0C900FFFFFF00FFFFFF0001B0C90001B2CB0001B3CC4011B9 + D0A361D8E5D097EEF7EEA5F5FDFBA5F4FDFB95EDF7EE5DD6E5D011B9D0A301B3 + CC4001B2CB0001B0C900FFFFFF00FFFFFF0001B0C90001B2CB411EBDD2B297EE + F6F08DEDFCFF81EAFBFF81EAFBFF81EAFBFF81EAFBFF8BEDFCFF8FEBF6F01BBC + D2B201B2CB4101B0C900FFFFFF00FFFFFF0001B0C91611B6CDA593EBF5F07DE8 + F8FF79E6F7FF79E6F7FF757575FF757575FF79E6F7FF79E6F7FF7CE7F8FF84E7 + F3F00EB5CDA501B0C916FFFFFF00FFFFFF0001AEC75D5AD2E1D27DE6F5FF70E2 + F3FF70E2F3FF70E2F3FF666666FF666666FF70E2F3FF70E2F3FF70E2F3FF78E5 + F5FF49CDDFD201AEC75DFFFFFF00FFFFFF0001ABC49082E4EFEF69DFF0FF69DF + F0FF69DFF0FF63DCEBFF303030FF181818FF48CCD4FF45C9D2FF45C9D2FF48CC + D4FF58D3DCEF01ABC490FFFFFF00FFFFFF0001A8C1AB85E7F3FC66DDEEFF61DB + EAFF4DD4DAFF42CFD0FF000000FF000000FF40CFCFFF40CFCFFF40CFCFFF40CF + CFFF4FD4D4FC01A8C1ABFFFFFF00FFFFFF0001A5BEAD80E5F1FC56D9E5FF3FD2 + D6FF3CD1D4FF3CD1D4FF000000FF000000FF3CD1D4FF3CD1D4FF3CD1D4FF3CD1 + D4FF44D2D6FC01A5BEADFFFFFF00FFFFFF0001A2BA945DD8E2F038D4D9FF37D4 + D9FF37D4D9FF37D4D9FF81EAEDFF81EAEDFF37D4D9FF37D4D9FF37D4D9FF37D4 + D9FF32CDD5F001A2BA94FFFFFF00FFFFFF00019FB7622DBFCED739D8DFFF32D6 + DEFF32D6DEFF32D6DEFF000000FF000000FF32D6DEFF32D6DEFF32D6DEFF32D6 + DEFF19BAC9D7019FB762FFFFFF00FFFFFF00019CB41807A1B7B136D3DEF22ED9 + E4FF2DD9E3FF2DD9E3FF000000FF000000FF2DD9E3FF2DD9E3FF2DD9E3FF26CF + DCF205A0B7B1019CB418FFFFFF00FFFFFF00019AB2000097AE47089EB4C127D0 + DFF329DBE8FF28DBE8FF7AEDF4FF7AEDF4FF28DBE8FF28DBE8FF22CFDEF3069E + B4C10097AE47019AB200FFFFFF00FFFFFF000000000000252A000067784A038E + A5BA12AFC2E01ECCDDF423D9E9FD23D9E9FD1ECCDDF412AFC2E0038EA5BA0067 + 784A00252A0000000000FFFFFF00FFFFFF0000000004000000170000002B0023 + 2943005D6D7F007C91AB008096C4008096C4007C91AB005D6D7F002329430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 + A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 + A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 + AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 + A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B + E8F65F5FE7FF5B5BE3FF4949D1FF4949D1FF5B5BE3FF5F5FE7FF5858E4F60F0F + B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 + D9FF4F4FD7FF4040C8FFFFFFFFFFFFFFFFFF4040C8FF4F4FD7FF5050D8FF4F4F + DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FF4242 + CAFF4242CAFF3636BEFFFFFFFFFFFFFFFFFF3636BEFF4242CAFF4242CAFF4747 + CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF3737 + BFFF3737BFFF2A2AB2FFE8E8E8FFDADADAFF15159EFF12129CFF12129CFF1616 + A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E + B8FF1D1DABFF1212A1FFCCCCCCFFD1D1D1FF1111A0FF1111A1FF1111A1FF1111 + A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 + ABFF1111AAFF1111A6FFD1D1D1FFDCDCDCFF1111A6FF1111AAFF1111AAFF1111 + AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 + B4FF1111B4FF1111B4FF1111A8FF1111A8FF1111B4FF1111B4FF1111B4FF1111 + B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FF1111 + BEFF1111BEFF1111B5FFE8E8E8FFEEEEEEFF1111B5FF1111BEFF1111BEFF1111 + BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 + C8FF1111C8FF1111BCFFEEEEEEFFEEEEEEFF1111BCFF1111C8FF1111C8FF0F0F + BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 + C4F61212D1FF1111D1FF1111B6FF1111B6FF1111D1FF1111D1FF0F0FC2F60303 + 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 + 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 + 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 + 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0088888899888888CC8888 + 88CC888888CC888888CC888888CC888888CC888888CC888888CC888888CC8888 + 8899FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00838383CCBCBCBCFFB9B9 + B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFB9B9B9FFBBBBBBFF8383 + 83CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007F7F7FCCB5B5B5FFABAB + ABFFABABABFFABABABFFABABABFFABABABFFABABABFFABABABFFB3B3B3FF7F7F + 7FCCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00797979CCAFAFAFFFA0A0 + A0FFA0A0A0FFA0A0A0FF9B9B9BFF969696FF919191FF909090FF9F9F9FFF7979 + 79CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00727272CCABABABFF9B9B + 9BFF909090FF848484FF7F7F7FFF7E7E7EFF7E7E7EFF7E7E7EFF8D8D8DFF7272 + 72CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00686868CCA0A0A0FF8181 + 81FF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF7E7E7EFF8A8A8AFF6868 + 68CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00606060CC8E8E8EFF7C7C + 7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF7C7C7CFF858585FF6060 + 60CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00575757CC888888FF7979 + 79FF797979FF797979FF797979FF797979FF797979FF797979FF808080FF5757 + 57CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00505050CC848484FF7878 + 78FF787878FF787878FF787878FF787878FF787878FF787878FF7D7D7DFF5050 + 50CCFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4ACC858585FF7F7F + 7FFF7E7E7EFF7E7E7EFF7D7D7DFF7C7C7CFF7C7C7CFF7C7C7CFF7D7D7DFF4A4A + 4ACCFFFFFF00FFFFFF00FFFFFF00FFFFFF0016161603353535A0454545CC4545 + 45CC454545CC454545CC454545CC454545CC454545CC454545CC454545CC3535 + 35A116161604FFFFFF00FFFFFF00FFFFFF0016161603161616111616161A1616 + 161A1616161A1616161A1616161A1616161A1616161A1616161A1616161A1616 + 161316161604FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object IconMed: TImageList + Height = 48 + Width = 48 + left = 328 + top = 238 + Bitmap = { + 4C69010000003000000030000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004D6BEC004D6BEC004D6BEC004D6B + EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B + EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC104D6BEC4E4D6BEC8C4D6B + ECBA4D6BECD84D6BECEE4D6BECF94D6BECF94D6BECEE4D6BECD84D6BECBA4D6B + EC8C4D6BEC4F4D6BEC104D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B + EC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6BEC004D6B + EC004D6BEC004D6BEC00FFFFFF00FFFFFF004D6AEB004D6AEB004D6AEB004D6A + EB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6A + EB004D6AEB004D6AEB074D6AEB5B4D6AEBB74D6AEBFC4D6AEBFF4D6AEBFF4D6A + EBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6AEBFF4D6A + EBFF4D6AEBFF4D6AEBFC4D6AEBB84D6AEB5B4D6AEB074D6AEB004D6AEB004D6A + EB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6AEB004D6A + EB004D6AEB004D6AEB00FFFFFF00FFFFFF004C6AEA004C6AEA004C6AEA004C6A + EA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6A + EA094C6AEA724C6AEAE44C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6A + EAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6A + EAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAFF4C6AEAE54C6AEA724C6AEA094C6A + EA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6AEA004C6A + EA004C6AEA004C6AEA00FFFFFF00FFFFFF004C69E9004C69E9004C69E9004C69 + E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9494C69 + E9DC4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9FF617BECFF8095F1FF92A4 + F4FF9DAEF6FFA6B5F7FFAAB8F8FFAAB8F8FFA6B5F7FF9DAEF6FF92A4F4FF8095 + F1FF617BECFF4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9FF4C69E9DC4C69 + E9494C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69E9004C69 + E9004C69E9004C69E900FFFFFF00FFFFFF004B68E8004B68E8004B68E8004B68 + E8004B68E8004B68E8004B68E8004B68E8004B68E8084B68E8964B68E8FF4B68 + E8FF4B68E8FF4B68E8FF5872EAFF8498F1FFA7B5F7FFACB9F8FFACB9F8FFACB9 + F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9F8FFACB9 + F8FFACB9F8FFA8B6F7FF8498F1FF5873EAFF4B68E8FF4B68E8FF4B68E8FF4B68 + E8FF4B68E8964B68E8084B68E8004B68E8004B68E8004B68E8004B68E8004B68 + E8004B68E8004B68E800FFFFFF00FFFFFF004A67E7004A67E7004A67E7004A67 + E7004A67E7004A67E7004A67E7004A67E7174A67E7CB4A67E7FF4A67E7FF4A67 + E7FF536FE9FF8C9FF3FFAAB9F8FFAAB9F8FFAAB9F8FF9FAFF7FF8DA0F5FF7C92 + F4FF748CF3FF6F88F3FF6C85F3FF6C85F3FF6F88F3FF748CF3FF7C92F4FF8DA0 + F5FF9FAFF7FFAAB9F8FFAAB9F8FFAAB9F8FF8C9FF3FF536FE9FF4A67E7FF4A67 + E7FF4A67E7FF4A67E7CD4A67E7174A67E7004A67E7004A67E7004A67E7004A67 + E7004A67E7004A67E700FFFFFF00FFFFFF004966E5004966E5004966E5004966 + E5004966E5004966E5004966E5224966E5DB4966E5FF4966E5FF4966E5FF7188 + ECFFA4B3F6FFAAB8F7FFAAB8F7FF91A3F5FF7189F2FF647EF1FF647EF1FF647E + F1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647EF1FF647E + F1FF647EF1FF7189F2FF91A3F5FFAAB8F7FFAAB8F7FFA4B3F6FF7188ECFF4966 + E5FF4966E5FF4966E5FF4966E5DB4966E5214966E5004966E5004966E5004966 + E5004966E5004966E500FFFFFF00FFFFFF004965E4004965E4004965E4004965 + E4004965E4004965E41C4965E4DF4965E4FF4965E4FF4965E4FF8599F0FFA9B8 + F7FFA9B8F7FF94A6F5FF6C84F1FF637DF0FF637DF0FF637DF0FF637DF0FF637D + F0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637DF0FF637D + F0FF637DF0FF637DF0FF637DF0FF6C84F1FF94A6F5FFA9B8F7FFA9B8F7FF8699 + F0FF4965E4FF4965E4FF4965E4FF4965E4DF4965E41C4965E4004965E4004965 + E4004965E4004965E400FFFFFF00FFFFFF004864E2004864E2004864E2004864 + E2004864E20A4864E2CE4864E2FF4864E2FF4864E2FF8B9DF0FFA9B7F6FFA9B7 + F6FF7B91F2FF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627C + EFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF627C + EFFF627CEFFF627CEFFF627CEFFF627CEFFF627CEFFF7B91F2FFA7B6F6FFA9B7 + F6FF8B9DF0FF4864E2FF4864E2FF4864E2FF4864E2CE4864E20A4864E2004864 + E2004864E2004864E200FFFFFF00FFFFFF004763E1004763E1004763E1004763 + E1004763E19A4763E1FF4763E1FF4763E1FF8B9DF0FFA8B6F6FFA3B2F5FF758B + F0FF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF617A + EEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF617AEEFF758BF0FFA3B2 + F5FFA8B6F6FF8B9DF0FF4763E1FF4763E1FF4763E1FF4763E19B4763E1004763 + E1004763E1004763E100FFFFFF00FFFFFF004662DF004662DF004662DF004662 + DF4A4662DFFF4662DFFF4662DFFF8497EDFFA7B5F5FFA0B0F4FF7188EFFF5F79 + EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5F79 + EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF5F79EDFF7188 + EFFFA0B0F4FFA7B5F5FF8497EDFF4662DFFF4662DFFF4662DFFF4662DF4A4662 + DF004662DF004662DF00FFFFFF00FFFFFF004561DE004561DE004561DE084561 + DEDC4561DEFF4561DEFF6F85E8FFA7B5F5FFA5B3F4FF7188EEFF5E78ECFF5E78 + ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5E78 + ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78ECFF5E78 + ECFF7188EEFFA5B3F4FFA7B5F5FF7086E8FF4561DEFF4561DEFF4561DEDD4561 + DE084561DE004561DE00FFFFFF00FFFFFF004460DC004460DC004460DC714460 + DCFF4460DCFF4E68DEFFA0AFF2FFA6B4F4FF768CEEFF5C76EBFF5C76EBFF5C76 + EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5C76 + EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76EBFF5C76 + EBFF5C76EBFF768CEEFFA6B4F4FFA0AFF2FF4E69DEFF4460DCFF4460DCFF4460 + DC714460DC004460DC00FFFFFF00FFFFFF00435EDA00435EDA07435EDAE5435E + DAFF435EDAFF8598EBFFA5B3F3FF8EA0F1FF5B74EAFF5B74EAFF5B74EAFF5B74 + EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5B74 + EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74EAFF5B74 + EAFF5B74EAFF5B74EAFF8EA0F1FFA5B3F3FF8598EBFF435EDAFF435EDAFF435E + DAE6435EDA08435EDA00FFFFFF00FFFFFF00425DD800425DD85B425DD8FF425D + D8FF4F68DBFFA4B2F2FFA4B2F2FF627BE9FF5973E8FF5973E8FF5973E8FF5973 + E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5973 + E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973E8FF5973 + E8FF5973E8FF5973E8FF627BE9FFA4B2F2FFA4B2F2FF4F69DCFF425DD8FF425D + D8FF425DD85B425DD800FFFFFF00FFFFFF00415CD700415CD7B8415CD7FF415C + D7FF7B8EE7FFA3B1F2FF889AEEFF5871E7FF5871E7FF5871E7FF5871E7FF5871 + E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FFFFFF + FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5871 + E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871E7FF5871 + E7FF5871E7FF5871E7FF5871E7FF889AEEFFA3B1F2FF7B8EE7FF415CD7FF415C + D7FF415CD7B8415CD700FFFFFF00FFFFFF00405BD510405BD5FC405BD5FF405B + D5FF9EACF0FFA2B0F1FF657CE8FF5670E6FF5670E6FF5670E6FF5670E6FF5670 + E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FFFAFB + FEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF9FAFEFF5670 + E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670E6FF5670 + E6FF5670E6FF5670E6FF5670E6FF657CE8FFA2B0F1FF9EACF0FF405BD5FF405B + D5FF405BD5FC405BD510FFFFFF00FFFFFF003F59D34F3F59D3FF3F59D3FF556C + DAFFA1AFF1FF94A5EFFF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546E + E5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FFE8EC + FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFE8ECFCFF546E + E5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546EE5FF546E + E5FF546EE5FF546EE5FF546EE5FF546EE5FF94A5EFFFA1AFF1FF556CDAFF3F59 + D3FF3F59D3FF3F59D34FFFFFFF00FFFFFF003E58D18B3E58D1FF3E58D1FF7487 + E2FFA1AEF0FF8092EAFF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536C + E3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FFD8DE + F9FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFD8DEF9FF536C + E3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536CE3FF536C + E3FF536CE3FF536CE3FF536CE3FF536CE3FF8092EAFFA1AEF0FF7487E2FF3E58 + D1FF3E58D1FF3E58D18CFFFFFF00FFFFFF003D57CFB43D57CFFF3D57CFFF8294 + E6FF9FAEEFFF6D83E7FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516B + E2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FFC6CF + F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC6CFF6FF516B + E2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516BE2FF516B + E2FF516BE2FF516BE2FF516BE2FF516BE2FF6D83E7FF9FAEEFFF8395E6FF3D57 + CFFF3D57CFFF3D57CFB5FFFFFF00FFFFFF003C55CDD93C55CDFF3C55CDFF8FA0 + EAFF9EADEFFF6078E4FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69 + E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FFB5C0 + F2FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB4BFF2FF4F69 + E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF4F69 + E1FF4F69E1FF4F69E1FF4F69E1FF4F69E1FF6078E4FF9EADEFFF8FA0EAFF3C55 + CDFF3C55CDFF3C55CDD9FFFFFF00FFFFFF003B54CBF13B54CBFF3B54CBFF98A7 + ECFF9DACEEFF576FE2FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67 + E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FFA4B1 + EFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA4B1EFFF4D67 + E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF4D67 + E0FF4D67E0FF4D67E0FF4D67E0FF4D67E0FF5971E2FF9DACEEFF96A6ECFF3B54 + CBFF3B54CBFF3B54CBEDFFFFFF00FFFFFF003953C9FF3953C9FF3953C9FF9DAA + EDFF9DAAEDFF526ADFFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65 + DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF91A0 + EBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF91A0EBFF4C65 + DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF4C65 + DEFF4C65DEFF4C65DEFF4C65DEFF4C65DEFF546CDFFF9DAAEDFF9BA8ECFF3953 + C9FF3953C9FF3953C9F9FFFFFF00FFFFFF003851C7FF3851C7FF3851C7FF9CAA + ECFF9CAAECFF5069DEFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64 + DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF7E90 + E7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7F91E7FF4A64 + DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF4A64 + DDFF4A64DDFF4A64DDFF4A64DDFF4A64DDFF526BDEFF9CAAECFF9AA8EBFF3851 + C7FF3851C7FF3851C7F9FFFFFF00FFFFFF003750C6F13750C6FF3750C6FF96A4 + EAFF9BA9ECFF526BDEFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862 + DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF6D81 + E3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6D81E3FF4862 + DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862DCFF4862 + DCFF4862DCFF4862DCFF4862DCFF4862DCFF546CDEFF9BA9ECFF94A3E9FF3750 + C6FF3750C6FF3750C6EDFFFFFF00FFFFFF00364FC4D9364FC4FF364FC4FF8B9B + E5FF9AA8EBFF5970DEFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760 + DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF586F + DDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF586FDDFF4760 + DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760DAFF4760 + DAFF4760DAFF4760DAFF4760DAFF4760DAFF5970DEFF9AA8EBFF8B9BE5FF364F + C4FF364FC4FF364FC4D9FFFFFF00FFFFFF00354DC2B4354DC2FF354DC2FF7C8D + DEFF99A7EAFF6378DFFF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455E + D9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF4760 + D9FFFDFDFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFDFFFF4760D9FF455E + D9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455ED9FF455E + D9FF455ED9FF455ED9FF455ED9FF455ED9FF6378DFFF99A7EAFF7C8DDEFF354D + C2FF354DC2FF354DC2B5FFFFFF00FFFFFF00344CC08C344CC0FF344CC0FF6B7D + D7FF98A6EAFF7486E2FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C + D8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C + D8FFEDF0FBFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEEF0FBFF435CD8FF435C + D8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435CD8FF435C + D8FF435CD8FF435CD8FF435CD8FF435CD8FF7486E2FF98A6EAFF6B7DD7FF344C + C0FF344CC0FF344CC08CFFFFFF00FFFFFF00334BBE4F334BBEFF334BBEFF495F + C8FF97A5E9FF8999E6FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B + D7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B + D7FFDADFF7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDADFF7FF415BD7FF415B + D7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415BD7FF415B + D7FF415BD7FF415BD7FF415BD7FF415BD7FF8999E6FF97A5E9FF495FC8FF334B + BEFF334BBEFF334BBE4FFFFFFF00FFFFFF00324ABC10324ABCFC324ABCFF324A + BCFF92A0E6FF96A4E8FF5067D9FF4059D5FF4059D5FF4059D5FF4059D5FF4059 + D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059 + D5FF677BDEFF7385E0FF7385E0FF7385E0FF7385E0FF677BDEFF4059D5FF4059 + D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059D5FF4059 + D5FF4059D5FF4059D5FF4059D5FF5067D9FF96A4E8FF92A0E6FF324ABCFF324A + BCFF324ABCFC324ABC11FFFFFF00FFFFFF003148BA003148BAB83148BAFF3148 + BAFF6C7ED5FF95A3E7FF7688E0FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 + D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 + D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 + D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57D4FF3E57 + D4FF3E57D4FF3E57D4FF3E57D4FF7688E0FF95A3E7FF6D7ED5FF3148BAFF3148 + BAFF3148BAB93148BA00FFFFFF00FFFFFF003047B8003047B85B3047B8FF3047 + B8FF3E53BEFF94A2E7FF94A2E7FF475FD5FF3C56D3FF3C56D3FF3C56D3FF3C56 + D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56 + D3FF92A0E6FF97A5E8FF97A5E8FF97A5E8FF97A5E8FF97A5E8FF475FD5FF3C56 + D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56D3FF3C56 + D3FF3C56D3FF3C56D3FF475FD5FF94A2E7FF94A2E7FF3E53BEFF3047B8FF3047 + B8FF3047B85C3047B800FFFFFF00FFFFFF002F46B7002F46B7082F46B7E62F46 + B7FF2F46B7FF7384D7FF93A1E6FF788AE0FF3B54D2FF3B54D2FF3B54D2FF3B54 + D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54 + D2FFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5268D7FF3B54 + D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54D2FF3B54 + D2FF3B54D2FF3B54D2FF788AE0FF93A1E6FF7384D7FF2F46B7FF2F46B7FF2F46 + B7E62F46B7082F46B700FFFFFF00FFFFFF002E45B5002E45B5002E45B5712E45 + B5FF2E45B5FF384EBAFF8C9BE2FF92A1E5FF576DD7FF3953D0FF3953D0FF3953 + D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953 + D0FFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5067D6FF3953 + D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953D0FF3953 + D0FF3953D0FF576DD7FF92A1E5FF8C9CE2FF384EBAFF2E45B5FF2E45B5FF2E45 + B5722E45B5002E45B500FFFFFF00FFFFFF002D43B3002D43B3002D43B3082D43 + B3DD2D43B3FF2D43B3FF596BC9FF929FE5FF8F9DE4FF4F65D5FF3851CFFF3851 + CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851 + CFFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4F65D5FF3851 + CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851CFFF3851 + CFFF4F65D5FF8F9DE4FF929FE5FF5A6CC9FF2D43B3FF2D43B3FF2D43B3DD2D43 + B3082D43B3002D43B300FFFFFF00FFFFFF002C42B1002C42B1002C42B1002C42 + B14A2C42B1FF2C42B1FF2C42B1FF6D7DD2FF919EE4FF8897E2FF4C62D3FF364F + CEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364F + CEFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4E64D4FF364F + CEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF364FCEFF4C62 + D3FF8897E2FF919EE4FF6D7DD2FF2C42B1FF2C42B1FF2C42B1FF2C42B14B2C42 + B1002C42B1002C42B100FFFFFF00FFFFFF002B41B0002B41B0002B41B0002B41 + B0002B41B09C2B41B0FF2B41B0FF2B41B0FF7283D5FF909EE4FF8A98E2FF4F65 + D3FF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354E + CDFFF3F5FCFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF4D63D3FF354E + CDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF354ECDFF4F65D3FF8A98 + E2FF909EE4FF7283D5FF2B41B0FF2B41B0FF2B41B0FF2B41B09E2B41B0002B41 + B0002B41B0002B41B000FFFFFF00FFFFFF002A40AE002A40AE002A40AE002A40 + AE002A40AE0A2A40AECF2A40AEFF2A40AEFF2A40AEFF7081D3FF8F9DE3FF8D9B + E2FF546AD4FF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334D + CCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF334D + CCFF334DCCFF334DCCFF334DCCFF334DCCFF334DCCFF546AD4FF8D9BE2FF8F9D + E3FF7081D3FF2A40AEFF2A40AEFF2A40AEFF2A40AECF2A40AE0A2A40AE002A40 + AE002A40AE002A40AE00FFFFFF00FFFFFF00293FAD00293FAD00293FAD00293F + AD00293FAD00293FAD1C293FADE0293FADFF293FADFF293FADFF697ACEFF8E9C + E2FF8E9CE2FF7283DBFF3D55CEFF324BCBFF324BCBFF324BCBFF324BCBFF324B + CBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324BCBFF324B + CBFF324BCBFF324BCBFF324BCBFF3D55CEFF7283DBFF8E9CE2FF8E9CE2FF697A + CEFF293FADFF293FADFF293FADFF293FADE0293FAD1C293FAD00293FAD00293F + AD00293FAD00293FAD00FFFFFF00FFFFFF00283EAB00283EAB00283EAB00283E + AB00283EAB00283EAB00283EAB22283EABDD283EABFF283EABFF283EABFF5466 + C3FF8896DFFF8E9CE2FF8E9CE2FF6D7FD9FF435ACFFF314ACAFF314ACAFF314A + CAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314ACAFF314A + CAFF314ACAFF435ACFFF6D7FD9FF8E9CE2FF8E9CE2FF8796DEFF5366C2FF283E + ABFF283EABFF283EABFF283EABDD283EAB22283EAB00283EAB00283EAB00283E + AB00283EAB00283EAB00FFFFFF00FFFFFF00273DAA00273DAA00273DAA00273D + AA00273DAA00273DAA00273DAA00273DAA18273DAACD273DAAFF273DAAFF273D + AAFF3146AFFF6D7DD0FF8D9BE1FF8D9BE1FF8D9BE1FF7E8EDDFF6678D7FF5166 + D2FF475DCFFF3E55CDFF3951CBFF3951CBFF3E55CDFF475DCFFF5166D2FF6678 + D7FF7E8EDDFF8D9BE1FF8D9BE1FF8D9BE1FF6D7DD0FF3146AFFF273DAAFF273D + AAFF273DAAFF273DAACD273DAA18273DAA00273DAA00273DAA00273DAA00273D + AA00273DAA00273DAA00FFFFFF00FFFFFF00273CA800273CA800273CA800273C + A800273CA800273CA800273CA800273CA800273CA808273CA899273CA8FF273C + A8FF273CA8FF273CA8FF3549B0FF6374CAFF8998DFFF8D9BE1FF8D9BE1FF8D9B + E1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9BE1FF8D9B + E1FF8D9BE1FF8998DFFF6374CAFF3549B0FF273CA8FF273CA8FF273CA8FF273C + A8FF273CA898273CA808273CA800273CA800273CA800273CA800273CA800273C + A800273CA800273CA800FFFFFF00FFFFFF00263BA700263BA700263BA700263B + A700263BA700263BA700263BA700263BA700263BA700263BA700263BA74A263B + A7DC263BA7FF263BA7FF263BA7FF263BA7FF263BA7FF3D50B4FF5E6FC7FF6E7E + D0FF7C8BD8FF8594DDFF8A98E0FF8A98E0FF8594DDFF7C8BD8FF6E7ED0FF5E6F + C7FF3D50B4FF263BA7FF263BA7FF263BA7FF263BA7FF263BA7FF263BA7DC263B + A749263BA700263BA700263BA700263BA700263BA700263BA700263BA700263B + A700263BA700263BA700FFFFFF00FFFFFF00253AA600253AA600253AA600253A + A600253AA600253AA600253AA600253AA600253AA600253AA600253AA600253A + A609253AA672253AA6E6253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253A + A6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6FF253A + A6FF253AA6FF253AA6FF253AA6FF253AA6FF253AA6E6253AA672253AA609253A + A600253AA600253AA600253AA600253AA600253AA600253AA600253AA600253A + A600253AA600253AA600FFFFFF00FFFFFF002439A5002439A5002439A5002439 + A5002439A5002439A5002439A5002439A5002439A5002439A5002439A5002439 + A5002439A5002439A5072439A55B2439A5BA2439A5FC2439A5FF2439A5FF2439 + A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439A5FF2439 + A5FF2439A5FF2439A5FC2439A5BA2439A55B2439A5072439A5002439A5002439 + A5002439A5002439A5002439A5002439A5002439A5002439A5002439A5002439 + A5002439A5002439A500FFFFFF00FFFFFF002439A4002439A4002439A4002439 + A4002439A4002439A4002439A4002439A4002439A4002439A4002439A4002439 + A4002439A4002439A4002439A4002439A4002439A4112439A4502439A48B2439 + A4B52439A4D72439A4EE2439A4FA2439A4FA2439A4EE2439A4D72439A4B52439 + A48B2439A4502439A4112439A4002439A4002439A4002439A4002439A4002439 + A4002439A4002439A4002439A4002439A4002439A4002439A4002439A4002439 + A4002439A4002439A400FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object IconSmall: TImageList + left = 27 + top = 328 + Bitmap = { + 4C69030000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D898 + 5223D4964D7DD2924CDBCD8C45F3CB8B41F3C98B40DBC78B407DC5873D23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D6974F53D191 + 49E6D0A06AFFE0BFA0FFE3C5AEFFE3C5AEFFDFBC9FFFC89762FFBD7D35E6BC7E + 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D4964D53CF8D47F4D9B2 + 8CFFE6CDB8FFE0BA9DFFD7AB85FFD6A982FFD9B391FFE1C2ABFFD4AE86FFB16B + 35F4B16F3553FFFFFF00FFFFFF00FFFFFF00D2934C22CE8E47E5D9B28CFFE6CA + B3FFD6A97DFFD1A579FFE2C4A8FFE1C3A8FFD0A276FFD1A477FFDDBDA2FFD0AC + 85FFAB6635E5A9653522FFFFFF00FFFFFF00CE91477ECD9C68FFE7CBB4FFD4A5 + 7AFFD0A077FFCF9E74FFFBF8F5FFFBF8F5FFCB9E71FFCB9D71FFCDA177FFDFC0 + A5FFB98A5BFFA45C347EFFFFFF00FFFFFF00CB8E41DBE0BC9FFFDBB393FFCFA0 + 75FFCD9E72FFCB9C71FFDDBFA3FFDDBFA2FFC5996BFFC5996BFFC4986BFFD1AB + 85FFD8BA97FF9E5635DBFFFFFF00FFFFFF00C5853BF6E4C9B0FFD0A37AFFCC9D + 71FFC79A6CFFC5986BFFFFFFFFFFFFFFFEFFC39669FFC19468FFC29468FFC398 + 6DFFDFC5ABFF955334F6FFFFFF00FFFFFF00BF7E35F6E3C7AFFFD0A276FFC599 + 6BFFC4976AFFC49669FFEEE0D4FFFBF7F4FFBF9066FFBE8F65FFBE8F64FFBE92 + 69FFDFC6AAFF925034F6FFFFFF00FFFFFF00BC7E35DBDBBC9CFFD5AD89FFC798 + 6CFFC39569FFC19367FFEDDFD3FFFAF7F4FFBB8B63FFB98A63FFB88A62FFC59D + 78FFD2B893FF905135DBFFFFFF00FFFFFF00B878357EBF915EFFE0C2A8FFC596 + 6CFFC29169FFE1CBB8FFFEFDFCFFFFFFFEFFEADCD0FFB4855EFFB3855EFFD4B5 + 99FFAE7B56FF8F51357EFFFFFF00FFFFFF00AF703522AB6935E5CFAA81FFDABC + A2FFBE9166FFBA8C62FFB7895FFFB3845EFFB1835DFFB0835CFFCDAA8DFFC6A5 + 79FF895034E589503522FFFFFF00FFFFFF00FFFFFF00A76234539F5533F4CBA7 + 7DFFD8BB9FFFC39C77FFB68A62FFB48660FFBE9672FFD1B397FFC5A377FF844F + 35F489503553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009F5634539955 + 34E6B28057FFD5B793FFDBC3A6FFDAC3A6FFD2B490FFAB7A52FF864F34E68850 + 3553FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009754 + 35239453347D925234DB8A5034F3884F34F3895035DB8950357D84503623FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006A85 + FC236984FA7D6782F9DB6580F7F3637EF5F3617CF3DB5F7AF17D5D77EF23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006984FA536C85 + F9E76E83EEFF92A6F4FFA0B4F8FFA0B4F8FF91A6F3FF687DE9FF5D76EBE65671 + E953FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006883F953748DF9F58497 + F1FFA9BDFBFF8AA3F8FF6B89F6FF6B89F6FF89A2F8FFA8BCFAFF7F92ECFF6279 + E6F54F69E253FFFFFF00FFFFFF00FFFFFF006781F8226983F6E68397F0FFACBF + FBFF6382F5FF6382F5FF6382F5FF617EF3FF617EF3FF607CF3FFA6B9F9FF7B8D + EAFF4D66DFE54862DB22FFFFFF00FFFFFF00637EF57E6C81ECFFA9BDFBFF6382 + F5FF8099F7FFA4B6F9FF6280F4FF607BF1FFA5B4F7FF7B8FF3FF5D76EFFFA5B5 + F8FF5D70DDFF435DD77EFFFFFF00FFFFFF005F7AF1DB91A6F3FF88A1F8FF6280 + F4FFA4B5F8FFE7EBFDFFA8B8F8FFABB8F7FFE7EBFDFF9EACF5FF5B70ECFF8293 + F1FF8998ECFF3E58D2DBFFFFFF00FFFFFF005B76EDF6A1B6F8FF6784F4FF607C + F3FF5F7AF1FFA8B5F7FFE7EBFDFFE7EAFCFFA1ADF4FF5A6EEBFF596CEAFF5F6F + E9FF9BA8F1FF3A53CEF6FFFFFF00FFFFFF005771E9F6A0B3F7FF6580F2FF5F78 + F0FF5E77EFFFAAB6F6FFE7EAFCFFE6E9FCFFA5AFF4FF5869E8FF5767E7FF5D6C + E7FF99A5F1FF354FCAF6FFFFFF00FFFFFF00526DE5DB8E9FF0FF8499F4FF5C73 + EEFFA4AFF4FFE6E9FCFFA1ADF4FFA3ACF2FFE6E8FBFF9CA5F0FF5562E5FF7D89 + EBFF8591E7FF314AC6DBFFFFFF00FFFFFF004E68E17E6073E0FFA4B3F7FF5A6E + EBFF7685EEFF9BA5F1FF5869E8FF5562E5FF9CA3F0FF6F7AE8FF535FE2FF9FA9 + F2FF5061D1FF2D46C27EFFFFFF00FFFFFF004963DC224B64DBE67888E6FFA7B3 + F5FF5767E7FF5665E6FF5665E6FF535FE2FF535FE2FF525DE1FF9FA9F2FF6F7D + DDFF2D46C1E52942BE22FFFFFF00FFFFFF00FFFFFF00425CD5533F59D3F47584 + E3FFA1ACF4FF7F8BECFF5C67E4FF5B66E3FF7D87EAFF9FA8F1FF6F7CDDFF2943 + BFF42741BD53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003A54CF533852 + CCE65264D4FF8490E7FF95A0EEFF959FEDFF838EE5FF4C5DCEFF2841BDE6263F + BB53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00334D + C823314BC67D2F48C4DB2C46C2F32A44C0F32842BEDB2640BC7D243EBA23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0040C9 + 62233BC55E7D39C25BDB31BD54F32DBB52F32BB952DB2BB7527D28B44E23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003DC7605336C2 + 59E659C274FF96D7A3FFA5DCAEFFA5DCAEFF95D6A1FF50B96AFF1FAB42E61FA9 + 4253FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003BC55E5334C055F47FCE + 90FFAFE1B7FF92D89DFF77CE83FF77CE83FF92D89DFFAEE1B5FF78C88BFF1D9D + 32F41D9D3653FFFFFF00FFFFFF00FFFFFF0039C25C2234BE55E57FCE90FFAEE1 + B5FF6DCC7AFF6ACA76FF68C872FF68C874FF68C875FF6BC979FFACDFB4FF76C4 + 89FF1C962DE51C942D22FFFFFF00FFFFFF0034BE597E57BF70FFAFE1B7FF6DCC + 7AFF68C872FF65C770FF63C56EFF62C46EFF63C471FFB6E3BEFF6FC77EFFACDF + B5FF48A95EFF1C8F267EFFFFFF00FFFFFF002DBB54DB95D7A1FF91D79BFF69C9 + 76FF64C66FFF61C46EFF61C36FFF61C26FFFB9E4C0FFFFFFFFFFE3F4E6FF8BD1 + 99FF8BCE9DFF1C8820DBFFFFFF00FFFFFF0026B44BF6A7DDB1FF72CC80FF66C7 + 73FFB0E1B7FFD2EED6FF63C170FFB8E3BFFFFFFFFFFFFBFDFCFF8CD099FF69C1 + 7EFFA1D7AEFF1B7F1EF6FFFFFF00FFFFFF001FAD42F6A6DCAFFF70CA7FFF73CA + 80FFF0F9F1FFFFFFFFFFEBF7EDFFFFFFFFFFFBFDFCFF88CD96FF5BB971FF67BE + 7DFFA0D7AFFF1B7A1EF6FFFFFF00FFFFFF001FA942DB91D29FFF8DD49AFF64C3 + 74FF79C987FFF2FAF4FFFFFFFFFFFDFEFDFF86CB96FF57B76DFF5BB972FF85CC + 97FF87C79AFF1B781FDBFFFFFF00FFFFFF001EA43D7E4CB064FFAADDB4FF64C1 + 79FF5FBE71FF75C585FFD4ECD9FF8ACD99FF56B66CFF58B56EFF5CB774FFA6DA + B4FF419B4EFF1B771F7EFFFFFF00FFFFFF001D9B36221C962FE572C287FFA8DB + B2FF60BC77FF5CBA73FF59B870FF59B56FFF58B56FFF5BB774FFA5D9B3FF69B8 + 7FFF1A711EE51B711F22FFFFFF00FFFFFF00FFFFFF001C912B531B8A20F46DBE + 83FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB98FFA5D9B4FF66B77DFF1A6C + 1DF41B711F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C8A21531B83 + 1FE642A052FF87CA9AFF9BD3ABFF9BD2ABFF83C796FF3D974CFF1A6E1EE61B70 + 1F53FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C81 + 1F231B7E1F7D1B7A1FDB1A731EF31A701EF31B711FDB1B711F7D1B6C1F23FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00 + } + end + object pmEditURL: TPopupMenu + OnPopup = pmEditURLPopup + left = 592 + top = 136 + object medURLUndo: TMenuItem + Caption = 'Undo' + OnClick = medURLUndoClick + end + object MenuItem9: TMenuItem + Caption = '-' + end + object medURLCut: TMenuItem + Caption = 'Cut' + OnClick = medURLCutClick + end + object medURLCopy: TMenuItem + Caption = 'Copy' + OnClick = medURLCopyClick + end + object medURLPaste: TMenuItem + Caption = 'Paste' + OnClick = medURLPasteClick + end + object medURLPasteandgo: TMenuItem + Caption = 'Paste and go' + OnClick = medURLPasteandgoClick + end + object medtURLDelete: TMenuItem + Caption = 'Delete' + OnClick = medtURLDeleteClick + end + object MenuItem15: TMenuItem + Caption = '-' + end + object medURLSelectAll: TMenuItem + Caption = 'Select all' + OnClick = medURLSelectAllClick + end + end + object appPropertiesMain: TApplicationProperties + CaptureExceptions = False + OnShowHint = appPropertiesMainShowHint + left = 392 + top = 312 + end + object tmExitCommand: TTimer + Enabled = False + OnTimer = tmExitCommandTimer + left = 560 + top = 472 + end + object TransferRateGraphList: TListChartSource + DataPoints.Strings = ( + '1|0|?|' + ) + left = 504 + top = 120 + end + object TransferRateToolset: TChartToolset + left = 464 + top = 120 + end + object pmSbMain: TPopupMenu + OnPopup = pmSbMainPopup + left = 152 + top = 376 + object miAbortSilentThread: TMenuItem + Caption = 'Abort' + OnClick = miAbortSilentThreadClick + end + end + object pmFilterGenreAll: TPopupMenu + left = 520 + top = 168 + object mnFilterGenreAllCheck: TMenuItem + Caption = 'Check all' + OnClick = mnFilterGenreAllCheckClick + end + object mnFilterGenreAllUncheck: TMenuItem + Caption = 'Uncheck all' + OnClick = mnFilterGenreAllUncheckClick + end + object mnFilterGenreAllIndeterminate: TMenuItem + Caption = 'Indeterminate all' + OnClick = mnFilterGenreAllIndeterminateClick + end + end + object pmTray: TPopupMenu + OnPopup = pmTrayPopup + left = 341 + top = 432 + object miTrayResumeAll: TMenuItem + Caption = 'Resume all' + OnClick = tbDownloadResumeAllClick + end + object miTrayStopAll: TMenuItem + Caption = 'Stop all' + OnClick = tbDownloadStopAllClick + end + object miTrayAfterDownloadFinish: TMenuItem + Caption = 'After download finish' + object miTrayFinishNothing: TMenuItem + AutoCheck = True + Caption = 'Nothing' + RadioItem = True + OnClick = miTrayFinishNothingClick + end + object miTrayFinishExit: TMenuItem + Tag = 1 + AutoCheck = True + Caption = 'Exit' + RadioItem = True + OnClick = miTrayFinishNothingClick + end + object miTrayFinishShutdown: TMenuItem + Tag = 2 + AutoCheck = True + Caption = 'Shutdown' + RadioItem = True + OnClick = miTrayFinishNothingClick + end + object miTrayFinishHibernate: TMenuItem + Tag = 3 + AutoCheck = True + Caption = 'Hibernate' + RadioItem = True + OnClick = miTrayFinishNothingClick + end + end + object MenuItem8: TMenuItem + Caption = '-' + end + object miTrayShowDropBox: TMenuItem + AutoCheck = True + Caption = 'Show Drop Box' + Checked = True + OnClick = miTrayShowDropBoxClick + end + object miTrayRestore: TMenuItem + Caption = 'Restore' + OnClick = TrayIconDblClick + end + object MenuItem10: TMenuItem + Caption = '-' + end + object miTrayExit: TMenuItem + Caption = 'Exit' + OnClick = miTrayExitClick + end + end + object tmAnimateMangaInfo: TTimer + Enabled = False + Interval = 48 + OnTimer = tmAnimateMangaInfoTimer + left = 656 + top = 416 + end + object tmRefreshDownloadsInfo: TTimer + Enabled = False + OnTimer = tmRefreshDownloadsInfoTimer + OnStartTimer = tmRefreshDownloadsInfoStartTimer + OnStopTimer = tmRefreshDownloadsInfoStopTimer + left = 440 + top = 472 + end + object tmBackup: TTimer + Interval = 120000 + OnTimer = tmBackupTimer + left = 656 + top = 472 + end + object tmCheckFavorites: TTimer + Enabled = False + Interval = 600000 + OnTimer = tmCheckFavoritesTimer + left = 480 + top = 472 + end + object IconDLLeft: TImageList + Height = 24 + Width = 24 + left = 272 + top = 232 + Bitmap = { + 4C69040000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000003522 + 0C00A1692500DA8F3400DE933700E1963A00E59A3C00E89D3E00EA9F4066EA9F + 4066E89D3E00E59A3C00E1963A00DE933700DA8F3400A169250035220C000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009A622000D186 + 2D00D68B3100DA8F3400DE933700E1963A00E59A3C00E89D3E66E89D3ECCE89D + 3ECCE89D3E66E59A3C00E1963A00DE933700DA8F3400D68B3100D1862D009A62 + 2000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D00D68B3100DA8F3400DE933700E1963A00E59A3C66E59A3CCCFFE599FFFFE4 + 98FFE59A3CCCE59A3C66E1963A00DE933700DA8F3400D68B3100D1862D00CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D00D68B3100DA8F3400DE933700E1963A66E1963ACCFFE498FFFCD185FFFCD1 + 85FFFFE397FFE1963ACCE1963A66DE933700DA8F3400D68B3100D1862D00CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D00D68B3100DA8F3400DE933766DE9337CCFFE397FFF8CA7EFFF6C276FFF6C2 + 76FFF8C97DFFFEE195FFDE9337CCDE933766DA8F3400D68B3100D1862D00CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D00D68B3100DA8F3466DA8F34CCFEE195FFF4C276FFF1B86CFFF1B86CFFF1B8 + 6CFFF1B86CFFF4C175FFFDDD91FFDA8F34CCDA8F3466D68B3100D1862D00CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D00D68B3166D68B31CCFDE094FFF2BE72FFEEB367FFEEB367FFEEB367FFEEB3 + 67FFEEB367FFEEB367FFF2BC70FFFBD88CFFD68B31CCD68B3166D1862D00CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00D186 + 2D66D1862DCCFDDE92FFF2BD71FFEEB266FFECB064FFE3A75BFFD99D51FFD498 + 4CFFCF9347FFCD9145FFCD9145FFD7A155FFF1CC80FFD1862DCCD1862D66CD82 + 2A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00CC812A66CD82 + 2ACCFCDD91FFF9D185FFF4C579FFECBD71FFE1B266FFCC9044FFCC9044FFCC90 + 44FFCC9044FFD59E52FFDDAC60FFDCAB5FFFE4B86CFFEBC478FFCD822ACCCC81 + 2A66FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C97E2799C87D + 26CCC87D26CCC87D26CCC87D26CCC87D26CCF1CD81FFCC9044FFCC9044FFCC90 + 44FFCC9044FFDCAB5FFFC87D26CCC87D26CCC87D26CCC87D26CCC87D26CCC97E + 2799FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600C77C + 2500C77C2500C77C2500C67B2500C37823CCEFC97CFFCD9142FFCD9142FFCD91 + 42FFCD9142FFDCA95BFFC37823CCC3792300C77C2500C77C2500C77C2500C87D + 2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600C77C + 2500C77C2500C57A2400BE741F00BE741FCCEEC675FFD3943CFFD3943CFFD394 + 3CFFD3943CFFDEA954FFBF7521CDBE741F03C0762100C77C2500C77C2500C87D + 2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600C77C + 2500C4792300BA6F1C00BA6F1C00BA6F1CCBEEC36CFFD99834FFD99834FFD998 + 34FFD99834FFE2AA4BFFBE7521D0BA6F1C0DBA6F1C00BD721E00C77C2500C87D + 2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600C378 + 2200B56A1800B56A1800B56A1800B56A18BDECBC5DFBE09F2CFFE09D2AFFE09D + 2AFFE09D2AFFE6AA3EFFBF7823D4B56A181EB56A1800B56A1800BA6F1B00C87D + 2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BC711D00B065 + 1500B0651500B0651500B0651500B065159EE4AD49F3E9A82AFFE7A220FFE7A2 + 20FFE7A220FFEBAB2FFFC37E25DAB0651536B0651500B0651500B0651500B065 + 1500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00AC611100AC61 + 1100AC611100AC611100AC611100AC611168CE8D2CE3F2B330FFEFA716FFEFA7 + 16FFEFA716FFF0AC1FFFCD8A26E2AB601156AA5F1000AA5F1000AA5F1000AA5F + 1000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A85D0F00A85D + 0F00A85D0F00A85D0F00A85D0F00A85D0F20AF6613C8F3B635FBF6AE10FFF6AC + 0DFFF6AC0DFFF6AE10FFE2A027F0A75C0E8CA75C0E00A75C0E00A75C0E00A75C + 0E00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000007C440900A4590C00A4590C00A3580B73C8831BE0FCB81EFFFBB0 + 06FFFBB006FFFBB006FFF6B31EFBA95F0CBDA2570A0BA2570A00A2570A00A257 + 0A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 00000000000000000000291603007A420800A1560A0FA05508A2D28D17E7FEB8 + 12FFFFB301FFFFB201FFFFB70FFFC37B10DEA055084B9F5407007E4105005C2E + 0200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 00000000000000000000000000000000000028160300773E05169C5106A2C57D + 0FE0F7B012FBFFB405FFFFB404FFEEA712F6A15607AF9B5005106F3803005C2E + 0200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 00000000000100000004000000070000000B0000000F0000001327140125793E + 0382A25806C9C8800CE3E9A00CF3F8B00EFBCF860BE6994E04916F3803265C2E + 0200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000000000001000000070000000D000000150000001E000000260000002D0000 + 0032311901476633027D8F4802A5964B02BE974C02CB974C02CC7139029F4C26 + 0100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 00000000000100000004000000070000000B0000000F00000013000000170000 + 00190000001A0000001A0000001A0000001A0000001A0000001A000000100000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 000036230D00A46C2800DE933700E1963A00E59A3C00E89D3E00EA9F4066EA9F + 4066E89D3E00E59A3C00E1963A00DE933700A46C280036230D00000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3100DA8F3400DE933700E1963A00E59A3C00E89D3E66E89D3ECCE89D + 3ECCE89D3E66E59A3C00E1963A00DE933700DA8F3400D68B3100D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3100DA8F3400DE933700E1963A00E59A3C66E59A3CCCFFE599FFFFE4 + 98FFE59A3CCCE59A3C66E1963A00DE933700DA8F3400D68B3100D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3100DA8F3400DE933700E1963A66E1963ACCFFE498FFFCD286FFFCD2 + 86FFFFE397FFE1963ACCE1963A66DE933700DA8F3400D68B3100D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3100DA8F3400DE933766DE9337CCFFE397FFF9CC80FFF7C478FFF7C4 + 78FFF9CB7FFFFEE195FFDE9337CCDE933766DA8F3400D68B3100D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3100DA8F3466DA8F34CCFEE296FFF6C579FFF3BC70FFF3BC70FFF3BC + 70FFF3BC70FFF6C478FFFDDD91FFDA8F34CCDA8F3466D68B3100D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D00D68B3166D68B31CCFDE094FFF3BF73FFF0B569FFF0B569FFF0B569FFF0B5 + 69FFF0B569FFF0B569FFF3BE72FFFBD98DFFD68B31CCD68B3166D1862D00CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CD822A00D186 + 2D66D1862DCCFDDE92FFF2BD71FFEEB266FFEEB266FFEEB266FFEEB266FFEEB2 + 66FFEEB266FFEEB266FFEEB266FFF1BB6FFFFAD589FFD1862DCCD1862D66CD82 + 2A00C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2600CC812A66CD82 + 2ACCFCDD91FFF2BD71FFEEB266FFEEB266FFECB064FFE3A75BFFD99D51FFD498 + 4CFFCF9347FFCD9145FFCD9145FFCF9347FFD9A256FFF0C97DFFCD822ACCCC81 + 2A66C87D2600FFFFFF00FFFFFF00FFFFFF00FFFFFF00C87D2666C87D26CCFCDB + 8FFFF8D084FFF5C67AFFF3C478FFEABB6FFFE0B064FFCC9044FFCC9044FFCC90 + 44FFCC9044FFD49D51FFDBAA5EFFDBA95DFFDBA85CFFE2B367FFE8BE72FFC87D + 26CCC87D2666FFFFFF00FFFFFF00FFFFFF00FFFFFF00C4792499C37823CCC378 + 23CCC37823CCC37823CCC37823CCC37823CCEEC97DFFCC9044FFCC9044FFCC90 + 44FFCC9044FFDBA95DFFC37823CCC37823CCC37823CCC37823CCC37823CCC378 + 23CCC4792499FFFFFF00FFFFFF00FFFFFF00FFFFFF00C3782300C2772200C277 + 2200C2772200C2772200C1762100BE741FCCECC577FFCF9241FFCF9241FFCF92 + 41FFCF9241FFDBA758FFBE741FCCC1762100C2772200C2772200C2772200C277 + 2200C3782300FFFFFF00FFFFFF00FFFFFF00FFFFFF00C3782300C2772200C277 + 2200C2772200C0752100BA6F1C00BA6F1CCCEDC26FFFD49539FFD49539FFD495 + 39FFD49539FFDEA850FFBA6F1CCCBA6F1C00C0752100C2772200C2772200C277 + 2200C3782300FFFFFF00FFFFFF00FFFFFF00FFFFFF00C3782300C2772200C277 + 2200BF742000B56A1800B56A1800B56A18CCEEC165FFDB9A30FFDB9A30FFDB9A + 30FFDB9A30FFE3AA46FFB56A18CCB56A1800B56A1800BF742000C2772200C277 + 2200C3782300FFFFFF00FFFFFF00FFFFFF00FFFFFF00C3782300C2772200BE73 + 1F00B0651500B0651500B0651500B06515CCF0BF5AFFE3A025FFE3A025FFE3A0 + 25FFE3A025FFE9AC3AFFB06515CCB0651500B0651500B0651500BE731F00C277 + 2200C3782300FFFFFF00FFFFFF00FFFFFF00FFFFFF00C3782300BC711E00AC61 + 1100AC611100AC611100AC611100AC6111CCF3BF4EFFEBA51AFFEBA51AFFEBA5 + 1AFFEBA51AFFEFB02EFFAC6111CCAC611100AC611100AC611100AC611100BC71 + 1E00C3782300FFFFFF00FFFFFF00FFFFFF00FFFFFF00B56A1800A75C0E00A75C + 0E00A75C0E00A75C0E00A75C0E00A75C0ECCF7BF40FFF3AA10FFF3AA10FFF3AA + 10FFF3AA10FFF5B322FFA75C0ECCA75C0E00A75C0E00A75C0E00A75C0E00A75C + 0E00B56A1800FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00007B430800A3580B00A3580B00A3580BCCFBBF34FFFAAE07FFFAAE07FFFAAE + 07FFFAAE07FFFBB518FFA3580BCCA3580B00A3580B007B430800000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00000000000078400700A0550800A05508CCFFBF29FFFEB201FFFEB201FFFEB2 + 01FFFEB201FFFEB710FFA05508CCA05508007840070000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00000000000000000000763D05009C5106CCFFBE22FFFFB200FFFFB200FFFFB2 + 00FFFFB200FFFFB60CFF9C5106CC763D05000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0001000000060000000C00000012994E04CCFFBC1CFFFFB60DFFFFB60CFFFFB6 + 0BFFFFB60AFFFFB70FFF994E04CC000000130000000C00000006000000010000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00020000000B0000001800000024713902A5974C02CC974C02CC974C02CC974C + 02CC974C02CC974C02CC713902A500000025000000180000000B000000020000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0001000000060000000C00000012000000180000001A0000001A0000001A0000 + 001A0000001A0000001A00000018000000130000000C00000006000000010000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E99E3F00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00EA9F4099EA9F40CCEA9F40CCEA9F40CCEA9F + 40CCEA9F40CCEA9F40CCEA9F4099E99E3F00E99E3F00E99E3F00E99E3F00E99E + 3F00E99E3F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E89D3E00E89D + 3E00E89D3E00E89D3E00E89D3E00E89D3ECCFFE599FFFFE599FFFFE599FFFFE4 + 98FFFFE498FFFFE498FFE89D3ECCE89D3E00E89D3E00E89D3E00E89D3E00E89D + 3E00E89D3E00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E59A3C00E59A3C00E59A + 3C00E59A3C00E59A3C00E59A3C00E59A3CCCFFE498FFFBCB7FFFFBCB7FFFFBCB + 7FFFFBCB7FFFFDD78BFFE59A3CCCE59A3C00E59A3C00E59A3C00E59A3C00E59A + 3C00E59A3C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E1963A00E1963A00E196 + 3A00E1963A00E1963A00E1963A00E1963ACCFFE397FFF6C276FFF6C276FFF6C2 + 76FFF6C276FFFAD185FFE1963ACCE1963A00E1963A00E1963A00E1963A00E196 + 3A00E1963A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00DE933700DE933700DE93 + 3700DE933700DE933700DE933700DE9337CCFEE195FFF1B86CFFF1B86CFFF1B8 + 6CFFF1B86CFFF7CB7FFFDE9337CCDE933700DE933700DE933700DE933700DE93 + 3700DE933700FFFFFF00FFFFFF00FFFFFF00FFFFFF00CD822A00DA8F3400DA8F + 3400DA8F3400DA8F3400DA8F3400DA8F34CCFDDE92FFEEB367FFEEB367FFEEB3 + 67FFEEB367FFF5C77BFFDA8F34CCDA8F3400DA8F3400DA8F3400DA8F3400DA8F + 3400CD822A00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE741F00C57B2500D68B + 3100D68B3100D68B3100D68B3100D68B31CCFCDC90FFEEB266FFEEB266FFEEB2 + 66FFEEB266FFF4C579FFD68B31CCD68B3100D68B3100D68B3100D68B3100C57B + 2500BE741F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE741F00BF752000C47A + 2400D1862D00D1862D00D1862D00D1862DCCFBD98DFFE3A75BFFD99D51FFD498 + 4CFFCF9347FFDEAD61FFD1862DCCD1862D00D1862D00D1862D00C47A2400BF75 + 2000BE741F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE741F00BF752000BF75 + 2000C3792300CD822A00CD822A00CD822ACCF1CE82FFCC9044FFCC9044FFCC90 + 44FFCC9044FFDCAB5FFFCD822ACCCD822A00CD822A00C3792300BF752000BF75 + 2000BE741F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE741F00BF752000BF75 + 2000BF752000C2782200C87D2600C87D26CCEEC97DFFCC9044FFCC9044FFCC90 + 44FFCC9044FFDBA95DFFC87D26CCC87D2600C2782200BF752000BF752000BF75 + 2000BE741F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE741F00BF752000BF75 + 2000BF752000BF752000C1762100C37823CCECC577FFCF9241FFCF9241FFCF92 + 41FFCF9241FFDBA758FFC37823CCC1762100BF752000BF752000BF752000BF75 + 2000BE741F00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BE731F99BE741FCCBE74 + 1FCCBE741FCCBE741FCCBE741FCCBE741FCCEDC26FFFD49539FFD49539FFD495 + 39FFD49539FFDEA850FFBE741FCCBE741FCCBE741FCCBE741FCCBE741FCCBE74 + 1FCCBE731F99FFFFFF00FFFFFF00FFFFFF00FFFFFF00BB701C66BA6F1CCCF1C7 + 6FFFF0C66DFFF0C56BFFEFC369FFEEC267FFEEC165FFDB9A30FFDB9A30FFDB9A + 30FFDB9A30FFE3AA46FFEAB95AFFE9B758FFE8B656FFE8B554FFE7B353FFBA6F + 1CCCBB701C66FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00B66B1966B56A + 18CCF2C462FFE3A025FFE3A025FFE3A025FFE3A025FFE3A025FFE3A025FFE3A0 + 25FFE3A025FFE3A025FFE3A025FFE3A025FFE3A025FFECB548FFB56A18CCB66B + 1966BA6F1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00B56A1800B166 + 1566B06515CCF4C354FFEBA51AFFEBA51AFFEBA51AFFEBA51AFFEBA51AFFEBA5 + 1AFFEBA51AFFEBA51AFFEBA51AFFEBA51AFFF1B73DFFB06515CCB1661566B56A + 1800BA6F1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00B56A1800B065 + 1500AD621266AC6111CCF8C145FFF3AA10FFF3AA10FFF3AA10FFF3AA10FFF3AA + 10FFF3AA10FFF3AA10FFF3AA10FFF6B931FFAC6111CCAD621266B0651500B56A + 1800BA6F1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00B56A1800B065 + 1500AC611100A85D0F66A75C0ECCFBC036FFFAAE07FFFAAE07FFFAAE07FFFAAE + 07FFFAAE07FFFAAE07FFFBBA27FFA75C0ECCA85D0F66AC611100B0651500B56A + 1800BA6F1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00B56A1800B065 + 1500AC611100A75C0E00A4590B66A3580BCCFFBF29FFFEB201FFFEB201FFFEB2 + 01FFFEB201FFFEBC1FFFA3580BCCA4590B66A75C0E00AC611100B0651500B56A + 1800BA6F1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF005D380E005B350C005833 + 0B0056310900542E0700A3580B00A0550966A05508CCFFBD20FFFFB200FFFFB2 + 00FFFFBB1AFFA05508CCA0550966A3580B00542E070000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 0000000000000000000000000000502B04009D5206669C5106CCFFBB19FFFFBA + 17FF9C5106CC9D520666502B0400000000000000000000000000000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 000000000000000000040000000B00000013000000196E390377994E04CC994E + 04CC6E39037700000019000000140000000C0000000500000001000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 00000000000000000008000000160000002600000032000000336734027B6734 + 027B000000330000003200000028000000180000000900000001000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF0000000000000000000000 + 000000000000000000040000000B00000013000000190000001A0000001A0000 + 001A0000001A00000019000000140000000C0000000500000001000000000000 + 000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E99E3F00EA9F + 4099EA9F40CCEA9F40CBEA9F40BDEA9F409EEA9F4068E99E3F20E89D3E00E69B + 3D00E3983B00E0953800DF943700DF943700704A1C0000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E89D + 3E1DE89D3E90F4C36EE6FEE093FBFAD181F3F3BE67E3EAA447C8E89D3E73E69B + 3D0FE3983B00E0953800DF943700DF943700DF943700DF943700704A1C00704A + 1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E89D + 3E00E69B3D10E69D40AFFBD889F6FDD88CFFFCCF83FFFCD285FBF0B761E0E59A + 3CA2E3983B16E0953800DF943700DF943700DF943700DF943700DF943700DF94 + 3700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00E89D3E00E59A + 3C00E2973A00E2973A4BEDB35DDEFDDE92FFF8C579FFF8C579FFF9CA7EFFF1BB + 67E7E1963AA2E095380FDF943700DF943700DF943700DF943700DF943700DF94 + 3700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00DF943700DF94 + 3700DF943700DF94370BE0983DBDFCDD8FFBF6C276FFF4BD71FFF4BD71FFF6C3 + 77FFEBB15BE0DE933773DD923600DD923600DD923600DD923600DD923600DD92 + 3600FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00DA8F3400DA8F + 3400DA8F3400DA8F3400DA8F348CF4C978F0F6C77BFFF0B66AFFF0B66AFFF0B6 + 6AFFF4C376FBDE973DC8DA8F3420D98E3300D98E3300D98E3300D98E3300D98E + 3300FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D78C3100D78C + 3100D78C3100D78C3100D78C3156E7B05BE2F7CA7EFFEEB266FFEEB266FFEEB2 + 66FFF0B66AFFE7AD59E3D68B3168D68B3100D68B3100D68B3100D68B3100D68B + 3100FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D1862D00D186 + 2D00D1862D00D1862D00D1862D36DE9F4ADAF8CE82FFEEB266FFEEB266FFEEB2 + 66FFEEB266FFEEBB6CF3D1862D9ED1862D00D1862D00D1862D00D1862D00C67B + 2500FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00C97E + 2700CD822A00CD822A00CD822A1ED5913BD4F8D084FFE3A75BFFD99D51FFD498 + 4CFFCF9347FFDDAB5FFBCD822ABDCD822A00CD822A00CD822A00C0752000BA6F + 1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00BB70 + 1C00C57A2400C87D2600C87D260DCB832DD0EDC77BFFCC9044FFCC9044FFCC90 + 44FFCC9044FFDBA85CFFC87D26CBC87D2600C87D2600BF741F00BB701C00BA6F + 1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00BB70 + 1C00BB701C00C2772200C3782303C47A25CDECC478FFCC9044FFCC9044FFCC90 + 44FFCC9044FFDAA75BFFC37823CCC3782300BE731E00BB701C00BB701C00BA6F + 1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00BA6F1C00BB70 + 1C00BB701C00BB701C00BD721E00BE741FCCEAC171FFD0933FFFD0933FFFD093 + 3FFFD0933FFFDBA654FFBE741FCCBC721D00BB701C00BB701C00BB701C00BA6F + 1C00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B96E1C99BA6F + 1CCCBA6F1CCCBA6F1CCCBA6F1CCCBA6F1CCCEBBF69FFD79737FFD79737FFD797 + 37FFD79737FFDFA74BFFBA6F1CCCBA6F1CCCBA6F1CCCBA6F1CCCBA6F1CCCB96E + 1C99FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B66B1966B56A + 18CCF0C365FFEFC263FFEFC061FFEEBF5FFFEDBE5DFFDF9D2BFFDF9D2BFFDF9D + 2BFFDF9D2BFFE5AA3FFFEAB652FFEAB550FFE9B44EFFE9B34DFFB56A18CCB66B + 1966FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B56A1800B166 + 1566B06515CCF2C157FFE8A31FFFE8A31FFFE8A31FFFE8A31FFFE8A31FFFE8A3 + 1FFFE8A31FFFE8A31FFFE8A31FFFE8A31FFFEEB541FFB06515CCB1661566B56A + 1800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B56A1800B065 + 1500AD621266AC6111CCF6C048FFF0A814FFF0A814FFF0A814FFF0A814FFF0A8 + 14FFF0A814FFF0A814FFF0A814FFF4B735FFAC6111CCAD621266B0651500B56A + 1800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B56A1800B065 + 1500AC611100A85D0F66A75C0ECCFABF38FFF8AD0AFFF8AD0AFFF8AD0AFFF8AD + 0AFFF8AD0AFFF8AD0AFFF9B929FFA75C0ECCA85D0F66AC611100B0651500B56A + 1800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B56A1800B065 + 1500AC611100A75C0E00A4590B66A3580BCCFEBF2AFFFEB102FFFEB102FFFEB1 + 02FFFEB102FFFEBB1FFFA3580BCCA4590B66A75C0E00AC611100B0651500B56A + 1800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005B350C005833 + 0B0056310900542E0700A3580B00A0550966A05508CCFFBD20FFFFB200FFFFB2 + 00FFFFBB1AFFA05508CCA0550966A3580B00542E070000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 0000000000000000000000000000502B04009D5206669C5106CCFFBB19FFFFBA + 17FF9C5106CC9D520666502B0400000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000000000000000000040000000B00000013000000196E390377994E04CC994E + 04CC6E39037700000019000000140000000C0000000500000001000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 00000000000000000008000000160000002600000032000000336734027B6734 + 027B000000330000003200000028000000180000000900000001000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000000000 + 000000000000000000040000000B00000013000000190000001A0000001A0000 + 001A0000001A00000019000000140000000C0000000500000001000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00 + } + end +end diff --git a/mangadownloader/forms/frmMain.lrj b/mangadownloader/forms/frmMain.lrj new file mode 100644 index 000000000..e79f86750 --- /dev/null +++ b/mangadownloader/forms/frmMain.lrj @@ -0,0 +1,327 @@ +{"version":1,"strings":[ +{"hash":57972706,"name":"tmainform.caption","sourcebytes":[70,114,101,101,32,77,97,110,103,97,32,68,111,119,110,108,111,97,100,101,114],"value":"Free Manga Downloader"}, +{"hash":240327891,"name":"tmainform.tsdownload.caption","sourcebytes":[68,111,119,110,108,111,97,100,115],"value":"Downloads"}, +{"hash":204655756,"name":"tmainform.tbdownloadresumeall.caption","sourcebytes":[82,101,115,117,109,101,32,65,108,108],"value":"Resume All"}, +{"hash":190989196,"name":"tmainform.tbdownloadstopall.caption","sourcebytes":[83,116,111,112,32,65,108,108],"value":"Stop All"}, +{"hash":235571507,"name":"tmainform.tbdownloaddeletecompleted.caption","sourcebytes":[68,101,108,101,116,101,32,97,108,108,32,99,111,109,112,108,101,116,101,100,32,116,97,115,107,115],"value":"Delete all completed tasks"}, +{"hash":173363182,"name":"tmainform.eddownloadssearch.texthint","sourcebytes":[83,101,97,114,99,104,32,100,111,119,110,108,111,97,100,115,46,46,46],"value":"Search downloads..."}, +{"hash":14216608,"name":"tmainform.tbmidownloadmovetop.hint","sourcebytes":[77,111,118,101,32,115,101,108,101,99,116,101,100,32,105,116,101,109,40,115,41,32,116,111,32,116,111,112],"value":"Move selected item(s) to top"}, +{"hash":160874656,"name":"tmainform.tbmidownloadmoveup.hint","sourcebytes":[77,111,118,101,32,115,101,108,101,99,116,101,100,32,105,116,101,109,40,115,41,32,117,112],"value":"Move selected item(s) up"}, +{"hash":113368910,"name":"tmainform.tbmidownloadmovedown.hint","sourcebytes":[77,111,118,101,32,115,101,108,101,99,116,101,100,32,105,116,101,109,40,115,41,32,100,111,119,110],"value":"Move selected item(s) down"}, +{"hash":268089565,"name":"tmainform.tbmidownloadmovebottom.hint","sourcebytes":[77,111,118,101,32,115,101,108,101,99,116,101,100,32,105,116,101,109,40,115,41,32,116,111,32,98,111,116,116,111,109],"value":"Move selected item(s) to bottom"}, +{"hash":5473489,"name":"tmainform.vtdownload.header.columns[0].text","sourcebytes":[77,97,110,103,97],"value":"Manga"}, +{"hash":95062979,"name":"tmainform.vtdownload.header.columns[1].text","sourcebytes":[83,116,97,116,117,115],"value":"Status"}, +{"hash":157190611,"name":"tmainform.vtdownload.header.columns[2].text","sourcebytes":[80,114,111,103,114,101,115,115],"value":"Progress"}, +{"hash":131060021,"name":"tmainform.vtdownload.header.columns[3].text","sourcebytes":[84,114,97,110,115,102,101,114,32,114,97,116,101],"value":"Transfer rate"}, +{"hash":230269173,"name":"tmainform.vtdownload.header.columns[4].text","sourcebytes":[87,101,98,115,105,116,101],"value":"Website"}, +{"hash":160200703,"name":"tmainform.vtdownload.header.columns[5].text","sourcebytes":[83,97,118,101,32,116,111],"value":"Save to"}, +{"hash":4696756,"name":"tmainform.vtdownload.header.columns[6].text","sourcebytes":[65,100,100,101,100],"value":"Added"}, +{"hash":221371535,"name":"tmainform.tsinformation.caption","sourcebytes":[77,97,110,103,97,32,73,110,102,111],"value":"Manga Info"}, +{"hash":206498996,"name":"tmainform.btabortupdatelist.hint","sourcebytes":[65,98,111,114,116,32,117,112,100,97,116,101,32,108,105,115,116],"value":"Abort update list"}, +{"hash":158194067,"name":"tmainform.cbselectmanga.hint","sourcebytes":[70,111,114,32,109,111,114,101,32,109,97,110,103,97,32,115,105,116,101,115,44,32,112,108,101,97,115,101,32,103,111,32,116,111,32,79,112,116,105,111,110,115,45,62,77,97,110,103,97,32,115,105,116,101,115],"value":"For more manga sites, please go to Options->Manga sites"}, +{"hash":119443044,"name":"tmainform.btupdatelist.hint","sourcebytes":[85,112,100,97,116,101,32,109,97,110,103,97,32,108,105,115,116],"value":"Update manga list"}, +{"hash":138125102,"name":"tmainform.edmangalistsearch.texthint","sourcebytes":[83,101,97,114,99,104,32,116,105,116,108,101,46,46,46],"value":"Search title..."}, +{"hash":150137481,"name":"tmainform.lbmode.caption","sourcebytes":[77,111,100,101,58,32,83,104,111,119,32,97,108,108,32,40,48,41],"value":"Mode: Show all (0)"}, +{"hash":328911,"name":"tmainform.tsinfomanga.caption","sourcebytes":[73,110,102,111],"value":"Info"}, +{"hash":60460069,"name":"tmainform.edurl.texthint","sourcebytes":[73,110,112,117,116,32,85,82,76,32,104,101,114,101],"value":"Input URL here"}, +{"hash":115683780,"name":"tmainform.btdownload.caption","sourcebytes":[68,111,119,110,108,111,97,100],"value":"Download"}, +{"hash":70044827,"name":"tmainform.cbaddasstopped.caption","sourcebytes":[65,100,100,32,116,111,32,100,111,119,110,108,111,97,100,32,108,105,115,116,32,97,115,32,115,116,111,112,112,101,100,32,116,97,115,107],"value":"Add to download list as stopped task"}, +{"hash":119380261,"name":"tmainform.btreadonline.caption","sourcebytes":[82,101,97,100,32,111,110,108,105,110,101],"value":"Read online"}, +{"hash":215882787,"name":"tmainform.btaddtofavorites.caption","sourcebytes":[65,100,100,32,116,111,32,102,97,118,111,114,105,116,101,115],"value":"Add to favorites"}, +{"hash":147292346,"name":"tmainform.lbsaveto.caption","sourcebytes":[83,97,118,101,32,116,111,58],"value":"Save to:"}, +{"hash":80755394,"name":"tmainform.edfiltermangainfochapters.texthint","sourcebytes":[70,105,108,116,101,114],"value":"Filter"}, +{"hash":160200703,"name":"tmainform.edsaveto.texthint","sourcebytes":[83,97,118,101,32,116,111],"value":"Save to"}, +{"hash":32855652,"name":"tmainform.btdownloadsplit.hint","sourcebytes":[83,112,108,105,116,32,100,111,119,110,108,111,97,100],"value":"Split download"}, +{"hash":80755394,"name":"tmainform.tsinfofilteradv.caption","sourcebytes":[70,105,108,116,101,114],"value":"Filter"}, +{"hash":236121459,"name":"tmainform.lbfiltercustomgenres.caption","sourcebytes":[67,117,115,116,111,109,32,71,101,110,114,101,115],"value":"Custom Genres"}, +{"hash":58090881,"name":"tmainform.edcustomgenres.texthint","sourcebytes":[73,110,112,117,116,32,99,117,115,116,111,109,32,103,101,110,114,101,115,44,32,115,101,112,97,114,97,116,101,100,32,98,121,32,99,111,109,109,97],"value":"Input custom genres, separated by comma"}, +{"hash":255353502,"name":"tmainform.lbfilterhint.hint","sourcebytes":[71,101,110,114,101,115,58,13,10,45,32,67,104,101,99,107,101,100,58,32,73,110,99,108,117,100,101,32,116,104,105,115,32,103,101,110,114,101,46,13,10,45,32,85,110,99,104,101,99,107,101,100,58,32,69,120,99,108,117,100,101,32,116,104,105,115,32,103,101,110,114,101,46,13,10,45,32,71,114,97,121,101,100,58,32,68,111,101,115,110,39,116,32,109,97,116,116,101,114,46,13,10,13,10,67,117,115,116,111,109,32,71,101,110,114,101,115,58,13,10,45,32,83,101,112,97,114,97,116,101,32,109,117,108,116,105,112,108,101,32,103,101,110,114,101,115,32,119,105,116,104,32,39,44,39,46,13,10,45,32,69,120,99,108,117,100,101,32,97,32,103,101,110,114,101,32,98,121,32,112,108,97,99,105,110,103,32,39,33,39,32,111,114,32,39,45,39,32,97,116,32,116,104,101,32,98,101,103,105,110,110,105,110,103,32,111,102,32,97,32,103,101,110,114,101,46,13,10,45,32,69,120,97,109,112,108,101,58,32,65,100,118,101,110,116,117,114,101,44,33,69,99,99,104,105,44,67,111,109,101,100,121,46],"value":"Genres:\r\n- Checked: Include this genre.\r\n- Unchecked: Exclude this genre.\r\n- Grayed: Doesn't matter.\r\n\r\nCustom Genres:\r\n- Separate multiple genres with ','.\r\n- Exclude a genre by placing '!' or '-' at the beginning of a genre.\r\n- Example: Adventure,!Ecchi,Comedy."}, +{"hash":24397,"name":"tmainform.lbfilterhint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":5966629,"name":"tmainform.lbfiltertitle.caption","sourcebytes":[84,105,116,108,101],"value":"Title"}, +{"hash":5966629,"name":"tmainform.edfiltertitle.texthint","sourcebytes":[84,105,116,108,101],"value":"Title"}, +{"hash":76328802,"name":"tmainform.lbfilterauthors.caption","sourcebytes":[65,117,116,104,111,114],"value":"Author"}, +{"hash":76328802,"name":"tmainform.edfilterauthors.texthint","sourcebytes":[65,117,116,104,111,114],"value":"Author"}, +{"hash":76132516,"name":"tmainform.lbfilterartists.caption","sourcebytes":[65,114,116,105,115,116],"value":"Artist"}, +{"hash":76132516,"name":"tmainform.edfilterartists.texthint","sourcebytes":[65,114,116,105,115,116],"value":"Artist"}, +{"hash":95062979,"name":"tmainform.lbfilterstatus.caption","sourcebytes":[83,116,97,116,117,115],"value":"Status"}, +{"hash":70608014,"name":"tmainform.cbfilterstatus.text","sourcebytes":[60,110,111,110,101,62],"value":""}, +{"hash":180631753,"name":"tmainform.lbfiltersummary.caption","sourcebytes":[83,117,109,109,97,114,121],"value":"Summary"}, +{"hash":65353321,"name":"tmainform.edfiltersummary.texthint","sourcebytes":[80,97,114,116,32,111,102,32,115,117,109,109,97,114,121],"value":"Part of summary"}, +{"hash":201437348,"name":"tmainform.rbone.caption","sourcebytes":[72,97,118,101,32,111,110,101,32,111,102,32,103,101,110,114,101,115,32,99,104,101,99,107,101,100],"value":"Have one of genres checked"}, +{"hash":51044468,"name":"tmainform.rball.caption","sourcebytes":[72,97,118,101,32,97,108,108,32,103,101,110,114,101,32,99,104,101,99,107,101,100],"value":"Have all genre checked"}, +{"hash":81924321,"name":"tmainform.cbonlynew.caption","sourcebytes":[83,101,97,114,99,104,32,111,110,108,121,32,110,101,119,32,109,97,110,103,97],"value":"Search only new manga"}, +{"hash":36938179,"name":"tmainform.cbsearchfromallsites.caption","sourcebytes":[83,101,97,114,99,104,32,105,110,32,97,108,108,32,109,97,110,103,97,32,115,105,116,101,115],"value":"Search in all manga sites"}, +{"hash":84262158,"name":"tmainform.cbuseregexpr.caption","sourcebytes":[82,101,103,117,108,97,114,32,69,120,112,114,101,115,115,105,111,110],"value":"Regular Expression"}, +{"hash":111905342,"name":"tmainform.ckfilteraction.hint","sourcebytes":[65,32,119,111,114,107,32,116,121,112,105,99,97,108,108,121,32,100,101,112,105,99,116,105,110,103,32,102,105,103,104,116,105,110,103,44,32,118,105,111,108,101,110,99,101,44,32,99,104,97,111,115,44,32,97,110,100,32,102,97,115,116,32,112,97,99,101,100,32,109,111,116,105,111,110,46],"value":"A work typically depicting fighting, violence, chaos, and fast paced motion."}, +{"hash":75149406,"name":"tmainform.ckfilteraction.caption","sourcebytes":[65,99,116,105,111,110],"value":"Action"}, +{"hash":258619502,"name":"tmainform.ckfilteradult.hint","sourcebytes":[67,111,110,116,97,105,110,115,32,99,111,110,116,101,110,116,32,116,104,97,116,32,105,115,32,115,117,105,116,97,98,108,101,32,111,110,108,121,32,102,111,114,32,97,100,117,108,116,115,46,32,84,105,116,108,101,115,32,105,110,32,116,104,105,115,32,99,97,116,101,103,111,114,121,32,109,97,121,32,105,110,99,108,117,100,101,32,112,114,111,108,111,110,103,101,100,32,115,99,101,110,101,115,32,111,102,32,105,110,116,101,110,115,101,32,118,105,111,108,101,110,99,101,32,97,110,100,47,111,114,32,103,114,97,112,104,105,99,32,115,101,120,117,97,108,32,99,111,110,116,101,110,116,32,97,110,100,32,110,117,100,105,116,121,46],"value":"Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity."}, +{"hash":4701236,"name":"tmainform.ckfilteradult.caption","sourcebytes":[65,100,117,108,116],"value":"Adult"}, +{"hash":267284606,"name":"tmainform.ckfilteradventure.hint","sourcebytes":[73,102,32,97,32,99,104,97,114,97,99,116,101,114,32,105,110,32,116,104,101,32,115,116,111,114,121,32,103,111,101,115,32,111,110,32,97,32,116,114,105,112,32,111,114,32,97,108,111,110,103,32,116,104,97,116,32,108,105,110,101,44,32,121,111,117,114,32,98,101,115,116,32,98,101,116,32,105,115,32,116,104,97,116,32,105,116,32,105,115,32,97,110,32,97,100,118,101,110,116,117,114,101,32,109,97,110,103,97,46,32,79,116,104,101,114,119,105,115,101,44,32,105,116,39,115,32,117,112,32,116,111,32,121,111,117,114,32,112,101,114,115,111,110,97,108,32,112,114,101,106,117,100,105,99,101,32,111,110,32,116,104,105,115,32,99,97,115,101,46],"value":"If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case."}, +{"hash":214301493,"name":"tmainform.ckfilteradventure.caption","sourcebytes":[65,100,118,101,110,116,117,114,101],"value":"Adventure"}, +{"hash":11846766,"name":"tmainform.ckfiltercomedy.hint","sourcebytes":[65,32,100,114,97,109,97,116,105,99,32,119,111,114,107,32,116,104,97,116,32,105,115,32,108,105,103,104,116,32,97,110,100,32,111,102,116,101,110,32,104,117,109,111,114,111,117,115,32,111,114,32,115,97,116,105,114,105,99,97,108,32,105,110,32,116,111,110,101,32,97,110,100,32,116,104,97,116,32,117,115,117,97,108,108,121,32,99,111,110,116,97,105,110,115,32,97,32,104,97,112,112,121,32,114,101,115,111,108,117,116,105,111,110,32,111,102,32,116,104,101,32,116,104,101,109,97,116,105,99,32,99,111,110,102,108,105,99,116,46],"value":"A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict."}, +{"hash":78003129,"name":"tmainform.ckfiltercomedy.caption","sourcebytes":[67,111,109,101,100,121],"value":"Comedy"}, +{"hash":163738830,"name":"tmainform.ckfilterdoujinshi.hint","sourcebytes":[70,97,110,32,98,97,115,101,100,32,119,111,114,107,32,105,110,112,115,112,105,114,101,100,32,98,121,32,111,102,102,105,99,105,97,108,32,109,97,110,103,97,47,97,110,105,109,101,46],"value":"Fan based work inpspired by official manga/anime."}, +{"hash":202379913,"name":"tmainform.ckfilterdoujinshi.caption","sourcebytes":[68,111,117,106,105,110,115,104,105],"value":"Doujinshi"}, +{"hash":221112350,"name":"tmainform.ckfilterdrama.hint","sourcebytes":[65,32,119,111,114,107,32,109,101,97,110,116,32,116,111,32,98,114,105,110,103,32,111,110,32,97,110,32,101,109,111,116,105,111,110,97,108,32,114,101,115,112,111,110,115,101,44,32,115,117,99,104,32,97,115,32,105,110,115,116,105,108,108,105,110,103,32,115,97,100,110,101,115,115,32,111,114,32,116,101,110,115,105,111,110,46],"value":"A work meant to bring on an emotional response, such as instilling sadness or tension."}, +{"hash":4950065,"name":"tmainform.ckfilterdrama.caption","sourcebytes":[68,114,97,109,97],"value":"Drama"}, +{"hash":33591486,"name":"tmainform.ckfilterechi.hint","sourcebytes":[80,111,115,115,105,98,108,121,32,116,104,101,32,108,105,110,101,32,98,101,116,119,101,101,110,32,104,101,110,116,97,105,32,97,110,100,32,110,111,110,45,104,101,110,116,97,105,44,32,101,99,99,104,105,32,117,115,117,97,108,108,121,32,114,101,102,101,114,115,32,116,111,32,102,97,110,115,101,114,118,105,99,101,32,112,117,116,32,105,110,32,116,111,32,97,116,116,114,97,99,116,32,97,32,99,101,114,116,97,105,110,32,103,114,111,117,112,32,111,102,32,102,97,110,115,46],"value":"Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans."}, +{"hash":4954601,"name":"tmainform.ckfilterechi.caption","sourcebytes":[69,99,99,104,105],"value":"Ecchi"}, +{"hash":149295550,"name":"tmainform.ckfilterfantasy.hint","sourcebytes":[65,110,121,116,104,105,110,103,32,116,104,97,116,32,105,110,118,111,108,118,101,115,44,32,98,117,116,32,110,111,116,32,108,105,109,105,116,101,100,32,116,111,44,32,109,97,103,105,99,44,32,100,114,101,97,109,32,119,111,114,108,100,44,32,97,110,100,32,102,97,105,114,121,32,116,97,108,101,115,46],"value":"Anything that involves, but not limited to, magic, dream world, and fairy tales."}, +{"hash":210086121,"name":"tmainform.ckfilterfantasy.caption","sourcebytes":[70,97,110,116,97,115,121],"value":"Fantasy"}, +{"hash":124460254,"name":"tmainform.ckfiltergenderbender.hint","sourcebytes":[71,105,114,108,115,32,100,114,101,115,115,105,110,103,32,117,112,32,97,115,32,103,117,121,115,44,32,103,117,121,115,32,100,114,101,115,115,105,110,103,32,117,112,32,97,115,32,103,105,114,108,115,46,13,10,71,117,121,115,32,116,117,114,110,105,110,103,32,105,110,116,111,32,103,105,114,108,115,44,32,103,105,114,108,115,32,116,117,114,110,105,110,103,32,105,110,116,111,32,103,117,121,115,46],"value":"Girls dressing up as guys, guys dressing up as girls.\r\nGuys turning into girls, girls turning into guys."}, +{"hash":156296898,"name":"tmainform.ckfiltergenderbender.caption","sourcebytes":[71,101,110,100,101,114,32,66,101,110,100,101,114],"value":"Gender Bender"}, +{"hash":237637310,"name":"tmainform.ckfilterharem.hint","sourcebytes":[65,32,115,101,114,105,101,115,32,105,110,118,111,108,118,105,110,103,32,111,110,101,32,109,97,108,101,32,99,104,97,114,97,99,116,101,114,32,97,110,100,32,109,97,110,121,32,102,101,109,97,108,101,32,99,104,97,114,97,99,116,101,114,115,32,40,117,115,117,97,108,108,121,32,97,116,116,114,97,99,116,101,100,32,116,111,32,116,104,101,32,109,97,108,101,32,99,104,97,114,97,99,116,101,114,41,46,32,65,32,82,101,118,101,114,115,101,32,72,97,114,101,109,32,105,115,32,119,104,101,110,32,116,104,101,32,103,101,110,100,101,114,115,32,97,114,101,32,114,101,118,101,114,115,101,100,46],"value":"A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed."}, +{"hash":5146813,"name":"tmainform.ckfilterharem.caption","sourcebytes":[72,97,114,101,109],"value":"Harem"}, +{"hash":82598521,"name":"tmainform.ckfilterhentai.hint","sourcebytes":[72,101,110,116,97,105],"value":"Hentai"}, +{"hash":82598521,"name":"tmainform.ckfilterhentai.caption","sourcebytes":[72,101,110,116,97,105],"value":"Hentai"}, +{"hash":159671182,"name":"tmainform.ckfilterhistorical.hint","sourcebytes":[72,97,118,105,110,103,32,116,111,32,100,111,32,119,105,116,104,32,111,108,100,32,111,114,32,97,110,99,105,101,110,116,32,116,105,109,101,115,46],"value":"Having to do with old or ancient times."}, +{"hash":191629788,"name":"tmainform.ckfilterhistorical.caption","sourcebytes":[72,105,115,116,111,114,105,99,97,108],"value":"Historical"}, +{"hash":69062670,"name":"tmainform.ckfilterhorror.hint","sourcebytes":[65,32,112,97,105,110,102,117,108,32,101,109,111,116,105,111,110,32,111,102,32,102,101,97,114,44,32,100,114,101,97,100,44,32,97,110,100,32,97,98,104,111,114,114,101,110,99,101,59,32,97,32,115,104,117,100,100,101,114,105,110,103,32,119,105,116,104,32,116,101,114,114,111,114,32,97,110,100,32,100,101,116,101,115,116,97,116,105,111,110,59,32,116,104,101,32,102,101,101,108,105,110,103,32,105,110,115,112,105,114,101,100,32,98,121,32,115,111,109,101,116,104,105,110,103,32,102,114,105,103,104,116,102,117,108,32,97,110,100,32,115,104,111,99,107,105,110,103,46],"value":"A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking."}, +{"hash":83269986,"name":"tmainform.ckfilterhorror.caption","sourcebytes":[72,111,114,114,111,114],"value":"Horror"}, +{"hash":76590862,"name":"tmainform.ckfilterjosei.hint","sourcebytes":[76,105,116,101,114,97,108,108,121,32,34,87,111,109,97,110,34,46,32,84,97,114,103,101,116,115,32,119,111,109,101,110,32,49,56,45,51,48,46,32,70,101,109,97,108,101,32,101,113,117,105,118,97,108,101,110,116,32,116,111,32,115,101,105,110,101,110,46,32,85,110,108,105,107,101,32,115,104,111,117,106,111,32,116,104,101,32,114,111,109,97,110,99,101,32,105,115,32,109,111,114,101,32,114,101,97,108,105,115,116,105,99,32,97,110,100,32,108,101,115,115,32,105,100,101,97,108,105,122,101,100,46,32,84,104,101,32,115,116,111,114,121,116,101,108,108,105,110,103,32,105,115,32,109,111,114,101,32,101,120,112,108,105,99,105,116,32,97,110,100,32,109,97,116,117,114,101,46],"value":"Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature."}, +{"hash":5335481,"name":"tmainform.ckfilterjosei.caption","sourcebytes":[74,111,115,101,105],"value":"Josei"}, +{"hash":76842110,"name":"tmainform.ckfilterlolicon.hint","sourcebytes":[82,101,112,114,101,115,101,110,116,105,110,103,32,97,32,115,101,120,117,97,108,32,97,116,116,114,97,99,116,105,111,110,32,116,111,32,121,111,117,110,103,32,111,114,32,117,110,100,101,114,45,97,103,101,32,103,105,114,108,115,46],"value":"Representing a sexual attraction to young or under-age girls."}, +{"hash":56818190,"name":"tmainform.ckfilterlolicon.caption","sourcebytes":[76,111,108,105,99,111,110],"value":"Lolicon"}, +{"hash":104001182,"name":"tmainform.ckfiltermartialarts.hint","sourcebytes":[65,115,32,116,104,101,32,110,97,109,101,32,115,117,103,103,101,115,116,115,44,32,97,110,121,116,104,105,110,103,32,109,97,114,116,105,97,108,32,97,114,116,115,32,114,101,108,97,116,101,100,46,32,65,110,121,32,111,102,32,115,101,118,101,114,97,108,32,97,114,116,115,32,111,102,32,99,111,109,98,97,116,32,111,114,32,115,101,108,102,45,100,101,102,101,110,115,101,44,32,115,117,99,104,32,97,115,32,97,105,107,105,100,111,44,32,107,97,114,97,116,101,44,32,106,117,100,111,44,32,111,114,32,116,97,101,107,119,111,110,100,111,44,32,107,101,110,100,111,44,32,102,101,110,99,105,110,103,44,32,97,110,100,32,115,111,32,111,110,32,97,110,100,32,115,111,32,102,111,114,116,104,46],"value":"As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth."}, +{"hash":47977283,"name":"tmainform.ckfiltermartialarts.caption","sourcebytes":[77,97,114,116,105,97,108,32,65,114,116,115],"value":"Martial Arts"}, +{"hash":190246206,"name":"tmainform.ckfiltermature.hint","sourcebytes":[67,111,110,116,97,105,110,115,32,115,117,98,106,101,99,116,32,109,97,116,116,101,114,32,119,104,105,99,104,32,109,97,121,32,98,101,32,116,111,111,32,101,120,116,114,101,109,101,32,102,111,114,32,112,101,111,112,108,101,32,117,110,100,101,114,32,116,104,101,32,97,103,101,32,111,102,32,49,55,46,32,84,105,116,108,101,115,32,105,110,32,116,104,105,115,32,99,97,116,101,103,111,114,121,32,109,97,121,32,99,111,110,116,97,105,110,32,105,110,116,101,110,115,101,32,118,105,111,108,101,110,99,101,44,32,98,108,111,111,100,32,97,110,100,32,103,111,114,101,44,32,115,101,120,117,97,108,32,99,111,110,116,101,110,116,32,97,110,100,47,111,114,32,115,116,114,111,110,103,32,108,97,110,103,117,97,103,101,46],"value":"Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language."}, +{"hash":87604357,"name":"tmainform.ckfiltermature.caption","sourcebytes":[77,97,116,117,114,101],"value":"Mature"}, +{"hash":187133582,"name":"tmainform.ckfiltermecha.hint","sourcebytes":[65,32,119,111,114,107,32,105,110,118,111,108,118,105,110,103,32,97,110,100,32,117,115,117,97,108,108,121,32,99,111,110,99,101,110,116,114,97,116,105,110,103,32,111,110,32,97,108,108,32,116,121,112,101,115,32,111,102,32,108,97,114,103,101,32,114,111,98,111,116,105,99,32,109,97,99,104,105,110,101,115,46],"value":"A work involving and usually concentrating on all types of large robotic machines."}, +{"hash":5487073,"name":"tmainform.ckfiltermecha.caption","sourcebytes":[77,101,99,104,97],"value":"Mecha"}, +{"hash":80345388,"name":"tmainform.ckfiltermusical.hint","sourcebytes":[77,117,115,105,99,97,108],"value":"Musical"}, +{"hash":80345388,"name":"tmainform.ckfiltermusical.caption","sourcebytes":[77,117,115,105,99,97,108],"value":"Musical"}, +{"hash":80699502,"name":"tmainform.ckfiltermystery.hint","sourcebytes":[85,115,117,97,108,108,121,32,97,110,32,117,110,101,120,112,108,97,105,110,101,100,32,101,118,101,110,116,32,111,99,99,117,114,115,44,32,97,110,100,32,116,104,101,32,109,97,105,110,32,112,114,111,116,97,103,111,110,105,115,116,32,97,116,116,101,109,112,116,115,32,116,111,32,102,105,110,100,32,111,117,116,32,119,104,97,116,32,99,97,117,115,101,100,32,105,116,46],"value":"Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it."}, +{"hash":84585673,"name":"tmainform.ckfiltermystery.caption","sourcebytes":[77,121,115,116,101,114,121],"value":"Mystery"}, +{"hash":140769566,"name":"tmainform.ckfilterpsychological.hint","sourcebytes":[85,115,117,97,108,108,121,32,100,101,97,108,115,32,119,105,116,104,32,116,104,101,32,112,104,105,108,111,115,111,112,104,121,32,111,102,32,97,32,115,116,97,116,101,32,111,102,32,109,105,110,100,44,32,105,110,32,109,111,115,116,32,99,97,115,101,115,32,100,101,116,97,105,108,105,110,103,32,97,98,110,111,114,109,97,108,32,112,115,121,99,104,111,108,111,103,121,46],"value":"Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology."}, +{"hash":116549228,"name":"tmainform.ckfilterpsychological.caption","sourcebytes":[80,115,121,99,104,111,108,111,103,105,99,97,108],"value":"Psychological"}, +{"hash":6796286,"name":"tmainform.ckfilterromance.hint","sourcebytes":[65,110,121,32,108,111,118,101,32,114,101,108,97,116,101,100,32,115,116,111,114,121,46,32,87,101,32,119,105,108,108,32,100,101,102,105,110,101,32,108,111,118,101,32,97,115,32,98,101,116,119,101,101,110,32,109,97,110,32,97,110,100,32,119,111,109,97,110,32,105,110,32,116,104,105,115,32,99,97,115,101,46,32,79,116,104,101,114,32,116,104,97,110,32,116,104,97,116,44,32,105,116,32,105,115,32,117,112,32,116,111,32,121,111,117,114,32,111,119,110,32,105,109,97,103,105,110,97,116,105,111,110,32,111,102,32,119,104,97,116,32,108,111,118,101,32,105,115,46],"value":"Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is."}, +{"hash":157516997,"name":"tmainform.ckfilterromance.caption","sourcebytes":[82,111,109,97,110,99,101],"value":"Romance"}, +{"hash":101821054,"name":"tmainform.ckfilterschoollife.hint","sourcebytes":[72,97,118,105,110,103,32,97,32,109,97,106,111,114,32,115,101,116,116,105,110,103,32,111,102,32,116,104,101,32,115,116,111,114,121,32,100,101,97,108,32,119,105,116,104,32,115,111,109,101,32,116,121,112,101,32,111,102,32,115,99,104,111,111,108,46],"value":"Having a major setting of the story deal with some type of school."}, +{"hash":96383141,"name":"tmainform.ckfilterschoollife.caption","sourcebytes":[83,99,104,111,111,108,32,76,105,102,101],"value":"School Life"}, +{"hash":119378158,"name":"tmainform.ckfilterscifi.hint","sourcebytes":[83,104,111,114,116,32,102,111,114,32,115,99,105,101,110,99,101,32,102,105,99,116,105,111,110,44,32,116,104,101,115,101,32,119,111,114,107,115,32,105,110,118,111,108,118,101,32,116,119,105,115,116,115,32,111,110,32,116,101,99,104,110,111,108,111,103,121,32,97,110,100,32,111,116,104,101,114,32,115,99,105,101,110,99,101,32,114,101,108,97,116,101,100,32,112,104,101,110,111,109,101,110,97,32,119,104,105,99,104,32,97,114,101,32,99,111,110,116,114,97,114,121,32,111,114,32,115,116,114,101,116,99,104,101,115,32,111,102,32,116,104,101,32,109,111,100,101,114,110,32,100,97,121,32,115,99,105,101,110,116,105,102,105,99,32,119,111,114,108,100,46],"value":"Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world."}, +{"hash":93962697,"name":"tmainform.ckfilterscifi.caption","sourcebytes":[83,99,105,45,70,105],"value":"Sci-Fi"}, +{"hash":1010254,"name":"tmainform.ckfilterseinen.hint","sourcebytes":[70,114,111,109,32,71,111,111,103,108,101,58,32,83,101,105,110,101,110,32,109,101,97,110,115,32,39,121,111,117,110,103,32,77,97,110,39,46,32,77,97,110,103,97,32,97,110,100,32,97,110,105,109,101,32,116,104,97,116,32,115,112,101,99,105,102,105,99,97,108,108,121,32,116,97,114,103,101,116,115,32,121,111,117,110,103,32,97,100,117,108,116,32,109,97,108,101,115,32,97,114,111,117,110,100,32,116,104,101,32,97,103,101,115,32,111,102,32,49,56,32,116,111,32,50,53,32,97,114,101,32,115,101,105,110,101,110,32,116,105,116,108,101,115,46,32,84,104,101,32,115,116,111,114,105,101,115,32,105,110,32,115,101,105,110,101,110,32,119,111,114,107,115,32,97,112,112,101,97,108,32,116,111,32,117,110,105,118,101,114,115,105,116,121,32,115,116,117,100,101,110,116,115,32,97,110,100,32,116,104,111,115,101,32,105,110,32,116,104,101,32,119,111,114,107,105,110,103,32,119,111,114,108,100,46,32,84,121,112,105,99,97,108,108,121,32,116,104,101,32,115,116,111,114,121,32,108,105,110,101,115,32,100,101,97,108,32,119,105,116,104,32,116,104,101,32,105,115,115,117,101,115,32,111,102,32,97,100,117,108,116,104,111,111,100,46],"value":"From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood."}, +{"hash":94110910,"name":"tmainform.ckfilterseinen.caption","sourcebytes":[83,101,105,110,101,110],"value":"Seinen"}, +{"hash":38682414,"name":"tmainform.ckfiltershotacon.hint","sourcebytes":[82,101,112,114,101,115,101,110,116,105,110,103,32,97,32,115,101,120,117,97,108,32,97,116,116,114,97,99,116,105,111,110,32,116,111,32,121,111,117,110,103,32,111,114,32,117,110,100,101,114,45,97,103,101,32,98,111,121,115,46],"value":"Representing a sexual attraction to young or under-age boys."}, +{"hash":258637262,"name":"tmainform.ckfiltershotacon.caption","sourcebytes":[83,104,111,116,97,99,111,110],"value":"Shotacon"}, +{"hash":153596830,"name":"tmainform.ckfiltershoujo.hint","sourcebytes":[65,32,119,111,114,107,32,105,110,116,101,110,100,101,100,32,97,110,100,32,112,114,105,109,97,114,105,108,121,32,119,114,105,116,116,101,110,32,102,111,114,32,102,101,109,97,108,101,115,46,32,85,115,117,97,108,108,121,32,105,110,118,111,108,118,101,115,32,97,32,108,111,116,32,111,102,32,114,111,109,97,110,99,101,32,97,110,100,32,115,116,114,111,110,103,32,99,104,97,114,97,99,116,101,114,32,100,101,118,101,108,111,112,109,101,110,116,46],"value":"A work intended and primarily written for females. Usually involves a lot of romance and strong character development."}, +{"hash":94333967,"name":"tmainform.ckfiltershoujo.caption","sourcebytes":[83,104,111,117,106,111],"value":"Shoujo"}, +{"hash":171132846,"name":"tmainform.ckfiltershoujoai.hint","sourcebytes":[79,102,116,101,110,32,115,121,110,111,110,121,109,111,117,115,32,119,105,116,104,32,121,117,114,105,44,32,116,104,105,115,32,99,97,110,32,98,101,32,116,104,111,117,103,104,116,32,111,102,32,97,115,32,115,111,109,101,119,104,97,116,32,108,101,115,115,32,101,120,116,114,101,109,101,46,32,34,71,105,114,108,39,39,115,32,76,111,118,101,34,44,32,115,111,32,116,111,32,115,112,101,97,107,46],"value":"Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak."}, +{"hash":113331593,"name":"tmainform.ckfiltershoujoai.caption","sourcebytes":[83,104,111,117,106,111,32,65,105],"value":"Shoujo Ai"}, +{"hash":215064270,"name":"tmainform.ckfiltershounen.hint","sourcebytes":[65,32,119,111,114,107,32,105,110,116,101,110,100,101,100,32,97,110,100,32,112,114,105,109,97,114,105,108,121,32,119,114,105,116,116,101,110,32,102,111,114,32,109,97,108,101,115,46,32,84,104,101,115,101,32,119,111,114,107,115,32,117,115,117,97,108,108,121,32,105,110,118,111,108,118,101,32,102,105,103,104,116,105,110,103,32,97,110,100,47,111,114,32,118,105,111,108,101,110,99,101,46],"value":"A work intended and primarily written for males. These works usually involve fighting and/or violence."}, +{"hash":167167214,"name":"tmainform.ckfiltershounen.caption","sourcebytes":[83,104,111,117,110,101,110],"value":"Shounen"}, +{"hash":19597467,"name":"tmainform.ckfiltershounenai.hint","sourcebytes":[79,102,116,101,110,32,115,121,110,111,110,121,109,111,117,115,32,119,105,116,104,32,121,97,111,105,44,32,116,104,105,115,32,99,97,110,32,98,101,32,116,104,111,117,103,104,116,32,111,102,32,97,115,32,115,111,109,101,119,104,97,116,32,108,101,115,115,32,101,120,116,114,101,109,101,46,32,34,66,111,121,39,39,115,32,76,111,118,101,34,194,157,44,32,115,111,32,116,111,32,115,112,101,97,107],"value":"Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\"\u009D, so to speak"}, +{"hash":206543641,"name":"tmainform.ckfiltershounenai.caption","sourcebytes":[83,104,111,117,110,101,110,32,65,105],"value":"Shounen Ai"}, +{"hash":250633278,"name":"tmainform.ckfiltersliceoflife.hint","sourcebytes":[65,115,32,116,104,101,32,110,97,109,101,32,115,117,103,103,101,115,116,115,44,32,116,104,105,115,32,103,101,110,114,101,32,114,101,112,114,101,115,101,110,116,115,32,100,97,121,45,116,111,45,100,97,121,32,116,114,105,98,117,108,97,116,105,111,110,115,32,111,102,32,111,110,101,47,109,97,110,121,32,99,104,97,114,97,99,116,101,114,40,115,41,46,32,84,104,101,115,101,32,99,104,97,108,108,101,110,103,101,115,47,101,118,101,110,116,115,32,99,111,117,108,100,32,116,101,99,104,110,105,99,97,108,108,121,32,104,97,112,112,101,110,32,105,110,32,114,101,97,108,32,108,105,102,101,32,97,110,100,32,97,114,101,32,111,102,116,101,110,32,45,105,102,32,110,111,116,32,97,108,108,32,116,104,101,32,116,105,109,101,45,32,115,101,116,32,105,110,32,116,104,101,32,112,114,101,115,101,110,116,32,116,105,109,101,108,105,110,101,32,105,110,32,97,32,119,111,114,108,100,32,116,104,97,116,32,109,105,114,114,111,114,115,32,111,117,114,32,111,119,110,46],"value":"As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own."}, +{"hash":262977669,"name":"tmainform.ckfiltersliceoflife.caption","sourcebytes":[83,108,105,99,101,32,111,102,32,76,105,102,101],"value":"Slice of Life"}, +{"hash":68245006,"name":"tmainform.ckfiltersmut.hint","sourcebytes":[68,101,97,108,115,32,119,105,116,104,32,115,101,114,105,101,115,32,116,104,97,116,32,97,114,101,32,99,111,110,115,105,100,101,114,101,100,32,112,114,111,102,97,110,101,32,111,114,32,111,102,102,101,110,115,105,118,101,44,32,112,97,114,116,105,99,117,108,97,114,108,121,32,119,105,116,104,32,114,101,103,97,114,100,115,32,116,111,32,115,101,120,117,97,108,32,99,111,110,116,101,110,116,46],"value":"Deals with series that are considered profane or offensive, particularly with regards to sexual content."}, +{"hash":369860,"name":"tmainform.ckfiltersmut.caption","sourcebytes":[83,109,117,116],"value":"Smut"}, +{"hash":176420878,"name":"tmainform.ckfiltersports.hint","sourcebytes":[65,115,32,116,104,101,32,110,97,109,101,32,115,117,103,103,101,115,116,115,44,32,97,110,121,116,104,105,110,103,32,115,112,111,114,116,115,32,114,101,108,97,116,101,100,46,32,66,97,115,101,98,97,108,108,44,32,98,97,115,107,101,116,98,97,108,108,44,32,104,111,99,107,101,121,44,32,115,111,99,99,101,114,44,32,103,111,108,102,44,32,97,110,100,32,114,97,99,105,110,103,32,106,117,115,116,32,116,111,32,110,97,109,101,32,97,32,102,101,119,46],"value":"As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few."}, +{"hash":94857651,"name":"tmainform.ckfiltersports.caption","sourcebytes":[83,112,111,114,116,115],"value":"Sports"}, +{"hash":148813966,"name":"tmainform.ckfiltersupernatural.hint","sourcebytes":[85,115,117,97,108,108,121,32,101,110,116,97,105,108,115,32,97,109,97,122,105,110,103,32,97,110,100,32,117,110,101,120,112,108,97,105,110,101,100,32,112,111,119,101,114,115,32,111,114,32,101,118,101,110,116,115,32,119,104,105,99,104,32,100,101,102,121,32,116,104,101,32,108,97,119,115,32,111,102,32,112,104,121,115,105,99,115,46],"value":"Usually entails amazing and unexplained powers or events which defy the laws of physics."}, +{"hash":19375340,"name":"tmainform.ckfiltersupernatural.caption","sourcebytes":[83,117,112,101,114,110,97,116,117,114,97,108],"value":"Supernatural"}, +{"hash":134027038,"name":"tmainform.ckfiltertragedy.hint","sourcebytes":[67,111,110,116,97,105,110,115,32,101,118,101,110,116,115,32,114,101,115,117,108,116,105,110,103,32,105,110,32,103,114,101,97,116,32,108,111,115,115,32,97,110,100,32,109,105,115,102,111,114,116,117,110,101,46],"value":"Contains events resulting in great loss and misfortune."}, +{"hash":193453033,"name":"tmainform.ckfiltertragedy.caption","sourcebytes":[84,114,97,103,101,100,121],"value":"Tragedy"}, +{"hash":67321502,"name":"tmainform.ckfilteryaoi.hint","sourcebytes":[84,104,105,115,32,119,111,114,107,32,117,115,117,97,108,108,121,32,105,110,118,111,108,118,101,115,32,105,110,116,105,109,97,116,101,32,114,101,108,97,116,105,111,110,115,104,105,112,115,32,98,101,116,119,101,101,110,32,109,101,110,46],"value":"This work usually involves intimate relationships between men."}, +{"hash":391257,"name":"tmainform.ckfilteryaoi.caption","sourcebytes":[89,97,111,105],"value":"Yaoi"}, +{"hash":65318926,"name":"tmainform.ckfilteryuri.hint","sourcebytes":[84,104,105,115,32,119,111,114,107,32,117,115,117,97,108,108,121,32,105,110,118,111,108,118,101,115,32,105,110,116,105,109,97,116,101,32,114,101,108,97,116,105,111,110,115,104,105,112,115,32,98,101,116,119,101,101,110,32,119,111,109,101,110,46],"value":"This work usually involves intimate relationships between women."}, +{"hash":396425,"name":"tmainform.ckfilteryuri.caption","sourcebytes":[89,117,114,105],"value":"Yuri"}, +{"hash":194714083,"name":"tmainform.ckfilterweebtons.hint","sourcebytes":[87,101,101,98,116,111,111,110,115],"value":"Weebtoons"}, +{"hash":194714083,"name":"tmainform.ckfilterweebtons.caption","sourcebytes":[87,101,101,98,116,111,111,110,115],"value":"Weebtoons"}, +{"hash":80755394,"name":"tmainform.btfilter.caption","sourcebytes":[70,105,108,116,101,114],"value":"Filter"}, +{"hash":235689698,"name":"tmainform.btremovefilterlarge.hint","sourcebytes":[82,101,109,111,118,101,32,102,105,108,116,101,114],"value":"Remove filter"}, +{"hash":235689698,"name":"tmainform.btremovefilterlarge.caption","sourcebytes":[82,101,109,111,118,101,32,102,105,108,116,101,114],"value":"Remove filter"}, +{"hash":103074421,"name":"tmainform.btfilterreset.caption","sourcebytes":[82,101,115,101,116,32,118,97,108,117,101],"value":"Reset value"}, +{"hash":225003075,"name":"tmainform.tsfavorites.caption","sourcebytes":[70,97,118,111,114,105,116,101,115],"value":"Favorites"}, +{"hash":35,"name":"tmainform.vtfavorites.header.columns[0].text","sourcebytes":[35],"value":"#"}, +{"hash":5966629,"name":"tmainform.vtfavorites.header.columns[1].text","sourcebytes":[84,105,116,108,101],"value":"Title"}, +{"hash":6579810,"name":"tmainform.vtfavorites.header.columns[2].text","sourcebytes":[67,117,114,114,101,110,116,32,99,104,97,112,116,101,114],"value":"Current chapter"}, +{"hash":230269173,"name":"tmainform.vtfavorites.header.columns[3].text","sourcebytes":[87,101,98,115,105,116,101],"value":"Website"}, +{"hash":160200703,"name":"tmainform.vtfavorites.header.columns[4].text","sourcebytes":[83,97,118,101,32,116,111],"value":"Save to"}, +{"hash":154630084,"name":"tmainform.btfavoritesimport.caption","sourcebytes":[73,109,112,111,114,116,32,108,105,115,116],"value":"Import list"}, +{"hash":165778738,"name":"tmainform.btfavoriteschecknewchapter.caption","sourcebytes":[67,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114],"value":"Check for new chapter"}, +{"hash":266084494,"name":"tmainform.edfavoritessearch.texthint","sourcebytes":[83,101,97,114,99,104,32,102,97,118,111,114,105,116,101,115,46,46,46],"value":"Search favorites..."}, +{"hash":108725763,"name":"tmainform.tsoption.caption","sourcebytes":[79,112,116,105,111,110,115],"value":"Options"}, +{"hash":231000124,"name":"tmainform.tsgeneral.caption","sourcebytes":[71,101,110,101,114,97,108],"value":"General"}, +{"hash":189923241,"name":"tmainform.cboptionminimizetotray.caption","sourcebytes":[77,105,110,105,109,105,122,101,32,116,111,32,116,114,97,121],"value":"Minimize to tray"}, +{"hash":9911767,"name":"tmainform.cboptiononeinstanceonly.caption","sourcebytes":[80,101,114,109,105,116,32,111,110,108,121,32,111,110,101,32,70,77,68,32,114,117,110,110,105,110,103],"value":"Permit only one FMD running"}, +{"hash":251042137,"name":"tmainform.cboptionlivesearch.caption","sourcebytes":[69,110,97,98,108,101,32,108,105,118,101,32,115,101,97,114,99,104,32,40,115,108,111,119,32,111,110,32,108,111,110,103,32,108,105,115,116,41],"value":"Enable live search (slow on long list)"}, +{"hash":186997165,"name":"tmainform.gboptionexternal.caption","sourcebytes":[69,120,116,101,114,110,97,108,32,112,114,111,103,114,97,109],"value":"External program"}, +{"hash":36189706,"name":"tmainform.lboptionexternal.caption","sourcebytes":[79,112,101,110,32,109,97,110,103,97,32,98,121,32,117,115,105,110,103,32,101,120,116,101,114,110,97,108,32,112,114,111,103,114,97,109,58],"value":"Open manga by using external program:"}, +{"hash":60572138,"name":"tmainform.lboptionexternalparams.caption","sourcebytes":[80,97,114,97,109,101,116,101,114,115,58],"value":"Parameters:"}, +{"hash":242848131,"name":"tmainform.edoptionexternalparams.texthint","sourcebytes":[69,120,116,101,114,110,97,108,32,112,114,111,103,114,97,109,32,112,97,114,97,109,101,116,101,114,115],"value":"External program parameters"}, +{"hash":24397,"name":"tmainform.lboptionexternalparamshint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":172309816,"name":"tmainform.edoptionexternalpath.texthint","sourcebytes":[69,120,116,101,114,110,97,108,32,112,114,111,103,114,97,109,32,112,97,116,104],"value":"External program path"}, +{"hash":82521866,"name":"tmainform.lboptionlanguage.caption","sourcebytes":[76,97,110,103,117,97,103,101,58],"value":"Language:"}, +{"hash":93623386,"name":"tmainform.lboptionletfmddo.caption","sourcebytes":[65,102,116,101,114,32,100,111,119,110,108,111,97,100,32,102,105,110,105,115,104,58],"value":"After download finish:"}, +{"hash":160062057,"name":"tmainform.lboptionnewmangatime.caption","sourcebytes":[78,101,119,32,109,97,110,103,97,32,98,97,115,101,100,32,111,110,32,32,105,116,39,115,32,117,112,100,97,116,101,32,116,105,109,101,32,40,100,97,121,115,41],"value":"New manga based on it's update time (days)"}, +{"hash":69131508,"name":"tmainform.cboptionminimizeonstart.caption","sourcebytes":[77,105,110,105,109,105,122,101,32,111,110,32,115,116,97,114,116],"value":"Minimize on start"}, +{"hash":134851429,"name":"tmainform.cboptiondeletecompletedtasksonclose.caption","sourcebytes":[68,101,108,101,116,101,32,99,111,109,112,108,101,116,101,100,32,116,97,115,107,115,32,111,110,32,99,108,111,115,101],"value":"Delete completed tasks on close"}, +{"hash":380871,"name":"tmainform.tsview.caption","sourcebytes":[86,105,101,119],"value":"View"}, +{"hash":126054082,"name":"tmainform.cboptionshowdownloadtoolbar.caption","sourcebytes":[83,104,111,119,32,100,111,119,110,108,111,97,100,115,32,116,111,111,108,98,97,114],"value":"Show downloads toolbar"}, +{"hash":157437400,"name":"tmainform.gbdroptarget.caption","sourcebytes":[68,114,111,112,32,66,111,120],"value":"Drop Box"}, +{"hash":43310472,"name":"tmainform.ckdroptarget.caption","sourcebytes":[83,104,111,119,32,68,114,111,112,32,66,111,120],"value":"Show Drop Box"}, +{"hash":107454697,"name":"tmainform.lbdroptargetopacity.caption","sourcebytes":[79,112,97,99,105,116,121],"value":"Opacity"}, +{"hash":345509,"name":"tmainform.rgdroptargetmode.caption","sourcebytes":[77,111,100,101],"value":"Mode"}, +{"hash":117603058,"name":"tmainform.cboptionenableloadcover.caption","sourcebytes":[69,110,97,98,108,101,32,108,111,97,100,32,109,97,110,103,97,32,99,111,118,101,114],"value":"Enable load manga cover"}, +{"hash":150918338,"name":"tmainform.cboptionshowdownloadtoolbardeleteall.caption","sourcebytes":[83,104,111,119,32,34,68,101,108,101,116,101,32,97,108,108,32,99,111,109,112,108,101,116,101,100,32,116,97,115,107,115,34,32,105,110,32,100,111,119,110,108,111,97,100,115,32,116,111,111,108,98,97,114],"value":"Show \"Delete all completed tasks\" in downloads toolbar"}, +{"hash":81333124,"name":"tmainform.cboptionshowballoonhint.caption","sourcebytes":[83,104,111,119,32,98,97,108,108,111,111,110,32,104,105,110,116],"value":"Show balloon hint"}, +{"hash":185449858,"name":"tmainform.cboptionshowdownloadtoolbarleft.caption","sourcebytes":[83,104,111,119,32,108,101,102,116,32,100,111,119,110,108,111,97,100,115,32,116,111,111,108,98,97,114],"value":"Show left downloads toolbar"}, +{"hash":199270675,"name":"tmainform.tsconnections.caption","sourcebytes":[67,111,110,110,101,99,116,105,111,110,115],"value":"Connections"}, +{"hash":125299305,"name":"tmainform.cboptionuseproxy.caption","sourcebytes":[85,115,101,32,112,114,111,120,121],"value":"Use proxy"}, +{"hash":66921287,"name":"tmainform.gboptionproxy.caption","sourcebytes":[80,114,111,120,121,32,99,111,110,102,105,103],"value":"Proxy config"}, +{"hash":325284,"name":"tmainform.lboptionhost.caption","sourcebytes":[72,111,115,116],"value":"Host"}, +{"hash":184330448,"name":"tmainform.edoptionhost.texthint","sourcebytes":[80,114,111,120,121,32,104,111,115,116,47,73,80],"value":"Proxy host/IP"}, +{"hash":164185077,"name":"tmainform.lboptionuser.caption","sourcebytes":[85,115,101,114,110,97,109,101],"value":"Username"}, +{"hash":11073157,"name":"tmainform.edoptionuser.texthint","sourcebytes":[80,114,111,120,121,32,117,115,101,114,110,97,109,101],"value":"Proxy username"}, +{"hash":358036,"name":"tmainform.lboptionport.caption","sourcebytes":[80,111,114,116],"value":"Port"}, +{"hash":145417188,"name":"tmainform.lboptionpass.caption","sourcebytes":[80,97,115,115,119,111,114,100],"value":"Password"}, +{"hash":29717652,"name":"tmainform.edoptionpass.texthint","sourcebytes":[80,114,111,120,121,32,112,97,115,115,119,111,114,100],"value":"Proxy password"}, +{"hash":376933,"name":"tmainform.lboptionproxytype.caption","sourcebytes":[84,121,112,101],"value":"Type"}, +{"hash":317840,"name":"tmainform.cboptionproxytype.text","sourcebytes":[72,84,84,80],"value":"HTTP"}, +{"hash":172706133,"name":"tmainform.lboptionmaxparallel.caption","sourcebytes":[78,117,109,98,101,114,32,111,102,32,100,111,119,110,108,111,97,100,101,100,32,116,97,115,107,115,32,97,116,32,116,104,101,32,115,97,109,101,32,116,105,109,101],"value":"Number of downloaded tasks at the same time"}, +{"hash":244185205,"name":"tmainform.lboptionmaxthread.caption","sourcebytes":[78,117,109,98,101,114,32,111,102,32,100,111,119,110,108,111,97,100,101,100,32,102,105,108,101,115,32,112,101,114,32,116,97,115,107,32,97,116,32,116,104,101,32,115,97,109,101,32,116,105,109,101],"value":"Number of downloaded files per task at the same time"}, +{"hash":34874153,"name":"tmainform.lboptionmaxretry.caption","sourcebytes":[78,117,109,98,101,114,32,111,102,32,114,101,116,114,121,32,116,105,109,101,115,32,105,102,32,116,97,115,107,115,32,104,97,118,101,32,100,111,119,110,108,111,97,100,32,112,114,111,98,108,101,109,115,32,40,45,49,32,61,32,97,108,119,97,121,115,32,114,101,116,114,121,41],"value":"Number of retry times if tasks have download problems (-1 = always retry)"}, +{"hash":161967481,"name":"tmainform.lboptionconnectiontimeout.caption","sourcebytes":[67,111,110,110,101,99,116,105,111,110,32,116,105,109,101,111,117,116,32,40,115,101,99,111,110,100,115,41],"value":"Connection timeout (seconds)"}, +{"hash":225523060,"name":"tmainform.lboptionretryfailedtask.caption","sourcebytes":[78,117,109,98,101,114,32,111,102,32,114,101,116,114,121,32,116,105,109,101,115,32,105,102,32,116,97,115,107,32,102,97,105,108,101,100],"value":"Number of retry times if task failed"}, +{"hash":168552227,"name":"tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption","sourcebytes":[65,108,119,97,121,115,32,115,116,97,114,116,32,116,97,115,107,32,102,114,111,109,32,102,97,105,108,101,100,32,99,104,97,112,116,101,114,115],"value":"Always start task from failed chapters"}, +{"hash":160200703,"name":"tmainform.tssaveto.caption","sourcebytes":[83,97,118,101,32,116,111],"value":"Save to"}, +{"hash":96652067,"name":"tmainform.rgoptioncompress.caption","sourcebytes":[83,97,118,101,32,100,111,119,110,108,111,97,100,101,100,32,99,104,97,112,116,101,114,115,32,97,115],"value":"Save downloaded chapters as"}, +{"hash":206060487,"name":"tmainform.gboptionrenaming.caption","sourcebytes":[82,101,110,97,109,105,110,103],"value":"Renaming"}, +{"hash":117199758,"name":"tmainform.cboptionchangeunicodecharacter.hint","sourcebytes":[69,110,97,98,108,101,32,116,104,105,115,32,105,102,32,121,111,117,32,104,97,118,101,32,112,114,111,98,108,101,109,32,119,105,116,104,32,117,110,105,99,111,100,101,32,99,104,97,114,97,99,116,101,114,32,105,110,32,112,97,116,104,46],"value":"Enable this if you have problem with unicode character in path."}, +{"hash":135172728,"name":"tmainform.cboptionchangeunicodecharacter.caption","sourcebytes":[82,101,112,108,97,99,101,32,97,108,108,32,117,110,105,99,111,100,101,32,99,104,97,114,97,99,116,101,114,32,119,105,116,104],"value":"Replace all unicode character with"}, +{"hash":153869381,"name":"tmainform.cboptiongeneratemangafolder.caption","sourcebytes":[65,117,116,111,32,103,101,110,101,114,97,116,101,32,102,111,108,100,101,114,32,98,97,115,101,100,32,111,110,32,109,97,110,103,97,39,115,32,110,97,109,101],"value":"Auto generate folder based on manga's name"}, +{"hash":8004730,"name":"tmainform.lboptionmangacustomrename.caption","sourcebytes":[77,97,110,103,97,32,102,111,108,100,101,114,32,110,97,109,101,58],"value":"Manga folder name:"}, +{"hash":222491525,"name":"tmainform.edoptionmangacustomrename.texthint","sourcebytes":[67,117,115,116,111,109,32,114,101,110,97,109,101],"value":"Custom rename"}, +{"hash":158256302,"name":"tmainform.lboptionmangacustomrenamehint.hint","sourcebytes":[37,87,69,66,83,73,84,69,37,32,58,32,87,101,98,115,105,116,101,32,110,97,109,101,13,10,37,77,65,78,71,65,37,32,58,32,77,97,110,103,97,32,116,105,116,108,101,13,10,37,65,85,84,72,79,82,37,32,58,32,65,117,116,104,111,114,13,10,37,65,82,84,73,83,84,37,32,58,32,65,114,116,105,115,116,13,10,13,10,78,111,116,101,58,13,10,77,97,110,103,97,32,102,111,108,100,101,114,32,110,97,109,101,32,109,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,37,77,65,78,71,65,37,46],"value":"%WEBSITE% : Website name\r\n%MANGA% : Manga title\r\n%AUTHOR% : Author\r\n%ARTIST% : Artist\r\n\r\nNote:\r\nManga folder name must have at least %MANGA%."}, +{"hash":24397,"name":"tmainform.lboptionmangacustomrenamehint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":245130434,"name":"tmainform.cboptionremovemanganamefromchapter.caption","sourcebytes":[82,101,109,111,118,101,32,109,97,110,103,97,32,110,97,109,101,32,102,114,111,109,32,99,104,97,112,116,101,114],"value":"Remove manga name from chapter"}, +{"hash":28489826,"name":"tmainform.cboptiongeneratechapterfolder.caption","sourcebytes":[65,117,116,111,32,103,101,110,101,114,97,116,101,32,99,104,97,112,116,101,114,32,102,111,108,100,101,114],"value":"Auto generate chapter folder"}, +{"hash":228333834,"name":"tmainform.lboptionchaptercustomrename.caption","sourcebytes":[67,104,97,112,116,101,114,32,110,97,109,101,58],"value":"Chapter name:"}, +{"hash":222491525,"name":"tmainform.edoptionchaptercustomrename.texthint","sourcebytes":[67,117,115,116,111,109,32,114,101,110,97,109,101],"value":"Custom rename"}, +{"hash":157813262,"name":"tmainform.lboptionchaptercustomrenamehint.hint","sourcebytes":[37,87,69,66,83,73,84,69,37,32,58,32,87,101,98,115,105,116,101,32,110,97,109,101,13,10,37,77,65,78,71,65,37,32,58,32,77,97,110,103,97,32,116,105,116,108,101,13,10,37,67,72,65,80,84,69,82,37,32,58,32,67,104,97,112,116,101,114,32,116,105,116,108,101,13,10,37,65,85,84,72,79,82,37,32,58,32,65,117,116,104,111,114,13,10,37,65,82,84,73,83,84,37,32,58,32,65,114,116,105,115,116,13,10,37,78,85,77,66,69,82,73,78,71,37,32,58,32,78,117,109,98,101,114,105,110,103,13,10,13,10,78,111,116,101,58,13,10,67,104,97,112,116,101,114,32,102,111,108,100,101,114,32,110,97,109,101,32,109,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,37,67,72,65,80,84,69,82,37,32,111,114,32,37,78,85,77,66,69,82,73,78,71,37,46],"value":"%WEBSITE% : Website name\r\n%MANGA% : Manga title\r\n%CHAPTER% : Chapter title\r\n%AUTHOR% : Author\r\n%ARTIST% : Artist\r\n%NUMBERING% : Numbering\r\n\r\nNote:\r\nChapter folder name must have at least %CHAPTER% or %NUMBERING%."}, +{"hash":24397,"name":"tmainform.lboptionchaptercustomrenamehint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":182972947,"name":"tmainform.lboptionrenamedigits.caption","sourcebytes":[82,101,110,97,109,101,32,32,100,105,103,105,116,115],"value":"Rename digits"}, +{"hash":97926197,"name":"tmainform.cboptiondigitvolume.caption","sourcebytes":[86,111,108,117,109,101],"value":"Volume"}, +{"hash":166230658,"name":"tmainform.cboptiondigitchapter.caption","sourcebytes":[67,104,97,112,116,101,114],"value":"Chapter"}, +{"hash":225313701,"name":"tmainform.lboptionfilenamecustomrenamehint.hint","sourcebytes":[37,87,69,66,83,73,84,69,37,32,58,32,87,101,98,115,105,116,101,32,110,97,109,101,13,10,37,77,65,78,71,65,37,32,58,32,77,97,110,103,97,32,116,105,116,108,101,13,10,37,67,72,65,80,84,69,82,37,32,58,32,67,104,97,112,116,101,114,32,116,105,116,108,101,13,10,37,70,73,76,69,78,65,77,69,37,32,58,32,70,105,108,101,110,97,109,101,13,10,13,10,78,111,116,101,58,13,10,70,105,108,101,110,97,109,101,32,109,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,37,70,73,76,69,78,65,77,69,37],"value":"%WEBSITE% : Website name\r\n%MANGA% : Manga title\r\n%CHAPTER% : Chapter title\r\n%FILENAME% : Filename\r\n\r\nNote:\r\nFilename must have at least %FILENAME%"}, +{"hash":24397,"name":"tmainform.lboptionfilenamecustomrenamehint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":222491525,"name":"tmainform.edoptionfilenamecustomrename.texthint","sourcebytes":[67,117,115,116,111,109,32,114,101,110,97,109,101],"value":"Custom rename"}, +{"hash":46419594,"name":"tmainform.lboptionfilenamecustomrename.caption","sourcebytes":[70,105,108,101,110,97,109,101,58],"value":"Filename:"}, +{"hash":1010826,"name":"tmainform.lbdefaultdownloadpath.caption","sourcebytes":[67,104,111,111,115,101,32,116,104,101,32,100,101,102,97,117,108,116,32,100,111,119,110,108,111,97,100,32,112,97,116,104,58],"value":"Choose the default download path:"}, +{"hash":24397,"name":"tmainform.lboptionpdfqualityhint.caption","sourcebytes":[91,63,93],"value":"[?]"}, +{"hash":265971401,"name":"tmainform.seoptionpdfquality.hint","sourcebytes":[49,48,48,32,61,32,70,108,97,116,101,69,110,99,111,100,101,32,40,108,111,115,115,108,101,115,115,41,44,32,108,111,119,101,114,32,61,32,68,67,84,69,110,99,111,100,101,32,40,108,111,115,115,121,41],"value":"100 = FlateEncode (lossless), lower = DCTEncode (lossy)"}, +{"hash":265971401,"name":"tmainform.lboptionpdfquality.hint","sourcebytes":[49,48,48,32,61,32,70,108,97,116,101,69,110,99,111,100,101,32,40,108,111,115,115,108,101,115,115,41,44,32,108,111,119,101,114,32,61,32,68,67,84,69,110,99,111,100,101,32,40,108,111,115,115,121,41],"value":"100 = FlateEncode (lossless), lower = DCTEncode (lossy)"}, +{"hash":13786124,"name":"tmainform.lboptionpdfquality.caption","sourcebytes":[80,68,70,32,99,111,109,112,114,101,115,115,105,111,110,32,108,101,118,101,108],"value":"PDF compression level"}, +{"hash":8726312,"name":"tmainform.edoptiondefaultpath.texthint","sourcebytes":[68,101,102,97,117,108,116,32,100,111,119,110,108,111,97,100,32,112,97,116,104],"value":"Default download path"}, +{"hash":28850558,"name":"tmainform.gbimageconversion.caption","sourcebytes":[73,109,97,103,101,32,67,111,110,118,101,114,115,105,111,110],"value":"Image Conversion"}, +{"hash":137355731,"name":"tmainform.lbwebpsaveas.caption","sourcebytes":[83,97,118,101,32,87,101,98,80,32,97,115],"value":"Save WebP as"}, +{"hash":21799,"name":"tmainform.cbwebpsaveas.text","sourcebytes":[80,78,71],"value":"PNG"}, +{"hash":32654252,"name":"tmainform.lbpngcompressionlevel.caption","sourcebytes":[80,78,71,32,67,111,109,112,114,101,115,115,105,111,110,32,108,101,118,101,108],"value":"PNG Compression level"}, +{"hash":210414820,"name":"tmainform.cbpngcompressionlevel.text","sourcebytes":[70,97,115,116,101,115,116],"value":"Fastest"}, +{"hash":205834697,"name":"tmainform.lbjpegquality.caption","sourcebytes":[74,80,69,71,32,113,117,97,108,105,116,121],"value":"JPEG quality"}, +{"hash":252069175,"name":"tmainform.ckpngsaveasjpeg.caption","sourcebytes":[83,97,118,101,32,80,78,71,32,97,115,32,74,80,69,71],"value":"Save PNG as JPEG"}, +{"hash":208308883,"name":"tmainform.tsupdate.caption","sourcebytes":[85,112,100,97,116,101,115],"value":"Updates"}, +{"hash":72408384,"name":"tmainform.cboptionautochecklatestversion.caption","sourcebytes":[65,117,116,111,32,99,104,101,99,107,32,102,111,114,32,108,97,116,101,115,116,32,118,101,114,115,105,111,110,32],"value":"Auto check for latest version "}, +{"hash":225003075,"name":"tmainform.gboptionfavorites.caption","sourcebytes":[70,97,118,111,114,105,116,101,115],"value":"Favorites"}, +{"hash":4527776,"name":"tmainform.cboptionautocheckfavstartup.caption","sourcebytes":[65,117,116,111,32,99,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114,32,97,116,32,115,116,97,114,116,117,112],"value":"Auto check for new chapter at startup"}, +{"hash":12237571,"name":"tmainform.lboptionautocheckfavintervalminutes.caption","sourcebytes":[65,117,116,111,32,99,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114,32,101,118,101,114,121,32,37,100,32,109,105,110,117,116,101,115],"value":"Auto check for new chapter every %d minutes"}, +{"hash":234489075,"name":"tmainform.cboptionautocheckfavremovecompletedmanga.caption","sourcebytes":[65,117,116,111,109,97,116,105,99,32,114,101,109,111,118,101,32,99,111,109,112,108,101,116,101,100,32,109,97,110,103,97,32,102,114,111,109,32,70,97,118,111,114,105,116,101,115],"value":"Automatic remove completed manga from Favorites"}, +{"hash":44744407,"name":"tmainform.cboptionautocheckfavdownload.caption","sourcebytes":[65,117,116,111,109,97,116,105,99,32,100,111,119,110,108,111,97,100,32,97,102,116,101,114,32,102,105,110,105,115,104,32,99,104,101,99,107,105,110,103],"value":"Automatic download after finish checking"}, +{"hash":248673660,"name":"tmainform.cboptionautocheckfavinterval.caption","sourcebytes":[65,117,116,111,32,99,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114,32,105,110,32,97,110,32,105,110,116,101,114,118,97,108],"value":"Auto check for new chapter in an interval"}, +{"hash":138709376,"name":"tmainform.cboptionautoopenfavstartup.caption","sourcebytes":[79,112,101,110,32,70,97,118,111,114,105,116,101,115,32,97,116,32,115,116,97,114,116,117,112],"value":"Open Favorites at startup"}, +{"hash":9269721,"name":"tmainform.cboptionupdatelistnomangainfo.caption","sourcebytes":[68,111,110,39,116,32,108,111,97,100,32,109,97,110,103,97,32,105,110,102,111,114,109,97,116,105,111,110,32,119,104,101,110,32,117,112,100,97,116,105,110,103,32,108,105,115,116,32,40,102,105,108,116,101,114,32,119,105,108,108,32,98,101,32,110,111,116,32,119,111,114,107,33,41],"value":"Don't load manga information when updating list (filter will be not work!)"}, +{"hash":182501908,"name":"tmainform.cboptionupdatelistremoveduplicatelocaldata.caption","sourcebytes":[82,101,109,111,118,101,32,100,117,112,108,105,99,97,116,101,32,108,111,99,97,108,32,100,97,116,97,32,119,104,101,110,32,117,112,100,97,116,105,110,103,32,109,97,110,103,97,32,108,105,115,116],"value":"Remove duplicate local data when updating manga list"}, +{"hash":184038819,"name":"tmainform.tsdialogs.caption","sourcebytes":[68,105,97,108,111,103,115],"value":"Dialogs"}, +{"hash":263412434,"name":"tmainform.gbdialogs.caption","sourcebytes":[83,104,111,119,32,100,105,97,108,111,103,32,99,111,110,102,105,114,109,97,116,105,111,110,32,102,111,114],"value":"Show dialog confirmation for"}, +{"hash":252071892,"name":"tmainform.cboptionshowquitdialog.caption","sourcebytes":[69,120,105,116,32,70,77,68],"value":"Exit FMD"}, +{"hash":242423477,"name":"tmainform.cboptionshowdeletetaskdialog.caption","sourcebytes":[68,101,108,101,116,101,32,116,97,115,107,47,102,97,118,111,114,105,116,101],"value":"Delete task/favorite"}, +{"hash":221590857,"name":"tmainform.cboptionshowdownloadmangalistdialog.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,109,97,110,103,97,32,108,105,115,116,32,105,102,32,101,109,112,116,121],"value":"Download manga list if empty"}, +{"hash":194645779,"name":"tmainform.tswebsites.caption","sourcebytes":[87,101,98,115,105,116,101,115],"value":"Websites"}, +{"hash":194645779,"name":"tmainform.tswebsiteselection.caption","sourcebytes":[87,101,98,115,105,116,101,115],"value":"Websites"}, +{"hash":138578252,"name":"tmainform.tbwebsitesexpandall.caption","sourcebytes":[69,120,112,97,110,100,32,65,108,108],"value":"Expand All"}, +{"hash":53573292,"name":"tmainform.tbwebsitescollapseall.caption","sourcebytes":[67,111,108,108,97,112,115,101,32,65,108,108],"value":"Collapse All"}, +{"hash":32777246,"name":"tmainform.edwebsitessearch.texthint","sourcebytes":[83,101,97,114,99,104,32,119,101,98,115,105,116,101,46,46,46],"value":"Search website..."}, +{"hash":161923523,"name":"tmainform.tsaccounts.caption","sourcebytes":[65,99,99,111,117,110,116,115],"value":"Accounts"}, +{"hash":108725763,"name":"tmainform.tswebsiteoptions.caption","sourcebytes":[79,112,116,105,111,110,115],"value":"Options"}, +{"hash":197676484,"name":"tmainform.tswebsiteadvanced.caption","sourcebytes":[65,100,118,97,110,99,101,100],"value":"Advanced"}, +{"hash":73122451,"name":"tmainform.tswebsitemodules.caption","sourcebytes":[77,111,100,117,108,101,115],"value":"Modules"}, +{"hash":344211,"name":"tmainform.tsmisc.caption","sourcebytes":[77,105,115,99],"value":"Misc"}, +{"hash":197593650,"name":"tmainform.tscustomcolor.caption","sourcebytes":[67,117,115,116,111,109,32,99,111,108,111,114],"value":"Custom color"}, +{"hash":21335,"name":"tmainform.tslog.caption","sourcebytes":[76,111,103],"value":"Log"}, +{"hash":119864823,"name":"tmainform.ckenablelogging.caption","sourcebytes":[69,110,97,98,108,101,32,108,111,103,103,105,110,103],"value":"Enable logging"}, +{"hash":120491445,"name":"tmainform.btclearlogfile.caption","sourcebytes":[67,108,101,97,114,32,108,111,103,32,102,105,108,101],"value":"Clear log file"}, +{"hash":158118362,"name":"tmainform.lblogfilename.caption","sourcebytes":[76,111,103,32,102,105,108,101,58],"value":"Log file:"}, +{"hash":113276983,"name":"tmainform.btopenlog.caption","sourcebytes":[79,112,101,110,32,108,111,103],"value":"Open log"}, +{"hash":4749113,"name":"tmainform.btoptionapply.caption","sourcebytes":[65,112,112,108,121],"value":"Apply"}, +{"hash":4691652,"name":"tmainform.tsabout.caption","sourcebytes":[65,98,111,117,116],"value":"About"}, +{"hash":101464798,"name":"tmainform.btchecklatestversion.caption","sourcebytes":[67,104,101,99,107,32,102,111,114,32,108,97,116,101,115,116,32,118,101,114,115,105,111,110],"value":"Check for latest version"}, +{"hash":163353879,"name":"tmainform.btvisitmyblog.caption","sourcebytes":[86,105,115,105,116,32,109,121,32,98,108,111,103],"value":"Visit my blog"}, +{"hash":113643140,"name":"tmainform.tsabouttext.caption","sourcebytes":[65,98,111,117,116,32,70,77,68],"value":"About FMD"}, +{"hash":139332791,"name":"tmainform.tschangelogtext.caption","sourcebytes":[67,104,97,110,103,101,108,111,103],"value":"Changelog"}, +{"hash":371552,"name":"tmainform.midownloadstop.caption","sourcebytes":[83,116,111,112],"value":"Stop"}, +{"hash":93105205,"name":"tmainform.midownloadresume.caption","sourcebytes":[82,101,115,117,109,101],"value":"Resume"}, +{"hash":79984933,"name":"tmainform.midownloadenable.caption","sourcebytes":[69,110,97,98,108,101],"value":"Enable"}, +{"hash":185170277,"name":"tmainform.midownloaddisable.caption","sourcebytes":[68,105,115,97,98,108,101],"value":"Disable"}, +{"hash":78392485,"name":"tmainform.midownloaddelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, +{"hash":165093305,"name":"tmainform.midownloaddeletetask.caption","sourcebytes":[84,97,115,107,32,111,110,108,121],"value":"Task only"}, +{"hash":42869105,"name":"tmainform.midownloaddeletetaskdata.caption","sourcebytes":[84,97,115,107,32,43,32,68,97,116,97],"value":"Task + Data"}, +{"hash":267175541,"name":"tmainform.midownloaddeletetaskdatafavorite.caption","sourcebytes":[84,97,115,107,32,43,32,68,97,116,97,32,43,32,70,97,118,111,114,105,116,101],"value":"Task + Data + Favorite"}, +{"hash":235571507,"name":"tmainform.midownloaddeletecompleted.caption","sourcebytes":[68,101,108,101,116,101,32,97,108,108,32,99,111,109,112,108,101,116,101,100,32,116,97,115,107,115],"value":"Delete all completed tasks"}, +{"hash":180320563,"name":"tmainform.midownloadmergecompleted.caption","sourcebytes":[77,101,114,103,101,32,99,111,109,112,108,101,116,101,100,32,116,97,115,107,115],"value":"Merge completed tasks"}, +{"hash":27371647,"name":"tmainform.midownloadviewmangainfo.caption","sourcebytes":[86,105,101,119,32,109,97,110,103,97,32,105,110,102,111],"value":"View manga info"}, +{"hash":77874882,"name":"tmainform.midownloadopenfolder.caption","sourcebytes":[79,112,101,110,32,70,111,108,100,101,114],"value":"Open Folder"}, +{"hash":113260142,"name":"tmainform.midownloadopenwith.caption","sourcebytes":[79,112,101,110,32,46,46,46],"value":"Open ..."}, +{"hash":110262708,"name":"tmainform.michapterlistcheckselected.caption","sourcebytes":[67,104,101,99,107,32,115,101,108,101,99,116,101,100],"value":"Check selected"}, +{"hash":110606772,"name":"tmainform.michapterlistuncheckselected.caption","sourcebytes":[85,110,99,104,101,99,107,32,115,101,108,101,99,116,101,100],"value":"Uncheck selected"}, +{"hash":194850764,"name":"tmainform.michapterlistcheckall.caption","sourcebytes":[67,104,101,99,107,32,97,108,108],"value":"Check all"}, +{"hash":197210060,"name":"tmainform.michapterlistuncheckall.caption","sourcebytes":[85,110,99,104,101,99,107,32,97,108,108],"value":"Uncheck all"}, +{"hash":15962307,"name":"tmainform.michapterlisthighlight.caption","sourcebytes":[72,105,103,104,108,105,103,104,116,32,100,111,119,110,108,111,97,100,101,100,32,99,104,97,112,116,101,114,115],"value":"Highlight downloaded chapters"}, +{"hash":112147507,"name":"tmainform.michapterlisthidedownloaded.caption","sourcebytes":[72,105,100,101,32,100,111,119,110,108,111,97,100,101,100,32,99,104,97,112,116,101,114,115],"value":"Hide downloaded chapters"}, +{"hash":80755394,"name":"tmainform.michapterlistfilter.caption","sourcebytes":[70,105,108,116,101,114],"value":"Filter"}, +{"hash":163899607,"name":"tmainform.michapterlistascending.caption","sourcebytes":[65,115,99,101,110,100,105,110,103],"value":"Ascending"}, +{"hash":163579095,"name":"tmainform.michapterlistdescending.caption","sourcebytes":[68,101,115,99,101,110,100,105,110,103],"value":"Descending"}, +{"hash":165778738,"name":"tmainform.mifavoriteschecknewchapter.caption","sourcebytes":[67,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114],"value":"Check for new chapter"}, +{"hash":222540418,"name":"tmainform.mifavoritesstopchecknewchapter.caption","sourcebytes":[83,116,111,112,32,99,104,101,99,107,32,102,111,114,32,110,101,119,32,99,104,97,112,116,101,114],"value":"Stop check for new chapter"}, +{"hash":79984933,"name":"tmainform.mifavoritesenable.caption","sourcebytes":[69,110,97,98,108,101],"value":"Enable"}, +{"hash":185170277,"name":"tmainform.mifavoritesdisable.caption","sourcebytes":[68,105,115,97,98,108,101],"value":"Disable"}, +{"hash":27371647,"name":"tmainform.mifavoritesviewinfos.caption","sourcebytes":[86,105,101,119,32,109,97,110,103,97,32,105,110,102,111],"value":"View manga info"}, +{"hash":29393692,"name":"tmainform.mifavoritesdownloadall.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,97,108,108],"value":"Download all"}, +{"hash":93079605,"name":"tmainform.mifavoritesrename.caption","sourcebytes":[82,101,110,97,109,101],"value":"Rename"}, +{"hash":136379477,"name":"tmainform.mifavoritestransferwebsite.caption","sourcebytes":[84,114,97,110,115,102,101,114,32,119,101,98,115,105,116,101],"value":"Transfer website"}, +{"hash":78392485,"name":"tmainform.mifavoritesdelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, +{"hash":94036626,"name":"tmainform.mifavoriteschangecurrentchapter.caption","sourcebytes":[67,104,97,110,103,101,32,34,67,117,114,114,101,110,116,32,99,104,97,112,116,101,114,34],"value":"Change \"Current chapter\""}, +{"hash":202687490,"name":"tmainform.mifavoriteschangesaveto.caption","sourcebytes":[67,104,97,110,103,101,32,34,83,97,118,101,32,116,111,34],"value":"Change \"Save to\""}, +{"hash":77874882,"name":"tmainform.mifavoritesopenfolder.caption","sourcebytes":[79,112,101,110,32,70,111,108,100,101,114],"value":"Open Folder"}, +{"hash":113260142,"name":"tmainform.mifavoritesopenwith.caption","sourcebytes":[79,112,101,110,32,46,46,46],"value":"Open ..."}, +{"hash":169511027,"name":"tmainform.mimangalistviewinfos.caption","sourcebytes":[86,105,101,119,32,109,97,110,103,97,32,105,110,102,111,115],"value":"View manga infos"}, +{"hash":29393692,"name":"tmainform.mimangalistdownloadall.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,97,108,108],"value":"Download all"}, +{"hash":215890979,"name":"tmainform.mimangalistaddtofavorites.caption","sourcebytes":[65,100,100,32,116,111,32,70,97,118,111,114,105,116,101,115],"value":"Add to Favorites"}, +{"hash":78392485,"name":"tmainform.mimangalistdelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, +{"hash":175694497,"name":"tmainform.mihighlightnewmanga.caption","sourcebytes":[72,105,103,104,108,105,103,104,116,32,110,101,119,32,109,97,110,103,97],"value":"Highlight new manga"}, +{"hash":119443044,"name":"tmainform.mnupdatelist.caption","sourcebytes":[85,112,100,97,116,101,32,109,97,110,103,97,32,108,105,115,116],"value":"Update manga list"}, +{"hash":11631810,"name":"tmainform.mnupdatedownfromserver.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,109,97,110,103,97,32,108,105,115,116,32,102,114,111,109,32,115,101,114,118,101,114],"value":"Download manga list from server"}, +{"hash":164591397,"name":"tmainform.mnupdate1click.caption","sourcebytes":[85,112,100,97,116,101,32,97,108,108,32,108,105,115,116,115,32,97,116,32,111,110,99,101],"value":"Update all lists at once"}, +{"hash":182967733,"name":"tmainform.mndownload1click.caption","sourcebytes":[68,111,119,110,108,111,97,100,32,97,108,108,32,108,105,115,116,115,32,102,114,111,109,32,115,101,114,118,101,114,32,97,116,32,111,110,99,101],"value":"Download all lists from server at once"}, +{"hash":378031,"name":"tmainform.medurlundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"}, +{"hash":19140,"name":"tmainform.medurlcut.caption","sourcebytes":[67,117,116],"value":"Cut"}, +{"hash":304761,"name":"tmainform.medurlcopy.caption","sourcebytes":[67,111,112,121],"value":"Copy"}, +{"hash":5671589,"name":"tmainform.medurlpaste.caption","sourcebytes":[80,97,115,116,101],"value":"Paste"}, +{"hash":53267631,"name":"tmainform.medurlpasteandgo.caption","sourcebytes":[80,97,115,116,101,32,97,110,100,32,103,111],"value":"Paste and go"}, +{"hash":78392485,"name":"tmainform.medturldelete.caption","sourcebytes":[68,101,108,101,116,101],"value":"Delete"}, +{"hash":195296268,"name":"tmainform.medurlselectall.caption","sourcebytes":[83,101,108,101,99,116,32,97,108,108],"value":"Select all"}, +{"hash":4691604,"name":"tmainform.miabortsilentthread.caption","sourcebytes":[65,98,111,114,116],"value":"Abort"}, +{"hash":194850764,"name":"tmainform.mnfiltergenreallcheck.caption","sourcebytes":[67,104,101,99,107,32,97,108,108],"value":"Check all"}, +{"hash":197210060,"name":"tmainform.mnfiltergenrealluncheck.caption","sourcebytes":[85,110,99,104,101,99,107,32,97,108,108],"value":"Uncheck all"}, +{"hash":37622444,"name":"tmainform.mnfiltergenreallindeterminate.caption","sourcebytes":[73,110,100,101,116,101,114,109,105,110,97,116,101,32,97,108,108],"value":"Indeterminate all"}, +{"hash":204663948,"name":"tmainform.mitrayresumeall.caption","sourcebytes":[82,101,115,117,109,101,32,97,108,108],"value":"Resume all"}, +{"hash":190997388,"name":"tmainform.mitraystopall.caption","sourcebytes":[83,116,111,112,32,97,108,108],"value":"Stop all"}, +{"hash":240732488,"name":"tmainform.mitrayafterdownloadfinish.caption","sourcebytes":[65,102,116,101,114,32,100,111,119,110,108,111,97,100,32,102,105,110,105,115,104],"value":"After download finish"}, +{"hash":90894359,"name":"tmainform.mitrayfinishnothing.caption","sourcebytes":[78,111,116,104,105,110,103],"value":"Nothing"}, +{"hash":315140,"name":"tmainform.mitrayfinishexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"}, +{"hash":264942414,"name":"tmainform.mitrayfinishshutdown.caption","sourcebytes":[83,104,117,116,100,111,119,110],"value":"Shutdown"}, +{"hash":147392085,"name":"tmainform.mitrayfinishhibernate.caption","sourcebytes":[72,105,98,101,114,110,97,116,101],"value":"Hibernate"}, +{"hash":43310472,"name":"tmainform.mitrayshowdropbox.caption","sourcebytes":[83,104,111,119,32,68,114,111,112,32,66,111,120],"value":"Show Drop Box"}, +{"hash":147502805,"name":"tmainform.mitrayrestore.caption","sourcebytes":[82,101,115,116,111,114,101],"value":"Restore"}, +{"hash":315140,"name":"tmainform.mitrayexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"} +]} diff --git a/mangadownloader/forms/frmMain.pas b/mangadownloader/forms/frmMain.pas index 1969b4204..ab84ad427 100644 --- a/mangadownloader/forms/frmMain.pas +++ b/mangadownloader/forms/frmMain.pas @@ -16,13 +16,15 @@ interface {$else} FakeActiveX, {$endif} - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, - LCLType, ExtCtrls, ComCtrls, Buttons, Spin, Menus, VirtualTrees, RichMemo, - IniFiles, simpleipc, lclproc, types, strutils, LCLIntf, DefaultTranslator, - EditBtn, LazUTF8, TAGraph, TASources, TASeries, AnimatedGif, uBaseUnit, uData, - uDownloadsManager, uFavoritesManager, uUpdateThread, uUpdateDBThread, - uSubThread, uSilentThread, uMisc, uGetMangaInfosThread, uTranslation, - frmDropTarget, USimpleException, USimpleLogger; + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLType, ExtCtrls, ComCtrls, + Buttons, Spin, Menus, VirtualTrees, RichMemo, IniFiles, simpleipc, lclproc, types, LCLIntf, + DefaultTranslator, EditBtn, PairSplitter, MultiLog, FileChannel, FileUtil, LazUTF8Classes, + TAGraph, TASources, TASeries, TATools, AnimatedGif, uBaseUnit, uDownloadsManager, + uFavoritesManager, uUpdateThread, uSilentThread, uMisc, + uGetMangaInfosThread, frmDropTarget, frmAccountManager, frmWebsiteOptionCustom, + frmCustomColor, frmLogger, frmTransferFavorites, + frmLuaModulesUpdater, CheckUpdate, DBDataProcess, MangaFoxWatermark, + SimpleTranslator, FMDOptions, httpsendthread, SimpleException; type @@ -30,11 +32,11 @@ interface TMainForm = class(TForm) appPropertiesMain: TApplicationProperties; - Bevel1: TBevel; + btOpenLog: TBitBtn; + btClearLogFile: TBitBtn; btAddToFavorites: TBitBtn; - btBrowse: TSpeedButton; btCancelFavoritesCheck: TSpeedButton; - btOptionBrowse: TSpeedButton; + btAbortCheckLatestVersion: TSpeedButton; btChecks: TSpeedButton; btDonate: TImage; btFavoritesImport: TBitBtn; @@ -43,23 +45,135 @@ TMainForm = class(TForm) btOptionApply: TBitBtn; btReadOnline: TBitBtn; btRemoveFilter: TSpeedButton; - btSearchClear: TSpeedButton; - btWebsitesSearchClear: TSpeedButton; + btMangaListSearchClear: TSpeedButton; btUpdateList: TSpeedButton; - btURL: TSpeedButton; - cbOptionAutoDlFav: TCheckBox; - cbOptionAutoRemoveCompletedManga: TCheckBox; + cbOptionAutoCheckFavStartup: TCheckBox; + cbOptionAutoCheckFavInterval: TCheckBox; + cbOptionAutoCheckFavDownload: TCheckBox; + cbOptionAutoCheckFavRemoveCompletedManga: TCheckBox; + cbOptionAutoOpenFavStartup: TCheckBox; + cbOptionDeleteCompletedTasksOnClose: TCheckBox; cbOptionEnableLoadCover: TCheckBox; + cbOptionMinimizeOnStart: TCheckBox; + cbOptionShowBalloonHint: TCheckBox; + cbOptionGenerateChapterFolder: TCheckBox; + cbOptionRemoveMangaNameFromChapter: TCheckBox; + cbOptionShowDownloadMangalistDialog: TCheckBox; cbOptionShowDownloadToolbar: TCheckBox; + cbOptionShowDownloadToolbarLeft: TCheckBox; + cbOptionShowDownloadToolbarDeleteAll: TCheckBox; cbOptionUpdateListNoMangaInfo: TCheckBox; cbOptionDigitVolume: TCheckBox; cbOptionDigitChapter: TCheckBox; - cbOptionMangaFoxRemoveWatermarks: TCheckBox; cbOptionLiveSearch: TCheckBox; cbOptionUpdateListRemoveDuplicateLocalData : TCheckBox; cbUseRegExpr: TCheckBox; cbOptionProxyType: TComboBox; cbOptionOneInstanceOnly: TCheckBox; + ckPNGSaveAsJPEG: TCheckBox; + ckOptionsAlwaysStartTaskFromFailedChapters: TCheckBox; + ckEnableLogging: TCheckBox; + cbWebPSaveAs: TComboBox; + cbPNGCompressionLevel: TComboBox; + edDownloadsSearch: TEditButton; + edFavoritesSearch: TEditButton; + edFilterMangaInfoChapters: TEditButton; + edLogFileName: TEditButton; + edOptionChangeUnicodeCharacterStr: TEdit; + edOptionDefaultPath: TEditButton; + edOptionExternalPath: TEditButton; + edOptionFilenameCustomRename: TEdit; + edOptionMangaCustomRename: TEdit; + edSaveTo: TEditButton; + edURL: TEditButton; + edWebsitesSearch: TEditButton; + gbImageConversion: TGroupBox; + IconDLLeft: TImageList; + lbPNGCompressionLevel: TLabel; + lbJPEGQuality: TLabel; + lbWebPSaveAs: TLabel; + lbLogFileName: TLabel; + lbOptionRetryFailedTask: TLabel; + lbOptionFilenameCustomRenameHint: TLabel; + lbOptionFilenameCustomRename: TLabel; + lbOptionMangaCustomRenameHint: TLabel; + lbOptionMangaCustomRename: TLabel; + MenuItem10: TMenuItem; + MenuItem11: TMenuItem; + miFavoritesRename: TMenuItem; + miFavoritesTransferWebsite: TMenuItem; + miFavoritesEnable: TMenuItem; + miFavoritesDisable: TMenuItem; + miChapterListDescending: TMenuItem; + miChapterListAscending: TMenuItem; + miMangaListDelete: TMenuItem; + miDownloadDeleteTaskDataFavorite: TMenuItem; + miTrayExit: TMenuItem; + miTrayRestore: TMenuItem; + miTrayShowDropBox: TMenuItem; + MenuItem8: TMenuItem; + miTrayFinishNothing: TMenuItem; + miTrayFinishExit: TMenuItem; + miTrayFinishShutdown: TMenuItem; + MenuItem2: TMenuItem; + miTrayFinishHibernate: TMenuItem; + miTrayAfterDownloadFinish: TMenuItem; + miTrayStopAll: TMenuItem; + miTrayResumeAll: TMenuItem; + miDownloadEnable: TMenuItem; + miDownloadDisable: TMenuItem; + miChapterListFilter: TMenuItem; + mnFilterGenreAllIndeterminate: TMenuItem; + mnFilterGenreAllCheck: TMenuItem; + mnFilterGenreAllUncheck: TMenuItem; + miChapterListHideDownloaded: TMenuItem; + miAbortSilentThread: TMenuItem; + mmChangelog: TMemo; + pnDownloadList: TPanel; + pnAboutComp: TPanel; + pcInfo: TPageControl; + psInfo: TPairSplitter; + pssInfoList: TPairSplitterSide; + pssInfo: TPairSplitterSide; + psDownloads: TPairSplitter; + pssDownloadsFilter: TPairSplitterSide; + pssDownloads: TPairSplitterSide; + pcMisc: TPageControl; + pcWebsiteOptions: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + Panel8: TPanel; + pcAbout: TPageControl; + pmSbMain: TPopupMenu; + pmFilterGenreAll: TPopupMenu; + pmTray: TPopupMenu; + sbSaveTo: TScrollBox; + sbWebsiteOptions: TScrollBox; + btDownloadSplit: TSpeedButton; + seOptionRetryFailedTask: TSpinEdit; + seJPEGQuality: TSpinEdit; + tsAccounts: TTabSheet; + tsWebsiteModules: TTabSheet; + ToolBarDownloadLeft: TToolBar; + tbmiDownloadMoveTop: TToolButton; + tbmiDownloadMoveUp: TToolButton; + tbmiDownloadMoveDown: TToolButton; + tbmiDownloadMoveBottom: TToolButton; + tsInfoManga: TTabSheet; + tsinfoFilterAdv: TTabSheet; + tsCustomColor: TTabSheet; + tsLog: TTabSheet; + tmAnimateMangaInfo: TTimer; + tmBackup: TTimer; + tmCheckFavorites: TTimer; + tmRefreshDownloadsInfo: TTimer; + tsWebsiteAdvanced: TTabSheet; + tsWebsiteSelection: TTabSheet; + tsWebsiteOptions: TTabSheet; + tsAboutText: TTabSheet; + tsChangelogText: TTabSheet; + TransferRateToolset: TChartToolset; miFavoritesStopCheckNewChapter: TMenuItem; miFavoritesCheckNewChapter: TMenuItem; pnDownloadToolbarLeft: TPanel; @@ -67,19 +181,13 @@ TMainForm = class(TForm) TransferRateGraphArea: TAreaSeries; TransferRateGraph: TChart; ckDropTarget: TCheckBox; - edOptionDefaultPath: TEdit; edOptionExternalParams: TEdit; - edOptionExternalPath: TFileNameEdit; - edSaveTo: TEdit; - edWebsitesSearch: TEdit; - edURL: TEdit; gbDropTarget: TGroupBox; gbOptionExternal: TGroupBox; IconDL: TImageList; IconMed: TImageList; IconSmall: TImageList; - itMonitor: TTimer; - itStartup: TIdleTimer; + tmExitCommand: TTimer; lbDefaultDownloadPath: TLabel; lbDropTargetOpacity: TLabel; lbOptionExternalParams: TLabel; @@ -89,8 +197,8 @@ TMainForm = class(TForm) lbOptionRenameDigits: TLabel; lbFilterHint: TLabel; lbOptionExternal: TLabel; - lbOptionCustomRenameHint: TLabel; - lbOptionCustomRenameHint1: TLabel; + lbOptionChapterCustomRenameHint: TLabel; + lbOptionPDFQualityHint: TLabel; lbOptionExternalParamsHint: TLabel; TransferRateGraphList: TListChartSource; medURLCut: TMenuItem; @@ -115,14 +223,12 @@ TMainForm = class(TForm) pnThumbContainer: TPanel; pnMainTop: TPanel; btVisitMyBlog: TBitBtn; - btCheckVersion: TBitBtn; + btCheckLatestVersion: TBitBtn; btFavoritesCheckNewChapter: TBitBtn; btDownload: TBitBtn; btRemoveFilterLarge: TBitBtn; - cbOptionAutoCheckUpdate: TCheckBox; + cbOptionAutoCheckLatestVersion: TCheckBox; cbOptionShowDeleteTaskDialog: TCheckBox; - cbOptionShowBatotoSG: TCheckBox; - cbOptionShowAllLang: TCheckBox; cbOptionUseProxy: TCheckBox; cbSelectManga: TComboBox; ckFilterAction: TCheckBox; @@ -161,12 +267,9 @@ TMainForm = class(TForm) cbOnlyNew: TCheckBox; cbAddAsStopped: TCheckBox; cbOptionShowQuitDialog: TCheckBox; - cbOptionPathConvert: TCheckBox; - cbOptionGenerateChapterName: TCheckBox; - cbOptionGenerateMangaFolderName: TCheckBox; + cbOptionChangeUnicodeCharacter: TCheckBox; + cbOptionGenerateMangaFolder: TCheckBox; cbOptionMinimizeToTray: TCheckBox; - cbOptionAutoNumberChapter: TCheckBox; - cbOptionAutoCheckFavStartup: TCheckBox; cbSearchFromAllSites: TCheckBox; ckFilterDoujinshi: TCheckBox; ckFilterDrama: TCheckBox; @@ -181,30 +284,24 @@ TMainForm = class(TForm) edFilterAuthors: TEdit; edFilterArtists: TEdit; edCustomGenres: TEdit; - edOptionCustomRename: TEdit; + edOptionChapterCustomRename: TEdit; edOptionHost: TEdit; edOptionPass: TEdit; edOptionPort: TEdit; edOptionUser: TEdit; - edSearch: TEdit; + edMangaListSearch: TEdit; gbDialogs: TGroupBox; gbOptionProxy: TGroupBox; gbOptionRenaming: TGroupBox; gbOptionFavorites: TGroupBox; - gbMisc: TGroupBox; IconList: TImageList; - itSaveDownloadedList: TIdleTimer; - itRefreshDLInfo: TIdleTimer; - itCheckForChapters: TIdleTimer; - itAnimate: TIdleTimer; imCover: TImage; - lbOptionCustomRename: TLabel; + lbOptionChapterCustomRename: TLabel; lbOptionPDFQuality: TLabel; - lbOptionAutoCheckMinutes: TLabel; + lbOptionAutoCheckFavIntervalMinutes: TLabel; lbOptionLetFMDDo: TLabel; lbOptionNewMangaTime: TLabel; lbOptionLanguage: TLabel; - lbOptionDialogs: TLabel; lbFilterCustomGenres: TLabel; lbFilterSummary: TLabel; lbFilterStatus: TLabel; @@ -251,10 +348,9 @@ TMainForm = class(TForm) miDownloadResume: TMenuItem; miDownloadDelete: TMenuItem; miChapterListUncheckAll: TMenuItem; - pcLeft: TPageControl; pbWait: TPaintBox; pmChapterList: TPopupMenu; - pnOptions: TPageControl; + pcOptions: TPageControl; pnChapterList: TPanel; pnFilter: TPanel; pnGenres: TPanel; @@ -280,7 +376,7 @@ TMainForm = class(TForm) seOptionConnectionTimeout: TSpinEdit; seOptionMaxThread: TSpinEdit; seOptionNewMangaTime: TSpinEdit; - seOptionCheckMinutes: TSpinEdit; + seOptionAutoCheckFavIntervalMinutes: TSpinEdit; seOptionPDFQuality: TSpinEdit; seOptionDigitVolume: TSpinEdit; seOptionDigitChapter: TSpinEdit; @@ -294,15 +390,12 @@ TMainForm = class(TForm) tbWebsitesExpandAll: TToolButton; ToolBarWebsites: TToolBar; tsView: TTabSheet; - tmBackup: TIdleTimer; ToolBarDownload: TToolBar; tbDownloadResumeAll: TToolButton; tbDownloadStopAll: TToolButton; - ToolButton1: TToolButton; + tbSeparator1: TToolButton; tbDownloadDeleteCompleted: TToolButton; tvDownloadFilter: TTreeView; - tsDownloadFilter: TTabSheet; - tsMangaList: TTabSheet; tsMisc: TTabSheet; tsUpdate: TTabSheet; tsAbout: TTabSheet; @@ -314,7 +407,6 @@ TMainForm = class(TForm) tsSaveTo: TTabSheet; tsConnections: TTabSheet; tsOption: TTabSheet; - tsFilter: TTabSheet; tsInformation: TTabSheet; tsDownload: TTabSheet; clbChapterList: TVirtualStringTree; @@ -328,42 +420,62 @@ TMainForm = class(TForm) var CanShow: Boolean; var HintInfo: THintInfo); procedure btAddToFavoritesClick(Sender: TObject); procedure btAbortUpdateListClick(Sender: TObject); + procedure btAbortCheckLatestVersionClick(Sender: TObject); procedure btCancelFavoritesCheckClick(Sender: TObject); procedure btChecksClick(Sender: TObject); - procedure btCheckVersionClick(Sender: TObject); + procedure btCheckLatestVersionClick(Sender: TObject); + procedure btClearLogFileClick(Sender: TObject); procedure btDonateClick(Sender: TObject); + procedure btDownloadSplitClick(Sender: TObject); procedure btFavoritesImportClick(Sender: TObject); + procedure btOpenLogClick(Sender: TObject); procedure btReadOnlineClick(Sender: TObject); - procedure btSearchClearClick(Sender: TObject); + procedure btMangaListSearchClearClick(Sender: TObject); procedure btUpdateListClick(Sender: TObject); - procedure btURLClick(Sender: TObject); procedure btVisitMyBlogClick(Sender: TObject); - procedure btWebsitesSearchClearClick(Sender: TObject); + procedure cbAddAsStoppedChange(Sender: TObject); + procedure cbOptionAutoCheckFavIntervalChange(Sender: TObject); + procedure cbOptionAutoCheckFavStartupChange(Sender: TObject); + procedure cbOptionChangeUnicodeCharacterChange(Sender: TObject); procedure cbOptionDigitChapterChange(Sender: TObject); procedure cbOptionDigitVolumeChange(Sender: TObject); - procedure cbSelectMangaChange(Sender: TObject); - procedure ckDropTargetChange(Sender: TObject); + procedure cbOptionGenerateMangaFolderChange(Sender: TObject); + procedure cbSelectMangaEditingDone(Sender: TObject); + procedure cbSelectMangaKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure cbSelectMangaMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); procedure clbChapterListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); - procedure clbChapterListFreeNode(Sender : TBaseVirtualTree; - Node : PVirtualNode); - procedure clbChapterListGetNodeDataSize(Sender: TBaseVirtualTree; - var NodeDataSize: Integer); procedure clbChapterListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); - procedure clbChapterListInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); - procedure edSearchChange(Sender: TObject); - procedure edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure clbChapterListInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + procedure clbChapterListKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure edDownloadsSearchButtonClick(Sender: TObject); + procedure edDownloadsSearchChange(Sender: TObject); + procedure edFavoritesSearchButtonClick(Sender: TObject); + procedure edFavoritesSearchChange(Sender: TObject); + procedure edFilterMangaInfoChaptersButtonClick(Sender: TObject); + procedure edFilterMangaInfoChaptersChange(Sender: TObject); + procedure edLogFileNameButtonClick(Sender: TObject); + procedure edMangaListSearchChange(Sender: TObject); + procedure edMangaListSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState + ); + procedure edOptionDefaultPathButtonClick(Sender: TObject); + procedure edOptionExternalPathButtonClick(Sender: TObject); + procedure edSaveToButtonClick(Sender: TObject); + procedure edURLButtonClick(Sender: TObject); + procedure edURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure edURLKeyPress(Sender: TObject; var Key: Char); + procedure edWebsitesSearchButtonClick(Sender: TObject); procedure edWebsitesSearchChange(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); - procedure btBrowseClick(Sender: TObject); - procedure btOptionBrowseClick(Sender: TObject); procedure btDownloadClick(Sender: TObject); procedure btFavoritesCheckNewChapterClick(Sender: TObject); procedure btOptionApplyClick(Sender: TObject); @@ -372,19 +484,24 @@ TMainForm = class(TForm) procedure btFilterResetClick(Sender: TObject); procedure btRemoveFilterClick(Sender: TObject); - procedure cbAddAsStoppedChange(Sender: TObject); procedure cbOptionUseProxyChange(Sender: TObject); procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender: TObject); procedure FormWindowStateChange(Sender: TObject); - procedure itAnimateTimer(Sender: TObject); - procedure itCheckForChaptersTimer(Sender: TObject); - procedure itMonitorTimer(Sender: TObject); - procedure itRefreshDLInfoStartTimer(Sender: TObject); - procedure itRefreshDLInfoStopTimer(Sender: TObject); - procedure itRefreshDLInfoTimer(Sender: TObject); - procedure itSaveDownloadedListTimer(Sender: TObject); - procedure itStartupTimer(Sender: TObject); + procedure miChapterListAscendingClick(Sender: TObject); + procedure miFavoritesEnableClick(Sender: TObject); + procedure miFavoritesRenameClick(Sender: TObject); + procedure miFavoritesTransferWebsiteClick(Sender: TObject); + procedure tbmiDownloadMoveBottomClick(Sender: TObject); + procedure tbmiDownloadMoveDownClick(Sender: TObject); + procedure tbmiDownloadMoveTopClick(Sender: TObject); + procedure tbmiDownloadMoveUpClick(Sender: TObject); + procedure tmAnimateMangaInfoTimer(Sender: TObject); + procedure tmCheckFavoritesTimer(Sender: TObject); + procedure tmExitCommandTimer(Sender: TObject); + procedure tmRefreshDownloadsInfoStartTimer(Sender: TObject); + procedure tmRefreshDownloadsInfoStopTimer(Sender: TObject); + procedure tmRefreshDownloadsInfoTimer(Sender: TObject); + procedure tmStartupTimer(Sender: TObject); procedure medURLCutClick(Sender: TObject); procedure medURLCopyClick(Sender: TObject); procedure medURLPasteClick(Sender: TObject); @@ -392,6 +509,10 @@ TMainForm = class(TForm) procedure medtURLDeleteClick(Sender: TObject); procedure medURLSelectAllClick(Sender: TObject); procedure medURLUndoClick(Sender: TObject); + procedure miAbortSilentThreadClick(Sender: TObject); + procedure miChapterListFilterClick(Sender: TObject); + procedure miChapterListHideDownloadedClick(Sender: TObject); + procedure miDownloadEnableClick(Sender: TObject); procedure miDownloadViewMangaInfoClick(Sender: TObject); procedure miChapterListHighlightClick(Sender: TObject); procedure miDownloadDeleteTaskClick(Sender: TObject); @@ -415,13 +536,20 @@ TMainForm = class(TForm) procedure miDownloadDeleteCompletedClick(Sender: TObject); procedure miDownloadResumeClick(Sender: TObject); procedure miDownloadStopClick(Sender: TObject); + procedure miMangaListDeleteClick(Sender: TObject); procedure miMangaListDownloadAllClick(Sender: TObject); procedure miMangaListViewInfosClick(Sender: TObject); procedure miFavoritesOpenFolderClick(Sender: TObject); procedure miDownloadOpenFolderClick(Sender: TObject); procedure miFavoritesOpenWithClick(Sender: TObject); procedure miDownloadOpenWithClick(Sender: TObject); + procedure miTrayExitClick(Sender: TObject); + procedure miTrayFinishNothingClick(Sender: TObject); + procedure miTrayShowDropBoxClick(Sender: TObject); procedure mnDownload1ClickClick(Sender: TObject); + procedure mnFilterGenreAllCheckClick(Sender: TObject); + procedure mnFilterGenreAllIndeterminateClick(Sender: TObject); + procedure mnFilterGenreAllUncheckClick(Sender: TObject); procedure mnUpdate1ClickClick(Sender: TObject); procedure mnUpdateDownFromServerClick(Sender: TObject); procedure mnUpdateListClick(Sender: TObject); @@ -430,9 +558,12 @@ TMainForm = class(TForm) procedure pmEditURLPopup(Sender: TObject); procedure pmFavoritesPopup(Sender: TObject); procedure pmMangaListPopup(Sender: TObject); + procedure pmSbMainPopup(Sender: TObject); + procedure pmTrayPopup(Sender: TObject); + procedure rgOptionCompressSelectionChanged(Sender: TObject); procedure sbUpdateListDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); - procedure seOptionCheckMinutesChange(Sender: TObject); + procedure seOptionAutoCheckFavIntervalMinutesChange(Sender: TObject); procedure spMainSplitterMoved(Sender: TObject); procedure tbDownloadDeleteCompletedClick(Sender: TObject); procedure tbDownloadResumeAllClick(Sender: TObject); @@ -444,9 +575,6 @@ TMainForm = class(TForm) procedure tvDownloadFilterSelectionChanged(Sender: TObject); procedure UniqueInstanceFMDOtherInstance(Sender: TObject; ParamCount: Integer; Parameters: array of String); - procedure vtDownloadAfterCellPaint(Sender: TBaseVirtualTree; - TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const CellRect: TRect); procedure vtDownloadColumnDblClick(Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState); procedure vtDownloadDragAllowed(Sender : TBaseVirtualTree; @@ -457,7 +585,11 @@ TMainForm = class(TForm) procedure vtDownloadDragOver(Sender : TBaseVirtualTree; Source : TObject; Shift : TShiftState; State : TDragState; const Pt : TPoint; Mode : TDropMode; var Effect : LongWord; var Accept : Boolean); - procedure vtDownloadFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vtDownloadDrawText(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const CellText: String; const CellRect: TRect; var DefaultDraw: Boolean); + procedure vtDownloadFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); procedure vtDownloadGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); @@ -466,19 +598,30 @@ TMainForm = class(TForm) var Ghosted: Boolean; var ImageIndex: Integer); procedure vtDownloadGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + {$if VTMajorVersion < 5} procedure vtDownloadHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure vtDownloadInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + {$else} + procedure vtDownloadHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + {$endif} + procedure vtDownloadKeyAction(Sender: TBaseVirtualTree; var CharCode: Word; + var Shift: TShiftState; var DoDefault: Boolean); procedure vtDownloadKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState); procedure vtDownloadKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure vtDownloadPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure vtFavoritesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); procedure vtFavoritesColumnDblClick(Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState); - procedure vtFavoritesFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vtFavoritesDragDrop(Sender: TBaseVirtualTree; Source: TObject; + DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; + const Pt: TPoint; var Effect: LongWord; Mode: TDropMode); + procedure vtFavoritesDragOver(Sender: TBaseVirtualTree; Source: TObject; + Shift: TShiftState; State: TDragState; const Pt: TPoint; Mode: TDropMode; + var Effect: LongWord; var Accept: Boolean); procedure vtFavoritesGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); @@ -487,38 +630,32 @@ TMainForm = class(TForm) var Ghosted: Boolean; var ImageIndex: Integer); procedure vtFavoritesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + {$if VTMajorVersion < 5} procedure vtFavoritesHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure vtFavoritesInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + {$else} + procedure vtFavoritesHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + {$endif} + procedure vtFavoritesPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); procedure vtMangaListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vtMangaListColumnDblClick(Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState); - procedure vtMangaListDragAllowed(Sender : TBaseVirtualTree; - Node : PVirtualNode; Column : TColumnIndex; var Allowed : Boolean); - procedure vtMangaListDragOver(Sender : TBaseVirtualTree; Source : TObject; - Shift : TShiftState; State : TDragState; const Pt : TPoint; - Mode : TDropMode; var Effect : LongWord; var Accept : Boolean); - // for search feature - procedure vtMangaListInitSearchNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure vtMangaListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); - procedure vtMangaListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vtMangaListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); + procedure vtMangaListGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); procedure vtMangaListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); - procedure vtMangaListInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure tmBackupTimer(Sender: TObject); - procedure vtOptionMangaSiteSelectionChange(Sender : TBaseVirtualTree; - Node : PVirtualNode); - procedure vtOptionMangaSiteSelectionFocusChanged(Sender : TBaseVirtualTree; - Node : PVirtualNode; Column : TColumnIndex); + procedure vtMangaListInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure vtOptionMangaSiteSelectionFreeNode(Sender : TBaseVirtualTree; Node : PVirtualNode); procedure vtOptionMangaSiteSelectionGetNodeDataSize(Sender: TBaseVirtualTree; @@ -526,8 +663,6 @@ TMainForm = class(TForm) procedure vtOptionMangaSiteSelectionGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); - procedure vtOptionMangaSiteSelectionInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure DisableAddToFavorites(webs: String); private PrevWindowState: TWindowState; @@ -536,135 +671,212 @@ TMainForm = class(TForm) procedure FMDInstanceReceiveMsg(Sender: TObject); procedure ClearChapterListState; public - ulTotalPtr, ulWorkPtr: Cardinal; - optionMangaSiteSelectionNodes: array of PVirtualNode; LastSearchStr: String; LastSearchWeb: String; - isStartup, isExiting: Boolean; - // for manga website that available for visible on selection list - //websiteName :TStringList; - //websiteLanguage :TStringList; - - isRunDownloadFilter: Boolean; - isUpdating: Boolean; - revisionIni, updates, mangalistIni, options: TIniFile; - FavoriteManager: TFavoriteManager; - dataProcess: TDataProcess; - mangaInfo: TMangaInfo; + LastUserPickedSaveTo: String; + LastViewMangaInfoSender: TObject; + + // state of chapterlist in mangainfo ChapterList: array of TChapterStateItem; - DLManager: TDownloadManager; - updateDB: TUpdateDBThread; - updateList: TUpdateMangaManagerThread; - SilentThreadManager: TSilentThreadManager; - ticks: Cardinal; - backupTicks: Cardinal; + // animation gif gifWaiting: TAnimatedGif; gifWaitingRect: TRect; - // doing stuff like get manga info, compress, ... - SubThread: TSubThread; - isSubthread: Boolean; - GetInfosThread: TGetMangaInfosThread; - isGetMangaInfos: Boolean; - // repaint treeview - procedure tvDownloadFilterRepaint; + // embed form + procedure EmbedForm(const AForm: TForm; const AParent: TWinControl); // generate >> nodes - procedure GenerateNodes; + procedure GeneratetvDownloadFilterNodes; // load about information procedure LoadAbout; + procedure AddToAboutStatus(const ACaption, AValue: String); - procedure CloseNow(WaitFor: Boolean = True); + procedure CloseNow; - procedure CheckForTopPanel; // en: Too lazy to add it one by one procedure InitCheckboxes; // download task filters - procedure ShowTasks(Status: TDownloadStatusTypes = []); - - procedure ShowTasksOnCertainDays(const L, H: longint); - procedure ShowTodayTasks; - procedure ShowYesterdayTasks; - procedure ShowOneWeekTasks; - procedure ShowOneMonthTasks; - procedure vtDownloadFilters; + procedure tvDownloadFilterRefresh(const ResourceChanged: Boolean = False); + procedure vtDownloadUpdateFilters(const RefreshTree: Boolean = True); procedure AddChapterNameToList; // Create silent thread - procedure AddSilentThread(URL: string); + procedure AddSilentThread(URL: string; MetaDataType: TMetaDataType); overload; + procedure AddSilentThread(URL: string); overload; // Add text to TRichMemo - procedure AddTextToInfo(title, infoText: String); + procedure AddTextToInfo(const ATitle, AValue: String); + + // fill edSaveTo with default path + procedure FillSaveTo; + + // View manga information + procedure ViewMangaInfo(const ALink, AWebsite, ATitle, ASaveTo: String; + const ASender: TObject; const AMangaListNode: PVirtualNode = nil); // Show manga information - procedure ShowInformation(const title, website, link: String); + procedure ShowInformation; // get manga list from server procedure RunGetList; // Load config from config.ini procedure LoadOptions; + procedure SaveOptions(const AShowDialog: Boolean = False); + procedure ApplyOptions; // Load config from mangalist.ini procedure LoadMangaOptions; - function SaveMangaOptions: String; - procedure UpdateVtChapter; - procedure UpdateVtDownload; + procedure UpdateVtDownload; inline; procedure UpdateVtFavorites; + procedure UpdateVtMangaListFilterStatus; - // Load form information, like previous position, size, ... + // load form information, like previous position, size, ... procedure LoadFormInformation; procedure SaveFormInformation; + + // drop target + procedure ShowDropTarget(const AShow: Boolean); procedure SaveDropTargetFormInformation; - // load language file - procedure LoadLanguage; + // load language from file + procedure CollectLanguagesFromFiles; + procedure ApplyLanguage; // openwith - procedure OpenWithExternalProgram(const dirPath, Filename: String); + procedure OpenWithExternalProgramChapters(const Dir: String; + const Chapters: TStrings = nil); + procedure OpenWithExternalProgram(const Dir, Filename: String); - //transfer rate graph + // transfer rate graph procedure TransferRateGraphInit(xCount: Integer = 10); procedure TransferRateGraphAddItem(TransferRate: Integer); + // exit counter + procedure DoExitWaitCounter; + function ShowExitCounter: Boolean; + + // open db with thread + procedure OpenDataDB(const AWebsite: String); + + // search db with thread + procedure SearchDataDB(const ATitle: String); + + // change all filter genre checkbox state + procedure FilterGenreChangeAllState(const AState: TCheckBoxState); + + // filter chapter list + procedure FilterChapterList(const SearchStr: String; const HideDownloaded: Boolean); + // exception handle procedure ExceptionHandler(Sender: TObject; E: Exception); { public declarations } end; -var - //Instance - FMDInstance: TSimpleIPCServer; + { TOpenDBThread } - MainForm: TMainForm; - INIAdvanced: TIniFileR; + TOpenDBThread = class(TThread) + private + FWebsite: String; + protected + procedure SetControlEnabled(const Value: Boolean); + procedure SyncOpenStart; + procedure SyncOpenFinish; + procedure Execute; override; + public + constructor Create(const AWebsite: String); + destructor Destroy; override; + end; - // update fmd through main thread - DoAfterFMD: TFMDDo; - FUpdateURL: String; + { TSearchDBThread } + + TSearchDBThread = class(TThread) + private + FSearchStr: String; + FNewSearch: Boolean; + protected + procedure SyncBeforeSearch; + procedure SyncAfterSearch; + procedure Execute; override; + public + constructor Create(const ASearchStr: String); + destructor Destroy; override; + procedure NewSearch(const ASearchStr: String); + end; + + PMangaInfoData = ^TMangaInfoData; + + TMangaInfoData = record + website, + link, + title, + titleformat, + authors, + artists, + genres, + status, + summary: String; + numchapter, + jdn: Integer; + end; + +var + MainForm: TMainForm; const - CL_HLBlueMarks = $FDC594; - CL_HLGreenMarks = $B8FFB8; - CL_HLRedMarks = $008080FF; + CL_HLBlueMarks = $FDC594; + CL_HLGreenMarks = $B8FFB8; + CL_HLRedMarks = $8080FF; + CL_HLYellowMarks = $80EBFE; + + CL_BarGrayLine = $bcbcbc; + CL_BarGray = $e6e6e6; + + CL_BarGreenLine = $25b006; + CL_BarGreen = $42d932; + + CL_BarOrangeLine = $00b399; + CL_BarOrange = $1870e9; + + CL_BarRedLine = $1a1ab1; + CL_BarRed = $4b4af0; + + CL_BarBlueLine = $b36b1d; + CL_BarBlue = $fab24f; + + CL_BarBlueLightLine = $eab27c; + CL_BarBlueLight = $fed2a3; + + CL_BarYellowLine = $4a4af0; + CL_BarYellow = $80ebfe; + + CL_BarBrownGoldLine = $5ea2c8; + CL_BarBrownGold = $8dd5f0; + + CL_YellowLight = $eaffff; + CL_BlueLight = $f8f8f3; resourcestring RS_FilterStatusItems = 'Completed'#13#10'Ongoing'#13#10''; - RS_OptionFMDDoItems = 'Do nothing'#13#10'Exit FMD'#13#10'Shutdown'#13#10'Hibernate'; + RS_OptionFMDDoItems = 'Nothing'#13#10'Exit'#13#10'Shutdown'#13#10'Hibernate'; RS_DropTargetModeItems = 'Download all'#13#10'Add to favorites'; + RS_OptionCompress = 'None'#13#10'ZIP'#13#10'CBZ'#13#10'PDF'#13#10'EPUB'; + RS_WebPConvertTo = 'WebP'#13#10'PNG'#13#10'JPEG'; + RS_WebPPNGLevel = 'None'#13#10'Fastest'#13#10'Default'#13#10'Maximum'; RS_HintFavoriteProblem = 'There is a problem with this data!'#13#10 + 'Removing and re-adding this data may fix the problem.'; RS_DlgTitleExistInDLlist = 'This title are already in download list.'#13#10 + 'Do you want to download it anyway?'; RS_DlgQuit = 'Are you sure you want to exit?'; + RS_DlgRemoveItem = 'Are you sure you want to delete this item(s)?'; RS_DlgRemoveTask = 'Are you sure you want to delete the task(s)?'; RS_DlgRemoveFavorite = 'Are you sure you want to delete the favorite(s)?'; RS_DlgURLNotSupport = 'URL not supported!'; @@ -676,6 +888,9 @@ TMainForm = class(TForm) RS_DlgMangaListSelect = 'You must choose at least 1 manga website!'; RS_DlgCannotGetMangaInfo = 'Cannot get manga info. Please check your internet connection and try it again.'; RS_DlgCannotConnectToServer = 'Cannot connect to the server.'; + RS_DlgSplitDownload = 'Split download'; + RS_DlgDownloadCount = 'Download count:'; + RS_WrongInput = 'Invalid input!'; RS_LblOptionExternalParamsHint = '%s : Path to the manga'#13#10+ '%s : Chapter filename'#13#10+ #13#10+ @@ -705,172 +920,360 @@ TMainForm = class(TForm) RS_InfoGenres = 'Genre(s):'; RS_InfoStatus = 'Status:'; RS_InfoSummary = 'Summary:'; + RS_FMDAlreadyRunning = 'Free Manga Downloader already running!'; + RS_ModeSearching = 'Mode: Searching...'; implementation {$R *.lfm} uses - frmImportFavorites, RegExpr, Clipbrd; + frmImportFavorites, frmShutdownCounter, frmSelectDirectory, + frmWebsiteSettings, WebsiteModules, FMDVars, RegExpr, sqlite3dyn, Clipbrd, + ssl_openssl_lib, LazFileUtils, LazUTF8, webp, DBUpdater, LuaWebsiteModules; + +var + // thread for open db + OpenDBThread: TOpenDBThread; + + // thread for search db + SearchDBThread: TSearchDBThread; + + // ... + UpdateStatusTextStyle: TTextStyle; + +{$ifdef windows} + PrevWndProc: windows.WNDPROC; + +function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam): LRESULT; stdcall; +begin + if uMsg = WM_DISPLAYCHANGE then + begin + Screen.UpdateMonitors; + Screen.UpdateScreen; + if Screen.MonitorCount < MainForm.Monitor.MonitorNum then + MainForm.DefaultMonitor := dmMainForm; + if (MainForm.Left > Screen.Width) or (MainForm.Top > Screen.Height) then + MainForm.MoveToDefaultPosition; + end; + Result := CallWindowProc(PrevWndProc, Ahwnd, uMsg, WParam, LParam); +end; +{$endif} + +procedure ChangeAllCursor(const ParentControl: TWinControl; const Cur: TCursor); +var + i: Integer; +begin + if ParentControl = nil then Exit; + ParentControl.Cursor := Cur; + if ParentControl.ControlCount > 0 then + for i := 0 to ParentControl.ControlCount - 1 do + ParentControl.Controls[i].Cursor := Cur; +end; + +{ TSearchDBThread } + +procedure TSearchDBThread.SyncBeforeSearch; +begin + with MainForm do + begin + vtMangaList.Cursor := crHourGlass; + lbMode.Caption := RS_ModeSearching; + vtMangaList.RootNodeCount := 0; + end; +end; + +procedure TSearchDBThread.SyncAfterSearch; +begin + with MainForm do + begin + vtMangaList.RootNodeCount := dataProcess.RecordCount; + UpdateVtMangaListFilterStatus; + LastSearchWeb := dataProcess.Website; + LastSearchStr := UpCase(FSearchStr); + vtMangaList.Cursor := crDefault; + end; +end; + +procedure TSearchDBThread.Execute; +begin + if dataProcess <> nil then + begin + Synchronize(@SyncBeforeSearch); + while FNewSearch do + begin + FNewSearch := False; + dataProcess.Search(FSearchStr); + end; + if not Terminated then + Synchronize(@SyncAfterSearch); + end; +end; + +constructor TSearchDBThread.Create(const ASearchStr: String); +begin + FreeOnTerminate := True; + FSearchStr := ASearchStr; + FNewSearch := True; + inherited Create(False); +end; + +destructor TSearchDBThread.Destroy; +begin + SearchDBThread := nil; + inherited Destroy; +end; + +procedure TSearchDBThread.NewSearch(const ASearchStr: String); +begin + if ASearchStr <> FSearchStr then + begin + FSearchStr := ASearchStr; + FNewSearch := True; + end; +end; + +{ TOpenDBThread } + +procedure TOpenDBThread.SetControlEnabled(const Value: Boolean); +begin + with MainForm do + begin + cbSelectManga.Enabled := Value; + btUpdateList.Enabled := Value; + edMangaListSearch.Enabled := Value; + btMangaListSearchClear.Enabled := Value; + btRemoveFilter.Enabled := Value; + end; +end; + +procedure TOpenDBThread.SyncOpenStart; +begin + with MainForm do + begin + ChangeAllCursor(pssInfoList, crHourGlass); + SetControlEnabled(False); + lbMode.Caption := RS_Loading; + vtMangaList.Clear; + end; +end; + +procedure TOpenDBThread.SyncOpenFinish; +begin + with MainForm do + begin + LastSearchStr := upcase(edMangaListSearch.Text); + LastSearchWeb := currentWebsite; + if dataProcess.Filtered then + lbMode.Caption := Format(RS_ModeFiltered, [dataProcess.RecordCount]) + else + lbMode.Caption := Format(RS_ModeAll, [dataProcess.RecordCount]); + SetControlEnabled(True); + vtMangaList.RootNodeCount := dataProcess.RecordCount; + ChangeAllCursor(pssInfoList, crDefault); + end; +end; + +procedure TOpenDBThread.Execute; +begin + if (FWebsite <> '') and (dataProcess <> nil) then + begin + Synchronize(@SyncOpenStart); + if dataProcess <> nil then + begin + dataProcess.Open(FWebsite); + if FormMain.edMangaListSearch.Text <> '' then + dataProcess.Search(MainForm.edMangaListSearch.Text); + end; + if not Terminated then + Synchronize(@SyncOpenFinish); + end; +end; + +constructor TOpenDBThread.Create(const AWebsite: String); +begin + FreeOnTerminate := True; + FWebsite := AWebsite; + inherited Create(False); +end; + +destructor TOpenDBThread.Destroy; +begin + OpenDBThread := nil; + inherited Destroy; +end; { TMainForm } procedure TMainForm.FormCreate(Sender: TObject); -var - fs: TFileStream; begin Randomize; - fmdDirectory := CleanAndExpandDirectory(GetCurrentDirUTF8); - SetLogFile(Format('%s\%s_LOG_%s.txt', ['log', ExtractFileNameOnly(ParamStrUTF8(0)), - FormatDateTime('dd-mm-yyyy', Now)])); - Writelog_I('Starting ' + AnsiQuotedStr(Application.Title, '"')); - InitSimpleExceptionHandler; - AddIgnoredException('EImagingError'); - AddIgnoredException('ERegExpr'); - SilentThreadManager := TSilentThreadManager.Create; + FormMain := Self; + {$ifdef windows} + PrevWndProc := windows.WNDPROC(windows.GetWindowLongPtr(Self.Handle, GWL_WNDPROC)); + windows.SetWindowLongPtr(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback)); + {$endif} btAbortUpdateList.Parent := sbUpdateList; - INIAdvanced := TIniFileR.Create(fmdDirectory + CONFIG_FOLDER + CONFIG_ADVANCED); isRunDownloadFilter := False; isUpdating := False; - isExiting := False; - isSubthread := False; - isGetMangaInfos := False; + isPendingExitCounter:=False; + isNormalExit:=False; DoAfterFMD := DO_NOTHING; Application.HintHidePause := 10000; sbUpdateList.DoubleBuffered := True; + ForceDirectoriesUTF8(CONFIG_FOLDER); + + // load about + LoadAbout; + + // remove old updater + if FileExistsUTF8(OLD_CURRENT_UPDATER_EXE) then + begin + if FileExistsUTF8(CURRENT_UPDATER_EXE) then + DeleteFileUTF8(OLD_CURRENT_UPDATER_EXE) + else + RenameFileUTF8(OLD_CURRENT_UPDATER_EXE, CURRENT_UPDATER_EXE); + end; + // TrayIcon TrayIcon.Icon.Assign(Application.Icon); PrevWindowState := wsNormal; - // Load readme.rtf to rmAbout - rmAbout.Clear; - if FileExistsUTF8(README_FILE) then - begin - fs := TFileStream.Create(README_FILE, fmOpenRead or fmShareDenyNone); - try - rmAbout.LoadRichText(fs); - finally - fs.free; - end; - end; + // main dataprocess + dataProcess := TDBDataProcess.Create; - dataProcess := TDataProcess.Create; + // downloadmanager DLManager := TDownloadManager.Create; - DLManager.Restore; + // favorites FavoriteManager := TFavoriteManager.Create; + FavoriteManager.DLManager := DLManager; FavoriteManager.OnUpdateFavorite := @UpdateVtFavorites; FavoriteManager.OnUpdateDownload := @UpdateVtDownload; - FavoriteManager.DLManager := DLManager; - // Load config.ini - options := TIniFile.Create(fmdDirectory + CONFIG_FOLDER + CONFIG_FILE); - options.CacheUpdates := True; + // download all / add to favorites + SilentThreadManager := TSilentThreadManager.Create; - // Load revision.ini - revisionIni := TIniFile.Create(fmdDirectory + CONFIG_FOLDER + REVISION_FILE); - options.CacheUpdates := False; - options.StripQuotes := False; + // ShowInformation + mangaInfo := TMangaInfo.Create; - // Load updates.ini - updates := TIniFile.Create(fmdDirectory + CONFIG_FOLDER + UPDATE_FILE); - updates.CacheUpdates := False; + // generate tvDownloadFilter nodes + GeneratetvDownloadFilterNodes; - // Load mangalist.ini - mangalistIni := TIniFile.Create(fmdDirectory + CONFIG_FOLDER + MANGALIST_FILE); - mangalistIni.CacheUpdates := True; + // set connection limit + seOptionMaxParallel.MaxValue := MAX_TASKLIMIT; + seOptionMaxThread.MaxValue := MAX_CONNECTIONPERHOSTLIMIT; - LoadOptions; - isStartup := False; - LoadMangaOptions; - LoadFormInformation; if cbFilterStatus.Items.Count > 2 then cbFilterStatus.ItemIndex := 2; - // ShowInformation; - mangaInfo := TMangaInfo.Create; - - vtDownload.NodeDataSize := SizeOf(TDownloadInfo) - 4; - vtDownload.RootNodeCount := DLManager.Count; - - vtFavorites.NodeDataSize := SizeOf(TFavoriteInfo); - UpdateVtFavorites; - InitCheckboxes; - //lbMode.Caption := Format(RS_ModeAll, [dataProcess.filterPos.Count]); - pcMain.ActivePage := tsDownload; - CheckForTopPanel; - DLManager.CheckAndActiveTaskAtStartup; TrayIcon.Show; - // load some necessary options at startup - Revision := revisionIni.ReadInteger('general', 'Revision', 0); - revisionIni.Free; - - seOptionNewMangaTime.Value := options.ReadInteger('general', 'NewMangaTime', 3); - miHighLightNewManga.Checked := options.ReadBool('general', 'HighlightNewManga', True); - miChapterListHighlight.Checked := - options.ReadBool('general', 'HighlightDownloadedChapters', True); - cbOptionShowQuitDialog.Checked := options.ReadBool('dialogs', 'ShowQuitDialog', True); - cbOptionShowDeleteTaskDialog.Checked := - options.ReadBool('dialogs', 'ShowDeleteDldTaskDialog', True); currentJDN := GetCurrentJDN; // read online btDownload.Enabled := False; + btDownloadSplit.Enabled := btDownload.Enabled; btReadOnline.Enabled := False; btAddToFavorites.Enabled := False; - // subthread - SubThread := TSubThread.Create; + // waiting gif + if FileExistsUTF8(IMAGE_FOLDER + 'waiting.gif') then + try + gifWaiting := TAnimatedGif.Create(IMAGE_FOLDER + 'waiting.gif'); + gifWaiting.EraseColor := Self.Color; + gifWaiting.BackgroundMode := gbmSaveBackgroundOnce; + gifWaitingRect.Left := 53; + gifWaitingRect.Top := 84; + gifWaitingRect.Right := 101; + gifWaitingRect.Bottom := 131; + except + end; - cbOptionLetFMDDo.ItemIndex := options.ReadInteger('general', 'LetFMDDo', 0); + mangaCover := TPicture.Create; - // waiting gif - if FileExists(IMAGE_FOLDER + 'waiting.gif') then + //textstyle for updatestatusbar + with UpdateStatusTextStyle do begin - gifWaiting := TAnimatedGif.Create(IMAGE_FOLDER + 'waiting.gif'); - gifWaiting.EraseColor := Self.Color; - gifWaiting.BackgroundMode := gbmSaveBackgroundOnce; - gifWaitingRect.Left := 53; - gifWaitingRect.Top := 84; - gifWaitingRect.Right := 101; - gifWaitingRect.Bottom := 131; + Alignment := taLeftJustify; + Layout := tlCenter; + SingleLine := True; + Clipping := False; + ExpandTabs := False; + ShowPrefix := False; + Wordbreak := False; + Opaque := True; + SystemFont := False; + RightToLeft := False; + EndEllipsis := True; end; - mangaCover := TPicture.Create; + // embed form + CustomColorForm := TCustomColorForm.Create(Self); + EmbedForm(CustomColorForm, tsCustomColor); - // generate nodes - GenerateNodes; - tvDownloadFilterRepaint; + AccountManagerForm := TAccountManagerForm.Create(Self); + EmbedForm(AccountManagerForm, tsAccounts); - // refresh sort - if DLManager.Count > 1 then - begin - DLManager.SortDirection := Boolean(vtDownload.Header.SortDirection); - vtDownload.Repaint; - end; - if FavoriteManager.Count > 0 then + WebsiteOptionCustomForm := TCustomOptionForm.Create(Self); + EmbedForm(WebsiteOptionCustomForm, sbWebsiteOptions); + + WebsiteSettingsForm := TWebsiteSettingsForm.Create(Self); + EmbedForm(WebsiteSettingsForm, tsWebsiteAdvanced); + + LuaModulesUpdaterForm := TLuaModulesUpdaterForm.Create(Self); + EmbedForm(LuaModulesUpdaterForm, tsWebsiteModules); + + AddVT(Self.vtMangaList); + AddVT(Self.clbChapterList); + AddVT(Self.vtDownload); + AddVT(Self.vtFavorites); + AddVT(Self.vtOptionMangaSiteSelection); + + // logger + FormLogger := TFormLogger.Create(Self); + + // load mangafox template + MangaFoxWatermark.SetTemplateDirectory(MANGAFOXTEMPLATE_FOLDER); + + // hint + ShowHint := True; + Application.HintPause := 500; + Application.HintHidePause := 3000; + + // transfer rate graph + TransferRateGraphList.DataPoints.NameValueSeparator := '|'; + TransferRateGraph.Visible := False; + + // minimize on start + if configfile.ReadBool('general', 'MinimizeOnStart', False) then + Application.ShowMainForm := False; + + LoadFormInformation; + CollectLanguagesFromFiles; + ApplyLanguage; + + with TTimer.Create(nil) do begin - FavoriteManager.SortDirection := Boolean(vtFavorites.Header.SortDirection); - FavoriteManager.Sort(vtFavorites.Header.SortColumn); - vtFavorites.Repaint; + OnTimer := @tmStartupTimer; + Interval := 100; + Enabled := True; end; - uTranslation.LangDir := GetCurrentDirUTF8 + PathDelim + 'languages'; - uTranslation.LangAppName := 'fmd'; - LoadLanguage; end; procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin - if cbOptionShowQuitDialog.Checked and (DoAfterFMD = DO_NOTHING) then + Logger.Send(Self.ClassName+'.FormClose'); + if cbOptionShowQuitDialog.Checked and (DoAfterFMD = DO_NOTHING) and (not OptionRestartFMD) then begin if MessageDlg('', RS_DlgQuit, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then begin + Logger.Send(Self.ClassName+'.FormClose aborted!'); CloseAction := caNone; Exit; end; @@ -879,63 +1282,130 @@ procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); CloseAction := caFree; end; -procedure TMainForm.CloseNow(WaitFor: Boolean); +procedure TMainForm.CloseNow; begin - if Assigned(FormDropTarget) then - FormDropTarget.Close; - tmBackup.Enabled := False; - itSaveDownloadedList.Enabled := False; - itRefreshDLInfo.Enabled := False; - itCheckForChapters.Enabled := False; - itAnimate.Enabled := False; - itStartup.Enabled := False; - itMonitor.Enabled := False; + if OptionDeleteCompletedTasksOnClose then + miDownloadDeleteCompletedClick(nil); + isExiting := True; + {$ifdef windows} + if Assigned(PrevWndProc) then + windows.SetWindowLongPtr(Self.Handle, GWL_WNDPROC, PtrInt(PrevWndProc)); + {$endif} + if FavoriteManager.isRunning then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating check favorites threads'); + FavoriteManager.StopChekForNewChapter(True); + Logger.Send(Self.ClassName+'.CloseNow, check favorites threads terminated'); + end; + if SilentThreadManager.Count > 0 then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating silentthreads'); + SilentThreadManager.StopAll(True); + Logger.Send(Self.ClassName+'.CloseNow, silentthreads terminated'); + end; + if DLManager.ItemsActiveTask.Count > 0 then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating downloads threads'); + DLManager.StopAllDownloadTasksForExit; + Logger.Send(Self.ClassName+'.CloseNow, downlads threads terminated'); + end; //Terminating all threads and wait for it - if isGetMangaInfos then + if Assigned(CheckUpdateThread) then begin - GetInfosThread.IsFlushed := True; - GetInfosThread.Terminate; - if WaitFor then - GetInfosThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, terminating CheckUpdateThread'); + CheckUpdateThread.Terminate; + CheckUpdateThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, CheckUpdateThread terminated'); + end; + if Assigned(SearchDBThread) then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating SearchDBThread'); + SearchDBThread.Terminate; + SearchDBThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, SearchDBThread terminated'); + end; + if Assigned(OpenDBThread) then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating OpenDBThread'); + OpenDBThread.Terminate; + OpenDBThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, OpenDBThread terminated'); end; - if isSubthread then + if Assigned(GetInfosThread) then begin - SubThread.Terminate; - if WaitFor then - SubThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, terminating GetInfosThread'); + try + GetInfosThread.Terminate; + GetInfosThread.WaitFor; + except + end; + Logger.Send(Self.ClassName+'.CloseNow, GetInfosThread terminated'); end; if isUpdating then begin + Logger.Send(Self.ClassName+'.CloseNow, terminating UpdateListThread'); updateList.Terminate; - if WaitFor then - updateList.WaitFor; + updateList.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, UpdateListThread terminated'); end; - FavoriteManager.StopChekForNewChapter(WaitFor); - SilentThreadManager.StopAll(WaitFor); - DLManager.StopAllDownloadTasksForExit; - - if FMDInstance <> nil then + if Assigned(DBUpdaterThread) then begin - FMDInstance.StopServer; - FreeAndNil(FMDInstance); + Logger.Send(Self.ClassName+'.CloseNow, terminating DBUpdaterThread'); + DBUpdaterThread.Terminate; + DBUpdaterThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, DBUpdaterThread terminated'); end; + if Assigned(SelfUpdaterThread) then + begin + Logger.Send(Self.ClassName+'.CloseNow, terminating SelfUpdaterThread'); + SelfUpdaterThread.Terminate; + SelfUpdaterThread.WaitFor; + Logger.Send(Self.ClassName+'.CloseNow, SelfUpdaterThread terminated'); + end; + + Logger.Send(Self.ClassName+'.CloseNow, disabling all timer'); + tmBackup.Enabled := False; + tmRefreshDownloadsInfo.Enabled := False; + tmCheckFavorites.Enabled := False; + tmAnimateMangaInfo.Enabled := False; + tmExitCommand.Enabled := False; //Backup data - if not dataProcess.isFilterAllSites then - dataProcess.SaveToFile; + Logger.Send(Self.ClassName+'.CloseNow, backup downloads'); DLManager.Backup; - DLManager.BackupDownloadedChaptersList; - isExiting := True; + Logger.Send(Self.ClassName+'.CloseNow, backup favorites'); FavoriteManager.Backup; + Logger.Send(Self.ClassName+'.CloseNow, backup all data to file'); + SaveOptions; SaveFormInformation; - options.UpdateFile; - SetLength(optionMangaSiteSelectionNodes, 0); + Logger.Send(Self.ClassName+'.CloseNow, close other forms'); + //embed form + if Assigned(AccountManagerForm) then + AccountManagerForm.Close; + + if Assigned(FormDropTarget) then + FormDropTarget.Close; + + if FMDInstance <> nil then + begin + Logger.Send(Self.ClassName+'.CloseNow, stop ipc server'); + FMDInstance.StopServer; + FreeAndNil(FMDInstance); + end; + isNormalExit:=True; end; procedure TMainForm.FormDestroy(Sender: TObject); begin + Logger.Send(Self.ClassName+'.FormDestroy, freeing all objects'); + RemoveVT(vtMangaList); + RemoveVT(clbChapterList); + RemoveVT(vtDownload); + RemoveVT(vtFavorites); + RemoveVT(vtOptionMangaSiteSelection); + SetLength(ChapterList, 0); FreeAndNil(mangaInfo); @@ -947,17 +1417,13 @@ procedure TMainForm.FormDestroy(Sender: TObject); FreeAndNil(gifWaiting); FreeAndNil(mangaCover); - FreeAndNil(mangalistIni); - FreeAndNil(updates); - FreeAndNil(options); - FreeAndNil(INIAdvanced); - Writelog_I(AnsiQuotedStr(Application.Title, '"') + ' exit normally'); -end; + if isNormalExit then + Logger.Send(QuotedStrd(Application.Title)+' exit normally [PID:'+IntToStr(GetProcessID)+'] [HANDLE:'+IntToStr(GetCurrentProcess)+']') + else + Logger.SendWarning(QuotedStrd(Application.Title)+' doesn''t exit normally [PID:'+IntToStr(GetProcessID)+'] [HANDLE:'+IntToStr(GetCurrentProcess)+']'); -procedure TMainForm.FormShow(Sender: TObject); -begin - if not isStartup then - itStartup.Enabled := True; + if OptionRestartFMD then + DoRestartFMD; end; procedure TMainForm.cbOptionUseProxyChange(Sender: TObject); @@ -981,97 +1447,360 @@ procedure TMainForm.FormWindowStateChange(Sender: TObject); PrevWindowState := WindowState; end; -procedure TMainForm.itAnimateTimer(Sender: TObject); -begin - gifWaiting.Update(pbWait.Canvas, gifWaitingRect); -end; - -procedure TMainForm.itCheckForChaptersTimer(Sender: TObject); -begin - if DLManager.isDlgCounter then Exit; - if options.ReadBool('update', 'AutoCheckUpdate', True) then - SubThread.CheckUpdate := True; - FavoriteManager.isAuto := True; - FavoriteManager.CheckForNewChapter; -end; - -procedure TMainForm.itMonitorTimer(Sender: TObject); -begin - if DoAfterFMD <> DO_NOTHING then +procedure TMainForm.miChapterListAscendingClick(Sender: TObject); +var + i, j, f: Integer; + t: TChapterStateItem; + Node, FNode: PVirtualNode; + c: array of TCheckState; +begin + if not (Sender is TMenuItem) then Exit; + if TMenuItem(Sender).Checked then Exit; + TMenuItem(Sender).Checked := True; + configfile.WriteBool('general', 'SortChapterListAscending', miChapterListAscending.Checked); + if Length(ChapterList) <> 0 then begin - itMonitor.Enabled := False; - Self.CloseNow(False); - case DoAfterFMD of - DO_POWEROFF: fmdPowerOff; - DO_HIBERNATE: fmdHibernate; - DO_UPDATE: + // invert chapterlist + for i := Low(ChapterList) to (High(ChapterList) div 2) do + begin + j := High(ChapterList) - i; + t := ChapterList[i]; + ChapterList[i] := ChapterList[j]; + ChapterList[j] := t; + end; + // rearrange checked state and focused + if (clbChapterList.CheckedCount <> 0 ) or (clbChapterList.SelectedCount <> 0) then + begin + FNode := nil; + if Assigned(clbChapterList.FocusedNode) then + f := clbChapterList.FocusedNode^.Index + else + f := -1; + SetLength(c, clbChapterList.RootNodeCount); + Node := clbChapterList.GetFirst(); + while Assigned(Node) do begin - if FileExistsUTF8(fmdDirectory + 'updater.exe') then - CopyFile(fmdDirectory + 'updater.exe', fmdDirectory + 'old_updater.exe'); - if FileExistsUTF8(fmdDirectory + 'old_updater.exe') then - begin - RunExternalProcess(fmdDirectory + 'old_updater.exe', - ['-x', '-r', '3', '-a', FUpdateURL, '-l', Application.ExeName, - '--lang', uTranslation.LastSelected], True, False); - Self.Close; - end; + c[Node^.Index] := Node^.CheckState; + Node := clbChapterList.GetNext(Node); + end; + i := Low(c); + Node := clbChapterList.GetLast(); + while Assigned(Node) do + begin + if i = f then + FNode := Node; + Node^.CheckState := c[i]; + Inc(i); + Node := clbChapterList.GetPrevious(Node); end; + SetLength(c, 0); + if Assigned(FNode) then + clbChapterList.FocusedNode := FNode end; - Self.Close; + clbChapterList.ClearSelection; + clbChapterList.Repaint; end; end; -procedure TMainForm.itRefreshDLInfoStartTimer(Sender: TObject); +procedure TMainForm.miFavoritesEnableClick(Sender: TObject); +var + Node: PVirtualNode; begin - if Assigned(DLManager) then + if vtFavorites.SelectedCount = 0 then Exit; + Node := vtFavorites.GetFirstSelected(); + while Assigned(Node) do begin - TransferRateGraphInit(round(TransferRateGraph.Width/4)); - TransferRateGraph.Visible := True; + if Sender = miFavoritesDisable then + FavoriteManager.StopChekForNewChapter(False, Node^.Index); + FavoriteManager[Node^.Index].Enabled := (Sender = miFavoritesEnable); + Node := vtFavorites.GetNextSelected(Node); end; + UpdateVtFavorites; end; -procedure TMainForm.itRefreshDLInfoStopTimer(Sender: TObject); +procedure TMainForm.miFavoritesRenameClick(Sender: TObject); +var + node: PVirtualNode; + t: TFavoriteContainer; + tt: String; begin - if Assigned(DLManager) then + node := vtFavorites.GetFirstSelected(); + if Assigned(node) then begin - DLManager.ClearTransferRate; - TransferRateGraph.Visible := False; + t := FavoriteManager.Items[node^.Index]; + tt := t.FavoriteInfo.Title; + if InputQuery('', RS_InfoTitle, tt) then + begin + t.FavoriteInfo.Title := tt; + t.SaveToDB(); + end; end; - vtDownload.Repaint; end; -procedure TMainForm.itRefreshDLInfoTimer(Sender: TObject); +procedure TMainForm.miFavoritesTransferWebsiteClick(Sender: TObject); +var + Node: PVirtualNode; + sm: Integer; + Data: PFavContainer; begin - if Assigned(DLManager) then - TransferRateGraphAddItem(DLManager.TransferRate); - vtDownload.Repaint; + with TTransferFavoritesForm.Create(nil) do + try + FavoriteManager.isRunning := True; + sm := mrNone; + try + Node := vtFavorites.GetFirstSelected(); + while Assigned(Node) do + begin + AddFav(FavoriteManager.Items[Node^.Index]); + Node := vtFavorites.GetNextSelected(Node); + end; + sm := ShowModal; + finally + FavoriteManager.isRunning := False; + end; + if sm = mrOK then + begin + UpdateVtFavorites; + if ckClearDownloadedChapters.Checked then + begin + Node := vtFavs.GetFirst(); + while Assigned(Node) do + begin + Data := vtFavs.GetNodeData(Node); + if Data^.NewLink <> '' then + FavoriteManager.CheckForNewChapter(FavoriteManager.Items.IndexOf(Data^.Fav)); + Node := vtFavs.GetNext(Node); + end; + end; + end; + finally + Free; + end; +end; + +procedure TMainForm.tbmiDownloadMoveTopClick(Sender: TObject); +begin + if vtDownload.SelectedCount = 0 then Exit; + vtDownloadMoveItems(0, dmAbove); +end; + +procedure TMainForm.tbmiDownloadMoveUpClick(Sender: TObject); +var + p: Cardinal; +begin + if vtDownload.SelectedCount = 0 then Exit; + p := vtDownload.GetFirstSelected()^.Index; + if p > 0 then + vtDownloadMoveItems(p - 1, dmAbove); end; -procedure TMainForm.itSaveDownloadedListTimer(Sender: TObject); +procedure TMainForm.tbmiDownloadMoveDownClick(Sender: TObject); begin - DLManager.BackupDownloadedChaptersList; + if vtDownload.SelectedCount = 0 then Exit; + vtDownloadMoveItems(vtDownload.GetFirstSelected()^.Index, dmBelow); +end; + +procedure TMainForm.tbmiDownloadMoveBottomClick(Sender: TObject); +begin + if vtDownload.SelectedCount = 0 then Exit; + vtDownloadMoveItems(vtDownload.RootNodeCount - 1, dmBelow); +end; + +procedure TMainForm.tmAnimateMangaInfoTimer(Sender: TObject); +begin + gifWaiting.Update(pbWait.Canvas, gifWaitingRect); end; -procedure TMainForm.itStartupTimer(Sender: TObject); +procedure TMainForm.tmCheckFavoritesTimer(Sender: TObject); begin - if not isStartup then + if IsDlgCounter then Exit; + tmCheckFavorites.Enabled := False; + if OptionAutoCheckLatestVersion then begin - Screen.Cursor := crHourGlass; - isStartup := True; + btCheckLatestVersionClick(btCheckLatestVersion); + LuaModulesUpdaterForm.btCheckUpdateClick(LuaModulesUpdaterForm.btCheckUpdate); + end; + FavoriteManager.isAuto := True; + FavoriteManager.CheckForNewChapter; +end; + +function TMainForm.ShowExitCounter: Boolean; +begin + IsDlgCounter := True; + with TShutdownCounterForm.Create(nil) do try + case DoAfterFMD of + DO_POWEROFF: + begin + WaitTimeout := 60; + LabelMessage := RS_LblMessageShutdown; + end; + DO_HIBERNATE: + begin + WaitTimeout := 30; + LabelMessage := RS_LblMessageHibernate; + end; + DO_EXIT: + begin + WaitTimeout := 5; + LabelMessage := RS_LblMessageExit; + end; + end; + Result := (ShowModal = mrOK); + finally + Free; + end; + isPendingExitCounter:=False; + IsDlgCounter := False; +end; + +procedure TMainForm.OpenDataDB(const AWebsite: String); +begin + if OpenDBThread = nil then + OpenDBThread := TOpenDBThread.Create(AWebsite); +end; + +procedure TMainForm.SearchDataDB(const ATitle: String); +begin + if SearchDBThread = nil then + SearchDBThread := TSearchDBThread.Create(ATitle) + else + begin + SearchDBThread.NewSearch(ATitle); + end; +end; + +procedure TMainForm.FilterGenreChangeAllState(const AState: TCheckBoxState); +var + i: Integer; +begin + for i := 0 to pnGenres.ControlCount - 1 do + if pnGenres.Controls[i] is TCheckBox then + TCheckBox(pnGenres.Controls[i]).State := AState; +end; + +procedure TMainForm.FilterChapterList(const SearchStr: String; + const HideDownloaded: Boolean); +var + Node: PVirtualNode; + S: String; + isShow: Boolean; +begin + if clbChapterList.RootNodeCount = 0 then Exit; + with clbChapterList do try - if cbSelectManga.ItemIndex > -1 then - dataProcess.LoadFromFile(cbSelectManga.Items[cbSelectManga.ItemIndex]); - vtMangaList.NodeDataSize := SizeOf(TMangaListItem); - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; - lbMode.Caption := Format(RS_ModeAll, [dataProcess.filterPos.Count]); + BeginUpdate; + S := AnsiUpperCase(SearchStr); + Node := GetFirst(); + while Assigned(Node) do + begin + isShow := True; + if HideDownloaded then + isShow := not ChapterList[Node^.Index].Downloaded; + if isShow and (S <> '') then + isShow := Pos(S, AnsiUpperCase(ChapterList[Node^.Index].Title)) <> 0; + IsVisible[Node] := isShow; + Node := GetNext(Node); + end; finally - Screen.Cursor := crDefault; + EndUpdate; end; - if cbOptionAutoCheckUpdate.Checked then - SubThread.CheckUpdate := True; - SubThread.Start; - itStartup.Enabled := False; +end; + +procedure TMainForm.tmExitCommandTimer(Sender: TObject); +begin + tmExitCommand.Enabled := False; + if DoAfterFMD <> DO_NOTHING then + begin + if DoAfterFMD in [DO_POWEROFF, DO_HIBERNATE, DO_EXIT] then + begin + if ShowExitCounter then + begin + Self.CloseNow; + if DoAfterFMD = DO_POWEROFF then + fmdPowerOff + else + if DoAfterFMD = DO_HIBERNATE then + fmdHibernate; + Self.Close; + end; + end + else + if DoAfterFMD = DO_UPDATE then + begin + Self.CloseNow; + Self.Close; + end; + DoAfterFMD := DO_NOTHING; + end; +end; + +procedure TMainForm.tmRefreshDownloadsInfoStartTimer(Sender: TObject); +begin + if Assigned(DLManager) then + begin + TransferRateGraphInit(round(TransferRateGraph.Width/4)+1); + TransferRateGraph.Visible := True; + end + else + tmRefreshDownloadsInfo.Enabled := False; +end; + +procedure TMainForm.tmRefreshDownloadsInfoStopTimer(Sender: TObject); +begin + TransferRateGraph.Visible := False; + vtDownload.Repaint; +end; + +procedure TMainForm.tmRefreshDownloadsInfoTimer(Sender: TObject); +begin + if Assigned(DLManager) then + TransferRateGraphAddItem(DLManager.TransferRate); + vtDownload.Repaint; +end; + +procedure TMainForm.tmStartupTimer(Sender: TObject); +begin + try + if Sender is TTimer then + TTimer(Sender).Free; + + //load lua modules + ScanLuaWebsiteModulesFile; + AddToAboutStatus('Modules', IntToStr(Modules.Count)); + + Modules.LoadFromFile; + WebsiteOptionCustomForm.CreateWebsiteOption; + WebsiteSettingsForm.LoadWebsiteSettings; + AccountManagerForm.LoadAccounts; + + //load configfile + LoadMangaOptions; + LoadOptions; + ApplyOptions; + finally + isStartup := False; + end; + + //restore everything after all modules loaded + DLManager.Restore; + UpdateVtDownload; + + FavoriteManager.Restore; + UpdateVtFavorites; + + if cbSelectManga.ItemIndex > -1 then + OpenDataDB(cbSelectManga.Items[cbSelectManga.ItemIndex]); + if OptionAutoCheckLatestVersion then + begin + btCheckLatestVersionClick(btCheckLatestVersion); + LuaModulesUpdaterForm.btCheckUpdateClick(LuaModulesUpdaterForm.btCheckUpdate); + end; + if OptionAutoCheckFavStartup then + begin + FavoriteManager.isAuto := True; + FavoriteManager.CheckForNewChapter; end; + DLManager.CheckAndActiveTaskAtStartup; end; procedure TMainForm.medURLCutClick(Sender: TObject); @@ -1091,8 +1820,9 @@ procedure TMainForm.medURLPasteClick(Sender: TObject); procedure TMainForm.medURLPasteandgoClick(Sender: TObject); begin - edURL.Text := Clipboard.AsText; - btURLClick(edURL); + edURL.Clear; + edURL.PasteFromClipboard; + edURLButtonClick(edURL); end; procedure TMainForm.medtURLDeleteClick(Sender: TObject); @@ -1111,39 +1841,86 @@ procedure TMainForm.medURLUndoClick(Sender: TObject); edURL.Undo; end; +procedure TMainForm.miAbortSilentThreadClick(Sender: TObject); +begin + if Assigned(SilentThreadManager) then + SilentThreadManager.StopAll(False); +end; + +procedure TMainForm.miChapterListFilterClick(Sender: TObject); +begin + edFilterMangaInfoChapters.Visible := miChapterListFilter.Checked; + if edFilterMangaInfoChapters.Visible then + begin + clbChapterList.AnchorSide[akTop].Control := edFilterMangaInfoChapters; + clbChapterList.AnchorSide[akTop].Side := asrBottom; + edFilterMangaInfoChapters.SetFocus; + end + else + begin + edFilterMangaInfoChapters.Clear; + clbChapterList.AnchorSide[akTop].Control := nil; + clbChapterList.AnchorSide[akTop].Side := asrTop; + clbChapterList.Top := 0; + end; +end; + +procedure TMainForm.miChapterListHideDownloadedClick(Sender: TObject); +begin + if Sender = miChapterListHideDownloaded then + begin + miChapterListHideDownloaded.Checked := not miChapterListHideDownloaded.Checked; + configfile.WriteBool('general', 'ChapterListHideDownloaded', miChapterListHideDownloaded.Checked); + end; + + FilterChapterList(edFilterMangaInfoChapters.Text, miChapterListHideDownloaded.Checked); +end; + +procedure TMainForm.miDownloadEnableClick(Sender: TObject); +var + Node: PVirtualNode; +begin + if vtDownload.SelectedCount = 0 then Exit; + Node := vtDownload.GetFirstSelected(); + while Assigned(Node) do + begin + if Sender = miDownloadEnable then + DLManager.EnableTask(Node^.Index) + else + DLManager.DisableTask(Node^.Index); + Node := vtDownload.GetNextSelected(Node); + end; + UpdateVtDownload; +end; + procedure TMainForm.miDownloadViewMangaInfoClick(Sender: TObject); begin - if vtDownload.Focused then - with DLManager.TaskItem(vtDownload.FocusedNode^.Index) do begin - edURL.Text := FillMangaSiteHost(MangaSiteID, DownloadInfo.Link); - btURLClick(btURL); - pcMain.ActivePage := tsInformation; - end; + if Assigned(vtDownload.FocusedNode) then + with DLManager.Items[vtDownload.FocusedNode^.Index].DownloadInfo do + ViewMangaInfo(Link, Website, Title, SaveTo, miDownloadViewMangaInfo); end; procedure TMainForm.miChapterListHighlightClick(Sender: TObject); begin - miChapterListHighlight.Checked := not miChapterListHighlight.Checked; - options.WriteBool('general', 'HighlightDownloadedChapters', - miChapterListHighlight.Checked); - if Length(ChapterList) > 0 then + if Sender = miChapterListHighlight then begin - if miChapterListHighlight.Checked then - DLManager.GetDownloadedChaptersState(mangaInfo.website + mangaInfo.link, - ChapterList) - else - ClearChapterListState; - clbChapterList.Repaint; + miChapterListHighlight.Checked := not miChapterListHighlight.Checked; + configfile.WriteBool('general', 'HighlightDownloadedChapters', miChapterListHighlight.Checked); end; + if Length(ChapterList) = 0 then Exit; + if miChapterListHighlight.Checked then + DLManager.GetDownloadedChaptersState(mangaInfo.website + mangaInfo.link, + ChapterList) + else + ClearChapterListState; + clbChapterList.Repaint; end; procedure TMainForm.miDownloadDeleteTaskClick(Sender: TObject); var - i, j: Integer; xNode: PVirtualNode; - f: String; - finfo: TSearchRec; - fs: TStringList; + i: Integer; + f, d: String; begin if vtDownload.SelectedCount = 0 then Exit; if DLManager.Count = 0 then Exit; @@ -1151,92 +1928,107 @@ procedure TMainForm.miDownloadDeleteTaskClick(Sender: TObject); if MessageDlg('', RS_DlgRemoveTask, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit; - DLManager.CS_DownloadManager_Task.Acquire; + vtDownload.BeginUpdate; try - i:=0; - xNode := vtDownload.GetFirst; - while i < DLManager.Count do + EnterCriticalSection(DLManager.CS_Task); + // stop selected nodes + xNode := vtDownload.GetPreviousSelected(nil); + while Assigned(xNode) do + begin + with DLManager.Items[xNode^.Index] do + if ThreadState then + begin + Task.IsForDelete := True; + Task.Terminate; + end; + xNode := vtDownload.GetPreviousSelected(xNode); + end; + // cleaning the data + xNode := vtDownload.GetPreviousSelected(nil); + while Assigned(xNode) do begin - if vtDownload.Selected[xNode] then + Exclude(xNode^.States, vsSelected); + with DLManager.Items[xNode^.Index] do begin - if Sender = miDownloadDeleteTaskData then + if ThreadState then + Task.WaitFor; + if (Sender = miDownloadDeleteTaskData) or (Sender = miDownloadDeleteTaskDataFavorite) + and (ChapterName.Count > 0) then begin - DLManager.StopTask(i, True, False); - if DLManager.TaskItem(i).ChapterName.Count > 0 then - begin - for j := 0 to DLManager.TaskItem(i).ChapterName.Count-1 do - begin - f := CleanAndExpandDirectory(DLManager.TaskItem(i).DownloadInfo.SaveTo) + - DLManager.TaskItem(i).ChapterName[j]; - if FileExistsUTF8(f + '.zip') then - DeleteFileUTF8(f + '.zip') - else if FileExistsUTF8(f + '.cbz') then - DeleteFileUTF8(f + '.cbz') - else if FileExistsUTF8(f + '.pdf') then - DeleteFileUTF8(f + '.pdf') - else if DirectoryExistsUTF8(f) then - DeleteDirectory(f, False); - end; + d := CorrectPathSys(DownloadInfo.SaveTo); + for i := 0 to ChapterName.Count - 1 do begin + f := CorrectPathSys(d + ChapterName[i]); + if DirectoryExistsUTF8(f) then + DeleteDirectory(f, False); + f := RemovePathDelim(f); + if FileExistsUTF8(f + '.zip') then + DeleteFileUTF8(f + '.zip') + else if FileExistsUTF8(f + '.cbz') then + DeleteFileUTF8(f + '.cbz') + else if FileExistsUTF8(f + '.pdf') then + DeleteFileUTF8(f + '.pdf') + else if FileExistsUTF8(f + '.epub') then + DeleteFileUTF8(f + '.epub') + else if DirectoryExistsUTF8(f) then + DeleteDirectory(f, False); end; - f := CleanAndExpandDirectory(DLManager.TaskItem(i).DownloadInfo.SaveTo); - fs := TStringList.Create; + RemoveDirUTF8(d); + end; + if (Sender = miDownloadDeleteTaskDataFavorite) and + (FavoriteManager.Items.Count <> 0) and + (FavoriteManager.isRunning = False) then try - if FindFirstUTF8(f + '*', faAnyFile and faDirectory, finfo) = 0 then - repeat - fs.Add(finfo.Name); - until FindNextUTF8(finfo) <> 0; - FindCloseUTF8(finfo); - if fs.Count = 2 then - DeleteDirectory(f, False); + FavoriteManager.Lock; + for i := 0 to FavoriteManager.Count - 1 do + begin + if SameText(DLManager[xNode^.Index].DownloadInfo.Link, FavoriteManager[i].FavoriteInfo.Link) + and SameText(DLManager[xNode^.Index].DownloadInfo.Website, FavoriteManager[i].FavoriteInfo.Website) then + begin + FavoriteManager.FreeAndDelete(i); + Break; + end; + end; finally - fs.Free; + FavoriteManager.LockRelease; end; - end; - DLManager.RemoveTask(i); - end - else - Inc(i); - xNode := vtDownload.GetNext(xNode); + DLManager.FreeAndDelete(xNode^.Index); + end; + xNode := vtDownload.GetPreviousSelected(xNode); end; finally - DLManager.CS_DownloadManager_Task.Release; + LeaveCriticalSection(DLManager.CS_Task); end; - vtDownload.ClearSelection; - DLManager.CheckAndActiveTask; + vtDownload.RootNodeCount := DLManager.Items.Count; + vtDownload.EndUpdate; + UpdateVtFavorites; UpdateVtDownload; - DLManager.Backup; + DLManager.CheckAndActiveTask(); + Exit; end; procedure TMainForm.miDownloadMergeCompletedClick(Sender: TObject); var - i, j: Cardinal; + i, j: Integer; + ic, jc: TTaskContainer; // merge all finished tasks that have same manga name, website and directory begin - i := DLManager.Count - 1; - while i > 0 do - begin - if DLManager.TaskItem(i).Status = STATUS_FINISH then + i:=DLManager.Count-1; + while i>0 do begin + ic:=DLManager.Items[i]; + if ic.Status=STATUS_FINISH then begin - j := i - 1; - while j > 0 do - begin - if (i <> j) and - (DLManager.TaskItem(j).Status = STATUS_FINISH) and - SameText(DLManager.TaskItem(i).DownloadInfo.title, - DLManager.TaskItem(j).DownloadInfo.title) and - SameText(DLManager.TaskItem(i).DownloadInfo.website, - DLManager.TaskItem(j).DownloadInfo.website) and - SameText(DLManager.TaskItem(i).DownloadInfo.saveTo, - DLManager.TaskItem(j).DownloadInfo.saveTo) then + j:=i-1; + while j>0 do begin + jc:=DLManager.Items[j]; + if (i<>j) and + (jc.Status = STATUS_FINISH) and + SameText(ic.DownloadInfo.title,jc.DownloadInfo.title) and + SameText(ic.DownloadInfo.website,jc.DownloadInfo.website) and + SameText(ic.DownloadInfo.saveTo,jc.DownloadInfo.saveTo) then begin - DLManager.TaskItem(i).ChapterLinks.Text := - DLManager.TaskItem(j).ChapterLinks.Text + - DLManager.TaskItem(i).ChapterLinks.Text; - DLManager.TaskItem(i).ChapterName.Text := - DLManager.TaskItem(j).ChapterName.Text + - DLManager.TaskItem(i).ChapterName.Text; - DLManager.TaskItem(i).DownloadInfo.dateTime := - DLManager.TaskItem(j).DownloadInfo.dateTime; + ic.ChapterLinks.Text:=jc.ChapterLinks.Text+ic.ChapterLinks.Text; + ic.ChapterName.Text:=jc.ChapterName.Text+ic.ChapterName.Text; + ic.DownloadInfo.dateTime:=jc.DownloadInfo.dateTime; DLManager.RemoveTask(j); Dec(i); end; @@ -1271,14 +2063,14 @@ procedure TMainForm.miFavoritesDownloadAllClick(Sender: TObject); i: Integer; xNode: PVirtualNode; begin - if vtFavorites.SelectedCount = 0 then - Exit; + if vtFavorites.SelectedCount = 0 then Exit; + SilentThreadManager.BeginAdd; try xNode := vtFavorites.GetFirstSelected; for i := 0 to vtFavorites.SelectedCount - 1 do begin if vtFavorites.Selected[xNode] then - with FavoriteManager.FavoriteItem(xNode^.Index).FavoriteInfo do + with FavoriteManager.Items[xNode^.Index].FavoriteInfo do SilentThreadManager.Add(MD_DownloadAll, Website, Title, Link, SaveTo); xNode := vtFavorites.GetNextSelected(xNode); end; @@ -1286,299 +2078,292 @@ procedure TMainForm.miFavoritesDownloadAllClick(Sender: TObject); on E: Exception do ExceptionHandler(Self, E); end; + SilentThreadManager.EndAdd; end; procedure TMainForm.miFavoritesStopCheckNewChapterClick(Sender: TObject); var xNode: PVirtualNode; begin - if vtFavorites.SelectedCount > 0 then + if vtFavorites.SelectedCount = 0 then Exit; + xNode := vtFavorites.GetFirstSelected; + while Assigned(xNode) do begin - xNode := vtFavorites.GetFirstSelected; - repeat - if Assigned(xNode) then - begin - FavoriteManager.StopChekForNewChapter(False, xNode^.Index); - xNode := vtFavorites.GetNextSelected(xNode); - end; - until xNode = nil; - vtFavorites.Repaint; + FavoriteManager.StopChekForNewChapter(False, xNode^.Index); + xNode := vtFavorites.GetNextSelected(xNode); end; + UpdateVtFavorites; end; procedure TMainForm.miFavoritesViewInfosClick(Sender: TObject); -var - title, website, link: String; begin - if (not vtFavorites.Focused) then - Exit; - btDownload.Enabled := False; - pcMain.ActivePage := tsInformation; - imCover.Picture.Assign(nil); - rmInformation.Clear; - rmInformation.Lines.Add('Loading ...'); - clbChapterList.Clear; - - website := FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.Website; - link := FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.link; - title := FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.Title; - - if isGetMangaInfos then - begin - GetInfosThread.IsFlushed := True; - GetInfosThread.Terminate; - //GetInfosThread.WaitFor; - end; - GetInfosThread := TGetMangaInfosThread.Create; - GetInfosThread.MangaListPos := -2; - GetInfosThread.Title := title; - GetInfosThread.Website := website; - GetInfosThread.Link := link; - GetInfosThread.Start; - - if Assigned(gifWaiting) then - begin - itAnimate.Enabled := True; - pbWait.Visible := True; - end; - - if ExecRegExpr('^https?://', link) then - edURL.Text := link - else - edURL.Text := WebsiteRoots[GetMangaSiteID(website), 1] + link; - - btDownload.Enabled := (clbChapterList.RootNodeCount > 0); - btReadOnline.Enabled := (edURL.Text <> ''); + if Assigned(vtFavorites.FocusedNode) then + with FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo do + ViewMangaInfo(Link, Website, Title, SaveTo, miFavoritesViewInfos); end; procedure TMainForm.miHighlightNewMangaClick(Sender: TObject); begin miHighlightNewManga.Checked := not miHighlightNewManga.Checked; - options.WriteBool('general', 'HighLightNewManga', miHighlightNewManga.Checked); + configfile.WriteBool('general', 'HighLightNewManga', miHighlightNewManga.Checked); vtMangaList.Repaint; end; -procedure TMainForm.CheckForTopPanel; -begin - -end; - procedure TMainForm.LoadAbout; var - fs: TFileStream; + i: Integer; + fs: TFileStreamUTF8; + st: TStringList; + regx: TRegExpr; begin - try - rmAbout.Clear; - fs := TFileStream.Create(README_FILE, fmOpenRead or fmShareDenyNone); - rmAbout.LoadRichText(fs); - fs.Free; - except - on E: Exception do ; + // load readme.rtf + if FileExistsUTF8(README_FILE) then begin + regx := TRegExpr.Create; + st := TStringList.Create; + try + regx.ModifierI := True; + regx.Expression := '(version.*)((\d+\.){3}\d+)'; + st.LoadFromFile(README_FILE); + if st.Count > 0 then + for i := 0 to st.Count - 1 do + if regx.Exec(st[i]) then + begin + if regx.Match[2] <> FMD_VERSION_STRING then begin + st[i] := regx.Replace(st[i], '$1\' + FMD_VERSION_STRING, True); + if DeleteFileUTF8(README_FILE) then + st.SaveToFile(README_FILE); + end; + Break; + end; + finally + st.Free; + regx.Free; + end; + fs := TFileStreamUTF8.Create(README_FILE, fmOpenRead or fmShareDenyNone); + try + rmAbout.LoadRichText(fs); + finally + fs.free; + end; + end; + // load changelog.txt + if FileExistsUTF8(CHANGELOG_FILE) then mmChangelog.Lines.LoadFromFile(CHANGELOG_FILE); + + // compiler info + AddToAboutStatus('FPC Version', GetFPCVersion); + AddToAboutStatus('LCL Version', GetLCLVersion); + AddToAboutStatus('WidgetSet', GetWidgetSetName); + AddToAboutStatus('Target CPU-OS', GetTargetCPU_OS); + AddToAboutStatus('Build Time', GetBuildTime); + if SQLiteLibraryHandle = 0 then InitializeSqlite(); + if SQLiteLibraryHandle <> 0 then try AddToAboutStatus('SQLite Version', sqlite3_version()); except end; + if SSLLibHandle = 0 then InitSSLInterface; + if SSLLibHandle <> 0 then try AddToAboutStatus('OpenSSL Version', SSLeayversion(0)); except end; + if WebPLibHandle = 0 then InitWebPModule; + if WebPLibHandle <> 0 then try AddToAboutStatus('WebP Version', WebPGetVersion); except end; +end; + +procedure TMainForm.AddToAboutStatus(const ACaption, AValue: String); + + function addaboutcomplbl(const ACaption: String): TLabel; + begin + Result := TLabel.Create(Self); + Result.Parent := pnAboutComp; + Result.Caption := ACaption; end; -end; -procedure TMainForm.tvDownloadFilterRepaint; -var - i: Cardinal; - LFinishedTasks: Cardinal = 0; - LInProgressTasks: Cardinal = 0; - LStoppedTasks: Cardinal = 0; - LFailedTask: Cardinal = 0; begin - if (Assigned(DLManager)) and (DLManager.Count > 0) then - for i := 0 to DLManager.Count - 1 do - begin - case DLManager.TaskItem(i).Status of - STATUS_FINISH: Inc(LFinishedTasks); - STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_WAIT: Inc(LInProgressTasks); - STATUS_STOP: Inc(LStoppedTasks); - STATUS_PROBLEM, STATUS_FAILED: Inc(LFailedTask); - end; - end; - - // root - tvDownloadFilter.Items[0].Text := - Format('%s (%d)', [RS_AllDownloads, vtDownload.RootNodeCount]); + addaboutcomplbl(ACaption + ':'); + with addaboutcomplbl(AValue) do + begin + Font.Style := [fsBold]; + BorderSpacing.Right := 16; + end; +end; - // childs - tvDownloadFilter.Items[1].Text := Format('%s (%d)', [RS_Finish, LFinishedTasks]); - tvDownloadFilter.Items[2].Text := Format('%s (%d)', [RS_InProgress, LInProgressTasks]); - tvDownloadFilter.Items[3].Text := Format('%s (%d)', [RS_Stopped, LStoppedTasks]); - tvDownloadFilter.Items[4].Text := Format('%s (%d)', [RS_Failed, LFailedTask]); +procedure TMainForm.GeneratetvDownloadFilterNodes; - // root - tvDownloadFilter.Items[5].Text := RS_History; + function Add(const ParentNode: TTreeNode; const S: String; + const ImgIdx: Integer = -1): TTreeNode; + begin + if Assigned(ParentNode) then + Result := tvDownloadFilter.Items.AddChild(ParentNode, S) + else + Result := tvDownloadFilter.Items.Add(nil, S); + with Result do + begin + ImageIndex := ImgIdx; + SelectedIndex := ImgIdx; + StateIndex := ImgIdx; + end; + end; - // childs - tvDownloadFilter.Items[6].Text := RS_Today; - tvDownloadFilter.Items[7].Text := RS_Yesterday; - tvDownloadFilter.Items[8].Text := RS_OneWeek; - tvDownloadFilter.Items[9].Text := RS_OneMonth; -end; +var + Node: TTreeNode; -procedure TMainForm.GenerateNodes; begin with tvDownloadFilter do begin Items.Clear; - // root - Items.Add(nil, RS_AllDownloads); - Items[0].ImageIndex := 4; - Items[0].SelectedIndex := 4; - Items[0].StateIndex := 4; - - // childs - Items.AddChild(tvDownloadFilter.Items[0], RS_Finish); - Items[1].ImageIndex := 5; - Items[1].SelectedIndex := 5; - Items[1].StateIndex := 5; - Items.AddChild(tvDownloadFilter.Items[0], RS_InProgress); - Items[2].ImageIndex := 6; - Items[2].SelectedIndex := 6; - Items[2].StateIndex := 6; - Items.AddChild(tvDownloadFilter.Items[0], RS_Stopped); - Items[3].ImageIndex := 7; - Items[3].SelectedIndex := 7; - Items[3].StateIndex := 7; - Items.AddChild(tvDownloadFilter.Items[0], RS_Failed); - Items[4].ImageIndex := 16; - Items[4].SelectedIndex := 16; - Items[4].StateIndex := 16; - - // root - Items.Add(nil, RS_History); - Items[5].ImageIndex := 4; - Items[5].SelectedIndex := 4; - Items[5].StateIndex := 4; - - // childs - Items.AddChild(tvDownloadFilter.Items[5], RS_Today); - Items[6].ImageIndex := 8; - Items[6].SelectedIndex := 8; - Items[6].StateIndex := 8; - Items.AddChild(tvDownloadFilter.Items[5], RS_Yesterday); - Items[7].ImageIndex := 8; - Items[7].SelectedIndex := 8; - Items[7].StateIndex := 8; - Items.AddChild(tvDownloadFilter.Items[5], RS_OneWeek); - Items[8].ImageIndex := 8; - Items[8].SelectedIndex := 8; - Items[8].StateIndex := 8; - Items.AddChild(tvDownloadFilter.Items[5], RS_OneMonth); - Items[9].ImageIndex := 8; - Items[9].SelectedIndex := 8; - Items[9].StateIndex := 8; - - Items[Self.options.ReadInteger('general', 'DownloadFilterSelect',0)].Selected := True; + // download + Node := Add(nil, RS_AllDownloads, 4); + Add(Node, RS_Finish, 5); + Add(Node, RS_InProgress, 6); + Add(Node, RS_Stopped, 7); + Add(Node, RS_Failed, 16); + Add(Node, RS_Disabled, 22); + + // history + Node := Add(nil, RS_History, 4); + Add(Node, RS_Today, 8); + Add(Node, RS_Yesterday, 8); + Add(Node, RS_OneWeek, 8); + Add(Node, RS_OneMonth, 8); + + Items[configfile.ReadInteger('general', 'DownloadFilterSelect', 0)].Selected := True; end; end; procedure TMainForm.btDownloadClick(Sender: TObject); var - s: String; - i, pos: Integer; - isCreate: Boolean = False; - xNode: PVirtualNode; + links,names:TStrings; + node:PVirtualNode; + s:String; + c,p,r,i,j,k,l, newdl:Integer; begin if clbChapterList.CheckedCount = 0 then Exit; - Pos := -1; - xNode := clbChapterList.GetFirstChecked; - for i := 0 to clbChapterList.CheckedCount - 1 do - begin - if xNode^.CheckState = csCheckedNormal then + links:=TStringList.Create; + names:=TStringList.Create; + try + node:=clbChapterList.GetFirstChecked(); + while Assigned(node) do begin - if not isCreate then + if (vsVisible in node^.States) then begin - pos := DLManager.AddTask; - isCreate := True; + links.Add(ChapterList[node^.Index].Link); + s:=CustomRename(OptionChapterCustomRename, + mangaInfo.website, + mangaInfo.title, + mangaInfo.authors, + mangaInfo.artists, + ChapterList[node^.Index].Title, + Format('%.4d',[ChapterList[node^.Index].Index]), + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); + names.Add(s); + ChapterList[node^.Index].Downloaded:=True; + clbChapterList.ReinitNode(node,False); end; - DLManager.TaskItem(pos).MangaSiteID := GetMangaSiteID(mangaInfo.website); - // generate folder name - s := CustomRename(OptionCustomRename, - mangaInfo.website, - mangaInfo.title, - mangaInfo.authors, - mangaInfo.artists, - mangaInfo.chapterName.Strings[xNode^.Index], - Format('%.4d', [xNode^.Index + 1]), - cbOptionPathConvert.Checked); - DLManager.TaskItem(pos).ChapterName.Add(s); - DLManager.TaskItem(pos).ChapterLinks.Add( - mangaInfo.chapterLinks.Strings[xNode^.Index]); - ChapterList[xNode^.Index].Downloaded := True; - clbChapterList.ReinitNode(xNode, False); + node:=clbChapterList.GetNextChecked(node); end; - xNode := clbChapterList.GetNextChecked(xNode); - end; - if not isCreate then - Exit; - if cbAddAsStopped.Checked then - begin - DLManager.TaskItem(pos).DownloadInfo.Status := RS_Stopped; - DLManager.TaskItem(pos).Status := STATUS_STOP; - end - else - begin - DLManager.TaskItem(pos).DownloadInfo.Status := RS_Waiting; - DLManager.TaskItem(pos).Status := STATUS_WAIT; - end; - DLManager.TaskItem(pos).CurrentDownloadChapterPtr := 0; - DLManager.TaskItem(pos).DownloadInfo.Website := mangaInfo.website; - DLManager.TaskItem(pos).DownloadInfo.Link := mangaInfo.url; - DLManager.TaskItem(pos).DownloadInfo.Title := mangaInfo.title; - DLManager.TaskItem(pos).DownloadInfo.DateTime := Now; - - s := CorrectPathSys(edSaveTo.Text); - // save to - if cbOptionGenerateMangaFolderName.Checked then - begin - if not cbOptionPathConvert.Checked then - s := s + RemoveSymbols(mangaInfo.title) - else - s := s + RemoveSymbols(UnicodeRemove(mangaInfo.title)); + clbChapterList.Repaint; + if links.Count<>0 then + begin + s:=edSaveTo.Text; + if OptionGenerateMangaFolder and + not((LastViewMangaInfoSender = miDownloadViewMangaInfo) or + (LastViewMangaInfoSender = miFavoritesViewInfos)) // ignore custom saveto options + then + s:=AppendPathDelim(s)+CustomRename( + OptionMangaCustomRename, + mangaInfo.website, + mangaInfo.title, + mangaInfo.authors, + mangaInfo.artists, + '', + '', + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); + s:=ReplaceRegExpr('\.*$', s, '', False); + c:=1; + p:=links.Count; + r:=0; + if btDownload.Tag>=links.Count then + begin + c:=links.Count; + p:=1; + end + else + if btDownload.Tag>1 then + begin + c:=btDownload.Tag; + p:=links.Count div c; + r:=links.Count mod c; + end; + btDownload.Tag:=0; + k:=0; + for i:=1 to c do + begin + if i<=r then + l:=p+1 + else + if i=c then + l:=links.Count-k + else + l:=p; + newdl := DLManager.AddTask; + with DLManager[newdl] do + begin + for j:=1 to l do + begin + ChapterLinks.Add(links[k]); + ChapterName.Add(names[k]); + Inc(k); + end; + if cbAddAsStopped.Checked then + begin + DownloadInfo.Status:=Format('[%d/%d] %s',[0,ChapterLinks.Count,RS_Stopped]); + Status:=STATUS_STOP; + end + else + begin + DownloadInfo.Status:=Format('[%d/%d] %s',[0,ChapterLinks.Count,RS_Waiting]); + Status:=STATUS_WAIT; + end; + Website:=mangaInfo.website; + DownloadInfo.Website:=mangaInfo.website; + DownloadInfo.Link:=mangaInfo.link; + DownloadInfo.Title:=mangaInfo.title; + DownloadInfo.DateTime:=Now; + DownloadInfo.SaveTo:=s; + CurrentDownloadChapterPtr:=0; + SaveToDB(newdl); + end; + end; + DLManager.DownloadedChapters.Chapters[mangaInfo.website+mangaInfo.link]:=links.Text; + FavoriteManager.AddToDownloadedChaptersList(mangaInfo.website,mangaInfo.link,links); + DLManager.CheckAndActiveTask; + pcMain.ActivePage:=tsDownload; + UpdateVtDownload; + end; + finally + links.Free; + names.Free; end; - s := CorrectPathSys(s); - DLManager.TaskItem(pos).DownloadInfo.SaveTo := s; - UpdateVtDownload; - - DLManager.Backup; - DLManager.CheckAndActiveTask; - DLManager.AddToDownloadedChaptersList( - mangaInfo.website + mangaInfo.link, DLManager.TaskItem(pos).ChapterLinks); - FavoriteManager.AddToDownloadedChaptersList( - mangaInfo.website, mangaInfo.link, DLManager.TaskItem(pos).ChapterLinks); - clbChapterList.Repaint; - pcMain.ActivePage := tsDownload; end; procedure TMainForm.btAddToFavoritesClick(Sender: TObject); var - s, s2: String; - i: Integer; + s: String; begin if mangaInfo.title <> '' then begin - s := CorrectPathSys(edSaveTo.Text); - // save to - if cbOptionGenerateMangaFolderName.Checked then - begin - if not cbOptionPathConvert.Checked then - s := s + RemoveSymbols(mangaInfo.title) - else - s := s + RemoveSymbols(UnicodeRemove(mangaInfo.title)); - end; - s := CorrectPathSys(s); - - s2 := ''; - if (mangaInfo.numChapter > 0) {AND (mangaInfo.website = MANGASTREAM_NAME)} then - begin - for i := 0 to mangaInfo.numChapter - 1 do - s2 := s2 + mangaInfo.chapterLinks.Strings[i] + SEPERATOR; - end; - - FavoriteManager.Add(mangaInfo.title, IntToStr(mangaInfo.numChapter), s2, + s := edSaveTo.Text; + if OptionGenerateMangaFolder then + s := AppendPathDelim(s) + CustomRename( + OptionMangaCustomRename, + mangaInfo.website, + mangaInfo.title, + mangaInfo.authors, + mangaInfo.artists, + '', + '', + OptionChangeUnicodeCharacter, + OptionChangeUnicodeCharacterStr); + + FavoriteManager.Add(mangaInfo.title, IntToStr(mangaInfo.numChapter), mangaInfo.chapterLinks.Text, mangaInfo.website, s, mangaInfo.link); vtFavorites.NodeDataSize := SizeOf(TFavoriteInfo); UpdateVtFavorites; @@ -1592,6 +2377,12 @@ procedure TMainForm.btAbortUpdateListClick(Sender: TObject); updateList.Terminate; end; +procedure TMainForm.btAbortCheckLatestVersionClick(Sender: TObject); +begin + if Assigned(CheckUpdateThread) then + CheckUpdateThread.Terminate; +end; + procedure TMainForm.btCancelFavoritesCheckClick(Sender: TObject); begin FavoriteManager.StopChekForNewChapter(False); @@ -1601,7 +2392,10 @@ procedure TMainForm.appPropertiesMainShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo); begin if HintInfo.HintControl = vtMangaList then + begin HintInfo.HintMaxWidth := 500; + HintInfo.HideTimeout := 300000; + end; if HintInfo.HintControl = sbUpdateList then if isUpdating then HintStr := Trim(updateList.websites.Text) @@ -1619,24 +2413,6 @@ procedure TMainForm.btFavoritesCheckNewChapterClick(Sender: TObject); // ----- -procedure TMainForm.btBrowseClick(Sender: TObject); -begin - //dlgSaveTo.InitialDir := CorrectFilePath(edSaveTo.Text); - dlgSaveTo.InitialDir := edSaveTo.Text; - if dlgSaveTo.Execute then - edSaveTo.Text := dlgSaveTo.FileName; - //edSaveTo.Text := CorrectFilePath(dlgSaveTo.FileName); -end; - -procedure TMainForm.btOptionBrowseClick(Sender: TObject); -begin - //dlgSaveTo.InitialDir := CorrectFilePath(edOptionDefaultPath.Text); - dlgSaveTo.InitialDir := edOptionDefaultPath.Text; - if dlgSaveTo.Execute then - edOptionDefaultPath.Text := CorrectPathSys(dlgSaveTo.FileName); - //edOptionDefaultPath.Text := CorrectFilePath(dlgSaveTo.FileName); -end; - // ----- procedure TMainForm.btUpdateListClick(Sender: TObject); @@ -1683,9 +2459,7 @@ procedure TMainForm.DisableAddToFavorites(webs: String); procedure TMainForm.FMDInstanceReceiveMsg(Sender: TObject); begin - { TODO 5 -oCholif : Need translation } - MessageDlg('Free Manga Downloader', 'Free Manga Downloader already running!', - mtWarning, [mbOK], 0); + MessageDlg(Application.Title, RS_FMDAlreadyRunning, mtWarning, [mbOK], 0); if WindowState = wsMinimized then WindowState := wsNormal; Show; @@ -1701,94 +2475,17 @@ procedure TMainForm.ClearChapterListState; ChapterList[i].Downloaded := False; end; -procedure TMainForm.btURLClick(Sender: TObject); -var - i: Integer; - webid: Cardinal; - website, - webs, - link: String; - regx: TRegExpr; +procedure TMainForm.EmbedForm(const AForm: TForm; const AParent: TWinControl); begin - website := ''; - webs := ''; - link := ''; - regx := TRegExpr.Create; - try - regx.Expression := '^https?\://'; - if not (regx.Exec(edURL.Text)) then - edURL.Text := 'http://' + edURL.Text; - - regx.Expression := '^https?\:(//[^/]*\w+\.\w+)(\:\d+)?(/|\Z)(.*)$'; - if regx.Exec(edURL.Text) then - begin - link := regx.Replace(edURL.Text, '$4', True); - webs := regx.Replace(edURL.Text, '$1', True); - end; - - if (webs <> '') and (link <> '') then - begin - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - if Pos(webs, WebsiteRoots[i, 1]) > 0 then - begin - webid := i; - website := WebsiteRoots[i, 0]; - Break; - end; - if website = '' then - begin - webs := TrimLeftChar(webs, ['/']); - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - begin - if Pos(webs, WebsiteRoots[i, 1]) > 0 then - begin - webid := i; - website := WebsiteRoots[i, 0]; - Break; - end; - end; - end; - if website <> '' then - begin - link := '/' + link; - edURL.Text := FixURL(WebsiteRoots[webid, 1] + link); - DisableAddToFavorites(website); - end; - end; - finally - regx.Free; - end; - - if (website = '') or (link = '') then - begin - MessageDlg('', RS_DlgURLNotSupport, mtInformation, [mbYes], 0); - Exit; - end; - - if isGetMangaInfos then - begin - GetInfosThread.IsFlushed := True; - GetInfosThread.Terminate; - //GetInfosThread.WaitFor; - end; - GetInfosThread := TGetMangaInfosThread.Create; - GetInfosThread.MangaListPos := -1; - GetInfosThread.Title := ''; - GetInfosThread.Website := website; - GetInfosThread.Link := link; - GetInfosThread.Start; - - pcMain.ActivePage := tsInformation; - imCover.Picture.Assign(nil); - clbChapterList.Clear; - if Assigned(gifWaiting) then + with AForm do begin - itAnimate.Enabled := True; - pbWait.Visible := True; + Parent := AParent; + BorderStyle := bsNone; + Align := alClient; + Show; + if Screen.PixelsPerInch > 96 then + AutoAdjustLayout(lapAutoAdjustForDPI, Screen.PixelsPerInch, 96, 0, 0); end; - btAddToFavorites.Enabled := not SitesWithoutFavorites(website); - rmInformation.Clear; - rmInformation.Lines.Add(RS_Loading); end; procedure TMainForm.btVisitMyBlogClick(Sender: TObject); @@ -1796,9 +2493,25 @@ procedure TMainForm.btVisitMyBlogClick(Sender: TObject); OpenURL('http://akarink.wordpress.com/'); end; -procedure TMainForm.btWebsitesSearchClearClick(Sender: TObject); +procedure TMainForm.cbAddAsStoppedChange(Sender: TObject); begin - edWebsitesSearch.Clear; + configfile.WriteBool('general', 'AddAsStopped', cbAddAsStopped.Checked); +end; + +procedure TMainForm.cbOptionAutoCheckFavIntervalChange(Sender: TObject); +begin + seOptionAutoCheckFavIntervalMinutes.Enabled := cbOptionAutoCheckFavInterval.Checked; + lbOptionAutoCheckFavIntervalMinutes.Enabled := cbOptionAutoCheckFavInterval.Checked; +end; + +procedure TMainForm.cbOptionAutoCheckFavStartupChange(Sender: TObject); +begin + cbOptionAutoOpenFavStartup.Enabled := cbOptionAutoCheckFavStartup.Checked; +end; + +procedure TMainForm.cbOptionChangeUnicodeCharacterChange(Sender: TObject); +begin + edOptionChangeUnicodeCharacterStr.Enabled := cbOptionChangeUnicodeCharacter.Checked; end; procedure TMainForm.cbOptionDigitChapterChange(Sender: TObject); @@ -1811,22 +2524,81 @@ procedure TMainForm.cbOptionDigitVolumeChange(Sender: TObject); seOptionDigitVolume.Enabled := cbOptionDigitVolume.Checked; end; +procedure TMainForm.cbOptionGenerateMangaFolderChange(Sender: TObject); +begin + edOptionMangaCustomRename.Enabled := cbOptionGenerateMangaFolder.Checked; + lbOptionMangaCustomRename.Enabled := edOptionMangaCustomRename.Enabled; + lbOptionMangaCustomRenameHint.Enabled := edOptionMangaCustomRename.Enabled; +end; + +procedure TMainForm.cbSelectMangaEditingDone(Sender: TObject); +begin + if cbSelectManga.ItemIndex < 0 then + Exit; + if currentWebsite <> cbSelectManga.Items[cbSelectManga.ItemIndex] then + begin + configfile.WriteInteger('form', 'SelectManga', cbSelectManga.ItemIndex); + currentWebsite := cbSelectManga.Items[cbSelectManga.ItemIndex]; + vtMangaList.Clear; + if dataProcess = nil then + dataProcess := TDBDataProcess.Create + else + if dataProcess.Connected then + dataProcess.Close; + lbMode.Caption := Format(RS_ModeAll, [0]); + if DataFileExist(cbSelectManga.Items[cbSelectManga.ItemIndex]) then + begin + OpenDataDB(cbSelectManga.Items[cbSelectManga.ItemIndex]); + end + else + if cbOptionShowDownloadMangalistDialog.Checked then + RunGetList; + end; +end; + +procedure TMainForm.cbSelectMangaKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if not (Key in [VK_RETURN, VK_TAB]) then + cbSelectManga.DroppedDown:=True; +end; + +procedure TMainForm.cbSelectMangaMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if Button = mbMiddle then + cbSelectMangaEditingDone(Sender); +end; + procedure TMainForm.btReadOnlineClick(Sender: TObject); begin OpenURL(mangaInfo.url); end; -procedure TMainForm.btSearchClearClick(Sender: TObject); +procedure TMainForm.btMangaListSearchClearClick(Sender: TObject); begin - edSearch.Clear; + edMangaListSearch.Tag := 1; + edMangaListSearch.Clear; end; -procedure TMainForm.btCheckVersionClick(Sender: TObject); +procedure TMainForm.btCheckLatestVersionClick(Sender: TObject); begin - if SubThread.CheckUpdate then + if Assigned(CheckUpdateThread) or Assigned(SelfUpdaterThread) then MessageDlg('', RS_DlgUpdaterIsRunning, mtInformation, [mbYes], 0) else - SubThread.CheckUpdate := True; + CheckUpdateThread := TCheckUpdateThread.Create; +end; + +procedure TMainForm.btClearLogFileClick(Sender: TObject); +var + F: TextFile; +begin + if FileExistsUTF8(edLogFileName.Text) then + begin + system.Assign(F, edLogFileName.Text); + Rewrite(F); + CloseFile(F); + end; end; procedure TMainForm.btDonateClick(Sender: TObject); @@ -1834,6 +2606,24 @@ procedure TMainForm.btDonateClick(Sender: TObject); OpenURL('https://www.paypal.com/cgi-bin/webscr?cmd=_donations&business=akarin.km@gmail.com&item_name=Donation+to+Free+Manga+Downloader'); end; +procedure TMainForm.btDownloadSplitClick(Sender: TObject); +var + s:String=''; + c:Integer=-1; +begin + if InputQuery(RS_DlgSplitDownload,RS_DlgDownloadCount,s) and (s<>'') then + begin + c:=StrToIntDef(s,-1); + if c<=0 then + MessageDlg(RS_WrongInput,mtError,[mbOK],0) + else + begin + btDownload.Tag:=c; + btDownloadClick(btDownload); + end; + end; +end; + procedure TMainForm.btFavoritesImportClick(Sender: TObject); begin with TImportFavorites.Create(Self) do try @@ -1843,12 +2633,13 @@ procedure TMainForm.btFavoritesImportClick(Sender: TObject); end; end; +procedure TMainForm.btOpenLogClick(Sender: TObject); +begin + FormLogger.Show; +end; + procedure TMainForm.btChecksClick(Sender: TObject); begin - if dataProcess.Title.Count = 0 then - pmUpdate.Items[0].Enabled := False - else - pmUpdate.Items[0].Enabled := True; if Sender is TControl then with TControl(Sender) do begin pmChapterList.Alignment := Menus.paRight; @@ -1858,234 +2649,129 @@ procedure TMainForm.btChecksClick(Sender: TObject); clbChapterList.SetFocus; end; -procedure TMainForm.cbSelectMangaChange(Sender: TObject); -var - isFilterAllSites: Boolean; - K: Word; +procedure TMainForm.clbChapterListBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); begin - if cbSelectManga.ItemIndex < 0 then - Exit; - - if currentWebsite <> cbSelectManga.Items[cbSelectManga.ItemIndex] then + if CellPaintMode <> cpmPaint then Exit; + if Node^.Index>=Length(ChapterList) then Exit; + if ChapterList[Node^.Index].Downloaded then begin - Screen.Cursor := crHourGlass; - try - if dataProcess.Title.Count > 0 then - begin - isFilterAllSites := dataProcess.isFilterAllSites; - dataProcess.RemoveFilter; - if not isFilterAllSites then - dataProcess.SaveToFile; - end; - if Assigned(dataProcess) then - dataProcess.Free; - dataProcess := TDataProcess.Create; - if not dataProcess.LoadFromFile( - cbSelectManga.Items.Strings[cbSelectManga.ItemIndex]) then - begin - RunGetList; - end; - vtMangaList.OnInitNode := @vtMangaListInitNode; - vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; - lbMode.Caption := Format(RS_ModeAll, [dataProcess.filterPos.Count]); - currentWebsite := cbSelectManga.Items[cbSelectManga.ItemIndex]; - dataProcess.website := cbSelectManga.Items[cbSelectManga.ItemIndex]; - CheckForTopPanel; - LastSearchStr := ''; - K := VK_RETURN; - edSearchKeyUp(edSearch, K, []); - edSearchChange(edSearch); - finally - Screen.Cursor := crDefault; - end; + TargetCanvas.Brush.Color:=CL_CHDownloaded; + TargetCanvas.FillRect(CellRect); end; end; -procedure TMainForm.ckDropTargetChange(Sender: TObject); +procedure TMainForm.clbChapterListGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); begin - if ckDropTarget.Checked then - begin - if FormDropTarget = nil then - Application.CreateForm(TFormDropTarget, FormDropTarget); - frmDropTarget.OnDropChekout := @AddSilentThread; - frmDropTarget.FAlphaBlendValue := tbDropTargetOpacity.Position; - FormDropTarget.Show; - end + if Node^.Index>=Length(ChapterList) then Exit; + if Length(ChapterList)=1 then + CellText:=ChapterList[Node^.Index].Title else - begin - if Assigned(FormDropTarget) then - FormDropTarget.Close; - end; + CellText:=Format('%.4d - %s',[ChapterList[Node^.Index].Index, ChapterList[Node^.Index].Title]); end; -procedure TMainForm.clbChapterListBeforeCellPaint(Sender: TBaseVirtualTree; - TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +procedure TMainForm.clbChapterListInitNode(Sender: TBaseVirtualTree; + ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +begin + if Assigned(Node) then Node^.CheckType:=ctCheckBox; +end; + +procedure TMainForm.clbChapterListKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var + i: Cardinal; + xNode: PVirtualNode; begin - if Assigned(Node) then - if ChapterList[Node^.Index].Downloaded then + if (Key = VK_SPACE) and (clbChapterList.SelectedCount > 0) then + begin + xNode := clbChapterList.GetFirstSelected; + for i := 0 to clbChapterList.SelectedCount - 1 do begin - TargetCanvas.Brush.Color := CL_HLGreenMarks; - TargetCanvas.FillRect(CellRect); + if clbChapterList.Selected[xNode] then + if xNode^.CheckState = csUncheckedNormal then + xNode^.CheckState := csCheckedNormal + else if xNode^.CheckState = csCheckedNormal then + xNode^.CheckState := csUncheckedNormal; + clbChapterList.InvalidateNode(xNode); + xNode := clbChapterList.GetNextSelected(xNode); end; + Key := VK_UNKNOWN; + end; end; -procedure TMainForm.clbChapterListFreeNode(Sender : TBaseVirtualTree; - Node : PVirtualNode); -var - Data: PChapterStateItem; +procedure TMainForm.edDownloadsSearchButtonClick(Sender: TObject); begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - Finalize(Data^); + edDownloadsSearch.Clear; end; -procedure TMainForm.clbChapterListGetNodeDataSize(Sender: TBaseVirtualTree; - var NodeDataSize: Integer); +procedure TMainForm.edDownloadsSearchChange(Sender: TObject); begin - NodeDataSize := SizeOf(TChapterStateItem); + SearchOnVT(vtDownload, edDownloadsSearch.Text); end; -procedure TMainForm.clbChapterListGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: String); -var - Data: PChapterStateItem; +procedure TMainForm.edFavoritesSearchButtonClick(Sender: TObject); begin - Data := clbChapterList.GetNodeData(Node); - if Assigned(Data) then - CellText := Data^.Title; + edFavoritesSearch.Clear; end; -procedure TMainForm.clbChapterListInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); -var - Data: PChapterStateItem; +procedure TMainForm.edFavoritesSearchChange(Sender: TObject); begin - with Sender do - begin - Data := GetNodeData(Node); - if mangaInfo.chapterName.Count = 1 then - Data^.Title := ChapterList[Node^.Index].Title - else - Data^.Title := Format('%.4d - %s', [Node^.Index + 1, - ChapterList[Node^.Index].Title]); - Data^.Link := ChapterList[Node^.Index].Link; - Data^.Downloaded := ChapterList[Node^.Index].Downloaded; - Node^.CheckType := ctCheckBox; - clbChapterList.ValidateNode(Node, False); - end; + SearchOnVT(vtFavorites, edFavoritesSearch.Text, 1); +end; + +procedure TMainForm.edFilterMangaInfoChaptersButtonClick(Sender: TObject); +begin + edFilterMangaInfoChapters.Clear; +end; + +procedure TMainForm.edFilterMangaInfoChaptersChange(Sender: TObject); +begin + FilterChapterList(edFilterMangaInfoChapters.Text, miChapterListHideDownloaded.Checked); +end; + +procedure TMainForm.edLogFileNameButtonClick(Sender: TObject); +begin + with TOpenDialog.Create(nil) do + try + InitialDir := ExtractFileDir(ExpandFileName(edLogFileName.Text)); + if Execute then + edLogFileName.Text := FileName; + finally + Free; + end; end; procedure TMainForm.edURLKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then - btURLClick(btURL); + edURLButtonClick(edURL); +end; + +procedure TMainForm.edWebsitesSearchButtonClick(Sender: TObject); +begin + edWebsitesSearch.Clear; end; procedure TMainForm.edWebsitesSearchChange(Sender: TObject); -var - s: String; - lcount: Integer; - data: PMangaListItem; - xNode, lNode: PVirtualNode; begin - if Length(optionMangaSiteSelectionNodes) < 1 then Exit; - s := Trim(LowerCase(edWebsitesSearch.Text)); - vtOptionMangaSiteSelection.BeginUpdate; - try - lNode := nil; - lcount := 0; - vtOptionMangaSiteSelection.RootNode^.TotalHeight := vtOptionMangaSiteSelection.DefaultNodeHeight; - if s = '' then - begin - xNode := vtOptionMangaSiteSelection.GetFirst; - while Assigned(xNode) do - begin - Include(xNode^.States, vsVisible); - if xNode^.ChildCount > 0 then - begin - lNode := xNode; - Inc(vtOptionMangaSiteSelection.RootNode^.TotalHeight, xNode^.NodeHeight); - end - else - if Assigned(lNode) then - if vsExpanded in lNode^.States then - Inc(vtOptionMangaSiteSelection.RootNode^.TotalHeight, xNode^.NodeHeight); - xNode := vtOptionMangaSiteSelection.GetNext(xNode); - end; - end - else - begin - xNode := vtOptionMangaSiteSelection.GetFirst; - while Assigned(xNode) do - begin - Include(xNode^.States, vsVisible); - if xNode^.ChildCount > 0 then - begin - if Assigned(lNode) then - begin - if lcount > 0 then - Inc(vtOptionMangaSiteSelection.RootNode^.TotalHeight, lNode^.NodeHeight) - else - Exclude(lNode^.States, vsVisible); - end; - lNode := xNode; - lcount := 0; - end - else - begin - data := vtOptionMangaSiteSelection.GetNodeData(xNode); - if Assigned(data) then - begin - if Pos(s, LowerCase(data^.Text)) <> 0 then - begin - Inc(lcount); - if Assigned(lNode) then - begin - if vsExpanded in lNode^.States then - Inc(vtOptionMangaSiteSelection.RootNode^.TotalHeight, xNode^.NodeHeight); - end; - end - else - Exclude(xNode^.States, vsVisible); - end; - end; - xNode := vtOptionMangaSiteSelection.GetNext(xNode); - end; - if Assigned(lNode) then - begin - if lcount > 0 then - Inc(vtOptionMangaSiteSelection.RootNode^.TotalHeight, lNode^.NodeHeight) - else - Exclude(lNode^.States, vsVisible); - end; - end; - finally - vtOptionMangaSiteSelection.EndUpdate; - end; + SearchOnVT(vtOptionMangaSiteSelection, edWebsitesSearch.Text); end; procedure TMainForm.btRemoveFilterClick(Sender: TObject); begin - if dataProcess.isFiltered then + if dataProcess.Filtered then begin + vtMangaList.Clear; Screen.Cursor := crHourGlass; try dataProcess.RemoveFilter; - if dataProcess.isFilterAllSites then - begin - dataProcess.isFilterAllSites := False; - dataProcess.Free; - dataProcess := TDataProcess.Create; - dataProcess.LoadFromFile(cbSelectManga.Items[cbSelectManga.ItemIndex]); - end; - vtMangaList.OnInitNode := @vtMangaListInitNode; - vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; - lbMode.Caption := Format(RS_ModeAll, [dataProcess.filterPos.Count]); - edSearch.Text := ''; + vtMangaList.RootNodeCount := dataProcess.RecordCount; + lbMode.Caption := Format(RS_ModeAll, [dataProcess.RecordCount]); + edMangaListSearch.Tag := -1; + edMangaListSearch.Clear; except on E: Exception do ExceptionHandler(Self, E); @@ -2098,83 +2784,76 @@ procedure TMainForm.btRemoveFilterClick(Sender: TObject); procedure TMainForm.btFilterClick(Sender: TObject); var - l, checkGenres, uncheckGenres: TStringList; - i: Cardinal; + checkGenres, + uncheckGenres: TStringList; + i: Integer; s: String; begin Screen.Cursor := crHourGlass; checkGenres := TStringList.Create; uncheckGenres := TStringList.Create; try - if cbUseRegExpr.Checked and (Trim(edCustomGenres.Text) <> '') then - checkGenres.Add(Trim(edCustomGenres.Text)) + edCustomGenres.Text := Trim(edCustomGenres.Text); + if cbUseRegExpr.Checked and (edCustomGenres.Text <> '') then + checkGenres.Add(edCustomGenres.Text) else begin - //CustomGenres(checkGenres, edCustomGenres.Text); - ExtractStrings([',', ';'], [], PChar(edCustomGenres.Text), checkGenres); + ExtractStrings([','], [], PChar(edCustomGenres.Text), checkGenres); TrimStrings(checkGenres); i := 0; - while i < checkGenres.Count do - begin - s := checkGenres.Strings[i]; - if (s[1] = '-') or (s[1] = '!') then - begin - if (s[1] = '-') then - s := StringReplace(s, '-', '', []) - else - s := StringReplace(s, '!', '', []); + while i < checkGenres.Count do begin + s := Trim(checkGenres.Strings[i]); + if (s <> '') and (s[1] = '-') or (s[1] = '!') then begin + Delete(s, 1, 1); uncheckGenres.Add(s); checkGenres.Delete(i); end - else - Inc(i); + else Inc(i); end; end; - for i := 0 to 37 do - begin - if TCheckBox(pnGenres.Controls[i]).State = cbChecked then - checkGenres.Add(TCheckBox(pnGenres.Controls[i]).Caption) - else - if TCheckBox(pnGenres.Controls[i]).State = cbUnchecked then - uncheckGenres.Add(TCheckBox(pnGenres.Controls[i]).Caption); - end; - // we will reload the list if search from all websites is enabled - if (cbSearchFromAllSites.Checked) and (not dataProcess.isFilterAllSites) and - (not dataProcess.isFiltered) then - begin - if not dataProcess.CanFilter(checkGenres, uncheckGenres, - edFilterTitle.Text, edFilterAuthors.Text, - edFilterArtists.Text, IntToStr(cbFilterStatus.ItemIndex), - edFilterSummary.Text, - seOptionNewMangaTime.Value, - rbAll.Checked, cbOnlyNew.Checked) then - begin - uncheckGenres.Free; - checkGenres.Free; - Exit; - end; - l := TStringList.Create; - for i := 0 to cbSelectManga.Items.Count - 1 do - l.Add(cbSelectManga.Items[i]); - dataProcess.Free; - dataProcess := TDataProcess.Create; - dataProcess.LoadFromAllFiles(l); - dataProcess.isFilterAllSites := True; - l.Free; - end; + if pnGenres.ControlCount > 0 then + for i := 0 to pnGenres.ControlCount - 1 do + if pnGenres.Controls[i] is TCheckBox then begin + if TCheckBox(pnGenres.Controls[i]).State = cbChecked then + checkGenres.Add(TCheckBox(pnGenres.Controls[i]).Caption) + else + if TCheckBox(pnGenres.Controls[i]).State = cbUnchecked then + uncheckGenres.Add(TCheckBox(pnGenres.Controls[i]).Caption); + end; - if dataProcess.Filter(checkGenres, uncheckGenres, - edFilterTitle.Text, edFilterAuthors.Text, - edFilterArtists.Text, IntToStr(cbFilterStatus.ItemIndex), + if dataProcess.CanFilter( + checkGenres, + uncheckGenres, + edFilterTitle.Text, + edFilterAuthors.Text, + edFilterArtists.Text, + IntToStr(cbFilterStatus.ItemIndex), edFilterSummary.Text, - seOptionNewMangaTime.Value, - rbAll.Checked, cbOnlyNew.Checked, cbUseRegExpr.Checked) then + OptionNewMangaTime, + rbAll.Checked, + cbOnlyNew.Checked) then begin - lbMode.Caption := Format(RS_ModeFiltered, [dataProcess.filterPos.Count]); - vtMangaList.OnInitNode := @vtMangaListInitNode; + dataProcess.FilterAllSites := cbSearchFromAllSites.Checked; + if cbSearchFromAllSites.Checked then + dataProcess.SitesList.Assign(cbSelectManga.Items); + + edMangaListSearch.Tag := -1; + edMangaListSearch.Clear; vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; + + dataProcess.Filter( + checkGenres, + uncheckGenres, + edFilterTitle.Text, + edFilterAuthors.Text, + edFilterArtists.Text, + IntToStr(cbFilterStatus.ItemIndex), + edFilterSummary.Text, + OptionNewMangaTime, + rbAll.Checked, + cbOnlyNew.Checked, + cbUseRegExpr.Checked); end; except on E: Exception do @@ -2183,6 +2862,12 @@ procedure TMainForm.btFilterClick(Sender: TObject); uncheckGenres.Free; checkGenres.Free; Screen.Cursor := crDefault; + + vtMangaList.RootNodeCount := dataProcess.RecordCount; + if dataProcess.Filtered then + lbMode.Caption := Format(RS_ModeFiltered, [vtMangaList.RootNodeCount]) + else + lbMode.Caption := Format(RS_ModeAll, [vtMangaList.RootNodeCount]) end; procedure TMainForm.btFilterResetClick(Sender: TObject); @@ -2203,22 +2888,21 @@ procedure TMainForm.btFilterResetClick(Sender: TObject); procedure TMainForm.miMangaListAddToFavoritesClick(Sender: TObject); var - i: Cardinal; xNode: PVirtualNode; + data: PMangaInfoData; begin - if vtMangaList.SelectedCount = 0 then - Exit; - xNode := vtMangaList.GetFirstSelected; - for i := 0 to vtMangaList.SelectedCount - 1 do - begin - if vtMangaList.Selected[xNode] then + if vtMangaList.SelectedCount = 0 then Exit; + SilentThreadManager.BeginAdd; + try + xNode := vtMangaList.GetFirstSelected; + while Assigned(xNode) do begin - SilentThreadManager.Add(MD_AddToFavorites, - GetMangaSiteName(DataProcess.site.Items[DataProcess.GetPos(xNode^.Index)]), - DataProcess.Param[DataProcess.GetPos(xNode^.Index), DATA_PARAM_NAME], - DataProcess.Param[DataProcess.GetPos(xNode^.Index), DATA_PARAM_LINK]); + data := vtMangaList.GetNodeData(xNode); + SilentThreadManager.Add(MD_AddToFavorites, data^.website, data^.title, data^.link); + xNode := vtMangaList.GetNextSelected(xNode); end; - xNode := vtMangaList.GetNextSelected(xNode); + finally + SilentThreadManager.EndAdd; end; end; @@ -2226,50 +2910,26 @@ procedure TMainForm.miMangaListAddToFavoritesClick(Sender: TObject); procedure TMainForm.miFavoritesDeleteClick(Sender: TObject); var - i: Cardinal; xNode: PVirtualNode; - delList: array of Cardinal; begin - if (cbOptionShowDeleteTaskDialog.Checked) and (vtFavorites.SelectedCount > 0) then - if MessageDlg('', RS_DlgRemoveFavorite, - mtConfirmation, [mbYes, mbNo], 0) = mrNo then - Exit; - if FavoriteManager.isRunning then - begin + if vtFavorites.SelectedCount = 0 then Exit; + if FavoriteManager.isRunning then begin MessageDlg('', RS_DlgFavoritesCheckIsRunning, - mtInformation, [mbYes, mbNo], 0); + mtInformation, [mbOK], 0); Exit; end; - if vtFavorites.SelectedCount = 1 then - begin - if not Assigned(vtFavorites.FocusedNode) then + if cbOptionShowDeleteTaskDialog.Checked then + if MessageDlg('', RS_DlgRemoveFavorite, mtConfirmation, [mbYes, mbNo], 0) = mrNo then Exit; - FavoriteManager.Remove(vtFavorites.FocusedNode^.Index); - end - else - begin - xNode := vtFavorites.GetFirst; - SetLength(delList, 0); - i := 0; - while i < FavoriteManager.Count do - begin - if vtFavorites.Selected[xNode] then - begin - SetLength(delList, Length(delList) + 1); - delList[Length(delList) - 1] := i; - end; - Inc(i); - xNode := vtFavorites.GetNext(xNode); - end; - - if Length(delList) > 0 then - for i := Length(delList) - 1 downto 0 do - FavoriteManager.Remove(delList[i], False); - FavoriteManager.Backup; + xNode := vtFavorites.GetLast(); + while Assigned(xNode) do begin + if vtFavorites.Selected[xNode] then + FavoriteManager.Remove(xNode^.Index, False); + xNode := vtFavorites.GetPreviousSelected(xNode); end; + FavoriteManager.Backup; UpdateVtFavorites; - SetLength(delList, 0); end; procedure TMainForm.miFavoritesChangeCurrentChapterClick(Sender: TObject); @@ -2285,19 +2945,21 @@ procedure TMainForm.miFavoritesChangeCurrentChapterClick(Sender: TObject); end; if not Assigned(vtFavorites.FocusedNode) then Exit; - s := FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.currentChapter; + s := FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.currentChapter; repeat if InputQuery('', RS_DlgTypeInNewChapter, s) then until TryStrToInt(s, i); - if s <> FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.currentChapter then + if s <> FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.currentChapter then begin - FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.currentChapter := s; + FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.currentChapter := s; UpdateVtFavorites; FavoriteManager.Backup; end; end; procedure TMainForm.miFavoritesChangeSaveToClick(Sender: TObject); +var + s: String; begin if FavoriteManager.isRunning then begin @@ -2307,11 +2969,18 @@ procedure TMainForm.miFavoritesChangeSaveToClick(Sender: TObject); end; if not Assigned(vtFavorites.FocusedNode) then Exit; - if InputQuery('', RS_DlgTypeInNewSavePath, - FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo) then + s := ''; + with TSelectDirectoryForm.Create(Self) do try + dePath.Directory := FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.SaveTo; + if ShowModal = mrOK then + s := dePath.Directory; + finally + Free; + end; + + if s <> '' then begin - FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo := - CorrectFilePath(FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo); + FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.SaveTo := s; UpdateVtFavorites; FavoriteManager.Backup; end; @@ -2324,7 +2993,7 @@ procedure TMainForm.miChapterListCheckSelectedClick(Sender: TObject); i: Cardinal; xNode: PVirtualNode; begin - if clbChapterList.RootNodeCount > 0 then + if clbChapterList.SelectedCount > 0 then begin xNode := clbChapterList.GetFirstSelected; for i := 0 to clbChapterList.SelectedCount - 1 do @@ -2392,27 +3061,31 @@ procedure TMainForm.miChapterListUncheckAllClick(Sender: TObject); // ----- vtDownload popup menu ----- procedure TMainForm.mnDownload1ClickClick(Sender: TObject); -var - i: Integer; begin - if not isUpdating then - begin - if (MessageDlg('', RS_DlgUpdaterWantToUpdateDB, mtInformation, [mbYes, mbNo], 0) = - mrYes) then - begin - // if dataProcess.Title.Count > 1 then - //begin - isUpdating := True; - updateList := TUpdateMangaManagerThread.Create; - for i := 0 to cbSelectManga.Items.Count - 1 do - updateList.websites.Add(cbSelectManga.Items[i]); - updateList.isDownloadFromServer := True; - updateList.Start; - //end; - end; - end + if DBUpdaterThread <> nil then + DBUpdaterThread.Add(cbSelectManga.Items) else - MessageDlg('', RS_DlgFavoritesCheckIsRunning, mtInformation, [mbYes], 0); + if MessageDlg('', RS_DlgUpdaterWantToUpdateDB, mtInformation, [mbYes, mbNo], 0) = mrYes then + begin + DBUpdaterThread := TDBUpdaterThread.Create; + DBUpdaterThread.Items.AddStrings(cbSelectManga.Items); + DBUpdaterThread.Start; + end; +end; + +procedure TMainForm.mnFilterGenreAllCheckClick(Sender: TObject); +begin + FilterGenreChangeAllState(cbChecked); +end; + +procedure TMainForm.mnFilterGenreAllIndeterminateClick(Sender: TObject); +begin + FilterGenreChangeAllState(cbGrayed); +end; + +procedure TMainForm.mnFilterGenreAllUncheckClick(Sender: TObject); +begin + FilterGenreChangeAllState(cbUnchecked); end; procedure TMainForm.mnUpdate1ClickClick(Sender: TObject); @@ -2428,10 +3101,9 @@ procedure TMainForm.mnUpdate1ClickClick(Sender: TObject); {$ENDIF} begin isUpdating := True; - updateList := TUpdateMangaManagerThread.Create; + updateList := TUpdateListManagerThread.Create; for i := 0 to cbSelectManga.Items.Count - 1 do updateList.websites.Add(cbSelectManga.Items[i]); - updateList.isDownloadFromServer := False; updateList.Start; end; end @@ -2468,10 +3140,7 @@ procedure TMainForm.mnUpdate1ClickClick(Sender: TObject); procedure TMainForm.mnUpdateDownFromServerClick(Sender: TObject); begin - if (not isUpdating) then - RunGetList - else - MessageDlg('', RS_DlgFavoritesCheckIsRunning, mtInformation, [mbYes], 0); + RunGetList; end; procedure TMainForm.mnUpdateListClick(Sender: TObject); @@ -2487,10 +3156,9 @@ procedure TMainForm.mnUpdateListClick(Sender: TObject); {$ENDIF} begin isUpdating := True; - updateList := TUpdateMangaManagerThread.Create; + updateList := TUpdateListManagerThread.Create; updateList.numberOfThreads := 4; updateList.websites.Add(cbSelectManga.Items[cbSelectManga.ItemIndex]); - updateList.isDownloadFromServer := False; updateList.Start; end; end @@ -2523,81 +3191,87 @@ procedure TMainForm.miDownloadDeleteCompletedClick(Sender: TObject); mtConfirmation, [mbYes, mbNo], 0) = mrYes) then Exit; DLManager.RemoveAllFinishedTasks; + if Sender <> nil then UpdateVtDownload; - DLManager.Backup; // the reason we put it in here instead of in DLManager because of the size of // download list will change during this method end; procedure TMainForm.miDownloadResumeClick(Sender: TObject); var - i: Cardinal; xNode: PVirtualNode; begin - if (vtDownload.SelectedCount = 1) and (Assigned(vtDownload.FocusedNode)) then - begin - if DLManager.TaskItem(vtDownload.FocusedNode^.Index).Status in - [STATUS_STOP, STATUS_PROBLEM, STATUS_FAILED] then - begin - DLManager.TaskItem(vtDownload.FocusedNode^.Index).Status := STATUS_WAIT; - DLManager.TaskItem(vtDownload.FocusedNode^.Index).DownloadInfo.Status := - RS_Waiting; - if DLManager.CanActiveTask(vtDownload.FocusedNode^.Index) then - DLManager.ActiveTask(vtDownload.FocusedNode^.Index); - vtDownload.Repaint; - DLManager.Backup; - end; - end - else - if (vtDownload.SelectedCount > 1) then - begin - xNode := vtDownload.GetFirstSelected; - for i := 0 to vtDownload.SelectedCount - 1 do - begin - if vtDownload.Selected[xNode] and - (DLManager.TaskItem(xNode^.Index).Status in - [STATUS_STOP, STATUS_PROBLEM, STATUS_FAILED]) then - begin - DLManager.TaskItem(xNode^.Index).Status := STATUS_WAIT; - DLManager.TaskItem(xNode^.Index).DownloadInfo.Status := RS_Waiting; - if DLManager.CanActiveTask(xNode^.Index) then - DLManager.ActiveTask(xNode^.Index); - end; + if vtDownload.SelectedCount > 0 then begin + xNode := vtDownload.GetFirstSelected(); + while Assigned(xNode) do begin + DLManager.SetTaskActive(xNode^.Index); xNode := vtDownload.GetNextSelected(xNode); end; - vtDownload.Repaint; - DLManager.Backup; + DLManager.CheckAndActiveTask(); + UpdateVtDownload; end; end; procedure TMainForm.miDownloadStopClick(Sender: TObject); var - i: Cardinal; xNode: PVirtualNode; begin - if not Assigned(vtDownload.FocusedNode) then exit; - xNode := vtDownload.GetFirstSelected; - for i := 0 to vtDownload.SelectedCount - 1 do - begin - if vtDownload.Selected[xNode] then + if vtDownload.SelectedCount > 0 then begin + xNode := vtDownload.GetFirstSelected(); + while Assigned(xNode) do begin DLManager.StopTask(xNode^.Index, False); - xNode := vtDownload.GetNextSelected(xNode); + xNode := vtDownload.GetNextSelected(xNode); + end; + DLManager.CheckAndActiveTask(); + UpdateVtDownload; + end; +end; + +procedure TMainForm.miMangaListDeleteClick(Sender: TObject); +var + Node: PVirtualNode; + DeleteCount: Integer; +begin + if vtMangaList.SelectedCount = 0 then Exit; + if dataProcess.Table.Active = False then Exit; + if MessageDlg('', RS_DlgRemoveItem, mtConfirmation, [mbYes, mbNo], 0) = mrNo then Exit; + try + vtMangaList.BeginUpdate; + DeleteCount := 0; + Node := vtMangaList.GetPreviousSelected(nil); + while Assigned(Node) do + begin + if dataProcess.DeleteData(Node^.Index) then + begin + Inc(DeleteCount); + vtMangaList.DeleteNode(Node); + end; + Node := vtMangaList.GetPreviousSelected(nil); + end; + dataProcess.Table.ApplyUpdates; + dataProcess.Table.SQLTransaction.CommitRetaining; + if DeleteCount <> 0 then + begin + vtMangaList.ClearSelection; + UpdateVtMangaListFilterStatus; + end; + finally + vtMangaList.EndUpdate; end; - DLManager.Backup; - DLManager.CheckAndActiveTask; - vtDownload.Repaint; end; procedure TMainForm.miMangaListDownloadAllClick(Sender: TObject); var xNode: PVirtualNode; AllowedToCreate, YesAll, NoAll : Boolean; - i, j: Integer; + i: Integer; mResult: TModalResult; mBtns: TMsgDlgButtons; + data: PMangaInfoData; begin - if vtMangaList.SelectedCount = 0 then - Exit; + if vtMangaList.SelectedCount = 0 then Exit; + + SilentThreadManager.BeginAdd; try YesAll := False; NoAll := False; @@ -2607,426 +3281,190 @@ procedure TMainForm.miMangaListDownloadAllClick(Sender: TObject); mBtns := [mbYes, mbNo, mbYesToAll, mbNoToAll]; xNode := vtMangaList.GetFirstSelected; - for i := 0 to vtMangaList.SelectedCount - 1 do + while Assigned(xNode) do begin - if vtMangaList.Selected[xNode] then - begin - AllowedToCreate := True; - if DLManager.Count > 0 then - for j := 0 to DLManager.Count - 1 do - if dataProcess.Param[dataProcess.GetPos(xNode^.Index), DATA_PARAM_NAME] = - DLManager.TaskItem(j).DownloadInfo.title then + data := vtMangaList.GetNodeData(xNode); + AllowedToCreate := True; + if DLManager.Count > 0 then + for i := 0 to DLManager.Count - 1 do + if data^.title = DLManager.Items[i].DownloadInfo.title then + begin + if YesAll then + AllowedToCreate := True + else if NoAll then + AllowedToCreate := False + else begin - if YesAll then - AllowedToCreate := True - else if NoAll then - AllowedToCreate := False - else - begin - pcMain.ActivePage := tsDownload; - mResult := MessageDlg('', DLManager.TaskItem(j).DownloadInfo.title + - LineEnding + LineEnding + RS_DlgTitleExistInDLlist, mtConfirmation, - mBtns, 0); - case mResult of - mrYes : AllowedToCreate := True; - mrNo : AllowedToCreate := False; - mrYesToAll : - begin - YesAll := True; - NoAll := False; - AllowedToCreate := True; - end; - mrNoToAll : - begin - YesAll := False; - NoAll := True; - AllowedToCreate := False; - end; - end; + pcMain.ActivePage := tsDownload; + mResult := MessageDlg('', DLManager.Items[i].DownloadInfo.title + + LineEnding + LineEnding + RS_DlgTitleExistInDLlist, mtConfirmation, + mBtns, 0); + case mResult of + mrYes : AllowedToCreate := True; + mrNo : AllowedToCreate := False; + mrYesToAll : + begin + YesAll := True; + NoAll := False; + AllowedToCreate := True; + end; + mrNoToAll : + begin + YesAll := False; + NoAll := True; + AllowedToCreate := False; + end; end; - Break; end; + Break; + end; - if AllowedToCreate then - SilentThreadManager.Add(MD_DownloadAll, - GetMangaSiteName(DataProcess.site.Items[DataProcess.GetPos(xNode^.Index)]), - dataProcess.Param[DataProcess.GetPos(xNode^.Index), DATA_PARAM_NAME], - dataProcess.Param[DataProcess.GetPos(xNode^.Index), DATA_PARAM_LINK]); - end; + if AllowedToCreate then + SilentThreadManager.Add(MD_DownloadAll, data^.website, data^.title, data^.link); xNode := vtMangaList.GetNextSelected(xNode); end; except on E: Exception do ExceptionHandler(Self, E); end; + SilentThreadManager.EndAdd; end; procedure TMainForm.miMangaListViewInfosClick(Sender: TObject); -var - title, website, link: String; - i: Integer; begin - if (not vtMangaList.Focused) or (vtMangaList.SelectedCount = 0) then - Exit; - btDownload.Enabled := False; - btAddToFavorites.Enabled := False; - pcMain.ActivePage := tsInformation; - imCover.Picture.Assign(nil); - rmInformation.Clear; - rmInformation.Lines.Add(RS_Loading); - clbChapterList.Clear; - - if isGetMangaInfos then - begin - GetInfosThread.IsFlushed := True; - GetInfosThread.Terminate; - //GetInfosThread.WaitFor; - end; - GetInfosThread := TGetMangaInfosThread.Create; - GetInfosThread.MangaListPos := vtMangaList.FocusedNode^.Index; - if DataProcess.searchPos.Count = 0 then - begin - website := GetMangaSiteName( - DataProcess.site.Items[DataProcess.GetPos(GetInfosThread.mangaListPos)]); - //cbSelectManga.Items[cbSelectManga.ItemIndex]; - title := DataProcess.Param[DataProcess.GetPos(GetInfosThread.mangaListPos), - DATA_PARAM_NAME]; - link := DataProcess.Param[DataProcess.GetPos(GetInfosThread.mangaListPos), - DATA_PARAM_LINK]; - end - else - begin - website := GetMangaSiteName( - DataProcess.site.Items[DataProcess.searchPos.Items[GetInfosThread.mangaListPos]]); - //cbSelectManga.Items[cbSelectManga.ItemIndex]; - title := DataProcess.Param[DataProcess.searchPos.Items[GetInfosThread.mangaListPos], - DATA_PARAM_NAME]; - link := DataProcess.Param[DataProcess.searchPos.Items[GetInfosThread.mangaListPos], - DATA_PARAM_LINK]; - end; - GetInfosThread.Title := title; - GetInfosThread.Website := website; - GetInfosThread.Link := link; - GetInfosThread.Start; - - //ShowInformation; - for i := 0 to High(WebsiteRoots) do - if Pos(website, WebsiteRoots[i, 0]) > 0 then - begin - link := StringReplace(link, WebsiteRoots[i, 1], '', []); - edURL.Text := FixURL(FillMangaSiteHost(i, link)); - Break; - end; - - if Assigned(gifWaiting) then - begin - itAnimate.Enabled := True; - pbWait.Visible := True; + if Assigned(vtMangaList.FocusedNode) then begin + with PMangaInfoData(vtMangaList.GetNodeData(vtMangaList.FocusedNode))^ do + ViewMangaInfo(link, website, title, '', miMangaListViewInfos, vtMangaList.FocusedNode); + if pcInfo.ActivePage <> tsInfoManga then + pcInfo.ActivePage := tsInfoManga; end; - - btReadOnline.Enabled := (link <> ''); end; procedure TMainForm.miFavoritesOpenFolderClick(Sender: TObject); begin - if not Assigned(vtFavorites.FocusedNode) then - Exit; - OpenDocument(TrimRightChar( - FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo, - [PathDelim])); + if Assigned(vtFavorites.FocusedNode) then + OpenDocument(CorrectPathSys( + FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.SaveTo)); end; procedure TMainForm.miDownloadOpenFolderClick(Sender: TObject); begin - if (vtDownload.SelectedCount = 0) or (Assigned(vtDownload.FocusedNode) = False) then - Exit; - OpenDocument(TrimRightChar( - DLManager.TaskItem(vtDownload.FocusedNode^.Index).DownloadInfo.SaveTo, - [PathDelim])); + if Assigned(vtDownload.FocusedNode) then + OpenDocument(CorrectPathSys( + DLManager.Items[vtDownload.FocusedNode^.Index].DownloadInfo.SaveTo)); end; procedure TMainForm.miFavoritesOpenWithClick(Sender: TObject); -var - f, fd: String; - Info: TSearchRec; - l: TStringList; begin - if (not Assigned(vtFavorites.FocusedNode)) then - Exit; - l := TStringList.Create; - try - fd := StringReplace(FavoriteManager.FavoriteItem( - vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo, '/', '\', [rfReplaceAll]); - if fd[Length(fd)] <> PathDelim then - fd := fd + PathDelim; - - if FindFirstUTF8(fd + '*', faAnyFile and faDirectory, Info) = 0 then - repeat - l.Add(Info.Name); - until FindNextUTF8(Info) <> 0; - if l.Count >= 3 then - f := l.Strings[2] - else - f := ''; - FindCloseUTF8(Info); - - OpenWithExternalProgram(fd, f); - except - end; - l.Free; + if Assigned(vtFavorites.FocusedNode) then + OpenWithExternalProgramChapters( + FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.SaveTo); end; procedure TMainForm.miDownloadOpenWithClick(Sender: TObject); -var - f, fd, ff: String; - Info: TSearchRec; - l: TStringList; begin - if (not Assigned(vtDownload.FocusedNode)) then - Exit; - l := TStringList.Create; - try - fd := StringReplace(DLManager.TaskItem( - vtDownload.FocusedNode^.Index).DownloadInfo.SaveTo, '/', '\', [rfReplaceAll]); - if fd[Length(fd)] <> PathDelim then - fd := fd + PathDelim; - - if DLManager.TaskItem(vtDownload.FocusedNode^.Index).ChapterName.Count > 0 then - begin - ff := DLManager.TaskItem(vtDownload.FocusedNode^.Index). - ChapterName[0]; - if FileExistsUTF8(fd + ff + '.zip') then - f := ff + '.zip' - else if FileExistsUTF8(fd + ff + '.cbz') then - f := ff + '.cbz' - else if FileExistsUTF8(fd + ff + '.pdf') then - f := ff + '.pdf' - else if DirectoryExistsUTF8(fd + ff) then - f := ff - else - f := ''; - end; - - if f = '' then - begin - if FindFirstUTF8(fd + '*', faAnyFile and faDirectory, Info) = 0 then - repeat - l.Add(Info.Name); - until FindNextUTF8(Info) <> 0; - if l.Count >= 3 then - f := l.Strings[2] - else - f := ''; - FindCloseUTF8(Info); - end; - - OpenWithExternalProgram(fd, f); - except - end; - l.Free; + if Assigned(vtDownload.FocusedNode) then + with DLManager.Items[vtDownload.FocusedNode^.Index] do + OpenWithExternalProgramChapters(DownloadInfo.SaveTo, ChapterName); end; -procedure TMainForm.pcMainChange(Sender: TObject); +procedure TMainForm.miTrayExitClick(Sender: TObject); +begin + Self.Close; +end; - procedure UpdateOptions; - var - l: TStringList; - s: String; - i, j: Cardinal; - Data: PMangaListItem; +procedure TMainForm.miTrayFinishNothingClick(Sender: TObject); +begin + if Sender is TMenuItem then begin - l := TStringList.Create; - - cbOptionMinimizeToTray.Checked := - options.ReadBool('general', 'MinimizeToTray', False); - seOptionNewMangaTime.Value := options.ReadInteger('general', 'NewMangaTime', 3); - cbOptionLetFMDDo.ItemIndex := options.ReadInteger('general', 'LetFMDDo', 0); - cbOptionEnableLoadCover.Checked := - options.ReadBool('general', 'LoadMangaCover', True); - OptionLetFMDDo := TFMDDo(cbOptionLetFMDDo.ItemIndex); - edOptionExternalPath.FileName := options.ReadString('general', 'ExternalProgramPath', ''); - edOptionExternalParams.Text := options.ReadString('general', 'ExternalProgramParams', DEFAULT_EXPARAM); - - cbOptionShowDownloadToolbar.Checked := options.ReadBool('view', 'ShowDownloadsToolbar', True); - - seOptionMaxParallel.Value := options.ReadInteger('connections', 'NumberOfTasks', 1); - seOptionMaxThread.Value := - options.ReadInteger('connections', 'NumberOfThreadsPerTask', 1); - seOptionMaxRetry.Value := options.ReadInteger('connections', 'Retry', 3); - seOptionConnectionTimeout.Value := options.ReadInteger('connections', 'ConnectionTimeout', 15); - cbOptionUseProxy.Checked := options.ReadBool('connections', 'UseProxy', False); - cbOptionProxyType.Text := options.ReadString('connections', 'ProxyType', 'HTTP'); - edOptionHost.Text := options.ReadString('connections', 'Host', ''); - edOptionPass.Text := options.ReadString('connections', 'Pass', ''); - edOptionPort.Text := options.ReadString('connections', 'Port', ''); - edOptionUser.Text := options.ReadString('connections', 'User', ''); - edOptionDefaultPath.Text := options.ReadString('saveto', 'SaveTo', DEFAULT_PATH); - if Trim(edOptionDefaultPath.Text) = '' then - edOptionDefaultPath.Text := DEFAULT_PATH; - edOptionDefaultPath.Text := CorrectPathSys(edOptionDefaultPath.Text); - rgOptionCompress.ItemIndex := options.ReadInteger('saveto', 'Compress', 0); - - edOptionCustomRename.Text := - options.ReadString('saveto', 'CustomRename', DEFAULT_CUSTOM_RENAME); - if Trim(edOptionCustomRename.Text) = '' then - edOptionCustomRename.Text := DEFAULT_CUSTOM_RENAME; - - cbOptionShowQuitDialog.Checked := - options.ReadBool('dialogs', 'ShowQuitDialog', True); - cbOptionShowDeleteTaskDialog.Checked := - options.ReadBool('dialogs', 'ShowDeleteDldTaskDialog', True); - - cbOptionPathConvert.Checked := options.ReadBool('saveto', 'PathConv', False); - cbOptionGenerateChapterName.Checked := - options.ReadBool('saveto', 'GenChapName', False); - cbOptionGenerateMangaFolderName.Checked := - options.ReadBool('saveto', 'GenMangaName', True); - cbOptionAutoNumberChapter.Checked := - options.ReadBool('saveto', 'AutoNumberChapter', True); - OptionAutoNumberChapterChecked := cbOptionAutoNumberChapter.Checked; - seOptionPDFQuality.Value := options.ReadInteger('saveto', 'PDFQuality', 95); - - cbOptionAutoRemoveCompletedManga.Checked := - options.ReadBool('update', 'AutoRemoveCompletedManga', True); - cbOptionAutoCheckFavStartup.Checked := - options.ReadBool('update', 'AutoCheckFavStartup', False); - seOptionCheckMinutes.Value := options.ReadInteger('update', 'AutoCheckMinutes', 0); - lbOptionAutoCheckMinutes.Caption := Format(RS_LblAutoCheckNewChapterMinute, - [seOptionCheckMinutes.Value]); - - cbOptionShowBatotoSG.Checked := OptionShowBatotoSG; - cbOptionShowAllLang.Checked := OptionShowAllLang; - cbOptionAutoDlFav.Checked := OptionAutoDlFav; - - if Length(optionMangaSiteSelectionNodes) > 0 then - for i := 0 to Length(optionMangaSiteSelectionNodes) - 1 do - optionMangaSiteSelectionNodes[i]^.CheckState := csUncheckedNormal; - - s := options.ReadString('general', 'MangaListSelect', - mangalistIni.ReadString('general', 'DefaultSelect', DEFAULT_LIST)); - if Pos(SEPERATOR, S) > 0 then - GetParams(l, s) //for old config - else - ExtractStrings([','], [], PChar(s), l); - - if l.Count > 0 then - for i := 0 to l.Count - 1 do - begin - if Length(optionMangaSiteSelectionNodes) > 0 then - for j := 0 to Length(optionMangaSiteSelectionNodes) - 1 do - begin - Data := vtOptionMangaSiteSelection.GetNodeData( - optionMangaSiteSelectionNodes[j]); - if Data^.Text = l.Strings[i] then - begin - optionMangaSiteSelectionNodes[j]^.CheckState := csCheckedNormal; - Break; - end; - end; - end; - - l.Free; + OptionLetFMDDo := TFMDDo(TMenuItem(Sender).Tag); + configfile.WriteInteger('general', 'LetFMDDo', Integer(OptionLetFMDDo)); end; +end; +procedure TMainForm.miTrayShowDropBoxClick(Sender: TObject); +begin + ShowDropTarget(TMenuItem(Sender).Checked); +end; + +procedure TMainForm.pcMainChange(Sender: TObject); begin - if pcMain.ActivePage = tsAbout then - LoadAbout - else if pcMain.ActivePage = tsFavorites then - vtFavorites.Repaint; - UpdateOptions; + vtFavorites.Repaint + else if pcMain.ActivePage = tsOption then + LoadOptions; end; procedure TMainForm.pmDownloadPopup(Sender: TObject); +var + iStop, + iResume, + iEnable, + iDisable: Boolean; - function FinishedTaskPresent: Boolean; - var - i: Integer; - begin - Result := False; - with DLManager do begin - CS_DownloadManager_Task.Acquire; - try - for i := 0 to Count - 1 do - if TaskItem(i).Status = STATUS_FINISH then - begin - Result := True; - Break; - end; - finally - CS_DownloadManager_Task.Release; - end; - end; - end; - - function SelectedTaskStatusPresent(Stats: TDownloadStatusTypes): Boolean; + procedure ScanTasks; var - xNode: PVirtualNode; + Node: PVirtualNode; begin - Result := False; - if vtDownload.SelectedCount > 0 then + iStop := False; + iResume := False; + iEnable := False; + iDisable := False; + Node := vtDownload.GetFirstSelected(); + while Assigned(Node) do begin - with DLManager do + if DLManager[Node^.Index].Enabled then begin - CS_DownloadManager_Task.Acquire; - try - xNode := vtDownload.GetFirstSelected; - repeat - if TaskItem(xNode^.Index).Status in Stats then - begin - Result := True; - Break; - end; - xNode := vtDownload.GetNextSelected(xNode); - until xNode = nil; - finally - CS_DownloadManager_Task.Release; + if not iDisable then + iDisable := True; + case DLManager[Node^.Index].Status of + STATUS_DOWNLOAD, + STATUS_PREPARE, + STATUS_WAIT : if not iStop then iStop := True; + STATUS_STOP, + STATUS_FAILED, + STATUS_PROBLEM : if not iResume then iResume := True; end; - end; + end + else if not iEnable then + iEnable := True; + if iStop and iResume and iStop and iEnable and iDisable then + Break; + Node := vtDownload.GetNextSelected(Node); end; end; begin + miDownloadDeleteCompleted.Enabled := DLManager.Count > 0; + miDownloadMergeCompleted.Enabled := miDownloadDeleteCompleted.Enabled; with DLManager do begin - if vtDownload.SelectedCount = 0 then + if (vtDownload.SelectedCount = 0) or (vtDownload.FocusedNode = nil) then begin miDownloadStop.Enabled := False; miDownloadResume.Enabled := False; miDownloadDelete.Enabled := False; miDownloadDeleteTask.Enabled := False; miDownloadDeleteTaskData.Enabled := False; - miDownloadDeleteCompleted.Enabled := FinishedTaskPresent; - miDownloadMergeCompleted.Enabled := miDownloadDeleteCompleted.Enabled; miDownloadViewMangaInfo.Enabled := False; miDownloadOpenFolder.Enabled := False; miDownloadOpenWith.Enabled := False; + miDownloadEnable.Enabled := False; + miDownloadDisable.Enabled := False; end else - if vtDownload.SelectedCount = 1 then begin - miDownloadStop.Enabled := (TaskItem(vtDownload.FocusedNode^.Index).Status in [STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_WAIT]); - miDownloadResume.Enabled := (TaskItem(vtDownload.FocusedNode^.Index).Status in [STATUS_STOP, STATUS_FAILED, STATUS_PROBLEM]); + ScanTasks; + miDownloadStop.Enabled := iStop; + miDownloadResume.Enabled := iResume; miDownloadDelete.Enabled := True; miDownloadDeleteTask.Enabled := True; miDownloadDeleteTaskData.Enabled := True; - miDownloadDeleteCompleted.Enabled := FinishedTaskPresent; - miDownloadMergeCompleted.Enabled := miDownloadDeleteCompleted.Enabled; - miDownloadViewMangaInfo.Enabled := (TaskItem(vtDownload.FocusedNode^.Index).DownloadInfo.Link <> ''); - miDownloadOpenFolder.Enabled := True; - miDownloadOpenWith.Enabled := True; - end - else - begin - miDownloadStop.Enabled := SelectedTaskStatusPresent([STATUS_DOWNLOAD, STATUS_PREPARE, STATUS_WAIT]); - miDownloadResume.Enabled := SelectedTaskStatusPresent([STATUS_STOP, STATUS_FAILED, STATUS_PROBLEM]); - miDownloadDelete.Enabled := True; - miDownloadDeleteTask.Enabled := True; - miDownloadDeleteTaskData.Enabled := True; - miDownloadDeleteCompleted.Enabled := FinishedTaskPresent; - miDownloadMergeCompleted.Enabled := miDownloadDeleteCompleted.Enabled; - miDownloadViewMangaInfo.Enabled := False; - miDownloadOpenFolder.Enabled := False; - miDownloadOpenWith.Enabled := False; + miDownloadOpenWith.Enabled := vtDownload.SelectedCount = 1; + miDownloadOpenFolder.Enabled := miDownloadOpenWith.Enabled; + miDownloadViewMangaInfo.Enabled := miDownloadOpenFolder.Enabled and + (DLManager[vtDownload.FocusedNode^.Index].DownloadInfo.Link <> ''); + miDownloadEnable.Enabled := iEnable; + miDownloadDisable.Enabled := iDisable; end; end; end; @@ -3044,34 +3482,39 @@ procedure TMainForm.pmEditURLPopup(Sender: TObject); end; procedure TMainForm.pmFavoritesPopup(Sender: TObject); +var + iCheck, + iStop, + iEnable, + iDisable: Boolean; - function SelectedStatusPresent(Stats: TFavoriteStatusTypes): Boolean; + procedure ScanFavs; var - xNode: PVirtualNode; + Node: PVirtualNode; begin - Result := False; - with FavoriteManager do + iCheck := False; + iStop := False; + iEnable := False; + iDisable := False; + Node := vtFavorites.GetFirstSelected(); + while Assigned(Node) do begin - if vtFavorites.SelectedCount > 0 then + if FavoriteManager[Node^.Index].Enabled then begin - Lock; - try - xNode := vtFavorites.GetFirstSelected; - repeat - if Assigned(xNode) then - begin - if FavoriteManager.FavoriteItem(xNode^.Index).Status in Stats then - begin - Result := True; - Break; - end; - xNode := vtFavorites.GetNextSelected(xNode); - end; - until xNode = nil; - finally - LockRelease; + if not iDisable then + iDisable := True; + case FavoriteManager[Node^.Index].Status of + STATUS_IDLE : if not iCheck then iCheck := True; + STATUS_CHECK, + STATUS_CHECKING, + STATUS_CHECKED : if not iStop then iStop := True; end; - end; + end + else if not iEnable then + iEnable := True; + if iEnable and iDisable and iCheck and iStop then + Break; + Node := vtFavorites.GetNextSelected(Node); end; end; @@ -3080,42 +3523,49 @@ procedure TMainForm.pmFavoritesPopup(Sender: TObject); begin miFavoritesViewInfos.Enabled := False; miFavoritesDownloadAll.Enabled := False; + miFavoritesEnable.Enabled := False; + miFavoritesDisable.Enabled := False; miFavoritesDelete.Enabled := False; miFavoritesChangeSaveTo.Enabled := False; miFavoritesOpenFolder.Enabled := False; miFavoritesOpenWith.Enabled := False; - end - else - if vtFavorites.SelectedCount = 1 then - begin - miFavoritesCheckNewChapter.Visible := SelectedStatusPresent([STATUS_IDLE]); - miFavoritesStopCheckNewChapter.Visible := - SelectedStatusPresent([STATUS_CHECK, STATUS_CHECKING]); - miFavoritesViewInfos.Enabled := True; - miFavoritesDownloadAll.Enabled := (Trim(FavoriteManager.FavoriteItem( - vtFavorites.FocusedNode^.Index).FavoriteInfo.Link) <> ''); - miFavoritesDelete.Enabled := True; - miFavoritesChangeSaveTo.Enabled := True; - miFavoritesOpenFolder.Enabled := - DirectoryExistsUTF8(FavoriteManager.FavoriteItem(vtFavorites.FocusedNode^.Index).FavoriteInfo.SaveTo); - miFavoritesOpenWith.Enabled := miFavoritesOpenFolder.Enabled; + miFavoritesTransferWebsite.Enabled := False; + miFavoritesRename.Enabled := False; end else begin - miFavoritesCheckNewChapter.Visible := SelectedStatusPresent([STATUS_IDLE]); - miFavoritesStopCheckNewChapter.Visible := - SelectedStatusPresent([STATUS_CHECK, STATUS_CHECKING]); - miFavoritesViewInfos.Enabled := False; - miFavoritesDownloadAll.Enabled := True; - miFavoritesDelete.Enabled := True; - miFavoritesChangeSaveTo.Enabled := False; - miFavoritesOpenFolder.Enabled := False; - miFavoritesOpenWith.Enabled := False; + ScanFavs; + miFavoritesCheckNewChapter.Enabled := iCheck; + miFavoritesStopCheckNewChapter.Enabled := iStop; + miFavoritesEnable.Enabled := iEnable; + miFavoritesDisable.Enabled := iDisable; + miFavoritesTransferWebsite.Enabled := True; + if (vtFavorites.SelectedCount = 1) and Assigned(vtFavorites.FocusedNode) then + begin + miFavoritesViewInfos.Enabled := True; + miFavoritesDownloadAll.Enabled := (Trim(FavoriteManager[vtFavorites.FocusedNode^.Index].FavoriteInfo.Link) <> ''); + miFavoritesDelete.Enabled := True; + miFavoritesChangeSaveTo.Enabled := True; + miFavoritesOpenFolder.Enabled := DirectoryExistsUTF8(FavoriteManager.Items[vtFavorites.FocusedNode^.Index].FavoriteInfo.SaveTo); + miFavoritesOpenWith.Enabled := miFavoritesOpenFolder.Enabled; + miFavoritesRename.Enabled := True; + end + else + begin + miFavoritesViewInfos.Enabled := False; + miFavoritesDownloadAll.Enabled := True; + miFavoritesDelete.Enabled := True; + miFavoritesChangeSaveTo.Enabled := False; + miFavoritesOpenFolder.Enabled := False; + miFavoritesOpenWith.Enabled := False; + miFavoritesRename.Enabled := False; + end; end; if FavoriteManager.isRunning then begin miFavoritesDelete.Enabled := False; miFavoritesChangeSaveTo.Enabled := False; + miFavoritesTransferWebsite.Enabled := False; end; end; @@ -3137,12 +3587,43 @@ procedure TMainForm.pmMangaListPopup(Sender: TObject); pmMangaList.Items[2].Enabled := not SitesWithoutFavorites(cbSelectManga.Text); end; +procedure TMainForm.pmSbMainPopup(Sender: TObject); +begin + if Assigned(SilentThreadManager) then + begin + if SilentThreadManager.Count = 0 then + Abort; + end + else + Abort; +end; + +procedure TMainForm.pmTrayPopup(Sender: TObject); +var + i: Integer; +begin + with miTrayAfterDownloadFinish do + for i := 0 to Count - 1 do + if Items[i].Tag = Integer(OptionLetFMDDo) then + begin + Items[i].Checked := True; + Break; + end; + miTrayShowDropBox.Checked := Assigned(FormDropTarget); +end; + +procedure TMainForm.rgOptionCompressSelectionChanged(Sender: TObject); +begin + seOptionPDFQuality.Enabled:=rgOptionCompress.ItemIndex=3; + lbOptionPDFQuality.Enabled:=seOptionPDFQuality.Enabled; + lbOptionPDFQualityHint.Enabled:=seOptionPDFQuality.Enabled; +end; + procedure TMainForm.sbUpdateListDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); var ClRect, TxtRect, BarRect, ProgressBarRect: TRect; Percents: double; - tStyle: TTextStyle; begin if Panel.Index = 0 then begin @@ -3157,7 +3638,7 @@ procedure TMainForm.sbUpdateListDrawPanel(StatusBar: TStatusBar; if ulTotalPtr = 0 then ulTotalPtr := 100; if ulWorkPtr > ulTotalPtr then - ulWorkPtr := 0; + ulWorkPtr := ulTotalPtr; Percents := ulWorkPtr / ulTotalPtr; with StatusBar.Canvas do begin @@ -3174,8 +3655,8 @@ procedure TMainForm.sbUpdateListDrawPanel(StatusBar: TStatusBar; Pen.Style := psSolid; Brush.Style := bsSolid; - Pen.Color := RGB(188, 188, 188); - Brush.Color := RGB(230, 230, 230); + Pen.Color:=CL_BarGrayLine; + Brush.Color:=CL_BarGray; Rectangle(BarRect); ProgressBarRect := BarRect; @@ -3184,39 +3665,20 @@ procedure TMainForm.sbUpdateListDrawPanel(StatusBar: TStatusBar; if (ProgressBarRect.Right - ProgressBarRect.Left) > 0 then begin - //green - Pen.Color := RGB(6, 176, 37); - Brush.Color := RGB(50, 217, 66); - //orange - //Pen.Color := RGB(153, 79, 0); - //Brush.Color := RGB(233, 112, 24); + Pen.Color:=CL_BarGreenLine; + Brush.Color:=CL_BarGreen; Rectangle(ProgressBarRect); end; - //TTextStyle get messed up if all record not assigned? - with tStyle do - begin - Alignment := taLeftJustify; - Layout := tlCenter; - SingleLine := True; - Clipping := False; - ExpandTabs := False; - ShowPrefix := False; - Wordbreak := False; - Opaque := True; - SystemFont := False; - RightToLeft := False; - EndEllipsis := True; - end; Brush.Style := bsClear; - TextRect(txtRect, 5, 0, Panel.Text, tStyle); + TextRect(txtRect, 5, 0, Panel.Text, UpdateStatusTextStyle); end; end; end; -procedure TMainForm.seOptionCheckMinutesChange(Sender: TObject); +procedure TMainForm.seOptionAutoCheckFavIntervalMinutesChange(Sender: TObject); begin - lbOptionAutoCheckMinutes.Caption := - Format(RS_LblAutoCheckNewChapterMinute, [seOptionCheckMinutes.Value]); + lbOptionAutoCheckFavIntervalMinutes.Caption := + Format(RS_LblAutoCheckNewChapterMinute, [seOptionAutoCheckFavIntervalMinutes.Value]); end; procedure TMainForm.spMainSplitterMoved(Sender: TObject); @@ -3233,11 +3695,13 @@ procedure TMainForm.tbDownloadDeleteCompletedClick(Sender: TObject); procedure TMainForm.tbDownloadResumeAllClick(Sender: TObject); begin DLManager.StartAllTasks; + UpdateVtDownload; end; procedure TMainForm.tbDownloadStopAllClick(Sender: TObject); begin DLManager.StopAllTasks; + UpdateVtDownload; end; procedure TMainForm.tbDropTargetOpacityChange(Sender: TObject); @@ -3271,9 +3735,9 @@ procedure TMainForm.TrayIconDblClick(Sender: TObject); procedure TMainForm.tvDownloadFilterSelectionChanged(Sender: TObject); begin - vtDownloadFilters; + vtDownloadUpdateFilters(False); pcMain.ActivePage := tsDownload; - options.WriteInteger('general', 'DownloadFilterSelect', + configfile.WriteInteger('general', 'DownloadFilterSelect', tvDownloadFilter.Selected.AbsoluteIndex); end; @@ -3286,117 +3750,13 @@ procedure TMainForm.UniqueInstanceFMDOtherInstance(Sender: TObject; BringToFront; end; -procedure TMainForm.vtDownloadAfterCellPaint(Sender: TBaseVirtualTree; - TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - const CellRect: TRect); -var - Data: PDownloadInfo; - BarRect, ProgressBarRect: TRect; - Percents: double; - ww, hh: Integer; -begin - if Node = nil then Exit; - if Node^.Index >= DLManager.Count then Exit; - if Column = 2 then - begin - Data := vtDownload.GetNodeData(Node); - //if Data^.Status = stFinish then - if DLManager.TaskItem(Node^.Index).Status in - [STATUS_FINISH, STATUS_COMPRESS, STATUS_FAILED] then - Percents := 1 - else - if StrToIntDef(Trim(ExtractWord(2, Data^.Progress, ['/'])), 100) = 0 then - Percents := 0 - else - Percents := StrToIntDef(Trim(ExtractWord(1, Data^.Progress, ['/'])), 0) / - StrToIntDef(Trim(ExtractWord(2, Data^.Progress, ['/'])), 100); - //progress-bar box - BarRect.Left := CellRect.Left + 2; - BarRect.Top := CellRect.Top + 2; - BarRect.Right := CellRect.Right - 2; - BarRect.Bottom := CellRect.Bottom - 2; - TargetCanvas.Pen.Style := psSolid; - TargetCanvas.Brush.Style := bsSolid; - - TargetCanvas.Pen.Color := RGB(188, 188, 188); - TargetCanvas.Brush.Color := RGB(230, 230, 230); - - TargetCanvas.Rectangle(BarRect); - //TargetCanvas.RoundRect(BarRect, 6,6); - - // a progress-bar - ProgressBarRect := BarRect; - //Inc(ProgressBarRect.Left); - //Inc(ProgressBarRect.Top); - //Dec(ProgressBarRect.Right); - //Dec(ProgressBarRect.Bottom); - ProgressBarRect.Right := round((ProgressBarRect.Right - ProgressBarRect.Left) * - Percents) + ProgressBarRect.Left; - if (ProgressBarRect.Right - ProgressBarRect.Left) > 0 then - begin - //TargetCanvas.Pen.Style:= psClear; - - case DLManager.TaskItem(Node^.Index).Status of - //(STATUS_STOP, STATUS_WAIT, STATUS_PREPARE, - //STATUS_DOWNLOAD, STATUS_FINISH, STATUS_COMPRESS, STATUS_PROBLEM, STATUS_FAILED); - STATUS_STOP, STATUS_FAILED: - begin - //Red - TargetCanvas.Pen.Color := RGB(177, 26, 26); - TargetCanvas.Brush.Color := RGB(240, 74, 74); - end; - STATUS_WAIT: - begin - //gray - TargetCanvas.Pen.Color := RGB(188, 188, 188); - TargetCanvas.Brush.Color := RGB(230, 230, 230); - end; - STATUS_DOWNLOAD: - begin - //blue - TargetCanvas.Pen.Color := RGB(29, 107, 179); - TargetCanvas.Brush.Color := RGB(79, 178, 250); - //blue light - //TargetCanvas.Pen.Color:= RGB(124,178,234); - //TargetCanvas.Brush.Color:= RGB(163,210,254); - end; - STATUS_PROBLEM: - begin - //yellow - //TargetCanvas.Pen.Color := RGB(195, 145, 79); - TargetCanvas.Pen.Color := RGB(240, 74, 74); - TargetCanvas.Brush.Color := RGB(254, 235, 128); - end; - STATUS_FINISH: - begin - //green - TargetCanvas.Pen.Color := RGB(6, 176, 37); - TargetCanvas.Brush.Color := RGB(50, 217, 66); - end; - else - begin - //browngold - TargetCanvas.Pen.Color := RGB(200, 162, 94); - TargetCanvas.Brush.Color := RGB(240, 213, 141); - end; - end; - //TargetCanvas.RoundRect(ProgressBarRect, 5, 5); - TargetCanvas.Rectangle(ProgressBarRect); - //TargetCanvas.FillRect(ProgressBarRect); - end; - //text - TargetCanvas.Font.Color := clBlack; - TargetCanvas.Brush.Style := bsClear; - TargetCanvas.GetTextSize(Data^.Progress, ww, hh); - TargetCanvas.TextOut(CellRect.Left + ((CellRect.Right - CellRect.Left - ww) div 2), - CellRect.Top + ((CellRect.Bottom - CellRect.Top - hh) div 2), Data^.Progress); - end; -end; - procedure TMainForm.vtDownloadColumnDblClick(Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState); begin - miDownloadOpenFolderClick(Sender); + if Column = 5 then + miDownloadOpenFolderClick(Sender) + else + miDownloadOpenWithClick(Sender); end; procedure TMainForm.vtDownloadDragAllowed(Sender : TBaseVirtualTree; @@ -3407,73 +3767,62 @@ procedure TMainForm.vtDownloadDragAllowed(Sender : TBaseVirtualTree; procedure TMainForm.vtDownloadMoveItems(NextIndex: Cardinal; Mode: TDropMode); var - i, nIndex: Integer; + i, nIndex: Cardinal; cNode: PVirtualNode; - ConTemp: TFPList; + ConTemp: TTaskContainers; begin + if vtDownload.SelectedCount=0 then Exit; + nIndex:=NextIndex; vtDownload.BeginUpdate; - ConTemp := TFPList.Create; + ConTemp:=TTaskContainers.Create; + EnterCriticalSection(DLManager.CS_Task); try - nIndex := NextIndex; + i:=0; + cNode:=vtDownload.GetFirstSelected(); + while cNode<>nil do + begin + vtDownload.Selected[cNode]:=False; + ConTemp.Add(DLManager.Items[cNode^.Index-i]); + DLManager.Items.Delete(cNode^.Index-i); + if (nIndex>0) and (cNode^.Index 0 then + for i:=0 to ConTemp.Count-1 do begin - cNode := vtDownload.GetFirst; - i := 0; - while i < vtDownload.RootNodeCount do - //DLManager.Count do - begin - if vtDownload.Selected[cNode] then - begin - vtDownload.Selected[cNode] := False; - ConTemp.Add(DLManager.TaskItem(i)); - DLManager.containers.Delete(i); - if (i < nIndex) and (nIndex > 0) then - Dec(nIndex); - end - else - Inc(i); - cNode := vtDownload.GetNext(cNode); - end; - vtDownload.FocusedNode := nil; + if (i=0) and (Mode in [dmBelow,dmNowhere]) then + Inc(nIndex) + else if (i>0) and (nIndexDLManager.Count then + nIndex:=DLManager.Count; + DLManager.Items.Insert(nIndex, ConTemp[i]); + end; - for i := 0 to ConTemp.Count - 1 do - begin - if (i = 0) and (Mode in [dmBelow, dmNowhere]) then - Inc(nIndex) - else - if (i > 0) then - begin - if (nIndex < DLManager.Count) then - Inc(nIndex); - end; - if nIndex > DLManager.Count then - Dec(nIndex); - DLManager.containers.Insert(nIndex, ConTemp[i]); - end; + cNode:=vtDownload.GetFirst; + while cNode^.Index vtDownload) or (Source <> Sender) or - (DLManager.Count < 2) then - Exit; - if Mode = dmNowhere then - vtDownloadMoveItems(vtDownload.GetLast^.Index, Mode) + if (Source=vtDownload) and (vtDownload.RootNodeCount>1) then + begin + if Mode = dmNowhere then + vtDownloadMoveItems(vtDownload.GetLast^.Index, Mode) + else + vtDownloadMoveItems(vtDownload.DropTargetNode^.Index, Mode); + end else - vtDownloadMoveItems(vtDownload.DropTargetNode^.Index, Mode); + AddSilentThread(frmDropTarget.GetDropURLs(DataObject), MD_DownloadAll); end; procedure TMainForm.vtDownloadDragOver(Sender : TBaseVirtualTree; Source : TObject; Shift : TShiftState; State : TDragState; const Pt : TPoint; Mode : TDropMode; var Effect : LongWord; var Accept : Boolean); begin - Accept := (Sender = Source); + Accept:=True; end; -// Download table - -procedure TMainForm.vtDownloadFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +procedure TMainForm.vtDownloadDrawText(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + const CellText: String; const CellRect: TRect; var DefaultDraw: Boolean); var - Data: PDownloadInfo; + BarRect: TRect; + Percents: double; + ww, hh: Integer; +begin + if Column <> 2 then Exit; + DefaultDraw := False; + with DLManager.Items[Node^.Index], TargetCanvas do + begin + if Status in [STATUS_FINISH, STATUS_COMPRESS, STATUS_FAILED] then + Percents := 1 + else + if (DLManager.Items[Node^.Index].DownCounter = 0) or + (DLManager.Items[Node^.Index].PageNumber = 0) then + Percents := 0 + else + Percents := DLManager.Items[Node^.Index].DownCounter / DLManager.Items[Node^.Index].PageNumber; + + // base bar + BarRect.Left := CellRect.Left + 2; + BarRect.Top := CellRect.Top + 2; + BarRect.Right := CellRect.Right - 2; + BarRect.Bottom := CellRect.Bottom - 2; + Pen.Style := psSolid; + Brush.Style := bsSolid; + Pen.Color := CL_BarGrayLine; + Brush.Color := CL_BarGray; + Rectangle(BarRect); + + // progress bar + if Percents > 0 then + begin + BarRect.Right := round((BarRect.Right - BarRect.Left) * Percents) + BarRect.Left; + case DLManager.Items[Node^.Index].Status of + STATUS_STOP, + STATUS_FAILED : begin + Pen.Color := CL_BarRedLine; + Brush.Color := CL_BarRed; + end; + STATUS_WAIT : begin + Pen.Color := CL_BarGrayLine; + Brush.Color := CL_BarGray; + end; + STATUS_DOWNLOAD: begin + Pen.Color := CL_BarBlueLine; + Brush.Color := CL_BarBlue; + end; + STATUS_PROBLEM : begin + Pen.Color := CL_BarYellowLine; + Brush.Color := CL_BarYellow; + end; + STATUS_FINISH : begin + Pen.Color := CL_BarGreenLine; + Brush.Color := CL_BarGreen; + end; + else + begin + Pen.Color := CL_BarBrownGoldLine; + Brush.Color := CL_BarBrownGold; + end; + end; + Rectangle(BarRect); + end; + // text + if DownloadInfo.Progress <> '' then + begin + Font.Color := clBlack; + Brush.Style := bsClear; + GetTextSize(DownloadInfo.Progress, ww, hh); + TextOut(CellRect.Left + ((CellRect.Right - CellRect.Left - ww) div 2), + CellRect.Top + ((CellRect.Bottom - CellRect.Top - hh) div 2), DownloadInfo.Progress); + end; + end; +end; + +procedure TMainForm.vtDownloadFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - Finalize(Data^); + Sender.ScrollIntoView(Node, False, False); end; +// Download table + procedure TMainForm.vtDownloadGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); var l, i: Cardinal; - p: PDownloadInfo; begin - if Node^.Index >= DLManager.Count then Exit; - if Column = 0 then - begin - l := DLManager.TaskItem(Node^.Index).ChapterLinks.Count; - if l > 0 then - begin - HintText := ''; - if l < 5 then - begin - for i := 0 to l - 1 do - if HintText = '' then - HintText := - DLManager.TaskItem(Node^.Index).ChapterName.Strings[i]{ + ' : ' + - DLManager.TaskItem(Node^.Index).ChapterLinks.Strings[i]} - else - HintText := HintText + LineEnding + - DLManager.TaskItem(Node^.Index).ChapterName.Strings[i]{ + ' : ' + - DLManager.TaskItem(Node^.Index).ChapterLinks.Strings[i]}; - end - else - begin - for i := 0 to 1 do - if HintText = '' then - HintText := - DLManager.TaskItem(Node^.Index).ChapterName.Strings[i]{ + ' : ' + - DLManager.TaskItem(Node^.Index).ChapterLinks.Strings[i]} - else - HintText := HintText + LineEnding + - DLManager.TaskItem(Node^.Index).ChapterName.Strings[i]{ + ' : ' + - DLManager.TaskItem(Node^.Index).ChapterLinks.Strings[i]}; - HintText := HintText + LineEnding + '...'; - for i := l - 2 to l - 1 do - HintText := HintText + LineEnding + - DLManager.TaskItem(Node^.Index).ChapterName.Strings[i]{ + ' : ' + - DLManager.TaskItem(Node^.Index).ChapterLinks.Strings[i]}; - end; - end; - end - else - begin - p := Sender.GetNodeData(Node); + with DLManager.Items[Node^.Index],DLManager.Items[Node^.Index].DownloadInfo do case Column of - 1: HintText := p^.Status; - 2: HintText := p^.Progress; - 4: HintText := p^.Website; - 5: HintText := p^.SaveTo; - 6: HintText := DateTimeToStr(p^.dateTime); + 0: begin + l := ChapterLinks.Count; + if l>0 then + begin + HintText:=''; + if l<5 then + for i:=0 to l-1 do begin + if HintText<>'' then HintText+=LineEnding; + HintText+=ChapterName.Strings[i] + end + else + begin + for i:=0 to 1 do begin + if HintText<>'' then HintText+=LineEnding; + HintText+=ChapterName.Strings[i] + end; + HintText+=LineEnding+'...'; + for i:=l-2 to l-1 do begin + if HintText<>'' then HintText+=LineEnding; + HintText+=ChapterName.Strings[i] + end; + end; + end; + end; + 1: HintText:=Status; + 2: HintText:=Progress; + 4: HintText:=Website; + 5: HintText:=SaveTo; + 6: HintText:=DateTimeToStr(DateTime); end; - end; end; procedure TMainForm.vtDownloadGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); begin - if (Node^.Index < DLManager.Count) and - (vtDownload.Header.Columns[Column].Position = 0) then - ImageIndex := integer(DLManager.TaskItem(Node^.Index).Status); + if vtDownload.Header.Columns[Column].Position = 0 then + if not DLManager[Node^.Index].Enabled then + ImageIndex := 8 + else + ImageIndex := Integer(DLManager[Node^.Index].Status); end; procedure TMainForm.vtDownloadGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); -var - Data: PDownloadInfo; - pos: Cardinal; begin - if Node^.Index >= DLManager.Count then Exit; - with Sender do - begin - pos := Node^.Index; - Data := Sender.GetNodeData(Node); - if (DLManager.Count > 0) then - if Assigned(Data) and (DLManager.TaskItem(pos) <> nil) then - begin - Data^.Title := DLManager.TaskItem(pos).DownloadInfo.Title; - Data^.Status := DLManager.TaskItem(pos).DownloadInfo.Status; - Data^.Progress := DLManager.TaskItem(pos).DownloadInfo.Progress; - Data^.TransferRate := DLManager.TaskItem(pos).DownloadInfo.TransferRate; - Data^.Website := DLManager.TaskItem(pos).DownloadInfo.Website; - Data^.SaveTo := DLManager.TaskItem(pos).DownloadInfo.SaveTo; - Data^.DateTime := DLManager.TaskItem(pos).DownloadInfo.DateTime; - case Column of - 0: CellText := Data^.title; - 1: CellText := Data^.status; - 2: CellText := ''; - 3: CellText := Data^.TransferRate; - 4: CellText := Data^.website; - 5: CellText := Data^.saveTo; - 6: CellText := DateTimeToStr(Data^.dateTime); - end; - end; - end; + with DLManager[Node^.Index].DownloadInfo do + case Column of + 0: CellText:=Title; + 1: CellText:=Status; + 2: begin + if Progress='' then CellText:='Empty' + else CellText:=Progress; + end; + 3: CellText:=TransferRate; + 4: CellText:=Website; + 5: CellText:=SaveTo; + 6: CellText:=DateTimeToStr(DateTime); + end; end; +{$if VTMajorVersion < 5} procedure TMainForm.vtDownloadHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); +{$else} +procedure TMainForm.vtDownloadHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + Column: TColumnIndex; + Button: TMouseButton; +{$endif} begin - if DLManager.Count < 2 then Exit; + {$if VTMajorVersion >= 5} + Column := HitInfo.Column; + Button := HitInfo.Button; + {$endif} + if Button <> mbLeft then Exit; if (Column = 2) or (Column = 3) then Exit; if DLManager.SortColumn = Column then DLManager.SortDirection := not DLManager.SortDirection; DLManager.SortColumn := Column; vtDownload.Header.SortDirection := TSortDirection(DLManager.SortDirection); vtDownload.Header.SortColumn := Column; - DLManager.Sort(Column); - options.WriteInteger('misc', 'SortDownloadColumn', vtDownload.Header.SortColumn); - options.WriteBool('misc', 'SortDownloadDirection', DLManager.SortDirection); - vtDownload.Repaint; + if DLManager.Count > 1 then + DLManager.Sort(Column); + UpdateVtDownload; end; -procedure TMainForm.vtDownloadInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); -var - Data: PDownloadInfo; - pos: Cardinal; +procedure TMainForm.vtDownloadKeyAction(Sender: TBaseVirtualTree; + var CharCode: Word; var Shift: TShiftState; var DoDefault: Boolean); begin - with Sender do - begin - pos := Node^.Index; - Data := GetNodeData(Node); - if (DLManager.Count <> 0) then - if (DLManager.TaskItem(pos) <> nil) or - (not DLManager.TaskItem(pos).Thread.isTerminated) then - begin - Data^.title := DLManager.TaskItem(pos).DownloadInfo.title; - Data^.status := DLManager.TaskItem(pos).DownloadInfo.Status; - Data^.progress := DLManager.TaskItem(pos).DownloadInfo.Progress; - Data^.TransferRate := DLManager.TaskItem(pos).DownloadInfo.TransferRate; - Data^.website := DLManager.TaskItem(pos).DownloadInfo.Website; - Data^.saveTo := DLManager.TaskItem(pos).DownloadInfo.SaveTo; - Data^.dateTime := DLManager.TaskItem(pos).DownloadInfo.dateTime; - end; + if (ssCtrl in Shift) then begin + if (Sender.SelectedCount>0) and + (CharCode in [VK_UP,VK_DOWN,VK_HOME,VK_END]) then + DoDefault:=False; end; - vtDownload.ValidateNode(Node, False); end; procedure TMainForm.vtDownloadKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState); -begin - if (Key in [VK_UP, VK_DOWN]) and (ssCtrl in Shift) then - begin - if Key = VK_DOWN then - vtDownloadMoveItems(vtDownload.GetFirstSelected^.Index, dmBelow) - else - if vtDownload.GetFirstSelected^.Index > 0 then - vtDownloadMoveItems(vtDownload.GetFirstSelected^.Index - 1, dmAbove); +var + p: Cardinal; +begin + if not (ssCtrl in Shift) then Exit; + if vtDownload.SelectedCount=0 then Exit; + p:=vtDownload.GetFirstSelected()^.Index; + case Key of + VK_UP : if p>0 then vtDownloadMoveItems(p-1,dmAbove); + VK_DOWN : vtDownloadMoveItems(p,dmBelow); + VK_HOME : vtDownloadMoveItems(0,dmAbove); + VK_END : vtDownloadMoveItems(vtDownload.RootNodeCount-1,dmBelow); end; end; @@ -3672,89 +4063,119 @@ procedure TMainForm.vtDownloadKeyUp(Sender: TObject; var Key: Word; Shift: TShif miDownloadDeleteTaskClick(miDownloadDeleteTask); end; +procedure TMainForm.vtDownloadPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +begin + if not DLManager[Node^.Index].Enabled then + TargetCanvas.Font.Color := TVirtualStringTree(Sender).Colors.DisabledColor; +end; + procedure TMainForm.vtFavoritesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + var - Data: PFavoriteInfo; + C: TColor; begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then + if CellPaintMode <> cpmPaint then Exit; + with TargetCanvas, FavoriteManager.Items[Node^.Index] do begin - with FavoriteManager.FavoriteItem(Node^.Index) do + if not Enabled then Exit; + C := Brush.Color; + Brush.Color := clNone; + if Trim(FavoriteInfo.Link) = '' then + Brush.Color := CL_FVBrokenFavorite + else begin - if Trim(FavoriteInfo.Link) = '' then - begin - TargetCanvas.Brush.Color := CL_HLRedMarks; - TargetCanvas.FillRect(CellRect); - end - else + if FavoriteInfo.CurrentChapter = '0' then + Brush.Color := CL_FVEmptyChapters; if Status = STATUS_CHECKING then + Brush.Color := CL_FVChecking + else + if (Status = STATUS_CHECKED) and + Assigned(NewMangaInfo) then begin - TargetCanvas.Brush.Color := CL_HLGreenMarks; - TargetCanvas.FillRect(CellRect); + if NewMangaInfoChaptersPos.Count > 0 then + Brush.Color := CL_FVNewChapterFound + else + if NewMangaInfo.status = MangaInfo_StatusCompleted then + Brush.Color := CL_FVCompletedManga; end; end; + if Brush.Color <> clNone then + FillRect(CellRect) + else + Brush.Color := C; end; end; procedure TMainForm.vtFavoritesColumnDblClick(Sender: TBaseVirtualTree; Column: TColumnIndex; Shift: TShiftState); begin - miFavoritesOpenFolderClick(Sender); + if Column = 4 then + miFavoritesOpenFolderClick(Sender) + else + miFavoritesOpenWithClick(Sender); end; -procedure TMainForm.vtFavoritesFreeNode(Sender: TBaseVirtualTree; - Node: PVirtualNode); -var - Data: PFavoriteInfo; +procedure TMainForm.vtFavoritesDragDrop(Sender: TBaseVirtualTree; + Source: TObject; DataObject: IDataObject; Formats: TFormatArray; + Shift: TShiftState; const Pt: TPoint; var Effect: LongWord; Mode: TDropMode); begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - Finalize(Data^); + AddSilentThread(frmDropTarget.GetDropURLs(DataObject), MD_AddToFavorites); +end; + +procedure TMainForm.vtFavoritesDragOver(Sender: TBaseVirtualTree; + Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint; + Mode: TDropMode; var Effect: LongWord; var Accept: Boolean); +begin + Accept:=True; + Effect:=DROPEFFECT_LINK; end; procedure TMainForm.vtFavoritesGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String); -var - Data: PFavoriteInfo; begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then + if Node^.Index>=FavoriteManager.Count then Exit; + with FavoriteManager.Items[Node^.Index].FavoriteInfo do case Column of - 1: if Trim(Data^.Link) = '' then - HintText := RS_HintFavoriteProblem - else - HintText := Data^.Title; - 2: HintText := Data^.currentChapter; - 3: HintText := Data^.website; - 4: HintText := Data^.saveTo; + 1: if Trim(Link)='' then HintText:=RS_HintFavoriteProblem + else HintText:=Title; + 2: HintText:=currentChapter; + 3: HintText:=website; + 4: HintText:=saveTo; end; end; procedure TMainForm.vtFavoritesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); -var - Data: PFavoriteInfo; begin - if vtFavorites.Header.Columns[Column].Position = 1 then + if vtFavorites.Header.Columns[Column].Position<>1 then Exit; + with FavoriteManager.Items[Node^.Index] do begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - with FavoriteManager.FavoriteItem(Node^.Index) do - begin - if Trim(FavoriteInfo.Link) = '' then - ImageIndex := 16 + if Trim(FavoriteInfo.Link)='' then + ImageIndex:=16 + else + case FavoriteManager.Items[Node^.Index].Status of + STATUS_CHECK : ImageIndex:=19; + STATUS_CHECKING : ImageIndex:=12; + STATUS_CHECKED : + begin + ImageIndex:=20; + if Assigned(NewMangaInfo) then + begin + if NewMangaInfoChaptersPos.Count>0 then + ImageIndex:=21 + else + if NewMangaInfo.status=MangaInfo_StatusCompleted then + ImageIndex:=5 + end; + end; else - case Status of - STATUS_CHECK: ImageIndex := 19; - STATUS_CHECKING: ImageIndex := 12; - STATUS_CHECKED: ImageIndex := 20; - else - ImageIndex := -1; - end; + ImageIndex:=-1; end; end; end; @@ -3764,61 +4185,55 @@ procedure TMainForm.vtFavoritesGetImageIndex(Sender: TBaseVirtualTree; procedure TMainForm.vtFavoritesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); -var - Data: PFavoriteInfo; begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then + if Node^.Index>=FavoriteManager.Count then Exit; + with FavoriteManager.Items[Node^.Index].FavoriteInfo do case Column of - 0: CellText := Data^.numbering; - 1: CellText := Data^.Title; - 2: CellText := Data^.currentChapter; - 3: CellText := Data^.website; - 4: CellText := Data^.saveTo; + 0: CellText:=IntToStr(Node^.Index+1); + 1: CellText:=Title; + 2: CellText:=currentChapter; + 3: CellText:=website; + 4: CellText:=saveTo; end; end; +{$if VTMajorVersion < 5} procedure TMainForm.vtFavoritesHeaderClick(Sender: TVTHeader; Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); +{$else} +procedure TMainForm.vtFavoritesHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + Column: TColumnIndex; + Button: TMouseButton; +{$endif} begin + {$if VTMajorVersion >= 5} + Column := HitInfo.Column; + Button := HitInfo.Button; + {$endif} + if Button <> mbLeft then Exit; if FavoriteManager.isRunning then Exit; - if FavoriteManager.Count < 2 then Exit; if Column = 0 then Exit; FavoriteManager.isRunning := True; - try - if FavoriteManager.SortColumn = Column then - FavoriteManager.sortDirection := not FavoriteManager.sortDirection; + if FavoriteManager.SortColumn = Column then + FavoriteManager.sortDirection := not FavoriteManager.sortDirection + else FavoriteManager.SortColumn := Column; - vtFavorites.Header.SortColumn := Column; - vtFavorites.Header.SortDirection := TSortDirection(FavoriteManager.sortDirection); + vtFavorites.Header.SortColumn := Column; + vtFavorites.Header.SortDirection := TSortDirection(FavoriteManager.sortDirection); + if FavoriteManager.Count > 1 then FavoriteManager.Sort(Column); - options.WriteInteger('misc', 'SortFavoritesColumn', vtFavorites.Header.SortColumn); - options.WriteBool('misc', 'SortFavoritesDirection', FavoriteManager.sortDirection); - finally - UpdateVtFavorites; - FavoriteManager.isRunning := False; - end; + UpdateVtFavorites; + FavoriteManager.isRunning := False; end; -procedure TMainForm.vtFavoritesInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); -var - Data: PFavoriteInfo; - pos: Cardinal; +procedure TMainForm.vtFavoritesPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); begin - with Sender do - begin - pos := Node^.Index; - Data := GetNodeData(Node); - Data^.numbering := IntToStr(QWord(pos) + 1); - Data^.Title := FavoriteManager.FavoriteItem(pos).FavoriteInfo.Title; - Data^.currentChapter := FavoriteManager.FavoriteItem(pos).FavoriteInfo.currentChapter; - Data^.website := FavoriteManager.FavoriteItem(pos).FavoriteInfo.website; - Data^.saveTo := FavoriteManager.FavoriteItem(pos).FavoriteInfo.saveTo; - Data^.Link := FavoriteManager.FavoriteItem(pos).FavoriteInfo.Link; - end; - vtFavorites.ValidateNode(Node, False); + if not FavoriteManager[Node^.Index].Enabled then + TargetCanvas.Font.Color := TVirtualStringTree(Sender).Colors.DisabledColor; end; procedure TMainForm.vtMangaListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); @@ -3838,1152 +4253,1463 @@ procedure TMainForm.vtMangaListColumnDblClick(Sender: TBaseVirtualTree; miMangaListViewInfosClick(vtMangaList); end; -procedure TMainForm.vtMangaListDragAllowed(Sender : TBaseVirtualTree; - Node : PVirtualNode; Column : TColumnIndex; var Allowed : Boolean); -begin - Allowed := False; -end; +// options -procedure TMainForm.vtMangaListDragOver(Sender : TBaseVirtualTree; - Source : TObject; Shift : TShiftState; State : TDragState; const Pt : TPoint; - Mode : TDropMode; var Effect : LongWord; var Accept : Boolean); +procedure TMainForm.btOptionApplyClick(Sender: TObject); begin - Accept := False; + SaveOptions(True); + ApplyOptions; + if not Self.Focused then Self.SetFocus; end; -// options +// vtMangaList -procedure TMainForm.btOptionApplyClick(Sender: TObject); +procedure TMainForm.vtMangaListBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); var - i: Cardinal; - s: String; - isStillHaveCurrentWebsite: Boolean = False; - Data: PMangaListItem; + data: PMangaInfoData; begin - try - s := SaveMangaOptions; - if s = '' then + if CellPaintMode <> cpmPaint then Exit; + with TargetCanvas do + begin + Brush.Color := clNone; + data := Sender.GetNodeData(Node); + if data^.status = MangaInfo_StatusCompleted then + Brush.Color := CL_MNCompletedManga; + if miHighlightNewManga.Checked and (data^.jdn > OptionJDNNewMangaTime) then begin - MessageDlg('', RS_DlgMangaListSelect, - mtConfirmation, [mbYes], 0); - Exit; + if Brush.Color <> clNone then + Brush.Color := Brush.Color + CL_MNNewManga + else + Brush.Color := CL_MNNewManga; end; + if Brush.Color <> clNone then + FillRect(CellRect); + end; +end; - // general - options.WriteString('general', 'MangaListSelect', s); - mangalistIni.UpdateFile; +procedure TMainForm.vtMangaListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + data: PMangaInfoData; +begin + data := Sender.GetNodeData(Node); + Finalize(data^); +end; - cbSelectManga.Clear; - for i := 0 to Length(optionMangaSiteSelectionNodes) - 1 do +procedure TMainForm.vtMangaListGetHint(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; + var HintText: String); +var + data: PMangaInfoData; +begin + data := Sender.GetNodeData(Node); + with data^ do + begin + if dataProcess.FilterAllSites then + HintText += RS_InfoWebsite + LineEnding + website + LineEnding2; + HintText += RS_InfoTitle + LineEnding + title; + if authors <> '' then + HintText += LineEnding2 + RS_InfoAuthors + LineEnding + authors; + if artists <> '' then + HintText += LineEnding2 + RS_InfoArtists + LineEnding + artists; + if genres <> '' then + HintText += LineEnding2 + RS_InfoGenres + LineEnding + genres; + if status <> '' then begin - Data := vtOptionMangaSiteSelection.GetNodeData(optionMangaSiteSelectionNodes[i]); - if (optionMangaSiteSelectionNodes[i]^.CheckState = csCheckedNormal) and - (Data^.Text <> '') then - begin - cbSelectManga.Items.Add(Data^.Text); - end; - end; + HintText += LineEnding2 + RS_InfoStatus + LineEnding; + if status = '0' then + HintText += cbFilterStatus.Items[0] + else + if status = '1' then + HintText += cbFilterStatus.Items[1] + else + HintText += status; + end; + if summary <> '' then + HintText += LineEnding2 + RS_InfoSummary + LineEnding + summary; + end; +end; - for i := 0 to cbSelectManga.Items.Count - 1 do - begin - if cbSelectManga.Items[i] = currentWebsite then +procedure TMainForm.vtMangaListGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(TMangaInfoData); +end; + +procedure TMainForm.vtMangaListGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + data: PMangaInfoData; +begin + data := Sender.GetNodeData(Node); + CellText := data^.titleformat; +end; + +procedure TMainForm.InitCheckboxes; +var + i: Cardinal; +begin + for i := 0 to 37 do + TCheckBox(pnGenres.Controls[i]).State := cbGrayed; +end; + +procedure TMainForm.tvDownloadFilterRefresh(const ResourceChanged: Boolean); +begin + // update download filter treeview + tvDownloadFilter.BeginUpdate; + with DLManager, tvDownloadFilter do + try + // root + Items[0].Text := Format('%s (%d)', [RS_AllDownloads, vtDownload.RootNodeCount]); + + // childs + Items[1].Text := Format('%s (%d)', [RS_Finish, StatusCount[STATUS_FINISH]]); + Items[2].Text := Format('%s (%d)', [RS_InProgress, + StatusCount[STATUS_DOWNLOAD] + + StatusCount[STATUS_PREPARE] + + StatusCount[STATUS_WAIT]]); + Items[3].Text := Format('%s (%d)', [RS_Stopped, StatusCount[STATUS_STOP]]); + Items[4].Text := Format('%s (%d)', [RS_Failed, + StatusCount[STATUS_PROBLEM] + + StatusCount[STATUS_FAILED]]); + Items[5].Text := Format('%s (%d)', [RS_Disabled, DisabledCount]); + + if ResourceChanged then begin - cbSelectManga.ItemIndex := i; - isStillHaveCurrentWebsite := True; - Break; + // root + Items[6].Text := RS_History; + + // childs + Items[7].Text := RS_Today; + Items[8].Text := RS_Yesterday; + Items[9].Text := RS_OneWeek; + Items[10].Text := RS_OneMonth; end; + finally + tvDownloadFilter.EndUpdate; end; +end; - if not isStillHaveCurrentWebsite then +procedure TMainForm.vtDownloadUpdateFilters(const RefreshTree: Boolean); +var + ACurrentJDN: Integer; + + procedure ShowTasks(S: TDownloadStatusTypes = []); + var + xNode: PVirtualNode; + begin + if (S = []) and (vtDownload.VisibleCount = vtDownload.RootNodeCount) then + Exit; + xNode := vtDownload.GetFirst(); + while Assigned(xNode) do begin - if cbSelectManga.Items.Count > 0 then - begin - cbSelectManga.ItemIndex := 0; - cbSelectMangaChange(Sender); - end - else + with DLManager[xNode^.Index] do begin - cbSelectManga.ItemIndex := -1; - cbSelectManga.Text := ''; - currentWebsite := ''; - FreeAndNil(dataProcess); - vtMangaList.Clear; - lbMode.Caption := Format(RS_ModeAll, [0]); + if S = [] then + Visible := True + else + Visible := Status in S; + vtDownload.IsVisible[xNode] := Visible; end; + xNode := vtDownload.GetNext(xNode); end; - options.WriteBool('general', 'LiveSearch', cbOptionLiveSearch.Checked); - options.WriteBool('general', 'OneInstanceOnly', cbOptionOneInstanceOnly.Checked); - //FMDInstace - if cbOptionOneInstanceOnly.Checked then + end; + + procedure ShowTasksOnCertainDays(const L, H: Integer); + var + jdn: Integer; + xNode: PVirtualNode; + begin + xNode := vtDownload.GetFirst(); + while Assigned(xNode) do begin - if FMDInstance = nil then + with DLManager.Items[xNode^.Index] do begin - FMDInstance := TSimpleIPCServer.Create(Self); - FMDInstance.ServerID := FMD_INSTANCE; - FMDInstance.Global := True; - FMDInstance.OnMessage := @FMDInstanceReceiveMsg; - FMDInstance.StartServer; + jdn := DateToJDN(DownloadInfo.DateTime); + Visible := (jdn >= L) and (jdn <= H);; + vtDownload.IsVisible[xNode] := Visible; end; - end - else + xNode := vtDownload.GetNext(xNode); + end; + end; + + procedure ShowDisabled; + var + xNode: PVirtualNode; + begin + xNode := vtDownload.GetFirst(); + while Assigned(xNode) do begin - if FMDInstance <> nil then + with DLManager.Items[xNode^.Index] do begin - FMDInstance.StopServer; - FreeAndNil(FMDInstance); + Visible := not Enabled; + vtDownload.IsVisible[xNode] := Visible; end; + xNode := vtDownload.GetNext(xNode); end; + end; - options.WriteString('languages', 'Selected', - AvailableLanguages.Names[cbLanguages.ItemIndex]); - options.WriteBool('general', 'MinimizeToTray', cbOptionMinimizeToTray.Checked); - options.WriteInteger('general', 'NewMangaTime', seOptionNewMangaTime.Value); - options.WriteInteger('general', 'LetFMDDo', cbOptionLetFMDDo.ItemIndex); - OptionLetFMDDo := TFMDDo(cbOptionLetFMDDo.ItemIndex); - options.WriteBool('general', 'LoadMangaCover', cbOptionEnableLoadCover.Checked); - OptionEnableLoadCover := cbOptionEnableLoadCover.Checked; - options.WriteString('general', 'ExternalProgramPath', edOptionExternalPath.FileName); - options.WriteString('general', 'ExternalProgramParams', edOptionExternalParams.Text); - - // view - options.WriteBool('droptarget', 'Show', ckDropTarget.Checked); - options.WriteInteger('droptarget', 'Mode', rgDropTargetMode.ItemIndex); - options.WriteInteger('droptarget', 'Opacity', tbDropTargetOpacity.Position); - options.WriteInteger('droptarget', 'Width', frmDropTarget.FWidth); - options.WriteInteger('droptarget', 'Heigth', frmDropTarget.FHeight); - options.WriteInteger('droptarget', 'Top', frmDropTarget.FTop); - options.WriteInteger('droptarget', 'Left', frmDropTarget.FLeft); - options.WriteBool('view', 'ShowDownloadsToolbar', cbOptionShowDownloadToolbar.Checked); - ToolBarDownload.Visible := cbOptionShowDownloadToolbar.Checked; - - // connections - options.WriteInteger('connections', 'NumberOfTasks', seOptionMaxParallel.Value); - options.WriteInteger('connections', 'NumberOfThreadsPerTask', - seOptionMaxThread.Value); - options.WriteInteger('connections', 'Retry', seOptionMaxRetry.Value); - DLManager.retryConnect := seOptionMaxRetry.Value; - options.WriteInteger('connections', 'ConnectionTimeout', seOptionConnectionTimeout.Value); - OptionConnectionTimeout := seOptionConnectionTimeout.Value*1000; - options.WriteBool('connections', 'UseProxy', cbOptionUseProxy.Checked); - options.WriteString('connections', 'ProxyType', cbOptionProxyType.Text); - options.WriteString('connections', 'Host', edOptionHost.Text); - options.WriteString('connections', 'Pass', edOptionPass.Text); - options.WriteString('connections', 'Port', edOptionPort.Text); - options.WriteString('connections', 'User', edOptionUser.Text); - - // saveto - if Trim(edOptionDefaultPath.Text) = '' then - edOptionDefaultPath.Text := DEFAULT_PATH; - edOptionDefaultPath.Text := CorrectPathSys(edOptionDefaultPath.Text); - options.WriteString('saveto', 'SaveTo', edOptionDefaultPath.Text); - options.WriteBool('saveto', 'PathConv', cbOptionPathConvert.Checked); - options.WriteBool('saveto', 'GenChapName', cbOptionGenerateChapterName.Checked); - options.WriteBool('saveto', 'GenMangaName', cbOptionGenerateMangaFolderName.Checked); - options.WriteInteger('saveto', 'Compress', rgOptionCompress.ItemIndex); - options.WriteBool('saveto', 'AutoNumberChapter', cbOptionAutoNumberChapter.Checked); - OptionAutoNumberChapterChecked := cbOptionAutoNumberChapter.Checked; - options.WriteInteger('saveto', 'PDFQuality', seOptionPDFQuality.Value); - OptionPDFQuality := seOptionPDFQuality.Value; - if Trim(edOptionCustomRename.Text) = '' then - edOptionCustomRename.Text := DEFAULT_CUSTOM_RENAME; - options.WriteString('saveto', 'CustomRename', edOptionCustomRename.Text); - OptionCustomRename := edOptionCustomRename.Text; - options.WriteBool('saveto', 'ConvertDigitVolume', cbOptionDigitVolume.Checked); - options.WriteBool('saveto', 'ConvertDigitChapter', cbOptionDigitChapter.Checked); - options.WriteInteger('saveto', 'DigitVolumeLength', seOptionDigitVolume.Value); - options.WriteInteger('saveto', 'DigitChapterLength', seOptionDigitChapter.Value); - - // update - options.WriteBool('update', 'AutoRemoveCompletedManga', - cbOptionAutoRemoveCompletedManga.Checked); - OptionAutoRemoveCompletedManga := cbOptionAutoRemoveCompletedManga.Checked; - options.WriteBool('update', 'AutoCheckUpdate', - cbOptionAutoCheckUpdate.Checked); - options.WriteBool('update', 'AutoCheckFavStartup', - cbOptionAutoCheckFavStartup.Checked); - OptionAutoCheckFavStartup := cbOptionAutoCheckFavStartup.Checked; - options.WriteInteger('update', 'AutoCheckMinutes', seOptionCheckMinutes.Value); - OptionCheckMinutes := seOptionCheckMinutes.Value; - lbOptionAutoCheckMinutes.Caption := Format(RS_LblAutoCheckNewChapterMinute, - [seOptionCheckMinutes.Value]); - options.WriteBool('update', 'UpdateListNoMangaInfo', - cbOptionUpdateListNoMangaInfo.Checked); - OptionUpdateListNoMangaInfo := cbOptionUpdateListNoMangaInfo.Checked; - options.WriteBool('update', 'UpdateListRemoveDuplicateLocalData', - cbOptionUpdateListRemoveDuplicateLocalData.Checked); - OptionUpdateListRemoveDuplicateLocalData := cbOptionUpdateListRemoveDuplicateLocalData.Checked; - - DLManager.compress := rgOptionCompress.ItemIndex; - - // dialogs - options.WriteBool('dialogs', 'ShowQuitDialog', cbOptionShowQuitDialog.Checked); - options.WriteBool('dialogs', 'ShowDeleteDldTaskDialog', - cbOptionShowDeleteTaskDialog.Checked); - - // misc - options.WriteBool('misc', 'ShowBatotoSG', cbOptionShowBatotoSG.Checked); - options.WriteBool('misc', 'ShowAllLang', cbOptionShowAllLang.Checked); - options.WriteBool('misc', 'AutoDlFav', cbOptionAutoDlFav.Checked); - OptionShowBatotoSG := cbOptionShowBatotoSG.Checked; - OptionShowAllLang := cbOptionShowAllLang.Checked; - OptionAutoDlFav := cbOptionAutoDlFav.Checked; - options.WriteBool('misc', 'MangafoxRemoveWatermarks', - cbOptionMangaFoxRemoveWatermarks.Checked); - - - options.UpdateFile; - - if OptionCheckMinutes = 0 then - itCheckForChapters.Enabled := False - else - begin - itCheckForChapters.Interval := OptionCheckMinutes * 60000; - itCheckForChapters.Enabled := True; - end; +begin + if tvDownloadFilter.Selected = nil then Exit; - if cbOptionUseProxy.Checked then - begin - ProxyType := cbOptionProxyType.Text; - Host := edOptionHost.Text; - Pass := edOptionPass.Text; - Port := edOptionPort.Text; - User := edOptionUser.Text; - end - else - begin - ProxyType := ''; - Host := ''; - Pass := ''; - Port := ''; - User := ''; + vtDownload.BeginUpdate; + try + if vtDownload.RootNodeCount <> DLManager.Count then + vtDownload.RootNodeCount := DLManager.Count; + + // filter download list + if tvDownloadFilter.Selected.AbsoluteIndex > 5 then + ACurrentJDN := DateToJDN(Now); + case tvDownloadFilter.Selected.AbsoluteIndex of + 0, 6: ShowTasks; + 1: ShowTasks([STATUS_FINISH]); + 2: ShowTasks([STATUS_WAIT, STATUS_PREPARE, STATUS_DOWNLOAD, STATUS_COMPRESS]); + 3: ShowTasks([STATUS_STOP]); + 4: ShowTasks([STATUS_PROBLEM, STATUS_FAILED]); + 5: ShowDisabled; + + 7: ShowTasksOnCertainDays(ACurrentJDN, ACurrentJDN); + 8: ShowTasksOnCertainDays(ACurrentJDN - 1, ACurrentJDN - 1); + 9: ShowTasksOnCertainDays(ACurrentJDN - 7, ACurrentJDN); + 10: ShowTasksOnCertainDays(ACurrentJDN - 30, ACurrentJDN); end; - - DLManager.maxDLTasks := seOptionMaxParallel.Value; - DLManager.maxDLThreadsPerTask := seOptionMaxThread.Value; - DLManager.retryConnect := seOptionMaxRetry.Value; - - LoadLanguage; finally - //Recheck download thread - DLManager.CheckAndActiveTask; + vtDownload.EndUpdate; end; + + if RefreshTree then + tvDownloadFilterRefresh; + if edDownloadsSearch.Text <> '' then + edDownloadsSearchChange(edDownloadsSearch); end; -procedure TMainForm.cbAddAsStoppedChange(Sender: TObject); +procedure TMainForm.AddChapterNameToList; begin - options.WriteBool('general', 'AddAsStopped', cbAddAsStopped.Checked); + UpdateVtChapter; end; -// vtMangaList - -procedure TMainForm.vtMangaListBeforeCellPaint(Sender: TBaseVirtualTree; - TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; - CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +procedure TMainForm.AddSilentThread(URL: string; MetaDataType: TMetaDataType); +var + i, m: Integer; + host, link, webs: String; + URls: TStringList; begin - if (isExiting) or (dataProcess.JDN.Count = 0) or (dataProcess.filterPos.Count = 0) then - Exit; - if miHighlightNewManga.Checked then - begin - try - if currentJDN - cardinal(dataProcess.JDN.Items[dataProcess.GetPos(Node^.Index)]) < - seOptionNewMangaTime.Value then - begin - TargetCanvas.Brush.Color := CL_HLBlueMarks; - TargetCanvas.FillRect(CellRect); + if Trim(URL) = '' then Exit; + URLs := TStringList.Create; + try + URls.Text := URL; + if URls.Count > 0 then + begin + GoogleResultURLs(URls); + SilentThreadManager.BeginAdd; + with TRegExpr.Create do + try + Expression := REGEX_HOST; + for i := 0 to URls.Count - 1 do + begin + host := ''; + link := ''; + webs := ''; + host := LowerCase(Replace(URls[i], '$2', True)); + link := Replace(URls[i], '$4', True); + if (host <> '') and (link <> '') then + begin + m := Modules.LocateModuleByHost(host); + if m > -1 then + webs := Modules.Module[m].Website; + if webs <> '' then + begin + if not ((MetaDataType = MD_AddToFavorites) and SitesWithoutFavorites(webs)) then + SilentThreadManager.Add(MetaDataType, webs, '', link); + end; + end; + end; + finally + Free; end; - except - on E: Exception do ; + SilentThreadManager.EndAdd; end; + finally + URls.Free; end; end; -procedure TMainForm.vtMangaListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +procedure TMainForm.AddSilentThread(URL: string); var - Data: PMangaListItem; + mt: TMetaDataType; begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - Finalize(Data^); + if Trim(URL)='' then Exit; + if rgDropTargetMode.ItemIndex=0 then + mt:=MD_DownloadAll + else + mt:=MD_AddToFavorites; + AddSilentThread(URL,mt); end; -procedure TMainForm.vtMangaListGetHint(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; - var HintText: String); +procedure TMainForm.AddTextToInfo(const ATitle, AValue: String); var - LPos: Integer; - s: String; + p: Integer; + fp: TFontParams; + s: string; begin - s := ''; - LPos := dataProcess.GetPos(Node^.Index); - if dataProcess.isFilterAllSites then - s := s + RS_InfoWebsite + LineEnding + - GetMangaSiteName(dataProcess.site.Items[LPos]) + LineEnding + LineEnding; - if Trim(dataProcess.Param[LPos, DATA_PARAM_NAME]) <> '' then - s := s + RS_InfoTitle + LineEnding + dataProcess.Param[LPos, DATA_PARAM_NAME]; - if Trim(dataProcess.Param[LPos, DATA_PARAM_AUTHORS]) <> '' then - s := s + LineEnding + LineEnding + RS_InfoAuthors + LineEnding + - dataProcess.Param[LPos, DATA_PARAM_AUTHORS]; - if Trim(dataProcess.Param[LPos, DATA_PARAM_ARTISTS]) <> '' then - s := s + LineEnding + LineEnding + RS_InfoArtists + LineEnding + - dataProcess.Param[LPos, DATA_PARAM_ARTISTS]; - if Trim(dataProcess.Param[LPos, DATA_PARAM_GENRES]) <> '' then - s := s + LineEnding + LineEnding + RS_InfoGenres + LineEnding + - dataProcess.Param[LPos, DATA_PARAM_GENRES]; - if Trim(dataProcess.Param[LPos, DATA_PARAM_STATUS]) <> '' then + s := Trim(FixWhiteSpace(AValue)); + if s = '' then Exit; + if ATitle = RS_InfoSummary then + s := Trim(StringBreaks(s)); + with rmInformation do begin - s := s + LineEnding + LineEnding + RS_InfoStatus + LineEnding; - if dataProcess.Param[LPos, DATA_PARAM_STATUS] = '0' then - s := s + cbFilterStatus.Items[0] - else - s := s + cbFilterStatus.Items[1]; + if Lines.Count > 0 then + Lines.Add(''); + p := SelStart; + GetTextAttributes(p, fp); + fp.Style += [fsBold, fsUnderline]; + Inc(fp.Size); + SetTextAttributes(p, 0, fp); + Lines.Add(ATitle); + p := SelStart; + fp.Style -= [fsBold, fsUnderline]; + Dec(fp.Size); + SetTextAttributes(p, 0, fp); + Lines.Add(s); end; - if Trim(dataProcess.Param[LPos, DATA_PARAM_SUMMARY]) <> '' then - //s := s + LineEndingLineEnding + infoSummary + ':' + LineEnding + PrepareSummaryForHint(dataProcess.Param[LPos, DATA_PARAM_SUMMARY], 80); - s := s + LineEnding + LineEnding + RS_InfoSummary + ':' + LineEnding + - StringBreaks(dataProcess.Param[LPos, DATA_PARAM_SUMMARY]); - HintText := s; end; -procedure TMainForm.vtMangaListGetText(Sender: TBaseVirtualTree; - Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; - var CellText: String); -var - Data: PMangaListItem; +procedure TMainForm.FillSaveTo; begin - Data := Sender.GetNodeData(Node); - if Assigned(Data) then - CellText := Data^.Text; + if Trim(edSaveTo.Text) <> '' then Exit; + if LastUserPickedSaveTo = '' then + LastUserPickedSaveTo := Trim(configfile.ReadString('saveto', 'SaveTo', DEFAULT_PATH)); + if LastUserPickedSaveTo = '' then + LastUserPickedSaveTo := DEFAULT_PATH; + edSaveTo.Text := LastUserPickedSaveTo; end; -procedure TMainForm.vtMangaListInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +procedure TMainForm.ViewMangaInfo(const ALink, AWebsite, ATitle, ASaveTo: String; + const ASender: TObject; const AMangaListNode: PVirtualNode); var - Data: PMangaListItem; - pos: Cardinal; + i: Integer; + fav: TFavoriteContainer; begin - with Sender do - begin - pos := dataProcess.filterPos.Items[Node^.Index]; - Data := GetNodeData(Node); - Data^.Text := dataProcess.Param[pos, DATA_PARAM_NAME] + - ' (' + - dataProcess.Param[pos, DATA_PARAM_NUMCHAPTER] + ')'; - end; - vtMangaList.ValidateNode(Node, False); -end; + if (ALink = '') or (AWebsite = '') then Exit; -procedure TMainForm.vtMangaListInitSearchNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); -var - Data: PMangaListItem; - pos: Cardinal; -begin - with Sender do + // terminate exisiting getmangainfo thread + if Assigned(GetInfosThread) then + try + GetInfosThread.Terminate; + GetInfosThread.WaitFor; + except + end; + + // set the UI + i := Modules.LocateModule(AWebsite); + if i <> -1 then + edURL.Text := FillHost(Modules.Module[i].RootURL, ALink); + pcMain.ActivePage := tsInformation; + imCover.Picture.Assign(nil); + rmInformation.Clear; + rmInformation.Lines.Add(RS_Loading); + clbChapterList.Clear; + if Assigned(gifWaiting) then begin - pos := dataProcess.searchPos.Items[Node^.Index]; - Data := GetNodeData(Node); - Data^.Text := dataProcess.Param[pos, DATA_PARAM_NAME] + - ' (' + - dataProcess.Param[pos, DATA_PARAM_NUMCHAPTER] + ')'; + tmAnimateMangaInfo.Enabled := True; + pbWait.Visible := True; end; -end; + btDownload.Enabled := False; + btDownloadSplit.Enabled := btDownload.Enabled; + btReadOnline.Enabled := True; -procedure TMainForm.InitCheckboxes; -var - i: Cardinal; -begin - for i := 0 to 37 do - TCheckBox(pnGenres.Controls[i]).State := cbGrayed; -end; + // set saveto + edSaveTo.Text := ASaveTo; + LastViewMangaInfoSender := ASender; + if edSaveTo.Text = '' then + FillSaveTo; -procedure TMainForm.ShowTasks(Status: TDownloadStatusTypes); -var - i: Cardinal; - xNode: PVirtualNode; - canExit: Boolean = False; -begin - if vtDownload.RootNodeCount = 0 then - Exit; - xNode := vtDownload.GetLast; - for i := vtDownload.RootNodeCount - 1 downto 0 do + DisableAddToFavorites(AWebsite); + //check if manga already in FavoriteManager list + if btAddToFavorites.Enabled and not(LastViewMangaInfoSender = miFavoritesViewInfos) then begin - if Status = [] then - vtDownload.isVisible[xNode] := True - else - vtDownload.IsVisible[xNode] := DLManager.TaskItem(i).Status in Status; - if canExit then - Exit; - if xNode = vtDownload.GetFirst then - canExit := True; - xNode := vtDownload.GetPrevious(xNode); - if xNode = vtDownload.GetFirst then - canExit := True; + fav := FavoriteManager.LocateMangaByLink(AWebsite, ALink); + if fav <> nil then + begin + btAddToFavorites.Enabled := False; + if LastViewMangaInfoSender <> miDownloadViewMangaInfo then + begin + edSaveTo.Text := fav.FavoriteInfo.SaveTo; + LastViewMangaInfoSender := miFavoritesViewInfos; + end; + end; end; + + // start the thread + GetInfosThread := TGetMangaInfosThread.Create; + GetInfosThread.MangaListNode := AMangaListNode; + if (ASender = miDownloadViewMangaInfo) or (ASender = miFavoritesViewInfos) then + GetInfosThread.Title := '' // retrieve the original title so custom rename can remove them + else + GetInfosThread.Title := ATitle; + GetInfosThread.Website := AWebsite; + GetInfosThread.Link := ALink; + GetInfosThread.Start; end; -procedure TMainForm.ShowTasksOnCertainDays(const L, H: longint); +procedure TMainForm.ShowInformation; var - i: Cardinal; - jdn: longint; - xNode: PVirtualNode; - canExit: Boolean = False; - dt: TDateTime; - day, month, year: Word; + i, j: Integer; begin - if vtDownload.RootNodeCount = 0 then - Exit; - if vtDownload.RootNodeCount <> DLManager.Count then - vtDownload.RootNodeCount := DLManager.Count; - xNode := vtDownload.GetLast; - for i := DLManager.Count-1 downto 0 do + pcMain.ActivePage := tsInformation; + + imCover.Picture.Assign(nil); + + with rmInformation do + try + Lines.BeginUpdate; + Lines.Clear; + edURL.Text := mangaInfo.url; + AddTextToInfo(RS_InfoTitle, mangaInfo.title); + AddTextToInfo(RS_InfoAuthors, mangaInfo.authors); + AddTextToInfo(RS_InfoArtists, mangaInfo.artists); + AddTextToInfo(RS_InfoGenres, mangaInfo.genres); + i := StrToIntDef(mangaInfo.status, -1); + if (i > -1) and (i < cbFilterStatus.Items.Count) then + AddTextToInfo(RS_InfoStatus, cbFilterStatus.Items[i]); + AddTextToInfo(RS_InfoSummary, mangaInfo.summary); + CaretPos := Point(0, 0); + finally + Lines.EndUpdate; + end; + + SetLength(ChapterList, mangaInfo.chapterName.Count); + if Length(ChapterList) <> 0 then begin - if i < DLManager.Count then + if miChapterListAscending.Checked then + j := 0 + else + j := High(ChapterList); + for i := low(ChapterList) to High(ChapterList) do begin - dt := DLManager.TaskItem(i).DownloadInfo.dateTime; - DecodeDate(dt, year, month, day); - jdn := DateToJDN(year, month, day); - - if (jdn >= L) and (jdn <= H) then - vtDownload.isVisible[xNode] := True + ChapterList[i].Index := j + 1; + ChapterList[i].Title := mangaInfo.chapterName[j]; + ChapterList[i].Link := mangaInfo.chapterLinks[j]; + ChapterList[i].Downloaded := False; + if miChapterListAscending.Checked then + Inc(j) else - vtDownload.isVisible[xNode] := False; - - if canExit then - Exit; - if xNode = vtDownload.GetFirst then - canExit := True; - xNode := vtDownload.GetPrevious(xNode); - if xNode = vtDownload.GetFirst then - canExit := True; + Dec(j); end; end; -end; -procedure TMainForm.ShowTodayTasks; -begin - ShowTasksOnCertainDays(GetCurrentJDN, GetCurrentJDN); -end; + miChapterListHighlightClick(nil); + UpdateVtChapter; + miChapterListHideDownloadedClick(nil); + edFilterMangaInfoChaptersChange(nil); + if (clbChapterList.RootNodeCount <> 0) and miChapterListAscending.Checked then + clbChapterList.FocusedNode := clbChapterList.GetLast(); -procedure TMainForm.ShowYesterdayTasks; -begin - ShowTasksOnCertainDays(GetCurrentJDN - 1, GetCurrentJDN - 1); + btDownload.Enabled := (clbChapterList.RootNodeCount > 0); + btDownloadSplit.Enabled := btDownload.Enabled; + btReadOnline.Enabled := (mangaInfo.link <> ''); end; -procedure TMainForm.ShowOneWeekTasks; +procedure TMainForm.RunGetList; begin - ShowTasksOnCertainDays(GetCurrentJDN - 7, GetCurrentJDN); + if DBUpdaterThread <> nil then + DBUpdaterThread.Add(cbSelectManga.Items[cbSelectManga.ItemIndex]) + else + if MessageDlg('', RS_DlgUpdaterWantToUpdateDB, mtInformation, [mbYes, mbNo], 0) = mrYes then + begin + DBUpdaterThread := TDBUpdaterThread.Create; + DBUpdaterThread.Items.Add(cbSelectManga.Items[cbSelectManga.ItemIndex]); + DBUpdaterThread.Start; + end; end; -procedure TMainForm.ShowOneMonthTasks; +procedure TMainForm.LoadOptions; begin - ShowTasksOnCertainDays(GetCurrentJDN - 30, GetCurrentJDN); + with configfile do begin + // general + cbOptionOneInstanceOnly.Checked := ReadBool('general', 'OneInstanceOnly', True); + cbOptionLiveSearch.Checked := ReadBool('general', 'LiveSearch', True); + cbOptionMinimizeOnStart.Checked := ReadBool('general', 'MinimizeOnStart', False); + cbOptionMinimizeToTray.Checked := ReadBool('general', 'MinimizeToTray', False); + cbOptionDeleteCompletedTasksOnClose.Checked := ReadBool('general', 'DeleteCompletedTasksOnClose', OptionDeleteCompletedTasksOnClose); + cbOptionLetFMDDo.ItemIndex := ReadInteger('general', 'LetFMDDo', 0); + edOptionExternalPath.Text := ReadString('general', 'ExternalProgramPath', ''); + edOptionExternalParams.Text := ReadString('general', 'ExternalProgramParams', DEFAULT_EXPARAM); + miChapterListHideDownloaded.Checked := ReadBool('general', 'ChapterListHideDownloaded', False); + cbAddAsStopped.Checked := ReadBool('general', 'AddAsStopped', False); + miHighLightNewManga.Checked := ReadBool('general', 'HighlightNewManga', True); + miChapterListHighlight.Checked := ReadBool('general', 'HighlightDownloadedChapters', True); + miChapterListAscending.Checked := ReadBool('general', 'SortChapterListAscending', True); + miChapterListDescending.Checked := not miChapterListAscending.Checked; + + // view + cbOptionShowDownloadToolbar.Checked := ReadBool('view', 'ShowDownloadsToolbar', True); + cbOptionShowDownloadToolbarLeft.Checked := ReadBool('view', 'ShowDownloadsToolbarLeft', True); + cbOptionShowDownloadToolbarDeleteAll.Checked := ReadBool('view', 'ShowDownloadsToolbarDeleteAll', False); + cbOptionEnableLoadCover.Checked := ReadBool('view', 'LoadMangaCover', True); + cbOptionShowBalloonHint.Checked := ReadBool('view', 'ShowBalloonHint', OptionShowBalloonHint); + ckDropTarget.Checked := ReadBool('droptarget', 'Show', False); + frmDropTarget.FWidth := ReadInteger('droptarget', 'Width', frmDropTarget.FWidth); + frmDropTarget.FHeight := ReadInteger('droptarget', 'Heigth', frmDropTarget.FHeight); + frmDropTarget.FTop := ReadInteger('droptarget', 'Top', frmDropTarget.FTop); + frmDropTarget.FLeft := ReadInteger('droptarget', 'Left', frmDropTarget.FLeft); + rgDropTargetMode.ItemIndex := ReadInteger('droptarget', 'Mode', 0); + tbDropTargetOpacity.Position := ReadInteger('droptarget', 'Opacity', 255); + + // connection + seOptionMaxParallel.Value := ReadInteger('connections', 'NumberOfTasks', OptionMaxParallel); + seOptionMaxThread.Value := ReadInteger('connections', 'NumberOfThreadsPerTask', OptionMaxThreads); + seOptionMaxRetry.Value := ReadInteger('connections', 'Retry', OptionMaxRetry);; + seOptionConnectionTimeout.Value := ReadInteger('connections', 'ConnectionTimeout', OptionConnectionTimeout); + seOptionRetryFailedTask.Value := ReadInteger('connections', 'NumberOfAutoRetryFailedTask', OptionRetryFailedTask); + ckOptionsAlwaysStartTaskFromFailedChapters.Checked := ReadBool('connections', 'AlwaysStartFromFailedChapters', OptionAlwaysStartTaskFromFailedChapters); + + // proxy + cbOptionUseProxy.Checked := ReadBool('connections', 'UseProxy', False); + cbOptionProxyType.Text := ReadString('connections', 'ProxyType', 'HTTP'); + edOptionHost.Text := ReadString('connections', 'Host', ''); + edOptionPass.Text := ReadString('connections', 'Pass', ''); + edOptionPort.Text := ReadString('connections', 'Port', ''); + edOptionUser.Text := ReadString('connections', 'User', ''); + + // saveto + edOptionDefaultPath.Text := ReadString('saveto', 'SaveTo', DEFAULT_PATH); + if Trim(edOptionDefaultPath.Text) = '' then + edOptionDefaultPath.Text := DEFAULT_PATH; + seOptionPDFQuality.Value := ReadInteger('saveto', 'PDFQuality', 100); + rgOptionCompress.ItemIndex := ReadInteger('saveto', 'Compress', 0); + cbOptionChangeUnicodeCharacter.Checked := ReadBool('saveto', 'ChangeUnicodeCharacter', False); + edOptionChangeUnicodeCharacterStr.Text := ReadString('saveto', 'ChangeUnicodeCharacterStr', OptionChangeUnicodeCharacterStr); + cbOptionRemoveMangaNameFromChapter.Checked := ReadBool('saveto', 'RemoveMangaNameFromChapter', False); + cbOptionGenerateMangaFolder.Checked := ReadBool('saveto', 'GenerateMangaFolder', True); + edOptionMangaCustomRename.Text := ReadString('saveto', 'MangaCustomRename', DEFAULT_MANGA_CUSTOMRENAME); + if Trim(edOptionMangaCustomRename.Text) = '' then + edOptionMangaCustomRename.Text := DEFAULT_MANGA_CUSTOMRENAME; + cbOptionGenerateChapterFolder.Checked := ReadBool('saveto', 'GenerateChapterFolder', True); + edOptionChapterCustomRename.Text := ReadString('saveto', 'ChapterCustomRename', DEFAULT_CHAPTER_CUSTOMRENAME); + if Trim(edOptionChapterCustomRename.Text) = '' then + edOptionChapterCustomRename.Text := DEFAULT_CHAPTER_CUSTOMRENAME; + cbOptionDigitVolume.Checked := ReadBool('saveto', 'ConvertDigitVolume', True); + seOptionDigitVolume.Value := ReadInteger('saveto', 'DigitVolumeLength', 2); + seOptionDigitVolume.Enabled := cbOptionDigitVolume.Checked; + cbOptionDigitChapter.Checked := ReadBool('saveto', 'ConvertDigitChapter', True); + seOptionDigitChapter.Value := ReadInteger('saveto', 'DigitChapterLength', 3); + seOptionDigitChapter.Enabled := cbOptionDigitChapter.Checked; + edOptionFilenameCustomRename.Text := ReadString('saveto', 'FilenameCustomRename', DEFAULT_FILENAME_CUSTOMRENAME); + if Trim(edOptionFilenameCustomRename.Text) = '' then + edOptionFilenameCustomRename.Text := DEFAULT_FILENAME_CUSTOMRENAME; + ckPNGSaveAsJPEG.Checked := ReadBool('saveto', 'PNGSaveAsJPEG', OptionPNGSaveAsJPEG); + cbWebPSaveAs.ItemIndex := ReadInteger('saveto', 'ConvertWebP', OptionWebPSaveAs); + cbPNGCompressionLevel.ItemIndex := ReadInteger('saveto', 'PNGCompressionLevel', OptionPNGCompressionLevel); + seJPEGQuality.Value := ReadInteger('saveto', 'JPEGQuality', OptionJPEGQuality); + + // update + cbOptionAutoCheckLatestVersion.Checked := ReadBool('update', 'AutoCheckLatestVersion', True); + cbOptionAutoCheckFavStartup.Checked := ReadBool('update', 'AutoCheckFavStartup', True); + cbOptionAutoCheckFavStartupChange(cbOptionAutoCheckFavStartup); + cbOptionAutoOpenFavStartup.Checked := ReadBool('update', 'AutoOpenFavStartup', False); + cbOptionAutoCheckFavInterval.Checked := ReadBool('update', 'AutoCheckFavInterval', True); + seOptionAutoCheckFavIntervalMinutes.Value := ReadInteger('update', 'AutoCheckFavIntervalMinutes', 60); + lbOptionAutoCheckFavIntervalMinutes.Caption := Format(RS_LblAutoCheckNewChapterMinute, [seOptionAutoCheckFavIntervalMinutes.Value]); + cbOptionAutoCheckFavIntervalChange(cbOptionAutoCheckFavInterval); + seOptionNewMangaTime.Value := ReadInteger('update', 'NewMangaTime', 1); + cbOptionAutoCheckFavDownload.Checked := ReadBool('update', 'AutoCheckFavAutoDownload', False); + cbOptionAutoCheckFavRemoveCompletedManga.Checked := ReadBool('update', 'AutoCheckFavAutoRemoveCompletedManga', False); + cbOptionUpdateListNoMangaInfo.Checked := ReadBool('update', 'UpdateListNoMangaInfo', False); + cbOptionUpdateListRemoveDuplicateLocalData.Checked := ReadBool('update', 'UpdateListRemoveDuplicateLocalData', False); + + // modules updater + LuaModulesUpdaterForm.ckShowUpdateWarning.Checked := ReadBool('modulesupdater', 'ShowUpdateWarning', OptionModulesUpdaterShowUpdateWarning); + LuaModulesUpdaterForm.ckAutoRestart.Checked := ReadBool('modulesupdater', 'AutoRestart', OptionModulesUpdaterAutoRestart); + + // dialogs + cbOptionShowQuitDialog.Checked := ReadBool('dialogs', 'ShowQuitDialog', True); + cbOptionShowDeleteTaskDialog.Checked := ReadBool('dialogs', 'ShowDeleteDldTaskDialog', True); + cbOptionShowDownloadMangalistDialog.Checked := ReadBool('dialogs', 'ShowDownloadMangalistDialog', True); + + // misc + frmCustomColor.LoadFromIniFile(configfile); + ckEnableLogging.Checked := ReadBool('logger', 'Enabled', False); + edLogFileName.Text := ReadString('logger', 'LogFileName', ''); + if edLogFileName.Text = '' then + edLogFileName.Text := DEFAULT_LOG_FILE; + end; end; -procedure TMainForm.vtDownloadFilters; +procedure TMainForm.SaveOptions(const AShowDialog: Boolean); begin - if (isRunDownloadFilter) or - (not Assigned(tvDownloadFilter.Selected)) then + if (cbSelectManga.Items.Count = 0) and AShowDialog then + begin + MessageDlg('', RS_DlgMangaListSelect, + mtConfirmation, [mbYes], 0); Exit; - isRunDownloadFilter := True; - case tvDownloadFilter.Selected.AbsoluteIndex of - 0, 5: ShowTasks; - 1: ShowTasks([STATUS_FINISH]); - 2: ShowTasks([STATUS_PREPARE, STATUS_DOWNLOAD, STATUS_COMPRESS]); - 3: ShowTasks([STATUS_STOP]); - 4: ShowTasks([STATUS_PROBLEM, STATUS_FAILED]); - 6: ShowTodayTasks; - 7: ShowYesterdayTasks; - 8: ShowOneWeekTasks; - 9: ShowOneMonthTasks; - end; - tvDownloadFilterRepaint; - isRunDownloadFilter := False; -end; + end; -procedure TMainForm.AddChapterNameToList; -begin - UpdateVtChapter; + with configfile do + try + // general + WriteString('general', 'MangaListSelect', cbSelectManga.Items.CommaText); + WriteBool('general', 'LiveSearch', cbOptionLiveSearch.Checked); + WriteBool('general', 'OneInstanceOnly', cbOptionOneInstanceOnly.Checked); + if cbLanguages.ItemIndex > -1 then + WriteString('languages', 'Selected', AvailableLanguages.Names[cbLanguages.ItemIndex]); + WriteBool('general', 'MinimizeOnStart', cbOptionMinimizeOnStart.Checked); + WriteBool('general', 'MinimizeToTray', cbOptionMinimizeToTray.Checked); + WriteBool('general', 'DeleteCompletedTasksOnClose', cbOptionDeleteCompletedTasksOnClose.Checked); + WriteInteger('general', 'LetFMDDo', cbOptionLetFMDDo.ItemIndex); + WriteString('general', 'ExternalProgramPath', edOptionExternalPath.Text); + WriteString('general', 'ExternalProgramParams', edOptionExternalParams.Text); + WriteBool('general', 'ChapterListHideDownloaded', miChapterListHideDownloaded.Checked); + WriteBool('general', 'AddAsStopped', cbAddAsStopped.Checked); + WriteBool('general', 'HighlightNewManga', miHighlightNewManga.Checked); + WriteBool('general', 'HighlightDownloadedChapters', miChapterListHighlight.Checked); + + // view + WriteBool('view', 'ShowDownloadsToolbar', cbOptionShowDownloadToolbar.Checked); + WriteBool('view', 'ShowDownloadsToolbarLeft', cbOptionShowDownloadToolbarLeft.Checked); + WriteBool('view', 'ShowDownloadsToolbarDeleteAll', cbOptionShowDownloadToolbarDeleteAll.Checked); + WriteBool('view', 'LoadMangaCover', cbOptionEnableLoadCover.Checked); + WriteBool('view', 'ShowBalloonHint', cbOptionShowBalloonHint.Checked); + if not (isExiting and Assigned(FormDropTarget)) then + SaveDropTargetFormInformation; + + // connections + WriteInteger('connections', 'NumberOfTasks', seOptionMaxParallel.Value); + WriteInteger('connections', 'NumberOfThreadsPerTask', seOptionMaxThread.Value); + WriteInteger('connections', 'Retry', seOptionMaxRetry.Value); + WriteInteger('connections', 'ConnectionTimeout', seOptionConnectionTimeout.Value); + WriteInteger('connections', 'NumberOfAutoRetryFailedTask', seOptionRetryFailedTask.Value); + WriteBool('connections', 'AlwaysRetruFailedChaptersOnStart', ckOptionsAlwaysStartTaskFromFailedChapters.Checked); + + // proxy + WriteBool('connections', 'UseProxy', cbOptionUseProxy.Checked); + WriteString('connections', 'ProxyType', cbOptionProxyType.Text); + WriteString('connections', 'Host', edOptionHost.Text); + WriteString('connections', 'Pass', edOptionPass.Text); + WriteString('connections', 'Port', edOptionPort.Text); + WriteString('connections', 'User', edOptionUser.Text); + + // saveto + if Trim(edOptionDefaultPath.Text) = '' then + edOptionDefaultPath.Text := DEFAULT_PATH; + WriteString('saveto', 'SaveTo', edOptionDefaultPath.Text); + WriteBool('saveto', 'ChangeUnicodeCharacter', cbOptionChangeUnicodeCharacter.Checked); + WriteString('saveto', 'ChangeUnicodeCharacterStr', edOptionChangeUnicodeCharacterStr.Text); + WriteBool('saveto', 'GenerateMangaFolder', cbOptionGenerateMangaFolder.Checked); + if Trim(edOptionMangaCustomRename.Text) = '' then + edOptionMangaCustomRename.Text := DEFAULT_MANGA_CUSTOMRENAME; + WriteString('saveto', 'MangaCustomRename', edOptionMangaCustomRename.Text); + WriteInteger('saveto', 'Compress', rgOptionCompress.ItemIndex); + WriteInteger('saveto', 'PDFQuality', seOptionPDFQuality.Value); + WriteBool('saveto', 'RemoveMangaNameFromChapter', cbOptionRemoveMangaNameFromChapter.Checked); + WriteBool('saveto', 'GenerateChapterFolder', cbOptionGenerateChapterFolder.Checked); + if Trim(edOptionChapterCustomRename.Text) = '' then + edOptionChapterCustomRename.Text := DEFAULT_CHAPTER_CUSTOMRENAME; + WriteString('saveto', 'ChapterCustomRename', edOptionChapterCustomRename.Text); + WriteBool('saveto', 'ConvertDigitVolume', cbOptionDigitVolume.Checked); + WriteBool('saveto', 'ConvertDigitChapter', cbOptionDigitChapter.Checked); + WriteInteger('saveto', 'DigitVolumeLength', seOptionDigitVolume.Value); + WriteInteger('saveto', 'DigitChapterLength', seOptionDigitChapter.Value); + if Trim(edOptionFilenameCustomRename.Text) = '' then + edOptionFilenameCustomRename.Text := DEFAULT_FILENAME_CUSTOMRENAME; + WriteString('saveto', 'FilenameCustomRename', edOptionFilenameCustomRename.Text); + WriteBool('saveto', 'PNGSaveAsJPEG', ckPNGSaveAsJPEG.Checked); + WriteInteger('saveto', 'ConvertWebP', cbWebPSaveAs.ItemIndex); + WriteInteger('saveto', 'PNGCompressionLevel', cbPNGCompressionLevel.ItemIndex); + WriteInteger('saveto', 'JPEGQuality', seJPEGQuality.Value); + + // update + WriteBool('update', 'AutoCheckLatestVersion', cbOptionAutoCheckLatestVersion.Checked); + WriteBool('update', 'AutoCheckFavStartup', cbOptionAutoCheckFavStartup.Checked); + WriteBool('update', 'AutoOpenFavStartup', cbOptionAutoOpenFavStartup.Checked); + WriteBool('update', 'AutoCheckFavInterval', cbOptionAutoCheckFavInterval.Checked); + WriteInteger('update', 'AutoCheckFavIntervalMinutes', seOptionAutoCheckFavIntervalMinutes.Value); + WriteInteger('update', 'NewMangaTime', seOptionNewMangaTime.Value); + WriteBool('update', 'AutoCheckFavAutoDownload', cbOptionAutoCheckFavDownload.Checked); + WriteBool('update', 'AutoCheckFavAutoRemoveCompletedManga', cbOptionAutoCheckFavRemoveCompletedManga.Checked); + WriteBool('update', 'UpdateListNoMangaInfo', cbOptionUpdateListNoMangaInfo.Checked); + WriteBool('update', 'UpdateListRemoveDuplicateLocalData', cbOptionUpdateListRemoveDuplicateLocalData.Checked); + + // modules updater + WriteBool('modulesupdater', 'ShowUpdateWarning', LuaModulesUpdaterForm.ckShowUpdateWarning.Checked); + WriteBool('modulesupdater', 'AutoRestart', LuaModulesUpdaterForm.ckAutoRestart.Checked); + + // dialogs + WriteBool('dialogs', 'ShowQuitDialog', cbOptionShowQuitDialog.Checked); + WriteBool('dialogs', 'ShowDeleteDldTaskDialog', cbOptionShowDeleteTaskDialog.Checked); + WriteBool('dialogs', 'ShowDownloadMangalistDialog', cbOptionShowDownloadMangalistDialog.Checked); + + // misc + frmCustomColor.SaveToIniFile(configfile); + WriteBool('logger', 'Enabled', ckEnableLogging.Checked); + if edLogFileName.Text = '' then + edLogFileName.Text := DEFAULT_LOG_FILE; + WriteString('logger', 'LogFileName', edLogFileName.Text); + finally + UpdateFile; + end; + Modules.SaveToFile; end; -procedure TMainForm.AddSilentThread(URL: string); +procedure TMainForm.ApplyOptions; var - mt: TMetaDataType; i: Integer; - webid: Cardinal; - website, - webs, - link: String; - regx: TRegExpr; + isStillHaveCurrentWebsite: Boolean; + node: PVirtualNode; begin - website := ''; - webs := ''; - link := ''; - regx := TRegExpr.Create; try - regx.Expression := '^https?\://'; - if not (regx.Exec(URL)) then - URL := 'http://' + URL; - - regx.Expression := '^https?\:(//[^/]*\w+\.\w+)(\:\d+)?(/|\Z)(.*)$'; - if regx.Exec(URL) then + // general + // selected websites + cbSelectManga.Clear; + node := vtOptionMangaSiteSelection.GetFirstChecked(); + while node<>nil do begin - link := regx.Replace(URL, '$4', True); - webs := regx.Replace(URL, '$1', True); + cbSelectManga.Items.Add(PSingleItem(vtOptionMangaSiteSelection.GetNodeData(node))^.Text); + node := vtOptionMangaSiteSelection.GetNextChecked(node); end; - if (webs <> '') and (link <> '') then + isStillHaveCurrentWebsite := False; + for i := 0 to cbSelectManga.Items.Count - 1 do begin - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - if Pos(webs, WebsiteRoots[i, 1]) > 0 then - begin - webid := i; - website := WebsiteRoots[i, 0]; - Break; - end; - if website = '' then - begin - webs := TrimLeftChar(webs, ['/']); - for i := Low(WebsiteRoots) to High(WebsiteRoots) do - begin - if Pos(webs, WebsiteRoots[i, 1]) > 0 then - begin - webid := i; - website := WebsiteRoots[i, 0]; - Break; - end; - end; - end; - if website <> '' then + if cbSelectManga.Items[i] = currentWebsite then begin - link := '/' + link; - URL := FixURL(WebsiteRoots[webid, 1] + link); - DisableAddToFavorites(website); + cbSelectManga.ItemIndex := i; + isStillHaveCurrentWebsite := True; + Break; end; end; - finally - regx.Free; - end; - if (website = '') or (link = '') then Exit; - if rgDropTargetMode.ItemIndex = 0 then - mt := MD_DownloadAll - else - mt := MD_AddToFavorites; - if (mt = MD_AddToFavorites) and (SitesWithoutFavorites(website)) then Exit; - SilentThreadManager.Add(mt, website, '', link); -end; - -procedure TMainForm.AddTextToInfo(title, infoText: String); -var - fp: TFontParams; - cp, np: Integer; - fn: String; -begin - infoText := Trim(infoText); - if infoText <> '' then - with rmInformation do + if not isStillHaveCurrentWebsite then begin - if Trim(Lines.Text) <> '' then - Lines.Add(''); - SelStart := UTF8Length(Lines.Text); - cp := SelStart; - GetTextAttributes(cp, fp); - fn := rmInformation.Font.Name; - fp.Style := [fsBold, fsUnderline]; - fp.Name := fn; - Inc(fp.Size); - Lines.Add(title); - SelStart := UTF8Length(Lines.Text); - np := SelStart; - SetTextAttributes(cp, np - cp, fp); - if title = RS_InfoSummary then - infoText := Trim(StringBreaks(infoText)); - Lines.Add(infoText); - fp.Style := []; - fp.Name := fn; - Dec(fp.Size); - SetTextAttributes(np, UTF8Length(Lines.Text) - np, fp); + if cbSelectManga.Items.Count > 0 then + begin + cbSelectManga.ItemIndex := 0; + cbSelectMangaEditingDone(cbSelectManga); + end + else + begin + cbSelectManga.ItemIndex := -1; + cbSelectManga.Text := ''; + currentWebsite := ''; + vtMangaList.Clear; + lbMode.Caption := Format(RS_ModeAll, [0]); + end; end; -end; - -procedure TMainForm.ShowInformation(const title, website, link: String); -var - i: Integer; -begin - pcMain.ActivePage := tsInformation; - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := options.ReadString('saveto', 'SaveTo', DEFAULT_PATH); - if Trim(edSaveTo.Text) = '' then - edSaveTo.Text := DEFAULT_PATH; - edSaveTo.Text := CorrectPathSys(edSaveTo.Text); - - with rmInformation do - begin - imCover.Picture.Assign(nil); - Clear; - - if (GetInfosThread <> nil) and - ((GetInfosThread.MangaListPos > -1) or (GetInfosThread.MangaListPos = -2)) then + //FMDInstace + if cbOptionOneInstanceOnly.Checked then begin - mangaInfo.title := title; - mangaInfo.link := link; + if FMDInstance = nil then + begin + FMDInstance := TSimpleIPCServer.Create(Self); + FMDInstance.ServerID := FMD_INSTANCE; + FMDInstance.Global := True; + FMDInstance.OnMessage := @FMDInstanceReceiveMsg; + FMDInstance.StartServer; + end; end else - edURL.Text := mangaInfo.url; - - AddTextToInfo(RS_InfoTitle, mangaInfo.title + LineEnding); - AddTextToInfo(RS_InfoAuthors, mangaInfo.authors + LineEnding); - AddTextToInfo(RS_InfoArtists, mangaInfo.artists + LineEnding); - AddTextToInfo(RS_InfoGenres, mangaInfo.genres + LineEnding); - i := StrToIntDef(mangaInfo.status, -1); - if (i > -1) and (i < cbFilterStatus.Items.Count) then - AddTextToInfo(RS_InfoStatus, cbFilterStatus.Items[i]); - AddTextToInfo(RS_InfoSummary, mangaInfo.summary); - CaretPos := Point(0, 0); - end; - SetLength(ChapterList, mangaInfo.chapterName.Count); - for i := 0 to mangaInfo.chapterName.Count - 1 do - begin - ChapterList[i].Title := mangaInfo.chapterName[i]; - ChapterList[i].Link := mangaInfo.chapterLinks[i]; - ChapterList[i].Downloaded := False; - end; - if miChapterListHighlight.Checked then - DLManager.GetDownloadedChaptersState(mangaInfo.website + mangaInfo.link, - ChapterList) - else - ClearChapterListState; - UpdateVtChapter; + begin + if FMDInstance <> nil then + begin + FMDInstance.StopServer; + FreeAndNil(FMDInstance); + end; + end; + OptionLetFMDDo := TFMDDo(cbOptionLetFMDDo.ItemIndex); + OptionEnableLoadCover := cbOptionEnableLoadCover.Checked; + OptionDeleteCompletedTasksOnClose := cbOptionDeleteCompletedTasksOnClose.Checked; - btDownload.Enabled := (clbChapterList.RootNodeCount > 0); - btReadOnline.Enabled := (mangaInfo.link <> ''); - btAddToFavorites.Enabled := not SitesWithoutFavorites(website); + //view + ToolBarDownload.Visible := cbOptionShowDownloadToolbar.Checked; + ToolBarDownloadLeft.Visible := cbOptionShowDownloadToolbarLeft.Checked; + tbDownloadDeleteCompleted.Visible := cbOptionShowDownloadToolbarDeleteAll.Checked; + tbSeparator1.Visible := tbDownloadDeleteCompleted.Visible; + ShowDropTarget(ckDropTarget.Checked); + OptionShowBalloonHint := cbOptionShowBalloonHint.Checked; + + //connection + OptionMaxParallel := seOptionMaxParallel.Value; + OptionMaxThreads := seOptionMaxThread.Value; + OptionMaxRetry := seOptionMaxRetry.Value; + DLManager.RetryConnect := OptionMaxRetry; + SetDefaultRetryCountAndApply(OptionMaxRetry); + OptionConnectionTimeout := seOptionConnectionTimeout.Value; + SetDefaultTimeoutAndApply(OptionConnectionTimeout * 1000); + OptionRetryFailedTask := seOptionRetryFailedTask.Value; + OptionAlwaysStartTaskFromFailedChapters := ckOptionsAlwaysStartTaskFromFailedChapters.Checked; + + // proxy + if cbOptionUseProxy.Checked then + SetDefaultProxyAndApply(cbOptionProxyType.Text, edOptionHost.Text, + edOptionPort.Text, edOptionUser.Text, edOptionPass.Text) + else + SetDefaultProxyAndApply('', '', '' ,'', ''); - //check if manga already in FavoriteManager list - if btAddToFavorites.Enabled and (FavoriteManager.Count > 0) then - btAddToFavorites.Enabled := not FavoriteManager.IsMangaExist(mangaInfo.title, website); -end; + //saveto + OptionPDFQuality := seOptionPDFQuality.Value; + DLManager.CompressType := rgOptionCompress.ItemIndex; + OptionChangeUnicodeCharacter := cbOptionChangeUnicodeCharacter.Checked; + OptionChangeUnicodeCharacterStr := edOptionChangeUnicodeCharacterStr.Text; + OptionRemoveMangaNameFromChapter := cbOptionRemoveMangaNameFromChapter.Checked; + OptionGenerateMangaFolder := cbOptionGenerateMangaFolder.Checked; + OptionMangaCustomRename := edOptionMangaCustomRename.Text; + OptionGenerateChapterFolder := cbOptionGenerateChapterFolder.Checked; + OptionChapterCustomRename := edOptionChapterCustomRename.Text; + OptionFilenameCustomRename := edOptionFilenameCustomRename.Text; + OptionConvertDigitVolume := cbOptionDigitVolume.Checked; + OptionConvertDigitVolumeLength := seOptionDigitVolume.Value; + OptionConvertDigitChapter := cbOptionDigitChapter.Checked; + OptionConvertDigitChapterLength := seOptionDigitChapter.Value; + OptionPNGSaveAsJPEG := ckPNGSaveAsJPEG.Checked; + OptionWebPSaveAs := cbWebPSaveAs.ItemIndex; + OptionPNGCompressionLevel := cbPNGCompressionLevel.ItemIndex; + OptionJPEGQuality := seJPEGQuality.Value; + + //update + OptionAutoCheckLatestVersion := cbOptionAutoCheckLatestVersion.Checked; + OptionAutoCheckFavStartup := cbOptionAutoCheckFavStartup.Checked; + OptionAutoCheckFavInterval := cbOptionAutoCheckFavInterval.Checked; + OptionAutoCheckFavIntervalMinutes := seOptionAutoCheckFavIntervalMinutes.Value; + OptionNewMangaTime := seOptionNewMangaTime.Value; + OptionJDNNewMangaTime := currentJDN - OptionNewMangaTime; + OptionAutoCheckFavDownload := cbOptionAutoCheckFavDownload.Checked; + OptionAutoCheckFavRemoveCompletedManga := cbOptionAutoCheckFavRemoveCompletedManga.Checked; + OptionUpdateListNoMangaInfo := cbOptionUpdateListNoMangaInfo.Checked; + OptionUpdateListRemoveDuplicateLocalData := cbOptionUpdateListRemoveDuplicateLocalData.Checked; + tmCheckFavorites.Interval := OptionAutoCheckFavIntervalMinutes * 60000; + tmCheckFavorites.Enabled := OptionAutoCheckFavInterval; -procedure TMainForm.RunGetList; -begin - if (MessageDlg('', RS_DlgUpdaterWantToUpdateDB, mtInformation, [mbYes, mbNo], 0) = - mrYes) and - (not isUpdating) then - begin - isUpdating := True; - updateDB := TUpdateDBThread.Create; - updateDB.websiteName := cbSelectManga.Items[cbSelectManga.ItemIndex]; - updateDB.Start; - end; -end; + // modules updater + OptionModulesUpdaterShowUpdateWarning := LuaModulesUpdaterForm.ckShowUpdateWarning.Checked; + OptionModulesUpdaterAutoRestart := LuaModulesUpdaterForm.ckAutoRestart.Checked; -procedure TMainForm.LoadOptions; -var - i: Integer; -begin - // general - cbOptionOneInstanceOnly.Checked := - options.ReadBool('general', 'OneInstanceOnly', True); - //FMDInstance - if cbOptionOneInstanceOnly.Checked then - begin - if FMDInstance = nil then + //misc + frmCustomColor.Apply; + SimpleException.SetLogFileName(edLogFileName.Text); + + if ckEnableLogging.Checked and (not Logger.Enabled) then begin - FMDInstance := TSimpleIPCServer.Create(Self); - FMDInstance.ServerID := FMD_INSTANCE; - FMDInstance.Global := True; - FMDInstance.OnMessage := @FMDInstanceReceiveMsg; - FMDInstance.StartServer; - end; - end - else - begin - if FMDInstance <> nil then + Logger.Enabled := True; + if MainExceptionHandler.LogFileOK then + begin + FileLogger := TFileChannel.Create(edLogFileName.Text, [fcoShowHeader, fcoShowPrefix, fcoShowTime]); + Logger.Channels.Add(FileLogger); + end + else + Logger.SendError('Log file error ' + MainExceptionHandler.LogFileStatus + '"' + edLogFileName.Text + '"'); + Logger.Send(QuotedStrd(Application.Title)+' started with [PID:'+IntToStr(GetProcessID)+'] [HANDLE:'+IntToStr(GetCurrentProcess)+']'); + Logger.SendStrings('Application info', SimpleException.GetApplicationInfo); + end + else + if (not ckEnableLogging.Checked) and (Logger.Enabled) then begin - FMDInstance.StopServer; - FreeAndNil(FMDInstance); + if Assigned(FileLogger) then + begin + Logger.Channels.Remove(FileLogger); + FreeAndNil(FileLogger); + end; + Logger.Enabled := False; end; - end; - cbOptionLiveSearch.Checked := options.ReadBool('general', 'LiveSearch', True); - cbOptionMinimizeToTray.Checked := options.ReadBool('general', 'MinimizeToTray', False); - OptionEnableLoadCover := options.ReadBool('general', 'LoadMangaCover', True); - cbOptionEnableLoadCover.Checked := OptionEnableLoadCover; - cbOptionLetFMDDo.ItemIndex := options.ReadInteger('general', 'LetFMDDo', 0); - OptionLetFMDDo := TFMDDo(cbOptionLetFMDDo.ItemIndex); - cbOptionAutoNumberChapter.Checked := - options.ReadBool('general', 'AutoNumberChapter', True); - edOptionExternalPath.FileName := options.ReadString('general', 'ExternalProgramPath', ''); - edOptionExternalParams.Text := options.ReadString('general', 'ExternalProgramParams', DEFAULT_EXPARAM); - OptionAutoNumberChapterChecked := cbOptionAutoNumberChapter.Checked; - cbAddAsStopped.Checked := options.ReadBool('general', 'AddAsStopped', False); - - // view - frmDropTarget.FWidth := options.ReadInteger('droptarget', 'Width', - frmDropTarget.FWidth); - frmDropTarget.FHeight := options.ReadInteger('droptarget', 'Heigth', - frmDropTarget.FHeight); - frmDropTarget.FTop := options.ReadInteger('droptarget', 'Top', - frmDropTarget.FTop); - frmDropTarget.FLeft := options.ReadInteger('droptarget', 'Left', - frmDropTarget.FLeft); - rgDropTargetMode.ItemIndex := options.ReadInteger('droptarget', 'Mode', 0); - tbDropTargetOpacity.Position := options.ReadInteger('droptarget', 'Opacity', 255); - ckDropTarget.Checked := options.ReadBool('droptarget', 'Show', False); - cbOptionShowDownloadToolbar.Checked := options.ReadBool('view', 'ShowDownloadsToolbar', True); - ToolBarDownload.Visible := cbOptionShowDownloadToolbar.Checked; - - // connection - seOptionMaxParallel.Value := options.ReadInteger('connections', 'NumberOfTasks', 1); - seOptionMaxThread.Value := options.ReadInteger('connections', 'NumberOfThreadsPerTask', 1); - seOptionMaxRetry.Value := options.ReadInteger('connections', 'Retry', 3);; - DLManager.maxDLTasks := seOptionMaxParallel.Value; - DLManager.maxDLThreadsPerTask := seOptionMaxThread.Value; - DLManager.retryConnect := seOptionMaxRetry.Value; - seOptionConnectionTimeout.Value := options.ReadInteger('connections', 'ConnectionTimeout', 15); - OptionConnectionTimeout := seOptionConnectionTimeout.Value*1000; - - // saveto - DLManager.compress := options.ReadInteger('saveto', 'Compress', 0); - cbOptionPathConvert.Checked := options.ReadBool('saveto', 'PathConv', False); - cbOptionGenerateChapterName.Checked := - options.ReadBool('saveto', 'GenChapName', False); - cbOptionGenerateMangaFolderName.Checked := - options.ReadBool('saveto', 'GenMangaName', True); - cbOptionAutoNumberChapter.Checked := - options.ReadBool('saveto', 'AutoNumberChapter', True); - seOptionPDFQuality.Value := options.ReadInteger('saveto', 'PDFQuality', 100); - OptionPDFQuality := seOptionPDFQuality.Value; - edOptionCustomRename.Text := - options.ReadString('saveto', 'CustomRename', DEFAULT_CUSTOM_RENAME); - if Trim(edOptionCustomRename.Text) = '' then - edOptionCustomRename.Text := DEFAULT_CUSTOM_RENAME; - OptionCustomRename := edOptionCustomRename.Text; - if options.ReadBool('connections', 'UseProxy', False) then - begin - ProxyType := options.ReadString('connections', 'ProxyType', 'HTTP'); - Host := options.ReadString('connections', 'Host', ''); - Pass := options.ReadString('connections', 'Pass', ''); - Port := options.ReadString('connections', 'Port', ''); - User := options.ReadString('connections', 'User', ''); - end; - - // update - cbOptionAutoCheckUpdate.Checked := - options.ReadBool('update', 'AutoCheckUpdate', True); - cbOptionAutoRemoveCompletedManga.Checked := - options.ReadBool('update', 'AutoRemoveCompletedManga', False); - OptionAutoRemoveCompletedManga := cbOptionAutoRemoveCompletedManga.Checked; - cbOptionAutoCheckFavStartup.Checked := - options.ReadBool('update', 'AutoCheckFavStartup', True); - OptionAutoCheckFavStartup := cbOptionAutoCheckFavStartup.Checked; - seOptionCheckMinutes.Value := options.ReadInteger('update', 'AutoCheckMinutes', 60); - lbOptionAutoCheckMinutes.Caption := Format(RS_LblAutoCheckNewChapterMinute, - [seOptionCheckMinutes.Value]); - OptionCheckMinutes := seOptionCheckMinutes.Value; - cbOptionUpdateListNoMangaInfo.Checked := - options.ReadBool('update', 'UpdateListNoMangaInfo', False); - OptionUpdateListNoMangaInfo := cbOptionUpdateListNoMangaInfo.Checked; - cbOptionUpdateListRemoveDuplicateLocalData.Checked := - options.ReadBool('update', 'UpdateListRemoveDuplicateLocalData', False); - OptionUpdateListRemoveDuplicateLocalData := cbOptionUpdateListRemoveDuplicateLocalData.Checked; - - // misc - cbOptionShowBatotoSG.Checked := options.ReadBool('misc', 'ShowBatotoSG', True); - OptionShowBatotoSG := cbOptionShowBatotoSG.Checked; - cbOptionShowAllLang.Checked := options.ReadBool('misc', 'ShowAllLang', False); - OptionShowAllLang := cbOptionShowAllLang.Checked; - cbOptionAutoDlFav.Checked := options.ReadBool('misc', 'AutoDlFav', False); - OptionAutoDlFav := cbOptionAutoDlFav.Checked; - - vtFavorites.Header.SortColumn := options.ReadInteger('misc', 'SortFavoritesColumn', 1); - FavoriteManager.sortDirection := options.ReadBool('misc', 'SortFavoritesDirection', False); - - vtDownload.Header.SortColumn := options.ReadInteger('misc', 'SortDownloadColumn', 0); - DLManager.SortDirection := options.ReadBool('misc', 'SortDownloadDirection', False); - vtDownload.Header.SortDirection := TSortDirection(DLManager.SortDirection); - vtFavorites.Header.SortDirection := TSortDirection(FavoriteManager.sortDirection); - if OptionCheckMinutes = 0 then - itCheckForChapters.Enabled := False - else - begin - itCheckForChapters.Interval := OptionCheckMinutes * 60000; - itCheckForChapters.Enabled := True; + //languages + ApplyLanguage; + except + on E: Exception do + ExceptionHandle(Self, E); end; - - cbOptionDigitVolume.Checked := options.ReadBool('saveto', 'ConvertDigitVolume', True); - seOptionDigitVolume.Value := options.ReadInteger('saveto', 'DigitVolumeLength', 2); - seOptionDigitVolume.Enabled := cbOptionDigitVolume.Checked; - cbOptionDigitChapter.Checked := - options.ReadBool('saveto', 'ConvertDigitChapter', True); - seOptionDigitChapter.Value := options.ReadInteger('saveto', 'DigitChapterLength', 3); - seOptionDigitChapter.Enabled := cbOptionDigitChapter.Checked; - - cbOptionMangaFoxRemoveWatermarks.Checked := - options.ReadBool('misc', 'MangafoxRemoveWatermarks', False); - - cbLanguages.Items.Clear; - uTranslation.CollectLanguagesFiles; - if uTranslation.AvailableLanguages.Count > 0 then - for i := 0 to AvailableLanguages.Count - 1 do - cbLanguages.Items.Add(uTranslation.AvailableLanguages.ValueFromIndex[i]); - - cbLanguages.ItemIndex := uTranslation.AvailableLanguages.IndexOfName( - options.ReadString('languages', 'Selected', 'en')); end; procedure TMainForm.LoadMangaOptions; var - isDeleteUnusedManga: Boolean; - i, j, sel: Integer; - lang: TStringList; - s, currentLanguage: String; - ANode, currentRootNode: PVirtualNode; - Data: PMangaListItem; - wName, wLang: TStringList; -begin - wName := TStringList.Create; - wLang := TStringList.Create; - lang := TStringList.Create; + categories: TStringList; + categoriesitem: TStringList; + i, j: Integer; + s: String; + module: TModuleContainer; + node: PVirtualNode; + nodei: PVirtualNode; + data: PSingleItem; +begin + categories := TStringList.Create; try - mangalistIni.ReadSection('available', lang); - if lang.Count > 0 then - for i := 0 to lang.Count - 1 do - begin - s := mangalistIni.ReadString('available', lang[i], ''); - ExtractParam(wName, s, ',', False); - while wlang.Count < wName.Count do - wLang.Add(lang[i]); - end; - - // load to option list - if wName.Count > 0 then + // sort all + categories.OwnsObjects := True; + categories.Duplicates := dupIgnore; + categories.Sorted := True; + for i := 0 to categories.Count - 1 do begin - SetLength(optionMangaSiteSelectionNodes, wName.Count); - currentLanguage := ''; - for i := 0 to wName.Count - 1 do - with vtOptionMangaSiteSelection do - begin - if currentLanguage <> wLang[i] then - begin - currentLanguage := wLang[i]; - currentRootNode := AddChild(nil); - Data := GetNodeData(currentRootNode); - Data^.Text := currentLanguage; - ValidateNode(currentRootNode, False); - end; - ANode := AddChild(currentRootNode); - ANode^.CheckState := csUncheckedNormal; - Data := GetNodeData(ANode); - Data^.Text := wName[i]; - ValidateNode(ANode, False); - optionMangaSiteSelectionNodes[i] := ANode; - end; + categoriesitem := TStringList(categories.Objects[i]); + categoriesitem.Duplicates := dupIgnore; + categoriesitem.Sorted := True; end; - // load selected manga list - lang.Clear; - s := options.ReadString('general', 'MangaListSelect', DEFAULT_LIST); - if Pos(SEPERATOR, s) <> 0 then - ExtractParam(lang, s, SEPERATOR, False) - else - ExtractParam(lang, s, ',', False); - cbSelectManga.Items.Assign(lang); - - // remove unused manga name - i := 0; - if (lang.Count > 0) and (Length(optionMangaSiteSelectionNodes) > 0) then - while i < lang.Count do + // read websitemodules + for i := 0 to WebsiteModules.Modules.Count - 1 do + begin + module := WebsiteModules.Modules[i]; + if module.Category <> '' then begin - isDeleteUnusedManga := True; - for j := 0 to Length(optionMangaSiteSelectionNodes) - 1 do + j := categories.IndexOf(module.Category); + if j = -1 then begin - Data := vtOptionMangaSiteSelection.GetNodeData( - optionMangaSiteSelectionNodes[j]); - if lang[i] = Data^.Text then - begin - isDeleteUnusedManga := False; - Break; - end; - end; - if isDeleteUnusedManga then - lang.Delete(i) + categoriesitem := TStringList.Create; + categories.AddObject(module.Category, categoriesitem); + categoriesitem.Duplicates := dupIgnore; + categoriesitem.Sorted := True; + end else - Inc(i); + categoriesitem := TStringList(categories.Objects[j]); + categoriesitem.Add(module.Website); end; + end; - // load last selected manga - if cbSelectManga.Items.Count > 0 then + // add them to vt websites selection and availablewebsites + vtOptionMangaSiteSelection.BeginUpdate; + for i := 0 to categories.Count - 1 do begin - sel := options.ReadInteger('form', 'SelectManga', 0); - if sel < 0 then - sel := 0; - if sel > cbSelectManga.Items.Count - 1 then - sel := cbSelectManga.Items.Count - 1; - cbSelectManga.ItemIndex := sel; - currentWebsite := cbSelectManga.Items.Strings[cbSelectManga.ItemIndex]; - dataProcess.website := cbSelectManga.Items.Strings[cbSelectManga.ItemIndex]; + node := vtOptionMangaSiteSelection.AddChild(nil, nil); + vtOptionMangaSiteSelection.ValidateNode(node, False); + data := vtOptionMangaSiteSelection.GetNodeData(node); + data^.Text := categories[i]; + categoriesitem := TStringList(categories.Objects[i]); + for j := 0 to categoriesitem.Count - 1 do + begin + s := categoriesitem[j]; + nodei := vtOptionMangaSiteSelection.AddChild(node, nil); + vtOptionMangaSiteSelection.ValidateNode(nodei, False); + nodei^.CheckType := ctCheckBox; + data := vtOptionMangaSiteSelection.GetNodeData(nodei); + data^.Text := s; + AvailableWebsites.Add(s); + end; end; + vtOptionMangaSiteSelection.EndUpdate; + AvailableWebsites.Duplicates := dupIgnore; + AvailableWebsites.Sorted := True; finally - lang.Free; - wName.Free; - wLang.Free; + categories.Free; end; -end; -function TMainForm.SaveMangaOptions: String; -var - i: Cardinal; - Data: PMangaListItem; -begin - Result := ''; - if Length(optionMangaSiteSelectionNodes) > 0 then - for i := 0 to Length(optionMangaSiteSelectionNodes) - 1 do + // load selected websites + s := configfile.ReadString('general', 'MangaListSelect', DEFAULT_SELECTED_WEBSITES); + if Pos(SEPERATOR, s) <> 0 then + ExtractParam(cbSelectManga.Items, s, SEPERATOR, False) + else + ExtractParam(cbSelectManga.Items, s, ',', False); + + // remove missing websites from selected websites + for i := cbSelectManga.Items.Count - 1 downto 0 do + begin + if not AvailableWebsites.Find(cbSelectManga.Items[i], j) then + cbSelectManga.Items.Delete(i); + end; + + // set checked vt websites selection + for i := 0 to cbSelectManga.Items.Count - 1 do + begin + node := vtOptionMangaSiteSelection.GetFirst(); + while node <> nil do begin - if optionMangaSiteSelectionNodes[i]^.CheckState = csCheckedNormal then + if node^.ChildCount = 0 then begin - Data := vtOptionMangaSiteSelection.GetNodeData(optionMangaSiteSelectionNodes[i]); - if Result = '' then - Result := Data^.Text - else - Result := Result + ',' + Data^.Text; + data := vtOptionMangaSiteSelection.GetNodeData(node); + if cbSelectManga.Items[i] = data^.Text then + begin + node^.CheckState := csCheckedNormal; + Break; + end; end; + node := vtOptionMangaSiteSelection.GetNext(node); end; + end; + + // load last selected webssite + if cbSelectManga.Items.Count > 0 then + begin + i := configfile.ReadInteger('form', 'SelectManga', 0); + if i < 0 then + i := 0; + if i > cbSelectManga.Items.Count - 1 then + i := cbSelectManga.Items.Count - 1; + cbSelectManga.ItemIndex := i; + currentWebsite := cbSelectManga.Items[cbSelectManga.ItemIndex]; + end; end; -procedure TMainForm.edSearchChange(Sender: TObject); +procedure TMainForm.edMangaListSearchChange(Sender: TObject); begin - if (upcase(edSearch.Text) = LastSearchStr) and (currentWebsite = LastSearchWeb) then - Exit; - if edSearch.Text = '' then + if edMangaListSearch.Tag = -1 then begin - LastSearchStr := ''; - //Screen.Cursor := crHourGlass; - DataProcess.searchPos.Clear; - vtMangaList.OnInitNode := @vtMangaListInitNode; - vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; - //Screen.Cursor := crDefault; + edMangaListSearch.Tag := 0; + LastSearchWeb := currentWebsite; + LastSearchStr := UpCase(edMangaListSearch.Text); + Exit; + end; + if (not cbOptionLiveSearch.Checked) and (edMangaListSearch.Tag = 0) then Exit; + if edMangaListSearch.Tag <> 0 then + edMangaListSearch.Tag := 0; + if (upcase(edMangaListSearch.Text) = LastSearchStr) and (currentWebsite = LastSearchWeb) then Exit; + + SearchDataDB(edMangaListSearch.Text); + + //vtMangaList.Clear; + //dataProcess.Search(edMangaListSearch.Text); + //vtMangaList.RootNodeCount := dataProcess.RecordCount; + //if dataProcess.Filtered then + // lbMode.Caption := Format(RS_ModeFiltered, [vtMangaList.RootNodeCount]) + //else + // lbMode.Caption := Format(RS_ModeAll, [vtMangaList.RootNodeCount]); +end; + +procedure TMainForm.edMangaListSearchKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + if Key = VK_RETURN then + begin + edMangaListSearch.Tag := 1; + edMangaListSearchChange(edMangaListSearch); end else - if cbOptionLiveSearch.Checked then - begin - LastSearchWeb := currentWebsite; - LastSearchStr := upcase(edSearch.Text); - DataProcess.Search(edSearch.Text); - vtMangaList.Clear; - vtMangaList.OnInitNode := @vtMangaListInitSearchNode; - vtMangaList.RootNodeCount := dataProcess.searchPos.Count; - end; + if edMangaListSearch.Tag <> 0 then + edMangaListSearch.Tag := 0; +end; + +procedure TMainForm.edOptionDefaultPathButtonClick(Sender: TObject); +begin + with TSelectDirectoryDialog.Create(nil) do + try + InitialDir := edOptionDefaultPath.Text; + if Execute then + edOptionDefaultPath.Text := FileName; + finally + Free; + end; +end; + +procedure TMainForm.edOptionExternalPathButtonClick(Sender: TObject); +begin + with TOpenDialog.Create(nil) do + try + InitialDir := ExtractFileDir(edOptionExternalPath.Text); + if Execute then + edOptionExternalPath.Text := FileName; + finally + Free; + end; +end; + +procedure TMainForm.edSaveToButtonClick(Sender: TObject); +begin + with TSelectDirectoryDialog.Create(nil) do + try + InitialDir := edSaveTo.Text; + if Execute then + edSaveTo.Text := FileName; + finally + Free; + end; end; -procedure TMainForm.edSearchKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); +procedure TMainForm.edURLButtonClick(Sender: TObject); +var + i: Integer; + website, + host, + link: String; begin - if ((upcase(edSearch.Text) = LastSearchStr) and (currentWebsite = LastSearchWeb)) or - cbOptionLiveSearch.Checked then + btDownload.Enabled := False; + btDownloadSplit.Enabled := btDownload.Enabled; + btAddToFavorites.Enabled := False; + btReadOnline.Enabled := False; + + website := ''; + SplitURL(edURL.Text, @host, @link); + + if (host <> '') and (link <> '') then + begin + host := LowerCase(host); + i := Modules.LocateModuleByHost(host); + if i <> -1 then + website := Modules.Module[i].Website; + end; + + if (website = '') or (link = '') then + begin + tmAnimateMangaInfo.Enabled := False; + pbWait.Visible := False; + MessageDlg('', RS_DlgURLNotSupport, mtInformation, [mbYes], 0); Exit; + end; - if Key = VK_RETURN then + ViewMangaInfo(link, website, '', '', edURL); +end; + +procedure TMainForm.edURLKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (ssCtrl in Shift) and (ssShift in Shift) then begin - LastSearchStr := upcase(edSearch.Text); - if edSearch.Text = '' then - begin - Screen.Cursor := crHourGlass; - DataProcess.searchPos.Clear; - vtMangaList.OnInitNode := @vtMangaListInitNode; - vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.filterPos.Count; - Screen.Cursor := crDefault; - end + if Key = VK_V then + medURLPasteandgoClick(medURLPasteandgo) else - begin - Screen.Cursor := crHourGlass; - LastSearchWeb := currentWebsite; - DataProcess.Search(edSearch.Text); - vtMangaList.OnInitNode := @vtMangaListInitSearchNode; - vtMangaList.Clear; - vtMangaList.RootNodeCount := dataProcess.searchPos.Count; - Screen.Cursor := crDefault; - end; + if Key = VK_C then + Clipboard.AsText := edURL.Text; + Key := 0; end; end; procedure TMainForm.UpdateVtChapter; begin - clbChapterList.Clear; - clbChapterList.RootNodeCount := Length(ChapterList); + if clbChapterList.RootNodeCount = Length(ChapterList) then + clbChapterList.Repaint + else + begin + clbChapterList.BeginUpdate; + clbChapterList.RootNodeCount := Length(ChapterList); + clbChapterList.EndUpdate; + end; end; procedure TMainForm.UpdateVtDownload; begin - //vtDownload.Clear; - vtDownload.RootNodeCount := DLManager.Count; - // the reason we put vtDownloadFilters in here instead of in DLManager because - // the size of download list can change while this method is running - vtDownloadFilters; + vtDownloadUpdateFilters; end; procedure TMainForm.UpdateVtFavorites; begin - vtFavorites.Clear; - vtFavorites.RootNodeCount := FavoriteManager.Count; + if vtFavorites.RootNodeCount = FavoriteManager.Items.Count then + vtFavorites.Repaint + else + begin + vtFavorites.BeginUpdate; + vtFavorites.RootNodeCount := FavoriteManager.Count; + vtFavorites.EndUpdate; + end; +end; + +procedure TMainForm.UpdateVtMangaListFilterStatus; +begin + if dataProcess.Filtered then + lbMode.Caption := Format(RS_ModeFiltered, [dataProcess.RecordCount]) + else + lbMode.Caption := Format(RS_ModeAll, [dataProcess.RecordCount]); end; procedure TMainForm.LoadFormInformation; + + procedure restorevt(const vt: VirtualTrees.TVirtualStringTree; const name: String); + var + i: Integer; + begin + with configfile, vt.Header do + begin + SortColumn := ReadInteger(name, 'SortColumn', SortColumn); + SortDirection := TSortDirection(ReadInteger(name, 'SortDirection', Integer(SortDirection))); + for i := 0 to Columns.Count - 1 do + begin + Columns[i].Width := ReadInteger(name, 'Column' + IntToStr(i) + 'Width', Columns[i].Width); + Columns[i].Position := ReadInteger(name, 'Column' + IntToStr(i) + 'Position', Columns[i].Position); + end; + end; + end; + begin - pcLeft.Width := options.ReadInteger('form', 'MainSplitter', 195); - sbMain.Panels[0].Width := pcLeft.Width + 4; + with configfile do + begin + psDownloads.Position := ReadInteger('form', 'DownloadsSplitter', psDownloads.Position); + psInfo.Position := ReadInteger('form', 'MangaInfoSplitter', psInfo.Position); + + if ReadBool('update', 'AutoCheckFavStartup', True) and ReadBool('update', 'AutoOpenFavStartup', False) then + pcMain.ActivePage := tsFavorites + else + pcMain.PageIndex := ReadInteger('form', 'pcMainPageIndex', 0); + + Left := ReadInteger('form', 'MainFormLeft', Left); + Top := ReadInteger('form', 'MainFormTop', Top); + Width := ReadInteger('form', 'MainFormWidth', Width); + Height := ReadInteger('form', 'MainFormHeight', Height); + + if Screen.PixelsPerInch > 96 then begin + Width := ScaleScreenTo96(Width); + Height := ScaleScreenTo96(Height); + psDownloads.Position := ScaleScreenTo96(psDownloads.Position); + psInfo.Position := ScaleScreenTo96(psInfo.Position); + end; - pcMain.PageIndex := options.ReadInteger('form', 'pcMainPageIndex', 0); + if ReadBool('form', 'MainFormMaximized', False) then + PrevWindowState := wsMaximized + else + PrevWindowState := wsNormal; + WindowState := PrevWindowState; - Left := options.ReadInteger('form', 'MainFormLeft', MainForm.Left); - Top := options.ReadInteger('form', 'MainFormTop', MainForm.Top); - Width := options.ReadInteger('form', 'MainFormWidth', 640); - Height := options.ReadInteger('form', 'MainFormHeight', 480); + ToolBarDownload.Visible := ReadBool('view', 'ShowDownloadsToolbar', True); + ToolBarDownloadLeft.Visible := ReadBool('view', 'ShowDownloadsToolbarLeft', True); + tbDownloadDeleteCompleted.Visible := ReadBool('view', 'ShowDownloadsToolbarDeleteAll', False); - if options.ReadBool('form', 'MainFormMaximized', False) then - PrevWindowState := wsMaximized - else - PrevWindowState := wsNormal; - WindowState := PrevWindowState; - - vtDownload.Header.Columns.Items[0].Width := - options.ReadInteger('form', 'vtDownload0Width', 50); - vtDownload.Header.Columns.Items[1].Width := - options.ReadInteger('form', 'vtDownload1Width', 50); - vtDownload.Header.Columns.Items[2].Width := - options.ReadInteger('form', 'vtDownload2Width', 50); - vtDownload.Header.Columns.Items[3].Width := - options.ReadInteger('form', 'vtDownload3Width', 50); - vtDownload.Header.Columns.Items[4].Width := - options.ReadInteger('form', 'vtDownload4Width', 50); - vtDownload.Header.Columns.Items[5].Width := - options.ReadInteger('form', 'vtDownload5Width', 50); - - vtFavorites.Header.Columns.Items[0].Width := - options.ReadInteger('form', 'vtFavorites0Width', 50); - vtFavorites.Header.Columns.Items[1].Width := - options.ReadInteger('form', 'vtFavorites1Width', 50); - vtFavorites.Header.Columns.Items[2].Width := - options.ReadInteger('form', 'vtFavorites2Width', 50); - vtFavorites.Header.Columns.Items[3].Width := - options.ReadInteger('form', 'vtFavorites3Width', 50); - vtFavorites.Header.Columns.Items[4].Width := - options.ReadInteger('form', 'vtFavorites4Width', 50); + restorevt(vtDownload, 'vtDownload'); + DLManager.SortColumn := vtDownload.Header.SortColumn; + DLManager.SortDirection := Boolean(vtDownload.Header.SortDirection); + + restorevt(vtFavorites, 'vtFavorites'); + FavoriteManager.SortColumn := vtFavorites.Header.SortColumn; + FavoriteManager.SortDirection := Boolean(vtFavorites.Header.SortDirection); + + // lua website modules list + restorevt(LuaModulesUpdaterForm.vtLuaModulesRepos, 'vtLuaModulesRepos'); + LuaModulesUpdaterForm.SortList; + + // account + restorevt(AccountManagerForm.vtAccountList, 'vtAccountList'); + AccountManagerForm.SortList; + end; end; procedure TMainForm.SaveFormInformation; + + procedure savevt(const vt: VirtualTrees.TVirtualStringTree; const name: String); + var + i: Integer; + begin + with configfile, vt.Header do + begin + WriteInteger(name, 'SortColumn', SortColumn); + WriteInteger(name, 'SortDirection', Integer(SortDirection)); + for i := 0 to Columns.Count - 1 do + begin + WriteInteger(name, 'Column' + IntToStr(i) + 'Width', Columns[i].Width); + WriteInteger(name, 'Column' + IntToStr(i) + 'Position', Columns[i].Position); + end; + end; + end; + begin - options.WriteInteger('form', 'MainSplitter', pcLeft.Width); - options.WriteInteger('form', 'pcMainPageIndex', pcMain.PageIndex); - - options.WriteInteger('form', 'vtDownload0Width', - vtDownload.Header.Columns.Items[0].Width); - options.WriteInteger('form', 'vtDownload1Width', - vtDownload.Header.Columns.Items[1].Width); - options.WriteInteger('form', 'vtDownload2Width', - vtDownload.Header.Columns.Items[2].Width); - options.WriteInteger('form', 'vtDownload3Width', - vtDownload.Header.Columns.Items[3].Width); - options.WriteInteger('form', 'vtDownload4Width', - vtDownload.Header.Columns.Items[4].Width); - options.WriteInteger('form', 'vtDownload5Width', - vtDownload.Header.Columns.Items[5].Width); - - options.WriteInteger('form', 'vtFavorites0Width', - vtFavorites.Header.Columns.Items[0].Width); - options.WriteInteger('form', 'vtFavorites1Width', - vtFavorites.Header.Columns.Items[1].Width); - options.WriteInteger('form', 'vtFavorites2Width', - vtFavorites.Header.Columns.Items[2].Width); - options.WriteInteger('form', 'vtFavorites3Width', - vtFavorites.Header.Columns.Items[3].Width); - options.WriteInteger('form', 'vtFavorites4Width', - vtFavorites.Header.Columns.Items[4].Width); - options.WriteInteger('form', 'SelectManga', cbSelectManga.ItemIndex); - - options.WriteBool('form', 'MainFormMaximized', (WindowState = wsMaximized)); - if WindowState = wsMaximized then - WindowState := wsNormal; - options.WriteInteger('form', 'MainFormLeft', Left); - options.WriteInteger('form', 'MainFormTop', Top); - options.WriteInteger('form', 'MainFormWidth', Width); - options.WriteInteger('form', 'MainFormHeight', Height); + with configfile do + begin + WriteInteger('form', 'DownloadsSplitter', psDownloads.Position); + WriteInteger('form', 'MangaInfoSplitter', psInfo.Position); + WriteInteger('form', 'pcMainPageIndex', pcMain.PageIndex); + WriteInteger('form', 'SelectManga', cbSelectManga.ItemIndex); + WriteBool('form', 'MainFormMaximized', (WindowState = wsMaximized)); + if WindowState = wsMaximized then + WindowState := wsNormal; + WriteInteger('form', 'MainFormLeft', Left); + WriteInteger('form', 'MainFormTop', Top); + WriteInteger('form', 'MainFormWidth', Width); + WriteInteger('form', 'MainFormHeight', Height); + + savevt(vtDownload, 'vtDownload'); + savevt(vtFavorites, 'vtFavorites'); + + // lua website modules list + savevt(LuaModulesUpdaterForm.vtLuaModulesRepos, 'vtLuaModulesRepos'); + + // account + savevt(AccountManagerForm.vtAccountList, 'vtAccountList'); + end; +end; + +procedure TMainForm.ShowDropTarget(const AShow: Boolean); +begin + ckDropTarget.Checked := AShow; + configfile.WriteBool('droptarget', 'Show', AShow); + if AShow then + begin + if FormDropTarget = nil then + Application.CreateForm(TFormDropTarget, FormDropTarget); + frmDropTarget.OnDropChekout := @AddSilentThread; + frmDropTarget.FAlphaBlendValue := tbDropTargetOpacity.Position; + FormDropTarget.Show; + end + else + begin + if Assigned(FormDropTarget) then + FormDropTarget.Close; + end; end; procedure TMainForm.SaveDropTargetFormInformation; begin - with options do + with configfile do begin + WriteBool('droptarget', 'Show', ckDropTarget.Checked); + WriteInteger('droptarget', 'Mode', rgDropTargetMode.ItemIndex); WriteInteger('droptarget', 'Opacity', frmDropTarget.FAlphaBlendValue); WriteInteger('droptarget', 'Width', frmDropTarget.FWidth); WriteInteger('droptarget', 'Heigth', frmDropTarget.FHeight); WriteInteger('droptarget', 'Top', frmDropTarget.FTop); WriteInteger('droptarget', 'Left', frmDropTarget.FLeft); - UpdateFile; end; end; -procedure TMainForm.LoadLanguage; +procedure TMainForm.CollectLanguagesFromFiles; +var + i: Integer; +begin + cbLanguages.Items.Clear; + SimpleTranslator.LangDir := FMD_DIRECTORY + 'languages'; + SimpleTranslator.LangAppName := 'fmd'; + SimpleTranslator.CollectLanguagesFiles; + if SimpleTranslator.AvailableLanguages.Count > 0 then + begin + for i := 0 to AvailableLanguages.Count - 1 do + cbLanguages.Items.Add(SimpleTranslator.AvailableLanguages.ValueFromIndex[i]); + cbLanguages.ItemIndex := SimpleTranslator.AvailableLanguages.IndexOfName( + configfile.ReadString('languages', 'Selected', 'en')); + end; +end; + +procedure TMainForm.ApplyLanguage; var + idxSelectManga, idxLanguages, idxFilterStatus, idxOptionLetFMDDo, idxOptionProxyType, - idxDropTargetMode: Integer; -begin - if uTranslation.LastSelected <> AvailableLanguages.Names[cbLanguages.ItemIndex] then + idxDropTargetMode, + idxOptionCompress, + idxOptionWebPConvertTo, + idxOptionWebPPNGLevel: Integer; +begin + if AvailableLanguages.Count = 0 then Exit; + if cbLanguages.ItemIndex < 0 then Exit; + if cbLanguages.ItemIndex >= AvailableLanguages.Count then Exit; + if SimpleTranslator.LastSelected <> AvailableLanguages.Names[cbLanguages.ItemIndex] then begin + // TCombobox.Items will be cleared upon changing language, + // and ItemIndex will fall to -1 + // save TComboBox.ItemIndex + idxSelectManga:=cbSelectManga.ItemIndex; idxLanguages := cbLanguages.ItemIndex; idxFilterStatus := cbFilterStatus.ItemIndex; idxOptionLetFMDDo := cbOptionLetFMDDo.ItemIndex; idxOptionProxyType := cbOptionProxyType.ItemIndex; idxDropTargetMode := rgDropTargetMode.ItemIndex; - if uTranslation.SetLangByIndex(cbLanguages.ItemIndex) then + idxOptionCompress := rgOptionCompress.ItemIndex; + idxOptionWebPConvertTo := cbWebPSaveAs.ItemIndex; + idxOptionWebPPNGLevel := cbPNGCompressionLevel.ItemIndex; + if SimpleTranslator.SetLangByIndex(cbLanguages.ItemIndex) then begin + // assign new value lbOptionExternalParamsHint.Hint := Format(RS_LblOptionExternalParamsHint, [EXPARAM_PATH, EXPARAM_CHAPTER, EXPARAM_PATH, EXPARAM_CHAPTER]); + lbOptionPDFQualityHint.Hint:=lbOptionPDFQuality.Hint; cbFilterStatus.Items.Text := RS_FilterStatusItems; cbOptionLetFMDDo.Items.Text := RS_OptionFMDDoItems; rgDropTargetMode.Items.Text := RS_DropTargetModeItems; + rgOptionCompress.Items.Text := RS_OptionCompress; + cbWebPSaveAs.Items.Text := RS_WebPConvertTo; + cbPNGCompressionLevel.Items.Text := RS_WebPPNGLevel; + // restore ItemIndex + cbSelectManga.ItemIndex:=idxSelectManga; cbLanguages.ItemIndex := idxLanguages; cbFilterStatus.ItemIndex := idxFilterStatus; cbOptionLetFMDDo.ItemIndex := idxOptionLetFMDDo; cbOptionProxyType.ItemIndex := idxOptionProxyType; rgDropTargetMode.ItemIndex := idxDropTargetMode; + rgOptionCompress.ItemIndex := idxOptionCompress; + cbWebPSaveAs.ItemIndex := idxOptionWebPConvertTo; + cbPNGCompressionLevel.ItemIndex := idxOptionWebPPNGLevel; Self.Repaint; vtMangaList.Repaint; - tvDownloadFilterRepaint; + tvDownloadFilterRefresh(True); + + // refresh custom option + if not isStartup then + WebsiteOptionCustomForm.CreateWebsiteOption; + end; + end; +end; + +procedure TMainForm.OpenWithExternalProgramChapters(const Dir: String; + const Chapters: TStrings); + + function FindSupportedOutputExt(const Dir, Filename: String): String; + var + i: Integer; + ADir, SDir: String; + begin + Result := ''; + if Filename = '' then Exit; + ADir := CorrectPathSys(Dir); + if not DirectoryExistsUTF8(ADir) then Exit; + for i := Low(FMDSupportedOutputExt) to High(FMDSupportedOutputExt) do + begin + SDir := ChompPathDelim(CorrectPathSys(ADir + Filename)); + if FileExistsUTF8(SDir + FMDSupportedOutputExt[i]) then + begin + Result := GetLastDir(SDir) + FMDSupportedOutputExt[i]; + Break; + end; + end; + if Result = '' then + begin + ADir := CorrectPathSys(ADir + Filename); + if DirectoryExistsUTF8(ADir) then + Result := GetLastDir(ADir); end; end; + +var + ADir, AFilename: String; + i: Integer; + FindList: TStringList; + SearchRec: TSearchRec; +begin + if Dir = '' then Exit; + ADir := CorrectPathSys(Dir); + if Assigned(Chapters) then + if Chapters.Count > 0 then + for i := 0 to Chapters.Count - 1 do + begin + AFilename := FindSupportedOutputExt(ADir, Chapters[i]); + if AFilename <> '' then + Break; + end; + + if AFilename = '' then + try + FindList := TStringList.Create; + if FindFirstUTF8(ADir + '*', faAnyFile and faDirectory, SearchRec) = 0 then + repeat + FindList.Add(SearchRec.Name); + until FindNextUTF8(SearchRec) <> 0; + if FindList.Count >= 3 then + AFilename := FindList.Strings[2] + else + AFilename := ''; + FindCloseUTF8(SearchRec); + finally + FindList.Free; + end; + OpenWithExternalProgram(ADir, AFilename); end; -procedure TMainForm.OpenWithExternalProgram(const dirPath, Filename: String); +procedure TMainForm.OpenWithExternalProgram(const Dir, Filename: String); var - Exe, Params, - p, f: String; + ADir, AParam, Exe, Params: String; begin - Exe := Trim(options.ReadString('general', 'ExternalProgramPath', '')); - Params := Trim(options.ReadString('general', 'ExternalProgramParams', DEFAULT_EXPARAM)); + Exe := Trim(configfile.ReadString('general', 'ExternalProgramPath', '')); + Params := Trim(configfile.ReadString('general', 'ExternalProgramParams', DEFAULT_EXPARAM)); - p := Trim(TrimRightChar(Trim(dirPath), [PathDelim])); - f := Trim(TrimChar(Trim(Filename), [PathDelim])); + ADir := Trim(ChompPathDelim(CorrectPathSys(Dir))); + AParam := Trim(ChompPathDelim(Filename)); if Exe <> '' then begin if (Pos(EXPARAM_PATH + EXPARAM_CHAPTER, Params) <> 0) then - f := PathDelim + f; - Params := StringReplace(Params, EXPARAM_PATH, p, [rfIgnoreCase, rfReplaceAll]); - Params := StringReplace(Params, EXPARAM_CHAPTER, f, [rfIgnoreCase, rfReplaceAll]); + AParam := PathDelim + AParam; + Params := StringReplace(Params, EXPARAM_PATH, ADir, [rfIgnoreCase, rfReplaceAll]); + Params := StringReplace(Params, EXPARAM_CHAPTER, AParam, [rfIgnoreCase, rfReplaceAll]); RunExternalProcess(Exe, Params, True, False); end else begin - if (p <> '') and (f <> '') then - f := p + PathDelim + f; - OpenDocument(f); + if (ADir <> '') and (AParam <> '') then + AParam := ADir + PathDelim + AParam; + OpenDocument(AParam); end; end; @@ -4992,13 +5718,9 @@ procedure TMainForm.TransferRateGraphInit(xCount: Integer); i: Integer; begin TransferRateGraphList.Clear; - TransferRateGraphList.DataPoints.NameValueSeparator := '|'; TransferRateGraphArea.Legend.Format := FormatByteSize(0, True); - if xCount=0 then - TransferRateGraphInit - else - for i:=1 to xCount do - TransferRateGraphList.DataPoints.Add(IntToStr(i)+'|0|?|'); + for i:=1 to xCount do + TransferRateGraphList.DataPoints.Add(IntToStr(i)+'|0|?|'); end; procedure TMainForm.TransferRateGraphAddItem(TransferRate: Integer); @@ -5008,74 +5730,76 @@ procedure TMainForm.TransferRateGraphAddItem(TransferRate: Integer); TransferRateGraphArea.Legend.Format := FormatByteSize(TransferRate, True); with TransferRateGraphList.DataPoints do begin - if Count=0 then - TransferRateGraphInit; - for i := 0 to Count - 1 do - if i < Count - 1 then - Strings[i] := Format('%d|%s', [i+1, ValueFromIndex[i+1]]); - Strings[Count-1] := Format('%d|%d|?|',[Count,TransferRate]); + for i := 0 to Count - 2 do + Strings[i] := IntToStr(i+1)+'|'+ValueFromIndex[i+1]; + Strings[Count-1] := IntToStr(Count)+'|'+IntToStr(TransferRate)+'|?|'; end; end; +procedure TMainForm.DoExitWaitCounter; +begin + Logger.Send(Self.ClassName+', Execute exit counter'); + if isUpdating then begin + Logger.Send(Self.ClassName+', Update thread still exist, pending exit counter'); + isPendingExitCounter:=True + end + else tmExitCommand.Enabled:=True; +end; + procedure TMainForm.ExceptionHandler(Sender: TObject; E: Exception); begin - USimpleException.ExceptionHandle(Sender, E); + SimpleException.ExceptionHandle(Sender, E); end; procedure TMainForm.tmBackupTimer(Sender: TObject); begin if not DLManager.isRunningBackup then DLManager.Backup; + if not FavoriteManager.isRunning then + FavoriteManager.Backup; end; -procedure TMainForm.vtOptionMangaSiteSelectionChange(Sender : TBaseVirtualTree; - Node : PVirtualNode); -begin - vtOptionMangaSiteSelection.Refresh; -end; - -procedure TMainForm.vtOptionMangaSiteSelectionFocusChanged( - Sender : TBaseVirtualTree; Node : PVirtualNode; Column : TColumnIndex); +procedure TMainForm.vtMangaListInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + data: PMangaInfoData; begin - vtOptionMangaSiteSelection.Refresh; + data := Sender.GetNodeData(Node); + with data^ do + begin + link := dataProcess.Value[Node^.Index, DATA_PARAM_LINK]; + title := dataProcess.Value[Node^.Index, DATA_PARAM_TITLE]; + authors := dataProcess.Value[Node^.Index, DATA_PARAM_AUTHORS]; + artists := dataProcess.Value[Node^.Index, DATA_PARAM_ARTISTS]; + genres := dataProcess.Value[Node^.Index, DATA_PARAM_GENRES]; + status := dataProcess.Value[Node^.Index, DATA_PARAM_STATUS]; + numchapter := dataProcess.ValueInt[Node^.Index, DATA_PARAM_NUMCHAPTER]; + jdn := dataProcess.ValueInt[Node^.Index, DATA_PARAM_JDN]; + website := dataProcess.WebsiteName[Node^.Index]; + summary := dataProcess.Value[Node^.Index, DATA_PARAM_SUMMARY]; + titleformat := title + ' (' + IntToStr(numchapter) + ')'; + if dataProcess.FilterAllSites then + titleformat += ' [' + website + ']'; + end; end; procedure TMainForm.vtOptionMangaSiteSelectionFreeNode( Sender : TBaseVirtualTree; Node : PVirtualNode); -var - Data: PMangaListItem; begin - Data := vtOptionMangaSiteSelection.GetNodeData(Node); - if Assigned(Data) then - Finalize(Data^); + Finalize(PSingleItem(Sender.GetNodeData(Node))^); end; procedure TMainForm.vtOptionMangaSiteSelectionGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin - NodeDataSize := SizeOf(TMangaListItem); + NodeDataSize := SizeOf(TSingleItem); end; procedure TMainForm.vtOptionMangaSiteSelectionGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); -var - Data: PMangaListItem; -begin - Data := vtOptionMangaSiteSelection.GetNodeData(Node); - if Assigned(Data) then - CellText := Data^.Text; -end; - -procedure TMainForm.vtOptionMangaSiteSelectionInitNode(Sender: TBaseVirtualTree; - ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); -var - Level: Integer; begin - Level := vtOptionMangaSiteSelection.GetNodeLevel(Node); - if Level = 1 then - Node^.CheckType := ctCheckBox; - vtOptionMangaSiteSelection.ValidateNode(Node, False); + CellText := PSingleItem(vtOptionMangaSiteSelection.GetNodeData(Node))^.Text; end; end. diff --git a/mangadownloader/forms/frmNewChapter.lfm b/mangadownloader/forms/frmNewChapter.lfm index 301983f37..26f36a196 100644 --- a/mangadownloader/forms/frmNewChapter.lfm +++ b/mangadownloader/forms/frmNewChapter.lfm @@ -1,196 +1,200 @@ -object NewChapter: TNewChapter - Left = 486 - Height = 290 - Top = 239 - Width = 394 - BorderIcons = [] - BorderStyle = bsSizeToolWin - Caption = 'New Chapter Notification' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ClientHeight = 290 - ClientWidth = 394 - OnCreate = FormCreate - Position = poDesktopCenter - LCLVersion = '1.5' - object mmMemo: TMemo - Left = 6 - Height = 235 - Top = 17 - Width = 382 - Align = alClient - BorderSpacing.Bottom = 6 - ReadOnly = True - ScrollBars = ssAutoBoth - TabOrder = 0 - end - object lbNotification: TLabel - Left = 6 - Height = 1 - Top = 6 - Width = 382 - Align = alTop - BorderSpacing.Bottom = 10 - Font.Style = [fsBold] - ParentColor = False - ParentFont = False - end - object pnBottom: TPanel - Left = 6 - Height = 26 - Top = 258 - Width = 382 - Align = alBottom - AutoSize = True - BevelOuter = bvNone - ChildSizing.HorizontalSpacing = 6 - ClientHeight = 26 - ClientWidth = 382 - TabOrder = 1 - object btDownload: TBitBtn - Left = 0 - Height = 26 - Top = 0 - Width = 100 - Align = alLeft - AutoSize = True - Caption = '&Download' - Default = True - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000120000 - 002C0D0D0D581212128512121285121212851212128512121285121212851212 - 12851212128512121285121212850D0D0D580000002C00000012000000090000 - 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 - C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B - 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 - 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 - 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD - DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D - 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 - B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F - 4F005151510D5454545A54545467545454675454546754545467545454675454 - 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F - 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 - 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F - 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 - 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F - 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 - 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F - 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 - 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F - 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD - 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 - 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 - 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 - 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 - 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E - 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 - 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 - 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E - 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E - 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 - } - ModalResult = 1 - OnClick = btDownloadClick - TabOrder = 0 - end - object btQueue: TBitBtn - Left = 106 - Height = 26 - Top = 0 - Width = 118 - Align = alLeft - AutoSize = True - Caption = '&Add to queue' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000130000 - 002D002C6CA600277CCC00166BCC001569CC000955CC000041CC000546CC0011 - 55CC001F68CC04542EEB056112EE054E00AB00000013000000000000000A0000 - 00177F5D1977F5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 - C0BFE9D3BDC0349426F62BDF1AFF0C8000D10000000A0746000000000000654B - 180085631F70F5EAE0D299BBC7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E33F99 - 46F3269323F9359C26F63DE22CFF0E8C00CC0E8C00CC0E8D0099674E1B008967 - 23008967236CF5EAE0D276AFCBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F61F95 - 23FD52E741FF52E741FF52E741FF52E741FF52E741FF109500CC8B6925008B69 - 25008B69256AF8F0E9DCEAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BE61B2 - 47E634A61EF23BAC29F866EB55FF129D00CC129D00CC129C00998C6A26008C6A - 26008D6B27358D6B2769F1E3D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 - C0BFF1E2D3D31F9F04E175EE64FF14A400CC13A10000129D00008C6A26008C6A - 26008D6B27008E6C28348E6C2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3 - D5D28E6C286738980CAE15A900CC15A9009914A80000129D00008C6A26008C6A - 26008D6B27008E6C2800906E2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E - 2A65906E2A33528B140015AA000015A9000014A80000129D000094722E009472 - 2E0094722E0093712D00916F2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F - 2B63916F2B32747F2200359C0C0015A9000014A80000129D000094722E009472 - 2E0094722E0093712D3193712D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3 - D5D293712D6293712D3194722E0094722E0094722E0094722E0094722E009472 - 2E0094722E3094722E60F1E3D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3 - BBCEF1E2D3D394722E6094722E3094722E0094722E0094722E0095732F009573 - 2F0095732F5FF8F0E9DCCCCBC3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391 - AFF9C7C6BDCEF7EEE5DC95732F5F95732F0095732F0095732F00967430009674 - 30009674305DF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 - C0BFE9D3BDC0F3E7DBD29674305D967430009674300096743000977531009775 - 31009775315CF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 - C0BFE9D3BDC0F3E7DBD29775315C977531009775310097753100987632009876 - 32009876325BF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 - C0BFE9D3BDC0F3E7DBD29876325B9876320098763200987632001975BA001975 - BA001770B7900B56A4C6014296CC003F94CC002A80CC00166BCC021C70CB072D - 7DC80D4390C51259A3C1176CB290186FB500186FB500186FB500 - } - ModalResult = 4 - OnClick = btQueueClick - TabOrder = 2 - end - object btCancel: TBitBtn - Left = 300 - Height = 26 - Top = 0 - Width = 82 - Align = alRight - AutoSize = True - Caption = '&Cancel' - Glyph.Data = { - 36040000424D3604000000000000360000002800000010000000100000000100 - 2000000000000004000064000000640000000000000000000000000000090000 - 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 - 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 - 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 - 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 - 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 - D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 - 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 - D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 - 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 - B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 - 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA - EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 - 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 - E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 - 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 - E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 - 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC - DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 - 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB - DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 - 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF - FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 - A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F - D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 - A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B - E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 - A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D - F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 - A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 - AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF - FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 - } - ModalResult = 2 - OnClick = btCancelClick - TabOrder = 1 - end - end -end +object NewChapter: TNewChapter + Left = 486 + Height = 290 + Top = 239 + Width = 394 + BorderIcons = [] + BorderStyle = bsSizeToolWin + Caption = 'New Chapter Notification' + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 290 + ClientWidth = 394 + OnCreate = FormCreate + Position = poDesktopCenter + LCLVersion = '1.7' + Visible = False + object lbNotification: TLabel + Left = 8 + Height = 1 + Top = 8 + Width = 378 + Align = alTop + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object mmMemo: TMemo + Left = 8 + Height = 235 + Top = 15 + Width = 378 + Align = alClient + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 0 + end + object pnBottom: TPanel + Left = 8 + Height = 26 + Top = 256 + Width = 378 + Align = alBottom + AutoSize = True + BevelOuter = bvNone + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 4 + ClientHeight = 26 + ClientWidth = 378 + TabOrder = 1 + object btDownload: TBitBtn + Left = 0 + Height = 26 + Top = 0 + Width = 100 + Align = alLeft + AutoSize = True + Caption = '&Download' + Default = True + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000120000 + 002C0D0D0D581212128512121285121212851212128512121285121212851212 + 12851212128512121285121212850D0D0D580000002C00000012000000090000 + 00162A2A2A7AB3B3B3DFDBDBDBFFD6D7D7FFCDCFCFFFC7C8C8FFC4C4C4FFC5C4 + C4FFC9C4C4FFC6BBBBFFA59A9ADF2A2A2A7A0000001600000009000000002B2B + 2B0038383873E9E9E9FFB0B0B0FF858585FF7E7F7FFF787979FF787777FF7E77 + 77FF857777FF66FF66FFD7C8C8FF383838732B2B2B0000000000333333004343 + 43004343436EFAFAFAFFF8F8F8FFEFF0F0FFE7E8E8FFE0E1E1FFDDDDDDFFDEDD + DDFFE2DDDDFFD7CCCCFFE8D9D9FF4343436E43434300333333004D4D4D004D4D + 4D004D4D4D5DC3C3C3DAD1D1D1FFC8C9C9FFBEC0C0FFB6B7B7FFB3B3B3FFB4B3 + B3FFB9B3B3FFBFB3B3FFB5A9A9DA4D4D4D5D4D4D4D004D4D4D004F4F4F004F4F + 4F005151510D5454545A54545467545454675454546754545467545454675454 + 546754545467545454675454545A5151510D4F4F4F004F4F4F004F4F4F004F4F + 4F00515151005555550055555500555555006653410075502B1F75502B1F6653 + 4100555555005555550055555500515151004F4F4F004F4F4F004F4F4F004F4F + 4F0051515100555555006A5844008E561D009B50055CA95F07D3A95F06D39B50 + 055C8E561D006A58440055555500515151004F4F4F004F4F4F00855F3600855F + 3600866037009E662800AC611100A3580B5CB0670ED4FFC53AFFFFBD20FFB066 + 0DD4A3580B5CAC6111009E66280086603700855F3600855F3600BA6F1C00BA6F + 1C00BA6F1C00B76C1A00AD62125CB97117D4FECB4DFFFEB714FFFEB102FFFEC0 + 2CFFB86F15D4AD62125CB76C1A00BA6F1C00BA6F1C00BA6F1C00BA6F1C00BA6F + 1C00BA6F1C00B96E1B5CC27B23D5FAD171FFF9CC65FFF5B833FFF1A913FFF6BD + 3FFFF7C554FFC0781FD4B96E1B5CBA6F1C00BA6F1C00BA6F1C00BF752000BF75 + 2000BF752000C177218FC27822B8C27822B8C27822CCEEC26AFFDE9C2CFFC278 + 22CCC27822B8C27822B8C177218FBF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200C57A2400C87D2700CE832BCCF1CA83FFD89B4AFFCE83 + 2BCCC87D2700C57A2400C2782200BF752000BF752000BF752000BF752000BF75 + 2000BF752000C2782200CB802900D98E3300D98E33ABF9D591D5EEB367D5D98E + 33AAD98E3300CB802900C2782200BF752000BF752000BF752000D2872E00D287 + 2E00D2872E00D3892F00E2973A00E2973A00E2973A6AFCDC9884F5BF7385E297 + 3A6AE2973A00E2973A00D3892F00D2872E00D2872E00D2872E00E99E3F00E99E + 3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F33FFE39E40FED18540E99E + 3F33E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00E99E3F00 + } + ModalResult = 1 + OnClick = btDownloadClick + TabOrder = 0 + end + object btQueue: TBitBtn + Left = 106 + Height = 26 + Top = 0 + Width = 118 + Align = alLeft + AutoSize = True + Caption = '&Add to queue' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000130000 + 002D002C6CA600277CCC00166BCC001569CC000955CC000041CC000546CC0011 + 55CC001F68CC04542EEB056112EE054E00AB00000013000000000000000A0000 + 00177F5D1977F5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 + C0BFE9D3BDC0349426F62BDF1AFF0C8000D10000000A0746000000000000654B + 180085631F70F5EAE0D299BBC7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E33F99 + 46F3269323F9359C26F63DE22CFF0E8C00CC0E8C00CC0E8D0099674E1B008967 + 23008967236CF5EAE0D276AFCBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F61F95 + 23FD52E741FF52E741FF52E741FF52E741FF52E741FF109500CC8B6925008B69 + 25008B69256AF8F0E9DCEAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BE61B2 + 47E634A61EF23BAC29F866EB55FF129D00CC129D00CC129C00998C6A26008C6A + 26008D6B27358D6B2769F1E3D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 + C0BFF1E2D3D31F9F04E175EE64FF14A400CC13A10000129D00008C6A26008C6A + 26008D6B27008E6C28348E6C2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3 + D5D28E6C286738980CAE15A900CC15A9009914A80000129D00008C6A26008C6A + 26008D6B27008E6C2800906E2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E + 2A65906E2A33528B140015AA000015A9000014A80000129D000094722E009472 + 2E0094722E0093712D00916F2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F + 2B63916F2B32747F2200359C0C0015A9000014A80000129D000094722E009472 + 2E0094722E0093712D3193712D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3 + D5D293712D6293712D3194722E0094722E0094722E0094722E0094722E009472 + 2E0094722E3094722E60F1E3D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3 + BBCEF1E2D3D394722E6094722E3094722E0094722E0094722E0095732F009573 + 2F0095732F5FF8F0E9DCCCCBC3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391 + AFF9C7C6BDCEF7EEE5DC95732F5F95732F0095732F0095732F00967430009674 + 30009674305DF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 + C0BFE9D3BDC0F3E7DBD29674305D967430009674300096743000977531009775 + 31009775315CF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 + C0BFE9D3BDC0F3E7DBD29775315C977531009775310097753100987632009876 + 32009876325BF5EAE0D2EAD4BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5 + C0BFE9D3BDC0F3E7DBD29876325B9876320098763200987632001975BA001975 + BA001770B7900B56A4C6014296CC003F94CC002A80CC00166BCC021C70CB072D + 7DC80D4390C51259A3C1176CB290186FB500186FB500186FB500 + } + ModalResult = 4 + OnClick = btQueueClick + TabOrder = 1 + end + object btCancel: TBitBtn + Left = 296 + Height = 26 + Top = 0 + Width = 82 + Align = alRight + AutoSize = True + Caption = '&Cancel' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000090000 + 00160000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 001A0000001A0000001A0000001A0000001A0000001600000009000000120000 + 0E3300004A8300005DBC00005DCC00005DCC00005DCC00005DCC00005DCC0000 + 5DCC00005DCC00005DCC00005DBC00004A8300000E330000001200001D000000 + 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111 + D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D7300001D0000007D000000 + 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111 + D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBA00007D00000084000000 + 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111 + B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CC00008400000089000000 + 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA + EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CC0000890000008D000000 + 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6 + E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCC00008D00000092000000 + 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2 + E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CC00009200000096000000 + 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC + DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CC0000960000009A000000 + 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB + DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACC00009A0000009E000000 + 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF + FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECC00009E000000A2000000 + A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F + D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CC0000A2000000A5000000 + A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B + E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BA0000A5000000A8000000 + A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D + F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A8730000A8000000A8000000 + A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000 + AACC0000AACC0000AACC0000AABA0000AA730000A90C0000A800FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ModalResult = 2 + OnClick = btCancelClick + TabOrder = 2 + end + end +end diff --git a/mangadownloader/forms/frmNewChapter.lrj b/mangadownloader/forms/frmNewChapter.lrj new file mode 100644 index 000000000..745cd03e7 --- /dev/null +++ b/mangadownloader/forms/frmNewChapter.lrj @@ -0,0 +1,5 @@ +{"version":1,"strings":[ +{"hash":115679172,"name":"tnewchapter.btdownload.caption","sourcebytes":[38,68,111,119,110,108,111,97,100],"value":"&Download"}, +{"hash":184736549,"name":"tnewchapter.btqueue.caption","sourcebytes":[38,65,100,100,32,116,111,32,113,117,101,117,101],"value":"&Add to queue"}, +{"hash":177752476,"name":"tnewchapter.btcancel.caption","sourcebytes":[38,67,97,110,99,101,108],"value":"&Cancel"} +]} diff --git a/mangadownloader/forms/frmSelectDirectory.lfm b/mangadownloader/forms/frmSelectDirectory.lfm new file mode 100644 index 000000000..a9c5a2ef5 --- /dev/null +++ b/mangadownloader/forms/frmSelectDirectory.lfm @@ -0,0 +1,112 @@ +object SelectDirectoryForm: TSelectDirectoryForm + Left = 445 + Height = 70 + Top = 322 + Width = 320 + BorderIcons = [biSystemMenu] + Caption = 'Select directory' + ChildSizing.VerticalSpacing = 6 + ClientHeight = 70 + ClientWidth = 320 + Position = poMainFormCenter + LCLVersion = '1.9.0.0' + object dePath: TDirectoryEdit + Left = 8 + Height = 23 + Top = 8 + Width = 304 + ShowHidden = False + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000000000000000 + 0000002E45000064970000629300005E8E30005C8C7C00598792000000070028 + 3C00005B8900005B8900005B8900002E45000000000000000000000000000000 + 0000002E450000659950006497991C7AA9C052A5CDE0005B89C10000001A0028 + 3C07005B8900005B8900005B8900002E45000000000000000000000000110000 + 002400466A983590BDF269B8DDFA82CBECFF85CEEEFF005C8BEF005079C40050 + 79C4005D8CBE005D8CBE005D8CBE00466A980000002400000011000000090000 + 0012006699B288D0EFFF7FCAE9FF7FCAE9FF87D0EFFF267DA9FF7FBCDBFF7FBC + DBFF8DD1F3FF8DD1F3FF90D4F5FF006699B20042634D00000009000000000054 + 7E00006FA7A48AD3F0FF82CDEBFF82CDEBFF8AD3F0FF267EABFF7CB9D8FF7CB9 + D8FF8ACEF0FF8ACEF0FF8FD3F4FFF4B62EFF006FA7A400547E00005782000073 + AC000073AC9E8ED6F2FF87D0EDFF87D0EDFF8ED6F2FF2882AFFF7DBAD8FF7DBA + D8FF8BCFF1FF8BCFF1FF91D5F5FFFEC941FF0073AC9E0073AC000076B0000076 + B0000076B09B92DAF4FF8BD4F0FF8BD4F0FF92DAF4FF2B85B3FF7FBCDAFF7FBC + DAFF8DD1F3FF8DD1F3FF93D7F6FFEBEBDDFF0076B09B0076B0000078B4000078 + B4000078B49797DEF6FF90D8F2FF90D8F2FF97DEF6FF2D89B7FF80BDDCFF80BD + DCFF8FD3F5FF8FD3F5FF95D9F8FFF5F5EEFF0078B4970078B400007BB800007B + B800007BB8949BE1F7FF94DBF4FF94DBF4FF9BE1F7FF308DBCFF81BEDDFF81BE + DDFF90D4F6FF90D4F6FF97DBF9FFFEFEFDFF007BB894007BB800007DBB00007D + BB00007DBB909EE5F9FF98DFF6FF98DFF6FF9EE5F9FF3290C0FF83C0DFFF83C0 + DFFF92D6F8FF92D6F8FF99DDFAFF007DBB90007DBB33007CBA00007FBF00007F + BF00007FBF8DA3E8FBFF9DE3F9FF9DE3F9FFA3E8FBFF3594C5FF85C2E1FF85C2 + E1FF94D8FAFF94D8FAFF9BDFFCFF007FBF8D007FBE00007EBD000082C2000082 + C2000082C28AA6EBFCFFA1E6FBFFA1E6FBFFA6EBFCFF3C9DCFFF87C4E2FF87C4 + E2FF96DAFCFF96DAFCFF9EE2FDFF0082C28A0082C2000082C2000084C5000084 + C5000084C587A9EEFDFFA4E9FCFFA4E9FCFFAAEFFDFF42A1D1FF90D1F1FF96DA + FBFF97DBFDFF97DBFDFF9FE3FEFF0084C5870084C5000084C5000085C8000085 + C8000085C885ADF1FFFFABEFFEFF95E2F8FF6EC9EDFF48A9D9FF98DCFEFF98DC + FEFF98DCFEFF98DCFEFFA1E5FFFF0085C8850085C8000085C8000087CA000087 + CA000087CA8388DCF4FF60C0E9FF5FBFEAFF80D3F4FF9CE3FDFFA2E6FFFFA2E6 + FFFFA2E6FFFFA2E6FFFFA6EAFFFF0087CA830087CA000087CA000087CB000087 + CB000088CC610088CC810088CC810088CC810088CC810088CC810088CC810088 + CC810088CC810088CC810088CC810088CC610087CB000087CB00 + } + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + MaxLength = 0 + TabOrder = 0 + end + object btOK: TBitBtn + AnchorSideTop.Control = dePath + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = dePath + AnchorSideRight.Side = asrBottom + Left = 250 + Height = 26 + Top = 37 + Width = 62 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'OK' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00010000000800000010000000170000001A0000001900000017000000150000 + 00110000000D0000000A000000060000000300000001FFFFFF00FFFFFF000000 + 00020000000F0000001F0000002D02330066025F00CC012B0055000000290000 + 00220000001A000000130000000C0000000600000001FFFFFF00FFFFFF000000 + 0000000000000320000006570048077200CC16A60AE8087601C406570029021E + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000747 + 00000A6500000B8300480B8200CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85 + 001B0745000000000000000000000000000000000000FFFFFF00FFFFFF000E8D + 00000D8800480D8700CC43CA33F629C318FF39CC28FF28C217FF1EAA0FEA0D87 + 00AE0D8A00100F8F0000084A00000000000000000000FFFFFF00FFFFFF000E8E + 00480E8D00CC5FD94FF933BC22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA2 + 0FE40E8D009E0F8F00081094000010950000084B0000FFFFFF00FFFFFF000F92 + 00CC6DE55CFA59D048FF69E158FC0F9200CC0F92006D139504CB34B423F832B2 + 21FF1F9F0FDF0F92008C109400021095000010950000FFFFFF00FFFFFF001196 + 0048119700CC73EA62FD119700CC119600480F9300001196004C189D08D33DB6 + 2CFB37AF26FE1FA00EDA1197007B11980000129B0000FFFFFF00FFFFFF001197 + 0000129B0048129B00CC129B0048119700000F93000011970000129B006924AA + 13D857CF46FE55CD44FD21A710D6129C006313A00000FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000113A0 + 008533B820DE61D850FF5CD54BFA1EA80CD213A1004CFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000614A3009E43C631E56BE25AFF70E95FFB14A300CCFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000014A5001014A700B077EE66FF14A700CC14A70048FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000013A2000014A5000014A5000014A6 + 000015A8000015A9001F15AA00CC15AA004814A70000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/mangadownloader/forms/frmSelectDirectory.lrj b/mangadownloader/forms/frmSelectDirectory.lrj new file mode 100644 index 000000000..57a2ded3c --- /dev/null +++ b/mangadownloader/forms/frmSelectDirectory.lrj @@ -0,0 +1,4 @@ +{"version":1,"strings":[ +{"hash":51995065,"name":"tselectdirectoryform.caption","sourcebytes":[83,101,108,101,99,116,32,100,105,114,101,99,116,111,114,121],"value":"Select directory"}, +{"hash":1339,"name":"tselectdirectoryform.btok.caption","sourcebytes":[79,75],"value":"OK"} +]} diff --git a/mangadownloader/forms/frmSelectDirectory.pas b/mangadownloader/forms/frmSelectDirectory.pas new file mode 100644 index 000000000..b4b7aa598 --- /dev/null +++ b/mangadownloader/forms/frmSelectDirectory.pas @@ -0,0 +1,32 @@ +unit frmSelectDirectory; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn, + Buttons; + +type + + { TSelectDirectoryForm } + + TSelectDirectoryForm = class(TForm) + btOK: TBitBtn; + dePath: TDirectoryEdit; + private + + public + + end; + +var + SelectDirectoryForm: TSelectDirectoryForm; + +implementation + +{$R *.lfm} + +end. + diff --git a/mangadownloader/forms/frmShutdownCounter.lfm b/mangadownloader/forms/frmShutdownCounter.lfm index 20bcdcd76..63ee7e3d1 100644 --- a/mangadownloader/forms/frmShutdownCounter.lfm +++ b/mangadownloader/forms/frmShutdownCounter.lfm @@ -18,7 +18,8 @@ object ShutdownCounterForm: TShutdownCounterForm OnKeyDown = FormKeyDown OnShow = FormShow Position = poDesktopCenter - LCLVersion = '1.5' + LCLVersion = '1.7' + Visible = False object pnBottom: TPanel Left = 0 Height = 38 diff --git a/mangadownloader/forms/frmShutdownCounter.lrj b/mangadownloader/forms/frmShutdownCounter.lrj new file mode 100644 index 000000000..138413043 --- /dev/null +++ b/mangadownloader/forms/frmShutdownCounter.lrj @@ -0,0 +1,4 @@ +{"version":1,"strings":[ +{"hash":44537492,"name":"tshutdowncounterform.btabort.caption","sourcebytes":[38,65,98,111,114,116],"value":"&Abort"}, +{"hash":177511,"name":"tshutdowncounterform.btnow.caption","sourcebytes":[38,78,111,119],"value":"&Now"} +]} diff --git a/mangadownloader/forms/frmTransferFavorites.lfm b/mangadownloader/forms/frmTransferFavorites.lfm new file mode 100644 index 000000000..fe7833449 --- /dev/null +++ b/mangadownloader/forms/frmTransferFavorites.lfm @@ -0,0 +1,352 @@ +object TransferFavoritesForm: TTransferFavoritesForm + Left = 299 + Height = 490 + Top = 250 + Width = 490 + Caption = 'Transfer Favorites' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.HorizontalSpacing = 4 + ChildSizing.VerticalSpacing = 4 + ClientHeight = 490 + ClientWidth = 490 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + Position = poMainFormCenter + object cbWebsites: TComboBox + AnchorSideLeft.Control = lbTransferTo + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = lbTransferTo + AnchorSideTop.Side = asrCenter + Left = 66 + Height = 23 + Top = 8 + Width = 164 + AutoComplete = True + AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchAscending] + AutoDropDown = True + ItemHeight = 15 + OnEditingDone = cbWebsitesEditingDone + TabOrder = 0 + end + object lbTransferTo: TLabel + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + Left = 6 + Height = 15 + Top = 12 + Width = 56 + BorderSpacing.Top = 12 + Caption = 'Transfer to' + ParentColor = False + end + object vtFavs: TVirtualStringTree + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = rbAll + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = btOK + Left = 6 + Height = 373 + Top = 81 + Width = 478 + Anchors = [akTop, akLeft, akRight, akBottom] + Header.AutoSizeIndex = 0 + Header.Columns = < + item + Position = 0 + Width = 20 + end + item + Position = 1 + Text = 'Title' + Width = 300 + end + item + Position = 2 + Text = 'Website' + Width = 150 + end> + Header.DefaultHeight = 17 + Header.Height = 23 + Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] + Images = imgsState + TabOrder = 5 + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines] + TreeOptions.SelectionOptions = [toFullRowSelect] + WantTabs = True + OnFreeNode = vtFavsFreeNode + OnGetText = vtFavsGetText + OnGetImageIndex = vtFavsGetImageIndex + OnGetNodeDataSize = vtFavsGetNodeDataSize + end + object btOK: TBitBtn + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 422 + Height = 26 + Top = 458 + Width = 62 + Anchors = [akRight, akBottom] + AutoSize = True + Caption = 'OK' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00010000000800000010000000170000001A0000001900000017000000150000 + 00110000000D0000000A000000060000000300000001FFFFFF00FFFFFF000000 + 00020000000F0000001F0000002D02330066025F00CC012B0055000000290000 + 00220000001A000000130000000C0000000600000001FFFFFF00FFFFFF000000 + 0000000000000320000006570048077200CC16A60AE8087601C406570029021E + 00000000000000000000000000000000000000000000FFFFFF00FFFFFF000747 + 00000A6500000B8300480B8200CC2AC01BF424CD13FF1DB60EEF0C8301BB0C85 + 001B0745000000000000000000000000000000000000FFFFFF00FFFFFF000E8D + 00000D8800480D8700CC43CA33F629C318FF39CC28FF28C217FF1EAA0FEA0D87 + 00AE0D8A00100F8F0000084A00000000000000000000FFFFFF00FFFFFF000E8E + 00480E8D00CC5FD94FF933BC22FF50D040F80E8D00CC2AB21AF32CB81BFF1EA2 + 0FE40E8D009E0F8F00081094000010950000084B0000FFFFFF00FFFFFF000F92 + 00CC6DE55CFA59D048FF69E158FC0F9200CC0F92006D139504CB34B423F832B2 + 21FF1F9F0FDF0F92008C109400021095000010950000FFFFFF00FFFFFF001196 + 0048119700CC73EA62FD119700CC119600480F9300001196004C189D08D33DB6 + 2CFB37AF26FE1FA00EDA1197007B11980000129B0000FFFFFF00FFFFFF001197 + 0000129B0048129B00CC129B0048119700000F93000011970000129B006924AA + 13D857CF46FE55CD44FD21A710D6129C006313A00000FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000113A0 + 008533B820DE61D850FF5CD54BFA1EA80CD213A1004CFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000614A3009E43C631E56BE25AFF70E95FFB14A300CCFFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000011990000129F0000129F000013A2 + 000014A5001014A700B077EE66FF14A700CC14A70048FFFFFF00FFFFFF001197 + 0000129B0000129C0000129B00001197000013A2000014A5000014A5000014A6 + 000015A8000015A9001F15AA00CC15AA004814A70000FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btOKClick + TabOrder = 7 + end + object btCancel: TBitBtn + AnchorSideTop.Control = btOK + AnchorSideRight.Control = btOK + Left = 336 + Height = 26 + Top = 458 + Width = 82 + Anchors = [akTop, akRight] + AutoSize = True + Caption = 'Cancel' + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 000E00000013000000190000001900000016000000120000000F0000000E0000 + 0011000000150000001900000019000000140000000EFFFFFF00FFFFFF000000 + 001C000000260000346400005FCC00003561000000240000001D0000001B0000 + 00210000366000005FCC00003464000000270000001CFFFFFF00FFFFFF000000 + 1E0000005748000072CC1111D8FF000072CC0000574800002000000020000000 + 5748000072CC1111D8FF000072CC0000574800001E00FFFFFF00FFFFFF000000 + 8200000082CC1111D0FF1111D0FF1111D0FF000082CC00008348000083480000 + 82CC1111D0FF1111D0FF1111D0FF000082CC00008200FFFFFF00FFFFFF000000 + 860000008748000087CC1111C4FF1111C4FF1111C4FF000087CC000087CC1111 + C4FF1111C4FF1111C4FF000087CC0000874800008600FFFFFF00FFFFFF000000 + 86000000870000008C4800008DCC1111B8FF1111B8FF1111B8FF1111B8FF1111 + B8FF1111B8FF00008DCC00008C480000870000008600FFFFFF00FFFFFF000000 + 86000000870000008D0000009148000092CC1515AFFF1111ACFF1111ACFF1111 + ACFF000092CC0000914800008D000000870000008600FFFFFF00FFFFFF000000 + A1000000A00000009B0000009848000097CC2525B4FF1111A2FF1111A2FF1414 + A5FF000097CC0000984800009B000000A0000000A100FFFFFF00FFFFFF000000 + A1000000A00000009C4800009BCC5353DBFF2E2EB7FF3D3DC6FF3131BAFF1515 + 9FFF1E1EA8FF00009BCC00009C480000A0000000A100FFFFFF00FFFFFF000000 + A1000000A1480000A0CC6767EFFF3636BEFF5E5EE6FF0000A0CC0000A0CC4F4F + D7FF3636BEFF4545CDFF0000A0CC0000A1480000A100FFFFFF00FFFFFF000000 + A3000000A3CC7676FEFF4C4CD4FF7272FAFF0000A3CC0000A3480000A3480000 + A3CC6262EAFF4C4CD4FF5C5CE4FF0000A3CC0000A300FFFFFF00FFFFFF000000 + A6000000A7480000A7CC7777FFFF0000A7CC0000A7480000A3000000A3000000 + A7480000A7CC7070F8FF0000A7CC0000A7480000A600FFFFFF00FFFFFF000000 + A6000000A7000000AA480000AACC0000AA480000A7000000A3000000A3000000 + A7000000AA480000AACC0000AA480000A7000000A600FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + OnClick = btCancelClick + TabOrder = 6 + end + object rbAll: TRadioButton + AnchorSideLeft.Control = ckClearDownloadedChapters + AnchorSideTop.Control = ckClearDownloadedChapters + AnchorSideTop.Side = asrBottom + Left = 6 + Height = 19 + Top = 58 + Width = 34 + Caption = 'All' + Checked = True + OnChange = rbAllChange + TabOrder = 2 + TabStop = True + end + object rbValid: TRadioButton + AnchorSideLeft.Control = rbAll + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rbAll + Left = 48 + Height = 19 + Top = 58 + Width = 46 + BorderSpacing.Left = 8 + Caption = 'Valid' + OnChange = rbAllChange + TabOrder = 3 + end + object rbInvalid: TRadioButton + AnchorSideLeft.Control = rbValid + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = rbValid + Left = 102 + Height = 19 + Top = 58 + Width = 55 + BorderSpacing.Left = 8 + Caption = 'Invalid' + OnChange = rbAllChange + TabOrder = 4 + end + object ckClearDownloadedChapters: TCheckBox + AnchorSideLeft.Control = lbTransferTo + AnchorSideTop.Control = lbTransferTo + AnchorSideTop.Side = asrBottom + Left = 6 + Height = 19 + Top = 35 + Width = 299 + BorderSpacing.Top = 8 + Caption = 'Clear downloaded chapter list and reload from server' + Checked = True + State = cbChecked + TabOrder = 1 + end + object imgState: TImage + AnchorSideLeft.Control = cbWebsites + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = cbWebsites + AnchorSideTop.Side = asrCenter + Left = 234 + Height = 16 + Top = 11 + Width = 16 + end + object imgsState: TImageList + Left = 326 + Top = 32 + Bitmap = { + 4C690300000010000000100000001975BA001975BA001770B7900B56A4C60142 + 96CC003F94CC002A80CC00166BCC021C70CB072D7DC80D4390C51259A3C1176C + B290186FB500186FB500FFFFFF0098763200987632009876325BF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29876 + 325B9876320098763200FFFFFF0097753100977531009775315CF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29775 + 315C9775310097753100FFFFFF0096743000967430009674305DF5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD29674 + 305D9674300096743000FFFFFF0095732F0095732F0095732F5FF8F0E9DCCCCB + C3CE86BBD4FAB0D2E2FC629FBEF95492B0F95391AFF9C7C6BDCEF7EEE5DC9573 + 2F5F95732F0095732F00FFFFFF0094722E0094722E0094722E3094722E60F1E3 + D5D2DCDBD6D2B4D4E3FA69A3BFF65C96B1F6C4C3BBCEF1E2D3D394722E609472 + 2E3094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D319371 + 2D62F7EDE4D7E8EBEAE391B5C5E2D1CDC4C9F1E3D5D293712D6293712D319472 + 2E0094722E0094722E00FFFFFF0094722E0094722E0094722E0093712D00916F + 2B32916F2B63F9F2ECDBF0E1D1BDF4E7DBD1916F2B63916F2B3293712D009472 + 2E0094722E0094722E00FFFFFF008C6A26008C6A26008D6B27008E6C2800906E + 2A33906E2A65F9F2ECDBF0E1D1BDF4E7DBD1906E2A65906E2A338E6C28008D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27008E6C28348E6C + 2867F7EDE4D7F9F2ECDBF0E1D1BDEDDAC8BEF1E3D5D28E6C28678E6C28348D6B + 27008C6A26008C6A2600FFFFFF008C6A26008C6A26008D6B27358D6B2769F1E3 + D5D2F3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFF1E2D3D38D6B27698D6B + 27358C6A26008C6A2600FFFFFF008B6925008B6925008B69256AF8F0E9DCEAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F7EEE5DC8B69 + 256A8B6925008B692500FFFFFF00674E1B00896723008967236CF5EAE0D276AF + CBF68CBDD5F7B4D4E3FA69A3BFF65C96B1F65B95B0F66BA4BFF6F3E7DBD28967 + 236C89672300674E1B00FFFFFF0000000000654B180085631F70F5EAE0D299BB + C7E3ABCAD6E7CADEE6EF91B5C5E287AAB8E386A8B5E391B3BFE3F3E7DBD28563 + 1F70654B180000000000FFFFFF000000000A000000177F5D1977F5EAE0D2EAD4 + BFBFF3E5D8C8F9F2ECDBF0E1D1BDEDDAC8BEEAD5C0BFE9D3BDC0F3E7DBD27F5D + 1977000000170000000AFFFFFF00000000000000002D002C6CA600277CCC0016 + 6BCC001569CC000955CC000041CC000546CC001155CC001F68CC002E7CCC002B + 69A60000002E00000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0013A2000014A5000014A8000015A9 + 001A15AA006C15AA00A615AA00C415AA00C415AA00A615AA006C15A9001A14A8 + 000014A5000013A20000FFFFFF00FFFFFF0013A2000014A5000014A8004D1BAD + 08BF42C82FE35FDC4EF56BE35AFD6BE359FD5FDB4EF541C72EE31BAD07BF14A8 + 004D14A5000013A20000FFFFFF00FFFFFF0013A2000014A5004D21AF0ECD5FDA + 4EF663DA52FF5FD64EFF5FD64EFF5FD64EFF5FD64EFF62D951FF5DD94BF620AE + 0DCD14A5004D13A20000FFFFFF00FFFFFF0013A1001A1AA707BF5CD74BF658CF + 47FF57CE46FF57CE46FF57CE46FF57CE46FF57CE46FF4AC139FF52C941FF57D2 + 45F619A606BF13A1001AFFFFFF00FFFFFF00129E006C3DBF2CE354CB43FF4EC5 + 3DFF4EC53DFF4EC53DFF4EC53DFF4EC53DFF44BB33FFFFFFFFFFA7E29EFF52C9 + 41FF36B925E3129E006CFFFFFF00FFFFFF00119A00A751CB40F547BE36FF3EB5 + 2DFF47BE36FF41B930FF37AF26FF2DA41CFFE2E2E2FFE3E3E3FFE7E7E7FF269E + 15FF34B023F5119A00A7FFFFFF00FFFFFF00109600C453CB42FD3CB32BFFF8F8 + F8FF2DA81CFF23A212FF229F11FFDEDEDEFFE2E2E2FFE6E6E6FF229E11FF22A1 + 11FF2CAA1BFD109600C4FFFFFF00FFFFFF000F9200C450C83FFDA9D7A2FFD5D5 + D5FFEBEBEBFF22A511FFDEDEDEFFE2E2E2FFE6E6E6FF22A311FF22AA11FF22AA + 11FF28AE17FD0F9200C4FFFFFF00FFFFFF000E8D00A73BBD2BF523AE12FFD5D5 + D5FFDADADAFFDEDEDEFFE2E2E2FFE6E6E6FF22A811FF22B411FF22B411FF22B4 + 11FF21AF11F50E8D00A7FFFFFF00FFFFFF000D89006C22A813E326C015FF22AD + 11FFDEDEDEFFE2E2E2FFE6E6E6FF22AD11FF22BE11FF22BE11FF22BE11FF22BE + 11FF17A109E30D89006CFFFFFF00FFFFFF000C85001A0F8A03BF27C017F623C8 + 12FF22B211FFE6E6E6FF22B211FF22C811FF22C811FF22C811FF22C811FF1FBC + 0FF60D8902BF0C85001AFFFFFF00FFFFFF000B8300000B7F004D0E8804CD21C4 + 11F623D112FF22B611FF22D111FF22D111FF22D111FF22D111FF1EC20FF60D88 + 03CD0B7F004D0B830000FFFFFF00FFFFFF0000000000031F00000553004D0874 + 02BF139D08E31DC40EF521D411FD21D411FD1DC40EF5139D08E3087402BF0553 + 004D031F000000000000FFFFFF00FFFFFF0000000004000000170000002B011A + 004302440080025A00AB025D00C4025D00C4025A00AB02440080011A00430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000A2000000A5000000A8000000 + A91A0000AA6C0000AAA60000AAC40000AAC40000AAA60000AA6C0000A91A0000 + A8000000A5000000A200FFFFFF00FFFFFF000000A2000000A5000000A84D0909 + AEBF3737D0E35C5CEAF56A6AF3FD6969F2FD5B5BE9F53636CFE30909AEBF0000 + A84D0000A5000000A200FFFFFF00FFFFFF000000A2000000A54D1010B1CD5B5B + E8F65F5FE7FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5F5FE7FF5858E4F60F0F + B0CD0000A54D0000A200FFFFFF00FFFFFF000000A11A0808A8BF5656E2F65151 + D9FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FFFFFFFFFF5050D8FF4F4F + DCF60707A7BF0000A11AFFFFFF00FFFFFF0000009E6C3232C6E34949D1FFFFFF + FFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4747 + CFFF2A2ABDE300009E6CFFFFFF00FFFFFF0000009AA74747D3F53737BFFF2323 + ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDBDBFFDDDDDDFF11119BFF1616 + A0FF2727B4F500009AA7FFFFFF00FFFFFF00000096C44949D1FD3333BBFF2E2E + B8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDCDCFF11119EFF1111A1FF1111 + A1FF1D1DACFD000096C4FFFFFF00FFFFFF00000092C44444CDFD2626B5FF1414 + ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FF1111AAFF1111AAFF1111 + AAFF1818AFFD000092C4FFFFFF00FFFFFF0000008DA72E2EC0F51212B4FF1111 + B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6E6FFEAEAEAFF1111B4FF1111 + B4FF1212AFF500008DA7FFFFFF00FFFFFF000000896C1616AAE21616C1FFD1D1 + D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEAEAFFEEEEEEFFEEEEEEFF1111 + BEFF0909A1E30000896CFFFFFF00FFFFFF000000851A03038ABF1818C1F61212 + B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111B2FFEEEEEEFF1111B2FF0F0F + BCF6020289BF0000851AFFFFFF00FFFFFF000000830000007F4D040488CD1212 + C4F61212B6FF1111D1FF1111D1FF1111D1FF1111D1FF1111B6FF0F0FC2F60303 + 88CD00007F4D00008300FFFFFF00FFFFFF000000000000001F000000534D0202 + 74BF08089DE30E0EC4F51111D4FD1111D4FD0E0EC4F508089DE3020274BF0000 + 534D00001F0000000000FFFFFF00FFFFFF0000000004000000170000002B0000 + 1A430000448000005AAB00005DC400005DC400005AAB0000448000001A430000 + 002D0000001800000004FFFFFF00FFFFFF00000000020000000C000000160000 + 001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000 + 00170000000C00000002FFFFFF00 + } + end +end diff --git a/mangadownloader/forms/frmTransferFavorites.lrj b/mangadownloader/forms/frmTransferFavorites.lrj new file mode 100644 index 000000000..f2fd03e3f --- /dev/null +++ b/mangadownloader/forms/frmTransferFavorites.lrj @@ -0,0 +1,12 @@ +{"version":1,"strings":[ +{"hash":102089683,"name":"ttransferfavoritesform.caption","sourcebytes":[84,114,97,110,115,102,101,114,32,70,97,118,111,114,105,116,101,115],"value":"Transfer Favorites"}, +{"hash":160944127,"name":"ttransferfavoritesform.lbtransferto.caption","sourcebytes":[84,114,97,110,115,102,101,114,32,116,111],"value":"Transfer to"}, +{"hash":5966629,"name":"ttransferfavoritesform.vtfavs.header.columns[1].text","sourcebytes":[84,105,116,108,101],"value":"Title"}, +{"hash":230269173,"name":"ttransferfavoritesform.vtfavs.header.columns[2].text","sourcebytes":[87,101,98,115,105,116,101],"value":"Website"}, +{"hash":1339,"name":"ttransferfavoritesform.btok.caption","sourcebytes":[79,75],"value":"OK"}, +{"hash":77089212,"name":"ttransferfavoritesform.btcancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}, +{"hash":18476,"name":"ttransferfavoritesform.rball.caption","sourcebytes":[65,108,108],"value":"All"}, +{"hash":6062836,"name":"ttransferfavoritesform.rbvalid.caption","sourcebytes":[86,97,108,105,100],"value":"Valid"}, +{"hash":6062756,"name":"ttransferfavoritesform.rbinvalid.caption","sourcebytes":[73,110,118,97,108,105,100],"value":"Invalid"}, +{"hash":231329170,"name":"ttransferfavoritesform.ckcleardownloadedchapters.caption","sourcebytes":[67,108,101,97,114,32,100,111,119,110,108,111,97,100,101,100,32,99,104,97,112,116,101,114,32,108,105,115,116,32,97,110,100,32,114,101,108,111,97,100,32,102,114,111,109,32,115,101,114,118,101,114],"value":"Clear downloaded chapter list and reload from server"} +]} diff --git a/mangadownloader/forms/frmTransferFavorites.pas b/mangadownloader/forms/frmTransferFavorites.pas new file mode 100644 index 000000000..10c3f5e45 --- /dev/null +++ b/mangadownloader/forms/frmTransferFavorites.pas @@ -0,0 +1,359 @@ +unit frmTransferFavorites; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, Menus, ExtCtrls, + VirtualTrees, uFavoritesManager, DBDataProcess; + +type + + { TTransferFavoritesForm } + + TTransferFavoritesForm = class(TForm) + btOK: TBitBtn; + btCancel: TBitBtn; + cbWebsites: TComboBox; + ckClearDownloadedChapters: TCheckBox; + imgState: TImage; + imgsState: TImageList; + lbTransferTo: TLabel; + rbAll: TRadioButton; + rbValid: TRadioButton; + rbInvalid: TRadioButton; + vtFavs: TVirtualStringTree; + procedure btCancelClick(Sender: TObject); + procedure btOKClick(Sender: TObject); + procedure cbWebsitesEditingDone(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure rbAllChange(Sender: TObject); + procedure vtFavsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vtFavsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; + var Ghosted: Boolean; var ImageIndex: Integer); + procedure vtFavsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + procedure vtFavsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String + ); + private + FAllCount, + FValidCount, + FInvalidCount, + FLastFilter, + FLastWebsiteSelect: Integer; + procedure UpdateFilterCount; + procedure FilterState(const AState: Integer = 0); + procedure FindMatchTitle; + public + procedure AddFav(const AFav: TFavoriteContainer); + end; + + TFavsContainer = record + Fav: TFavoriteContainer; + NewLink: String; + State: Integer; + end; + + PFavContainer = ^TFavsContainer; + + { TFindMatchDBThread } + + TFindMatchDBThread = class(TThread) + private + FWebsite: String; + procedure SyncBegin; + procedure SyncEnd; + protected + procedure Execute; override; + public + Owner: TTransferFavoritesForm; + constructor Create(AWebsite: String); + end; + +var + TransferFavoritesForm: TTransferFavoritesForm; + +resourcestring + RS_ALL = 'All'; + RS_Valid = 'Valid'; + RS_Invalid = 'Invalid'; + +implementation + +uses + FMDVars, FMDOptions, db, frmCustomColor; + +{$R *.lfm} + +{ TFindMatchDBThread } + +procedure TFindMatchDBThread.SyncBegin; +begin + Owner.imgState.Visible := True; + Owner.imgsState.GetBitmap(0,Owner.imgState.Picture.Bitmap); + Owner.cbWebsites.Enabled := False; + Owner.vtFavs.Enabled := False; +end; + +procedure TFindMatchDBThread.SyncEnd; +begin + Owner.imgsState.GetBitmap(1,Owner.imgState.Picture.Bitmap); + Owner.cbWebsites.Enabled := True; + Owner.vtFavs.Enabled := True; + Owner.cbWebsites.SetFocus; + + Owner.UpdateFilterCount; + + if Owner.FLastFilter <> 0 then + begin + Owner.FLastFilter := -1; + Owner.rbAllChange(nil); + end; +end; + +procedure TFindMatchDBThread.Execute; +var + db: TDBDataProcess; + node: PVirtualNode; + data: PFavContainer; + +begin + Synchronize(@SyncBegin); + Owner.FValidCount := 0; + Owner.FInvalidCount := 0; + db := TDBDataProcess.Create; + try + if db.Connect(FWebsite) then + begin + db.Table.ReadOnly := True; + node := Owner.vtFavs.GetFirst(); + while Assigned(node) do + begin + data := Owner.vtFavs.GetNodeData(node); + if data^.Fav.Website = db.Website then + begin + data^.NewLink := ''; + data^.State := 0; + end + else + begin + try + db.Table.SQL.Text := 'SELECT link FROM ' + AnsiQuotedStr(db.TableName, '"') + + ' WHERE title LIKE '+AnsiQuotedStr(data^.Fav.FavoriteInfo.Title, '"') + ' COLLATE NOCASE;'; + db.Table.Open; + if db.Table.RecNo > 0 then + begin + data^.NewLink := db.Table.Fields[0].AsString; + data^.State := 1; + Inc(Owner.FValidCount); + end + else + begin + data^.NewLink := ''; + data^.State := 2; + Inc(Owner.FInvalidCount); + end; + except + end; + db.Table.Close; + end; + node := Owner.vtFavs.GetNext(node); + end; + end; + db.Connection.Connected := False; + finally + db.Free; + end; + Synchronize(@SyncEnd); +end; + +constructor TFindMatchDBThread.Create(AWebsite: String); +begin + inherited Create(True); + FreeOnTerminate := True; + FWebsite := AWebsite; +end; + +{ TTransferFavoritesForm } + +procedure TTransferFavoritesForm.FormCreate(Sender: TObject); +begin + frmCustomColor.AddVT(vtFavs); + cbWebsites.Items.Text := FormMain.cbSelectManga.Items.Text; + FLastFilter := 0; + FAllCount := 0; + FValidCount := 0; + FInvalidCount := 0; + FLastWebsiteSelect := -1; +end; + +procedure TTransferFavoritesForm.FormDestroy(Sender: TObject); +begin + frmCustomColor.RemoveVT(vtFavs); +end; + +procedure TTransferFavoritesForm.FormShow(Sender: TObject); +begin + UpdateFilterCount; +end; + +procedure TTransferFavoritesForm.rbAllChange(Sender: TObject); +begin + if rbAll.Checked then + FilterState(0) + else if rbValid.Checked then + FilterState(1) + else if rbInvalid.Checked then + FilterState(2); +end; + +procedure TTransferFavoritesForm.btOKClick(Sender: TObject); +var + Node: PVirtualNode; + Data: PFavContainer; + dc: String; + t: TFavoriteContainer; +begin + Node := vtFavs.GetFirst(); + while Assigned(Node) do + begin + Data := vtFavs.GetNodeData(Node); + // add new item and remove the old one + if Data^.NewLink <> '' then + begin + with Data^.Fav.FavoriteInfo do + begin + if ckClearDownloadedChapters.Checked then + dc := '' + else + dc := DownloadedChapterList; + FavoriteManager.Add( + Title, + CurrentChapter, + dc, + cbWebsites. + Text, + SaveTo, + Data^.NewLink); + end; + t := FavoriteManager.Items.Last; + FavoriteManager.FreeAndDelete(Data^.Fav); + Data^.Fav := t; + if ckClearDownloadedChapters.Checked then + t.Tag := 100; // get new chapterlist + end; + Node := vtFavs.GetNext(Node); + end; + ModalResult := mrOK; +end; + +procedure TTransferFavoritesForm.cbWebsitesEditingDone(Sender: TObject); +begin + FindMatchTitle; +end; + +procedure TTransferFavoritesForm.btCancelClick(Sender: TObject); +begin + ModalResult := mrCancel; +end; + +procedure TTransferFavoritesForm.vtFavsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + Data: PFavContainer; +begin + Data := Sender.GetNodeData(Node); + if Assigned(Data) then + Finalize(Data^); +end; + +procedure TTransferFavoritesForm.vtFavsGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; + Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); +var + Data: PFavContainer; +begin + if Column <> 0 then Exit; + Data := Sender.GetNodeData(Node); + if Data^.State = 0 then + ImageIndex := -1 + else + ImageIndex := Data^.State; +end; + +procedure TTransferFavoritesForm.vtFavsGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(TFavsContainer); +end; + +procedure TTransferFavoritesForm.vtFavsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: String); +var + Data: PFavContainer; +begin + Data := Sender.GetNodeData(Node); + case Column of + 1: CellText := Data^.Fav.FavoriteInfo.Title; + 2: CellText := Data^.Fav.FavoriteInfo.Website; + end; +end; + +procedure TTransferFavoritesForm.UpdateFilterCount; +begin + rbAll.Caption := RS_ALL + '(' + IntToStr(FAllCount) + ')'; + rbValid.Caption := RS_Valid + '(' + IntToStr(FValidCount) + ')'; + rbInvalid.Caption := RS_Invalid + '(' + IntToStr(FInvalidCount) + ')'; +end; + +procedure TTransferFavoritesForm.FilterState(const AState: Integer); +var + Node: PVirtualNode; + Data: PFavContainer; +begin + if FLastFilter = AState then Exit; + try + vtFavs.BeginUpdate; + Node := vtFavs.GetFirst(); + while Assigned(Node) do + begin + Data := vtFavs.GetNodeData(Node); + if AState = 0 then + vtFavs.IsVisible[Node] := True + else + vtFavs.IsVisible[Node] := Data^.State = AState; + Node := vtFavs.GetNext(Node); + end; + finally + vtFavs.EndUpdate; + end; + FLastFilter := AState; +end; + +procedure TTransferFavoritesForm.FindMatchTitle; +begin + if FLastWebsiteSelect = cbWebsites.ItemIndex then Exit; + FLastWebsiteSelect := cbWebsites.ItemIndex; + if not FileExists(DATA_FOLDER + cbWebsites.Text + DBDATA_EXT) then + Exit; + with TFindMatchDBThread.Create(cbWebsites.Text) do + begin + Owner := Self; + Start; + end; +end; + +procedure TTransferFavoritesForm.AddFav(const AFav: TFavoriteContainer); +var + Node: PVirtualNode; + Data: PFavContainer; +begin + Node := vtFavs.AddChild(nil); + Data := vtFavs.GetNodeData(Node); + Data^.Fav := AFav; + Data^.NewLink := ''; + Data^.State := 0; + Inc(FAllCount); +end; + +end. + diff --git a/mangadownloader/forms/frmUpdateDialog.lfm b/mangadownloader/forms/frmUpdateDialog.lfm index 5598b9d45..a2b394625 100644 --- a/mangadownloader/forms/frmUpdateDialog.lfm +++ b/mangadownloader/forms/frmUpdateDialog.lfm @@ -5,19 +5,21 @@ object UpdateDialogForm: TUpdateDialogForm Width = 488 BorderIcons = [biSystemMenu] Caption = 'New Version Found' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 + ChildSizing.LeftRightSpacing = 8 + ChildSizing.TopBottomSpacing = 8 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 ClientHeight = 420 ClientWidth = 488 Position = poOwnerFormCenter - LCLVersion = '1.5' + LCLVersion = '1.7' + Visible = False object mmLog: TMemo - Left = 6 + Left = 8 Height = 336 - Top = 46 - Width = 476 + Top = 44 + Width = 472 Align = alClient - BorderSpacing.Bottom = 6 Font.CharSet = ANSI_CHARSET Font.Height = -13 Font.Name = 'Courier New' @@ -33,33 +35,34 @@ object UpdateDialogForm: TUpdateDialogForm WordWrap = False end object lbMessage: TLabel - Left = 6 + Left = 8 Height = 30 - Top = 6 - Width = 476 + Top = 8 + Width = 472 Align = alTop - BorderSpacing.Bottom = 10 Caption = 'New version found! Do you want to update now?'#13#10'FMD will be closed to finish the update.' ParentColor = False end object pnBottom: TPanel - Left = 6 + Left = 8 Height = 26 - Top = 388 - Width = 476 + Top = 386 + Width = 472 Align = alBottom AutoSize = True BevelOuter = bvNone ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 ClientHeight = 26 - ClientWidth = 476 + ClientWidth = 472 TabOrder = 1 object btnUpdate: TBitBtn - Left = 78 + Left = 0 Height = 26 Top = 0 Width = 84 - Align = alLeft AutoSize = True Caption = '&Update' Default = True @@ -103,11 +106,10 @@ object UpdateDialogForm: TUpdateDialogForm TabOrder = 0 end object btnLater: TBitBtn - Left = 0 + Left = 90 Height = 26 Top = 0 Width = 72 - Align = alLeft AutoSize = True Caption = '&Later' Glyph.Data = { diff --git a/mangadownloader/forms/frmUpdateDialog.lrj b/mangadownloader/forms/frmUpdateDialog.lrj new file mode 100644 index 000000000..e062b0e16 --- /dev/null +++ b/mangadownloader/forms/frmUpdateDialog.lrj @@ -0,0 +1,5 @@ +{"version":1,"strings":[ +{"hash":60067406,"name":"tupdatedialogform.lbmessage.caption","sourcebytes":[78,101,119,32,118,101,114,115,105,111,110,32,102,111,117,110,100,33,32,68,111,32,121,111,117,32,119,97,110,116,32,116,111,32,117,112,100,97,116,101,32,110,111,119,63,13,10,70,77,68,32,119,105,108,108,32,98,101,32,99,108,111,115,101,100,32,116,111,32,102,105,110,105,115,104,32,116,104,101,32,117,112,100,97,116,101,46],"value":"New version found! Do you want to update now?\r\nFMD will be closed to finish the update."}, +{"hash":197568645,"name":"tupdatedialogform.btnupdate.caption","sourcebytes":[38,85,112,100,97,116,101],"value":"&Update"}, +{"hash":45255362,"name":"tupdatedialogform.btnlater.caption","sourcebytes":[38,76,97,116,101,114],"value":"&Later"} +]} diff --git a/mangadownloader/forms/frmWebsiteOptionCustom.lfm b/mangadownloader/forms/frmWebsiteOptionCustom.lfm new file mode 100644 index 000000000..751609833 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteOptionCustom.lfm @@ -0,0 +1,9 @@ +object CustomOptionForm: TCustomOptionForm + Left = 281 + Height = 240 + Top = 68 + Width = 320 + Caption = 'CustomOptionForm' + OnCreate = FormCreate + LCLVersion = '1.8.0.6' +end diff --git a/mangadownloader/forms/frmWebsiteOptionCustom.pas b/mangadownloader/forms/frmWebsiteOptionCustom.pas new file mode 100644 index 000000000..597f0b238 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteOptionCustom.pas @@ -0,0 +1,425 @@ +unit frmWebsiteOptionCustom; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, StdCtrls, Spin, WebsiteModules; + +type + + { TCheckBoxBindValue } + + TCheckBoxBindValue = class(TCheckBox) + private + FBindValue: PBoolean; + procedure SetBindValue(AValue: PBoolean); + protected + procedure ValueChange(Sender: TObject); + public + constructor Create(TheOwner: TComponent); override; + property BindValue: PBoolean read FBindValue write SetBindValue; + end; + + { TEditBindValue } + + TEditBindValue = class(TEdit) + private + FBindValue: PString; + procedure SetBindValue(AValue: PString); + protected + procedure ValueChange(Sender: TObject); + public + constructor Create(TheOwner: TComponent); override; + property BindValue: PString read FBindValue write SetBindValue; + end; + + { TSpinEditBindValue } + + TSpinEditBindValue = class(TSpinEdit) + private + FBindValue: PInteger; + procedure SetBindValue(AValue: PInteger); + protected + procedure ValueChange(Sender: TObject); + public + constructor Create(TheOwner: TComponent); override; + property BindValue: PInteger read FBindValue write SetBindValue; + end; + + { TComboBoxBindValue } + + TComboBoxBindValue = class(TComboBox) + private + FBindValue: PInteger; + procedure SetBindValue(AValue: PInteger); + protected + procedure ValueChange(Sender: TObject); + public + constructor Create(TheOwner: TComponent); override; + property BindValue: PInteger read FBindValue write SetBindValue; + end; + + { TCustomOptionForm } + + TCustomOptionForm = class(TForm) + procedure FormCreate(Sender: TObject); + private + { private declarations } + function AddOptionItem(const AOptionItemType: TWebsiteOptionType; + const AName, ACaption, AGroup, AGroupCaption: String): TWinControl; + public + { public declarations } + function AddCheckbox(const ABindValue: PBoolean; + const AName, ACaption, AGroup, AGroupCaption: String): TWinControl; + function AddEdit(const ABindValue: PString; + const AName, ACaption, AGroup, AGroupCaption: String): TWinControl; + function AddSpinEdit(const ABindValue: PInteger; + AName, ACaption, AGroup, AGroupCaption: String): TWinControl; + function AddComboBox(const ABindValue: PInteger; + AName, ACaption, AGroup, AGroupCaption, AItems: String): TWinControl; + procedure CreateWebsiteOption; + end; + +var + WebsiteOptionCustomForm: TCustomOptionForm; + downer: TComponent; + dparent: TWinControl; + tbspace: Cardinal = 6; + lrspace: Cardinal = 6; + hspace: Cardinal = 4; + vspace: Cardinal = 4; + +const + TWebsiteOptionItemTypeStr: array[TWebsiteOptionType] of String = + ('ack', 'ae', 'ase', 'acb'); + +implementation + +{$R *.lfm} + +{ TCheckBoxBindValue } + +procedure TCheckBoxBindValue.SetBindValue(AValue: PBoolean); +begin + if FBindValue = AValue then Exit; + FBindValue := AValue; + if Assigned(FBindValue) then + Checked := FBindValue^; +end; + +procedure TCheckBoxBindValue.ValueChange(Sender: TObject); +begin + if Assigned(FBindValue) then + FBindValue^ := Checked; +end; + +constructor TCheckBoxBindValue.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + OnChange := @ValueChange; +end; + +{ TEditBindValue } + +procedure TEditBindValue.SetBindValue(AValue: PString); +begin + if FBindValue = AValue then Exit; + FBindValue := AValue; + if Assigned(FBindValue) then + Text := FBindValue^; +end; + +procedure TEditBindValue.ValueChange(Sender: TObject); +begin + if Assigned(FBindValue) then + FBindValue^ := Text; +end; + +constructor TEditBindValue.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + OnChange := @ValueChange; +end; + +{ TSpinEditBindValue } + +procedure TSpinEditBindValue.SetBindValue(AValue: PInteger); +begin + if FBindValue = AValue then Exit; + FBindValue := AValue; + if Assigned(FBindValue) then + Value := FBindValue^; +end; + +procedure TSpinEditBindValue.ValueChange(Sender: TObject); +begin + if Assigned(FBindValue) then + FBindValue^ := Value; +end; + +constructor TSpinEditBindValue.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + MinValue := 0; + MaxValue := 10000; + OnChange := @ValueChange; +end; + +{ TComboBoxBindValue } + +procedure TComboBoxBindValue.SetBindValue(AValue: PInteger); +begin + if FBindValue = AValue then Exit; + FBindValue := AValue; + if Assigned(FBindValue) then + if FBindValue^ < Items.Count then + ItemIndex := FBindValue^; +end; + +procedure TComboBoxBindValue.ValueChange(Sender: TObject); +begin + if Assigned(FBindValue) then + FBindValue^ := ItemIndex; +end; + +constructor TComboBoxBindValue.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + OnChange := @ValueChange; + Style := csDropDownList; +end; + +{ TCustomOptionForm } + +procedure TCustomOptionForm.FormCreate(Sender: TObject); +begin + downer := self; + dparent := Self; + with dparent.ChildSizing do + begin + TopBottomSpacing := tbspace; + LeftRightSpacing := lrspace; + HorizontalSpacing := hspace; + VerticalSpacing := vspace; + end; +end; + +function TCustomOptionForm.AddOptionItem(const AOptionItemType: TWebsiteOptionType; + const AName, ACaption, AGroup, AGroupCaption: String): TWinControl; +var + i, j: Integer; + compparent: TWinControl; + compparentsibling, compsibling: TControl; + lcomp, lcompcaption, lgroup, lgroupcaption: String; + lb: TLabel; + + procedure SetControlProp(const AControl, ASibling: TControl; + const AParent: TWinControl; const AName, ACaption: String); + begin + with AControl do + begin + if AParent <> nil then + Parent := AParent; + Name := AName; + Caption := ACaption; + AutoSize := True; + Top := AParent.ChildSizing.TopBottomSpacing; + AnchorParallel(akLeft, 0, AParent); + if ASibling <> nil then + begin + Top := ASibling.Top + ASibling.Height; + AnchorToNeighbour(akTop, 0, ASibling); + end; + end; + end; + +begin + Result := nil; + lcomp := CleanOptionName(AName); + if lcomp = '' then Exit; + lcompcaption := Trim(ACaption); + lgroup := CleanOptionName(AGroup); + lgroupcaption := Trim(AGroupCaption); + compparent := nil; + compparentsibling := nil; + compsibling := nil; + + if (lcompcaption = '') and (lcomp <> '') then + lcompcaption := Trim(AName); + if (lgroupcaption = '') and (lgroup <> '') then + lgroupcaption := Trim(AGroup); + + if lcomp <> '' then + begin + if lgroup <> '' then + lcomp := lgroup + lcomp; + lcomp := TWebsiteOptionItemTypeStr[AOptionItemType] + lcomp; + if lgroup <> '' then + lgroup := 'agb' + lgroup; + end; + + with dparent do + if ComponentCount > 0 then + for i := ComponentCount - 1 downto 0 do + begin + if SameText(Components[i].Name, lcomp) then + begin + Result := TWinControl(Components[i]); + Exit; + end + else + if (Components[i] is TGroupBox) and SameText(Components[i].Name, lgroup) then + begin + compparent := TGroupBox(Components[i]); + with compparent do + if ControlCount > 0 then + compsibling := TControl(Controls[ControlCount - 1]); + end; + end; + + with dparent do + if ComponentCount > 0 then + begin + i := ComponentCount - 1; + if TWinControl(Components[i]).Parent is TGroupBox then + compparentsibling := TWinControl(Components[i]).Parent + else + compparentsibling := TWinControl(Components[i]); + end; + + Self.BeginFormUpdate; + try + if compparent = nil then + if lgroup <> '' then + begin + compparent := TGroupBox.Create(downer); + SetControlProp(compparent, compparentsibling, dparent, lgroup, lgroupcaption); + with compparent.ChildSizing do + begin + TopBottomSpacing := dparent.ChildSizing.TopBottomSpacing; + LeftRightSpacing := dparent.ChildSizing.LeftRightSpacing; + HorizontalSpacing := dparent.ChildSizing.HorizontalSpacing; + VerticalSpacing := dparent.ChildSizing.VerticalSpacing; + end; + compparent.Align := alTop; + end + else + begin + compparent := dparent; + if (compsibling = nil) and (compparentsibling <> nil) then + compsibling := compparentsibling; + end; + + case AOptionItemType of + woCheckBox: + begin + Result := TCheckBoxBindValue.Create(downer); + SetControlProp(Result, compsibling, compparent, lcomp, lcompcaption); + end; + + woEdit, woComboBox: + begin + lb := TLabel.Create(downer); + SetControlProp(lb, compsibling, compparent, lcomp + 'Lbl', lcompcaption); + compsibling := lb; + case AOptionItemType of + woEdit : Result := TEditBindValue.Create(downer); + woComboBox: Result := TComboBoxBindValue.Create(downer); + end; + SetControlProp(Result, compsibling, compparent, lcomp, ''); + with Result do + begin + Width := compparent.Width - compparent.ChildSizing.LeftRightSpacing; + Anchors := Anchors + [akRight]; + Text := ''; + end; + end; + + woSpinEdit: + begin + Result := TSpinEditBindValue.Create(downer); + SetControlProp(Result, compsibling, compparent, lcomp, lcompcaption); + Result.Width := Result.Width + (Result.Width div 4); + lb := TLabel.Create(downer); + SetControlProp(lb, Result, compparent, lcomp + 'Lbl', lcompcaption); + with lb do + begin + AnchorToNeighbour(akLeft, 0, Result); + AnchorVerticalCenterTo(Result); + end; + end; + end; + finally + Self.EndFormUpdate; + end; +end; + +function TCustomOptionForm.AddCheckbox(const ABindValue: PBoolean; + const AName, ACaption, AGroup, AGroupCaption: String + ): TWinControl; +begin + Result := AddOptionItem(woCheckBox, AName, ACaption, AGroup, AGroupCaption); + if (Result <> nil) and (Result is TCheckBoxBindValue) then + TCheckBoxBindValue(Result).BindValue := ABindValue; +end; + +function TCustomOptionForm.AddEdit(const ABindValue: PString; + const AName, ACaption, AGroup, AGroupCaption: String + ): TWinControl; +begin + Result := AddOptionItem(woEdit, AName, ACaption, AGroup, AGroupCaption); + if (Result <> nil) and (Result is TEditBindValue) then + TEditBindValue(Result).BindValue := ABindValue; +end; + +function TCustomOptionForm.AddSpinEdit(const ABindValue: PInteger; + AName, ACaption, AGroup, AGroupCaption: String + ): TWinControl; +begin + Result := AddOptionItem(woSpinEdit, AName, ACaption, AGroup, AGroupCaption); + if (Result <> nil) and (Result is TSpinEditBindValue) then + TSpinEditBindValue(Result).BindValue := ABindValue; +end; + +function TCustomOptionForm.AddComboBox(const ABindValue: PInteger; AName, ACaption, + AGroup, AGroupCaption, AItems: String): TWinControl; +begin + Result := AddOptionItem(woComboBox, AName, ACaption, AGroup, AGroupCaption); + if (Result <> nil) and (Result is TComboBoxBindValue) then + with TComboBoxBindValue(Result) do + begin + Items.Text := AItems; + TComboBoxBindValue(Result).BindValue := ABindValue; + end; +end; + +procedure TCustomOptionForm.CreateWebsiteOption; +var + i, j: Integer; + cap: String; +begin + if Modules = nil then Exit; + dparent.DestroyComponents; + if Modules.Count > 0 then + for i := 0 to Modules.Count - 1 do + with Modules.Module[i] do + if Length(OptionList) > 0 then + for j := Low(OptionList) to High(OptionList) do + with OptionList[j] do + begin + if Assigned(Caption) then + cap := Caption^ + else + cap := ''; + case OptionType of + woCheckBox: AddCheckbox(BindValue, Name, cap, Website, Website); + woEdit: AddEdit(BindValue, Name, cap, Website, Website); + woSpinEdit: AddSpinEdit(BindValue, Name, cap, Website, Website); + woComboBox: AddComboBox(BindValue, Name, cap, Website, Website, Items^); + end; + end; +end; + +end. diff --git a/mangadownloader/forms/frmWebsiteSelection.lfm b/mangadownloader/forms/frmWebsiteSelection.lfm new file mode 100644 index 000000000..d7c0eebe1 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSelection.lfm @@ -0,0 +1,48 @@ +object WebsiteSelectionForm: TWebsiteSelectionForm + Left = 202 + Height = 75 + Top = 182 + Width = 310 + BorderStyle = bsDialog + Caption = 'Select a website' + ChildSizing.LeftRightSpacing = 10 + ChildSizing.TopBottomSpacing = 10 + ChildSizing.HorizontalSpacing = 6 + ChildSizing.VerticalSpacing = 6 + ClientHeight = 75 + ClientWidth = 310 + Position = poMainFormCenter + LCLVersion = '1.7' + Visible = False + object cbWebsites: TComboBox + Left = 10 + Height = 23 + Top = 10 + Width = 290 + Align = alTop + AutoComplete = True + AutoCompleteText = [cbactEnabled, cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 15 + TabOrder = 0 + end + object btOk: TBitBtn + AnchorSideLeft.Control = cbWebsites + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = cbWebsites + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = cbWebsites + AnchorSideRight.Side = asrCenter + AnchorSideBottom.Side = asrBottom + Left = 124 + Height = 26 + Top = 41 + Width = 62 + Anchors = [akLeft, akBottom] + AutoSize = True + Default = True + DefaultCaption = True + Kind = bkOK + ModalResult = 1 + TabOrder = 1 + end +end diff --git a/mangadownloader/forms/frmWebsiteSelection.lrj b/mangadownloader/forms/frmWebsiteSelection.lrj new file mode 100644 index 000000000..9772f6136 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSelection.lrj @@ -0,0 +1,3 @@ +{"version":1,"strings":[ +{"hash":102399989,"name":"twebsiteselectionform.caption","sourcebytes":[83,101,108,101,99,116,32,97,32,119,101,98,115,105,116,101],"value":"Select a website"} +]} diff --git a/mangadownloader/forms/frmWebsiteSelection.pas b/mangadownloader/forms/frmWebsiteSelection.pas new file mode 100644 index 000000000..de9cc7686 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSelection.pas @@ -0,0 +1,31 @@ +unit frmWebsiteSelection; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons; + +type + + { TWebsiteSelectionForm } + + TWebsiteSelectionForm = class(TForm) + btOk: TBitBtn; + cbWebsites: TComboBox; + private + { private declarations } + public + { public declarations } + end; + +var + WebsiteSelectionForm: TWebsiteSelectionForm; + +implementation + +{$R *.lfm} + +end. + diff --git a/mangadownloader/forms/frmWebsiteSettings.lfm b/mangadownloader/forms/frmWebsiteSettings.lfm new file mode 100644 index 000000000..a3c220f84 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSettings.lfm @@ -0,0 +1,160 @@ +object WebsiteSettingsForm: TWebsiteSettingsForm + Left = 280 + Height = 461 + Top = 93 + Width = 572 + Caption = 'WebsiteSettingsForm' + ClientHeight = 461 + ClientWidth = 572 + OnCreate = FormCreate + OnDestroy = FormDestroy + LCLVersion = '1.8.0.6' + object spMain: TPairSplitter + Left = 0 + Height = 461 + Top = 0 + Width = 572 + Align = alClient + Position = 150 + object spList: TPairSplitterSide + Cursor = crArrow + Left = 0 + Height = 461 + Top = 0 + Width = 150 + ChildSizing.VerticalSpacing = 6 + ClientWidth = 150 + ClientHeight = 461 + object vtWebsite: TVirtualStringTree + Left = 0 + Height = 432 + Top = 29 + Width = 150 + Align = alClient + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.DefaultHeight = 17 + Header.MainColumn = -1 + TabOrder = 1 + TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] + TreeOptions.SelectionOptions = [toFullRowSelect] + OnCompareNodes = vtWebsiteCompareNodes + OnFocusChanged = vtWebsiteFocusChanged + OnGetText = vtWebsiteGetText + end + object edSearch: TEditButton + Left = 0 + Height = 23 + Top = 0 + Width = 150 + Align = alTop + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edSearchButtonClick + OnChange = edSearchChange + PasswordChar = #0 + TabOrder = 0 + TextHint = 'Website name' + end + end + object spProps: TPairSplitterSide + Cursor = crArrow + Left = 155 + Height = 461 + Top = 0 + Width = 417 + ChildSizing.VerticalSpacing = 6 + ClientWidth = 417 + ClientHeight = 461 + object edSearchProperty: TEditButton + Left = 0 + Height = 23 + Top = 0 + Width = 417 + Align = alTop + ButtonWidth = 23 + Glyph.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000010000 + 00070000000E00000014000000190000001A0000001900000017000000150000 + 00120000000E0000000B00000008000000050000000200000001000000020000 + 000D0000001B000000280000003100000033001A3064002D57CC002C56CC0018 + 305D0000001C000000160000000F0000000A0000000400000001000000000000 + 0000000000000000000001131F0000214048002B55CC5494B7FF34679AFF0030 + 5ACA00224248000D170000000000000000000000000000000000000000000000 + 00000116210000214000014D7C41014B79BB3A719FFF386F9DFF5F9FC0FF4578 + ABFF003763C600356046002D4E00010101000000000000000000013048000021 + 400001568600002B5548002B55CC4F8DB3FF68ACC8FF4880ACFF5087B3FF6AAA + C8FF5588BBFF00416EC1003E6A440101010001385B0001263D00015F9000002B + 55000157873F015585B65FA1C0FF3F79A3FF4278A7FF66A6C5FF619DC2FF5E95 + C1FF74B4D1FF6598CBFF010101AB0101013C014B7900014B7A00015F9000002B + 5548002B55CC336898FF508CB3FF69ABC8FF67A7C6FF4D80B3FF71B1CEFF6EA9 + CDFF6CA3CEFF6D6D6DFFAA9999FF010101A5014C7A42014B7A000160913E015E + 8FB16AAEC9FF66A8C5FF5692B8FF4B80AFFF5D97BFFF77B9D2FF669DC8FF7BBA + D5FF7E7E7EFFCEC0C0FF797979FF5588BBFF014F7EA6014E7D0001629383126D + 9BB82078A2C33385ABD058A2C0E774B9D1FB6EACCCFF669DC8FF83C7DAFF8888 + 88FFD3CACAFF838383FF60A4C6FF63A7C9FF015382A501528100016395050163 + 9414016293280161924101619277106C9AAB4B9BBADB79B9D5FC919191FFD9D4 + D4FF8D8D8DFF68ACCEFF74B8D4FF015887B40156864001558400016395000163 + 9400016293000161920001629300016293100162936D00000069DDDCDCFF9494 + 94FF70B4D6FF80C4DBFF015C8DB2001A63CC0013584800226E00016395000163 + 94000162930001619200016293000162930001639400000000240000006788CC + DDFF87CBDDFF016091AF003080CC3F72B6FF002774CC00247048016395000163 + 940001629300016192000162930001629300016394000000000001334C390165 + 969C0164959C0163943E00398B48003688CC5285C9FF002E7ECC016395000163 + 940001629300016192000162930001629300016394000000000001334C000165 + 97000164960001639400003A8C00003E9248003C8FCC00378A48FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } + MaxLength = 0 + NumGlyphs = 1 + OnButtonClick = edSearchPropertyButtonClick + OnChange = edSearchPropertyChange + PasswordChar = #0 + TabOrder = 0 + TextHint = 'Setting name' + end + end + end +end diff --git a/mangadownloader/forms/frmWebsiteSettings.lrj b/mangadownloader/forms/frmWebsiteSettings.lrj new file mode 100644 index 000000000..3d95548fa --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSettings.lrj @@ -0,0 +1,5 @@ +{"version":1,"strings":[ +{"hash":63106205,"name":"twebsitesettingsform.caption","sourcebytes":[87,101,98,115,105,116,101,83,101,116,116,105,110,103,115,70,111,114,109],"value":"WebsiteSettingsForm"}, +{"hash":263118389,"name":"twebsitesettingsform.edsearch.texthint","sourcebytes":[87,101,98,115,105,116,101,32,110,97,109,101],"value":"Website name"}, +{"hash":17562933,"name":"twebsitesettingsform.edsearchproperty.texthint","sourcebytes":[83,101,116,116,105,110,103,32,110,97,109,101],"value":"Setting name"} +]} diff --git a/mangadownloader/forms/frmWebsiteSettings.pas b/mangadownloader/forms/frmWebsiteSettings.pas new file mode 100644 index 000000000..8be8ee0b7 --- /dev/null +++ b/mangadownloader/forms/frmWebsiteSettings.pas @@ -0,0 +1,135 @@ +unit frmWebsiteSettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, WebsiteModules, VirtualPropertyGrid, frmCustomColor, Forms, + Controls, PairSplitter, EditBtn, VirtualTrees, uBaseUnit; + +type + + { TWebsiteSettingsForm } + + TWebsiteSettingsForm = class(TForm) + edSearch: TEditButton; + edSearchProperty: TEditButton; + spMain: TPairSplitter; + spList: TPairSplitterSide; + spProps: TPairSplitterSide; + vtWebsite: TVirtualStringTree; + procedure edSearchButtonClick(Sender: TObject); + procedure edSearchChange(Sender: TObject); + procedure edSearchPropertyButtonClick(Sender: TObject); + procedure edSearchPropertyChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure vtWebsiteCompareNodes(Sender: TBaseVirtualTree; + Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); + procedure vtWebsiteFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); + procedure vtWebsiteGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); + private + public + SettingsView: TVirtualPropertyGrid; + procedure LoadWebsiteSettings; + end; + +var + WebsiteSettingsForm: TWebsiteSettingsForm; + +implementation + +{$R *.lfm} + +{ TWebsiteSettingsForm } + +procedure TWebsiteSettingsForm.FormCreate(Sender: TObject); +begin + AddVT(vtWebsite); + SettingsView := TVirtualPropertyGrid.Create(Self); + with SettingsView do + begin + Parent := spProps; + Align := alClient; + AutoFullExpand := True; + CleanEnumName := True; + Header.Columns[0].Width := 300; + {$if VTMajorVersion < 5} + TreeOptions.PaintOptions := TreeOptions.PaintOptions + [toThemeAware, toUseExplorerTheme, toHotTrack]; + {$endif} + end; +end; + +procedure TWebsiteSettingsForm.edSearchChange(Sender: TObject); +begin + SearchOnVT(vtWebsite, edSearch.Text); +end; + +procedure TWebsiteSettingsForm.edSearchPropertyButtonClick(Sender: TObject); +begin + edSearchProperty.Clear; +end; + +procedure TWebsiteSettingsForm.edSearchPropertyChange(Sender: TObject); +begin + SearchOnVT(SettingsView, edSearchProperty.Text); +end; + +procedure TWebsiteSettingsForm.edSearchButtonClick(Sender: TObject); +begin + edSearch.Clear; +end; + +procedure TWebsiteSettingsForm.FormDestroy(Sender: TObject); +begin + RemoveVT(vtWebsite); +end; + +procedure TWebsiteSettingsForm.vtWebsiteCompareNodes(Sender: TBaseVirtualTree; + Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); +begin + Result := AnsiCompareStr(PModuleContainer(Sender.GetNodeData(Node1))^.Website, + PModuleContainer(Sender.GetNodeData(Node2))^.Website); +end; + +procedure TWebsiteSettingsForm.vtWebsiteFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); +begin + SettingsView.TIObject := PModuleContainer(Sender.GetNodeData(Node))^.Settings; +end; + +procedure TWebsiteSettingsForm.vtWebsiteGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); +begin + CellText := PModuleContainer(Sender.GetNodeData(Node))^.Website; +end; + +procedure TWebsiteSettingsForm.LoadWebsiteSettings; +var + i: Integer; + items: TStringList; +begin + items := TStringList.Create; + try + items.OwnsObjects := False; + items.Duplicates := dupIgnore; + for i := Modules.Count - 1 downto 0 do + if items.IndexOf(Modules[i].Website) = -1 then + items.AddObject(Modules[i].Website, Modules[i]); + + vtWebsite.NodeDataSize := SizeOf(TModuleContainer); + vtWebsite.BeginUpdate; + for i := 0 to items.Count - 1 do + vtWebsite.AddChild(nil, items.Objects[i]); + vtWebsite.Sort(nil, 0, sdAscending, False); + vtWebsite.EndUpdate; + finally + items.Free; + end; +end; + + +end. diff --git a/mangadownloader/forms/mainunit.lrs b/mangadownloader/forms/mainunit.lrs deleted file mode 100644 index 9f0280a35..000000000 --- a/mangadownloader/forms/mainunit.lrs +++ /dev/null @@ -1,332 +0,0 @@ -{ This is an automatically generated lazarus resource file } - -LazarusResources.Add('TMainForm','FORMDATA',[ - 'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3#172#0#6'Height'#3#210#1#3'Top'#2'6' - +#5'Width'#3#238#2#5'Align'#7#8'alBottom'#7'Caption'#6#21'Free Manga Download' - +'er'#12'ClientHeight'#3#210#1#11'ClientWidth'#3#238#2#8'OnCreate'#7#10'FormC' - +'reate'#9'OnDestroy'#7#11'FormDestroy'#10'LCLVersion'#6#3'1.1'#0#6'TPanel'#10 - +'pnMainLeft'#23'AnchorSideRight.Control'#7#14'spMainSplitter'#4'Left'#2#0#6 - +'Height'#3#210#1#3'Top'#2#0#5'Width'#3#195#0#5'Align'#7#6'alLeft'#7'Anchors' - +#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#12'ClientHeight'#3#210#1#11 - +'ClientWidth'#3#195#0#8'TabOrder'#2#0#0#9'TComboBox'#13'cbSelectManga'#4'Lef' - +'t'#2#8#6'Height'#2#21#3'Top'#2#8#5'Width'#3#144#0#7'Anchors'#11#5'akTop'#6 - +'akLeft'#7'akRight'#0#10'ItemHeight'#2#13#13'Items.Strings'#1#6#0#0#8'TabOrd' - +'er'#2#0#0#0#5'TEdit'#8'edSearch'#4'Left'#2#8#6'Height'#2#21#3'Top'#2'$'#5'W' - +'idth'#3#144#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#10'OnKeyPress'#7 - +#16'edSearchKeyPress'#8'TabOrder'#2#1#4'Text'#6#9'Search...'#0#0#18'TVirtual' - +'StringTree'#11'vtMangaList'#4'Left'#2#8#6'Height'#3'q'#1#3'Top'#2'X'#5'Widt' - +'h'#3#176#0#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#11'Def' - +'aultText'#6#4'Node'#20'Header.AutoSizeIndex'#2#0#14'Header.Columns'#14#0#20 - +'Header.DefaultHeight'#2#17#17'Header.MainColumn'#2#255#14'ParentShowHint'#8 - +#8'ShowHint'#9#8'TabOrder'#2#2#24'TreeOptions.PaintOptions'#11#13'toShowButt' - +'ons'#14'toShowDropmark'#10'toShowRoot'#12'toThemeAware'#18'toUseBlendedImag' - +'es'#0#28'TreeOptions.SelectionOptions'#11#15'toFullRowSelect'#0#10'OnDblCli' - +'ck'#7#19'vtMangaListDblClick'#10'OnFreeNode'#7#19'vtMangaListFreeNode'#9'On' - +'GetText'#7#18'vtMangaListGetText'#9'OnGetHint'#7#18'vtMangaListGetHint'#10 - +'OnInitNode'#7#19'vtMangaListInitNode'#0#0#7'TBitBtn'#8'btSearch'#19'AnchorS' - +'ideLeft.Side'#7#9'asrBottom'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#3 - +#160#0#6'Height'#2#21#4'Hint'#6#22'Search manga from list'#3'Top'#2'$'#5'Wid' - +'th'#2#24#7'Anchors'#11#5'akTop'#7'akRight'#0#7'OnClick'#7#13'btSearchClick' - +#14'ParentShowHint'#8#8'ShowHint'#9#8'TabOrder'#2#3#0#0#6'TLabel'#6'lbMode'#4 - +'Left'#2#8#6'Height'#2#13#3'Top'#2'@'#5'Width'#2'}'#7'Caption'#6#20'Mode: Sh' - +'ow all manga'#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#10'ParentFont' - +#8#0#0#7'TBitBtn'#14'btRemoveFilter'#19'AnchorSideLeft.Side'#7#9'asrBottom' - +#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#3#160#0#6'Height'#2#21#4'Hint' - +#6#13'Remove filter'#3'Top'#2'@'#5'Width'#2#24#7'Anchors'#11#5'akTop'#7'akRi' - +'ght'#0#7'OnClick'#7#19'btRemoveFilterClick'#14'ParentShowHint'#8#8'ShowHint' - +#9#8'TabOrder'#2#4#0#0#0#12'TPageControl'#6'pcMain'#4'Left'#3#195#0#6'Height' - +#3#210#1#3'Top'#2#0#5'Width'#3'+'#2#10'ActivePage'#7#11'tsFavorites'#5'Align' - +#7#8'alClient'#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#8'TabIndex'#2#3 - +#8'TabOrder'#2#1#8'OnChange'#7#12'pcMainChange'#0#9'TTabSheet'#10'tsDownload' - +#7'Caption'#6#8'Download'#12'ClientHeight'#3#184#1#11'ClientWidth'#3'#'#2#0 - +#18'TVirtualStringTree'#10'vtDownload'#4'Left'#2#0#6'Height'#3#184#1#3'Top'#2 - +#0#5'Width'#3'#'#2#5'Align'#7#8'alClient'#11'DefaultText'#6#4'Node'#20'Heade' - +'r.AutoSizeIndex'#2#0#14'Header.Columns'#14#1#8'Position'#2#0#4'Text'#6#5'Ma' - +'nga'#5'Width'#2'd'#0#1#8'Position'#2#1#4'Text'#6#6'Status'#5'Width'#3#200#0 - +#0#1#8'Position'#2#2#4'Text'#6#8'Progress'#5'Width'#2'7'#0#1#8'Position'#2#3 - +#4'Text'#6#7'Website'#5'Width'#2'A'#0#1#8'Position'#2#4#4'Text'#6#7'Save to' - +#5'Width'#3#150#0#0#1#8'Position'#2#5#4'Text'#6#5'Added'#5'Width'#2'P'#0#0#20 - +'Header.DefaultHeight'#2#17#13'Header.Height'#2#25#14'Header.Options'#11#14 - +'hoColumnResize'#6'hoDrag'#16'hoShowSortGlyphs'#9'hoVisible'#0#12'Header.Sty' - +'le'#7#9'hsXPStyle'#10'ParentFont'#8#9'PopupMenu'#7#10'pmDownload'#8'TabOrde' - +'r'#2#0#24'TreeOptions.PaintOptions'#11#13'toShowButtons'#14'toShowDropmark' - +#10'toShowRoot'#12'toThemeAware'#18'toUseBlendedImages'#0#28'TreeOptions.Sel' - +'ectionOptions'#11#15'toFullRowSelect'#0#10'OnFreeNode'#7#18'vtDownloadFreeN' - +'ode'#9'OnGetText'#7#17'vtDownloadGetText'#10'OnInitNode'#7#18'vtDownloadIni' - +'tNode'#0#0#0#9'TTabSheet'#13'tsInformation'#7'Caption'#6#11'Manga Infos'#12 - +'ClientHeight'#3#184#1#11'ClientWidth'#3'#'#2#0#10'TScrollBox'#13'sbInformat' - +'ion'#4'Left'#2#0#6'Height'#3#184#1#3'Top'#2#0#5'Width'#3'#'#2#18'HorzScroll' - +'Bar.Page'#3#31#2#18'VertScrollBar.Page'#3#180#1#5'Align'#7#8'alClient'#12'C' - +'lientHeight'#3#180#1#11'ClientWidth'#3#31#2#8'TabOrder'#2#0#0#6'TPanel'#12 - +'pnInfomation'#4'Left'#2#0#6'Height'#3#234#0#3'Top'#2#0#5'Width'#3#31#2#5'Al' - +'ign'#7#5'alTop'#12'ClientHeight'#3#234#0#11'ClientWidth'#3#31#2#10'ParentFo' - +'nt'#8#8'TabOrder'#2#0#0#6'TImage'#7'imCover'#18'AnchorSideTop.Side'#7#9'asr' - +'Center'#21'AnchorSideBottom.Side'#7#9'asrCenter'#4'Left'#2#8#6'Height'#3#216 - +#0#3'Top'#2#8#5'Width'#3#154#0#7'Stretch'#9#0#0#9'TRichMemo'#13'rmInformatio' - +'n'#4'Left'#3#175#0#6'Height'#3#216#0#3'Top'#2#8#5'Width'#3'k'#1#7'Anchors' - +#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#13'HideSelection'#8#10'Paren' - ,'tFont'#8#8'ReadOnly'#9#10'ScrollBars'#7#10'ssVertical'#8'TabOrder'#2#0#0#0#0 - +#9'TSplitter'#7'spInfos'#6'Cursor'#7#8'crVSplit'#4'Left'#2#0#6'Height'#2#5#3 - +'Top'#3#234#0#5'Width'#3#31#2#5'Align'#7#5'alTop'#12'ResizeAnchor'#7#5'akTop' - +#0#0#6'TPanel'#13'pnChapterList'#4'Left'#2#0#6'Height'#3#197#0#3'Top'#3#239#0 - +#5'Width'#3#31#2#5'Align'#7#8'alClient'#12'ClientHeight'#3#197#0#11'ClientWi' - +'dth'#3#31#2#8'TabOrder'#2#2#0#13'TCheckListBox'#14'clbChapterList'#18'Ancho' - +'rSideTop.Side'#7#9'asrBottom'#4'Left'#2#8#6'Height'#2'h'#3'Top'#2#9#5'Width' - +#3#15#2#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#10'ItemHei' - +'ght'#2#0#11'MultiSelect'#9#10'OnKeyPress'#7#22'clbChapterListKeyPress'#10'P' - +'arentFont'#8#9'PopupMenu'#7#13'pmChapterList'#8'TabOrder'#2#0#0#0#12'TLabel' - +'edEdit'#8'edSaveTo'#4'Left'#2#8#6'Height'#2#21#3'Top'#3#137#0#5'Width'#3#31 - +#1#7'Anchors'#11#6'akLeft'#8'akBottom'#0' EditLabel.AnchorSideLeft.Control'#7 - +#8'edSaveTo!EditLabel.AnchorSideRight.Control'#7#8'edSaveTo'#30'EditLabel.An' - +'chorSideRight.Side'#7#9'asrBottom"EditLabel.AnchorSideBottom.Control'#7#8'e' - +'dSaveTo'#14'EditLabel.Left'#2#8#16'EditLabel.Height'#2#13#13'EditLabel.Top' - +#2'y'#15'EditLabel.Width'#3#31#1#17'EditLabel.Caption'#6#7'Save to'#21'EditL' - +'abel.ParentColor'#8#20'EditLabel.ParentFont'#8#10'ParentFont'#8#8'TabOrder' - +#2#1#0#0#7'TBitBtn'#10'btDownload'#4'Left'#3#159#1#6'Height'#2#30#3'Top'#3 - +#128#0#5'Width'#2'['#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#8'Do' - +'wnload'#7'OnClick'#7#15'btDownloadClick'#8'TabOrder'#2#2#0#0#7'TBitBtn'#8'b' - +'tBrowse'#4'Left'#3'7'#1#6'Height'#2#30#3'Top'#3#128#0#5'Width'#2'['#7'Ancho' - +'rs'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#6'Browse'#7'OnClick'#7#13'btBro' - +'wseClick'#8'TabOrder'#2#3#0#0#9'TCheckBox'#14'cbAddAsStopped'#4'Left'#2#8#6 - +'Height'#2#17#3'Top'#3#168#0#5'Width'#3#196#0#7'Caption'#6'$Add to download ' - +'list as stopped task'#8'OnChange'#7#20'cbAddAsStoppedChange'#10'ParentFont' - +#8#8'TabOrder'#2#4#0#0#9'TCheckBox'#16'cbAddToFavorites'#4'Left'#3'7'#1#6'He' - +'ight'#2#17#3'Top'#3#168#0#5'Width'#2'd'#7'Caption'#6#16'Add to Favorites'#10 - +'ParentFont'#8#8'TabOrder'#2#5#0#0#0#0#0#9'TTabSheet'#8'tsFilter'#7'Caption' - +#6#6'Filter'#12'ClientHeight'#3#184#1#11'ClientWidth'#3'#'#2#0#10'TScrollBox' - +#8'sbFilter'#4'Left'#2#0#6'Height'#3#184#1#3'Top'#2#0#5'Width'#3'#'#2#18'Hor' - +'zScrollBar.Page'#3#31#2#18'VertScrollBar.Page'#3#180#1#5'Align'#7#8'alClien' - +'t'#12'ClientHeight'#3#180#1#11'ClientWidth'#3#31#2#8'TabOrder'#2#0#0#6'TPan' - +'el'#8'pnGenres'#4'Left'#2#0#6'Height'#3#216#0#3'Top'#2#0#5'Width'#3#31#2#5 - +'Align'#7#5'alTop'#12'ClientHeight'#3#216#0#11'ClientWidth'#3#31#2#8'TabOrde' - +'r'#2#0#0#9'TCheckBox'#9'CheckBox1'#4'Left'#2#23#6'Height'#2#17#3'Top'#2#16#5 - +'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'Tab' - +'Order'#2#0#0#0#9'TCheckBox'#9'CheckBox2'#4'Left'#2#23#6'Height'#2#17#3'Top' - +#2'('#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8 - +#8'TabOrder'#2#1#0#0#9'TCheckBox'#9'CheckBox3'#4'Left'#2#23#6'Height'#2#17#3 - +'Top'#2'@'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentF' - +'ont'#8#8'TabOrder'#2#2#0#0#9'TCheckBox'#9'CheckBox4'#4'Left'#2#23#6'Height' - +#2#17#3'Top'#2'X'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10 - +'ParentFont'#8#8'TabOrder'#2#3#0#0#9'TCheckBox'#9'CheckBox5'#4'Left'#2#23#6 - +'Height'#2#17#3'Top'#2'p'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Act' - +'ion'#10'ParentFont'#8#8'TabOrder'#2#4#0#0#9'TCheckBox'#9'CheckBox6'#4'Left' - +#2#23#6'Height'#2#17#3'Top'#3#136#0#5'Width'#2'2'#11'AllowGrayed'#9#7'Captio' - +'n'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#5#0#0#9'TCheckBox'#9'CheckBox' - +'7'#4'Left'#2#23#6'Height'#2#17#3'Top'#3#160#0#5'Width'#2'2'#11'AllowGrayed' - +#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#6#0#0#9'TCheckBox'#9 - +'CheckBox8'#4'Left'#2#23#6'Height'#2#17#3'Top'#3#184#0#5'Width'#2'2'#11'Allo' - +'wGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#7#0#0#9'TC' - +'heckBox'#9'CheckBox9'#4'Left'#2#127#6'Height'#2#17#3'Top'#2#16#5'Width'#2'2' - +#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#8#0 - +#0#9'TCheckBox'#10'CheckBox10'#4'Left'#2#127#6'Height'#2#17#3'Top'#2'('#5'Wi' - +'dth'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOr' - +'der'#2#9#0#0#9'TCheckBox'#10'CheckBox11'#4'Left'#2#127#6'Height'#2#17#3'Top' - +#2'@'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8 - +#8'TabOrder'#2#10#0#0#9'TCheckBox'#10'CheckBox12'#4'Left'#2#127#6'Height'#2 - +#17#3'Top'#2'X'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'Pa' - +'rentFont'#8#8'TabOrder'#2#11#0#0#9'TCheckBox'#10'CheckBox13'#4'Left'#2#127#6 - +'Height'#2#17#3'Top'#2'p'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Act' - +'ion'#10'ParentFont'#8#8'TabOrder'#2#12#0#0#9'TCheckBox'#10'CheckBox14'#4'Le' - +'ft'#2#127#6'Height'#2#17#3'Top'#3#136#0#5'Width'#2'2'#11'AllowGrayed'#9#7'C' - +'aption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#13#0#0#9'TCheckBox'#10'C' - ,'heckBox15'#4'Left'#2#127#6'Height'#2#17#3'Top'#3#160#0#5'Width'#2'2'#11'All' - +'owGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#14#0#0#9 - +'TCheckBox'#10'CheckBox16'#4'Left'#2#127#6'Height'#2#17#3'Top'#3#184#0#5'Wid' - +'th'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrd' - +'er'#2#15#0#0#9'TCheckBox'#10'CheckBox17'#4'Left'#3#223#0#6'Height'#2#17#3'T' - +'op'#2#16#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFo' - +'nt'#8#8'TabOrder'#2#16#0#0#9'TCheckBox'#10'CheckBox18'#4'Left'#3#223#0#6'He' - +'ight'#2#17#3'Top'#2'('#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Actio' - +'n'#10'ParentFont'#8#8'TabOrder'#2#17#0#0#9'TCheckBox'#10'CheckBox19'#4'Left' - +#3#223#0#6'Height'#2#17#3'Top'#2'@'#5'Width'#2'2'#11'AllowGrayed'#9#7'Captio' - +'n'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#18#0#0#9'TCheckBox'#10'CheckB' - +'ox20'#4'Left'#3#223#0#6'Height'#2#17#3'Top'#2'X'#5'Width'#2'2'#11'AllowGray' - +'ed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#19#0#0#9'TCheck' - +'Box'#10'CheckBox21'#4'Left'#3#223#0#6'Height'#2#17#3'Top'#2'p'#5'Width'#2'2' - +#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#20#0 - +#0#9'TCheckBox'#10'CheckBox22'#4'Left'#3#223#0#6'Height'#2#17#3'Top'#3#136#0 - +#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'T' - +'abOrder'#2#21#0#0#9'TCheckBox'#10'CheckBox23'#4'Left'#3#223#0#6'Height'#2#17 - +#3'Top'#3#160#0#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'Pa' - +'rentFont'#8#8'TabOrder'#2#22#0#0#9'TCheckBox'#10'CheckBox24'#4'Left'#3#223#0 - +#6'Height'#2#17#3'Top'#3#184#0#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6 - +'Action'#10'ParentFont'#8#8'TabOrder'#2#23#0#0#9'TCheckBox'#10'CheckBox25'#4 - +'Left'#3'?'#1#6'Height'#2#17#3'Top'#2#16#5'Width'#2'2'#11'AllowGrayed'#9#7'C' - +'aption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#24#0#0#9'TCheckBox'#10'C' - +'heckBox26'#4'Left'#3'?'#1#6'Height'#2#17#3'Top'#2'('#5'Width'#2'2'#11'Allow' - +'Grayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#25#0#0#9'TC' - +'heckBox'#10'CheckBox27'#4'Left'#3'?'#1#6'Height'#2#17#3'Top'#2'@'#5'Width'#2 - +'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2 - +#26#0#0#9'TCheckBox'#10'CheckBox28'#4'Left'#3'?'#1#6'Height'#2#17#3'Top'#2'X' - +#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'T' - +'abOrder'#2#27#0#0#9'TCheckBox'#10'CheckBox29'#4'Left'#3'?'#1#6'Height'#2#17 - +#3'Top'#2'p'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'Paren' - +'tFont'#8#8'TabOrder'#2#28#0#0#9'TCheckBox'#10'CheckBox30'#4'Left'#3'?'#1#6 - +'Height'#2#17#3'Top'#3#136#0#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6 - +'Action'#10'ParentFont'#8#8'TabOrder'#2#29#0#0#9'TCheckBox'#10'CheckBox31'#4 - +'Left'#3'?'#1#6'Height'#2#17#3'Top'#3#160#0#5'Width'#2'2'#11'AllowGrayed'#9#7 - +'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#30#0#0#9'TCheckBox'#10 - +'CheckBox32'#4'Left'#3'?'#1#6'Height'#2#17#3'Top'#3#184#0#5'Width'#2'2'#11'A' - +'llowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2#31#0#0#9 - +'TCheckBox'#10'CheckBox33'#4'Left'#3#167#1#6'Height'#2#17#3'Top'#2#16#5'Widt' - +'h'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrde' - +'r'#2' '#0#0#9'TCheckBox'#10'CheckBox34'#4'Left'#3#167#1#6'Height'#2#17#3'To' - +'p'#2'('#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFon' - +'t'#8#8'TabOrder'#2'!'#0#0#9'TCheckBox'#10'CheckBox35'#4'Left'#3#167#1#6'Hei' - +'ght'#2#17#3'Top'#2'@'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action' - +#10'ParentFont'#8#8'TabOrder'#2'"'#0#0#9'TCheckBox'#10'CheckBox36'#4'Left'#3 - +#167#1#6'Height'#2#17#3'Top'#2'X'#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption' - +#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2'#'#0#0#9'TCheckBox'#10'CheckBox3' - +'7'#4'Left'#3#167#1#6'Height'#2#17#3'Top'#2'p'#5'Width'#2'2'#11'AllowGrayed' - +#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2'$'#0#0#9'TCheckBox' - +#10'CheckBox38'#4'Left'#3#167#1#6'Height'#2#17#3'Top'#3#136#0#5'Width'#2'2' - +#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'TabOrder'#2'%'#0 - +#0#9'TCheckBox'#10'CheckBox39'#4'Left'#3#167#1#6'Height'#2#17#3'Top'#3#160#0 - +#5'Width'#2'2'#11'AllowGrayed'#9#7'Caption'#6#6'Action'#10'ParentFont'#8#8'T' - +'abOrder'#2'&'#0#0#0#6'TPanel'#8'pnFilter'#4'Left'#2#0#6'Height'#3#192#0#3'T' - +'op'#3#216#0#5'Width'#3#31#2#5'Align'#7#5'alTop'#12'ClientHeight'#3#192#0#11 - +'ClientWidth'#3#31#2#10'ParentFont'#8#8'TabOrder'#2#1#0#12'TRadioButton'#5'r' - +'bOne'#4'Left'#3'C'#1#6'Height'#2#17#3'Top'#2' '#5'Width'#3#157#0#7'Caption' - +#6#26'Have one of genres checked'#10'ParentFont'#8#8'TabOrder'#2#1#0#0#12'TR' - +'adioButton'#5'rbAll'#4'Left'#3'C'#1#6'Height'#2#17#3'Top'#2#8#5'Width'#3#131 - +#0#7'Caption'#6#22'Have all genre checked'#7'Checked'#9#10'ParentFont'#8#8'T' - +'abOrder'#2#0#7'TabStop'#9#0#0#9'TCheckBox'#9'cbOnlyNew'#4'Left'#3'C'#1#6'He' - +'ight'#2#17#3'Top'#2'8'#5'Width'#3#134#0#7'Caption'#6#21'Search only new man' - +'ga'#10'ParentFont'#8#8'TabOrder'#2#2#0#0#5'TEdit'#13'edFilterTitle'#4'Left' - ,#2'~'#6'Height'#2#21#3'Top'#2#8#5'Width'#3#146#0#8'TabOrder'#2#3#0#0#5'TEdit' - +#15'edFilterArtists'#4'Left'#2'~'#6'Height'#2#21#3'Top'#2'8'#5'Width'#3#146#0 - +#8'TabOrder'#2#4#0#0#5'TEdit'#15'edFilterAuthors'#4'Left'#2'~'#6'Height'#2#21 - +#3'Top'#2' '#5'Width'#3#146#0#8'TabOrder'#2#5#0#0#6'TLabel'#13'lbFilterTitle' - +#4'Left'#2''''#6'Height'#2#16#3'Top'#2#8#5'Width'#2#27#9'Alignment'#7#14'taR' - +'ightJustify'#8'BidiMode'#7#13'bdRightToLeft'#7'Caption'#6#5'Title'#11'Font.' - +'Height'#2#243#10'Font.Style'#11#6'fsBold'#0#14'ParentBidiMode'#8#11'ParentC' - +'olor'#8#10'ParentFont'#8#0#0#6'TLabel'#15'lbFilterAuthors'#4'Left'#2''''#6 - +'Height'#2#16#3'Top'#2' '#5'Width'#2'5'#9'Alignment'#7#14'taRightJustify'#8 - +'BidiMode'#7#13'bdRightToLeft'#7'Caption'#6#7'Authors'#11'Font.Height'#2#243 - +#10'Font.Style'#11#6'fsBold'#0#14'ParentBidiMode'#8#11'ParentColor'#8#10'Par' - +'entFont'#8#0#0#6'TLabel'#15'lbFilterArtists'#4'Left'#2''''#6'Height'#2#16#3 - +'Top'#2'8'#5'Width'#2'-'#9'Alignment'#7#14'taRightJustify'#8'BidiMode'#7#13 - +'bdRightToLeft'#7'Caption'#6#7'Artists'#11'Font.Height'#2#243#10'Font.Style' - +#11#6'fsBold'#0#14'ParentBidiMode'#8#11'ParentColor'#8#10'ParentFont'#8#0#0#9 - +'TComboBox'#14'cbFilterStatus'#4'Left'#2'~'#6'Height'#2#21#3'Top'#2'P'#5'Wid' - +'th'#3#146#0#10'ItemHeight'#2#13#9'ItemIndex'#2#2#13'Items.Strings'#1#6#9'Co' - +'mpleted'#6#7'Ongoing'#6#6''#0#8'TabOrder'#2#6#4'Text'#6#6''#0#0 - +#6'TLabel'#14'lbFilterStatus'#4'Left'#2''''#6'Height'#2#16#3'Top'#2'P'#5'Wid' - +'th'#2'+'#9'Alignment'#7#14'taRightJustify'#8'BidiMode'#7#13'bdRightToLeft'#7 - +'Caption'#6#6'Status'#11'Font.Height'#2#243#10'Font.Style'#11#6'fsBold'#0#14 - +'ParentBidiMode'#8#11'ParentColor'#8#10'ParentFont'#8#0#0#6'TLabel'#15'lbFil' - +'terSummary'#4'Left'#2''''#6'Height'#2#16#3'Top'#2'h'#5'Width'#2'<'#9'Alignm' - +'ent'#7#14'taRightJustify'#8'BidiMode'#7#13'bdRightToLeft'#7'Caption'#6#7'Su' - +'mmary'#11'Font.Height'#2#243#10'Font.Style'#11#6'fsBold'#0#14'ParentBidiMod' - +'e'#8#11'ParentColor'#8#10'ParentFont'#8#0#0#5'TEdit'#15'edFilterSummary'#4 - +'Left'#2'~'#6'Height'#2#21#3'Top'#2'h'#5'Width'#3'a'#1#8'TabOrder'#2#7#0#0#7 - +'TButton'#8'btFilter'#4'Left'#2''''#6'Height'#2'%'#3'Top'#3#139#0#5'Width'#3 - +#130#0#7'Caption'#6#6'Filter'#10'Font.Color'#7#11'clHighlight'#11'Font.Heigh' - +'t'#2#243#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#13'btFilterClick'#10'Pa' - +'rentFont'#8#8'TabOrder'#2#8#0#0#7'TButton'#13'btFilterReset'#4'Left'#3'_'#1 - +#6'Height'#2'%'#3'Top'#3#139#0#5'Width'#3#128#0#7'Caption'#6#11'Reset value' - +#11'Font.Height'#2#243#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#18'btFilte' - +'rResetClick'#10'ParentFont'#8#8'TabOrder'#2#9#0#0#7'TBitBtn'#19'btRemoveFil' - +'terLarge'#19'AnchorSideLeft.Side'#7#9'asrBottom'#18'AnchorSideTop.Side'#7#9 - +'asrBottom'#4'Left'#3#191#0#6'Height'#2'%'#4'Hint'#6#13'Remove filter'#3'Top' - +#3#139#0#5'Width'#3#136#0#7'Caption'#6#13'Remove filter'#11'Font.Height'#2 - +#243#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#19'btRemoveFilterClick'#10'P' - +'arentFont'#8#14'ParentShowHint'#8#8'ShowHint'#9#8'TabOrder'#2#10#0#0#0#0#0#9 - +'TTabSheet'#11'tsFavorites'#7'Caption'#6#9'Favorites'#12'ClientHeight'#3#184 - +#1#11'ClientWidth'#3'#'#2#0#18'TVirtualStringTree'#11'vtFavorites'#4'Left'#2 - +#0#6'Height'#3't'#1#3'Top'#2#0#5'Width'#3'#'#2#5'Align'#7#5'alTop'#7'Anchors' - +#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#11'DefaultText'#6#4'Node'#20 - +'Header.AutoSizeIndex'#2#0#14'Header.Columns'#14#1#8'Position'#2#0#4'Text'#6 - +#5'Title'#5'Width'#3#150#0#0#1#8'Position'#2#1#4'Text'#6#15'Current chapter' - +#5'Width'#2'd'#0#1#8'Position'#2#2#4'Text'#6#7'Website'#5'Width'#2'A'#0#1#8 - +'Position'#2#3#4'Text'#6#7'Save to'#5'Width'#3#200#0#0#0#20'Header.DefaultHe' - +'ight'#2#24#13'Header.Height'#2#24#14'Header.Options'#11#14'hoColumnResize'#6 - +'hoDrag'#16'hoShowSortGlyphs'#9'hoVisible'#0#12'Header.Style'#7#9'hsXPStyle' - +#8'TabOrder'#2#0#0#0#0#9'TTabSheet'#8'tsOption'#7'Caption'#6#7'Options'#12'C' - +'lientHeight'#3#160#1#11'ClientWidth'#3'!'#2#0#12'TPageControl'#9'pnOptions' - +#4'Left'#2#9#6'Height'#3'C'#1#3'Top'#2#26#5'Width'#3#14#2#10'ActivePage'#7#19 - +'tsOptionConnections'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom' - +#0#8'TabIndex'#2#0#8'TabOrder'#2#0#0#9'TTabSheet'#19'tsOptionConnections'#7 - +'Caption'#6#11'Connections'#12'ClientHeight'#3')'#1#11'ClientWidth'#3#6#2#0 - +#10'TScrollBox'#21'sbDownloadConnections'#4'Left'#2#0#6'Height'#3')'#1#3'Top' - +#2#0#5'Width'#3#6#2#18'HorzScrollBar.Page'#3#2#2#18'VertScrollBar.Page'#3'%' - +#1#5'Align'#7#8'alClient'#12'ClientHeight'#3'%'#1#11'ClientWidth'#3#2#2#8'Ta' - +'bOrder'#2#0#0#9'TCheckBox'#16'cbOptionUseProxy'#4'Left'#2' '#6'Height'#2#17 - +#3'Top'#3#154#0#5'Width'#2'E'#7'Caption'#6#9'Use proxy'#8'OnChange'#7#22'cbO' - +'ptionUseProxyChange'#10'ParentFont'#8#8'TabOrder'#2#0#0#0#9'TGroupBox'#13'g' - +'bOptionProxy'#4'Left'#2#12#6'Height'#2'h'#3'Top'#3#178#0#5'Width'#3#240#1#7 - +'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Caption'#6#12'Proxy config'#12 - +'ClientHeight'#2'T'#11'ClientWidth'#3#236#1#7'Enabled'#8#8'TabOrder'#2#1#0#6 - ,'TLabel'#12'lbOptionHost'#4'Left'#2#14#6'Height'#2#13#3'Top'#2#14#5'Width'#2 - +#26#7'Caption'#6#4'Host'#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#10 - +'ParentFont'#8#0#0#6'TLabel'#12'lbOptionPort'#4'Left'#2#14#6'Height'#2#13#3 - +'Top'#2'.'#5'Width'#2#24#7'Caption'#6#4'Port'#11'ParentColor'#8#0#0#5'TEdit' - +#12'edOptionHost'#4'Left'#2'7'#6'Height'#2#23#3'Top'#2#7#5'Width'#3#154#0#12 - +'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9'Font.Name'#6#7'Def' - +'ault'#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#8'TabOrder'#2#0#0#0#5 - +'TEdit'#12'edOptionPort'#4'Left'#2'7'#6'Height'#2#23#3'Top'#2''''#5'Width'#3 - +#154#0#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9'Font.Name' - +#6#7'Default'#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#8'TabOrder'#2#1 - +#0#0#6'TLabel'#12'lbOptionUser'#19'AnchorSideLeft.Side'#7#9'asrBottom'#18'An' - +'chorSideTop.Side'#7#9'asrBottom'#4'Left'#3#230#0#6'Height'#2#13#3'Top'#2#14 - +#5'Width'#2':'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#8'Username' - +#11'ParentColor'#8#0#0#6'TLabel'#12'lbOptionPass'#19'AnchorSideLeft.Side'#7#9 - +'asrBottom'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#3#234#0#6'Height'#2 - +#13#3'Top'#2'.'#5'Width'#2'6'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption' - +#6#8'Password'#11'ParentColor'#8#0#0#5'TEdit'#12'edOptionUser'#19'AnchorSide' - +'Left.Side'#7#9'asrBottom'#18'AnchorSideTop.Side'#7#9'asrBottom'#4'Left'#3',' - +#1#6'Height'#2#23#3'Top'#2#7#5'Width'#3#154#0#7'Anchors'#11#5'akTop'#7'akRig' - +'ht'#0#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9'Font.Name' - +#6#7'Default'#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#8'TabOrder'#2#2 - +#0#0#5'TEdit'#12'edOptionPass'#19'AnchorSideLeft.Side'#7#9'asrBottom'#18'Anc' - +'horSideTop.Side'#7#9'asrBottom'#4'Left'#3','#1#6'Height'#2#23#3'Top'#2''''#5 - +'Width'#3#154#0#7'Anchors'#11#5'akTop'#7'akRight'#0#12'Font.CharSet'#7#12'AN' - +'SI_CHARSET'#11'Font.Height'#2#244#9'Font.Name'#6#7'Default'#10'ParentFont'#8 - +#8'TabOrder'#2#3#0#0#0#9'TSpinEdit'#19'seOptionMaxParallel'#4'Left'#2#12#6'H' - +'eight'#2#21#3'Top'#2#26#5'Width'#2'0'#8'MaxValue'#2#8#8'MinValue'#2#1#10'Pa' - +'rentFont'#8#14'ParentShowHint'#8#8'TabOrder'#2#2#5'Value'#2#1#0#0#6'TLabel' - +#19'lbOptionMaxParallel'#4'Left'#2'L'#6'Height'#2#13#3'Top'#2#26#5'Width'#3 - +#10#1#7'Caption'#6'4Number of downloaded tasks at the same time (Max: 8)'#11 - +'ParentColor'#8#10'ParentFont'#8#0#0#6'TLabel'#17'lbOptionMaxThread'#4'Left' - +#2'L'#6'Height'#2#13#3'Top'#2':'#5'Width'#3'.'#1#7'Caption'#6'=Number of dow' - +'nloaded files per task at the same time (Max: 8)'#11'ParentColor'#8#10'Pare' - +'ntFont'#8#0#0#9'TSpinEdit'#17'seOptionMaxThread'#4'Left'#2#12#6'Height'#2#21 - +#3'Top'#2':'#5'Width'#2'0'#8'MaxValue'#2#8#8'MinValue'#2#1#10'ParentFont'#8 - +#14'ParentShowHint'#8#8'TabOrder'#2#3#5'Value'#2#1#0#0#9'TSpinEdit'#16'seOpt' - +'ionMaxRetry'#4'Left'#2#12#6'Height'#2#21#3'Top'#2'Z'#5'Width'#2'0'#8'MaxVal' - +'ue'#2#0#10'ParentFont'#8#14'ParentShowHint'#8#8'TabOrder'#2#4#0#0#6'TLabel' - +#16'lbOptionMaxRetry'#4'Left'#2'L'#6'Height'#2#13#3'Top'#2'Z'#5'Width'#3'c'#1 - +#7'Caption'#6'HNumber of retry times if tasks have download problems (0 = al' - +'ways retry)'#11'ParentColor'#8#10'ParentFont'#8#0#0#0#0#9'TTabSheet'#8'tsSa' - +'veTo'#7'Caption'#6#7'Save to'#12'ClientHeight'#3')'#1#11'ClientWidth'#3#6#2 - +#0#12'TLabeledEdit'#19'edOptionDefaultPath'#4'Left'#2#28#6'Height'#2#21#3'To' - +'p'#2'*'#5'Width'#3#198#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0' Edi' - +'tLabel.AnchorSideLeft.Control'#7#19'edOptionDefaultPath!EditLabel.AnchorSid' - +'eRight.Control'#7#19'edOptionDefaultPath'#30'EditLabel.AnchorSideRight.Side' - +#7#9'asrBottom"EditLabel.AnchorSideBottom.Control'#7#19'edOptionDefaultPath' - +#14'EditLabel.Left'#2#28#16'EditLabel.Height'#2#13#13'EditLabel.Top'#2#26#15 - +'EditLabel.Width'#3#198#1#17'EditLabel.Caption'#6#29'Choose default download' - +' path:'#21'EditLabel.ParentColor'#8#20'EditLabel.ParentFont'#8#10'ParentFon' - +'t'#8#8'TabOrder'#2#0#0#0#0#0#7'TButton'#13'btOptionApply'#4'Left'#2'&'#6'He' - +'ight'#2'!'#3'Top'#3'm'#1#5'Width'#2'c'#7'Anchors'#11#8'akBottom'#0#7'Captio' - +'n'#6#5'Apply'#7'OnClick'#7#18'btOptionApplyClick'#8'TabOrder'#2#1#0#0#0#0#9 - +'TSplitter'#14'spMainSplitter'#23'AnchorSideRight.Control'#7#6'pcMain'#4'Lef' - +'t'#3#195#0#6'Height'#3#210#1#3'Top'#2#8#5'Width'#2#5#5'Align'#7#6'alNone'#7 - +'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#0#0#22'TSelectDirectoryDialog' - +#9'dlgSaveTo'#4'left'#2'P'#3'top'#3#184#0#0#0#10'TPopupMenu'#10'pmDownload'#4 - +'left'#2'P'#3'top'#3#239#0#0#9'TMenuItem'#14'miDownloadStop'#7'Caption'#6#4 - +'Stop'#7'OnClick'#7#19'miDownloadStopClick'#0#0#9'TMenuItem'#16'miDownloadRe' - +'muse'#7'Caption'#6#6'Resume'#7'OnClick'#7#21'miDownloadResumeClick'#0#0#9'T' - +'MenuItem'#16'miDownloadRemove'#7'Caption'#6#6'Remove'#7'OnClick'#7#21'miDow' - +'nloadRemoveClick'#0#0#9'TMenuItem'#29'miDownloadRemoveFinishedTasks'#7'Capt' - +'ion'#6#21'Remove finished tasks'#7'OnClick'#7'"miDownloadRemoveFinishedTask' - +'sClick'#0#0#0#10'TPopupMenu'#13'pmChapterList'#4'left'#2'P'#3'top'#3'('#1#0 - ,#9'TMenuItem'#26'miChapterListCheckSelected'#7'Caption'#6#14'Check selected' - +#7'OnClick'#7#31'miChapterListCheckSelectedClick'#0#0#9'TMenuItem'#28'miChap' - +'terListUncheckSelected'#7'Caption'#6#16'Uncheck selected'#7'OnClick'#7'!miC' - +'hapterListUncheckSelectedClick'#0#0#9'TMenuItem'#4'miI1'#7'Caption'#6#1'-'#0 - +#0#9'TMenuItem'#21'miChapterListCheckAll'#7'Caption'#6#9'Check all'#7'OnClic' - +'k'#7#26'miChapterListCheckAllClick'#0#0#9'TMenuItem'#23'miChapterListUnchec' - +'kAll'#7'Caption'#6#11'Uncheck all'#7'OnClick'#7#28'miChapterListUncheckAllC' - +'lick'#0#0#0#0 -]); diff --git a/mangadownloader/languages/fmd.de.po b/mangadownloader/languages/fmd.de.po new file mode 100644 index 000000000..4ddb2abc0 --- /dev/null +++ b/mangadownloader/languages/fmd.de.po @@ -0,0 +1,2578 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: DE\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: Novellis\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: de\n" +"X-Generator: Poedit 2.0.2\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abbrechen" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Gescheitert" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Download Originalbilder (benötigt ExHentai account)" + +#: ehentai.rs_settingsimagesize +#| msgid "Image size" +msgid "Image size:" +msgstr "Bildgröße" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Bist du dir sicher, dass du den Account löschen willst?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Prüfen" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Ungültig" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Unbekannt" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Benutzername oder Passwort kann nicht leer sein!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Importierung abgeschlossen." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Liste von nicht importierten Manga" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Prüfe..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "" + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Alle Downloads" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&OK" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Abbrechen" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Prüfe..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Keine Verbindung zum Server." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Keine Manga-Informationen abrufbar. Bitte prüfen Sie ihre Internetverbindung und versuchen Sie es erneut." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Download zähler:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "Wählen Sie zumindest eine Manga-Webseite aus!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Sind Sie sicher, dass Sie beenden wollen?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Sind Sie sicher, dass Sie die Favoriten löschen wollen?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Sind Sie sicher, dass Sie alle abgeschlossenen Aufgaben löschen wollen?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Sind Sie sicher, dass Sie dieses Items löschen wollen?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Sind Sie sicher, dass Sie alle Aufgaben löschen wollen?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Download aufteilen" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Dieser Titel ist bereits in der Downloadliste.\n" +"Wollen Sie ihn dennoch laden?\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Tippe neues Kapitel ein:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Tippe neuen Speicherpfad ein:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Aktualisierung läuft!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Möchten Sie die Mangaliste vom Server laden?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "URL wird nicht unterstützt!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Lade alle\n" +"Zu den Favoriten hinzufügen\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Abgeschlossen\n" +"Fortlaufend\n" +"\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader läuft bereits!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"Es gibt ein Problem mit dieser Datei!\n" +"Entfernen und wieder hinzufügen dieser Datei könnte das Problem beheben.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "Verlauf" + +#: frmmain.rs_import +msgid "Import" +msgstr "Import" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Artist(en):" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Autor(en):" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Genre(s):" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Status:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Zusammenfassung:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Titel:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Webseite:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "Im Gange" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Automatisch nach neuen Kapitel alle %d Minuten suchen" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Pfad zum Manga\n" +"%s : Kapitel Dateiname\n" +"\n" +"Beispiel : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Lade ..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Modus: Zeig alle (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Mode: Gefiltert (%d)" + +#: frmmain.rs_modesearching +#| msgid "Searching..." +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Mode: Suche..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Ein Monat" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Eine Woche" + +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Nichts\n" +"Verlassen\n" +"Herunterfahren\n" +"Ruhezustand\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Ausgewählt: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Software" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Pfad zur Software (z.B. C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Heute" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Fehlerhafte Eingabe!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Gestern" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "FMD wird beendet in %d Sekunden." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "System wird in den Ruhemodus versetzt in %d Sekunden." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "System wird heruntergefahren in %d Sekunden." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Ungültig" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Initialisierungs Vektor:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Schlüssel:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Zeige alle Sprachen" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Zeige Scanlation Group" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Entferne Wasserzeichen" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Speichern als PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abbrechen" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Gescheitert" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Bearbeiten" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Aktualisieren" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +#| msgid "Username" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Webseite" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Benutzername" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Status" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "Abbrechen" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Ok" + +#: taccountsetform.caption +msgid "Account" +msgstr "" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Passwort anzeigen" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Passwort" + +#: taccountsetform.edusername.texthint +#| msgid "Status" +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Benutzername" + +#: taccountsetform.label2.caption +#| msgid "Status" +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Benutzername" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Passwort" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Basisliste " + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Kapitelliste" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Favoritenliste" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Mangaliste" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Zu den Favoriten hinzufügen" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&schließen" + +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Alles laden" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Sauber" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Oben bleiben" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Protokolllimit" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Kopieren" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Abbrechen" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&OK" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Pfad zur Software (z.B. C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Software:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Aktualisierungsliste abbrechen" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Zu den Favoriten hinzufügen" + +#: tmainform.btchecklatestversion.caption +#| msgid "Check for new version" +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Auf neuste Version prüfen" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Protokolldatei löschen" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Download" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Download aufteilen" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Auf neues Kapitel überprüfen" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Importiere Liste" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Filter" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Wert zurücksetzen" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Öffne Protokoll" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Anwenden" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Online lesen" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Entferne Filter" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Entferne Filter" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Aktualisiere Manga-Liste" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Besuche meinen Blog" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Zur Downloadliste als angehaltene Aufgabe hinzufügen" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Nur nach neuen Manga suchen." + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" +msgid "Automatic download after finish checking" +msgstr "Automatisch runterladen nach abgeschlossener Aktualisierung" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Automatisches auf neue Kapitel in einem Zeitabstand" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" +msgid "Automatic remove completed manga from Favorites" +msgstr "Automatisches Entfernen abgeschlosser Manga aus den Favoriten" + +#: tmainform.cboptionautocheckfavstartup.caption +#| msgid "Automatic check for new chapter at startup" +msgid "Auto check for new chapter at startup" +msgstr "Automatisch auf neue Kapitel beim Start prüfen" + +#: tmainform.cboptionautochecklatestversion.caption +#| msgid "Check for new version " +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Automatisch auf neuste Version prüfen " + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Öffne Favoriten beim Start" + +#: tmainform.cboptionchangeunicodecharacter.caption +#| msgid "Change all all character to" +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Ersetze alle Unicode Zeichen mit" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Aktiviere dies, falls du Probleme mit Unicode Zeichen in diesem Pfad hast" + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Kapitel" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Band" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Aktiviere Manga-Cover laden" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Automatischen Kapitel-Ordner erzeugen" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" +msgid "Auto generate folder based on manga's name" +msgstr "Auto generate folder based on manga's name" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Aktiviere live search (langsam bei langen Listen)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Minimieren beim Start" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Minimieren in die Ablage" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "FMD nur einmal ausführen lassen" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Entferne Manga-Name aus dem Kapitel" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Show balloon hint" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Lösche Aufgabe/Favorite" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Lade Manga-Liste falls leer" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Zeige Download-Symbolleiste" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Zeige \"Lösche alle abgeschlossenen Aufgaben\" in Download-Symbolleiste" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "FMD beenden" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Lade keine Manga-Informationen, wenn die Liste sich aktualisiert (Filter wird nicht funktionieren!)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Remove duplicate local data when updating manga list" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Benutze proxy" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Suche in allen Manga-Seiten" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Für mehr Manga-Seiten, bitte geh in die Optionen->Manga-Seiten" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Regular Expression" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Show Drop Box" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Aufzeichnung aktivieren" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Action" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Ein Werk, das typischwerise Kampf, Gewalt, Chaos und schnelle Bewegungen darstellt." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Erwachsen" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Enthält Inhalte, die nur für Erwachsene geeignet sind. Titel in dieser Kategorie können eine ausgedehnte Szenen intensiver Gewalt und / oder grafisch-sexuelle Inhalte und Nacktheit beinhalten." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Abenteuer" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Wenn ein Charakter in der Geschichte auf einer Reise geht oder entlang dieser Richtung, kannst du darauf wetten, dass es ein Abenteuer-Manga ist. Ansonsten obliegt es ganz deiner persönlichen Einschätzung auf diesen Fall." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Komödie" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Ein dramatisches Werk, das leicht und oft witzig oder satirisch im Ton ist, und dass in der Regel eine glückliche Auflösung des thematischen Konflikts enthält." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Fan basierte Arbeit, inspiriert von offiziellen Manga / Anime." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Drama" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Eine Arbeit, die eine emotionale Reaktion, wie intesiven Schwermut oder Spannung, auslösen will." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Möglicherweise die dünne Linie zwischen Hentai und nicht-Hentai. Ecchi baut auf Fanservice, um bestimmte Gruppe von Fans zu gewinnen." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantasie" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Alles was, aber nicht ausschließlich, Magie, Traumwelt, und Märchen behandelt." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Transvestit (Gender Bender)" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Mädchen verkleiden sich als Jungs, Jungs verkleiden sich als Mädchen.\n" +"Jungs verwandeln sich in Mädchen, Mädchen verwandeln sich in Jungs.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harem" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "Eine Serie, die sich um einen männlichen Charakter und viele weiblichen Charaktere (die in der Regel sich zu dem männlichen Charakter hingezogen fühlen) dreht. Ein \"Reverse Harem\" ist es wiederum, wenn die Geschlechter vertauscht sind." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Historisch" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Handelt von alten oder antiken Zeiten." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Horror" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Ein schmerzhaftes Gefühl der Angst, Furcht und Verachtung; ein Schauern mit Terror und Verabscheuung; das Gefühl, inspiriert von etwas schrecklichem und schockierendem." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Buchstäblich übersetzt „Frau“. Zielt auf Frauen zwischen 18-30 ab. Weibliches Äquivalent zu Seinen. Im Gegensatz zu Shoujo ist die Romantik realistischer und weniger idealisiert. Das Geschichtenerzählung ist expliziter und reifer." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Stellvertretend für eine sexuelle Anziehung zu jungen oder minderjährigen Mädchen." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Kampfsport" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "Wie der Name schon sagt, alles was mit Kampfkunst zutun hat. Behandelt verschiedene Arten von Kampfsport oder Selbstverteidigung, wie Aikido, Karate, Judo oder Taekwondo, Kendo, Fechten, und so weiter und so fort." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Erwachsen" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "Behandelt Themen, die für Menschen unter dem Alter von 17 vielleicht zu extrem sind. Titel in dieser Kategorie enthalten möglicherweise intensive Gewalt, Blut und Gore, sexuellen Inhalt und / oder Kraftausdrücke." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mecha" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Ein Werk, das in der Regel alle Arten von großen Robotermaschinen behandelt und normalerweise darauf konzentriert." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Mystery" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Üblicherweise tritt ein unerklärliche Ereignis ein, und die Hauptfigur versucht, herauszufinden, was es verursacht hat." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psychologisch" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Normalerweise befasst es sich mit der Philosophie des Geisteszustandes, in den meisten Fällen schildert es abnorme Psychologie." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romantik" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Jede Liebe behandelnde Geschichte. Wir werden in diesem Fall Liebe als etwas zwischen Mann und Frau definieren. Ansonsten obliegt es deiner Vorstellung, was du als Liebe definierst." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Schulleben" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Ein umfangreicher Teil des Schauplatzes der Geschichte befaßt sich mit irgendeiner Art von Schule." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Sci-Fi" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Abkürzung für Science Fiction. Diese Werke bauen auf Wendungen in technischen und anderen wissenschaftlich verwandten Phänomenen, welche Gegensätze oder Erweiterungen der monderen wissenschaftlichen Welt sind." + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "Von Google: Sein bedeutet wörtlich ‚junger Mann‘. Manga und Anime, die speziell auf junge, erwachsene Männer im Alter von 18 bis 25 abzielt. Die Geschichten in Seinen-Werken appellieren an Studenten und diejenigen in der Arbeitswelt. Normalerweise beschäftigen sich die Geschichten mit den Problem des Erwachsenseins." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Stellvertretend für eine sexuelle Anziehung zu jungen oder minderjährigen Jungs." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Eine Arbeit bestimmt und in erster Linie für Frauen geschrieben. Normalerweise bedeutet das eine Menge Romantik und starke Charakter-Entwicklung." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "Oft gleichbedeutend mit \"Yuri\". Es kann als etwas weniger extrem betrachtet werden. „Girl' Love“, sozusagen." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Eine Arbeit bestimmt und in erster Linie für Männer geschrieben. Normalerweise bedeutet das Kämpfe und/oder Gewalt." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "Oft gleichbedeutend mit \"Yaoi\". Es kann als etwas weniger extrem betrachtet werden. „Boy's Love“, sozusagen." + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Alltag/Ein Stück aus dem Leben" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "Wie der Name schon sagt, stellt dieses Genre die Tag-zu-Tag Sorgen eines/vieler Charakters/Charaktere dar. Diese Herausforderungen/Ereignisse könnten eigentlich im wirklichen Leben passieren und sind oft -Wenn nicht immer- in der gegenwärtigen Zeit, in einer uns gespiegelten Welt, angesiedelt." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Schweinekram" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Behandelt Serien, die als Profan oder Beleidigend betracht werden können, insbesondere im Hinblick auf sexuelle Inhalte." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Sport" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "Genre Sport = Sport. Welche eine Überraschung. Handelt von allem, was irgendwie Sport-Verwandt ist. Baseball, Basketball, Hockey, Fußball, Golf und Rennsport um nur einige zu nennen." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Übernatürlich" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Handelt normalerweise von erstaunlichen und unerklärlichen Kräften oder Ereignissen, die den Gesetzen der Physik trotzen." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Tragik" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Behandelt Ereignisse, die in großen Verlust und Unglück resultieren." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Diese Arbeit beinhaltet in der Regel intime Beziehungen zwischen Männern." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Diese Arbeit beinhaltet in der Regel intime Beziehungen zwischen Frauen." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Eingabe individueller Genres, durch Komma getrennt" + +#: tmainform.eddownloadssearch.texthint +#| msgid "Search favorites..." +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Downloads durchsuchen..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Favoriten durchsuchen..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Artist" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Autor" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Filter" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Zusammenfassungsteil" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Titel" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Suche Titel..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" +msgid "Custom rename" +msgstr "Benutzerdefinierte Umbenennung" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Standarddownloadpfad" + +#: tmainform.edoptionexternalparams.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalparams.texthint" +msgid "External program parameters" +msgstr "Externe Programmparameter" + +#: tmainform.edoptionexternalpath.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalpath.texthint" +msgid "External program path" +msgstr "Externer Programmpfad" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Benutzerdefinierte Umbenennung" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Proxy host/IP" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Benutzerdefinierte Umbenennung" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Proxy passwort" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Proxy Benutzername" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Speichern unter" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "URL hier einfügen" + +#: tmainform.edwebsitessearch.texthint +#| msgid "Search..." +msgctxt "tmainform.edwebsitessearch.texthint" +msgid "Search website..." +msgstr "Durchsuche webseite..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Zeige Dialogbestätigungen für" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Drop Box" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Externes Programm" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Favoriten" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Proxy Einstellung" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Umbenennung" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Wähle den Standarddownloadpfad:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Opazität" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Artist" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Autor" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Eigene Genres" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Genres:\n" +"- Ausgewählt: Dieses Genre einschließe\n" +"- Abgewählt: Dieses Genre ausschließen.\n" +"- Grau: Egal.\n" +"\n" +"Eigene Genres:\n" +"- Separiere mehrere Genres mit ','.\n" +"- Schließe ein Genre aus mit '!' oder '-' am Anfang eines Genre.\n" +"- Beispiel: Abenteuer, !Ecchi, Komödie.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Status" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Zusammenfassung" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Titel" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Protokolldatei:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Modus: Zeig alle (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" +msgid "Auto check for new chapter every %d minutes" +msgstr "Automatisch nach neuen Kapitel alle %d Minuten suchen" + +#: tmainform.lboptionchaptercustomrename.caption +#| msgid "Chapter folder name:" +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Kapitelname:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Webseite name\n" +"%MANGA% : Manga Titel\n" +"%CHAPTER% : Kapitelname\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Nummerierung\n" +"\n" +"Hinweis:\n" +"Kapitelordner muss mindest %CHAPTER% oder %NUMBERING% haben.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Verbindungsunterbrechung (sekunden)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Öffne Manga durch Nutzung eines externen Programmes:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Parameter:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "tmainform.lboptionexternalparamshint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Dateiname:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga Titel\n" +"%CHAPTER% : Kapitelname\n" +"%FILENAME% : Dateiname\n" +"\n" +"Note:\n" +"Der Dateiname muss mindest %FILENAME% haben. \n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Host" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Sprache:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "Nachdem der Download abgeschlossen ist:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Manga Ordnername:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Webseite name\n" +"%MANGA% : Manga Titel\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga Ordnername muss mindest %MANGA% haben.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Anzahl von Downloads zur selben Zeit" + +#: tmainform.lboptionmaxretry.caption +#| msgid "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Anzahl der erneuten Versuche, falls der Download Probleme hat (-1 =immer wiederholen)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Anzahl der Download-Dateien je Aufgabe zur selben Zeit" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Neuer Manga basierend auf seiner Aktualisierungszeit (täglich)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Passwort" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "PDF Komprimierungsstufe" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (Verlustfrei), Niedriger = DCTEncode (verlustbehaftet)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Port" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Type" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Rename digits" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Benutzername" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Speichern unter:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Löschen" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Kopieren" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Schneiden" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Einfügen" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Einfügen und los" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Alles auswählen" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Öffnen" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Abbrechen" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Aufsteigend" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Alles auswählen" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Prüfen ausgewählt" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Absteigend" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Filter" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Verstecke geladene Kapitel" + +#: tmainform.michapterlisthighlight.caption +#| msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" +msgstr "Hebe geladene Kapitel hervor" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Alles abwählen" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Uncheck selected" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Löschen" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Lösche alle abgeschlossenen Aufgaben" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Nur Aufgaben" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Aufgaben + Daten" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Aufgaben + Daten + Favoriten" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Deaktiviere" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Aktiviere" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Verschmelze abgeschlossene Aufgaben" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Öffne Ordner" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Öffne ..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Fortsetzen" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Stop" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Zeige Manga-Information" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Ändere \"Derzeitiges Kapitel\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Ändere \"Speichern unter\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Nach neuen Kapitel suchen" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Löschen" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Deaktiviere" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Alles laden" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Aktiviere" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Öffne Ordner" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Öffne ..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Nach neuen Kapitel suchen anhalten" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Zeige Manga-Informationen" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Neue Manga hervorheben" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Zu den Favoriten hinzufügen" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Löschen" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Alles laden" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Zeige Manga-Informationen" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "After download finish" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Beenden" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Beenden" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernate" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Nichts" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Herunterfahren" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Wiederherstellen" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Alle fortsetzen" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "Show Drop Box" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Alle anhalten" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Lade alle Listen aufeinmal vom Server" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Check all" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Indeterminate all" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Uncheck all" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Aktualisiere alle Listen gleichzeitig" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Download manga list from server" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Aktualisiere Manga-Liste" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Have all genre checked" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Have one of genres checked" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Modus" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Speichere geladene Kapitel als" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Lösche alle abgeschlossenen Aufgaben" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Alle fortsetzen" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Alle anhalten" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Collapse All" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Expand All" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "Über" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "Über FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Accounts" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Änderungsprotokoll " + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Verbindungen" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Custom color" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Dialog" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "Downloads" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Favoriten" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Allgemeines" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filter" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Info" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Manga Info" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Protokoll" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Sonstiges" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Optionen" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Speichern unter" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Updates" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Anzeige" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Erweitert" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Optionen" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Webseiten" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" +msgid "Websites" +msgstr "Webseiten" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Manga" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Status" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Fortschritt" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Tranferrate" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Webseite" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Speichern unter" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Hinzugefügt" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Titel" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Aktuelles Kapitel" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Webseite" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Speichern unter" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "&Abbrechen" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&Download" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&zur Warteschlage hinzufügen" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&Abbrechen" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Jetzt" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Abbrechen" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Ungültig" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Title" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Webseite" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&Später" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Aktualisiere" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"Neue Version gefunden! Möchten Sie jetzt aktualisieren?\n" +"FMD wird geschlossen um die Aktualisierung abzuschließen.\n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Hinzufügen" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Ändern" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Löschen" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Directory page number" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "Downloads" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Max threads je Aufgabe" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Anzahl von threads" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Aktualisiere Liste" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Webseite" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Webseite" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Webseite" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Webseite" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Webseite" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Wähle eine Webseite" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Compressing..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Deaktiviert" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Downloading" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Gescheitert" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Gescheitert einen Ordner zu erstellen!" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Gescheitert, versuch die Aufgabe zu wiederholen!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Abgeschlossen" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Preparing" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Angehalten" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Warte..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&zur Warteschlage hinzufügen" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "&Abbrechen" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Nach neuen Kapitel suchen" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&Download" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Entfernen" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "%d abgeschlossenen Manga gefunden" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Favoriten-Überprüfung läuft!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d manga(s) hat neue(s) Kapitel" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> hat %d neue Kapitel." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Abgeschlossene Manga werden entfernt:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Found %d new chapter from %d manga(s):" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Lade: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Prüfe auf neue Version" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Installierte Version" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Aktuellste Version " + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Neue Version gefunden!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s hat %d neue Manga" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Getting directory" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Getting info" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Getting list for" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Indexierung neuer Titel" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Schaue nach neuen Titel(n)" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Schaue nach neuen Titel(n) aus einem anderen Verzeichnis" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Vorbereitung" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Entfernen von Duplikaten aus aktuellen Daten" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Entfernen von Duplikaten aus lokalen Daten" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Entfernen von Duplikaten aus den neuen Titeln" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Speichere Daten" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Synchronisiere Daten" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Aktualisiere Liste" + diff --git a/mangadownloader/languages/fmd.el_GR.po b/mangadownloader/languages/fmd.el_GR.po new file mode 100644 index 000000000..a3d6b8518 --- /dev/null +++ b/mangadownloader/languages/fmd.el_GR.po @@ -0,0 +1,2633 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: Free Manga Downloader 0.9.118\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: geogeo.gr \n" +"Language-Team: Greek \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: en_US\n" +"X-Generator: Poedit 1.8.12\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" +"X-Poedit-SourceCharset: UTF-8\n" +"X-Poedit-Bookmarks: -1,-1,-1,-1,-1,-1,-1,29,-1,-1\n" +"X-Poedit-Language: Greek\n" +"X-Poedit-Country: GREECE\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Άκυρο" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Απέτυχε" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Λήψη αρχικής εικόνας (απαιτείται λογαριασμός ExHentai)" + +#: ehentai.rs_settingsimagesize +#| msgid "Image size" +msgid "Image size:" +msgstr "Μέγεθος εικόνας:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Αυτόματα\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Αρχικό\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Είστε βέβαιος ότι θέλετε να διαγράψετε αυτό το λογαριασμό;" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Έλεγχος" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Μη έγκυρο" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Άγνωστο" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "Εντάξει" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Το όνομα χρήστη ή ο κωδικός πρόσβασης δεν μπορεί να είναι κενά!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Η εισαγωγή ολοκληρώθηκε." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Λίστα μη εισηγμένων manga" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Έλεγχος..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "" + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Όλες οι λήψεις" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&Εντάξει" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Άκυρο" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Έλεγχος..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Δεν είναι δυνατή η σύνδεση με τον διακομιστή." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Δεν είναι δυνατή η λήψη πληροφοριών του manga. Ελέγξτε τη σύνδεσή σας στο διαδίκτυο και δοκιμάστε ξανά." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Πλήθος λήψεων:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "Πρέπει να επιλέξετε τουλάχιστον 1 ιστότοπο manga!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Είστε βέβαιος ότι θέλετε έξοδο;" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Είστε βέβαιος ότι θέλετε να διαγράψετε τα αγαπημένα;" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Είστε βέβαιος ότι θέλετε να διαγράψετε όλες τις ολοκληρωμένες εργασίες;" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Είστε βέβαιος ότι θέλετε να διαγράψετε αυτά τα στοιχεία;" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Είστε βέβαιος ότι θέλετε να διαγράψετε τις εργασίες;" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Διαχωρισμός λήψης" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Ο τίτλος αυτός είναι ήδη στη λίστα λήψης.\n" +"Θέλετε οπωσδήποτε να τον κατεβάσετε;\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Γράψτε στο νέο κεφάλαιο:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Γράψτε στη νέα διαδρομή αποθήκευσης:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Η λειτουργία ενημέρωσης εκτελείται ήδη!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Θέλετε να κατεβάσετε τη λίστα manga από τον διακομιστή;" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "Η URL δεν υποστηρίζεται!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Λήψη όλων\n" +"Προσθήκη στα αγαπημένα\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Ολοκληρωμένο\n" +"Σε εξέλιξη\n" +"<καμία>\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Το Free Manga Downloader εκτελείται ήδη!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"Υπάρχει ένα πρόβλημα με αυτά τα δεδομένα!\n" +"Η αφαίρεση και προσθήκη ξανά αυτών των δεδομένων μπορεί να διορθώσει το πρόβλημα.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "History" + +#: frmmain.rs_import +msgid "Import" +msgstr "Εισαγωγή" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Καλλιτέχνης(ες):" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Δημιουργός(οί):" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Είδος(η):" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Κατάσταση:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Περίληψη:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Τίτλος:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Ιστότοπος:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "Σε εξέλιξη" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Αυτόματος έλεγχος για νέα κεφάλαια κάθε %d λεπτά" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Η διαδρομή του manga\n" +"%s : Όνομα αρχείου κεφαλαίου\n" +"\n" +"Παράδειγμα : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Φόρτωση..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Λειτ.: Εμφάνιση όλων (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Λειτ.: Φιλτράρισμα (%d)" + +#: frmmain.rs_modesearching +#| msgid "Searching..." +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Λειτ.: Αναζήτηση..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Ένας μήνας" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Μια εβδομάδα" + +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Καμία ενέργεια\n" +"Έξοδος\n" +"Τερματισμός υπολογιστή\n" +"Αδρανοποίηση υπολογιστή\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Επιλεγμένα: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Πρόγραμμα" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Διαδρομή του προγράμματος (π.χ. C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Σήμερα" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Μη έγκυρη εισαγωγή!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Χθές" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "Θα γίνει έξοδος του FMD σε %d δευτερόλεπτα." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "Το σύστημα θα αδρανοποιηθεί σε %d δευτερόλεπτα." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "Το σύστημα θα τερματιστεί σε %d δευτερόλεπτα." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Μη έγκυρο" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Διάνυσμα προετοιμασίας:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Κλειδί:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Εμφάνιση όλων των γλωσσών" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Εμφάνιση ομάδας scanlation" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Αφαίρεση υδατογραφήματος" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Αποθήκευση ως PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Ματαίωση" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Απέτυχε" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Επεξεργασία" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Ανανέωση" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +#| msgid "Username" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Όνομα χρήστη" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Κατάσταση" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "Άκυρο" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Εντάξει" + +#: taccountsetform.caption +msgid "Account" +msgstr "" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Εμφάνιση κωδικού" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Κωδικός" + +#: taccountsetform.edusername.texthint +#| msgid "Status" +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Όνομα χρήστη" + +#: taccountsetform.label2.caption +#| msgid "Status" +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Όνομα χρήστη" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Κωδικός" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Βασική λίστα" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Λίστα κεφαλαίων" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Λίστα αγαπημένων" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Λίστα Manga" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Προσθήκη στα αγαπημένα" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&Κλείσιμο" + +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Λήψη όλων" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Απαλοιφή" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Πάντα στην κορυφή" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Όριο καταγραφής" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Αντιγραφή" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Άκυρο" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&Εντάξει" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Διαδρομή του προγράμματος (π.χ. C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Πρόγραμμα:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Ματαίωση ενημέρωσης λίστας" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Προσθήκη στα αγαπημένα" + +#: tmainform.btchecklatestversion.caption +#| msgid "Check for new version" +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Έλεγχος για νεότερη έκδοση" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Απαλοιφή αρχείου καταγραφής" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Λήψη" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Διαχωρισμός λήψης" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Έλεγχος για νέα κεφάλαια" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Εισαγωγή λίστας" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Φίλτρο" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Επαναφορά τιμών" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Άνοιγμα αρχείου καταγραφής" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Εφαρμογή" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Άμεση ανάγνωση" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Αφαίρεση φίλτρου" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Αφαίρεση φίλτρου" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Ενημέρωση λίστας manga" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Επίσκεψη στο blog μου" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Προσθήκη στη λίστα λήψης ως διακοπείσα εργασία" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "<καμία>" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Αναζήτηση μόνο νέου manga" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" +msgid "Automatic download after finish checking" +msgstr "Αυτόματη λήψη μετά το τέλους του ελέγχου" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Αυτόματος έλεγχος για νέα κεφάλαια περιοδικά" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" +msgid "Automatic remove completed manga from Favorites" +msgstr "Αυτόματη κατάργηση ολοκληρωμένων mangas από τα Αγαπημένα" + +#: tmainform.cboptionautocheckfavstartup.caption +#| msgid "Automatic check for new chapter at startup" +msgid "Auto check for new chapter at startup" +msgstr "Αυτόματος έλεγχος για νέα κεφάλαια στην έναρξη" + +#: tmainform.cboptionautochecklatestversion.caption +#| msgid "Check for new version " +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Αυτόματος έλεγχος για την τελευταία έκδοση" + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Άνοιγμα αγαπημένων στην έναρξη" + +#: tmainform.cboptionchangeunicodecharacter.caption +#| msgid "Change all all character to" +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Αλλαγή όλων των unicode χαρακτήρων με" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Ενεργοποιήστε το αν έχετε πρόβλημα με χαρακτήρες unicode στη διαδρομή." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Κεφάλαιο" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Τόμος" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Ενεργοποίηση φόρτωσης εξώφυλλου manga" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Αυτόματη δημιουργία φακέλου κεφαλαίου" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" +msgid "Auto generate folder based on manga's name" +msgstr "Αυτόματη δημιουργία φακέλου βάσει του ονόματος του manga" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Ενεργοποίηση ζωντανής αναζήτησης (αργή σε μεγάλη λίστα)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Ελαχιστοποίηση στην έναρξη" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Ελαχιστοποίηση στην περιοχή ειδοποιήσεωνMinimize to tray" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Επιτρέπεται μόνο μια παρουσία του FMD" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Αφαίρεση ονόματος manga από το κεφάλαιο" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Εμφάνιση αναδυόμενων παραθύρων συμβουλών" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Διαγραφή εργασίας / αγαπημένου" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Λήψη λίστας manga εάν είναι κενή" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Εμφάνιση εργαλειοθήκης λήψεων" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Εμφάνιση \"Διαγραφή όλων των ολοκληρωμένων εργασιών\" στην εργαλειοθήκη λήψεων" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "Έξοδος του FMD" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Να μη φορτώνονται πληροφορίες manga κατά την ενημέρωση λίστας (το φίλτρο δεν θα λειτουργήσει!)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Κατάργηση διπλότυπων τοπικών δεδομένων στην ενημέρωση λίστας manga" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Χρήση διακομιστή μεσολάβησης" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Αναζήτηση σε όλους τους ιστότοπους manga" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Για περισσότερους ιστότοπους manga, παρακαλώ δείτε στις Επιλογές->Ιστότοποι Manga" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Κανονική έκφραση" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Εμφάνιση κουτιού φύλαξης" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Ενεργοποίηση καταγραφής" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Action" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Ένα έργο που απεικονίζει συνήθως μάχες, βία, χάος και γρήγορο ρυθμό κίνησης." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Adult" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "" +"Περιέχει περιεχόμενο που είναι κατάλληλο μόνο για ενήλικες.\n" +" Οι τίτλοι σε αυτή την κατηγορία μπορεί να περιέχουν σκηνές παρατεταμένης έντονης \n" +"βίας ή/και γραφικά με σεξουαλικό περιεχόμενο και γυμνό.\n" + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Adventure" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "" +"Αν ένας χαρακτήρας στην ιστορία πηγαίνει σε ταξίδι ή κατά μήκος αυτής της γραμμής, \n" +"το πιθανότερο είναι ότι πρόκειται για μια περιπέτεια manga. Ειδάλλως, είναι στο χέρι σας\n" +" να αποφασίσετε γι αυτή την περίπτωση.\n" + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Comedy" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Μια ελαφρά δραματική ιστορία και συχνά χιουμοριστική ή με σατυρικό τόνο και που συνήθως περιέχει ένα ευτυχισμένο τέλος." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Διασκεδαστικό με βάση έργο εμπνευσμένο από επίσημα manga/anime." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Drama" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Ένα έργο με στόχο να προκαλέσει μια συναισθηματική αντίδραση, όπως θλίψη ή αναστάτωση." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "" +"Ενδεχομένως η γραμμή μεταξύ Hentai και μη-Hentai, το Ecchi συνήθως αναφέρεται \n" +"σε υπηρεσία οπαδών που θέλει να προσελκύσει μια συγκεκριμένη ομάδα οπαδών.\n" + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantasy" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Οτιδήποτε περιλαμβάνει, χωρίς να περιορίζεται σε αυτά, μαγεία, φανταστικό κόσμο και παραμύθια." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Gender Bender" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Κορίτσια που ντύνονται σαν αγόρια και αγόρια που ντύνονται σαν κορίτσια.\n" +"Αγόρια που γίνονται κορίτσια και κορίτσια που γίνονται αγόρια.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harem" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "" +"Μια σειρά που περιλαμβάνει έναν αρσενικό χαρακτήρα και πολλούς γυναικείους \n" +"(συνήθως έλκονται από τον αρσενικό χαρακτήρα). \n" +"Το Reverse Harem είναι όταν τα φύλα αντιστρέφονται.\n" + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Πορνογραφικό περιεχόμενο με στοιχεία διαστροφής." + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Historical" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Αναφέρεται σε παλαιούς ή αρχαίους χρόνους." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Horror" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "" +"Ένα οδυνηρό συναίσθημα φόβου, τρόμου και αποστροφής. Ένα ανατριχιαστικό με τρόμο \n" +"και αποστροφή. Το αίσθημα που είναι εμπνευσμένο από κάτι τρομακτικό και συγκλονιστικό.\n" + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "" +"Κυριολεκτικά «Γυναίκα». Απευθύνεται σε γυναίκες 18-30. Ισοδύναμο με το θηλυκό. \n" +"Σε αντίθεση με το Shoujo το ειδύλλιο είναι πιο ρεαλιστικό και λιγότερο εξιδανικευμένο. \n" +"Η αφήγηση είναι πιο σαφής και ώριμη.\n" + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Αναφέρεται στη σεξουαλική έλξη προς νεαρά ή ανήλικα κορίτσια." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Martial Arts" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "" +"Όπως υποδηλώνει το όνομα, οτιδήποτε σχετικό με πολεμικές τέχνες. \n" +"Οποιεσδήποτε από τις διάφορες τέχνες μάχης ή αυτοάμυνας, όπως αϊκίντο, \n" +"καράτε, τζούντο, τάε κβον ντο ή κέντο κ.ά.\n" + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Mature" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "" +"Περιέχει θέμα το οποίο μπορεί να είναι πολύ ακραίο για άτομα κάτω των 17 ετών. \n" +"Οι τίτλοι σε αυτή την κατηγορία μπορεί να περιέχουν έντονη βία, έντονη αιματοχυσία, \n" +"σεξουαλικό περιεχόμενο και σκληρή γλώσσα.\n" + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mecha" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "" +"Ένα έργο που περιλαμβάνει και συνήθως επικεντρώνεται σε όλους \n" +"τους τύπους των μεγάλων ρομποτικών μηχανημάτων.\n" + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Με μουσικό περιεχόμενο." + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Mystery" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "" +"Συνήθως συμβαίνει κάποιο ανεξήγητο γεγονός και ο κεντρικός \n" +"πρωταγωνιστής προσπαθεί να ανακαλύψει τι το προκάλεσε.\n" + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psychological" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "" +"Συνήθως ασχολείται με τη φιλοσοφία μιας κατάστασης του μυαλού. \n" +"Στις περισσότερες περιπτώσεις σε μια ανώμαλη ψυχολογική κατάσταση.\n" + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romance" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "" +"Οποιαδήποτε ιστορία σχετική με αγάπη. Εμείς θεωρούμε την αγάπη μεταξύ άνδρα και γυναίκας. \n" +"Εκτός από αυτήν, είναι θέμα της φαντασίας σας ποια αγάπη μπορεί να είναι.\n" + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "School Life" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Είναι ένα μεγάλο φάσμα ιστοριών που σχετίζονται με κάποιο τύπο σχολείου." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Sci-Fi" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "" +"Τα έργα αυτά αφορούν ανατροπές στην τεχνολογία και σε άλλα φαινόμενα σχετικά με την επιστήμη \n" +"που είναι αντίθετα ή παραποιιημένα τμήματα του σύγχρονου επιστημονικού κόσμου.\n" + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "" +"Seinen σημαίνει «νέος άνθρωπος». Τα manga και anime που στοχεύουν ειδικά σε νεαρά ενήλικα αρσενικά,\n" +" ηλικίας μεταξύ 18 και 25 ετών. Οι ιστορίες αυτές εμφανίζουν φοιτητές Πανεπιστημίου και άτομα από τον \n" +"κόσμο της εργασίας. Σε γενικές γραμμές οι ιστορίες αυτές ασχολούνται με θέματα της ενήλικης ζωής.\n" + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Αναφέρεται στη σεξουαλική έλξη προς νεαρά ή ανήλικα αγόρια." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "" +"Ένα έργο που προορίζεται και είναι κυρίως γραμμένο για γυναίκες. \n" +"Συνήθως περιλαμβάνει ειδύλλια και ανάπτυξη ισχυρού χαρακτήρα.\n" + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "" +"Συχνά συνώνυμη με το Yuri. Αυτό μπορεί να θεωρηθεί ως κάπως λιγότερο ακραίο. \n" +"Μπορείτε να το πείτε και «Έρωτας κοριτσιών».\n" + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "" +"Ένα έργο που προορίζεται και είναι γραμμένο κυρίως για άνδρες. \n" +"Τα έργα αυτά αφορούν συνήθως σκηνές μάχης ή/και βία.\n" + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "" +"Συχνά συνώνυμη με το Yaoi. Αυτό μπορεί να θεωρηθεί ως κάπως λιγότερο ακραίο. \n" +"Μπορείτε να το πείτε και «Έρωτας αγοριών».\n" + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Slice of Life" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "" +"Όπως υποδηλώνει το όνομα, το είδος αυτό αντιπροσωπεύει καθημερινές δοκιμασίες \n" +"από έναν ή περισσότερους χαρακτήρες. Αυτές οι προκλήσεις / εκδηλώσεις θα μπορούσαν \n" +"τεχνικά να συμβούν στην πραγματική ζωή και εμφανίζονται συχνά, αν όχι συνεχώς, σε \n" +"έναν κόσμο που αντικατοπτρίζει τις δικές μας ζωές.\n" + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Smut" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Ασχολείται με σειρές που θεωρούνται βλάσφημες ή προσβλητικές, ιδιαίτερα σε σχέση με σεξουαλικό περιεχόμενο." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Sports" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "" +"Όπως υποδηλώνει το όνομα, οτιδήποτε σχετικό με αθλήματα. \n" +"Για παράδειγμα μπέιζμπολ, μπάσκετ, χόκεϊ, ποδόσφαιρο, γκολφ και μηχανοκίνητα.\n" + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Supernatural" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "" +"Συνήθως συνεπάγεται εκπληκτικές και ανεξήγητες δυνάμεις ή γεγονότα \n" +"τα οποία αψηφούν τους νόμους της φυσικής.\n" + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Tragedy" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Περιέχει γεγονότα που οδήγησαν σε μεγάλη απώλεια και δυστυχία." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Το έργο αυτό συνήθως περιλαμβάνει στενές σχέσεις μεταξύ ανδρών." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Το έργο αυτό συνήθως περιλαμβάνει στενές σχέσεις μεταξύ γυναικών." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Εισαγωγή προσαρμοσμένων ειδών, χωρισμένα με κόμμα" + +#: tmainform.eddownloadssearch.texthint +#| msgid "Search favorites..." +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Αναζήτηση λήψεων..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Αναζήτηση αγαπημένων..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Καλλιτέχνης" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Δημιουργός" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Φίλτρο" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Τμήμα της περίληψης" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Τίτλος" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Αναζήτηση τίτλου..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" +msgid "Custom rename" +msgstr "Προσαρμ. μετονομασία" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Προεπιλεγμένη διαδρομή λήψης" + +#: tmainform.edoptionexternalparams.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalparams.texthint" +msgid "External program parameters" +msgstr "Ρυθμίσεις εξωτερικού προγράμματος" + +#: tmainform.edoptionexternalpath.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalpath.texthint" +msgid "External program path" +msgstr "Διαδρομή εξωτερικού προγράμματος" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Προσαρμ. μετονομασία" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr " Ηost/IP μεσολαβητή" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Προσαρμ. μετονομασία" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Κωδικός μεσολαβητή" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Όνομα χρήστη μεσολαβητή" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Αποθήκευση σε" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Εισαγωγή της URL εδώ" + +#: tmainform.edwebsitessearch.texthint +#| msgid "Search..." +msgctxt "tmainform.edwebsitessearch.texthint" +msgid "Search website..." +msgstr "Αναζήτηση ιστότοπου..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Εμφάνιση παραθύρου επιβεβαίωσης όταν γίνει:" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Κουτί φύλαξης" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Εξωτερικό πρόγραμμα" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Αγαπημένα" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Ρυθμίσεις διακομιστή μεσολάβησης" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Μετονομασία" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Καθορίστε την προεπιλεγμένη διαδρομή λήψης:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Αδιαφάνεια" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Καλλιτέχνης" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Δημιουργός" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Προσαρμ. είδη" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Είδη:\n" +" - Τσεκαρισμένο: Συμπερίληψη αυτού του είδους.\n" +" - Μη τσεκαρισμένο: Εξαίρεση αυτού του είδους.\n" +" - Γκρι χρώμα: Χωρίς σημασία.\n" +"\n" +"Προσαρμοσμένα είδη:\n" +" - Διαχωρισμός πολλαπλών ειδών με ','.\n" +" - Αποκλεισμός ενός είδους βάζοντας '!' ή '-' στην αρχή του είδους.\n" +" - Παράδειγμα: Adventure,!Ecchi,Comedy.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Κατάσταση" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Περίληψη" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Τίτλος" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Αρχείο καταγραφής:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Λειτ.: Εμφάνιση όλων (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" +msgid "Auto check for new chapter every %d minutes" +msgstr "Αυτόματος έλεγχος για νέα κεφάλαια κάθε %d λεπτά" + +#: tmainform.lboptionchaptercustomrename.caption +#| msgid "Chapter folder name:" +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Όνομα κεφαλαίου:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Όνομα ιστότοπου\n" +"%MANGA% : Τίτλος manga\n" +"%CHAPTER% : Τίτλος κεφαλαίου\n" +"%AUTHOR% : Δημιουργός\n" +"%ARTIST% : Καλλιτέχνες\n" +"%NUMBERING% : Αρίθμηση\n" +"\n" +"Σημείωση:\n" +"Το όνομα φακέλου κεφαλαίου πρέπει να έχει τουλάχιστον %CHAPTER% ή %NUMBERING%.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Χρονικό όριο σύνδεσης (δευτ/λεπτα)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Άνοιγμα manga με χρήση εξωτερικού προγράμματος:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Παράμετροι:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "tmainform.lboptionexternalparamshint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Όνομα αρχείου:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Όνομα ιστότοπου\n" +"%MANGA% : Τίτλος Manga\n" +"%CHAPTER% : Τίτλος κεφαλαίου\n" +"%FILENAME% : Όνομα αρχείου\n" +"\n" +"Σημείωση:\n" +"Το όνομα αρχείου πρέπει να έχει τουλάχιστο %FILENAME%\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Κεντρ. υπολογιστής" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Γλώσσα:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "Μετά την ολοκλήρωση της λήψης:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Όνομα φακέλου manga:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Όνομα ιστότοπου\n" +"%MANGA% : Τίτλος manga\n" +"%AUTHOR% : Δημιουργός\n" +"%ARTIST% : Καλλιτέχνης\n" +"\n" +"Σημείωση:\n" +"Το όνομα φακέλου Manga πρέπει να έχει τουλάχιστον %MANGA%.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Αριθμός ταυτόχρονων εργασιών λήψης" + +#: tmainform.lboptionmaxretry.caption +#| msgid "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Αριθμός επαναλήψεων αν οι εργασίες έχουν προβλήματα λήψης (-1 = συνεχής επανάληψη)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Αριθμός ταυτόχρονα ληφθέντων αρχείων ανά εργασία" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Νέα manga με βάση τον χρόνο ενημέρωσης (ηµέρες)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Κωδικός" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "Επίπεδο συμπίεσης PDF" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (χωρίς απώλειες). Χαμηλότερα = DCTEncode (με απώλειες)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Θύρα" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Τύπος" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Μετονομασία ψηφίων" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Όνομα χρήστη" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Αποθήκευση σε:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Διαγραφή" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Αντιγραφή" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Αποκοπή" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Επικόλληση" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Επικόλληση και μετάβαση" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Επιλογή όλων" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Αναίρεση" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Ματαίωση" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Αύξουσα" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Σήμανση όλων" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Σήμανση επιλεγμένων" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Φθίνουσα" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Φίλτρο" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Απόκρυψη ληφθέντων κεφαλαίων" + +#: tmainform.michapterlisthighlight.caption +#| msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" +msgstr "Επισήμανση ληφθέντων κεφαλαίων" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Αποσήμανση όλων" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Αποσήμανση επιλεγμένων" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Διαγραφή" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Διαγραφή όλων των ολοκληρωμένων εργασιών" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Εργασία μόνο" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Εργασία + Δεδομένα" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Εργασία + Δεδομένα + Αγαπημένο" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Απενεργοποίηση" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Ενεργοποίηση" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Συγχώνευση ολοκληρωμένων εργασιών" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Άνοιγμα φακέλου" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Άνοιγμα..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Συνέχιση" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Διακοπή" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Προβολή πληροφοριών manga" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Αλλαγή \"Τρέχοντος κεφαλαίου\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Αλλαγή \"Αποθήκευσης σε\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Έλεγχος για νέα κεφάλαια" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Διαγραφή" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Απενεργοποίηση" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Λήψη όλων" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Ενεργοποίηση" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Άνοιγμα φακέλου" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Άνοιγμα..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Διακοπή ελέγχου για νέα κεφάλαια" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Προβολή πληροφοριών manga" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Επισήμανση νέου manga" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Προσθήκη στα αγαπημένα" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Διαγραφή" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Λήψη όλων" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Προβολή πρηροφοριών manga" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "Μετά την ολοκλήρωση της λήψης" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Έξοδος" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Έξοδος" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Αδρανοποίηση υπολογιστή" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Καμία ενέργεια" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Τερματισμός υπολογιστή" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Επαναφορά" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Συνέχιση όλων" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "Εμφάνιση κουτιού φύλαξης" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Διακοπή όλων" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Λήψη όλων των λιστών από τον διακομιστή ταυτόχρονα" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Σήμανση όλων" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Ακαθόριστα όλα" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Αποσήμανση όλων" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Λήψη όλων των λιστών ταυτόχρονα" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Λήψη λίστας manga από τον διακομιστή" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Ενημέρωση λίστας manga" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Όλα τα είδη που έχουν σημανθεί" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Ένα από τα είδη που έχουν σημανθεί" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Λειτουργία" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Αποθήκευση ληφθέντων κεφαλαίων ως" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (χωρίς απώλειες). Χαμηλότερα = DCTEncode (με απώλειες)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Διαγραφή όλων των ολοκληρωμένων εργασιών" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Συνέχιση όλων" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Διακοπή όλων" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Σύμπτυξη όλων" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Ανάπτυξη όλων" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "Περί" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "Περί FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Λογαριασμοί" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Ιστορικό εκδόσεων" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Συνδέσεις" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Πρασαρμογή χρωμάτων" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Διάλογοι" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "Λήψεις" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Αγαπημένα" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Γενικές" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Φίλτρο" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Πληροφορίες" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Πληροφορίες manga" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Αρχείο καταγραφής" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Διάφορα" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Επιλογές" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Αποθήκευση" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Ενημερώσεις" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Προβολή" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Προηγμένες" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Επιλογές" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Ιστότοποι" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" +msgid "Websites" +msgstr "Ιστότοποι" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Manga" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Κατάσταση" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Εξέλιξη" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Ρυθμός μεταφοράς" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Αποθήκευση σε" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Προστέθηκε" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Τίτλος" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Τρέχον κεφάλαιο" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Ιστότοπος" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Αποθήκευση σε" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "Ά&κυρο" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&Λήψη" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&Προσθήκη στην ουρά" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "Εντάξει" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&Ματαίωση" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Τώρα" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Άκυρο" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "Εντάξει" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Μη έγκυρο" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Ιστότοπος" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&Αργότερα" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Ενημέρωση" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"Βρέθηκε νέα έκδοση! Θέλετε να γίνει ενημέρωση τώρα;\n" +"Το FMD θα κλείσει για να ολοκληρωθεί η ενημέρωση.\n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Προσθήκη" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Επεξεργασία" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Διαγραφή" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Αριθμός σελίδας καταλόγου" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "Λήψεις" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Μέγιστος αριθμός νημάτων ανά έργο" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Αριθμός νημάτων" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Ενημέρωση λίστας" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "Παράγοντας χρήστη" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Τιμή" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Τιμή" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Τιμή" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Ιστότοπος" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "Παράγοντας χρήστη" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Επιλέξτε έναν ιστότοπο" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Συμπίεση..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Απενεργ/μένο" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Λήψη" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Απέτυχε" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Δεν ήταν δυνατή η δημιουργία καταλόγου!" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Απέτυχε. Δοκιμάστε να επαναλάβετε αυτή την εργασία!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Ολοκληρωμένο" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Προετοιμασία" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Σταματημένο" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Αναμονή..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&Προσθήκη στην ουρά" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "Ά&κυρο" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Έλεγχος για νέα κεφάλαια" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&Λήψη" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Κατάργηση" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "Βρέθηκαν %d ολοκληρωμένα manga" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Ό έλεγχος αγαπημένων εκτελείται ήδη!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d manga έχουν νέα κεφάλαια." + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "Το %s <%s> έχει %d νέο(α) κεφάλαιο(α)." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Το ολοκληρωμένο manga θα αφαιρεθεί:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Βρέθηκαν %d νέα κεφάλαια από %d manga:" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Φόρτωση: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Έλεγχος για νέα έκδοση" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Εγκατεστημένη έκδοση" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Τελευταία έκδοση" + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Βρέθηκε νέα έκδοση!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "Το %s έχει %d νέα manga" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Λήψη καταλόγου" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Λήψη πληροφοριών" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Λήψη λίστας για" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Ευρετηρίαση νέων τίτλων" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Αναζήτηση για νέους τίτλους" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Αναζήτηση για νέους τίτλους από άλλο κατάλογο" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Προετοιμασία" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Κατάργηση διπλότυπων από τα τρέχοντα δεδομένα" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Κατάργηση διπλότυπων από τα τοπικά δεδομένα" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Κατάργηση διπλότυπων από τους νέους τίτλους" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Αποθήκευση δεδομένων" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Συγχρονισμός δεδομένων" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Ενημέρωση λίστας" + diff --git a/mangadownloader/languages/fmd.en.po b/mangadownloader/languages/fmd.en.po index 80449dbe8..1d1f7bf7a 100644 --- a/mangadownloader/languages/fmd.en.po +++ b/mangadownloader/languages/fmd.en.po @@ -1,16 +1,101 @@ msgid "" +msgstr "Content-Type: text/plain; charset=UTF-8" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abort" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "Downloading %s" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "Extracting %s" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: failed to extract, exitstatus = %d\"" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" +"Failed to finish:\n" +"\n" +"%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Failed" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: failed to save" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: Missing %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Download original image(require ExHentai account)" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "Image size:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: \n" -"Language-Team: \n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: en_US\n" -"X-Generator: Poedit 1.8.1\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Are you sure you want to delete this account?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Checking" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Invalid" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Unknown" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Username or password can't be empty!" #: frmimportfavorites.rs_importcompleted msgid "Import completed." @@ -20,6 +105,81 @@ msgstr "Import completed." msgid "List of unimported manga" msgstr "List of unimported manga" +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Checking..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Check update" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Finish checking" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "Finish download" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" +"Modules updated, restart now?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "Modules updated!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "Modules update found!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "Downloading..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "%s DELETE*" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "%s FAILED*" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "%s NEW*" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "%s REDOWNLOAD*" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "%s UPDATE*" + #: frmmain.rs_alldownloads msgid "All downloads" msgstr "All downloads" @@ -35,6 +195,7 @@ msgid "Cancel" msgstr "Cancel" #: frmmain.rs_checking +msgctxt "frmmain.rs_checking" msgid "Checking..." msgstr "Checking..." @@ -46,6 +207,10 @@ msgstr "Cannot connect to the server." msgid "Cannot get manga info. Please check your internet connection and try it again." msgstr "Cannot get manga info. Please check your internet connection and try it again." +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Download count:" + #: frmmain.rs_dlgmangalistselect msgid "You must choose at least 1 manga website!" msgstr "You must choose at least 1 manga website!" @@ -62,10 +227,19 @@ msgstr "Are you sure you want to delete the favorite(s)?" msgid "Are you sure you want to delete all finished tasks?" msgstr "Are you sure you want to delete all finished tasks?" +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Are you sure you want to delete this item(s)?" + #: frmmain.rs_dlgremovetask msgid "Are you sure you want to delete the task(s)?" msgstr "Are you sure you want to delete the task(s)?" +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Split download" + #: frmmain.rs_dlgtitleexistindllist msgid "" "This title are already in download list.\n" @@ -112,6 +286,10 @@ msgstr "" "Ongoing\n" "\n" +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader already running!" + #: frmmain.rs_hintfavoriteproblem msgid "" "There is a problem with this data!\n" @@ -153,6 +331,7 @@ msgid "Title:" msgstr "Title:" #: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" msgid "Website:" msgstr "Website:" @@ -166,11 +345,6 @@ msgid "Auto check for new chapter every %d minutes" msgstr "Auto check for new chapter every %d minutes" #: frmmain.rs_lbloptionexternalparamshint -#| msgid "" -#| "%s : Path to the manga\n" -#| "%s : Chapter filename\n" -#| "\n" -#| "Example : %s%s\n" msgid "" "%s : Path to the manga\n" "%s : Chapter filename\n" @@ -194,6 +368,11 @@ msgstr "Mode: Show all (%d)" msgid "Mode: Filtered (%d)" msgstr "Mode: Filtered (%d)" +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Mode: Searching..." + #: frmmain.rs_onemonth msgid "One month" msgstr "One month" @@ -202,15 +381,35 @@ msgstr "One month" msgid "One week" msgstr "One week" +#: frmmain.rs_optioncompress +#, fuzzy +#| msgid "" +#| "None\n" +#| "ZIP\n" +#| "CBZ\n" +#| "PDF\n" +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" + #: frmmain.rs_optionfmddoitems msgid "" -"Do nothing\n" -"Exit FMD\n" +"Nothing\n" +"Exit\n" "Shutdown\n" "Hibernate\n" msgstr "" -"Do nothing\n" -"Exit FMD\n" +"Nothing\n" +"Exit\n" "Shutdown\n" "Hibernate\n" @@ -231,6 +430,32 @@ msgstr "Path to the software (e.g. C:\\MangaDownloader)" msgid "Today" msgstr "Today" +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" +"WebP\n" +"PNG\n" +"JPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Invalid input!" + #: frmmain.rs_yesterday msgid "Yesterday" msgstr "Yesterday" @@ -247,10 +472,212 @@ msgstr "System will hibernate in %d second." msgid "System will shutdown in %d second." msgstr "System will shutdown in %d second." +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "All" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Invalid" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Valid" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Initialization Vector:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Key:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Use Google DCP" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Show all language" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Show scanlation group" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Remove watermark" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Save as PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abort" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "Downloading new version %s" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "Failed to extract %s, exitstatus = %d" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Failed" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "Failed to save %s" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "Download update package finished, restart to proceed?" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "Download finished" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "Missing %s" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Edit" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Refresh" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "AccountManagerForm" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[1].TEXT" +msgid "Website" +msgstr "Website" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[2].TEXT" +msgid "Username" +msgstr "Username" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[3].TEXT" +msgid "Status" +msgstr "Status" + +#: taccountsetform.btcancel.caption +msgctxt "TACCOUNTSETFORM.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Cancel" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Ok" + +#: taccountsetform.caption +msgid "Account" +msgstr "Account" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Show password" + +#: taccountsetform.edpassword.texthint +msgctxt "TACCOUNTSETFORM.EDPASSWORD.TEXTHINT" +msgid "Password" +msgstr "Password" + +#: taccountsetform.edusername.texthint +msgctxt "TACCOUNTSETFORM.EDUSERNAME.TEXTHINT" +msgid "Username" +msgstr "Username" + +#: taccountsetform.label2.caption +msgctxt "TACCOUNTSETFORM.LABEL2.CAPTION" +msgid "Username" +msgstr "Username" + +#: taccountsetform.label3.caption +msgctxt "TACCOUNTSETFORM.LABEL3.CAPTION" +msgid "Password" +msgstr "Password" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Basic list" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Chapter list" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Favorite list" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Manga list" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "TFORMDROPTARGET.MIADDTOFAVORITES.CAPTION" +msgid "Add to favorites" +msgstr "Add to favorites" + #: tformdroptarget.miclose.caption msgid "&Close" msgstr "&Close" +#: tformdroptarget.midownloadall.caption +msgctxt "TFORMDROPTARGET.MIDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Download all" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Clear" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Stay on top" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Log limit" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Copy" + #: timportfavorites.btcancel.caption msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" msgid "Cancel" @@ -261,16 +688,12 @@ msgctxt "timportfavorites.btimport.caption" msgid "&OK" msgstr "&OK" -#: timportfavorites.caption -msgid "Import list ..." -msgstr "Import list ..." - #: timportfavorites.cbsoftware.text msgid "Domdomsoft Manga Downloader" msgstr "Domdomsoft Manga Downloader" -#: timportfavorites.edpath.text -msgctxt "TIMPORTFAVORITES.EDPATH.TEXT" +#: timportfavorites.edpath.texthint +msgctxt "TIMPORTFAVORITES.EDPATH.TEXTHINT" msgid "Path to the software (e.g. C:\\MangaDownloader)" msgstr "Path to the software (e.g. C:\\MangaDownloader)" @@ -278,24 +701,59 @@ msgstr "Path to the software (e.g. C:\\MangaDownloader)" msgid "Software:" msgstr "Software:" +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Check update" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Auto restart" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Show update warning" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Filename" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Last modified" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Last message" + #: tmainform.btabortupdatelist.hint msgid "Abort update list" msgstr "Abort update list" #: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" msgid "Add to favorites" msgstr "Add to favorites" -#: tmainform.btcheckversion.caption -msgctxt "tmainform.btcheckversion.caption" -msgid "Check for new version" -msgstr "Check for new version" +#: tmainform.btchecklatestversion.caption +msgctxt "TMAINFORM.BTCHECKLATESTVERSION.CAPTION" +msgid "Check for latest version" +msgstr "Check for latest version" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Clear log file" #: tmainform.btdownload.caption msgctxt "tmainform.btdownload.caption" msgid "Download" msgstr "Download" +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Split download" + #: tmainform.btfavoriteschecknewchapter.caption msgctxt "tmainform.btfavoriteschecknewchapter.caption" msgid "Check for new chapter" @@ -314,6 +772,10 @@ msgstr "Filter" msgid "Reset value" msgstr "Reset value" +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Open log" + #: tmainform.btoptionapply.caption msgid "Apply" msgstr "Apply" @@ -342,7 +804,6 @@ msgid "Visit my blog" msgstr "Visit my blog" #: tmainform.caption -msgctxt "tmainform.caption" msgid "Free Manga Downloader" msgstr "Free Manga Downloader" @@ -358,26 +819,46 @@ msgstr "" msgid "Search only new manga" msgstr "Search only new manga" -#: tmainform.cboptionautocheckfavstartup.caption -msgid "Automatic check for new chapter at startup" -msgstr "Automatic check for new chapter at startup" - -#: tmainform.cboptionautocheckupdate.caption -msgid "Check for new version " -msgstr "Check for new version " - -#: tmainform.cboptionautodlfav.caption +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVDOWNLOAD.CAPTION" msgid "Automatic download after finish checking" msgstr "Automatic download after finish checking" -#: tmainform.cboptionautonumberchapter.caption -msgid "Auto number chapter" -msgstr "Auto number chapter" +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Auto check for new chapter in an interval" -#: tmainform.cboptionautoremovecompletedmanga.caption +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVREMOVECOMPLETEDMANGA.CAPTION" msgid "Automatic remove completed manga from Favorites" msgstr "Automatic remove completed manga from Favorites" +#: tmainform.cboptionautocheckfavstartup.caption +msgid "Auto check for new chapter at startup" +msgstr "Auto check for new chapter at startup" + +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKLATESTVERSION.CAPTION" +msgid "Auto check for latest version " +msgstr "Auto check for latest version " + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Open Favorites at startup" + +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "TMAINFORM.CBOPTIONCHANGEUNICODECHARACTER.CAPTION" +msgid "Replace all unicode character with" +msgstr "Replace all unicode character with" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Enable this if you have problem with unicode character in path." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Delete completed tasks on close" + #: tmainform.cboptiondigitchapter.caption msgid "Chapter" msgstr "Chapter" @@ -390,11 +871,12 @@ msgstr "Volume" msgid "Enable load manga cover" msgstr "Enable load manga cover" -#: tmainform.cboptiongeneratechaptername.caption -msgid "Generate chapter folder with chapter name" -msgstr "Generate chapter folder with chapter name" +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Auto generate chapter folder" -#: tmainform.cboptiongeneratemangafoldername.caption +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "TMAINFORM.CBOPTIONGENERATEMANGAFOLDER.CAPTION" msgid "Auto generate folder based on manga's name" msgstr "Auto generate folder based on manga's name" @@ -402,9 +884,9 @@ msgstr "Auto generate folder based on manga's name" msgid "Enable live search (slow on long list)" msgstr "Enable live search (slow on long list)" -#: tmainform.cboptionmangafoxremovewatermarks.caption -msgid "[Mangafox] Remove watermarks (Beware! Experimental!)" -msgstr "[Mangafox] Remove watermarks (Beware! Experimental!)" +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Minimize on start" #: tmainform.cboptionminimizetotray.caption msgid "Minimize to tray" @@ -414,30 +896,38 @@ msgstr "Minimize to tray" msgid "Permit only one FMD running" msgstr "Permit only one FMD running" -#: tmainform.cboptionpathconvert.caption -msgid "Change all all unicode symbols to \"_\" (choose this when you have problem with unicode path)" -msgstr "Change all all unicode symbols to \"_\" (choose this when you have problem with unicode path)" - #: tmainform.cboptionproxytype.text msgid "HTTP" msgstr "HTTP" -#: tmainform.cboptionshowalllang.caption -msgid "[Batoto] Show All Language" -msgstr "[Batoto] Show All Language" +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Remove manga name from chapter" -#: tmainform.cboptionshowbatotosg.caption -msgid "[Batoto] Show scan group name" -msgstr "[Batoto] Show scan group name" +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Show balloon hint" #: tmainform.cboptionshowdeletetaskdialog.caption msgid "Delete task/favorite" msgstr "Delete task/favorite" +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Download manga list if empty" + #: tmainform.cboptionshowdownloadtoolbar.caption msgid "Show downloads toolbar" msgstr "Show downloads toolbar" +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Show \"Delete all completed tasks\" in downloads toolbar" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Show left downloads toolbar" + #: tmainform.cboptionshowquitdialog.caption msgid "Exit FMD" msgstr "Exit FMD" @@ -454,6 +944,11 @@ msgstr "Remove duplicate local data when updating manga list" msgid "Use proxy" msgstr "Use proxy" +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "Fastest" + #: tmainform.cbsearchfromallsites.caption msgid "Search in all manga sites" msgstr "Search in all manga sites" @@ -466,10 +961,20 @@ msgstr "For more manga sites, please go to Options->Manga sites" msgid "Regular Expression" msgstr "Regular Expression" +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + #: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" msgid "Show Drop Box" msgstr "Show Drop Box" +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Enable logging" + #: tmainform.ckfilteraction.caption msgid "Action" msgstr "Action" @@ -786,10 +1291,29 @@ msgstr "Yuri" msgid "This work usually involves intimate relationships between women." msgstr "This work usually involves intimate relationships between women." +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "Always start task from failed chapters" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "Save PNG as JPEG" + #: tmainform.edcustomgenres.texthint msgid "Input custom genres, separated by comma" msgstr "Input custom genres, separated by comma" +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Search downloads..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Search favorites..." + #: tmainform.edfilterartists.texthint msgctxt "tmainform.edfilterartists.texthint" msgid "Artist" @@ -800,6 +1324,11 @@ msgctxt "tmainform.edfilterauthors.texthint" msgid "Author" msgstr "Author" +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "TMAINFORM.EDFILTERMANGAINFOCHAPTERS.TEXTHINT" +msgid "Filter" +msgstr "Filter" + #: tmainform.edfiltersummary.texthint msgid "Part of summary" msgstr "Part of summary" @@ -809,7 +1338,13 @@ msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" msgid "Title" msgstr "Title" -#: tmainform.edoptioncustomrename.texthint +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Search title..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONCHAPTERCUSTOMRENAME.TEXTHINT" msgid "Custom rename" msgstr "Custom rename" @@ -818,29 +1353,33 @@ msgid "Default download path" msgstr "Default download path" #: tmainform.edoptionexternalparams.texthint -#| msgid "External program parameters" -msgctxt "tmainform.edoptionexternalparams.texthint" +msgctxt "TMAINFORM.EDOPTIONEXTERNALPARAMS.TEXTHINT" msgid "External program parameters" msgstr "External program parameters" #: tmainform.edoptionexternalpath.texthint -#| msgid "External program parameters" -msgctxt "tmainform.edoptionexternalpath.texthint" +msgctxt "TMAINFORM.EDOPTIONEXTERNALPATH.TEXTHINT" msgid "External program path" msgstr "External program path" +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONFILENAMECUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Custom rename" + #: tmainform.edoptionhost.texthint msgid "Proxy host/IP" msgstr "Proxy host/IP" +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONMANGACUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Custom rename" + #: tmainform.edoptionpass.texthint msgid "Proxy password" msgstr "Proxy password" -#: tmainform.edoptionport.texthint -msgid "Proxy Port" -msgstr "Proxy Port" - #: tmainform.edoptionuser.texthint msgid "Proxy username" msgstr "Proxy username" @@ -850,26 +1389,27 @@ msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" msgid "Save to" msgstr "Save to" -#: tmainform.edsearch.texthint -#| msgid "Search..." -msgctxt "tmainform.edsearch.texthint" -msgid "Search title..." -msgstr "Search title..." - #: tmainform.edurl.texthint msgid "Input URL here" msgstr "Input URL here" #: tmainform.edwebsitessearch.texthint -#| msgid "Search..." -msgctxt "tmainform.edwebsitessearch.texthint" +msgctxt "TMAINFORM.EDWEBSITESSEARCH.TEXTHINT" msgid "Search website..." msgstr "Search website..." +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Show dialog confirmation for" + #: tmainform.gbdroptarget.caption msgid "Drop Box" msgstr "Drop Box" +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Image Conversion" + #: tmainform.gboptionexternal.caption msgid "External program" msgstr "External program" @@ -923,7 +1463,7 @@ msgid "" "\n" "Custom Genres:\n" "- Separate multiple genres with ','.\n" -"- Exclude a genre by placing ''!'' at the beginning of a genre.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" "- Example: Adventure,!Ecchi,Comedy.\n" msgstr "" "Genres:\n" @@ -933,7 +1473,7 @@ msgstr "" "\n" "Custom Genres:\n" "- Separate multiple genres with ','.\n" -"- Exclude a genre by placing ''!'' at the beginning of a genre.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" "- Example: Adventure,!Ecchi,Comedy.\n" #: tmainform.lbfilterstatus.caption @@ -950,29 +1490,35 @@ msgctxt "tmainform.lbfiltertitle.caption" msgid "Title" msgstr "Title" +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "JPEG quality" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Log file:" + #: tmainform.lbmode.caption -msgid "Mode: Show all manga" -msgstr "Mode: Show all manga" +msgid "Mode: Show all (0)" +msgstr "Mode: Show all (0)" -#: tmainform.lboptionautocheckminutes.caption -msgctxt "tmainform.lboptionautocheckminutes.caption" +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "TMAINFORM.LBOPTIONAUTOCHECKFAVINTERVALMINUTES.CAPTION" msgid "Auto check for new chapter every %d minutes" msgstr "Auto check for new chapter every %d minutes" -#: tmainform.lboptionconnectiontimeout.caption -msgid "Connection timeout (seconds)" -msgstr "Connection timeout (seconds)" - -#: tmainform.lboptioncustomrename.caption -msgid "Chapter folder name:" -msgstr "Chapter folder name:" +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAME.CAPTION" +msgid "Chapter name:" +msgstr "Chapter name:" -#: tmainform.lboptioncustomrenamehint.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT.CAPTION" +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.CAPTION" msgid "[?]" msgstr "[?]" -#: tmainform.lboptioncustomrenamehint.hint +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.HINT" msgid "" "%WEBSITE% : Website name\n" "%MANGA% : Manga title\n" @@ -994,18 +1540,9 @@ msgstr "" "Note:\n" "Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" -#: tmainform.lboptioncustomrenamehint1.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT1.CAPTION" -msgid "[?]" -msgstr "[?]" - -#: tmainform.lboptioncustomrenamehint1.hint -msgid "100: FlateEncode (lossless), lower: DCTEncode (lossy)" -msgstr "100: FlateEncode (lossless), lower: DCTEncode (lossy)" - -#: tmainform.lboptiondialogs.caption -msgid "Show dialog confirmation for:" -msgstr "Show dialog confirmation for:" +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Connection timeout (seconds)" #: tmainform.lboptionexternal.caption msgid "Open manga by using external program:" @@ -1016,10 +1553,37 @@ msgid "Parameters:" msgstr "Parameters:" #: tmainform.lboptionexternalparamshint.caption -msgctxt "tmainform.lboptionexternalparamshint.caption" +msgctxt "TMAINFORM.LBOPTIONEXTERNALPARAMSHINT.CAPTION" msgid "[?]" msgstr "[?]" +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Filename:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONFILENAMECUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" + #: tmainform.lboptionhost.caption msgid "Host" msgstr "Host" @@ -1032,23 +1596,52 @@ msgstr "Language:" msgid "After download finish:" msgstr "After download finish:" +#: tmainform.lboptionmangacustomrename.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAME.CAPTION" +msgid "Manga folder name:" +msgstr "Manga folder name:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" + #: tmainform.lboptionmaxparallel.caption -msgid "Number of downloaded tasks at the same time (Max: 8)" -msgstr "Number of downloaded tasks at the same time (Max: 8)" +msgid "Number of downloaded tasks at the same time" +msgstr "Number of downloaded tasks at the same time" #: tmainform.lboptionmaxretry.caption -msgid "Number of retry times if tasks have download problems (0 = always retry)" -msgstr "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Number of retry times if tasks have download problems (-1 = always retry)" #: tmainform.lboptionmaxthread.caption -msgid "Number of downloaded files per task at the same time (Max: 32)" -msgstr "Number of downloaded files per task at the same time (Max: 32)" +msgid "Number of downloaded files per task at the same time" +msgstr "Number of downloaded files per task at the same time" #: tmainform.lboptionnewmangatime.caption msgid "New manga based on it's update time (days)" msgstr "New manga based on it's update time (days)" #: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" msgid "Password" msgstr "Password" @@ -1061,6 +1654,11 @@ msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" msgstr "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "TMAINFORM.LBOPTIONPDFQUALITYHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + #: tmainform.lboptionport.caption msgid "Port" msgstr "Port" @@ -1073,20 +1671,35 @@ msgstr "Type" msgid "Rename digits" msgstr "Rename digits" +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Number of retry times if task failed" + #: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" msgid "Username" msgstr "Username" +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "PNG Compression level" + #: tmainform.lbsaveto.caption msgid "Save to:" msgstr "Save to:" +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "Save WebP as" + #: tmainform.medturldelete.caption msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" msgid "Delete" msgstr "Delete" #: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" msgid "Copy" msgstr "Copy" @@ -1110,7 +1723,17 @@ msgstr "Select all" msgid "Undo" msgstr "Undo" +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Abort" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Ascending" + #: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" msgid "Check all" msgstr "Check all" @@ -1118,11 +1741,25 @@ msgstr "Check all" msgid "Check selected" msgstr "Check selected" +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Descending" + +#: tmainform.michapterlistfilter.caption +msgctxt "TMAINFORM.MICHAPTERLISTFILTER.CAPTION" +msgid "Filter" +msgstr "Filter" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Hide downloaded chapters" + #: tmainform.michapterlisthighlight.caption -msgid "Highlight download chapters" -msgstr "Highlight download chapters" +msgid "Highlight downloaded chapters" +msgstr "Highlight downloaded chapters" #: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" msgid "Uncheck all" msgstr "Uncheck all" @@ -1148,6 +1785,20 @@ msgstr "Task only" msgid "Task + Data" msgstr "Task + Data" +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Task + Data + Favorite" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Disable" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Enable" + #: tmainform.midownloadmergecompleted.caption msgid "Merge completed tasks" msgstr "Merge completed tasks" @@ -1184,8 +1835,7 @@ msgid "Change \"Save to\"" msgstr "Change \"Save to\"" #: tmainform.mifavoriteschecknewchapter.caption -#, fuzzy -msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgctxt "TMAINFORM.MIFAVORITESCHECKNEWCHAPTER.CAPTION" msgid "Check for new chapter" msgstr "Check for new chapter" @@ -1194,11 +1844,21 @@ msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" msgid "Delete" msgstr "Delete" +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Disable" + #: tmainform.mifavoritesdownloadall.caption msgctxt "tmainform.mifavoritesdownloadall.caption" msgid "Download all" msgstr "Download all" +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Enable" + #: tmainform.mifavoritesopenfolder.caption msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" msgid "Open Folder" @@ -1209,9 +1869,18 @@ msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" msgid "Open ..." msgstr "Open ..." +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Rename" + #: tmainform.mifavoritesstopchecknewchapter.caption msgid "Stop check for new chapter" -msgstr "" +msgstr "Stop check for new chapter" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Transfer website" #: tmainform.mifavoritesviewinfos.caption msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" @@ -1226,6 +1895,11 @@ msgstr "Highlight new manga" msgid "Add to Favorites" msgstr "Add to Favorites" +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Delete" + #: tmainform.mimangalistdownloadall.caption msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" msgid "Download all" @@ -1235,10 +1909,67 @@ msgstr "Download all" msgid "View manga infos" msgstr "View manga infos" +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "After download finish" + +#: tmainform.mitrayexit.caption +msgctxt "TMAINFORM.MITRAYEXIT.CAPTION" +msgid "Exit" +msgstr "Exit" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Exit" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernate" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Nothing" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Shutdown" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Restore" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Resume all" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "TMAINFORM.MITRAYSHOWDROPBOX.CAPTION" +msgid "Show Drop Box" +msgstr "Show Drop Box" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Stop all" + #: tmainform.mndownload1click.caption msgid "Download all lists from server at once" msgstr "Download all lists from server at once" +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLCHECK.CAPTION" +msgid "Check all" +msgstr "Check all" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Indeterminate all" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLUNCHECK.CAPTION" +msgid "Uncheck all" +msgstr "Uncheck all" + #: tmainform.mnupdate1click.caption msgid "Update all lists at once" msgstr "Update all lists at once" @@ -1286,6 +2017,22 @@ msgstr "Resume All" msgid "Stop All" msgstr "Stop All" +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Move selected item(s) to bottom" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Move selected item(s) down" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Move selected item(s) to top" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Move selected item(s) up" + #: tmainform.tbwebsitescollapseall.caption msgid "Collapse All" msgstr "Collapse All" @@ -1298,49 +2045,67 @@ msgstr "Expand All" msgid "About" msgstr "About" +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "About FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Accounts" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Changelog" + #: tmainform.tsconnections.caption msgid "Connections" msgstr "Connections" +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Custom color" + #: tmainform.tsdialogs.caption msgid "Dialogs" msgstr "Dialogs" #: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" msgid "Downloads" msgstr "Downloads" -#: tmainform.tsdownloadfilter.caption -msgid ">>" -msgstr ">>" - #: tmainform.tsfavorites.caption msgctxt "tmainform.tsfavorites.caption" msgid "Favorites" msgstr "Favorites" -#: tmainform.tsfilter.caption -msgctxt "tmainform.tsfilter.caption" -msgid "Filter" -msgstr "Filter" - #: tmainform.tsgeneral.caption msgid "General" msgstr "General" +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filter" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Info" + #: tmainform.tsinformation.caption msgid "Manga Info" msgstr "Manga Info" -#: tmainform.tsmangalist.caption -msgid "Manga List" -msgstr "Manga List" +#: tmainform.tslog.caption +msgid "Log" +msgstr "Log" #: tmainform.tsmisc.caption msgid "Misc" msgstr "Misc" #: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" msgid "Options" msgstr "Options" @@ -1357,7 +2122,26 @@ msgstr "Updates" msgid "View" msgstr "View" +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Advanced" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Modules" + +#: tmainform.tswebsiteoptions.caption +msgctxt "TMAINFORM.TSWEBSITEOPTIONS.CAPTION" +msgid "Options" +msgstr "Options" + #: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Websites" + +#: tmainform.tswebsiteselection.caption +msgctxt "TMAINFORM.TSWEBSITESELECTION.CAPTION" msgid "Websites" msgstr "Websites" @@ -1432,9 +2216,14 @@ msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" msgid "&Add to queue" msgstr "&Add to queue" -#: tnewchapter.caption -msgid "New Chapter Notification" -msgstr "New Chapter Notification" +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Select directory" #: tshutdowncounterform.btabort.caption msgid "&Abort" @@ -1444,10 +2233,53 @@ msgstr "&Abort" msgid "&Now" msgstr "&Now" -#: tshutdowncounterform.caption -msgctxt "TSHUTDOWNCOUNTERFORM.CAPTION" -msgid "Free Manga Downloader" -msgstr "Free Manga Downloader" +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Cancel" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Transfer Favorites" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "Clear downloaded chapter list and reload from server" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Transfer to" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "All" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Invalid" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Valid" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Title" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Website" #: tupdatedialogform.btnlater.caption msgid "&Later" @@ -1457,10 +2289,6 @@ msgstr "&Later" msgid "&Update" msgstr "&Update" -#: tupdatedialogform.caption -msgid "New Version Found" -msgstr "New Version Found" - #: tupdatedialogform.lbmessage.caption msgid "" "New version found! Do you want to update now?\n" @@ -1469,21 +2297,138 @@ msgstr "" "New version found! Do you want to update now?\n" "FMD will be closed to finish the update.\n" +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM1.CAPTION" +msgid "Add" +msgstr "Add" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM2.CAPTION" +msgid "Edit" +msgstr "Edit" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM4.CAPTION" +msgid "Delete" +msgstr "Delete" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Directory page number" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.TSDOWNLOADS.CAPTION" +msgid "Downloads" +msgstr "Downloads" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Max threads per task" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Number of threads" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Update List" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[1].TEXT" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTDOWNLOADMAXTHREADSPERTASK.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Value" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[1].TEXT" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Select a website" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "WebsiteSettingsForm" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "Website name" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "Setting name" + #: udownloadsmanager.rs_compressing msgid "Compressing..." msgstr "Compressing..." +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Disabled" + #: udownloadsmanager.rs_downloading msgid "Downloading" msgstr "Downloading" #: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" msgid "Failed" msgstr "Failed" -#: udownloadsmanager.rs_failedtocreatedirtoolong -msgid "Failed to create dir! Too long?" -msgstr "Failed to create dir! Too long?" +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Failed to create directory!" #: udownloadsmanager.rs_failedtryresumetask msgid "Failed, try resuming this task!" diff --git a/mangadownloader/languages/fmd.es.po b/mangadownloader/languages/fmd.es.po new file mode 100644 index 000000000..a8fc4fbd4 --- /dev/null +++ b/mangadownloader/languages/fmd.es.po @@ -0,0 +1,2589 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: FMD\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Language-Team: Mariolr\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: Poedit 2.0.6\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" +"Last-Translator: Mariolr\n" +"Language: es_419\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abortar" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "Descargando %s" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "Extrayendo %s" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: falló en extraer, exitstatus = %d" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" +"Falló en terminar:\n" +"\n" +"%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Fallido" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: falló en guardar" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: Perdido %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Descargar imagen original (require una cuenta en ExHentai)" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "Tamaño de imagen:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "¿Estás seguro que deseas eliminar esta cuenta?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Revisando" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Inválido" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Desconocido" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "¡Nombre de usuario o contraseña no puede estar vacio!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Importar completado." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Lista de manga sin importar" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Revisando..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Revisar actualización" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Revisión finalizada" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "Descarga terminada" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" +"Módulos Actualizados, ¿Reiniciar Ahora?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "¡Módulos Actualizados!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" +"Actualización de módulos encontrada, cualquier cambio local será perdido, ¿Quiere hacerlo?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "¡Actualización de Módulos Encontrada!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "Descargando..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Todas las descargas" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&OK" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Cancelar" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Revisando..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "No se puede conectar con el servidor" + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "No se puede obtener la información del manga. Por favor revisa tu conexión a internet e inténtalo de nuevo." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Cuenta de Descarga:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "¡Debes escoger al menos 1 sitio web manga!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "¿Estás seguro que quieres salir?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "¿Estás seguro de eliminar los favoritos?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "¿Estás seguro de eliminar todas las tareas terminadas?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "¿Estás seguro de querer eliminar este(os) ítem(s)?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "¿Estás seguro de desear eliminar la(s) tarea(s)?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Dividir descarga" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Este título ya se encuentra en la lista de descarga\n" +"¿Deseas descargarlo de todos modos?\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "¿Ingresar Nuevo Capitulo?" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Ingresar Nueva Ruta de Guardado :" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "¡Actualizador está Ejecutandose!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "¿Quieres Descargar la Lista de Manga del Servidor?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "¡URL no Soportada!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Descargar Todo\n" +"Agregar a Favoritos\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Completado\n" +"En Curso\n" +"\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "¡Free Manga Downloader está ya ejecutandose!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"¡Hay un problema con estos datos!\n" +"Quitarlo y volviendolo a agregar podría resolver el problema.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "Historial" + +#: frmmain.rs_import +msgid "Import" +msgstr "Importar" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Artista(s):" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Autor(es):" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Género(s):" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Estado:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Sinopsis:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Título:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Sitio Web:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "En Progreso" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Auto Revisar Capítulos Cada %d Minutos" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Ruta al Manga\n" +"%s : Nombre del Capítulo\n" +"\n" +"Ejemplo : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Cargando ..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Modo: Mostrar Todo (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Modo: Filtrado(%d)" + +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Modo: Buscando..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Un Mes" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Una Semana" + +#: frmmain.rs_optioncompress +#, fuzzy +#| msgid "" +#| "None\n" +#| "ZIP\n" +#| "CBZ\n" +#| "PDF\n" +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" +"Ninguno\n" +"ZIP\n" +"CBZ\n" +"PDF\n" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Nada\n" +"Salir\n" +"Apagar\n" +"Hibernar\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Seleccionado: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Software" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Ruta al Software (e.g. C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Hoy" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" +"WebP\n" +"PNG\n" +"JPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" +"Ninguno\n" +"El Más Rápido\n" +"Por Defecto\n" +"Máximo\n" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Entrada no valida!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Ayer" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "FMD Saldrá en %d segundos." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "Sistema Hibernará en %d segundos." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "Sistema se Apagará en %d segundos." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "Todo" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "No Valido" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Valido" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Inicialización del Vector:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Llave:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Usar Google DCP" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Mostrar todos los idiomas" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Mostrar Grupo de Scanlation" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Quitar Marca de Agua" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Guardar como PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abortar" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "Descargando Nueva Versión %s" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" +"Fallo al descargar nueva versión %s\n" +"\n" +"%d %s\n" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "Ha Fallado en Extraer %s, exitstatus = %d" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Fallido" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "Falló en Guardar %s" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "La Descarga del Paquete ha terminado, ¿proceder en reiniciar?" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "Descarga Finalizada" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "Perdido %s" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Editar" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Actualizar" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Sitio Web" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Usuario" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Estado" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "Cancelar" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Ok" + +#: taccountsetform.caption +msgid "Account" +msgstr "" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Mostar Contraseña" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Contraseña" + +#: taccountsetform.edusername.texthint +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Usuario" + +#: taccountsetform.label2.caption +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Usuario" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Contraseña" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "FormadeColorPersonalizada" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Lista Básica" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Lista de Capítulos" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Lista de Favoritos" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Lista de Manga" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Agregar a Favoritos" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&Cerrar" + +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Descargar Todo" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Limpiar" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Siempre Visible" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Limite de Registro" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Copiar" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Cancelar" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&OK" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Ruta al Software (e.g. C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Software:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Revisar actualización" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Auto Reinicio" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Mostrar Advertencia de Actualización" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Nombre del Archivo" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Última Modificación" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Último Mensaje" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Abortar Actualizar Lista" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Agregar a Favoritos" + +#: tmainform.btchecklatestversion.caption +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Revisar Última Version" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Limpiar Archivo de Registro" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Descargar" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Dividir descarga" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Revisar si hay Capitulo Nuevo" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Importar Lista" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Filtro" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Reiniciar Valor" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Abrir Registro" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Aplicar" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Leer Online" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Quitar Filtro" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Quitar Filtro" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Actualizar Lista de Manga" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Visitar mi blog" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Agregar a Descargas como Tarea Detenida" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Buscar Solo Manga Nuevo" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" +msgid "Automatic download after finish checking" +msgstr "Descarga Automática al Terminar de Revisar" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Auto Revisar si hay Nuevo Capítulo en un Intervalo" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" +msgid "Automatic remove completed manga from Favorites" +msgstr "Remover Automáticamente Manga Completado de Favoritos" + +#: tmainform.cboptionautocheckfavstartup.caption +msgid "Auto check for new chapter at startup" +msgstr "Revisar Automáticamente Nuevos Capítulos al Iniciar" + +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Revisar Automáticamente la Última Versión" + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Abrir Favoritos al Iniciar" + +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Reemplazar todo Carácter Unicode con" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Habilitar Esto si Tienes Algún Problema con Caracteres Unicode en la Ruta" + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Eliminar Las Tareas Completadas Al Cerrar" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Capítulo" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Volumen" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Habilitar Carga de Cover (Portada)" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Generar Automáticamente Folder de Capítulo" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" +msgid "Auto generate folder based on manga's name" +msgstr "Auto Generar Folder Basado en Nombre del Manga" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Habilitar Búsqueda en Directo (Lento en Lista Larga)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Minimizar al Iniciar" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Minimizar a Bandeja" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Permitir Solo Ejecutar un FMD " + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Remover nombre del Manga del capitulo" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Mostrar globo de sugerencia" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Borrar Tarea/Favorito" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Descargar Lista de Manga si está Vacía" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Mostrar Barra de Herramientas de Descargas" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Mostrar \"eliminar todas las tareas completadas\" en la barra de herramientas de descargas" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Mostar barra de herramientas de descargas en la izquierda" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "Salir de FMD" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "No Cargar la Información del Manga Cuando se Actualice la Lista (El Filtro no Funcionará)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Remover los Datos Locales Duplicados Cuando se Actualiza la Lista de Manga" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Usar Proxy" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "El Más Rápido" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Buscar en Todos Los Sitios de Manga" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Para más Sitios de Mangas, Ve a Opciones->Sitios Manga" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Regular Expresión" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Mostrar Drop Box" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Habilitar Registro" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Acción" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Un trabajo que típicamente demuestra peleas, violencia, caos, y ritmo de rápido movimiento." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Adulto" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Contiene contenido que es apropiado solo para adultos. Los títulos en esta categoría pueden incluir prolongadas escenas de intensa violencia y/o contenido sexual gráfico o desnudez." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Aventura" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Si un personaje en la historia va en un viaje o siguiendo esa línea, mejor apuesta a que es un manga de aventura. De otro modo, es a tu prejuicio personal en este caso." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Comedia" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Un trabajo dramático que es iluminado y muy seguido en un tono humorístico o satírico y que usualmente contiene una feliz resolución del conflicto temático." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Trabajos de Fans inspirados en manga/anime oficiales." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Drama" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Un trabajo que pretende traer una respuesta emocional, tales como inculcar la tristeza o tensión." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Posiblemente la línea entre lo hentai y no-hentai, ecchi usualmente se refiere a fanservice puesto para atraer un cierto grupo de fans." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantasía" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Cualquier cosa que involucre, pero no limitado a: magia, mundo de ensueño, y cuentos de hadas." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Cambio de sexo" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Chicas vistiendo como chicos, chicos vistiendo como chicas.\n" +"Chicos convirtiéndose en chicas, chicas convirtiéndose en chicos.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harem" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "Una serie que envuelve un personaje masculino y muchos personajes femeninos (generalmente atraídos por el personaje masculino). Un Harem inverso es cuando los sexos se invierten." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Historico" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Tiene que ver con viejos o antiguos tiempos." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Horror" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Una dolorosa emoción de miedo, temor y repugnancia; un estremecimiento de terror y odio; el sentimiento inspirado por algo terrible e impactante." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Literalmente \"mujer\". Dirigido a las mujeres de 18-30. Femenino equivalente al seinen. A diferencia de shoujo el romance es más realista y menos idealizado. La narración es más explícita y madura." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Representa una atracción sexual a chicas jóvenes o menores de edad." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Artes Marciales" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "Como su nombre indica, cualquier cosa relacionada artes marciales. Cualquiera de los diversos artes de combate o de autodefensa, como el aikido, karate, judo, o el taekwondo, kendo, la esgrima, y así sucesivamente." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Maduro" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "Contiene temas que pueden ser demasiado extremos para las personas menores de 17. Los títulos de esta categoría pueden contener violencia intensa, sangre y gore, contenido sexual y/o lenguaje fuerte." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mecha" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Un trabajo que involucra y por lo general se concentra en todos los tipos de grandes máquinas robóticas." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Misterio" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Por lo general, se produce un acontecimiento inexplicable, y el protagonista intenta averiguar cuál fue la causa." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psicológico" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Por lo general lidia con la filosofía de un estado de la mente, en la mayoría de los casos que detallan la psicología anormal." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romance" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Cualquier historia relacionada con el amor. Vamos a definir el amor como entre el hombre y la mujer en este caso. Aparte de eso, le corresponde tu propia imaginación de lo que es el amor." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Vida Escolar" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Tener un escenario importante de la historia ocupado con algún tipo de escuela." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Sci-Fi (Ciencia Ficción)" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Abreviatura de ciencia ficción, estos trabajos implican giros en la tecnología y otros fenómenos relacionados con la ciencia y que sean contrarias o tramos del mundo científico de hoy en día." + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "De Google: Seinen significa 'hombre joven'. Manga y anime que se dirige específicamente a los varones adultos jóvenes en torno a las edades de 18 a 25 años son títulos seinen. Las historias en las obras seinen apelan a los estudiantes universitarios y los que están en el mundo laboral. Por lo general las líneas de la historia se ocupan de los problemas de la edad adulta." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Representa una atracción sexual hacia los niños jóvenes o menores de edad." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Un trabajo destinado y dirigido principalmente a las mujeres. Por lo general, implica mucho romance y fuerte desarrollo de los personajes." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "A menudo sinónimo de yuri, esto puede ser considerado como algo menos extremo. \"Amor entre Chicas\", por así decirlo." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Un trabajo destinado y dirigido principalmente a los varones. Estas trabajos involucran generalmente la lucha y/o violencia." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "A menudo sinónimo de yaoi, esto puede ser pensado como algo menos extremo. \"Amor entre Chicos\", por así decirlo" + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Recuentos de la Vida" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "Como su nombre indica, este género representa el día a día tribulaciones de uno/muchos personaje(s). Estos desafíos/eventos podrían ocurrir técnicamente en la vida real y no son a menudo -si todo el tiempo-, establecido en la presente línea de tiempo en un mundo que refleja al nuestro." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Smut (Atrevido)" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Se ocupa de series que se consideran profanas u ofensivas, sobre todo en lo que respecta a contenido sexual." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Deportes" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "Como su nombre sugiere, cualquier cosa relacionado con el deporte. Béisbol, baloncesto, hockey, fútbol, golf, y las carreras sólo para nombrar unos pocos." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Sobrenatural" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Por lo general, implica sorprendentes e inexplicables poderes y eventos que desafían las leyes de la física." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Tragedia" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Contiene eventos que resultan en una gran pérdida y desgracia." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Este trabajo involucra generalmente relaciones íntimas entre hombres." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Este trabajo involucra generalmente relaciones íntimas entre mujeres." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "Siempre Empezar Tareas desde Capítulos Fallídos" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "Guardar PNG como JPEG" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Ingresa géneros personalizados, separados por coma." + +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Buscar Descargas..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Buscar Favoritos..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Artista" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Autor" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Filtro" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Parte de la Sinopsis" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Título" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Buscar Título..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" +msgid "Custom rename" +msgstr "Nombre Personalizado" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Ruta de Descarga por Defecto" + +#: tmainform.edoptionexternalparams.texthint +msgctxt "tmainform.edoptionexternalparams.texthint" +msgid "External program parameters" +msgstr "Parametros de Programa Externos" + +#: tmainform.edoptionexternalpath.texthint +msgctxt "tmainform.edoptionexternalpath.texthint" +msgid "External program path" +msgstr "Ruta de Programa Externa" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Nombre Personalizado" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Proxy Host/IP" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Nombre Personalizado" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Contraseña de Proxy" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Usuario de Proxy" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Guardar en" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Ingresar URL Aquí" + +#: tmainform.edwebsitessearch.texthint +msgctxt "tmainform.edwebsitessearch.texthint" +msgid "Search website..." +msgstr "Buscar Sitio Web..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Mostrar Dialogo de Confirmación para" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Drop Box" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Conversión de Imagen" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Programa Externo" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Favoritos" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Configuración de Proxy" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Renombrando" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Escoger la Ruta de Descarga por Defecto:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Opacidad" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Artista" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Autor" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Géneros Personalizados" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Géneros:\n" +"- Marcado: Incluir este Género.\n" +"- Desmarcado: Excluir este Género.\n" +"- En Gris: No Importa.\n" +"\n" +"Géneros Personalizados:\n" +"- Separar Múltiples Géneros con ','.\n" +"- Excluir un Género poniendo '!' o '-' al Inicio del Género.\n" +"- Ejemplo: Aventura,!Ecchi,Comedia.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Estado" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Sinopsis" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Título" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "Calidad JPEG" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Archivo de Registro:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Modo: Mostrar Todo (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" +msgid "Auto check for new chapter every %d minutes" +msgstr "Auto Revisar Capítulos Cada %d Minutos" + +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Nombre del Capitulo:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Nombre del Sitio Web\n" +"%MANGA% : Título del Manga\n" +"%CHAPTER% : Título del Capítulo\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artista\n" +"%NUMBERING% : Numeración\n" +"\n" +"Nota:\n" +"El Nombre de la Carpeta del Capítulo debe tener al menos %CHAPTER% o %NUMBERING%.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Tiempo de Conexión Expiró (Segundos)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Abrir Manga Usando un Programa Externo:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Parámetros:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "tmainform.lboptionexternalparamshint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Nombre del Archivo:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Nombre del Sitio Web\n" +"%MANGA% : Título del Manga\n" +"%CHAPTER% : Título del Capítulo\n" +"%FILENAME% : Nombre del Archivo\n" +"\n" +"Nota:\n" +"El Nombre del Archivo debe tener al menos %FILENAME%\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Host" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Idioma:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "Después de Finalizar la Descarga:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Nombre de la Carpeta del Manga:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Nombre del Sitio Web\n" +"%MANGA% : Título del Manga\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artista\n" +"\n" +"Nota:\n" +"El Nombre del la Carpeta del Manga debe tener al menos %MANGA%.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Numero de Tareas de Descargas al Mismo Tiempo" + +#: tmainform.lboptionmaxretry.caption +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Numero de Reintentos si la Tarea Tiene Problemas de Descarga (-1 = siempre reintenta)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Numero de Archivos Descargados por Tarea al Mismo Tiempo" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Nuevo Manga Basado en su Tiempo de Actualización (Días)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Contraseña" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "Nivel de Compresión PDF" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (Sin Pérdida), Más Bajo = DCTEncode (Con Pérdida)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Puerto" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Tipo" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Renombrar Dígitos" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Número de Reintentos si la Tarea ha Fallado" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Usuario" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "Nivel de Compresión PNG" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Guardar en:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "Guardar WebP como" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Eliminar" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Copiar" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Cotar" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Pegar" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Pegar e Ir" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Selecionar Todo" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Deshacer" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Abortar" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Ascendente" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Marcar Todo" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Marcar Selecionado" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Descendente" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Filtro" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Ocultar Capitulos Descargados" + +#: tmainform.michapterlisthighlight.caption +msgid "Highlight downloaded chapters" +msgstr "Resaltar Capitulos Descargados" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Desmarcar Todo" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Desmarcar Seleccionado" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Eliminar" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Eliminar Todas las Tareas Completadas" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Solo Tarea" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Tarea + Datos" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Tarea + Datos + Favorito" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Deshabilitar" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Habilitar" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Combinar Tareas Completadas" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Abrir Carpeta" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Abrir ..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Reanudar" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Detener" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Ver Información del Manga" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Cambiar \"Capitulo Actual\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Cambiar \"Guardar En\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Revisar si hay Capitulo Nuevo" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Eliminar" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Deshabilitar" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Descargar Todo" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Habilitar" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Abrir Carpeta" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Abrir ..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Renombrar" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Detener Revisar si hay Nuevo Capitulo" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Transferir Sitio Web" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Ver Información del Manga" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Resaltar Manga Nuevo" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Agregar a Favoritos" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Eliminar" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Descargar Todo" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Ver Información del Manga" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "Después de Finalizar la Descarga" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Salir" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Salir" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernar" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Nada" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Apagar" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Restaurar" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Reanudar Todo" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "Mostrar Drop Box" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Detener Todo" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Descargar Todas las Listas desde el Servidor Inmediatamente" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Marcar Todo" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Todo Indeterminado" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Desmarcar Todo" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Actualizar Todas las Listas Inmediatamente" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Descargar la Lista de Manga desde el Servidor" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Actualizar Lista de Manga" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Tener Todos los Géneros Marcados" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Tener Uno de los Géneros Marcado" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Modo" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Guardar Capitulos Descargados Como" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (Sin Pérdida), Más Bajo = DCTEncode (Con Pérdida)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Eliminar Todas las Tareas Completadas" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Reanudar Todo" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Detener Todo" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Mover Ítem(s) Seleccionado(s) al Final" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Mover Ítem(s) Seleccionado(s) Abajo" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Mover Ítem(s) Seleccionado(s) al Inicio" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Mover Ítem(s) Seleccionado(s) Arriba" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Desplegar Todo" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Expandir Todo" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "Sobre" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "Sobre FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Cuentas" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Historial de Cambios" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Conexiones" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Color Personalizado" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Diálogos" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "Descargas" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Favoritos" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "General" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filtro" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Información" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Información del Manga" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Registro" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Misceláneo" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Opciones" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Guardar en" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Actualizaciones" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Ver" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Avanzado" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Módulos" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Opciones" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Sitios Web" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" +msgid "Websites" +msgstr "Sitios Web" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Manga" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Estado" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Progreso" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Ratio de Transferencia" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Sitio Web" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Guardar en" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Agregado" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Título" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Capítulo Actual" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Sitio Web" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Guardar en" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "&Cancelar" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&Descargar" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&Agregar a Cola" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Seleccionar Directorio" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&Abortar" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Ahora" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Cancelar" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Transferir Favoritos" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "Limpiar Lista de Capítulos Descargados y Volver a Cargar desde Servidor" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Transferir a" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "Todo" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "No Valido" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Valido" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Título" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Sitio Web" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&Después" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Actualizar" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"¡Nueva Versión Encontrada! ¿Quieres Actualizar Ahora?\n" +"FMD se Cerrará para Terminar la Actualización.\n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Agregar" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Editar" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Eliminar" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Numero de Pagina del Directorio" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "Descargas" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Maximos Hilos por Tarea" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Numero de Hilos" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Actualizar Lista" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "Agente de Usuario" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Sitio Web" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Sitio Web" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Sitio Web" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Sitio Web" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Sitio Web" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "Agente de Usuario" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Seleccionar un Sitio Web" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Comprimiendo..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Deshabilitado" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Descargando" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Fallido" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Falló en Crear Directorio" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Fallido, Intenta Reanudar Esta Tarea!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Completado" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Preparando" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Detenido" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Esperando..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&Agregar a Cola" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "&Cancelar" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Revisar si hay Capitulo Nuevo" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&Descargar" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Remover" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "Encontrado %d Manga Completado" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Revisar Favoritos está Ejecutándose!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d Manga(s) Tiene Nuevo(s) Capitulo(s)" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> Tienen %d Nuevo(s) Capitulo(s)." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Manga Completado será Removido:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Encontrado %d Nuevo Capitulo de %d Manga(s):" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Cargando: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Revisar si hay Nueva Versión" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Versión Instalada" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Última Versión" + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Nueva Versión Encontrada!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s Tiene %d Nuevo(s) Manga(s)" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Obteniendo Directorio" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Obteniendo Información" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Obteniendo Lista Para" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Indexando Nuevo(s) Título(s)" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Buscando Nuevo(s) Título(s)" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Buscando Nuevo(s) Título(s) desde Otro Directorio" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Preparando" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Removiendo Duplicado de los Datos Actuales" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Removiendo Duplicado de Datos Locales" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Removiendo Duplicado de Nuevo(s) Título(s)" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Guardando Datos" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Sincronizando Datos" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Actualizando Lista" + diff --git a/mangadownloader/languages/fmd.id_ID.po b/mangadownloader/languages/fmd.id_ID.po index ecbb6350c..3342cb4ad 100644 --- a/mangadownloader/languages/fmd.id_ID.po +++ b/mangadownloader/languages/fmd.id_ID.po @@ -1,16 +1,101 @@ msgid "" +msgstr "Content-Type: text/plain; charset=UTF-8" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Hentikan" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "Mengunduh %d" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "Mengekstrak %s" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: gagal mengekstrak, kode = %d" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" msgstr "" -"Content-Type: text/plain; charset=UTF-8\n" -"Project-Id-Version: \n" -"POT-Creation-Date: \n" -"PO-Revision-Date: \n" -"Last-Translator: \n" -"Language-Team: Cholif\n" -"MIME-Version: 1.0\n" -"Content-Transfer-Encoding: 8bit\n" -"Language: id_ID\n" -"X-Generator: Poedit 1.8.1\n" -"Plural-Forms: nplurals=1; plural=0;\n" +"Gagal menyelesaikan:\n" +"\n" +"%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Gagal" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: gagal menyimpan" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: Tidak ditemukan %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Unduh gambar asli(membutuhkan akun ExHentai)" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "Ukuran gambar:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Otomatis\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Asli\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Apakah anda yakin ingin menghapus akun ini?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Memeriksa" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Tidak valid" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Tidak diketahui" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Nama user atau kata kunci tidak boleh kosong!" #: frmimportfavorites.rs_importcompleted msgid "Import completed." @@ -20,6 +105,81 @@ msgstr "Selesai mengimpor." msgid "List of unimported manga" msgstr "Daftar komik yang tidak bisa di-impor" +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Memeriksa..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Periksa pembaruan" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Selesai memeriksa" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "Selesai mengunduh" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" +"Modul sudah diperbarui, muat ulang sekarang?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "Modul diperbarui!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" +"Pembaruan modul ditemukan, perubahan lokal akan ditimpa, lanjutkan?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "Pembaruan modul ditemukan!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "Mengunduh..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "%s DIHAPUS*" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "%s GAGAL*" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "%s BARU*" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "%s DOWNLOADULANG*" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "%s PEMBARUAN*" + #: frmmain.rs_alldownloads msgid "All downloads" msgstr "Semua unduhan" @@ -35,6 +195,7 @@ msgid "Cancel" msgstr "Batal" #: frmmain.rs_checking +msgctxt "frmmain.rs_checking" msgid "Checking..." msgstr "Memeriksa..." @@ -46,6 +207,10 @@ msgstr "Tidak dapat terhubung ke server." msgid "Cannot get manga info. Please check your internet connection and try it again." msgstr "Tidak bisa mendapatkan informasi komik. Silakan periksa koneksi internet Anda dan coba lagi." +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Jumlah unduhan:" + #: frmmain.rs_dlgmangalistselect msgid "You must choose at least 1 manga website!" msgstr "Anda harus memilih minimal 1 situs komik!" @@ -62,10 +227,19 @@ msgstr "Apakah Anda yakin Anda ingin menghapus kesukaan ini?" msgid "Are you sure you want to delete all finished tasks?" msgstr "Apakah Anda yakin Anda ingin menghapus semua unduhan yang sudah selesai?" +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Apakah Anda yakin ingin menghapus data ini?" + #: frmmain.rs_dlgremovetask msgid "Are you sure you want to delete the task(s)?" msgstr "Apakah Anda yakin ingin menghapus unduhan ini?" +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Pecah unduhan" + #: frmmain.rs_dlgtitleexistindllist msgid "" "This title are already in download list.\n" @@ -112,6 +286,10 @@ msgstr "" "Bersambung\n" "\n" +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader sudah berjalan!" + #: frmmain.rs_hintfavoriteproblem msgid "" "There is a problem with this data!\n" @@ -153,8 +331,9 @@ msgid "Title:" msgstr "Judul:" #: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" msgid "Website:" -msgstr "Situs web:" +msgstr "Situs:" #: frmmain.rs_inprogress msgid "In progress" @@ -189,6 +368,11 @@ msgstr "Mode: Tampilkan semua (%d)" msgid "Mode: Filtered (%d)" msgstr "Mode: Disaring (%d)" +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Mode: Mencari..." + #: frmmain.rs_onemonth msgid "One month" msgstr "Satu bulan" @@ -197,15 +381,29 @@ msgstr "Satu bulan" msgid "One week" msgstr "Satu minggu" +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" +"Tidak ada\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" + #: frmmain.rs_optionfmddoitems msgid "" -"Do nothing\n" -"Exit FMD\n" +"Nothing\n" +"Exit\n" "Shutdown\n" "Hibernate\n" msgstr "" "Tidak ada\n" -"Tutup FMD\n" +"Keluar\n" "Matikan komputer\n" "Tidurkan komputer\n" @@ -226,6 +424,32 @@ msgstr "Path ke perangkat lunak (misalnya C:\\MangaDownloader)" msgid "Today" msgstr "Hari ini" +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" +"WebP\n" +"PNG\n" +"JPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Input salah!" + #: frmmain.rs_yesterday msgid "Yesterday" msgstr "Kemarin" @@ -242,10 +466,212 @@ msgstr "Komputer akan dihibernasi dalam %d detik" msgid "System will shutdown in %d second." msgstr "Komputer akan dimatikan dalam %d detik" +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "Semua" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Tidak valid" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Valid" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Initialization Vector:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Key:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Gunakan Google DCP" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Tampilkan semua bahasa" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Tampilkan nama grup scan" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Hapus watermark" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Simpan sebagai PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Hentikan" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "Mengunduh versi baru %s" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" +"Gagal mengunduh versi baru %s\n" +"\n" +"%d %s\n" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "Gagal mengekstrak %s, kode = %d" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Gagal" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "Gagal menyimpan %s" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "Pembaruan selesai diunduh, memuat ulang sekarang?" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "Unduhan selesai" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "Tidak ditemukan %s" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Ubah" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Segarkan" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "AccountManagerForm" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Situs" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Nama user" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Status" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "Batal" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Ok" + +#: taccountsetform.caption +msgid "Account" +msgstr "Akun" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Tampilkan kata kunci" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Kata kunci" + +#: taccountsetform.edusername.texthint +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Nama user" + +#: taccountsetform.label2.caption +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Nama user" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Kata kunci" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Semua daftar" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Daftar bab" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Daftar kesukaan" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Daftar komik" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Tambahkan ke kesukaan" + #: tformdroptarget.miclose.caption msgid "&Close" msgstr "&Tutup" +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Unduh semua" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Bersihkan" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Tetap di atas" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Batasi log" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Copy" + #: timportfavorites.btcancel.caption msgctxt "timportfavorites.btcancel.caption" msgid "Cancel" @@ -256,16 +682,12 @@ msgctxt "timportfavorites.btimport.caption" msgid "&OK" msgstr "&OK" -#: timportfavorites.caption -msgid "Import list ..." -msgstr "Impor daftar ..." - #: timportfavorites.cbsoftware.text msgid "Domdomsoft Manga Downloader" msgstr "Domdomsoft Manga Downloader" -#: timportfavorites.edpath.text -msgctxt "timportfavorites.edpath.text" +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" msgid "Path to the software (e.g. C:\\MangaDownloader)" msgstr "Path ke perangkat lunak (misalnya C:\\MangaDownloader)" @@ -273,24 +695,59 @@ msgstr "Path ke perangkat lunak (misalnya C:\\MangaDownloader)" msgid "Software:" msgstr "Perangkat lunak:" +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Periksa pembaruan" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Otomatis memuat ulang" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Tampilkan peringatan pembaruan" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Nama" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Terakhir diperbarui" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Pesan terakhir" + #: tmainform.btabortupdatelist.hint msgid "Abort update list" -msgstr "Batalkan pembaruan daftar komik" +msgstr "Hentikan pembaruan daftar komik" #: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" msgid "Add to favorites" msgstr "Tambahkan ke kesukaan" -#: tmainform.btcheckversion.caption -msgctxt "tmainform.btcheckversion.caption" -msgid "Check for new version" -msgstr "Periksa versi baru" +#: tmainform.btchecklatestversion.caption +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Periksa versi terbaru" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Bersihkan berkas log" #: tmainform.btdownload.caption msgctxt "tmainform.btdownload.caption" msgid "Download" msgstr "Unduh" +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Pecah unduhan" + #: tmainform.btfavoriteschecknewchapter.caption msgctxt "tmainform.btfavoriteschecknewchapter.caption" msgid "Check for new chapter" @@ -309,13 +766,17 @@ msgstr "Saring" msgid "Reset value" msgstr "Atur Ulang" +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Buka log" + #: tmainform.btoptionapply.caption msgid "Apply" msgstr "Terapkan" #: tmainform.btreadonline.caption msgid "Read online" -msgstr "Baca online" +msgstr "Baca daring" #: tmainform.btremovefilterlarge.caption msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" @@ -337,7 +798,6 @@ msgid "Visit my blog" msgstr "Kunjungi blog" #: tmainform.caption -msgctxt "tmainform.caption" msgid "Free Manga Downloader" msgstr "Free Manga Downloader" @@ -353,26 +813,46 @@ msgstr "" msgid "Search only new manga" msgstr "Cari hanya komik baru" -#: tmainform.cboptionautocheckfavstartup.caption -msgid "Automatic check for new chapter at startup" -msgstr "Otomatis periksa bab baru saat program dimulai" - -#: tmainform.cboptionautocheckupdate.caption -msgid "Check for new version " -msgstr "Periksa versi baru" - -#: tmainform.cboptionautodlfav.caption +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" msgid "Automatic download after finish checking" msgstr "Otomatis mengunduh setelah selesai memeriksa" -#: tmainform.cboptionautonumberchapter.caption -msgid "Auto number chapter" -msgstr "Otomatis nomor bab" +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Otomatis periksa bab baru dalam interval" -#: tmainform.cboptionautoremovecompletedmanga.caption +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" msgid "Automatic remove completed manga from Favorites" msgstr "Otomatis hapus komik yang sudah tamat dari daftar kesukaan" +#: tmainform.cboptionautocheckfavstartup.caption +msgid "Auto check for new chapter at startup" +msgstr "Otomatis periksa bab baru saat program dimulai" + +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Otomatis periksa versi terbaru" + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Buka Kesukaan saat program dimulai" + +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Ubah semua simbol unicode menjadi" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Aktifkan pilihan ini jika anda mengalami masalah dengan karakter unicode pada path." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Hapus unduhan yang selesai saat ditutup" + #: tmainform.cboptiondigitchapter.caption msgid "Chapter" msgstr "Bab" @@ -385,11 +865,12 @@ msgstr "Volume" msgid "Enable load manga cover" msgstr "Aktifkan sampul komik" -#: tmainform.cboptiongeneratechaptername.caption -msgid "Generate chapter folder with chapter name" -msgstr "Buat folder dengan nama bab" +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Buat otomatis folder bab" -#: tmainform.cboptiongeneratemangafoldername.caption +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" msgid "Auto generate folder based on manga's name" msgstr "Buat otomatis folder berdasarkan nama komik" @@ -397,9 +878,9 @@ msgstr "Buat otomatis folder berdasarkan nama komik" msgid "Enable live search (slow on long list)" msgstr "Aktifkan pencarian langsung (lambat dengan daftar yang panjang)" -#: tmainform.cboptionmangafoxremovewatermarks.caption -msgid "[Mangafox] Remove watermarks (Beware! Experimental!)" -msgstr "[Mangafox] Menghapus Watermark (Waspadalah! Eksperimental!)" +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Kecilkan ke penampan saat dimulai" #: tmainform.cboptionminimizetotray.caption msgid "Minimize to tray" @@ -409,30 +890,38 @@ msgstr "Perkecil ke penampan" msgid "Permit only one FMD running" msgstr "Hanya ijinkan satu FMD berjalan" -#: tmainform.cboptionpathconvert.caption -msgid "Change all all unicode symbols to \"_\" (choose this when you have problem with unicode path)" -msgstr "Ubah semua simbol unicode menjadi \"_\" (pilih ini ketika Anda memiliki masalah dengan lokasi unicode)" - #: tmainform.cboptionproxytype.text msgid "HTTP" msgstr "HTTP" -#: tmainform.cboptionshowalllang.caption -msgid "[Batoto] Show All Language" -msgstr "[Batoto] Tampilkan semua bahasa" +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Hapus nama komik dari bab" -#: tmainform.cboptionshowbatotosg.caption -msgid "[Batoto] Show scan group name" -msgstr "[Batoto] Tampilkan nama grup scan" +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Tampilkan balon pemberitahuan" #: tmainform.cboptionshowdeletetaskdialog.caption msgid "Delete task/favorite" msgstr "Hapus unduhan/kesukaan" +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Unduh daftar komik jika kosong" + #: tmainform.cboptionshowdownloadtoolbar.caption msgid "Show downloads toolbar" msgstr "Tampilkan toolbar unduhan" +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Tampilkan \"Hapus semua unduhan selesai\" di toolbar unduhan" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Tampilkan toolbar kiri" + #: tmainform.cboptionshowquitdialog.caption msgid "Exit FMD" msgstr "Tutup FMD" @@ -449,6 +938,11 @@ msgstr "Menghapus duplikat data lokal saat memperbarui daftar komik" msgid "Use proxy" msgstr "Gunakan proxy" +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "Paling cepat" + #: tmainform.cbsearchfromallsites.caption msgid "Search in all manga sites" msgstr "Cari di semua situs komik" @@ -461,10 +955,20 @@ msgstr "Untuk situs komik yang lain, silahkan pilih di Pengaturan->Situs komik" msgid "Regular Expression" msgstr "Regular Expression" +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + #: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" msgid "Show Drop Box" msgstr "Tampilkan kotak unduh" +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Aktifkan logging" + #: tmainform.ckfilteraction.caption msgid "Action" msgstr "Action" @@ -781,10 +1285,29 @@ msgstr "Yuri" msgid "This work usually involves intimate relationships between women." msgstr "Biasanya melibatkan hubungan yang intim antara sesama perempuan." +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "Selalu mulai undudah dari bab yang gagal" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "Simpan PNG sebagai JPEG" + #: tmainform.edcustomgenres.texthint msgid "Input custom genres, separated by comma" msgstr "Masukan genre pilihan, dipisahkan dengan koma" +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Cari unduhan..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Cari kesukaan..." + #: tmainform.edfilterartists.texthint msgctxt "tmainform.edfilterartists.texthint" msgid "Artist" @@ -795,6 +1318,11 @@ msgctxt "tmainform.edfilterauthors.texthint" msgid "Author" msgstr "Penulis" +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Saring" + #: tmainform.edfiltersummary.texthint msgid "Part of summary" msgstr "Bagian dari ringkasan" @@ -804,7 +1332,13 @@ msgctxt "tmainform.edfiltertitle.texthint" msgid "Title" msgstr "Judul" -#: tmainform.edoptioncustomrename.texthint +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Cari nama komik..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" msgid "Custom rename" msgstr "Ubah nama kustom" @@ -822,18 +1356,24 @@ msgctxt "tmainform.edoptionexternalpath.texthint" msgid "External program path" msgstr "Parameter program" +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Ubah nama kustom" + #: tmainform.edoptionhost.texthint msgid "Proxy host/IP" msgstr "Host/IP" +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Ubah nama kustom" + #: tmainform.edoptionpass.texthint msgid "Proxy password" msgstr "Kata kunci" -#: tmainform.edoptionport.texthint -msgid "Proxy Port" -msgstr "Port" - #: tmainform.edoptionuser.texthint msgid "Proxy username" msgstr "Nama user" @@ -843,11 +1383,6 @@ msgctxt "tmainform.edsaveto.texthint" msgid "Save to" msgstr "Lokasi penyimpanan" -#: tmainform.edsearch.texthint -msgctxt "tmainform.edsearch.texthint" -msgid "Search title..." -msgstr "Cari nama komik..." - #: tmainform.edurl.texthint msgid "Input URL here" msgstr "Masukkan URL disini" @@ -855,12 +1390,20 @@ msgstr "Masukkan URL disini" #: tmainform.edwebsitessearch.texthint msgctxt "tmainform.edwebsitessearch.texthint" msgid "Search website..." -msgstr "Cari situs web..." +msgstr "Cari situs..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Tampilkan dialog konfirmasi untuk" #: tmainform.gbdroptarget.caption msgid "Drop Box" msgstr "Kotak unduh" +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Konversi gambar" + #: tmainform.gboptionexternal.caption msgid "External program" msgstr "Program eksternal" @@ -914,7 +1457,7 @@ msgid "" "\n" "Custom Genres:\n" "- Separate multiple genres with ','.\n" -"- Exclude a genre by placing ''!'' at the beginning of a genre.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" "- Example: Adventure,!Ecchi,Comedy.\n" msgstr "" "Genre: \n" @@ -924,7 +1467,7 @@ msgstr "" "\n" "Genre pilihan: \n" "- Pisahkan beberapa genre dengan ','. \n" -"- Kecualikan genre dengan menempatkan ''!'' pada permulaan genre. \n" +"- Kecualikan genre dengan menempatkan '!' atau '-' pada permulaan genre. \n" "- Contoh: petualangan,! Ecchi, komedi.\n" #: tmainform.lbfilterstatus.caption @@ -941,29 +1484,35 @@ msgctxt "tmainform.lbfiltertitle.caption" msgid "Title" msgstr "Judul" +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "Kualitas JPEG" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Berkas log:" + #: tmainform.lbmode.caption -msgid "Mode: Show all manga" -msgstr "Mode: Tampilkan semua komik" +msgid "Mode: Show all (0)" +msgstr "Mode: Tampilkan semua (0)" -#: tmainform.lboptionautocheckminutes.caption -msgctxt "tmainform.lboptionautocheckminutes.caption" +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" msgid "Auto check for new chapter every %d minutes" msgstr "Otomatis periksa bab baru setiap %d menit" -#: tmainform.lboptionconnectiontimeout.caption -msgid "Connection timeout (seconds)" -msgstr "Batas waktu koneksi (detik)" - -#: tmainform.lboptioncustomrename.caption -msgid "Chapter folder name:" -msgstr "Nama folder:" +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Nama bab:" -#: tmainform.lboptioncustomrenamehint.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT.CAPTION" +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" msgid "[?]" msgstr "[?]" -#: tmainform.lboptioncustomrenamehint.hint +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" msgid "" "%WEBSITE% : Website name\n" "%MANGA% : Manga title\n" @@ -983,20 +1532,11 @@ msgstr "" "%NUMBERING% : Penomoran\n" "\n" "Catatan:\n" -"Nama folder harus memiliki setidaknya %CHAPTER% atau %NUMBERING%.\n" +"Nama bab setidaknya harus memiliki %CHAPTER% atau %NUMBERING%.\n" -#: tmainform.lboptioncustomrenamehint1.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT1.CAPTION" -msgid "[?]" -msgstr "[?]" - -#: tmainform.lboptioncustomrenamehint1.hint -msgid "100: FlateEncode (lossless), lower: DCTEncode (lossy)" -msgstr "100 = FlateEncode (lossless), lebih rendah = DCTEncode (lossy)" - -#: tmainform.lboptiondialogs.caption -msgid "Show dialog confirmation for:" -msgstr "Tampilkan dialog konfirmasi untuk:" +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Batas waktu koneksi (detik)" #: tmainform.lboptionexternal.caption msgid "Open manga by using external program:" @@ -1011,6 +1551,33 @@ msgctxt "tmainform.lboptionexternalparamshint.caption" msgid "[?]" msgstr "[?]" +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Nama File:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Nama situs\n" +"%MANGA% : Judul komik\n" +"%CHAPTER% : Judul bab\n" +"%FILENAME% : Nama file\n" +"\n" +"Note:\n" +"Nama file setidaknya harus memiliki %FILENAME%\n" + #: tmainform.lboptionhost.caption msgid "Host" msgstr "Host" @@ -1023,23 +1590,52 @@ msgstr "Bahasa:" msgid "After download finish:" msgstr "Tugas setelah unduhan selesai:" +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Nama folder komik:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Nama situs\n" +"%MANGA% : Judul komik\n" +"%AUTHOR% : Penulis\n" +"%ARTIST% : Seniman\n" +"\n" +"Catatan:\n" +"Nama folder komik setidaknya harus meiliki %MANGA%\n" + #: tmainform.lboptionmaxparallel.caption -msgid "Number of downloaded tasks at the same time (Max: 8)" -msgstr "Jumlah unduhan aktif pada waktu yang sama (Max: 8)" +msgid "Number of downloaded tasks at the same time" +msgstr "Jumlah unduhan aktif pada waktu yang sama" #: tmainform.lboptionmaxretry.caption -msgid "Number of retry times if tasks have download problems (0 = always retry)" -msgstr "Jumlah pengulangan jika unduhan memiliki masalah (0 = selalu coba lagi)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Jumlah pengulangan jika unduhan memiliki masalah (-1 = selalu coba lagi)" #: tmainform.lboptionmaxthread.caption -msgid "Number of downloaded files per task at the same time (Max: 32)" -msgstr "Jumlah koneksi per unduhan pada waktu yang sama (Max: 32)" +msgid "Number of downloaded files per task at the same time" +msgstr "Jumlah koneksi per unduhan pada waktu yang sama" #: tmainform.lboptionnewmangatime.caption msgid "New manga based on it's update time (days)" msgstr "Komik baru berdasarkan waktu pembaruan (hari)" #: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" msgid "Password" msgstr "Kata kunci" @@ -1052,6 +1648,11 @@ msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" msgstr "100 = FlateEncode (lossless), lebih rendah = DCTEncode (lossy)" +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + #: tmainform.lboptionport.caption msgid "Port" msgstr "Port" @@ -1064,20 +1665,35 @@ msgstr "Tipe" msgid "Rename digits" msgstr "Ganti nama digit" +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Jumlah pengulangan pada tugas unduhan yang memiliki masalah" + #: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" msgid "Username" msgstr "Nama user" +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "Level kompresi PNG" + #: tmainform.lbsaveto.caption msgid "Save to:" msgstr "Lokasi penyimpanan:" +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "Simpan WebP sebagai" + #: tmainform.medturldelete.caption msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" msgid "Delete" msgstr "Hapus" #: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" msgid "Copy" msgstr "Salin" @@ -1101,7 +1717,17 @@ msgstr "Pilih semua" msgid "Undo" msgstr "Urungkan" +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Hentikan" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Menaik" + #: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" msgid "Check all" msgstr "Centang semua" @@ -1109,11 +1735,25 @@ msgstr "Centang semua" msgid "Check selected" msgstr "Centang yang dipilih" +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Menurun" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Saring" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Sembunyikan bab terunduh" + #: tmainform.michapterlisthighlight.caption -msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" msgstr "Sorot bab terunduh" #: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" msgid "Uncheck all" msgstr "Hapus semua centang" @@ -1139,6 +1779,20 @@ msgstr "Daftar saja" msgid "Task + Data" msgstr "Daftar dan data" +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Daftar, data dan kesukaan" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Matikan" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Nyalakan" + #: tmainform.midownloadmergecompleted.caption msgid "Merge completed tasks" msgstr "Gabungkan unduhan selesai" @@ -1184,11 +1838,21 @@ msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" msgid "Delete" msgstr "Hapus" +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Matikan" + #: tmainform.mifavoritesdownloadall.caption msgctxt "tmainform.mifavoritesdownloadall.caption" msgid "Download all" msgstr "Unduh semua" +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Nyalakan" + #: tmainform.mifavoritesopenfolder.caption msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" msgid "Open Folder" @@ -1199,10 +1863,19 @@ msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" msgid "Open ..." msgstr "Buka ..." +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Ubah nama" + #: tmainform.mifavoritesstopchecknewchapter.caption msgid "Stop check for new chapter" msgstr "Berhenti periksa bab baru" +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Transfer website" + #: tmainform.mifavoritesviewinfos.caption msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" msgid "View manga info" @@ -1216,6 +1889,11 @@ msgstr "Sorot komik baru" msgid "Add to Favorites" msgstr "Tambahkan ke kesukaan" +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Hapus" + #: tmainform.mimangalistdownloadall.caption msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" msgid "Download all" @@ -1225,10 +1903,67 @@ msgstr "Unduh semua" msgid "View manga infos" msgstr "Lihat informasi komik" +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "Setelah download selesai" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Keluar" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Keluar" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Tidurkan komputer" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "TIdak ada" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Matikan komputer" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Pulihkan" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Lanjutkan semua" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "Tampilkan kotak unduh" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Hentikan semua" + #: tmainform.mndownload1click.caption msgid "Download all lists from server at once" msgstr "Unduh semua daftar dari server" +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Centang semua" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Semua tak tentu" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Hapus semua centang" + #: tmainform.mnupdate1click.caption msgid "Update all lists at once" msgstr "Perbarui semua daftar" @@ -1276,6 +2011,22 @@ msgstr "Lanjutkan semua" msgid "Stop All" msgstr "Hentikan semua" +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Pindahkan item-item terpilih ke paling bawah" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Pindahkan item-item terpilih ke bawah" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Pindahkan item-item terpilih ke paling atas" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Pindahkan item-item terpilih ke atas" + #: tmainform.tbwebsitescollapseall.caption msgid "Collapse All" msgstr "Lipat semua" @@ -1288,49 +2039,67 @@ msgstr "Bentangkan semua" msgid "About" msgstr "Tentang" +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "Tentang FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Akun" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Catatan perubahan" + #: tmainform.tsconnections.caption msgid "Connections" msgstr "Koneksi" +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Kustomisasi warna" + #: tmainform.tsdialogs.caption msgid "Dialogs" msgstr "Dialog" #: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" msgid "Downloads" msgstr "Unduhan" -#: tmainform.tsdownloadfilter.caption -msgid ">>" -msgstr ">>" - #: tmainform.tsfavorites.caption msgctxt "tmainform.tsfavorites.caption" msgid "Favorites" msgstr "Kesukaan" -#: tmainform.tsfilter.caption -msgctxt "tmainform.tsfilter.caption" -msgid "Filter" -msgstr "Saring" - #: tmainform.tsgeneral.caption msgid "General" msgstr "Umum" +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Saring" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Info" + #: tmainform.tsinformation.caption msgid "Manga Info" msgstr "Informasi Komik" -#: tmainform.tsmangalist.caption -msgid "Manga List" -msgstr "Daftar Komik" +#: tmainform.tslog.caption +msgid "Log" +msgstr "Log" #: tmainform.tsmisc.caption msgid "Misc" msgstr "Lain-lain" #: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" msgid "Options" msgstr "Pengaturan" @@ -1347,9 +2116,28 @@ msgstr "Pembaruan" msgid "View" msgstr "Tampilan" +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Lanjutan" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Modul" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Pengaturan" + #: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Situs" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" msgid "Websites" -msgstr "Situs web" +msgstr "Situs" #: tmainform.vtdownload.header.columns[0].text msgid "Manga" @@ -1372,7 +2160,7 @@ msgstr "Kecepatan" #: tmainform.vtdownload.header.columns[4].text msgctxt "tmainform.vtdownload.header.columns[4].text" msgid "Website" -msgstr "Situs web" +msgstr "Situs" #: tmainform.vtdownload.header.columns[5].text msgctxt "tmainform.vtdownload.header.columns[5].text" @@ -1400,7 +2188,7 @@ msgstr "Bab saat ini" #: tmainform.vtfavorites.header.columns[3].text msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" msgid "Website" -msgstr "Situs web" +msgstr "Situs" #: tmainform.vtfavorites.header.columns[4].text msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" @@ -1422,22 +2210,70 @@ msgctxt "tnewchapter.btqueue.caption" msgid "&Add to queue" msgstr "&Tambahkan ke antrian" -#: tnewchapter.caption -msgid "New Chapter Notification" -msgstr "Pemberitahuan bab baru" +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Pilih direktori" #: tshutdowncounterform.btabort.caption msgid "&Abort" -msgstr "&Batalkan" +msgstr "&Hentikan" #: tshutdowncounterform.btnow.caption msgid "&Now" msgstr "&Sekarang" -#: tshutdowncounterform.caption -msgctxt "tshutdowncounterform.caption" -msgid "Free Manga Downloader" -msgstr "Free Manga Downloader" +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Batal" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Transfer kesukaan" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "Bersihkan daftr bab terunduh dan muat ulang dari server" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Transfer ke" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "Semua" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Tidak valid" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Valid" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Judul" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Situs" #: tupdatedialogform.btnlater.caption msgid "&Later" @@ -1447,10 +2283,6 @@ msgstr "&Nanti saja" msgid "&Update" msgstr "&Perbarui" -#: tupdatedialogform.caption -msgid "New Version Found" -msgstr "Versi baru ditemukan" - #: tupdatedialogform.lbmessage.caption msgid "" "New version found! Do you want to update now?\n" @@ -1459,21 +2291,138 @@ msgstr "" "Versi baru ditemukan! Apakah Anda ingin memperbarui sekarang? \n" "FMD akan ditutup untuk menyelesaikan update.\n" +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Tambah" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Ubah" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Hapus" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Jumlah halaman directory" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "Unduhan" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Max jumlah threads per unduhan" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Jumlah threads" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Pembaruan daftar" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Situs" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Situs" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Nilai" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Situs" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Nilai" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Situs" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Nilai" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Situs" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Pilih situs" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "WebsiteSettingsForm" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "Nama situs" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "Nama pengaturan" + #: udownloadsmanager.rs_compressing msgid "Compressing..." msgstr "Mengompresi..." +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Dimatikan" + #: udownloadsmanager.rs_downloading msgid "Downloading" msgstr "Mengunduh" #: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" msgid "Failed" msgstr "Gagal" -#: udownloadsmanager.rs_failedtocreatedirtoolong -msgid "Failed to create dir! Too long?" -msgstr "Gagal membuat folder! Terlalu panjang?" +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Gagal membuat direktori!" #: udownloadsmanager.rs_failedtryresumetask msgid "Failed, try resuming this task!" diff --git a/mangadownloader/languages/fmd.pl_PL.po b/mangadownloader/languages/fmd.pl_PL.po new file mode 100644 index 000000000..f14130823 --- /dev/null +++ b/mangadownloader/languages/fmd.pl_PL.po @@ -0,0 +1,2580 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: \n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: pl_PL\n" +"X-Generator: Poedit 1.8.12\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Anuluj" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Niepowodzenie" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Pobierz oryginalny obraz (wymaga konta ExHentai)" + +#: ehentai.rs_settingsimagesize +#| msgid "Image size" +msgid "Image size:" +msgstr "Rozmiar obrazka:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Orginał\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Czy na pewno chcesz usunąć to konto?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Sprawdzanie" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Niepoprawnie" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Nieznane" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Nazwa użytkownika lub hasło nie może być puste!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Importowanie zakończone." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Lista niezaimportowanych mang" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Sprawdzanie..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "" + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Wszystkie pobrania" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&OK" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Anuluj" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Sprawdzanie..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Nie można się połączyć z serwerem." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Nie można uzyskać informacji o mandze. Proszę sprawdzić swoje połączenie z internetem i spróbuj ponownie." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Licznik pobrań" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "Musisz wybrać co najmniej 1 stronę z mangami!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Czy na pewno chcesz wyjść?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Czy na pewno chcesz usunąć ulubione?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Czy na pewno chcesz usunąć wszystkie zakończone zadania?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Czy na pewno chcesz usunąć ten element?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Czy jesteś pewien, że chcesz usunąć zadanie?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Rozdzielone pobieranie" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Ten tytuł znajduje się juz na liście pobierania.\n" +"Czy chcesz go pobrać pomimo tego? \n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Wpisz nowy rozdział:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Wpisz nową ścieżkę zapisu:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Updater jest uruchomiony!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Chcesz pobrać listę mang z serwera?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "URL nie jest obsługiwany!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Pobierz wszystko\n" +"Dodaj do ulubionych\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Zakończone\n" +"W trakcie\n" +"\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader jest już uruchomiony!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"Jest problem z tymi danymi!\n" +"Usunięcie i ponowne dodanie tych danych może rozwiązać ten problem.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "Historia" + +#: frmmain.rs_import +msgid "Import" +msgstr "Importuj" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Wykonawca:" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Autor:" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Gatunek:" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Status:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Streszczenie:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Tytuł:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Strona www:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "W trakcie" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Automatyczne sprawdzanie nowych rozdziałów co %d minut" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Ścieżka do mangi\n" +"%s : Nazwa pliku rozdziału\n" +"\n" +"Przykład: \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Ładowanie ..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Tryb: Pokaż wszystko (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Tryb: Filtrowany (%d)" + +#: frmmain.rs_modesearching +#| msgid "Searching..." +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Tryb: Wyszukiwanie ..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Miesiąc temu" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Tydzień temu" + +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Nic\n" +"Wyjdź\n" +"Wyłącz\n" +"Hibernuj\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Wybrano: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Oprogramowanie" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Ścieżka do programu (np C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Dzisiaj" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Nieprawidłowe wejście!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Wczoraj" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "FMD wyłączy się za %d sekund." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "System zahibernuje się za %d sekund." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "System wyłączy się za %d sekund." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Niepoprawnie" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Pokaż wszystkie języki" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Pokaż grupę skanlacja" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Usuń znak wodny" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Zapisz jako PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Anuluj" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Niepowodzenie" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Edytuj" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Odśwież" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +#| msgid "Username" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Strona WWW" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Nazwa użytkownika" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Status" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "Anuluj" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "OK" + +#: taccountsetform.caption +msgid "Account" +msgstr "" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Pokaż hasło" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Hasło" + +#: taccountsetform.edusername.texthint +#| msgid "Status" +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Nazwa użytkownika" + +#: taccountsetform.label2.caption +#| msgid "Status" +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Nazwa użytkownika" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Hasło" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Lista podstawowa" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Lista rozdziałów" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Lista ulubionych" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Lista mang" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Dodaj do ulubionych" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&Zamknij" + +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Pobierz wszystko" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Wyczyść" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Zawsze na wierzchu" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Limit logów" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Kopia" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Anuluj" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&OK" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Ścieżka do programu (np C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Oprogramowanie:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Przerwij aktualizacje list" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Dodaj do ulubionych" + +#: tmainform.btchecklatestversion.caption +#| msgid "Check for new version" +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Szukaj aktualizacji" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Wyczyść plik logów" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Pobierz" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Rozdzielone pobieranie" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Sprawdź czy są nowe rozdziały" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Importuj listę" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Filtr" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Przywróć domyślne" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Otwórz Log" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Zastosuj" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Czytaj online" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Usuń filtr" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Usuń filtr" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Aktualizuj listę mang" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Odwiedź mój blog" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Dodaj do listy pobieranych jako zatrzymane zadanie." + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Szukaj tylko nowych mang" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" +msgid "Automatic download after finish checking" +msgstr "Automatyczne pobieranie po sprawdzeniu " + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Automatyczne sprawdzanie nowego rozdziału w przedziale" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" +msgid "Automatic remove completed manga from Favorites" +msgstr "Automatycznie usuń ukończone mangi z Ulubionych" + +#: tmainform.cboptionautocheckfavstartup.caption +#| msgid "Automatic check for new chapter at startup" +msgid "Auto check for new chapter at startup" +msgstr "Automatyczne sprawdzanie nowego rozdziału na starcie" + +#: tmainform.cboptionautochecklatestversion.caption +#| msgid "Check for new version " +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Automatyczne sprawdzanie aktualizacji" + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "" + +#: tmainform.cboptionchangeunicodecharacter.caption +#| msgid "Change all all character to" +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Wymień wszystkie znaki Unicode" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Włącz tę opcję, jeśli masz problem z znakami Unicode w ścieżce." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Rozdział" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Tom" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Włącz ładowanie okładek mang" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Automatyczne generowanie folderu rozdziału" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" +msgid "Auto generate folder based on manga's name" +msgstr "Automatyczne generowanie folderu używając nazwy mangi" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Włącz wyszukiwanie na żywo (wolne w przypadku długiej lisy)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Zminimalizuj do zasobnika" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Pozwól na tylko jedną instancje FMD uruchomioną" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Usuń nazwę mangi z rozdziału" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Usuń zadanie/ulubione" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Pobierz listę mang jeżeli jest pusta" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Pokaż pasek pobierania" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "Wyjdź z FMD" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Nie ładuj informacji o mandze podczas aktualizowania listy (filtry nie będą działać!)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Usuwanie zduplikowane lokalne dane podczas aktualizacji listy mang" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Użyj proxy" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Szukaj we wszystkich witrynach " + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Aby uzyskać więcej stron z mangami, przejdź do Opcje->Strony z mangami" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Wyrażenie regularne" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Pokaż menu rozwijane" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Włącz zapis logów" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Akcja" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Dzieło zazwyczaj przedstawiających walke, przemoc, chaos i szybki ruch." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Dla dorosłych" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Zawiera treści, które są przeznaczone wyłącznie dla osób dorosłych. Tytuły w tej kategorii mogą zawierać długotrwałych intensywne sceny przemocy i/lub treści seksualne i nagość." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Przygoda" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Jeśli postać idzie na wycieczkę lub coś w tym stylu, to zapewnie jest to manga przygodowa. W przeciwnym razie, to jest do osobistego uznania." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Komedia" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Dramatyczne dzieło, które jest lekkie, często humorystyczne, satyryczne w tonie i że zazwyczaj kończą się szczęśliwym sposobem rozwiązania konfliktu tematycznego." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Fanowska manga oparta/inspirowana na innej oficjalnej mandze/anime." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Drama" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Dzieło ma na celu doprowadzić do reakcji emocjonalnej, takie jak smutek lub napięcie." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Prawdopodobnie linia między hentai i non-hentai, ecchi zazwyczaj odnosi się do Fanserwisu aby przyciągnąć pewną grupę fanów." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantasy" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Wszystko co wiąże się z nie nieograniczonym światem magii, marzeń i bajek." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Tanswestytyzm" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Dziewczyny ubieranie się jak faceci, faceci ubieranie się jak dziewczyny.\n" +"Faceci zmieniający się w dziewczyny, dziewczyny zmienia się w facetów.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harem" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "Cykl obejmujący jedną męską postać i wiele kobiet(zwykle przyciągnięte do faceta). Odwrotny Harem jest wtedy gdy płcie są odwrócone." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Hentai ( ͡° ͜ʖ ͡°)" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Historyczne" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Mające odczynienia z dawanymi czasami lub starożytnością." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Horror" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Ból, strach, płacz i zgrzytanie zębów; uczucie inspirowane przez coś strasznego i szokującego." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Dosłownie \"Kobieta\";. Głównie kobiety w wielku 18-30. Kobiecy odpowiednik seinen. W przeciwieństwie Shoujo romans jest bardziej realistyczny i mniej wyidealizowany. Historia jest bardziej wyraźna i dojrzała." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Reprezentowanie pociągu seksualnego do młodych i młodocianych dziewcząt. (ps. Jest to nielegalne w Polsce)" + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Sztuki walk" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "Jak sama nazwa wskazuje, wszystko co związane ze sztukami walk. Różne typy sztuk walk i samoobrony, takich jak aikido, karate, judo, taekwondo, czy kendo, szermierka, i tak dalej i tak dalej." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Dojrzałe" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "Zawiera temat który może być zbyt ekstremalny dla osób w wieku poniżej 17 roku życia. Tytuły w tej kategorii mogą zawierać przemoc, krew i gore, treści seksualnych i/lub wulgaryzmy." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mecha" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Dzieło głównie skoncentrowane na dużych robotycznych maszynach." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Tajemnica" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Zwykle niewyjaśnione zdarzenie, a główny bohater próbuje dowiedzieć się co go spowodowało." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psychologiczne" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Zazwyczaj zajmuje się filozofią stan umysłu, w większości przypadków z wyszczególnieniem pschologii niekonwencjonalnej." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romans" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Każda historia powiązana z miłością. Tutaj zdefiniowana jako miłość między mężczyzną i kobietą. Poza tym, zależy to od twojego własnego wyobrażenia, czym jest miłość." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Szkolne" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Główne zdążenia dziejące się w szkole." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Sci-Fi" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Skrót od science fiction, prace te obejmują przekręty na technologii i innych zjawiskach związanych z nauką, które są sprzeczne lub naciągnięte względem współczesnego naukowego świata" + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "Seinen oznacza 'Młodego mężczyznę'. Grupą docelową mangi i anime tego gatunku są młodzi dorośli mężczyźni w wieku od 18 do 25 lat. Historia w Seinen odnosi się do studentów uniwersytetów i ich pracy. zazwyczaj historia opiera się na problemach dorosłego życia." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Reprezentuje pociąg seksualny do młodych i nieletnich chłopców." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Dzieło przeznaczone przede wszystkim dla kobiet. Zwykle wiąże się z romantyzmem i silnym rozwojem postaci." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "Cęsto równoznaczny z yuri, może być uznane jako coś mniej ekstremalnego. \"Dziewczęca miłość\", że tak powiem." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Dzieło przeznaczone przede wszystkim dla mężczyzn. Dzieła te obejmują zazwyczaj walki i/lub przemoc." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "Cęsto równoznaczny z yaoi, może być uznane jako coś mniej ekstremalnego. \"Chłopięca miłość\", że tak powiem." + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Okruchy życia" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "Jak sama nazwa wskazuje, ten gatunek reprezentuje codzienne zmagania jednej lub wielu postaci. Te wyzwania/wydarzenia mogłyby zdarzyć w realnym życiu, i często -jeśli nie zawsze- dzieją się w świecie przypominającym nasz własny." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Sprośne" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Obejmuje zdarzenia, które są uważane za bluźniercze lub obraźliwe, zwłaszcza w odniesieniu do treści o charakterze seksualnym." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Sportowe" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "Jak sama nazwa wskazuje, cokolwiek związane ze sportem. Baseball, koszykówka, hokej, piłka nożna, golf, wyścigi itd." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Supernatural" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Wiąże się ze zdumiewającymi i niewyjaśnionymi mocami lub zdarzeniami, które przeczą prawom fizyki." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Tragedia" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Zawiera zdarzenia powodujące wielkie straty i nieszczęścia." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Dzieło to obejmuje zazwyczaj intymne relacje między mężczyznami." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Dzieło to obejmuje zazwyczaj intymne relacje między kobietami." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Lista gatunków oddzielone przecinkami" + +#: tmainform.eddownloadssearch.texthint +#| msgid "Search favorites..." +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Wyszukiwanie plików do pobrania ..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Wyszukiwanie ulubionych ..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Wykonawca" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Autor" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Filtr" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Część streszczenia" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Tytuł" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Szukaj tytułu ..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" +msgid "Custom rename" +msgstr "Zmień nazwę" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Domyślna ścieżka pobierania" + +#: tmainform.edoptionexternalparams.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalparams.texthint" +msgid "External program parameters" +msgstr "Parametry programu zewnętrznego " + +#: tmainform.edoptionexternalpath.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalpath.texthint" +msgid "External program path" +msgstr "ścieżka programu zewnętrznego" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Zmień nazwę" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Proxy host/IP" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Zmień nazwę" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "hasło proxy" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "nazwa użytkownika Proxy" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Zapisz w" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Adres URL" + +#: tmainform.edwebsitessearch.texthint +#| msgid "Search..." +msgctxt "tmainform.edwebsitessearch.texthint" +msgid "Search website..." +msgstr "Szukaj www ..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Pokaż potwierdzenie dialogowe" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Pole rozwijane" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Program zewnętrzny" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Ulubione" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Konfiguracja Proxy" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Zmiana nazwy …" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Wybierz domyślną ścieżkę pobierania:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Przezroczystość" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Artysta" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Autor" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Niestandardowe Gatunki" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Gatunki: \n" +"- zaznaczone. Włączenie tego gatunku \n" +"- Niezaznaczony: Wyłącz ten gatunek \n" +"- nieaktywny. Nieważne \n" +" \n" +" NiestandardoweGatunki:. \n" +"- oddziel wiele gatunków poprzez ',' \n" +"Wyklucz gatunek poprzez '!' lub "-" na początku gatunek \n" +"- Przykład:.!. Przygoda, Ecchi, Komedia \n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Status" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Streszczenie" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Tytuł" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Plik logów:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Tryb: Pokaż wszystko (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" +msgid "Auto check for new chapter every %d minutes" +msgstr "Automatyczna sprawdzenie nowego rozdziału raz na %d minut" + +#: tmainform.lboptionchaptercustomrename.caption +#| msgid "Chapter folder name:" +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Nazwa Rozdziału:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Nazwa strony \n" +"%MANGA% : Tytuł mangi \n" +"%CHAPTER% : Tytuł rozdziału\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artysta\n" +"%NUMBERING% : Numeracja\n" +"\n" +"Notka:\n" +"Nazwa folderu z rozdziałami musi mieć co najmniej %CHAPTER% lub %NUMBERING%.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Limit czasu połączenia (sekundy)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Otwórz mangę za pomocą zewnętrznego programu:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Parametry:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "tmainform.lboptionexternalparamshint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Nazwa pliku:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Nazwa strony\n" +"%MANGA% : Tytuł mangi\n" +"%CHAPTER% : Tytuł rozdziału\n" +"%FILENAME% : Nazwa pliku\n" +"\n" +"Notka:\n" +"Nazwa pliku musi mieć co najmniej %FILENAME%\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Host" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Język:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "Po ukończeniu pobierania:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Nazwa folderu z Mangą:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Nazwa strony\n" +"%MANGA% : Tytuł mangi\n" +"%AUTHOR% : Autor\n" +"%ARTIST% : Artysta\n" +"\n" +"Notka:\n" +"Nazwa folderu z mangą musi mieć przynajmniej %MANGA%.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Ilość pobierań w tym samym czasie" + +#: tmainform.lboptionmaxretry.caption +#| msgid "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Ilość prób pobierania po nieudanym pobraniu (-1 = zawsze próbuj)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Liczba pobieranych plików na zadanie w tym samym czasie" + +# WTF does that mean? +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "New manga based on it's update time (days)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Hasło" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "Poziom kompresji PDF" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (bezstratny), niżej = DCTEncode (stratny)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Port" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Typ" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Zmiana nazwy cyfry" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Nazwa użytkownika" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Zapisz do:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Usuń" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Kopia" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Wytnij" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Wklej" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Wklej i przejdź" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Zaznacz wszystko" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Cofnij" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Anuluj" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Zaznacz wszystkie" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Zaznacz wybrane" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Filtr" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Ukryj pobrane rozdziały" + +#: tmainform.michapterlisthighlight.caption +#| msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" +msgstr "Podświetl pobrane rozdziały" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Odznacz wszystkie" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Odznacz wybrane" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Usuń" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Usuń wszystkie zadania wykonane" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Tylko zadania" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Zadania + Data" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Zadania + Data + Ulubione" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Wyłącz" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Włącz" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Scal wykonane zadania" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Otwórz folder" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Otwórz ..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Wznów" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Stop" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Zobacz informacje o mandze" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Zmień \"obecny rozdział\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Zmień \"Zapisz do\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Sprawdź czy są nowe rozdziały" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Usuń" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Wyłącz" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Pobierz wszystko" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Włącz" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Otwórz folder" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Otwórz... " + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Zatrzymaj sprawdzanie nowych rozdziałów" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Zobacz informacje o mandze" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Podświetl nową mangę" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Dodaj do ulubionych" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Usuń" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Pobierz wszystko" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Zobacz informacje o mandze" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "Po pobieraniu zakończ" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Wyjdź" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Wyjdź" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernacja" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Nic" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Wyłacz komputer" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Przywróć" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Wznów wszystkie" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "Pokaż menu rozwijane" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Zatrzymaj wszystko" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Pobierz wszystkie listy z serwera na raz" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Zaznacz wszystko" + +# I dont understand that either... +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Indeterminate all" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Odznacz wszystko" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Aktualizacja wszystkich list na raz" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Pobierz listę manga z serwera " + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Aktualizacja listy manga" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Miej wszystkie gatunki zaznaczone" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Miej jeden gatunek zaznaczony " + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Tryb" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Zapisz pobrane rozdziały jako " + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (bezstratne), niżej = DCTEncode (stratne)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Usuń wszystkie wykonane zadania " + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Wznów wszystkie" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Zatrzymaj wszystkie" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Zwiń wszystkie" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Rozwiń wszystkie" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "O programie" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "O FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Konta" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Lista zmian" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Połaczenia" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Kolor niestandardowe" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Okna dialogowe" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "Pobrane" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Ulubione" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Główne" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filtr" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Informacje o mandze" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Log" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Różne" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Opcje" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Zapisz do" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Aktualizacje" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Wygląd" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Zaawansowane" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Opcje" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Strony internetowe" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" +msgid "Websites" +msgstr "Strony internetowe" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Manga" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Status" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Postęp" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Prędkość transferu" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Strona WWW" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Zapisz do" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Dodano" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Tytuł" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Obecny rozdział" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Strona WWW" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Zapisz do" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "&Anuluj" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&Pobieranie" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&Dodaj do kolejki" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&O" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Teraz" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Anuluj" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Niepoprawnie" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Tytuł" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Strona WWW" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&później" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Aktualizacja" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"Nowa wersja znaleziona! Czy chcesz zaktualizować teraz? \n" +"FMD zostanie zamknięty, aby zakończyć aktualizację. \n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Dodaj" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Edytuj" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Usuń" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Pliki cookie" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "numer strony katalogu" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "Pobrane" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Max wątków na zadania" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Liczba wątków" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Aktualizuj Listę" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Strona WWW" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Pliki cookie" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Strona WWW" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Wartość" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Strona WWW" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Wartość" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Strona WWW" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Wartość" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Strona WWW" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Wybierz stronę internetową" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Kompresja danych..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Wyłączone" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Pobieranie" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Niepowodzenie" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Nie udało się utworzyć folderu" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Nie powiodło się, spróbuj wznowić zadanie!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Ukończono" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Przygotowanie" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Zatrzymano" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Oczekiwanie..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&Dodaj do kolejki" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "&Anuluj" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Sprawdź nowy rozdział" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&Pobrane" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Usuń" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "Znaleziono %d zakończonych mang" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Sprawdzanie ulubionych jest uruchomione!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d mang ma nowe rozdziały" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> ma %d nowych rozdziałów." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Zakończone mangi zostaną usunięte:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Znaleziono %d nowych rozdziałów w %d mang:" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Ładownanie: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Sprawdź czy jest nowa wersja" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Zainstalowana wersja" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Najnowsza wersja" + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Znaleziono nową wersje" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s ma %d nowych mang" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Zdobądź folder" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Zdobądź informacje" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Zdobądź listę dla" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Indeksowanie nowych tytułów" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Szukanie nowych tytułów" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Szukanie nowych tytułów w innych folderach" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Przygotowywanie" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Usuwanie duplikatów z aktualnych danych" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Usuwanie duplikatów z lokalnych danych" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Usuwanie duplikatów z nowych tytułów" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Zapisywanie danych" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Synchronizacja danych" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Aktualizacja listy" + diff --git a/mangadownloader/languages/fmd.po b/mangadownloader/languages/fmd.po index c5189ee99..6ee1f747b 100644 --- a/mangadownloader/languages/fmd.po +++ b/mangadownloader/languages/fmd.po @@ -1,6 +1,92 @@ msgid "" msgstr "Content-Type: text/plain; charset=UTF-8" +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "" + #: frmimportfavorites.rs_importcompleted msgid "Import completed." msgstr "" @@ -9,6 +95,75 @@ msgstr "" msgid "List of unimported manga" msgstr "" +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "" + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "" + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "" + #: frmmain.rs_alldownloads msgid "All downloads" msgstr "" @@ -24,6 +179,7 @@ msgid "Cancel" msgstr "" #: frmmain.rs_checking +msgctxt "frmmain.rs_checking" msgid "Checking..." msgstr "" @@ -35,6 +191,10 @@ msgstr "" msgid "Cannot get manga info. Please check your internet connection and try it again." msgstr "" +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "" + #: frmmain.rs_dlgmangalistselect msgid "You must choose at least 1 manga website!" msgstr "" @@ -51,10 +211,19 @@ msgstr "" msgid "Are you sure you want to delete all finished tasks?" msgstr "" +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "" + #: frmmain.rs_dlgremovetask msgid "Are you sure you want to delete the task(s)?" msgstr "" +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "" + #: frmmain.rs_dlgtitleexistindllist msgid "" "This title are already in download list.\n" @@ -94,6 +263,10 @@ msgid "" "\n" msgstr "" +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "" + #: frmmain.rs_hintfavoriteproblem msgid "" "There is a problem with this data!\n" @@ -133,6 +306,7 @@ msgid "Title:" msgstr "" #: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" msgid "Website:" msgstr "" @@ -165,6 +339,11 @@ msgstr "" msgid "Mode: Filtered (%d)" msgstr "" +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "" + #: frmmain.rs_onemonth msgid "One month" msgstr "" @@ -173,10 +352,19 @@ msgstr "" msgid "One week" msgstr "" +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" + #: frmmain.rs_optionfmddoitems msgid "" -"Do nothing\n" -"Exit FMD\n" +"Nothing\n" +"Exit\n" "Shutdown\n" "Hibernate\n" msgstr "" @@ -198,6 +386,25 @@ msgstr "" msgid "Today" msgstr "" +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "" + #: frmmain.rs_yesterday msgid "Yesterday" msgstr "" @@ -214,10 +421,209 @@ msgstr "" msgid "System will shutdown in %d second." msgstr "" +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[1].TEXT" +msgid "Website" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[2].TEXT" +msgid "Username" +msgstr "" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[3].TEXT" +msgid "Status" +msgstr "" + +#: taccountsetform.btcancel.caption +msgctxt "TACCOUNTSETFORM.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "" + +#: taccountsetform.caption +msgid "Account" +msgstr "" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "" + +#: taccountsetform.edpassword.texthint +msgctxt "TACCOUNTSETFORM.EDPASSWORD.TEXTHINT" +msgid "Password" +msgstr "" + +#: taccountsetform.edusername.texthint +msgctxt "TACCOUNTSETFORM.EDUSERNAME.TEXTHINT" +msgid "Username" +msgstr "" + +#: taccountsetform.label2.caption +msgctxt "TACCOUNTSETFORM.LABEL2.CAPTION" +msgid "Username" +msgstr "" + +#: taccountsetform.label3.caption +msgctxt "TACCOUNTSETFORM.LABEL3.CAPTION" +msgid "Password" +msgstr "" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "TFORMDROPTARGET.MIADDTOFAVORITES.CAPTION" +msgid "Add to favorites" +msgstr "" + #: tformdroptarget.miclose.caption msgid "&Close" msgstr "" +#: tformdroptarget.midownloadall.caption +msgctxt "TFORMDROPTARGET.MIDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "" + #: timportfavorites.btcancel.caption msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" msgid "Cancel" @@ -228,16 +634,12 @@ msgctxt "timportfavorites.btimport.caption" msgid "&OK" msgstr "" -#: timportfavorites.caption -msgid "Import list ..." -msgstr "" - #: timportfavorites.cbsoftware.text msgid "Domdomsoft Manga Downloader" msgstr "" -#: timportfavorites.edpath.text -msgctxt "TIMPORTFAVORITES.EDPATH.TEXT" +#: timportfavorites.edpath.texthint +msgctxt "TIMPORTFAVORITES.EDPATH.TEXTHINT" msgid "Path to the software (e.g. C:\\MangaDownloader)" msgstr "" @@ -245,17 +647,47 @@ msgstr "" msgid "Software:" msgstr "" +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "" + #: tmainform.btabortupdatelist.hint msgid "Abort update list" msgstr "" #: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" msgid "Add to favorites" msgstr "" -#: tmainform.btcheckversion.caption -msgctxt "tmainform.btcheckversion.caption" -msgid "Check for new version" +#: tmainform.btchecklatestversion.caption +msgctxt "TMAINFORM.BTCHECKLATESTVERSION.CAPTION" +msgid "Check for latest version" +msgstr "" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" msgstr "" #: tmainform.btdownload.caption @@ -263,6 +695,11 @@ msgctxt "tmainform.btdownload.caption" msgid "Download" msgstr "" +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "" + #: tmainform.btfavoriteschecknewchapter.caption msgctxt "tmainform.btfavoriteschecknewchapter.caption" msgid "Check for new chapter" @@ -281,6 +718,10 @@ msgstr "" msgid "Reset value" msgstr "" +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "" + #: tmainform.btoptionapply.caption msgid "Apply" msgstr "" @@ -309,7 +750,6 @@ msgid "Visit my blog" msgstr "" #: tmainform.caption -msgctxt "tmainform.caption" msgid "Free Manga Downloader" msgstr "" @@ -325,24 +765,44 @@ msgstr "" msgid "Search only new manga" msgstr "" +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVDOWNLOAD.CAPTION" +msgid "Automatic download after finish checking" +msgstr "" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVREMOVECOMPLETEDMANGA.CAPTION" +msgid "Automatic remove completed manga from Favorites" +msgstr "" + #: tmainform.cboptionautocheckfavstartup.caption -msgid "Automatic check for new chapter at startup" +msgid "Auto check for new chapter at startup" msgstr "" -#: tmainform.cboptionautocheckupdate.caption -msgid "Check for new version " +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKLATESTVERSION.CAPTION" +msgid "Auto check for latest version " msgstr "" -#: tmainform.cboptionautodlfav.caption -msgid "Automatic download after finish checking" +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" msgstr "" -#: tmainform.cboptionautonumberchapter.caption -msgid "Auto number chapter" +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "TMAINFORM.CBOPTIONCHANGEUNICODECHARACTER.CAPTION" +msgid "Replace all unicode character with" msgstr "" -#: tmainform.cboptionautoremovecompletedmanga.caption -msgid "Automatic remove completed manga from Favorites" +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "" + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" msgstr "" #: tmainform.cboptiondigitchapter.caption @@ -357,11 +817,12 @@ msgstr "" msgid "Enable load manga cover" msgstr "" -#: tmainform.cboptiongeneratechaptername.caption -msgid "Generate chapter folder with chapter name" +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" msgstr "" -#: tmainform.cboptiongeneratemangafoldername.caption +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "TMAINFORM.CBOPTIONGENERATEMANGAFOLDER.CAPTION" msgid "Auto generate folder based on manga's name" msgstr "" @@ -369,8 +830,8 @@ msgstr "" msgid "Enable live search (slow on long list)" msgstr "" -#: tmainform.cboptionmangafoxremovewatermarks.caption -msgid "[Mangafox] Remove watermarks (Beware! Experimental!)" +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" msgstr "" #: tmainform.cboptionminimizetotray.caption @@ -381,30 +842,38 @@ msgstr "" msgid "Permit only one FMD running" msgstr "" -#: tmainform.cboptionpathconvert.caption -msgid "Change all all unicode symbols to \"_\" (choose this when you have problem with unicode path)" -msgstr "" - #: tmainform.cboptionproxytype.text msgid "HTTP" msgstr "" -#: tmainform.cboptionshowalllang.caption -msgid "[Batoto] Show All Language" +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" msgstr "" -#: tmainform.cboptionshowbatotosg.caption -msgid "[Batoto] Show scan group name" +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" msgstr "" #: tmainform.cboptionshowdeletetaskdialog.caption msgid "Delete task/favorite" msgstr "" +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "" + #: tmainform.cboptionshowdownloadtoolbar.caption msgid "Show downloads toolbar" msgstr "" +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "" + #: tmainform.cboptionshowquitdialog.caption msgid "Exit FMD" msgstr "" @@ -421,6 +890,11 @@ msgstr "" msgid "Use proxy" msgstr "" +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "" + #: tmainform.cbsearchfromallsites.caption msgid "Search in all manga sites" msgstr "" @@ -433,10 +907,20 @@ msgstr "" msgid "Regular Expression" msgstr "" +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "" + #: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" msgid "Show Drop Box" msgstr "" +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "" + #: tmainform.ckfilteraction.caption msgid "Action" msgstr "" @@ -751,10 +1235,29 @@ msgstr "" msgid "This work usually involves intimate relationships between women." msgstr "" +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "" + #: tmainform.edcustomgenres.texthint msgid "Input custom genres, separated by comma" msgstr "" +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "" + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "" + #: tmainform.edfilterartists.texthint msgctxt "tmainform.edfilterartists.texthint" msgid "Artist" @@ -765,6 +1268,11 @@ msgctxt "tmainform.edfilterauthors.texthint" msgid "Author" msgstr "" +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "TMAINFORM.EDFILTERMANGAINFOCHAPTERS.TEXTHINT" +msgid "Filter" +msgstr "" + #: tmainform.edfiltersummary.texthint msgid "Part of summary" msgstr "" @@ -774,7 +1282,13 @@ msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" msgid "Title" msgstr "" -#: tmainform.edoptioncustomrename.texthint +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "" + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONCHAPTERCUSTOMRENAME.TEXTHINT" msgid "Custom rename" msgstr "" @@ -792,16 +1306,22 @@ msgctxt "TMAINFORM.EDOPTIONEXTERNALPATH.TEXTHINT" msgid "External program path" msgstr "" +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONFILENAMECUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "" + #: tmainform.edoptionhost.texthint msgid "Proxy host/IP" msgstr "" -#: tmainform.edoptionpass.texthint -msgid "Proxy password" +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONMANGACUSTOMRENAME.TEXTHINT" +msgid "Custom rename" msgstr "" -#: tmainform.edoptionport.texthint -msgid "Proxy Port" +#: tmainform.edoptionpass.texthint +msgid "Proxy password" msgstr "" #: tmainform.edoptionuser.texthint @@ -813,11 +1333,6 @@ msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" msgid "Save to" msgstr "" -#: tmainform.edsearch.texthint -msgctxt "tmainform.edsearch.texthint" -msgid "Search title..." -msgstr "" - #: tmainform.edurl.texthint msgid "Input URL here" msgstr "" @@ -827,10 +1342,18 @@ msgctxt "TMAINFORM.EDWEBSITESSEARCH.TEXTHINT" msgid "Search website..." msgstr "" +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "" + #: tmainform.gbdroptarget.caption msgid "Drop Box" msgstr "" +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "" + #: tmainform.gboptionexternal.caption msgid "External program" msgstr "" @@ -884,7 +1407,7 @@ msgid "" "\n" "Custom Genres:\n" "- Separate multiple genres with ','.\n" -"- Exclude a genre by placing ''!'' at the beginning of a genre.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" "- Example: Adventure,!Ecchi,Comedy.\n" msgstr "" @@ -902,29 +1425,35 @@ msgctxt "tmainform.lbfiltertitle.caption" msgid "Title" msgstr "" -#: tmainform.lbmode.caption -msgid "Mode: Show all manga" +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" msgstr "" -#: tmainform.lboptionautocheckminutes.caption -msgctxt "tmainform.lboptionautocheckminutes.caption" -msgid "Auto check for new chapter every %d minutes" +#: tmainform.lblogfilename.caption +msgid "Log file:" msgstr "" -#: tmainform.lboptionconnectiontimeout.caption -msgid "Connection timeout (seconds)" +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "TMAINFORM.LBOPTIONAUTOCHECKFAVINTERVALMINUTES.CAPTION" +msgid "Auto check for new chapter every %d minutes" msgstr "" -#: tmainform.lboptioncustomrename.caption -msgid "Chapter folder name:" +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAME.CAPTION" +msgid "Chapter name:" msgstr "" -#: tmainform.lboptioncustomrenamehint.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT.CAPTION" +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.CAPTION" msgid "[?]" msgstr "" -#: tmainform.lboptioncustomrenamehint.hint +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.HINT" msgid "" "%WEBSITE% : Website name\n" "%MANGA% : Manga title\n" @@ -937,17 +1466,8 @@ msgid "" "Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" msgstr "" -#: tmainform.lboptioncustomrenamehint1.caption -msgctxt "TMAINFORM.LBOPTIONCUSTOMRENAMEHINT1.CAPTION" -msgid "[?]" -msgstr "" - -#: tmainform.lboptioncustomrenamehint1.hint -msgid "100: FlateEncode (lossless), lower: DCTEncode (lossy)" -msgstr "" - -#: tmainform.lboptiondialogs.caption -msgid "Show dialog confirmation for:" +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" msgstr "" #: tmainform.lboptionexternal.caption @@ -963,6 +1483,26 @@ msgctxt "TMAINFORM.LBOPTIONEXTERNALPARAMSHINT.CAPTION" msgid "[?]" msgstr "" +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONFILENAMECUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" + #: tmainform.lboptionhost.caption msgid "Host" msgstr "" @@ -975,16 +1515,37 @@ msgstr "" msgid "After download finish:" msgstr "" +#: tmainform.lboptionmangacustomrename.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAME.CAPTION" +msgid "Manga folder name:" +msgstr "" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" + #: tmainform.lboptionmaxparallel.caption -msgid "Number of downloaded tasks at the same time (Max: 8)" +msgid "Number of downloaded tasks at the same time" msgstr "" #: tmainform.lboptionmaxretry.caption -msgid "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" msgstr "" #: tmainform.lboptionmaxthread.caption -msgid "Number of downloaded files per task at the same time (Max: 32)" +msgid "Number of downloaded files per task at the same time" msgstr "" #: tmainform.lboptionnewmangatime.caption @@ -992,6 +1553,7 @@ msgid "New manga based on it's update time (days)" msgstr "" #: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" msgid "Password" msgstr "" @@ -1004,6 +1566,11 @@ msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" msgstr "" +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "TMAINFORM.LBOPTIONPDFQUALITYHINT.CAPTION" +msgid "[?]" +msgstr "" + #: tmainform.lboptionport.caption msgid "Port" msgstr "" @@ -1016,20 +1583,35 @@ msgstr "" msgid "Rename digits" msgstr "" +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "" + #: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" msgid "Username" msgstr "" +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "" + #: tmainform.lbsaveto.caption msgid "Save to:" msgstr "" +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "" + #: tmainform.medturldelete.caption msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" msgid "Delete" msgstr "" #: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" msgid "Copy" msgstr "" @@ -1053,7 +1635,17 @@ msgstr "" msgid "Undo" msgstr "" +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "" + #: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" msgid "Check all" msgstr "" @@ -1061,11 +1653,25 @@ msgstr "" msgid "Check selected" msgstr "" +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "" + +#: tmainform.michapterlistfilter.caption +msgctxt "TMAINFORM.MICHAPTERLISTFILTER.CAPTION" +msgid "Filter" +msgstr "" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "" + #: tmainform.michapterlisthighlight.caption -msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" msgstr "" #: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" msgid "Uncheck all" msgstr "" @@ -1091,6 +1697,20 @@ msgstr "" msgid "Task + Data" msgstr "" +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "" + #: tmainform.midownloadmergecompleted.caption msgid "Merge completed tasks" msgstr "" @@ -1136,11 +1756,21 @@ msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" msgid "Delete" msgstr "" +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "" + #: tmainform.mifavoritesdownloadall.caption msgctxt "tmainform.mifavoritesdownloadall.caption" msgid "Download all" msgstr "" +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "" + #: tmainform.mifavoritesopenfolder.caption msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" msgid "Open Folder" @@ -1151,10 +1781,19 @@ msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" msgid "Open ..." msgstr "" +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "" + #: tmainform.mifavoritesstopchecknewchapter.caption msgid "Stop check for new chapter" msgstr "" +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "" + #: tmainform.mifavoritesviewinfos.caption msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" msgid "View manga info" @@ -1168,6 +1807,11 @@ msgstr "" msgid "Add to Favorites" msgstr "" +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "" + #: tmainform.mimangalistdownloadall.caption msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" msgid "Download all" @@ -1177,10 +1821,67 @@ msgstr "" msgid "View manga infos" msgstr "" +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "" + +#: tmainform.mitrayexit.caption +msgctxt "TMAINFORM.MITRAYEXIT.CAPTION" +msgid "Exit" +msgstr "" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "TMAINFORM.MITRAYSHOWDROPBOX.CAPTION" +msgid "Show Drop Box" +msgstr "" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "" + #: tmainform.mndownload1click.caption msgid "Download all lists from server at once" msgstr "" +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLCHECK.CAPTION" +msgid "Check all" +msgstr "" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLUNCHECK.CAPTION" +msgid "Uncheck all" +msgstr "" + #: tmainform.mnupdate1click.caption msgid "Update all lists at once" msgstr "" @@ -1228,6 +1929,22 @@ msgstr "" msgid "Stop All" msgstr "" +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "" + #: tmainform.tbwebsitescollapseall.caption msgid "Collapse All" msgstr "" @@ -1240,42 +1957,59 @@ msgstr "" msgid "About" msgstr "" +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "" + #: tmainform.tsconnections.caption msgid "Connections" msgstr "" +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "" + #: tmainform.tsdialogs.caption msgid "Dialogs" msgstr "" #: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" msgid "Downloads" msgstr "" -#: tmainform.tsdownloadfilter.caption -msgid ">>" -msgstr "" - #: tmainform.tsfavorites.caption msgctxt "tmainform.tsfavorites.caption" msgid "Favorites" msgstr "" -#: tmainform.tsfilter.caption -msgctxt "tmainform.tsfilter.caption" +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" msgid "Filter" msgstr "" -#: tmainform.tsgeneral.caption -msgid "General" +#: tmainform.tsinfomanga.caption +msgid "Info" msgstr "" #: tmainform.tsinformation.caption msgid "Manga Info" msgstr "" -#: tmainform.tsmangalist.caption -msgid "Manga List" +#: tmainform.tslog.caption +msgid "Log" msgstr "" #: tmainform.tsmisc.caption @@ -1283,6 +2017,7 @@ msgid "Misc" msgstr "" #: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" msgid "Options" msgstr "" @@ -1299,7 +2034,26 @@ msgstr "" msgid "View" msgstr "" +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "" + +#: tmainform.tswebsiteoptions.caption +msgctxt "TMAINFORM.TSWEBSITEOPTIONS.CAPTION" +msgid "Options" +msgstr "" + #: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "" + +#: tmainform.tswebsiteselection.caption +msgctxt "TMAINFORM.TSWEBSITESELECTION.CAPTION" msgid "Websites" msgstr "" @@ -1374,8 +2128,13 @@ msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" msgid "&Add to queue" msgstr "" -#: tnewchapter.caption -msgid "New Chapter Notification" +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "" + +#: tselectdirectoryform.caption +msgid "Select directory" msgstr "" #: tshutdowncounterform.btabort.caption @@ -1386,9 +2145,52 @@ msgstr "" msgid "&Now" msgstr "" -#: tshutdowncounterform.caption -msgctxt "TSHUTDOWNCOUNTERFORM.CAPTION" -msgid "Free Manga Downloader" +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" msgstr "" #: tupdatedialogform.btnlater.caption @@ -1399,30 +2201,143 @@ msgstr "" msgid "&Update" msgstr "" -#: tupdatedialogform.caption -msgid "New Version Found" -msgstr "" - #: tupdatedialogform.lbmessage.caption msgid "" "New version found! Do you want to update now?\n" "FMD will be closed to finish the update.\n" msgstr "" +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM1.CAPTION" +msgid "Add" +msgstr "" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM2.CAPTION" +msgid "Edit" +msgstr "" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM4.CAPTION" +msgid "Delete" +msgstr "" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.TSDOWNLOADS.CAPTION" +msgid "Downloads" +msgstr "" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[1].TEXT" +msgid "Cookies" +msgstr "" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTDOWNLOADMAXTHREADSPERTASK.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[1].TEXT" +msgid "User Agent" +msgstr "" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "" + #: udownloadsmanager.rs_compressing msgid "Compressing..." msgstr "" +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "" + #: udownloadsmanager.rs_downloading msgid "Downloading" msgstr "" #: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" msgid "Failed" msgstr "" -#: udownloadsmanager.rs_failedtocreatedirtoolong -msgid "Failed to create dir! Too long?" +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" msgstr "" #: udownloadsmanager.rs_failedtryresumetask diff --git a/mangadownloader/languages/fmd.pt_BR.po b/mangadownloader/languages/fmd.pt_BR.po new file mode 100644 index 000000000..3b66ea692 --- /dev/null +++ b/mangadownloader/languages/fmd.pt_BR.po @@ -0,0 +1,2497 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=utf-8\n" +"Last-Translator: Havokdan \n" +"Language-Team: Havokdan \n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abortar" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "Baixando %s" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "Extraindo %s" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: falhou ao extrair, exitstatus = %d" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "Falha ao terminar:\n\n%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Falhou" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: falhou ao salvar" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: Faltando %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Baixar imagem original (exige uma conta ExHentai)" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "Tam. da imagem:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "Auto\n780x\n980x\n1280x\n1600x\n2400x\nOriginal\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Você está certo que quer apagar esta conta?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Checando" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Inválido" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Desconhecido" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Nome de usuário ou a senha não podem estar vazios!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Importação concluída." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Lista de mangás não importados" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Checando..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Checar por atualização" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Terminar de checar" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "Terminar donwload" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "Módulos atualizados, reiniciar agora?\n\n%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "Módulos atualizados!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "Atualização de módulos encontrada, todas as mudanças locais serão perdidas, continuar?\n\n%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "Atualização de módulos encontrada!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "Baixando..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "%s EXCLUIR*" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "%s FALHOU*" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "%s NOVO*" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "%s BAIXAR_NOVAMENTE*" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "%s ATUALIZAR*" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Todos os downloads" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&OK" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Cancelar" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Checando..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Não é possível conectar ao servidor." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Não foi possível obter informações do mangá. Verifique a sua conexão com a Internet e tente novamente." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Número de downloads:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "Você deve escolher ao menos um site de mangá!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Você está certo que quer sair?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Você está certo que quer apagar o favorito(s)?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Você está certo que quer apagar todas as tarefas terminadas?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Você está certo que quer apagar este(s) item(ns)?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Você está certo que quer apagar a(s) tarefa(s)?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Dividir download" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "Este título já está na lista de download.\nVocê quer baixá-lo mesmo assim?\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Digite um novo capítulo:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Digite um novo caminho para salvamento:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Atualizador em execução!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Você quer baixar lista de mangás do servidor?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "URL não suportada!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "Baixar tudo\nAdicionar aos favoritos\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "Completo\nEm Andamento\n\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader já está em execução!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "Há um problema com estes dados!\nRemovendo e re-adicionando estes dados pode corrigir o problema.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "Histórico" + +#: frmmain.rs_import +msgid "Import" +msgstr "Importar" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Artista(s):" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Autor(es):" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Gênero(s):" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Status:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Resumo:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Título:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Website:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "Em progresso" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Auto checar por novos capítulos a cada %d minutos" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "%s : Caminho para o mangá\n%s : Nome do capítulo\n\nExamplo : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Carregando ..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Modo: Exibir Tudo (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Modo: Filtrado (%d)" + +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Modo: Buscando..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Um mês" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Uma semana" + +#: frmmain.rs_optioncompress +#, fuzzy +#| msgid "" +#| "None\n" +#| "ZIP\n" +#| "CBZ\n" +#| "PDF\n" +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "Nenhum\nZIP\nCBZ\nPDF\nEPUB\n" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "Nada\nSair\nDesligar\nHibernar\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Selecionado: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Software" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Caminho para o software (e.g. C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Hoje" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "WebP\nPNG\nJPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "Nenhum\nO mais rápido\nPadrão\nMáximo" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Entrada inválida!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Ontem" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "FMD irá sair em %d segundos." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "Sistema irá hibernar em %d segundos." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "Sistema irá desligar em %d segundos." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "Todos" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Inválido" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Válido" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Vetor de Inicialização:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Chave:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Usar Google DCP" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Exibir todos os idiomas" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Exibir grupo de scans" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Remover a marca d'água" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Salvar como PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Abortar" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "Baixar nova versão %s" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "Falha ao baixar a nova versão %s\n\n%d %s\n" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "Falha ao extrair %s, exitstatus = %d" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Falhou" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "Falha ao salvar %s" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "Download do pacote de atualização finalizado, reiniciar para prosseguir?" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "Download concluído" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "Faltando %s" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Editar" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Atualizar" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "AccountManagerForm" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[1].TEXT" +msgid "Website" +msgstr "Website" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[2].TEXT" +msgid "Username" +msgstr "Nome de usuário" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[3].TEXT" +msgid "Status" +msgstr "Status" + +#: taccountsetform.btcancel.caption +msgctxt "TACCOUNTSETFORM.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Cancelar" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Ok" + +#: taccountsetform.caption +msgid "Account" +msgstr "Conta" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Exibir senha" + +#: taccountsetform.edpassword.texthint +msgctxt "TACCOUNTSETFORM.EDPASSWORD.TEXTHINT" +msgid "Password" +msgstr "Senha" + +#: taccountsetform.edusername.texthint +msgctxt "TACCOUNTSETFORM.EDUSERNAME.TEXTHINT" +msgid "Username" +msgstr "Nome de usuário" + +#: taccountsetform.label2.caption +msgctxt "TACCOUNTSETFORM.LABEL2.CAPTION" +msgid "Username" +msgstr "Nome de usuário" + +#: taccountsetform.label3.caption +msgctxt "TACCOUNTSETFORM.LABEL3.CAPTION" +msgid "Password" +msgstr "Senha" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Lista básica" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Lista de capítulos" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Lista de favoritos" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Lista de mangás" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "TFORMDROPTARGET.MIADDTOFAVORITES.CAPTION" +msgid "Add to favorites" +msgstr "Adicionar aos favoritos" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&Fechar" + +#: tformdroptarget.midownloadall.caption +msgctxt "TFORMDROPTARGET.MIDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Baixar tudo" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Limpar" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Ficar no topo" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Limite do registro" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Copiar" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Cancelar" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&OK" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "TIMPORTFAVORITES.EDPATH.TEXTHINT" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Caminho para o software (e.g. C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Software:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Checar por atualização" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Reinício automático" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Mostrar aviso de atualização" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Nome do arquivo" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Última modificação" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Última mensagem" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Abortar atualizações das lista" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Adicionar aos favoritos" + +#: tmainform.btchecklatestversion.caption +msgctxt "TMAINFORM.BTCHECKLATESTVERSION.CAPTION" +msgid "Check for latest version" +msgstr "Checar pela última versão" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Limpar arquivo de registro" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Baixar" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Dividir download" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Checar por novos capítulos" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Importar lista" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Filtros" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Restaurar valor" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Abrir registro" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Aplicar" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Ler online" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Remover filtro" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Remover filtro" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Atualizar lista de mangá" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Visite meu blog" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Adicionar download de lista como uma tarefa parada" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Buscar somente novos mangás" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVDOWNLOAD.CAPTION" +msgid "Automatic download after finish checking" +msgstr "Download automático após terminar de checar" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Auto-checar por novos capítulos em um intervalo" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVREMOVECOMPLETEDMANGA.CAPTION" +msgid "Automatic remove completed manga from Favorites" +msgstr "Remover automaticamente mangás completados dos Favoritos" + +#: tmainform.cboptionautocheckfavstartup.caption +msgid "Auto check for new chapter at startup" +msgstr "Auto-checar por novos capítulos ao iniciar" + +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKLATESTVERSION.CAPTION" +msgid "Auto check for latest version " +msgstr "Auto-checar pela última versão " + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Abrir os Favoritos ao iniciar" + +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "TMAINFORM.CBOPTIONCHANGEUNICODECHARACTER.CAPTION" +msgid "Replace all unicode character with" +msgstr "Substituir todos caracteres unidcode com" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Habilite isto se você tem problemas com caminhos com caracteres unicode." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Excluir tarefas completas ao fechar" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Capítulo" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Volume" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Habilitar o carregamento da capa do mangá" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Auto-gerar pasta de capítulo" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "TMAINFORM.CBOPTIONGENERATEMANGAFOLDER.CAPTION" +msgid "Auto generate folder based on manga's name" +msgstr "Auto-gerar pasta com o nome do mangá" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Habilitar buscar em tempo real (lento em lista longas)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Minimizar ao iniciar" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Minimizar para bandeja" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Permitir somente um FMD em execução" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Remover nome do mangá do capítulo" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Exibir dicas em balões" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Apagar tarefa/favorito" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Baixar lista de mangá se vazia" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Exibir Barra de Ferramentas de Downloads" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Exibir \"Apagar todas tarefas concluídas\" na barra de ferramentas" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Mostrar barra de ferramentas de downloads à esquerda" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "Sair do FMD" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Não carregar infor dos mangás quando atualizar a lista (filtros pode não funcionar!)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Remover dados locais duplicados quando atualizando lista de mangás" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Usar proxy" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "Mais Rápido" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Buscar em todos sites de mangá" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Para mais sites de mangá, por favor vá em Opções->Sites de Mangá" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Expressão Regular" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Exibir Caixa de Seleção" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Habilitar registro" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Ação" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Um trabalho que descreve tipicamente a luta, a violência, o caos e o movimento rápido." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Adulto" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Contém conteúdo adequado somente para adultos. Títulos nesta categoria podem incluir cenas prolongadas de violência intensa e/ou conteúdo sexual gráfico e nudez." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Aventura" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Se um personagem da história vai em uma viagem ou ao longo dessa linha, a sua melhor aposta é que é um manga de aventura. Caso contrário, depende do seu preconceito pessoal neste caso." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Comédia" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Um trabalho dramático que é leve e muitas vezes humorístico ou satírico no tom e que geralmente contém uma resolução feliz do conflito temático." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Trabalho de fã baseado em um mangá/anime oficial." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Drama" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Um trabalho destinado a trazer uma resposta emocional, como incutir tristeza ou tensão." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Possivelmente a linha entre hentai e não-hentai, ecchi geralmente se refere a fanservice colocar em atrair um determinado grupo de fãs." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantasia" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Qualquer coisa que envolva, mas não limitado a, magia, mundo de sonho e contos de fadas." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Troca de Sexo" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "Meninas vestindo-se como caras, caras vestir-se como meninas.\nRapazes se transformando em garotas, garotas se transformando em caras.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harém" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "Uma série envolvendo um personagem masculino e muitas personagens femininas (normalmente atraídas pelo personagem masculino). Um Harem reverso é quando os sexos são invertidos." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Histórico" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Tem a ver com tempos antigos ou antigos." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Horror" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Uma dolorosa emoção de medo, temor e aborrecimento; Um estremecimento de terror e ódio; O sentimento inspirado por algo terrível e chocante." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Literalmente \"Mulher\". Alvos das mulheres 18-30. Feminino equivalente a seinen. Ao contrário shoujo o romance é mais realista e menos idealizado. A narrativa é mais explícita e madura." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Representando uma atração sexual para meninas jovens ou menores." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Artes Marciais" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "Como o nome sugere, nada de artes marciais relacionadas. Qualquer uma das várias artes de combate ou autodefesa, como aikido, karate, judo, ou taekwondo, kendo, esgrima, e assim por diante." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Maduro" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "Contém matérias que podem ser demasiado extremas para pessoas com menos de 17 anos. Os títulos desta categoria podem conter violência intensa, sangue e sangue, conteúdo sexual e/ou linguagem forte." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mecha" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Um trabalho que envolve e geralmente se concentra em todos os tipos de grandes máquinas robóticas." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Musical" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Mistério" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Normalmente um evento inexplicado ocorre, eo principal protagonista tenta descobrir o que causou isso." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psicológico" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Geralmente lida com a filosofia de um estado de espírito, na maioria dos casos detalhando psicologia anormal." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romance" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Qualquer história relacionada com o amor. Vamos definir o amor como entre homem e mulher, neste caso. Fora isso, cabe a sua própria imaginação do que é o amor." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Vida escolar" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Ter um cenário importante da história lidar com algum tipo de escola." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Ficção Científica" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Curto para a ficção científica, esses trabalhos envolvem voltas na tecnologia e outros fenômenos relacionados à ciência que são contrárias ou trechos do mundo científico moderno." + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "Do Google: Seinen significa \"jovem homem\". Manga e anime que visa especificamente jovens adultos do sexo masculino em torno das idades de 18 a 25 são títulos seinen. As histórias em seinen obras atraem estudantes universitários e aqueles no mundo do trabalho. Normalmente, as linhas de história lidar com as questões da idade adulta." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Representando uma atração sexual para jovens ou meninos menores de idade." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Um trabalho destinado e escrito principalmente para mulheres. Normalmente envolve muito romance e desenvolvimento de caráter forte." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "Muitas vezes sinônimo de yuri, isso pode ser pensado como um pouco menos extremo. \"Amor da menina\", por assim dizer." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Um trabalho destinado e escrito principalmente para homens. Esses trabalhos geralmente envolvem lutas e/ou violência." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "Muitas vezes sinónimo de yaoi, isto pode ser pensado como um pouco menos extrema. \"Boy\"s Love\", por assim dizer" + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Slice of Life" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "Como o nome sugere, este gênero representa tribulações cotidianas de um/muitos personagens. Estes desafios / eventos podem acontecer tecnicamente na vida real e são muitas vezes - se não o tempo todo - definidos na linha do tempo presente em um mundo que espelha o nosso." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Smut" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Trata de séries que são consideradas profanas ou ofensivas, particularmente no que diz respeito ao conteúdo sexual." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Esportes" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "Como o nome sugere, qualquer coisa relacionada com esportes. Basebol, basquete, hóquei, futebol, golfe e corrida apenas para citar alguns." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Sobrenatural" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Normalmente implica poderes surpreendentes e inexplicados ou eventos que desafiam as leis da física." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Tragédia" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Contém eventos resultando em grande perda e infortúnio." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Weebtoons" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Este trabalho geralmente envolve relações íntimas entre os homens." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Este trabalho geralmente envolve relações íntimas entre as mulheres." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "Sempre iniciar tarefa dos capítulos que falharam" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "Salvar PNG como JPEG" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Entrar gêneros personalizados, separados por vírgula" + +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Pesquisar downloads..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Pesquisar favoritos..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Artista" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Autor" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "TMAINFORM.EDFILTERMANGAINFOCHAPTERS.TEXTHINT" +msgid "Filter" +msgstr "Filtros" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Parte do resumo" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Título" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Pesquisar pelo título..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONCHAPTERCUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Renomear personalizado" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Caminho de download padrão" + +#: tmainform.edoptionexternalparams.texthint +msgctxt "TMAINFORM.EDOPTIONEXTERNALPARAMS.TEXTHINT" +msgid "External program parameters" +msgstr "Parâmetros externos do programa" + +#: tmainform.edoptionexternalpath.texthint +msgctxt "TMAINFORM.EDOPTIONEXTERNALPATH.TEXTHINT" +msgid "External program path" +msgstr "Caminho do programa externo" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONFILENAMECUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Renomear personalizado" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Proxy host/IP" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONMANGACUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Renomear personalizado" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Senha do proxy" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Nome de usuário Proxy" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Salvar em" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Introduza a URL aqui" + +#: tmainform.edwebsitessearch.texthint +msgctxt "TMAINFORM.EDWEBSITESSEARCH.TEXTHINT" +msgid "Search website..." +msgstr "Pesquisar no site ..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Mostrar diálogo de confirmação para" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Caixa de Seleção" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Conversão de imagem" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Programa externo" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Favoritos" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Config. do Proxy" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Renomeando" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Escolha o caminho de download padrão:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Opacidade" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Artista" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Autor" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Gêneros personalizados" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "Géneros:\n- Marcado: Inclua este gênero.\n- Desmarcado: exclua esse gênero.\n- Cinzento: Não importa.\n\nGéneros Personalizados:\n- Separar vários gêneros com ','.\n- Excluir um gênero colocando '!' Ou '-' no início de um gênero.\n- Exemplo: Aventura, Ecchi, Comédia.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Status" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Resumo" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Título" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "Qualidade JPEG" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Arquivo de registro:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Modo: Exibir Tudo (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "TMAINFORM.LBOPTIONAUTOCHECKFAVINTERVALMINUTES.CAPTION" +msgid "Auto check for new chapter every %d minutes" +msgstr "Auto checar por novos capítulos a cada %d minutos" + +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAME.CAPTION" +msgid "Chapter name:" +msgstr "Nome do capítulo:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.HINT" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "%WEBSITE% : Nome doWebsite\n%MANGA% : Título do Mangá\n%CHAPTER% : Título do capítulo\n%AUTHOR% : Autor\n%ARTIST% : Artista\n%NUMBERING% : Número\n\nNota:\nO nome da pasta do capítulo deve ter pelo menos %CHAPTER% ou %NUMBERING%.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Tempo de espera da conexão (segundos)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Abrir mangá usando um programa externo:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Parâmetros:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "TMAINFORM.LBOPTIONEXTERNALPARAMSHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Nome do arquivo:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONFILENAMECUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "%WEBSITE% : Nome do Website\n%MANGA% : Título do Mangá\n%CHAPTER% : Título do Capítulo\n%FILENAME% : Nome do arquivo\n\nNota:\nNome do arquivo deve ter pelo menos %FILENAME%\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Host" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Idioma:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "Depois do download terminar:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAME.CAPTION" +msgid "Manga folder name:" +msgstr "Nome da pasta do mangá:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "%WEBSITE% : Nome do Website\n%MANGA% : Título do Mangá\n%AUTHOR% : Autor\n%ARTIST% : Artista\n\nNota:\nNome da pasta Manga deve ter pelo menos %MANGA%.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Número de tarefas baixadas ao mesmo tempo" + +#: tmainform.lboptionmaxretry.caption +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Número de tentativas de repetição se as tarefas tiverem problemas de download (-1 = sempre tentar novamente)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Número de arquivos baixados por tarefa ao mesmo tempo" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Novo mangá baseado no seu tempo de atualização (dias)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Senha" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "Nível de compressão PDF" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (lossless), baixo = DCTEncode (lossy)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "TMAINFORM.LBOPTIONPDFQUALITYHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Porta" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Tipo" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Renomear dígitos" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Número de tentativas se a tarefa falhar" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Nome de usuário" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "Nível de compressão PNG" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Salvar em:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "Salvar WebP como" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Apagar" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Copiar" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Cortar" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Colar" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Colar e ir" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Selecionar tudo" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Desfazer" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Abortar" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Ascendente" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Marca tudo" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Marcar selecionado" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Descendente" + +#: tmainform.michapterlistfilter.caption +msgctxt "TMAINFORM.MICHAPTERLISTFILTER.CAPTION" +msgid "Filter" +msgstr "Filtros" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Ocultar capítulos baixados" + +#: tmainform.michapterlisthighlight.caption +msgid "Highlight downloaded chapters" +msgstr "Realçar capítulos baixados" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Desmarcar Tudo" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Desmarcar selecionado" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Apagar" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Apagar todas as tarefas concluídas" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Tarefa Somente" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Tarefa + Dados" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Tarefa + Dados + Favorito" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Desabilitar" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Habilitar" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Fundir tarefas completas" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Abrir Pasta" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Abrir ..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Resumir" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Parar" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Exibir info do mangá" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Alterar \"Capítulo atual\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Alterar \"Salvar em\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "TMAINFORM.MIFAVORITESCHECKNEWCHAPTER.CAPTION" +msgid "Check for new chapter" +msgstr "Checar por novos capítulos" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Apagar" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Desabilitar" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Baixar tudo" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Habilitar" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Abrir Pasta" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Abrir ..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Renomear" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Parar de checar por novos capítulos" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Transferir website" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Exibir info do mangá" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Realçar novo mangá" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Adicionar aos Favoritos" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Apagar" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Baixar tudo" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Exibir infos do mangá" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "Depois do download terminar" + +#: tmainform.mitrayexit.caption +msgctxt "TMAINFORM.MITRAYEXIT.CAPTION" +msgid "Exit" +msgstr "Sair" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Sair" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernar" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Nada" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Desligar" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Restaurar" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Resumir Todos" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "TMAINFORM.MITRAYSHOWDROPBOX.CAPTION" +msgid "Show Drop Box" +msgstr "Exibir Caixa de Seleção" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Parar Todos" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Faça o download de todas as listas do servidor de uma vez" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLCHECK.CAPTION" +msgid "Check all" +msgstr "Marca tudo" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Indeterminar tudo" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLUNCHECK.CAPTION" +msgid "Uncheck all" +msgstr "Desmarcar Tudo" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Atualizar todas as listas de uma só vez" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Faça o download da lista de mangás do servidor" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Atualizar lista de mangá" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Todos os gêneros marcados" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Um gênero marcado" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Modo" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Salvar os capítulos baixados como" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (lossless), baixo = DCTEncode (lossy)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Apagar todas as tarefas concluídas" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Resumir Tudo" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Parar Tudo" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Mover item(ns) selecionado(s) para o final" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Mover item(ns) selecionado(s) para baixo" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Mover item(ns) selecionado(s) para o topo" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Mover item(ns) selecionado(s) para cima" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Agrupar Tudo" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Expandir Tudo" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "Sobre" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "Sobre FMD" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Contas" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Changelog" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Conexões" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Cores personalizadas" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Diálogos" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr ">>" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Favoritos" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Geral" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filtros" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Info" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Info do Mangá" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Registro" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Misc" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Opções" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Salvar em" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Atualizações" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Exibir" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Avançado" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Módulos" + +#: tmainform.tswebsiteoptions.caption +msgctxt "TMAINFORM.TSWEBSITEOPTIONS.CAPTION" +msgid "Options" +msgstr "Opções" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Websites" + +#: tmainform.tswebsiteselection.caption +msgctxt "TMAINFORM.TSWEBSITESELECTION.CAPTION" +msgid "Websites" +msgstr "Websites" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Mangá" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Status" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Progresso" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Velocidade" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Website" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Salvar em" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Adicionado" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Título" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Capítulo atual" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Website" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Salvar em" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "&Cancelar" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&Baixar" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&Adic. à fila" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Selecionar Diretório" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&Abortar" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Agora" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Cancelar" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Transferir Favoritos" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "Limpar lista de capítulos baixados e recarregar do servidor" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Transferir para" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "Todos" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Inválido" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Válido" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Título" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Website" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&Depois" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Atualizar" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "Nova versão encontrada! Você quer atualizar agora?\nFMD irá fechar para terminar a atualização.\n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM1.CAPTION" +msgid "Add" +msgstr "Adic" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM2.CAPTION" +msgid "Edit" +msgstr "Editar" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM4.CAPTION" +msgid "Delete" +msgstr "Apagar" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Número de páginas do diretório" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.TSDOWNLOADS.CAPTION" +msgid "Downloads" +msgstr "Downloads" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Máx. de processos por tarefa" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Número de processos" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Atualizar Lista" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[1].TEXT" +msgid "Cookies" +msgstr "Cookies" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTDOWNLOADMAXTHREADSPERTASK.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Valor" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[1].TEXT" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Selecionar um website" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "WebsiteSettingsForm" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "Nome do site" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "Nome da configuração" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Compactando..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Desabilitado" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Baixando" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Falhou" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Falha ao criar diretório!" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Falha, tente continuar com esta tarefa!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Completo" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Preparando" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Parado" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Aguardando..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&Adic. à fila" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "&Cancelar" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Checar por novos capítulos" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&Baixar" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Remover" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "Encontrado %d mangá completado" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "A verificação de favoritos está em execução!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d mangá(s) tem novo(s) capítulo(s)" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> tem %d novo(s) capítulo(s)." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "O mangá completo será removido:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Encontrado %d novo(s) capítulo(s) para %d mangá(s):" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Carregando: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Verificar a nova versão" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Versão Instalada" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Última versão " + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Nova Versão encontrada!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s tem %d novo(s) mangá(s)" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Obtendo diretório" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Obtendo info" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Obtendo lista para" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Indexando novo(s) título(s)" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Procurando por novo(s) título(s)" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Procurando por novo(s) título(s) de outro diretório" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Preparando" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Removendo duplicados dos dados atuais" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Removendo duplicados dos dados locais" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Removendo duplicados dos novo(s) título(s)" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Salvando dados" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Sincronizando dados" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Atualizando a lista" diff --git a/mangadownloader/languages/fmd.ru_RU.po b/mangadownloader/languages/fmd.ru_RU.po new file mode 100644 index 000000000..7e30684f1 --- /dev/null +++ b/mangadownloader/languages/fmd.ru_RU.po @@ -0,0 +1,2580 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: 0.9.118.0\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: Tokc.D.K. \n" +"Language-Team: TokcDK\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: ru_RU\n" +"X-Generator: Poedit 2.0.2\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Отмена" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "Скачивание %s" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "Извлечение %s" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: ошибка при извлечении, exitstatus = %d" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" +"Не удалось завершить:\n" +"\n" +"%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Неудачно" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: ошибка при сохранении" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: отсутствует %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Загрузить оригинальное изображение(треб. аккаунт ExHentai)" + +#: ehentai.rs_settingsimagesize +msgid "Image size:" +msgstr "Размер изображения:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Авто\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Оригинал\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Хотите удалить этот аккаунт?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Проверка" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Неверный" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Неизвестный" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "OK" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Имя пользователя и пароль не могут быть пустыми!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "Импорт завершен." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "Список неимпортированной манги" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Проверка..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Проверить обновления" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Проверено" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "Скачано" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" +"Модули обновлены, перезапустить программу сейчас?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "Модули обновлены!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" +"Найдено обновление модулей, все локальные изменения модулей будут перезаписаны, продолжить?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "Найдено обновление модулей!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "Скачивание..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "%s УДАЛЕН*" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "%s ОШИБКА*" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "%s НОВЫЙ*" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "%s ПОВТОРНАЯ ЗАГРУЗКА*" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "%s ОБНОВЛЕН*" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Все загрузки" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&OK" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "Отмена" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Проверка..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Не удалось подключиться к серверу." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Не удалось получить информацию о манге. Проверьте интернет-подключение и попробуйте снова." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "Количество загрузок:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "Нужно выбрать минимум один сайт манги!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Хотите выйти?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Хотите удалить это избранное?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Хотите удалить все завершенные задачи?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Хотите удалить это?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Хотите удалить эти задачи?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Разделить загрузку" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Это название уже в списке загрузки.\n" +"Все равно хотите загрузить?\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Введите новую главу:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Введите новый путь сохранения:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Обновление запущено!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Хотите загрузить список манги с сервера?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "Ссылка не поддерживается!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Загрузить все\n" +"Добавить в избранное\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Завершено\n" +"Онгоинг\n" +"<нет>\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Бесплатный Manga Downloader уже запущен!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"Есть проблема с этими данными!\n" +"Удаление и повторное добавление этих данных могут решить проблему.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "История" + +#: frmmain.rs_import +msgid "Import" +msgstr "Импорт" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Артисты:" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Автор:" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Жанр:" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Статус:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Описание:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Название:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Сайт:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "В процессе" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Автоматическая проверка новой главы каждые %d минут" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Путь к манге\n" +"%s : Имя файла главы\n" +"\n" +"Пример : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Загрузка..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Режим: Показать все (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Режим: Отфильтрованные (%d)" + +#: frmmain.rs_modesearching +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Режим: Поиск..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "За месяц" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "За неделю" + +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" +"Как есть\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Ничего\n" +"Выход\n" +"Выключить\n" +"Сон\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Выбрано: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Программа" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Путь к программе (например, C:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Cегодня" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" +"WebP\n" +"PNG\n" +"JPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" +"Без компрессии\n" +"Скоростной\n" +"Средний\n" +"Максимальный\n" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Неверный ввод!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Вчера" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "Программа закроется через %d секунд." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "Система перейдет в спящий режим через %d секунд." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "Система выключится через %d секунд." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "Все" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Нельзя перенести" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Можно перенести" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Вектор инициализации:" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Ключ:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Использовать Google DCP" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Показать все языки" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Показать группу сканирования" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Удалить водяные знаки" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "Сохранить как PNG" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Отменить" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Неудачно" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Изменить" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Обновить" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "AccountManagerForm" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[1].TEXT" +msgid "Website" +msgstr "Сайт" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[2].TEXT" +msgid "Username" +msgstr "Имя пользователя" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +msgctxt "TACCOUNTMANAGERFORM.VTACCOUNTLIST.HEADER.COLUMNS[3].TEXT" +msgid "Status" +msgstr "Статус" + +#: taccountsetform.btcancel.caption +msgctxt "TACCOUNTSETFORM.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Отмена" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "OK" + +#: taccountsetform.caption +msgid "Account" +msgstr "Учетная запись" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Показать пароль" + +#: taccountsetform.edpassword.texthint +msgctxt "TACCOUNTSETFORM.EDPASSWORD.TEXTHINT" +msgid "Password" +msgstr "Пароль" + +#: taccountsetform.edusername.texthint +msgctxt "TACCOUNTSETFORM.EDUSERNAME.TEXTHINT" +msgid "Username" +msgstr "Имя пользователя" + +#: taccountsetform.label2.caption +msgctxt "TACCOUNTSETFORM.LABEL2.CAPTION" +msgid "Username" +msgstr "Имя пользователя" + +#: taccountsetform.label3.caption +msgctxt "TACCOUNTSETFORM.LABEL3.CAPTION" +msgid "Password" +msgstr "Пароль" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "CustomColorForm" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Основной список" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Список глав" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Список избранного" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Список манги" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "TFORMDROPTARGET.MIADDTOFAVORITES.CAPTION" +msgid "Add to favorites" +msgstr "Добавить в избранное" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "И Закрыть" + +#: tformdroptarget.midownloadall.caption +msgctxt "TFORMDROPTARGET.MIDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Загрузить все" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Очистить" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Пребывание на вершине" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Лимит лога" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Скопировать" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "Отмена" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&OK" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga Downloader" + +#: timportfavorites.edpath.texthint +msgctxt "TIMPORTFAVORITES.EDPATH.TEXTHINT" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Путь к программе (пример: C:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Программа:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Проверить обновления" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Автоматически перезапускать программу" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Показывать предупреждение" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Файл" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Изменен" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Описание изменения" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Прервать обновление списка" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Добавить в избранное" + +#: tmainform.btchecklatestversion.caption +msgctxt "TMAINFORM.BTCHECKLATESTVERSION.CAPTION" +msgid "Check for latest version" +msgstr "Проверка последней версии" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Очистить файл лога" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "Загрузить" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Разделить загрузку" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Проверить на новую глава" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Импорт списка" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Фильтр" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Сбросить том" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Открыть лог" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Принять" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Читать онлайн" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Удалить фильтр" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Удалить фильтр" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Обновить список манги" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Посетите мой блог" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "Добавить в список загрузки как остановленное задание" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "<нет>" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Искать только новую мангу" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVDOWNLOAD.CAPTION" +msgid "Automatic download after finish checking" +msgstr "Автоматическая загрузка после завершения проверки" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Автоматическая проверка новой главы в интервале" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKFAVREMOVECOMPLETEDMANGA.CAPTION" +msgid "Automatic remove completed manga from Favorites" +msgstr "Автоматически удалять завершенную мангу из Избранного" + +#: tmainform.cboptionautocheckfavstartup.caption +msgid "Auto check for new chapter at startup" +msgstr "Автоматическая проверка новой главы при запуске" + +#: tmainform.cboptionautochecklatestversion.caption +msgctxt "TMAINFORM.CBOPTIONAUTOCHECKLATESTVERSION.CAPTION" +msgid "Auto check for latest version " +msgstr "Автоматическая проверка последней версии " + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Открыть избранное при запуске" + +#: tmainform.cboptionchangeunicodecharacter.caption +msgctxt "TMAINFORM.CBOPTIONCHANGEUNICODECHARACTER.CAPTION" +msgid "Replace all unicode character with" +msgstr "Заменить все символы Юникода на" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Включите, если возникли проблемы с Unicode-символами в пути." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Удалить завершенные загрузки при выходе" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Глава" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Том" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Включить загрузку обложки манги" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Авто-создание папки главы" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "TMAINFORM.CBOPTIONGENERATEMANGAFOLDER.CAPTION" +msgid "Auto generate folder based on manga's name" +msgstr "Авто-создание папки на основе имени манги" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Включить живой поиск (медленно при длинном списке)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Минимизировать при запуске" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Свернуть в трей" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Разрешить только один экземпляр программы" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Удалить имя манги из главы" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Показывать подсказки" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Удаление задачи/избранного" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Загрузка списка манги, если он пустой" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "Показать панель загрузок" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "Показать \"Удалить все завершенные задачи\" в панели загрузки" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Показать дополнительную панель загрузок" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "Выход из программы" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Не загружать информацию о манге при обновлении списка (фильтр не будет работать!)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Удалять повторяющиеся локальные данные при обновлении списка манги" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Использовать прокси" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "Скоростной" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Поиск по всем сайтам манги" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Для получения дополнительных сайтов с мангой откройте Настройки->Сайты с мангой" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Регулярное выражение (regexp)" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "Показать Дропбокс" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Включить логирование" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Экшен" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Работы жанра обычно изображают бой, насилие, хаос и быстрое движение." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Взрослое" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Содержит контент, который подходит только для взрослых. Работы этой категории могут содержать длительные сцены интенсивного насилия и/или графический сексуальный контент и наготу." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Приключения" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Если персонаж в истории отправляется в путешествие или что-то в этом роде, тогда наверняка это приключенческая манга. В противном случае, это зависит от ваших личных предубеждений по этой теме." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Юмор" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Драматическая работа, легкая и часто юмористическая или сатирическая по тону и, обычно, содержит счастливое разрешение тематического конфликта." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Додзинси" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Фанатские работы, вдохновленные официальной мангой/аниме." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Драма" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Работы жанра призванны вызвать эмоциональный отклик, например, внушить печаль или напряжение." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Этти" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Возможно, середина между хентаем и не хентаем, этти обычно относится к фансервису, с целью привлечь определенную группу фанатов." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Фентези" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Все, что включает в себя, помимо прочего, магию, воображаемый мир и сказки." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Смена пола" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Девушки наряжаются как парни, парни наряжаются как девушки.\n" +"Парни превращаются в девушек, девушки превращаются в парней.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Гарем" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "В сериях учавствует один главный мужской персонаж и многих женских персонажей (как правило, испытывающих влечение к мужскому персонажу). Реверсивный гарем - это когда пол меняются на противоположный." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Хентай" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Хентай" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "История" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Имеет отношение к старым или древним временам." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Ужасы" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Мучительное чувство ужаса, страха и отвращения; Содрогание от ужаса и ненависти; Чувство, вдохновленное чем-то страшным и шокирующим." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Дзёсэй" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Буквально «Женщина». Нацелено на женщин 18-30 лет. Женский эквивалент сёнен. В отличие от сёдзе роман более реалистичен и менее идеализирован. Рассказ историй более ясный и зрелый." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Лоликон" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Представление сексуального влечения к молодым или несовершеннолетним девочкам." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Боевые Искусства" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "Как следует из названия, все, что связано с боевыми искусствами. Любое из нескольких исскуств боя или самозащиты, таких как айкидо, каратэ, дзюдо, таэквондо, кендо, фехтование и т.д.и т.п." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Зрелые" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "Содержит материаллы, которые могут быть слишком экстремальными для несовершеннолетних. Работы в этой категории могут содержать много насилия, крови, сексуального контента и/или резких слов." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Меха" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Работы жанра, включают и обычно концентрируются на всех типах крупных роботизированных машин." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Мюзикл" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Музыка" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Мистика" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Обычно происходит необъяснимое событие и главный герой пытается выяснить, что вызвало его." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Психология" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Обычно речь идет о философии состояния ума, в большинстве случаев подробно описывающей аномальную психологию." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Романтика" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Любая история, связанная с любовью. В этом случае мы определяем любовь между мужчиной и женщиной. Кроме этого, это зависит от вашего представления, что такое любовь." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Школьная жизнь" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "В основном сеттинге истории события происходят в какой-либо школе." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Скайфай" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Это сокращение от научной фантастики, эти работы связаны с поворотами в технологиях и других, связанных с наукой явлениях, которые являются противоречиями или отрезками современного научного мира." + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Сейнэн" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "Из Google: Сейнэн означает «молодой человек». аниме и манга, рассчитанные на особую целевую аудиторию — молодых мужчин от 18 лет и старше. Истории в Сейнэн рассчитаны на привлечение студентов университетов и тех, кто работают. Как правило, сюжетные линии посвящены проблемам взрослой жизни." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Шота" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Представление сексуального влечения к молодым или несовершеннолетним мальчикам." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Сёдзе" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Работы жанра нацелены и предназначены, в основном, для женщин. Обычно включает в себя много романтики и сильного развития персонажа." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Сёдзе-ай" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "Часто ассоциируется с Юри, можно считать несколько менее экстремальным. «Девичья любовь», так сказать." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Сёнэн" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Работы жанра нацелены и предназначены, в основном, для мужчин. Обычно связано с борьбой и/или насилием." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Сёнэн-ай" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "Часто ассоциируется с Яоем, можно считать несколько менее экстремальным. «Мужская любовь», так сказать" + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Повседневность" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "Wiki: Жанр, повествующий о жизни простых обывателей. Так называют любое реалистическое описание или представление событий и ситуаций из повседневной жизни. Акцент делается на чувствах и поведении персонажей." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Смат (Непристойность)" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Жанр сетевого текста, в котором описывается только секс между героями. Имеет дело с сериями, которые считаются неприличными или оскорбительными, особенно в отношении сексуального контента." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Спорт" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "Как следует из названия, все, что связано со спортом. Бейсбол, баскетбол, хоккей, футбол, гольф и гонки- некоторые из них." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Сверхъестественное" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Обычно подразумевает удивительные и необъяснимые силы или события, которые бросают вызов законам физики." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Трагедия" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Содержит события, приводящие к большим потерям и неудачам." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Вебкомиксы" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Вебкомиксы" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Яой" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Обычно связано с интимными отношениями между мужчинами." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Юри" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Обычно связано с интимными отношениями между женщинами." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgctxt "tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption" +msgid "Always start task from failed chapters" +msgstr "Всегда запускать задачу с неудавшихся частей" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "Сохранять PNG как JPEG" + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Ввод пользовательских жанров, разделенных запятой" + +#: tmainform.eddownloadssearch.texthint +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "Поиск загрузок..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Поиск в избранном..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Артист" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Автор" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "TMAINFORM.EDFILTERMANGAINFOCHAPTERS.TEXTHINT" +msgid "Filter" +msgstr "Фильтр" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Часть Описание" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Название" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Поиск названия..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONCHAPTERCUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Пользовательское переименование" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Путь загрузки по умолчанию:" + +#: tmainform.edoptionexternalparams.texthint +msgctxt "TMAINFORM.EDOPTIONEXTERNALPARAMS.TEXTHINT" +msgid "External program parameters" +msgstr "Параметры внешней программы" + +#: tmainform.edoptionexternalpath.texthint +msgctxt "TMAINFORM.EDOPTIONEXTERNALPATH.TEXTHINT" +msgid "External program path" +msgstr "Путь к внешней программе" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONFILENAMECUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Пользовательское переименование" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Прокси-сервер / IP-адрес" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "TMAINFORM.EDOPTIONMANGACUSTOMRENAME.TEXTHINT" +msgid "Custom rename" +msgstr "Пользовательское переименование" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Пароль прокси" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Имя пользователя прокси" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Сохранить в" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Ввести адрес сюда" + +#: tmainform.edwebsitessearch.texthint +msgctxt "TMAINFORM.EDWEBSITESSEARCH.TEXTHINT" +msgid "Search website..." +msgstr "Поиск сайта..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Показать диалог подтверждения когда" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "Дропбокс" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Конвертация изображений" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Внешняя программа" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Избранное" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Конфигурация прокси-сервера" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Переименовать" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Выберите путь загрузки по умолчанию:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Прозрачность" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Артист" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Автор" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Пользовательские жанры" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Жанры:\n" +"- Отмечено: Включить этот жанр.\n" +"- не отмечено: Исключить этот жанр.\n" +"- Серое: Не имеет значения.\n" +" \n" +"Свои жанры:\n" +"- Разделяйте несколько жанров с помощью ','.\n" +"- Исключите жанр, поставив '!' или '-' в начале жанра.\n" +"- Пример: Приключение,!Этти, Комедия.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Статус" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Описание" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Название" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "Качество JPEG" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Файл лога:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Режим: Показать все (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "TMAINFORM.LBOPTIONAUTOCHECKFAVINTERVALMINUTES.CAPTION" +msgid "Auto check for new chapter every %d minutes" +msgstr "Автоматическая проверка новой главы каждые %d минут" + +#: tmainform.lboptionchaptercustomrename.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAME.CAPTION" +msgid "Chapter name:" +msgstr "Название главы:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "TMAINFORM.LBOPTIONCHAPTERCUSTOMRENAMEHINT.HINT" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Название сайта\n" +"%MANGA%: Название манги\n" +"%CHAPTER%: Название главы\n" +"%AUTHOR%: Автор\n" +"%ARTIST%: Артист\n" +"%NUMBERING% : Нумерация\n" +"\n" +"Примечание:\n" +"Имя папки главы должно содержать как минимум %CHAPTER% или %NUMBERING%.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Время ожидания подключения (в секундах)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Открыть мангу, используя внешнюю программу:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Параметры боксмода:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "TMAINFORM.LBOPTIONEXTERNALPARAMSHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Имя файла:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONFILENAMECUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE%: Название сайта\n" +"%MANGA%: Название манги\n" +"%CHAPTER%: Название главы\n" +"%FILENAME%: Имя файла\n" +"\n" +"Примечание:\n" +"Имя файла должно содержать как минимум %FILENAME%\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Сервер" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Язык:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "После завершения загрузки:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAME.CAPTION" +msgid "Manga folder name:" +msgstr "Имя каталога манги:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "TMAINFORM.LBOPTIONMANGACUSTOMRENAMEHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE%: Название сайта\n" +"%MANGA%: Название манги\n" +"%AUTHOR%: Автор\n" +"%ARTIST%: Артист \n" +"\n" +"Примечание:\n" +"Имя папки манги должно содержать как минимум %MANGA%.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Количество одновременно загружаемых задач" + +#: tmainform.lboptionmaxretry.caption +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "Количество повторных попыток, если задачи имеют проблемы с загрузкой (-1 = всегда повторять)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Количество одновременно загружаемых файлов на одну задачу" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Новая манга основана на времени ее обновления (дней)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Пароль" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "Уровень сжатия PDF" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (без потерь), lower = DCTEncode (с потерями)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "TMAINFORM.LBOPTIONPDFQUALITYHINT.CAPTION" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Порт" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Тип" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Переименовать цифры" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Количество попыток при ошибке в задаче" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Имя пользователя" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "Уровень компрессии PNG" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Сохранить в:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "Сохранять WebP как" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Удалить" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Скопировать" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Вырезать" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Вставить" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Вставить и пойти" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Выбрать все" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Отменить" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Отменить" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Восходящий" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Отметить все" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Отметить выделенные" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Нисходящий" + +#: tmainform.michapterlistfilter.caption +msgctxt "TMAINFORM.MICHAPTERLISTFILTER.CAPTION" +msgid "Filter" +msgstr "Фильтр" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "Скрыть загруженные главы" + +#: tmainform.michapterlisthighlight.caption +msgid "Highlight downloaded chapters" +msgstr "Подсветить загруженные главы" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Снять отметку со всех" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Снять отметку с выделенных" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Удалить" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Удалить все выполненные задачи" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Только задание" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Задача + Данные" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Задача + Данные + Избранное" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Отключить" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Включить" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Объединить завершенные задачи" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Открыть папку" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Открыть..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Продолжить" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Остановить" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Информация о манге" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Изменить \"Текущая глава\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Изменить \"Сохранить в\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "TMAINFORM.MIFAVORITESCHECKNEWCHAPTER.CAPTION" +msgid "Check for new chapter" +msgstr "Проверить на новые главы" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Удалить" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Отключить" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Загрузить все" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Включить" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Открыть папку" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Открыть..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Переименовать" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Не проверять на новые главы" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Перенести на другой сайт" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Информация о манге" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Подсветить новую мангу" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Добавить в избранное" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Удалить" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Загрузить все" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Информация о манге" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "После завершения загрузки:" + +#: tmainform.mitrayexit.caption +msgctxt "TMAINFORM.MITRAYEXIT.CAPTION" +msgid "Exit" +msgstr "Выход" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Выход" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Hibernate" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Бесплатно" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Неисправность" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Восстановить" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Продолжить все" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "TMAINFORM.MITRAYSHOWDROPBOX.CAPTION" +msgid "Show Drop Box" +msgstr "Показать Drop Box" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Остановить все" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Загрузите все списки с сервера одновременно" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLCHECK.CAPTION" +msgid "Check all" +msgstr "Отметить все" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Определить все" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "TMAINFORM.MNFILTERGENREALLUNCHECK.CAPTION" +msgid "Uncheck all" +msgstr "Снить выделение со всех" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Обновление всех списков одновременно" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Загрузить список манги с сервера" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Обновить список манги" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Содержит все отмеченные жанры" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Содержит один из отмеченных жанров" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Режим" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "Сохранить загруженные главы как" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (без потерь), lower = DCTEncode (с потерями)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Удалить все выполненные задачи" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Продолжить все" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Остановить все" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Переместить выбранные элементы в конец списка" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Сдвинуть выбранные элементы вниз" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Переместить выбранные элементы в начало списка" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Сдвинуть выбранные элементы вверх" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Свернуть все" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Раскрыть все" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "О программе" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "О программе" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Учётные записи" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Журнал изменений" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Соединение" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Пользовательские цвета" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "Диалоги" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "Загрузки" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Избранное" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Основные" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Фильтр" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Информация" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Информация о манге" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Лог" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Разное" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Настройки" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Сохранение" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Обновления" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Вид" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Расширенные" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Модули" + +#: tmainform.tswebsiteoptions.caption +msgctxt "TMAINFORM.TSWEBSITEOPTIONS.CAPTION" +msgid "Options" +msgstr "Настройки" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Веб-сайты" + +#: tmainform.tswebsiteselection.caption +msgctxt "TMAINFORM.TSWEBSITESELECTION.CAPTION" +msgid "Websites" +msgstr "Веб-сайты" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Манга" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Статус" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "Прогресс" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Скоростъ загрузки" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Сайт" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Сохранить в" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Добавлена" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Название" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Текущая глава" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Сайт" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Сохранить в" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "Отмена" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "Загрузить" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "Добавить в очередь" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "OK" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Выбрать папку" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "Прервать" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "Сейчас" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "Отмена" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "OK" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Перенос на другой сайт" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "Очистить скачанные главы и заново загрузить с сервера" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Перенести на" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "Все" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Неподтвержденное" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Подтвержденное" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Название" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Сайт" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "Позже" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "Обновить" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"Найдена новая версия! Хотите обновить сейчас? \n" +"FMD будет закрыт для завершения обновления. \n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM1.CAPTION" +msgid "Add" +msgstr "Добавить" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM2.CAPTION" +msgid "Edit" +msgstr "Правка" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.MENUITEM4.CAPTION" +msgid "Delete" +msgstr "Удалить" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Куки" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Номер страницы папки" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "TWEBSITEOPTIONADVANCEDFORM.TSDOWNLOADS.CAPTION" +msgid "Downloads" +msgstr "Загрузки" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Максимальное количество потоков на задание" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "Количество потоков" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Обновление списка" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Сайт" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTCOOKIES.HEADER.COLUMNS[1].TEXT" +msgid "Cookies" +msgstr "Файлы Cookie" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTDOWNLOADMAXTHREADSPERTASK.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Сайт" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Значение" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Сайт" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTDIRECTORYPAGENUMBER.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Значение" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Сайт" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUPDATELISTNUMBEROFTHREADS.HEADER.COLUMNS[1].TEXT" +msgid "Value" +msgstr "Значение" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[0].TEXT" +msgid "Website" +msgstr "Сайт" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "TWEBSITEOPTIONADVANCEDFORM.VTUSERAGENT.HEADER.COLUMNS[1].TEXT" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Выбрать сайт" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "WebsiteSettingsForm" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "Название сайта" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "Название параметра" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Сжатие..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Отключено" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "Загрузка" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Неудачно" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Не удалось создать каталог!" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Не удалось, попробуйте возобновить эту задачу!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Завершено" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Подготовка" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Остановлено" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Ожидание..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "Добавить в очередь" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "Отмена" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Проверить на новые главы" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "Загрузить" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "Удалить" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "Найдено %d завершенной манги" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Проверка избранного запущена!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d manga (s) имеют новую главу (главы)" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> имеет %d новых глав." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Завершенная манга будет удалена::" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "Найдено %d новая глава из %d manga (s):" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Загрузка: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Проверить новую версию" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "Установленная версия" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Последняя версия " + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Найдена новая версия!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s имеет %d новых частей манги" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Получение каталога" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Получение информации" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Получение списка для" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Индексация новых названий" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Поиск новых названий" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Поиск новых названий из другого каталога" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Подготовка" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Удаление дубликатов из текущих данных" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Удаление дубликатов из локальных данных" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Удаление дубликатов из новых названий" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Сохранение данных" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Синхронизацияе данных" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Обновление списка" + diff --git a/mangadownloader/languages/fmd.tr_TR.po b/mangadownloader/languages/fmd.tr_TR.po new file mode 100644 index 000000000..40dec3362 --- /dev/null +++ b/mangadownloader/languages/fmd.tr_TR.po @@ -0,0 +1,2602 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: Free Manga Downloader\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: Tmp341 \n" +"Language-Team: Tmp341\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: tr\n" +"X-Generator: Poedit 2.0.6\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" +"X-Poedit-SourceCharset: UTF-8\n" + +#: dbupdater.rs_buttoncancel +msgctxt "dbupdater.rs_buttoncancel" +msgid "Abort" +msgstr "İptal" + +#: dbupdater.rs_downloading +msgid "Downloading %s" +msgstr "%s indiriliyor" + +#: dbupdater.rs_extracting +msgid "Extracting %s" +msgstr "%s çıkartılıyor" + +#: dbupdater.rs_faileddownload +msgid "%s: %d %s" +msgstr "%s: %d %s" + +#: dbupdater.rs_failedextract +msgid "%s: failed to extract, exitstatus = %d" +msgstr "%s: çıkartma başarısız, çıkış durumu = %d" + +#: dbupdater.rs_faileditems +msgid "" +"Failed to finish:\n" +"\n" +"%s\n" +msgstr "" +"Bitirme başarısız:\n" +"\n" +"%s\n" + +#: dbupdater.rs_faileditemstitle +msgctxt "dbupdater.rs_faileditemstitle" +msgid "Failed" +msgstr "Başarısız oldu" + +#: dbupdater.rs_failedtosave +msgid "%s: failed to save" +msgstr "%s: kaydetme başarısız" + +#: dbupdater.rs_missingzipexe +msgid "%s: Missing %s" +msgstr "%s: eksik %s" + +#: ehentai.rs_downloadoriginalimage +msgid "Download original image(require ExHentai account)" +msgstr "Orijinal resmi indir(ExHentai hesabı gerektirir)" + +#: ehentai.rs_settingsimagesize +#| msgid "Image size" +msgid "Image size:" +msgstr "Resim boyutu:" + +#: ehentai.rs_settingsimagesizeitems +msgid "" +"Auto\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Original\n" +msgstr "" +"Otomatik\n" +"780x\n" +"980x\n" +"1280x\n" +"1600x\n" +"2400x\n" +"Orjinal\n" + +#: frmaccountmanager.rs_accountdeleteconfirmation +msgid "Are you sure you want to delete this account?" +msgstr "Bu hesabı silmek istediğinizden emin misiniz?" + +#: frmaccountmanager.rs_checking +msgid "Checking" +msgstr "Kontrol ediliyor" + +#: frmaccountmanager.rs_invalid +msgctxt "frmaccountmanager.rs_invalid" +msgid "Invalid" +msgstr "Geçersiz" + +#: frmaccountmanager.rs_unknown +msgid "Unknown" +msgstr "Bilinmeyen" + +#: frmaccountmanager.rs_valid +msgctxt "frmaccountmanager.rs_valid" +msgid "OK" +msgstr "Tamam" + +#: frmaccountset.rs_cantbeempty +msgid "Username or password can't be empty!" +msgstr "Kullanıcı adı veya şifre boş olamaz!" + +#: frmimportfavorites.rs_importcompleted +msgid "Import completed." +msgstr "İçe aktarma tamamlandı." + +#: frmimportfavorites.rs_listunimportedcaption +msgid "List of unimported manga" +msgstr "İçe aktarılmayan manga listesi" + +#: frmluamodulesupdater.rs_checking +msgctxt "frmluamodulesupdater.rs_checking" +msgid "Checking..." +msgstr "Kontrol ediliyor..." + +#: frmluamodulesupdater.rs_checkupdate +msgctxt "frmluamodulesupdater.rs_checkupdate" +msgid "Check update" +msgstr "Güncellemelere bak" + +#: frmluamodulesupdater.rs_finishchecking +msgid "Finish checking" +msgstr "Kontrolü durdur" + +#: frmluamodulesupdater.rs_finishdownload +msgid "Finish download" +msgstr "İndirmeyi durdur" + +#: frmluamodulesupdater.rs_modulesupdatedrestart +msgid "" +"Modules updated, restart now?\n" +"\n" +"%s\n" +msgstr "" +"Modüller güncellendi, yeniden başlasın mı?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_modulesupdatedtitle +msgid "Modules updated!" +msgstr "Modüller güncellendi!" + +#: frmluamodulesupdater.rs_newupdatefoundlostchanges +msgid "" +"Modules update found, any local changes will be lost, procced?\n" +"\n" +"%s\n" +msgstr "" +"Modül güncellemeleri bulundu, herhangi bir yerel değişim kaybolacaktır, devam edilsin mi?\n" +"\n" +"%s\n" + +#: frmluamodulesupdater.rs_newupdatefoundtitle +msgid "Modules update found!" +msgstr "Modül güncellemeleri bulundu!" + +#: frmluamodulesupdater.rs_startdownloading +msgid "Downloading..." +msgstr "İndiriliyor..." + +#: frmluamodulesupdater.rs_statusdelete +msgctxt "frmluamodulesupdater.rs_statusdelete" +msgid "%s DELETE*" +msgstr "%s SİLİNDİ*" + +#: frmluamodulesupdater.rs_statusfailed +msgctxt "frmluamodulesupdater.rs_statusfailed" +msgid "%s FAILED*" +msgstr "%s BAŞARISIZ*" + +#: frmluamodulesupdater.rs_statusnew +msgctxt "frmluamodulesupdater.rs_statusnew" +msgid "%s NEW*" +msgstr "%s YENİ*" + +#: frmluamodulesupdater.rs_statusredownloaded +msgctxt "frmluamodulesupdater.rs_statusredownloaded" +msgid "%s REDOWNLOAD*" +msgstr "%s TEKRAR İNDİRME*" + +#: frmluamodulesupdater.rs_statusupdate +msgctxt "frmluamodulesupdater.rs_statusupdate" +msgid "%s UPDATE*" +msgstr "%s GÜNCELLENDİ*" + +#: frmmain.rs_alldownloads +msgid "All downloads" +msgstr "Tüm indirmeler" + +#: frmmain.rs_btnok +msgctxt "frmmain.rs_btnok" +msgid "&OK" +msgstr "&Tamam" + +#: frmmain.rs_cancel +msgctxt "frmmain.rs_cancel" +msgid "Cancel" +msgstr "İptal" + +#: frmmain.rs_checking +msgctxt "frmmain.rs_checking" +msgid "Checking..." +msgstr "Kontrol ediliyor..." + +#: frmmain.rs_dlgcannotconnecttoserver +msgid "Cannot connect to the server." +msgstr "Sunucuya bağlanılamıyor." + +#: frmmain.rs_dlgcannotgetmangainfo +msgid "Cannot get manga info. Please check your internet connection and try it again." +msgstr "Manga bilgisi alınamıyor. Lütfen internet bağlantınızı kontrol edip tekrar deneyin." + +#: frmmain.rs_dlgdownloadcount +msgid "Download count:" +msgstr "İndirme sayısı:" + +#: frmmain.rs_dlgmangalistselect +msgid "You must choose at least 1 manga website!" +msgstr "En az 1 manga sitesi seçmelisin!" + +#: frmmain.rs_dlgquit +msgid "Are you sure you want to exit?" +msgstr "Çıkmak istediğine emin misin?" + +#: frmmain.rs_dlgremovefavorite +msgid "Are you sure you want to delete the favorite(s)?" +msgstr "Favori(leri) silmek istediğine emin misin?" + +#: frmmain.rs_dlgremovefinishtasks +msgid "Are you sure you want to delete all finished tasks?" +msgstr "Tamamlanmış indirmeleri silmek istediğine emin misin?" + +#: frmmain.rs_dlgremoveitem +msgid "Are you sure you want to delete this item(s)?" +msgstr "Bu içerikleri silmek istediğine emin misin?" + +#: frmmain.rs_dlgremovetask +msgid "Are you sure you want to delete the task(s)?" +msgstr "Görev(leri) silmek istediğine emin misin?" + +#: frmmain.rs_dlgsplitdownload +msgctxt "frmmain.rs_dlgsplitdownload" +msgid "Split download" +msgstr "Bölünmüş indirme" + +#: frmmain.rs_dlgtitleexistindllist +msgid "" +"This title are already in download list.\n" +"Do you want to download it anyway?\n" +msgstr "" +"Bu başlık zaten indirme listesinde.\n" +"Yine de indirmek istiyor musun?\n" + +#: frmmain.rs_dlgtypeinnewchapter +msgid "Type in new chapter:" +msgstr "Yeni bölüm gir:" + +#: frmmain.rs_dlgtypeinnewsavepath +msgid "Type in new save path:" +msgstr "Yeni kayıt yolu gir:" + +#: frmmain.rs_dlgupdaterisrunning +msgid "Updater is running!" +msgstr "Güncelleyici çalışıyor!" + +#: frmmain.rs_dlgupdaterwanttoupdatedb +msgid "Do you want to download manga list from the server?" +msgstr "Manga listesini sunucudan indirmek istiyor musun?" + +#: frmmain.rs_dlgurlnotsupport +msgid "URL not supported!" +msgstr "URL desteklenmiyor!" + +#: frmmain.rs_droptargetmodeitems +msgid "" +"Download all\n" +"Add to favorites\n" +msgstr "" +"Tümünü indir\n" +"Favorilere ekle\n" + +#: frmmain.rs_filterstatusitems +msgid "" +"Completed\n" +"Ongoing\n" +"\n" +msgstr "" +"Tamamlandı\n" +"Devam Ediyor\n" +"\n" + +#: frmmain.rs_fmdalreadyrunning +msgid "Free Manga Downloader already running!" +msgstr "Free Manga Downloader zaten çalışıyor!" + +#: frmmain.rs_hintfavoriteproblem +msgid "" +"There is a problem with this data!\n" +"Removing and re-adding this data may fix the problem.\n" +msgstr "" +"Bu veriyle ilgili bir sorun var!\n" +"Silip tekrardan eklemek bu soruna çözüm olabilir.\n" + +#: frmmain.rs_history +msgid "History" +msgstr "Geçmiş" + +#: frmmain.rs_import +msgid "Import" +msgstr "İçe aktar" + +#: frmmain.rs_infoartists +msgid "Artist(s):" +msgstr "Çizer(ler):" + +#: frmmain.rs_infoauthors +msgid "Author(s):" +msgstr "Yazar(lar):" + +#: frmmain.rs_infogenres +msgid "Genre(s):" +msgstr "Tür(ler):" + +#: frmmain.rs_infostatus +msgid "Status:" +msgstr "Durum:" + +#: frmmain.rs_infosummary +msgid "Summary:" +msgstr "Özet:" + +#: frmmain.rs_infotitle +msgid "Title:" +msgstr "Başlık:" + +#: frmmain.rs_infowebsite +msgctxt "frmmain.rs_infowebsite" +msgid "Website:" +msgstr "Site:" + +#: frmmain.rs_inprogress +msgid "In progress" +msgstr "Devam ediyor" + +#: frmmain.rs_lblautochecknewchapterminute +msgctxt "frmmain.rs_lblautochecknewchapterminute" +msgid "Auto check for new chapter every %d minutes" +msgstr "Yeni bölümleri her %d dakikada bir kontrol et" + +#: frmmain.rs_lbloptionexternalparamshint +msgid "" +"%s : Path to the manga\n" +"%s : Chapter filename\n" +"\n" +"Example : \"%s%s\"\n" +msgstr "" +"%s : Manga yolu\n" +"%s : Bölüm dosya adı\n" +"\n" +"Örnek : \"%s%s\"\n" + +#: frmmain.rs_loading +msgid "Loading ..." +msgstr "Yükleniyor ..." + +#: frmmain.rs_modeall +msgid "Mode: Show all (%d)" +msgstr "Mod: Tümünü göster (%d)" + +#: frmmain.rs_modefiltered +msgid "Mode: Filtered (%d)" +msgstr "Mod: Filtrelenmiş (%d)" + +#: frmmain.rs_modesearching +#| msgid "Searching..." +msgctxt "frmmain.rs_modesearching" +msgid "Mode: Searching..." +msgstr "Mod: Aranıyor..." + +#: frmmain.rs_onemonth +msgid "One month" +msgstr "Bir ay" + +#: frmmain.rs_oneweek +msgid "One week" +msgstr "Bir hafta" + +#: frmmain.rs_optioncompress +msgid "" +"None\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" +msgstr "" +"Hiçbiri\n" +"ZIP\n" +"CBZ\n" +"PDF\n" +"EPUB\n" + +#: frmmain.rs_optionfmddoitems +msgid "" +"Nothing\n" +"Exit\n" +"Shutdown\n" +"Hibernate\n" +msgstr "" +"Hiçbiri\n" +"Çıkış\n" +"Kapat\n" +"Uyku\n" + +#: frmmain.rs_selected +msgid "Selected: %d" +msgstr "Seçildi: %d" + +#: frmmain.rs_software +msgid "Software" +msgstr "Yazılım" + +#: frmmain.rs_softwarepath +msgctxt "frmmain.rs_softwarepath" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Yazılım yolu (mesela c:\\MangaDownloader)" + +#: frmmain.rs_today +msgid "Today" +msgstr "Bugün" + +#: frmmain.rs_webpconvertto +msgid "" +"WebP\n" +"PNG\n" +"JPEG\n" +msgstr "" +"WebP\n" +"PNG\n" +"JPEG\n" + +#: frmmain.rs_webppnglevel +msgid "" +"None\n" +"Fastest\n" +"Default\n" +"Maximum\n" +msgstr "" +"Hiçbiri\n" +"En hızlı\n" +"Varsayılan\n" +"Maksimum\n" + +#: frmmain.rs_wronginput +msgid "Invalid input!" +msgstr "Geçersiz giriş!" + +#: frmmain.rs_yesterday +msgid "Yesterday" +msgstr "Dün" + +#: frmshutdowncounter.rs_lblmessageexit +msgid "FMD will exit in %d second." +msgstr "FMD %d saniye içinde kapanacak." + +#: frmshutdowncounter.rs_lblmessagehibernate +msgid "System will hibernate in %d second." +msgstr "Sistem %d saniye içinde uykuya geçecek." + +#: frmshutdowncounter.rs_lblmessageshutdown +msgid "System will shutdown in %d second." +msgstr "Sistem %d saniye içinde kapanacak." + +#: frmtransferfavorites.rs_all +msgctxt "frmtransferfavorites.rs_all" +msgid "All" +msgstr "Tümü" + +#: frmtransferfavorites.rs_invalid +msgctxt "frmtransferfavorites.rs_invalid" +msgid "Invalid" +msgstr "Geçersiz" + +#: frmtransferfavorites.rs_valid +msgctxt "frmtransferfavorites.rs_valid" +msgid "Valid" +msgstr "Geçerli" + +#: kissmanga.rs_kissmanga_initvector +msgid "Initialization Vector:" +msgstr "Başlatma Vektörü (IV):" + +#: kissmanga.rs_kissmanga_key +msgid "Key:" +msgstr "Anahtar:" + +#: kissmanga.rs_kissmanga_usegoogledcp +msgid "Use Google DCP" +msgstr "Google DCP kullan" + +#: mangadex.rs_showalllang +msgctxt "mangadex.rs_showalllang" +msgid "Show all language" +msgstr "Tüm dilleri göster" + +#: mangadex.rs_showscangroup +msgctxt "mangadex.rs_showscangroup" +msgid "Show scanlation group" +msgstr "Scanlation grubunu göster" + +#: mangafox.rs_removewatermark +msgid "Remove watermark" +msgstr "Filigranı kaldır" + +#: mangafox.rs_saveaspng +msgid "Save as PNG" +msgstr "PNG olarak kaydet" + +#: selfupdater.rs_buttoncancel +msgctxt "selfupdater.rs_buttoncancel" +msgid "Abort" +msgstr "Durdur" + +#: selfupdater.rs_downloading +msgid "Downloading new version %s" +msgstr "%s yeni sürümü indiriliyor" + +#: selfupdater.rs_faileddownload +msgid "" +"Failed to download new version %s\n" +"\n" +"%d %s\n" +msgstr "" +"%s yeni sürümü indirmesi başarısız\n" +"\n" +"%d %s\n" + +#: selfupdater.rs_failedextract +msgid "Failed to extract %s, exitstatus = %d" +msgstr "%s çıkartma başarısız, çıkış durumu = %d" + +#: selfupdater.rs_failedtitle +msgctxt "selfupdater.rs_failedtitle" +msgid "Failed" +msgstr "Başarısız oldu" + +#: selfupdater.rs_failedtosave +msgid "Failed to save %s" +msgstr "%s kaydetme başarısız" + +#: selfupdater.rs_finishrestart +msgid "Download update package finished, restart to proceed?" +msgstr "Güncelleme paketi indirme tamamlandı, devam etmek için yeniden başlansın mı?" + +#: selfupdater.rs_finishrestarttitle +msgid "Download finished" +msgstr "İndirme tamamlandı" + +#: selfupdater.rs_missingfile +msgctxt "selfupdater.rs_missingfile" +msgid "Missing %s" +msgstr "%s eksik" + +#: taccountmanagerform.btedit.caption +msgctxt "taccountmanagerform.btedit.caption" +msgid "Edit" +msgstr "Düzenle" + +#: taccountmanagerform.btrefresh.caption +msgid "Refresh" +msgstr "Yenile" + +#: taccountmanagerform.caption +msgid "AccountManagerForm" +msgstr "HesapYöneticisiFormu" + +#: taccountmanagerform.vtaccountlist.header.columns[1].text +#| msgid "Username" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[1].text" +msgid "Website" +msgstr "Site" + +#: taccountmanagerform.vtaccountlist.header.columns[2].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[2].text" +msgid "Username" +msgstr "Kullanıcı Adı" + +#: taccountmanagerform.vtaccountlist.header.columns[3].text +#| msgid "Status" +msgctxt "taccountmanagerform.vtaccountlist.header.columns[3].text" +msgid "Status" +msgstr "Durum" + +#: taccountsetform.btcancel.caption +msgctxt "taccountsetform.btcancel.caption" +msgid "Cancel" +msgstr "İptal" + +#: taccountsetform.btok.caption +msgid "Ok" +msgstr "Tamam" + +#: taccountsetform.caption +msgid "Account" +msgstr "Hesap" + +#: taccountsetform.ckshowpassword.caption +msgid "Show password" +msgstr "Şifreyi göster" + +#: taccountsetform.edpassword.texthint +msgctxt "taccountsetform.edpassword.texthint" +msgid "Password" +msgstr "Şifre" + +#: taccountsetform.edusername.texthint +#| msgid "Status" +msgctxt "taccountsetform.edusername.texthint" +msgid "Username" +msgstr "Kullanıcı Adı" + +#: taccountsetform.label2.caption +#| msgid "Status" +msgctxt "taccountsetform.label2.caption" +msgid "Username" +msgstr "Kullanıcı Adı" + +#: taccountsetform.label3.caption +msgctxt "taccountsetform.label3.caption" +msgid "Password" +msgstr "Şifre" + +#: tcustomcolorform.caption +msgid "CustomColorForm" +msgstr "KişiselRenkFromu" + +#: tcustomcolorform.tsbasiclist.caption +msgid "Basic list" +msgstr "Basit Liste" + +#: tcustomcolorform.tschapterlist.caption +msgid "Chapter list" +msgstr "Bölüm Listesi" + +#: tcustomcolorform.tsfavoritelist.caption +msgid "Favorite list" +msgstr "Favori Listesi" + +#: tcustomcolorform.tsmangalist.caption +msgid "Manga list" +msgstr "Manga Listesi" + +#: tformdroptarget.miaddtofavorites.caption +msgctxt "tformdroptarget.miaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Favorilere ekle" + +#: tformdroptarget.miclose.caption +msgid "&Close" +msgstr "&Kapat" + +#: tformdroptarget.midownloadall.caption +msgctxt "tformdroptarget.midownloadall.caption" +msgid "Download all" +msgstr "Tümünü İndir" + +#: tformlogger.btnclearlog.caption +msgid "Clear" +msgstr "Temizle" + +#: tformlogger.ckstayontop.caption +msgid "Stay on top" +msgstr "Üstte kal" + +#: tformlogger.lbloglimit.caption +msgid "Log limit" +msgstr "Günlük limiti" + +#: tformlogger.micopy.caption +msgctxt "tformlogger.micopy.caption" +msgid "Copy" +msgstr "Kopyala" + +#: timportfavorites.btcancel.caption +msgctxt "TIMPORTFAVORITES.BTCANCEL.CAPTION" +msgid "Cancel" +msgstr "İptal" + +#: timportfavorites.btimport.caption +msgctxt "timportfavorites.btimport.caption" +msgid "&OK" +msgstr "&Tamam" + +#: timportfavorites.cbsoftware.text +msgid "Domdomsoft Manga Downloader" +msgstr "Domdomsoft Manga İndirici" + +#: timportfavorites.edpath.texthint +msgctxt "timportfavorites.edpath.texthint" +msgid "Path to the software (e.g. C:\\MangaDownloader)" +msgstr "Yazılım yolu (mesela c:\\MangaDownloader)" + +#: timportfavorites.lbselectsoftware.caption +msgid "Software:" +msgstr "Yazılım:" + +#: tluamodulesupdaterform.btcheckupdate.caption +msgctxt "tluamodulesupdaterform.btcheckupdate.caption" +msgid "Check update" +msgstr "Güncellemelere bak" + +#: tluamodulesupdaterform.ckautorestart.caption +msgid "Auto restart" +msgstr "Otomatik yeniden başlat" + +#: tluamodulesupdaterform.ckshowupdatewarning.caption +msgid "Show update warning" +msgstr "Güncelleme uyarısını göster" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[0].text +msgid "Filename" +msgstr "Dosya adı" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[1].text +msgid "Last modified" +msgstr "Son değişim" + +#: tluamodulesupdaterform.vtluamodulesrepos.header.columns[2].text +msgid "Last message" +msgstr "Son mesaj" + +#: tmainform.btabortupdatelist.hint +msgid "Abort update list" +msgstr "Liste güncellemeyi iptal et" + +#: tmainform.btaddtofavorites.caption +msgctxt "tmainform.btaddtofavorites.caption" +msgid "Add to favorites" +msgstr "Favorilere ekle" + +#: tmainform.btchecklatestversion.caption +#| msgid "Check for new version" +msgctxt "tmainform.btchecklatestversion.caption" +msgid "Check for latest version" +msgstr "Son sürümü kontrol et" + +#: tmainform.btclearlogfile.caption +msgid "Clear log file" +msgstr "Günlük dosyasını temizle" + +#: tmainform.btdownload.caption +msgctxt "tmainform.btdownload.caption" +msgid "Download" +msgstr "İndir" + +#: tmainform.btdownloadsplit.hint +msgctxt "tmainform.btdownloadsplit.hint" +msgid "Split download" +msgstr "Bölünmüş indirme" + +#: tmainform.btfavoriteschecknewchapter.caption +msgctxt "tmainform.btfavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Yeni bölümü kontrol et" + +#: tmainform.btfavoritesimport.caption +msgid "Import list" +msgstr "Listeyi içe aktar" + +#: tmainform.btfilter.caption +msgctxt "TMAINFORM.BTFILTER.CAPTION" +msgid "Filter" +msgstr "Filtre" + +#: tmainform.btfilterreset.caption +msgid "Reset value" +msgstr "Değeri sıfırla" + +#: tmainform.btopenlog.caption +msgid "Open log" +msgstr "Günlüğü aç" + +#: tmainform.btoptionapply.caption +msgid "Apply" +msgstr "Uygula" + +#: tmainform.btreadonline.caption +msgid "Read online" +msgstr "Çevrimiçi oku" + +#: tmainform.btremovefilterlarge.caption +msgctxt "TMAINFORM.BTREMOVEFILTERLARGE.CAPTION" +msgid "Remove filter" +msgstr "Filtreyi kaldır" + +#: tmainform.btremovefilterlarge.hint +msgctxt "tmainform.btremovefilterlarge.hint" +msgid "Remove filter" +msgstr "Filtreyi kaldır" + +#: tmainform.btupdatelist.hint +msgctxt "tmainform.btupdatelist.hint" +msgid "Update manga list" +msgstr "Manga listesini güncelle" + +#: tmainform.btvisitmyblog.caption +msgid "Visit my blog" +msgstr "Blogumu ziyaret et" + +#: tmainform.caption +msgid "Free Manga Downloader" +msgstr "Free Manga Downloader" + +#: tmainform.cbaddasstopped.caption +msgid "Add to download list as stopped task" +msgstr "İndirme listesine durdurulmuş görev olarak ekle" + +#: tmainform.cbfilterstatus.text +msgid "" +msgstr "" + +#: tmainform.cbonlynew.caption +msgid "Search only new manga" +msgstr "Sadece yeni manga ara" + +#: tmainform.cboptionautocheckfavdownload.caption +msgctxt "tmainform.cboptionautocheckfavdownload.caption" +msgid "Automatic download after finish checking" +msgstr "Kontrol bittikten sonra otomatik indir" + +#: tmainform.cboptionautocheckfavinterval.caption +msgid "Auto check for new chapter in an interval" +msgstr "Beklerken yeni bölümleri otomatik kontrol et" + +#: tmainform.cboptionautocheckfavremovecompletedmanga.caption +msgctxt "tmainform.cboptionautocheckfavremovecompletedmanga.caption" +msgid "Automatic remove completed manga from Favorites" +msgstr "Tamamlanmış mangayı Favorilerden otomatik kaldır" + +#: tmainform.cboptionautocheckfavstartup.caption +#| msgid "Automatic check for new chapter at startup" +msgid "Auto check for new chapter at startup" +msgstr "Başlangıça yeni bölümleri otomatik kontrol et" + +#: tmainform.cboptionautochecklatestversion.caption +#| msgid "Check for new version " +msgctxt "tmainform.cboptionautochecklatestversion.caption" +msgid "Auto check for latest version " +msgstr "Son sürümü otomatik kontrol et " + +#: tmainform.cboptionautoopenfavstartup.caption +msgid "Open Favorites at startup" +msgstr "Başlangıçta Favorileri aç" + +#: tmainform.cboptionchangeunicodecharacter.caption +#| msgid "Change all all character to" +msgctxt "tmainform.cboptionchangeunicodecharacter.caption" +msgid "Replace all unicode character with" +msgstr "Tüm Unicode karakterleri şununla değiştir" + +#: tmainform.cboptionchangeunicodecharacter.hint +msgid "Enable this if you have problem with unicode character in path." +msgstr "Yolda Unicode karakter varsa bunu açın." + +#: tmainform.cboptiondeletecompletedtasksonclose.caption +msgid "Delete completed tasks on close" +msgstr "Tamamlanmış görevleri kapatırken sil" + +#: tmainform.cboptiondigitchapter.caption +msgid "Chapter" +msgstr "Bölüm" + +#: tmainform.cboptiondigitvolume.caption +msgid "Volume" +msgstr "Cilt" + +#: tmainform.cboptionenableloadcover.caption +msgid "Enable load manga cover" +msgstr "Manga afişini yüklemeyi aç" + +#: tmainform.cboptiongeneratechapterfolder.caption +msgid "Auto generate chapter folder" +msgstr "Bölüm klasörünü otomatik oluştur" + +#: tmainform.cboptiongeneratemangafolder.caption +msgctxt "tmainform.cboptiongeneratemangafolder.caption" +msgid "Auto generate folder based on manga's name" +msgstr "Klasörü manga adına göre otomatik oluştur" + +#: tmainform.cboptionlivesearch.caption +msgid "Enable live search (slow on long list)" +msgstr "Canlı taramayı etkinleştir (kalabalık listelerde yavaş)" + +#: tmainform.cboptionminimizeonstart.caption +msgid "Minimize on start" +msgstr "Başlangıça küçült" + +#: tmainform.cboptionminimizetotray.caption +msgid "Minimize to tray" +msgstr "Görev çubuğuna küçült" + +#: tmainform.cboptiononeinstanceonly.caption +msgid "Permit only one FMD running" +msgstr "Sadece bir FMD çalıştırmaya izin ver" + +#: tmainform.cboptionproxytype.text +msgid "HTTP" +msgstr "HTTP" + +#: tmainform.cboptionremovemanganamefromchapter.caption +msgid "Remove manga name from chapter" +msgstr "Manga ismini bölümden kaldır" + +#: tmainform.cboptionshowballoonhint.caption +msgid "Show balloon hint" +msgstr "Yardım balonlarını göster" + +#: tmainform.cboptionshowdeletetaskdialog.caption +msgid "Delete task/favorite" +msgstr "Görevi/favoriyi sil" + +#: tmainform.cboptionshowdownloadmangalistdialog.caption +msgid "Download manga list if empty" +msgstr "Boşsa manga listesini indir" + +#: tmainform.cboptionshowdownloadtoolbar.caption +msgid "Show downloads toolbar" +msgstr "İndirmeler araç çubuğunu göster" + +#: tmainform.cboptionshowdownloadtoolbardeleteall.caption +msgid "Show \"Delete all completed tasks\" in downloads toolbar" +msgstr "\"Tüm tamamlanmış görevleri sil\" seçeneğini indirmeler araç çubuğunda göster" + +#: tmainform.cboptionshowdownloadtoolbarleft.caption +msgid "Show left downloads toolbar" +msgstr "Sol indirmeler araç çubuğunu göster" + +#: tmainform.cboptionshowquitdialog.caption +msgid "Exit FMD" +msgstr "FMD'den çık" + +#: tmainform.cboptionupdatelistnomangainfo.caption +msgid "Don't load manga information when updating list (filter will be not work!)" +msgstr "Listeyi güncellerken manga bilgisini yükleme (filtre çalışmayabilir)" + +#: tmainform.cboptionupdatelistremoveduplicatelocaldata.caption +msgid "Remove duplicate local data when updating manga list" +msgstr "Manga listesini güncellerken çift yerel veriyi kaldır" + +#: tmainform.cboptionuseproxy.caption +msgid "Use proxy" +msgstr "Proxy kullan" + +#: tmainform.cbpngcompressionlevel.text +msgctxt "tmainform.cbpngcompressionlevel.text" +msgid "Fastest" +msgstr "En hızlı" + +#: tmainform.cbsearchfromallsites.caption +msgid "Search in all manga sites" +msgstr "Tüm manga sitelerinde ara" + +#: tmainform.cbselectmanga.hint +msgid "For more manga sites, please go to Options->Manga sites" +msgstr "Daha fazla manga sitesi için, lütfen Ayarlar->Manga siteleri'ne gidin" + +#: tmainform.cbuseregexpr.caption +msgid "Regular Expression" +msgstr "Düzenli İfadeler" + +#: tmainform.cbwebpsaveas.text +msgctxt "tmainform.cbwebpsaveas.text" +msgid "PNG" +msgstr "PNG" + +#: tmainform.ckdroptarget.caption +msgctxt "tmainform.ckdroptarget.caption" +msgid "Show Drop Box" +msgstr "İndirme Kutusunu Göster" + +#: tmainform.ckenablelogging.caption +msgid "Enable logging" +msgstr "Günlüklemeyi Aç" + +#: tmainform.ckfilteraction.caption +msgid "Action" +msgstr "Aksiyon" + +#: tmainform.ckfilteraction.hint +msgid "A work typically depicting fighting, violence, chaos, and fast paced motion." +msgstr "Dövüş, şiddet, kaos ve olayların hızla geliştiği bir çalışma." + +#: tmainform.ckfilteradult.caption +msgid "Adult" +msgstr "Yetişkin" + +#: tmainform.ckfilteradult.hint +msgid "Contains content that is suitable only for adults. Titles in this category may include prolonged scenes of intense violence and/or graphic sexual content and nudity." +msgstr "Sadece yetişkenlere uygun içerik barındırır. Bu kategorideki içerikler, uzun süreli yoğun şiddet ve/veya cinsel içerik ve çıplaklık içerebilir." + +#: tmainform.ckfilteradventure.caption +msgid "Adventure" +msgstr "Macera" + +#: tmainform.ckfilteradventure.hint +msgid "If a character in the story goes on a trip or along that line, your best bet is that it is an adventure manga. Otherwise, it's up to your personal prejudice on this case." +msgstr "Eğer hikayedeki bir karakter bir geziye ya da ona benzer bir şeye giderse, en yüksek ihtimalle o bir macera mangasıdır. Aksi halde, bu durumda sizin kişisel yargınıza kalmış." + +#: tmainform.ckfiltercomedy.caption +msgid "Comedy" +msgstr "Komedi" + +#: tmainform.ckfiltercomedy.hint +msgid "A dramatic work that is light and often humorous or satirical in tone and that usually contains a happy resolution of the thematic conflict." +msgstr "Hafif ve çoğu zaman gülünç olan ya da tonlamasında yergi içeren ve çoğunlukla tematik çatışmanın mutlu bir şekilde çözülmesini içeren dramatik bir çalışma." + +#: tmainform.ckfilterdoujinshi.caption +msgid "Doujinshi" +msgstr "Doujinshi" + +#: tmainform.ckfilterdoujinshi.hint +msgid "Fan based work inpspired by official manga/anime." +msgstr "Resmi bir mangadan/animeden esinlenerek yapılmış hayran temelli çalışma." + +#: tmainform.ckfilterdrama.caption +msgid "Drama" +msgstr "Dram" + +#: tmainform.ckfilterdrama.hint +msgid "A work meant to bring on an emotional response, such as instilling sadness or tension." +msgstr "Keder vererek ya da gererek duyguları etkilemek üzere yapılmış bir çalışma." + +#: tmainform.ckfilterechi.caption +msgid "Ecchi" +msgstr "Ecchi" + +#: tmainform.ckfilterechi.hint +msgid "Possibly the line between hentai and non-hentai, ecchi usually refers to fanservice put in to attract a certain group of fans." +msgstr "Hentai ile hentai-olmayan içerik arasında bir çizgi olan ecchi, çoğunlukla belli bir grup hayranı etkilemek üzere hazırlanmış bir hayran hizmetidir." + +#: tmainform.ckfilterfantasy.caption +msgid "Fantasy" +msgstr "Fantastik" + +#: tmainform.ckfilterfantasy.hint +msgid "Anything that involves, but not limited to, magic, dream world, and fairy tales." +msgstr "Sihir, hayal dünyası ve masalları içeren fakat bunlarla sınırlı olmayan çalışmaların tamamı." + +#: tmainform.ckfiltergenderbender.caption +msgid "Gender Bender" +msgstr "Gender Bender" + +#: tmainform.ckfiltergenderbender.hint +msgid "" +"Girls dressing up as guys, guys dressing up as girls.\n" +"Guys turning into girls, girls turning into guys.\n" +msgstr "" +"Kızlar erkek gibi giyinebilir, erkekler kız gibi giyinebilir.\n" +"Erkekler kıza dönüşebilir, kızlar erkeğe dönüşebilir.\n" + +#: tmainform.ckfilterharem.caption +msgid "Harem" +msgstr "Harem" + +#: tmainform.ckfilterharem.hint +msgid "A series involving one male character and many female characters (usually attracted to the male character). A Reverse Harem is when the genders are reversed." +msgstr "Bir erkek karakter ve birden çok kız/kadın karakter içeren (çoğunlukla bu kızlar/kadınlar erkek karaktere sevgi, aşk ile bağlıdırlar) çalışmalar. Reverse Haremde ise cinsiyetler tam tersidir." + +#: tmainform.ckfilterhentai.caption +msgctxt "tmainform.ckfilterhentai.caption" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhentai.hint +msgctxt "TMAINFORM.CKFILTERHENTAI.HINT" +msgid "Hentai" +msgstr "Hentai" + +#: tmainform.ckfilterhistorical.caption +msgid "Historical" +msgstr "Tarihi" + +#: tmainform.ckfilterhistorical.hint +msgid "Having to do with old or ancient times." +msgstr "Eski ya da antik çağlarda gerçekleşen olaylar." + +#: tmainform.ckfilterhorror.caption +msgid "Horror" +msgstr "Korku" + +#: tmainform.ckfilterhorror.hint +msgid "A painful emotion of fear, dread, and abhorrence; a shuddering with terror and detestation; the feeling inspired by something frightful and shocking." +msgstr "Korku, dehşet ve nefret; korkutmayla sarsıcı ve iğrenme; korkunç ve şok edici bir şeyden etkilenme hissi." + +#: tmainform.ckfilterjosei.caption +msgid "Josei" +msgstr "Josei" + +#: tmainform.ckfilterjosei.hint +msgid "Literally \"Woman\". Targets women 18-30. Female equivalent to seinen. Unlike shoujo the romance is more realistic and less idealized. The storytelling is more explicit and mature." +msgstr "Bayan. 18-30 yaş arası bayanlara yönelik içerik. Seinen'in kadın versiyonu. Aşklar gerçekçidir. Hikaye, Shoujo’ya göre daha olgun içerikler barındırır." + +#: tmainform.ckfilterlolicon.caption +msgid "Lolicon" +msgstr "Lolicon" + +#: tmainform.ckfilterlolicon.hint +msgid "Representing a sexual attraction to young or under-age girls." +msgstr "Genç veya çoğunlukla yaşı küçük kızlara karşı cinsel anlamda ilgi barındıran içerikler." + +#: tmainform.ckfiltermartialarts.caption +msgid "Martial Arts" +msgstr "Dövüş Sanatları" + +#: tmainform.ckfiltermartialarts.hint +msgid "As the name suggests, anything martial arts related. Any of several arts of combat or self-defense, such as aikido, karate, judo, or taekwondo, kendo, fencing, and so on and so forth." +msgstr "İsimden de anlaşılacağı gibi, dövüş sanatlarını içeren her şey. Birkaç tane dövüş ya da savunma sanatı; aikido, karate, judo ya da taekwondo, kendo, eskrim vb." + +#: tmainform.ckfiltermature.caption +msgid "Mature" +msgstr "Olgun" + +#: tmainform.ckfiltermature.hint +msgid "Contains subject matter which may be too extreme for people under the age of 17. Titles in this category may contain intense violence, blood and gore, sexual content and/or strong language." +msgstr "17 yaşın altındaki kişiler için aşırı gelebilecek şeyler içerir. Bu kategorideki başlıklar aşırı şiddet, kan ve gore, seksüel içerik ve/veya ağır sözler içerebilir." + +#: tmainform.ckfiltermecha.caption +msgid "Mecha" +msgstr "Mekanik" + +#: tmainform.ckfiltermecha.hint +msgid "A work involving and usually concentrating on all types of large robotic machines." +msgstr "Büyük robotik makineler içeren ve çoğunlukla bunlara odaklı çalışmalar." + +#: tmainform.ckfiltermusical.caption +msgctxt "tmainform.ckfiltermusical.caption" +msgid "Musical" +msgstr "Müzikal" + +#: tmainform.ckfiltermusical.hint +msgctxt "tmainform.ckfiltermusical.hint" +msgid "Musical" +msgstr "Müzikal" + +#: tmainform.ckfiltermystery.caption +msgid "Mystery" +msgstr "Gizem" + +#: tmainform.ckfiltermystery.hint +msgid "Usually an unexplained event occurs, and the main protagonist attempts to find out what caused it." +msgstr "Genellikle, açıklanmayan bir olay gerçekleşir ve ana karakter buna neyin sebep olduğunu bulmaya çalışır." + +#: tmainform.ckfilterpsychological.caption +msgid "Psychological" +msgstr "Psikolojik" + +#: tmainform.ckfilterpsychological.hint +msgid "Usually deals with the philosophy of a state of mind, in most cases detailing abnormal psychology." +msgstr "Genel olarak ruhsal durum felsefesi kullanır, çoğu durumda anormal psikoloji detaycılığıyla akıl oyunları oynar." + +#: tmainform.ckfilterromance.caption +msgid "Romance" +msgstr "Romantizm" + +#: tmainform.ckfilterromance.hint +msgid "Any love related story. We will define love as between man and woman in this case. Other than that, it is up to your own imagination of what love is." +msgstr "Aşk içeren herhangi bir hikaye. Buradaki aşk, kadın ve erkek arasındadır. Bunun dışında, aşkın ne olduğu sizin hayal gücünüze bağlıdır." + +#: tmainform.ckfilterschoollife.caption +msgid "School Life" +msgstr "Okul Hayatı" + +#: tmainform.ckfilterschoollife.hint +msgid "Having a major setting of the story deal with some type of school." +msgstr "Hikayenin çoğu, bir çeşit okulda geçer." + +#: tmainform.ckfilterscifi.caption +msgid "Sci-Fi" +msgstr "Bilim Kurgu" + +#: tmainform.ckfilterscifi.hint +msgid "Short for science fiction, these works involve twists on technology and other science related phenomena which are contrary or stretches of the modern day scientific world." +msgstr "Bu çalışmalar teknolojide ilerlemeler içerir ve günümüz dünyasındaki bilimsel gerçekliklerden farklı ya da fenomen olan içerikler barındırır." + +#: tmainform.ckfilterseinen.caption +msgid "Seinen" +msgstr "Seinen" + +#: tmainform.ckfilterseinen.hint +msgid "From Google: Seinen means 'young Man'. Manga and anime that specifically targets young adult males around the ages of 18 to 25 are seinen titles. The stories in seinen works appeal to university students and those in the working world. Typically the story lines deal with the issues of adulthood." +msgstr "Google: Seinen \"Genç Adam\" demek. 18-25 yaş arası genç yetişkinlere yönelik manga ve animeler. Seinen, üniversite öğrencileri ya da iş hayatındaki kişilerin yaşamlarını barındırır. Hikaye, yetişkinlik sorunlarını işler." + +#: tmainform.ckfiltershotacon.caption +msgid "Shotacon" +msgstr "Shotacon" + +#: tmainform.ckfiltershotacon.hint +msgid "Representing a sexual attraction to young or under-age boys." +msgstr "Genç yada küçük yaştaki erkek çocuklarına karşı cinsel anlamda ilgi barındıran içerikler." + +#: tmainform.ckfiltershoujo.caption +msgid "Shoujo" +msgstr "Shoujo" + +#: tmainform.ckfiltershoujo.hint +msgid "A work intended and primarily written for females. Usually involves a lot of romance and strong character development." +msgstr "Öncelikli olarak bayanlar için yazılmış çalışmalar. Bunlar çoğunlukla çok fazla romantizm ve güçlü derecede karakter gelişimi barındırır." + +#: tmainform.ckfiltershoujoai.caption +msgid "Shoujo Ai" +msgstr "Shoujo Ai" + +#: tmainform.ckfiltershoujoai.hint +msgctxt "TMAINFORM.CKFILTERSHOUJOAI.HINT" +msgid "Often synonymous with yuri, this can be thought of as somewhat less extreme. \"Girl''s Love\", so to speak." +msgstr "Yuri ile benzer görülse de, bu biraz daha az aşırılık barındırır. \"Kız Çocuklarının Aşkı\", denebilir." + +#: tmainform.ckfiltershounen.caption +msgid "Shounen" +msgstr "Shounen" + +#: tmainform.ckfiltershounen.hint +msgctxt "tmainform.ckfiltershounen.hint" +msgid "A work intended and primarily written for males. These works usually involve fighting and/or violence." +msgstr "Öncelikli olarak erkekler için yazılmış çalışmalar. Bunlar çoğunlukla kavga ve/veya şiddet içerir." + +#: tmainform.ckfiltershounenai.caption +msgid "Shounen Ai" +msgstr "Shounen Ai" + +#: tmainform.ckfiltershounenai.hint +msgid "Often synonymous with yaoi, this can be thought of as somewhat less extreme. \"Boy''s Love\", so to speak" +msgstr "Yaoi ile benzer görülse de, bu biraz daha az aşırılık barındırır. \"Erkek Çocuklarının Aşkı\", denebilir" + +#: tmainform.ckfiltersliceoflife.caption +msgid "Slice of Life" +msgstr "Hayattan Bir Kesit" + +#: tmainform.ckfiltersliceoflife.hint +msgid "As the name suggests, this genre represents day-to-day tribulations of one/many character(s). These challenges/events could technically happen in real life and are often -if not all the time- set in the present timeline in a world that mirrors our own." +msgstr "İsimden de anlaşılacağı gibi, bu tür bir/birden fazla karakterin günbegün yaşamını yansıtır. Bu zorluklar/olaylar teknik olarak günlük hayatta yaşanabilir ve çoğunlukla -her zaman olmasa bile- günümüz zaman diliminin yansıması olan bir dünyada geçer." + +#: tmainform.ckfiltersmut.caption +msgid "Smut" +msgstr "Smut" + +#: tmainform.ckfiltersmut.hint +msgid "Deals with series that are considered profane or offensive, particularly with regards to sexual content." +msgstr "Özellikle cinsel içerik açısından, küstahça veya saldırgan sayılan özellikler barındıran seriler." + +#: tmainform.ckfiltersports.caption +msgid "Sports" +msgstr "Spor" + +#: tmainform.ckfiltersports.hint +msgid "As the name suggests, anything sports related. Baseball, basketball, hockey, soccer, golf, and racing just to name a few." +msgstr "İsimden de anlaşılacağı gibi, spor içerikli. Beyzbol, hokey, futbol, golf ve yarış sadece birkaçı." + +#: tmainform.ckfiltersupernatural.caption +msgid "Supernatural" +msgstr "Doğaüstü" + +#: tmainform.ckfiltersupernatural.hint +msgid "Usually entails amazing and unexplained powers or events which defy the laws of physics." +msgstr "Gerçek olmayan güçler yada olaylar barındıran, fizik kurallarını ihlal eden içerikler." + +#: tmainform.ckfiltertragedy.caption +msgid "Tragedy" +msgstr "Trajedi" + +#: tmainform.ckfiltertragedy.hint +msgid "Contains events resulting in great loss and misfortune." +msgstr "Büyük kayıpların ya da talihsizliklerin olduğu olaylar içerir." + +#: tmainform.ckfilterweebtons.caption +msgctxt "tmainform.ckfilterweebtons.caption" +msgid "Weebtoons" +msgstr "Webtoonlar" + +#: tmainform.ckfilterweebtons.hint +msgctxt "tmainform.ckfilterweebtons.hint" +msgid "Weebtoons" +msgstr "Webtoonlar" + +#: tmainform.ckfilteryaoi.caption +msgid "Yaoi" +msgstr "Yaoi" + +#: tmainform.ckfilteryaoi.hint +msgid "This work usually involves intimate relationships between men." +msgstr "Bu çalışmalar genellikle erkekler arası yakın ilişki barındırır." + +#: tmainform.ckfilteryuri.caption +msgid "Yuri" +msgstr "Yuri" + +#: tmainform.ckfilteryuri.hint +msgid "This work usually involves intimate relationships between women." +msgstr "Bu çalışmalar genellikle kadınlar arası yakın ilişki barındırır." + +#: tmainform.ckoptionsalwaysstarttaskfromfailedchapters.caption +msgid "Always start task from failed chapters" +msgstr "Görevi her zaman başarısız bölümlerden başlat" + +#: tmainform.ckpngsaveasjpeg.caption +msgid "Save PNG as JPEG" +msgstr "PNGyi JPEG olarak kaydet." + +#: tmainform.edcustomgenres.texthint +msgid "Input custom genres, separated by comma" +msgstr "Kişisel tür ekle, virgülle ayırarak" + +#: tmainform.eddownloadssearch.texthint +#| msgid "Search favorites..." +msgctxt "tmainform.eddownloadssearch.texthint" +msgid "Search downloads..." +msgstr "İndirmeleri ara..." + +#: tmainform.edfavoritessearch.texthint +msgctxt "tmainform.edfavoritessearch.texthint" +msgid "Search favorites..." +msgstr "Favorileri ara..." + +#: tmainform.edfilterartists.texthint +msgctxt "tmainform.edfilterartists.texthint" +msgid "Artist" +msgstr "Çizer" + +#: tmainform.edfilterauthors.texthint +msgctxt "tmainform.edfilterauthors.texthint" +msgid "Author" +msgstr "Yazar" + +#: tmainform.edfiltermangainfochapters.texthint +msgctxt "tmainform.edfiltermangainfochapters.texthint" +msgid "Filter" +msgstr "Filtre" + +#: tmainform.edfiltersummary.texthint +msgid "Part of summary" +msgstr "Özetin bir kısmı" + +#: tmainform.edfiltertitle.texthint +msgctxt "TMAINFORM.EDFILTERTITLE.TEXTHINT" +msgid "Title" +msgstr "Başlık" + +#: tmainform.edmangalistsearch.texthint +msgctxt "tmainform.edmangalistsearch.texthint" +msgid "Search title..." +msgstr "Başlık ara..." + +#: tmainform.edoptionchaptercustomrename.texthint +msgctxt "tmainform.edoptionchaptercustomrename.texthint" +msgid "Custom rename" +msgstr "Kişisel yeniden adlandırma" + +#: tmainform.edoptiondefaultpath.texthint +msgid "Default download path" +msgstr "Varsayılan indirme yolu" + +#: tmainform.edoptionexternalparams.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalparams.texthint" +msgid "External program parameters" +msgstr "Harici program parametreleri" + +#: tmainform.edoptionexternalpath.texthint +#| msgid "External program parameters" +msgctxt "tmainform.edoptionexternalpath.texthint" +msgid "External program path" +msgstr "Harici program yolu" + +#: tmainform.edoptionfilenamecustomrename.texthint +msgctxt "tmainform.edoptionfilenamecustomrename.texthint" +msgid "Custom rename" +msgstr "Kişisel yeniden adlandırma" + +#: tmainform.edoptionhost.texthint +msgid "Proxy host/IP" +msgstr "Vekil sunucu/IP" + +#: tmainform.edoptionmangacustomrename.texthint +msgctxt "tmainform.edoptionmangacustomrename.texthint" +msgid "Custom rename" +msgstr "Kişisel yeniden adlandırma" + +#: tmainform.edoptionpass.texthint +msgid "Proxy password" +msgstr "Vekil şifre" + +#: tmainform.edoptionuser.texthint +msgid "Proxy username" +msgstr "Vekil kullanıcı adı" + +#: tmainform.edsaveto.texthint +msgctxt "TMAINFORM.EDSAVETO.TEXTHINT" +msgid "Save to" +msgstr "Şuraya kaydet" + +#: tmainform.edurl.texthint +msgid "Input URL here" +msgstr "Buraya URL ekle" + +#: tmainform.edwebsitessearch.texthint +#| msgid "Search..." +msgctxt "tmainform.edwebsitessearch.texthint" +msgid "Search website..." +msgstr "Websitesi ara..." + +#: tmainform.gbdialogs.caption +msgid "Show dialog confirmation for" +msgstr "Şunun için doğrulama diyaloğu göster" + +#: tmainform.gbdroptarget.caption +msgid "Drop Box" +msgstr "İndirme kutusu" + +#: tmainform.gbimageconversion.caption +msgid "Image Conversion" +msgstr "Resim Dönüştürme" + +#: tmainform.gboptionexternal.caption +msgid "External program" +msgstr "Harici program" + +#: tmainform.gboptionfavorites.caption +msgctxt "TMAINFORM.GBOPTIONFAVORITES.CAPTION" +msgid "Favorites" +msgstr "Favoriler" + +#: tmainform.gboptionproxy.caption +msgid "Proxy config" +msgstr "Vekil ayarları" + +#: tmainform.gboptionrenaming.caption +msgid "Renaming" +msgstr "Yeniden adlandırma" + +#: tmainform.lbdefaultdownloadpath.caption +msgid "Choose the default download path:" +msgstr "Varsayılan indirme yolunu seç:" + +#: tmainform.lbdroptargetopacity.caption +msgid "Opacity" +msgstr "Şeffaflık" + +#: tmainform.lbfilterartists.caption +msgctxt "tmainform.lbfilterartists.caption" +msgid "Artist" +msgstr "Çizer" + +#: tmainform.lbfilterauthors.caption +msgctxt "tmainform.lbfilterauthors.caption" +msgid "Author" +msgstr "Yazar" + +#: tmainform.lbfiltercustomgenres.caption +msgid "Custom Genres" +msgstr "Kişisel Türler" + +#: tmainform.lbfilterhint.caption +msgctxt "tmainform.lbfilterhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lbfilterhint.hint +msgid "" +"Genres:\n" +"- Checked: Include this genre.\n" +"- Unchecked: Exclude this genre.\n" +"- Grayed: Doesn't matter.\n" +"\n" +"Custom Genres:\n" +"- Separate multiple genres with ','.\n" +"- Exclude a genre by placing '!' or '-' at the beginning of a genre.\n" +"- Example: Adventure,!Ecchi,Comedy.\n" +msgstr "" +"Türler:\n" +"- Seçili: Bu türü dahil et.\n" +"- Seçilmemiş: Bu türü dahil etme.\n" +"- Gri: Farketmez.\n" +"\n" +"Kişisel türler:\n" +"- Birden fazla türü ',' ile ayır.\n" +"- Başına '!' ya da '-' ekleyerek bir türü hariç tutun.\n" +"- Örnek: Macera,!Ecchi,Komedi.\n" + +#: tmainform.lbfilterstatus.caption +msgctxt "TMAINFORM.LBFILTERSTATUS.CAPTION" +msgid "Status" +msgstr "Durum" + +#: tmainform.lbfiltersummary.caption +msgid "Summary" +msgstr "Özet" + +#: tmainform.lbfiltertitle.caption +msgctxt "tmainform.lbfiltertitle.caption" +msgid "Title" +msgstr "Başlık" + +#: tmainform.lbjpegquality.caption +msgid "JPEG quality" +msgstr "JPEG Kalitesi" + +#: tmainform.lblogfilename.caption +msgid "Log file:" +msgstr "Günlük dosyası:" + +#: tmainform.lbmode.caption +msgid "Mode: Show all (0)" +msgstr "Mod: Tümünü göster (0)" + +#: tmainform.lboptionautocheckfavintervalminutes.caption +msgctxt "tmainform.lboptionautocheckfavintervalminutes.caption" +msgid "Auto check for new chapter every %d minutes" +msgstr "Her %d dakikada bir yeni bölüm kontrolü yap" + +#: tmainform.lboptionchaptercustomrename.caption +#| msgid "Chapter folder name:" +msgctxt "tmainform.lboptionchaptercustomrename.caption" +msgid "Chapter name:" +msgstr "Bölüm adı:" + +#: tmainform.lboptionchaptercustomrenamehint.caption +msgctxt "tmainform.lboptionchaptercustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionchaptercustomrenamehint.hint +msgctxt "tmainform.lboptionchaptercustomrenamehint.hint" +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"%NUMBERING% : Numbering\n" +"\n" +"Note:\n" +"Chapter folder name must have at least %CHAPTER% or %NUMBERING%.\n" +msgstr "" +"%WEBSITE% : Website adı\n" +"%MANGA% : Manga başlığı\n" +"%CHAPTER% : Bölüm başlığı\n" +"%AUTHOR% : Yazar\n" +"%ARTIST% : Çizer\n" +"%NUMBERING% : Numaralama\n" +"\n" +"Not:\n" +"Bölüm klasörü en azından %CHAPTER% ya da %NUMBERING% içermelidir.\n" + +#: tmainform.lboptionconnectiontimeout.caption +msgid "Connection timeout (seconds)" +msgstr "Bağlantı zaman aşımı (saniye)" + +#: tmainform.lboptionexternal.caption +msgid "Open manga by using external program:" +msgstr "Mangayı harici program ile aç:" + +#: tmainform.lboptionexternalparams.caption +msgid "Parameters:" +msgstr "Parametreler:" + +#: tmainform.lboptionexternalparamshint.caption +msgctxt "tmainform.lboptionexternalparamshint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrename.caption +msgid "Filename:" +msgstr "Dosya adı:" + +#: tmainform.lboptionfilenamecustomrenamehint.caption +msgctxt "tmainform.lboptionfilenamecustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionfilenamecustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%CHAPTER% : Chapter title\n" +"%FILENAME% : Filename\n" +"\n" +"Note:\n" +"Filename must have at least %FILENAME%\n" +msgstr "" +"%WEBSITE% : Website adı\n" +"%MANGA% : Manga başlığı\n" +"%CHAPTER% : Bölüm başlığı\n" +"%FILENAME% : Dosya adı\n" +"\n" +"Not:\n" +"Dosya adı en azından %FILENAME% içermeldir\n" + +#: tmainform.lboptionhost.caption +msgid "Host" +msgstr "Host" + +#: tmainform.lboptionlanguage.caption +msgid "Language:" +msgstr "Dil:" + +#: tmainform.lboptionletfmddo.caption +msgid "After download finish:" +msgstr "İndirme bittikten sonra:" + +#: tmainform.lboptionmangacustomrename.caption +msgctxt "tmainform.lboptionmangacustomrename.caption" +msgid "Manga folder name:" +msgstr "Manga klasörü adı:" + +#: tmainform.lboptionmangacustomrenamehint.caption +msgctxt "tmainform.lboptionmangacustomrenamehint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionmangacustomrenamehint.hint +msgid "" +"%WEBSITE% : Website name\n" +"%MANGA% : Manga title\n" +"%AUTHOR% : Author\n" +"%ARTIST% : Artist\n" +"\n" +"Note:\n" +"Manga folder name must have at least %MANGA%.\n" +msgstr "" +"%WEBSITE% : Website adı\n" +"%MANGA% : Manga başlığı\n" +"%AUTHOR% : Yazar\n" +"%ARTIST% : Çizer\n" +"\n" +"Not:\n" +"Manga klasörü adı en azından %MANGA% içermelidir.\n" + +#: tmainform.lboptionmaxparallel.caption +msgid "Number of downloaded tasks at the same time" +msgstr "Eşzamanlı indirilen görev sayısı (Maks: 8)" + +#: tmainform.lboptionmaxretry.caption +#| msgid "Number of retry times if tasks have download problems (0 = always retry)" +msgid "Number of retry times if tasks have download problems (-1 = always retry)" +msgstr "İndirmede sorun varsa tekrar deneme sayısı (-1 = sürekli yeniden dene)" + +#: tmainform.lboptionmaxthread.caption +msgid "Number of downloaded files per task at the same time" +msgstr "Tek görev başına aynı anda indirilmiş dosya sayısı (Maks: 32)" + +#: tmainform.lboptionnewmangatime.caption +msgid "New manga based on it's update time (days)" +msgstr "Manga güncelleme süresine göre yeni manga (gün bazlı)" + +#: tmainform.lboptionpass.caption +msgctxt "tmainform.lboptionpass.caption" +msgid "Password" +msgstr "Şifre" + +#: tmainform.lboptionpdfquality.caption +msgid "PDF compression level" +msgstr "PDF sıkıştırma seviyesi" + +#: tmainform.lboptionpdfquality.hint +msgctxt "TMAINFORM.LBOPTIONPDFQUALITY.HINT" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (kayıpsız), düşük = DCTEncode (kayıplı)" + +#: tmainform.lboptionpdfqualityhint.caption +msgctxt "tmainform.lboptionpdfqualityhint.caption" +msgid "[?]" +msgstr "[?]" + +#: tmainform.lboptionport.caption +msgid "Port" +msgstr "Port" + +#: tmainform.lboptionproxytype.caption +msgid "Type" +msgstr "Tip" + +#: tmainform.lboptionrenamedigits.caption +msgid "Rename digits" +msgstr "Yeniden adlandırma basamak sayısı" + +#: tmainform.lboptionretryfailedtask.caption +msgid "Number of retry times if task failed" +msgstr "Görev başarısız olunca yeniden deneme sayısı" + +#: tmainform.lboptionuser.caption +msgctxt "tmainform.lboptionuser.caption" +msgid "Username" +msgstr "Kullanıcı adı" + +#: tmainform.lbpngcompressionlevel.caption +msgctxt "tmainform.lbpngcompressionlevel.caption" +msgid "PNG Compression level" +msgstr "PNG Sıkıştırma seviyesi" + +#: tmainform.lbsaveto.caption +msgid "Save to:" +msgstr "Şuraya kaydet:" + +#: tmainform.lbwebpsaveas.caption +msgid "Save WebP as" +msgstr "WebPyi şöyle kaydet" + +#: tmainform.medturldelete.caption +msgctxt "TMAINFORM.MEDTURLDELETE.CAPTION" +msgid "Delete" +msgstr "Sil" + +#: tmainform.medurlcopy.caption +msgctxt "tmainform.medurlcopy.caption" +msgid "Copy" +msgstr "Kopyala" + +#: tmainform.medurlcut.caption +msgid "Cut" +msgstr "Kes" + +#: tmainform.medurlpaste.caption +msgid "Paste" +msgstr "Yapıştır" + +#: tmainform.medurlpasteandgo.caption +msgid "Paste and go" +msgstr "Yapıştır ve git" + +#: tmainform.medurlselectall.caption +msgid "Select all" +msgstr "Tümünü seç" + +#: tmainform.medurlundo.caption +msgid "Undo" +msgstr "Geri al" + +#: tmainform.miabortsilentthread.caption +msgctxt "tmainform.miabortsilentthread.caption" +msgid "Abort" +msgstr "Durdur" + +#: tmainform.michapterlistascending.caption +msgid "Ascending" +msgstr "Artan" + +#: tmainform.michapterlistcheckall.caption +msgctxt "tmainform.michapterlistcheckall.caption" +msgid "Check all" +msgstr "Tümünü işaretle" + +#: tmainform.michapterlistcheckselected.caption +msgid "Check selected" +msgstr "Seçilileri işaretle" + +#: tmainform.michapterlistdescending.caption +msgid "Descending" +msgstr "Azalan" + +#: tmainform.michapterlistfilter.caption +msgctxt "tmainform.michapterlistfilter.caption" +msgid "Filter" +msgstr "Filtre" + +#: tmainform.michapterlisthidedownloaded.caption +msgid "Hide downloaded chapters" +msgstr "İndirilmiş bölümleri gizle" + +#: tmainform.michapterlisthighlight.caption +#| msgid "Highlight download chapters" +msgid "Highlight downloaded chapters" +msgstr "İndirilmiş bölümleri vurgula" + +#: tmainform.michapterlistuncheckall.caption +msgctxt "tmainform.michapterlistuncheckall.caption" +msgid "Uncheck all" +msgstr "Tüm seçimleri kaldır" + +#: tmainform.michapterlistuncheckselected.caption +msgid "Uncheck selected" +msgstr "Seçilmişin işaretini kaldır" + +#: tmainform.midownloaddelete.caption +msgctxt "tmainform.midownloaddelete.caption" +msgid "Delete" +msgstr "Sil" + +#: tmainform.midownloaddeletecompleted.caption +msgctxt "TMAINFORM.MIDOWNLOADDELETECOMPLETED.CAPTION" +msgid "Delete all completed tasks" +msgstr "Tüm tamamlanmış görevleri sil" + +#: tmainform.midownloaddeletetask.caption +msgid "Task only" +msgstr "Sadece görev" + +#: tmainform.midownloaddeletetaskdata.caption +msgid "Task + Data" +msgstr "Görev + Veri" + +#: tmainform.midownloaddeletetaskdatafavorite.caption +msgid "Task + Data + Favorite" +msgstr "Görev + Veri + Favori" + +#: tmainform.midownloaddisable.caption +msgctxt "tmainform.midownloaddisable.caption" +msgid "Disable" +msgstr "Pasifleştir" + +#: tmainform.midownloadenable.caption +msgctxt "tmainform.midownloadenable.caption" +msgid "Enable" +msgstr "Aktifleştir" + +#: tmainform.midownloadmergecompleted.caption +msgid "Merge completed tasks" +msgstr "Tamamlanmış görevleri birleştir" + +#: tmainform.midownloadopenfolder.caption +msgctxt "tmainform.midownloadopenfolder.caption" +msgid "Open Folder" +msgstr "Klasörü Aç" + +#: tmainform.midownloadopenwith.caption +msgctxt "tmainform.midownloadopenwith.caption" +msgid "Open ..." +msgstr "Aç ..." + +#: tmainform.midownloadresume.caption +msgid "Resume" +msgstr "Devam et" + +#: tmainform.midownloadstop.caption +msgid "Stop" +msgstr "Dur" + +#: tmainform.midownloadviewmangainfo.caption +msgctxt "tmainform.midownloadviewmangainfo.caption" +msgid "View manga info" +msgstr "Manga bilgisini göster" + +#: tmainform.mifavoriteschangecurrentchapter.caption +msgid "Change \"Current chapter\"" +msgstr "Değiştir \"Şu anki bölüm\"" + +#: tmainform.mifavoriteschangesaveto.caption +msgid "Change \"Save to\"" +msgstr "Değiştir \"Şuraya kaydet\"" + +#: tmainform.mifavoriteschecknewchapter.caption +msgctxt "tmainform.mifavoriteschecknewchapter.caption" +msgid "Check for new chapter" +msgstr "Yeni bölüm kontrolü yap" + +#: tmainform.mifavoritesdelete.caption +msgctxt "TMAINFORM.MIFAVORITESDELETE.CAPTION" +msgid "Delete" +msgstr "Sil" + +#: tmainform.mifavoritesdisable.caption +msgctxt "tmainform.mifavoritesdisable.caption" +msgid "Disable" +msgstr "Pasifleştir" + +#: tmainform.mifavoritesdownloadall.caption +msgctxt "tmainform.mifavoritesdownloadall.caption" +msgid "Download all" +msgstr "Tümünü indir" + +#: tmainform.mifavoritesenable.caption +msgctxt "tmainform.mifavoritesenable.caption" +msgid "Enable" +msgstr "Aktifleştir" + +#: tmainform.mifavoritesopenfolder.caption +msgctxt "TMAINFORM.MIFAVORITESOPENFOLDER.CAPTION" +msgid "Open Folder" +msgstr "Klasörü Aç" + +#: tmainform.mifavoritesopenwith.caption +msgctxt "TMAINFORM.MIFAVORITESOPENWITH.CAPTION" +msgid "Open ..." +msgstr "Aç ..." + +#: tmainform.mifavoritesrename.caption +msgid "Rename" +msgstr "Yeniden adlandır" + +#: tmainform.mifavoritesstopchecknewchapter.caption +msgid "Stop check for new chapter" +msgstr "Yeni bölüm aramayı durdur" + +#: tmainform.mifavoritestransferwebsite.caption +msgctxt "tmainform.mifavoritestransferwebsite.caption" +msgid "Transfer website" +msgstr "Website değiştir" + +#: tmainform.mifavoritesviewinfos.caption +msgctxt "TMAINFORM.MIFAVORITESVIEWINFOS.CAPTION" +msgid "View manga info" +msgstr "Manga bilgisini göster" + +#: tmainform.mihighlightnewmanga.caption +msgid "Highlight new manga" +msgstr "Yeni mangayı vurgula" + +#: tmainform.mimangalistaddtofavorites.caption +msgid "Add to Favorites" +msgstr "Favorilere Ekle" + +#: tmainform.mimangalistdelete.caption +msgctxt "tmainform.mimangalistdelete.caption" +msgid "Delete" +msgstr "Sil" + +#: tmainform.mimangalistdownloadall.caption +msgctxt "TMAINFORM.MIMANGALISTDOWNLOADALL.CAPTION" +msgid "Download all" +msgstr "Tümünü indir" + +#: tmainform.mimangalistviewinfos.caption +msgid "View manga infos" +msgstr "Manga bilgilerini göster" + +#: tmainform.mitrayafterdownloadfinish.caption +msgid "After download finish" +msgstr "İndirme bittikten sonra" + +#: tmainform.mitrayexit.caption +msgctxt "tmainform.mitrayexit.caption" +msgid "Exit" +msgstr "Çık" + +#: tmainform.mitrayfinishexit.caption +msgctxt "tmainform.mitrayfinishexit.caption" +msgid "Exit" +msgstr "Çık" + +#: tmainform.mitrayfinishhibernate.caption +msgid "Hibernate" +msgstr "Uyut" + +#: tmainform.mitrayfinishnothing.caption +msgid "Nothing" +msgstr "Hiçbir şey" + +#: tmainform.mitrayfinishshutdown.caption +msgid "Shutdown" +msgstr "Kapat" + +#: tmainform.mitrayrestore.caption +msgid "Restore" +msgstr "Geri getir" + +#: tmainform.mitrayresumeall.caption +msgid "Resume all" +msgstr "Tamamına devam et" + +#: tmainform.mitrayshowdropbox.caption +msgctxt "tmainform.mitrayshowdropbox.caption" +msgid "Show Drop Box" +msgstr "İndirme Kutusunu göster" + +#: tmainform.mitraystopall.caption +msgid "Stop all" +msgstr "Tümünü durdur" + +#: tmainform.mndownload1click.caption +msgid "Download all lists from server at once" +msgstr "Tüm listeleri tek seferde sunucudan indir" + +#: tmainform.mnfiltergenreallcheck.caption +msgctxt "tmainform.mnfiltergenreallcheck.caption" +msgid "Check all" +msgstr "Tümünü seç" + +#: tmainform.mnfiltergenreallindeterminate.caption +msgid "Indeterminate all" +msgstr "Tümünü belirsiz yap" + +#: tmainform.mnfiltergenrealluncheck.caption +msgctxt "tmainform.mnfiltergenrealluncheck.caption" +msgid "Uncheck all" +msgstr "Tüm seçimleri kaldır" + +#: tmainform.mnupdate1click.caption +msgid "Update all lists at once" +msgstr "Tüm listeleri güncelle" + +#: tmainform.mnupdatedownfromserver.caption +msgid "Download manga list from server" +msgstr "Manga listesini sunucudan indir" + +#: tmainform.mnupdatelist.caption +msgctxt "TMAINFORM.MNUPDATELIST.CAPTION" +msgid "Update manga list" +msgstr "Manga listesini güncelle" + +#: tmainform.rball.caption +msgid "Have all genre checked" +msgstr "Tüm türleri seç" + +#: tmainform.rbone.caption +msgid "Have one of genres checked" +msgstr "Türlerden birini seç" + +#: tmainform.rgdroptargetmode.caption +msgid "Mode" +msgstr "Mod" + +#: tmainform.rgoptioncompress.caption +msgid "Save downloaded chapters as" +msgstr "İndirilmiş bölümleri şöyle kaydet" + +#: tmainform.seoptionpdfquality.hint +msgctxt "tmainform.seoptionpdfquality.hint" +msgid "100 = FlateEncode (lossless), lower = DCTEncode (lossy)" +msgstr "100 = FlateEncode (kayıpsız), düşük = DCTEncode (kayıplı)" + +#: tmainform.tbdownloaddeletecompleted.caption +msgctxt "tmainform.tbdownloaddeletecompleted.caption" +msgid "Delete all completed tasks" +msgstr "Tamamlanmış tüm görevleri sil" + +#: tmainform.tbdownloadresumeall.caption +msgid "Resume All" +msgstr "Tümüne Devam Et" + +#: tmainform.tbdownloadstopall.caption +msgid "Stop All" +msgstr "Tümünü Durdur" + +#: tmainform.tbmidownloadmovebottom.hint +msgid "Move selected item(s) to bottom" +msgstr "Seçilen içerik(ler)i en alta taşı" + +#: tmainform.tbmidownloadmovedown.hint +msgid "Move selected item(s) down" +msgstr "Seçilen içerik(ler)i alta taşı" + +#: tmainform.tbmidownloadmovetop.hint +msgid "Move selected item(s) to top" +msgstr "Seçilen içerik(ler)i en üste taşı" + +#: tmainform.tbmidownloadmoveup.hint +msgid "Move selected item(s) up" +msgstr "Seçilen içerik(ler)i üste taşı" + +#: tmainform.tbwebsitescollapseall.caption +msgid "Collapse All" +msgstr "Tümünü Daralt" + +#: tmainform.tbwebsitesexpandall.caption +msgid "Expand All" +msgstr "Tümünü Genişlet" + +#: tmainform.tsabout.caption +msgid "About" +msgstr "Hakkında" + +#: tmainform.tsabouttext.caption +msgid "About FMD" +msgstr "FMD Hakkında" + +#: tmainform.tsaccounts.caption +msgid "Accounts" +msgstr "Hesaplar" + +#: tmainform.tschangelogtext.caption +msgid "Changelog" +msgstr "Değişim kaydı" + +#: tmainform.tsconnections.caption +msgid "Connections" +msgstr "Bağlantılar" + +#: tmainform.tscustomcolor.caption +msgid "Custom color" +msgstr "Kişisel renk" + +#: tmainform.tsdialogs.caption +msgid "Dialogs" +msgstr "İletişim kutuları" + +#: tmainform.tsdownload.caption +msgctxt "tmainform.tsdownload.caption" +msgid "Downloads" +msgstr "İndirmeler" + +#: tmainform.tsfavorites.caption +msgctxt "tmainform.tsfavorites.caption" +msgid "Favorites" +msgstr "Favoriler" + +#: tmainform.tsgeneral.caption +msgid "General" +msgstr "Genel" + +#: tmainform.tsinfofilteradv.caption +msgctxt "tmainform.tsinfofilteradv.caption" +msgid "Filter" +msgstr "Filtre" + +#: tmainform.tsinfomanga.caption +msgid "Info" +msgstr "Bilgi" + +#: tmainform.tsinformation.caption +msgid "Manga Info" +msgstr "Manga Bilgisi" + +#: tmainform.tslog.caption +msgid "Log" +msgstr "Günlük" + +#: tmainform.tsmisc.caption +msgid "Misc" +msgstr "Çeşitli" + +#: tmainform.tsoption.caption +msgctxt "tmainform.tsoption.caption" +msgid "Options" +msgstr "Ayarlar" + +#: tmainform.tssaveto.caption +msgctxt "TMAINFORM.TSSAVETO.CAPTION" +msgid "Save to" +msgstr "Şuraya kaydet" + +#: tmainform.tsupdate.caption +msgid "Updates" +msgstr "Güncellemeler" + +#: tmainform.tsview.caption +msgid "View" +msgstr "Görünüm" + +#: tmainform.tswebsiteadvanced.caption +msgid "Advanced" +msgstr "Gelişmiş" + +#: tmainform.tswebsitemodules.caption +msgid "Modules" +msgstr "Modüller" + +#: tmainform.tswebsiteoptions.caption +msgctxt "tmainform.tswebsiteoptions.caption" +msgid "Options" +msgstr "Ayarlar" + +#: tmainform.tswebsites.caption +msgctxt "tmainform.tswebsites.caption" +msgid "Websites" +msgstr "Websiteler" + +#: tmainform.tswebsiteselection.caption +msgctxt "tmainform.tswebsiteselection.caption" +msgid "Websites" +msgstr "Websiteler" + +#: tmainform.vtdownload.header.columns[0].text +msgid "Manga" +msgstr "Manga" + +#: tmainform.vtdownload.header.columns[1].text +msgctxt "tmainform.vtdownload.header.columns[1].text" +msgid "Status" +msgstr "Durum" + +#: tmainform.vtdownload.header.columns[2].text +msgid "Progress" +msgstr "İlerleme" + +#: tmainform.vtdownload.header.columns[3].text +msgctxt "tmainform.vtdownload.header.columns[3].text" +msgid "Transfer rate" +msgstr "Transfer oranı" + +#: tmainform.vtdownload.header.columns[4].text +msgctxt "tmainform.vtdownload.header.columns[4].text" +msgid "Website" +msgstr "Website" + +#: tmainform.vtdownload.header.columns[5].text +msgctxt "tmainform.vtdownload.header.columns[5].text" +msgid "Save to" +msgstr "Şuraya kaydet" + +#: tmainform.vtdownload.header.columns[6].text +msgctxt "TMAINFORM.VTDOWNLOAD.HEADER.COLUMNS[6].TEXT" +msgid "Added" +msgstr "Eklenme Tarihi" + +#: tmainform.vtfavorites.header.columns[0].text +msgid "#" +msgstr "#" + +#: tmainform.vtfavorites.header.columns[1].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[1].TEXT" +msgid "Title" +msgstr "Başlık" + +#: tmainform.vtfavorites.header.columns[2].text +msgid "Current chapter" +msgstr "Şu anki bölüm" + +#: tmainform.vtfavorites.header.columns[3].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[3].TEXT" +msgid "Website" +msgstr "Website" + +#: tmainform.vtfavorites.header.columns[4].text +msgctxt "TMAINFORM.VTFAVORITES.HEADER.COLUMNS[4].TEXT" +msgid "Save to" +msgstr "Şuraya kaydet" + +#: tnewchapter.btcancel.caption +msgctxt "TNEWCHAPTER.BTCANCEL.CAPTION" +msgid "&Cancel" +msgstr "&İptal" + +#: tnewchapter.btdownload.caption +msgctxt "TNEWCHAPTER.BTDOWNLOAD.CAPTION" +msgid "&Download" +msgstr "&İndir" + +#: tnewchapter.btqueue.caption +msgctxt "TNEWCHAPTER.BTQUEUE.CAPTION" +msgid "&Add to queue" +msgstr "&Sıraya ekle" + +#: tselectdirectoryform.btok.caption +msgctxt "tselectdirectoryform.btok.caption" +msgid "OK" +msgstr "Tamam" + +#: tselectdirectoryform.caption +msgid "Select directory" +msgstr "Yolu seç" + +#: tshutdowncounterform.btabort.caption +msgid "&Abort" +msgstr "&Durdur" + +#: tshutdowncounterform.btnow.caption +msgid "&Now" +msgstr "&Şimdi" + +#: ttransferfavoritesform.btcancel.caption +msgctxt "ttransferfavoritesform.btcancel.caption" +msgid "Cancel" +msgstr "İptal" + +#: ttransferfavoritesform.btok.caption +msgctxt "ttransferfavoritesform.btok.caption" +msgid "OK" +msgstr "Tamam" + +#: ttransferfavoritesform.caption +msgid "Transfer Favorites" +msgstr "Favorileri Transfer Et" + +#: ttransferfavoritesform.ckcleardownloadedchapters.caption +msgid "Clear downloaded chapter list and reload from server" +msgstr "İndirilmiş bölüm listesini temizle ve sunucudan yeniden yükle" + +#: ttransferfavoritesform.lbtransferto.caption +msgctxt "ttransferfavoritesform.lbtransferto.caption" +msgid "Transfer to" +msgstr "Şuraya Transfer Et" + +#: ttransferfavoritesform.rball.caption +msgctxt "ttransferfavoritesform.rball.caption" +msgid "All" +msgstr "Tümü" + +#: ttransferfavoritesform.rbinvalid.caption +msgctxt "ttransferfavoritesform.rbinvalid.caption" +msgid "Invalid" +msgstr "Geçersiz" + +#: ttransferfavoritesform.rbvalid.caption +msgctxt "ttransferfavoritesform.rbvalid.caption" +msgid "Valid" +msgstr "Geçerli" + +#: ttransferfavoritesform.vtfavs.header.columns[1].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[1].text" +msgid "Title" +msgstr "Başlık" + +#: ttransferfavoritesform.vtfavs.header.columns[2].text +msgctxt "ttransferfavoritesform.vtfavs.header.columns[2].text" +msgid "Website" +msgstr "Website" + +#: tupdatedialogform.btnlater.caption +msgid "&Later" +msgstr "&Sonra" + +#: tupdatedialogform.btnupdate.caption +msgid "&Update" +msgstr "&Güncelle" + +#: tupdatedialogform.lbmessage.caption +msgid "" +"New version found! Do you want to update now?\n" +"FMD will be closed to finish the update.\n" +msgstr "" +"Yeni sürüm bulundu! Şimdi güncellemek ister misiniz?\n" +"FMD, güncelleme için kapatılacak.\n" + +#: twebsiteoptionadvancedform.menuitem1.caption +msgctxt "twebsiteoptionadvancedform.menuitem1.caption" +msgid "Add" +msgstr "Ekle" + +#: twebsiteoptionadvancedform.menuitem2.caption +msgctxt "twebsiteoptionadvancedform.menuitem2.caption" +msgid "Edit" +msgstr "Düzenle" + +#: twebsiteoptionadvancedform.menuitem4.caption +msgctxt "twebsiteoptionadvancedform.menuitem4.caption" +msgid "Delete" +msgstr "Sil" + +#: twebsiteoptionadvancedform.tscookies.caption +msgctxt "twebsiteoptionadvancedform.tscookies.caption" +msgid "Cookies" +msgstr "Çerezler" + +#: twebsiteoptionadvancedform.tsdirectorypagenumber.caption +msgid "Directory page number" +msgstr "Dizin sayfa numarası" + +#: twebsiteoptionadvancedform.tsdownloads.caption +msgctxt "twebsiteoptionadvancedform.tsdownloads.caption" +msgid "Downloads" +msgstr "İndirmeler" + +#: twebsiteoptionadvancedform.tsmaxthreadspertask.caption +msgid "Max threads per task" +msgstr "Her bir görev için maksimum iş parçacığı" + +#: twebsiteoptionadvancedform.tsnumberofthreads.caption +msgid "Number of threads" +msgstr "İş parçacığı sayısı" + +#: twebsiteoptionadvancedform.tsupdatelist.caption +msgid "Update List" +msgstr "Listeyi Güncelle" + +#: twebsiteoptionadvancedform.tsuseragent.caption +msgctxt "twebsiteoptionadvancedform.tsuseragent.caption" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[0].text" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtcookies.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtcookies.header.columns[1].text" +msgid "Cookies" +msgstr "Çerezler" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[0].text" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtdownloadmaxthreadspertask.header.columns[1].text" +msgid "Value" +msgstr "Değer" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[0].text" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistdirectorypagenumber.header.columns[1].text" +msgid "Value" +msgstr "Değer" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[0].text" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtupdatelistnumberofthreads.header.columns[1].text" +msgid "Value" +msgstr "Değer" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[0].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[0].text" +msgid "Website" +msgstr "Website" + +#: twebsiteoptionadvancedform.vtuseragent.header.columns[1].text +msgctxt "twebsiteoptionadvancedform.vtuseragent.header.columns[1].text" +msgid "User Agent" +msgstr "User Agent" + +#: twebsiteselectionform.caption +msgid "Select a website" +msgstr "Bir websitesi seç" + +#: twebsitesettingsform.caption +msgid "WebsiteSettingsForm" +msgstr "WebsiteAyarlarıFormu" + +#: twebsitesettingsform.edsearch.texthint +msgid "Website name" +msgstr "Website Adı" + +#: twebsitesettingsform.edsearchproperty.texthint +msgid "Setting name" +msgstr "Ayar ismi" + +#: udownloadsmanager.rs_compressing +msgid "Compressing..." +msgstr "Sıkıştırılıyor..." + +#: udownloadsmanager.rs_disabled +msgid "Disabled" +msgstr "Pasifleştirilmiş" + +#: udownloadsmanager.rs_downloading +msgid "Downloading" +msgstr "İndiriliyor" + +#: udownloadsmanager.rs_failed +msgctxt "udownloadsmanager.rs_failed" +msgid "Failed" +msgstr "Başarısız oldu" + +#: udownloadsmanager.rs_failedtocreatedir +msgid "Failed to create directory!" +msgstr "Dizin oluşturma başarısız oldu!" + +#: udownloadsmanager.rs_failedtryresumetask +msgid "Failed, try resuming this task!" +msgstr "Başarısız, görevi devam ettirmeyi deneyin!" + +#: udownloadsmanager.rs_finish +msgid "Completed" +msgstr "Tamamlandı" + +#: udownloadsmanager.rs_preparing +msgctxt "udownloadsmanager.rs_preparing" +msgid "Preparing" +msgstr "Hazırlanıyor" + +#: udownloadsmanager.rs_stopped +msgid "Stopped" +msgstr "Durduruldu" + +#: udownloadsmanager.rs_waiting +msgid "Waiting..." +msgstr "Bekliyor..." + +#: ufavoritesmanager.rs_btnaddtoqueue +msgctxt "ufavoritesmanager.rs_btnaddtoqueue" +msgid "&Add to queue" +msgstr "&Sıraya ekle" + +#: ufavoritesmanager.rs_btncancel +msgctxt "ufavoritesmanager.rs_btncancel" +msgid "&Cancel" +msgstr "&İptal Et" + +#: ufavoritesmanager.rs_btncheckfavorites +msgctxt "ufavoritesmanager.rs_btncheckfavorites" +msgid "Check for new chapter" +msgstr "Yeni bölüme bak" + +#: ufavoritesmanager.rs_btndownload +msgctxt "ufavoritesmanager.rs_btndownload" +msgid "&Download" +msgstr "&İndir" + +#: ufavoritesmanager.rs_btnremove +msgid "&Remove" +msgstr "&Kaldır" + +#: ufavoritesmanager.rs_dlgcompletedmangacaption +msgid "Found %d completed manga" +msgstr "%d tamamlanmış manga bulundu" + +#: ufavoritesmanager.rs_dlgfavoritescheckisrunning +msgid "Favorites check is running!" +msgstr "Favorilerin kontrolü devam ediyor!" + +#: ufavoritesmanager.rs_dlgnewchaptercaption +msgid "%d manga(s) have new chapter(s)" +msgstr "%d manganın yeni bölümü var" + +#: ufavoritesmanager.rs_favoritehasnewchapter +msgid "%s <%s> has %d new chapter(s)." +msgstr "%s <%s> %d yeni bölümü var." + +#: ufavoritesmanager.rs_lblmangawillberemoved +msgid "Completed manga will be removed:" +msgstr "Tamamlanmış manga kaldırılacak:" + +#: ufavoritesmanager.rs_lblnewchapterfound +msgid "Found %d new chapter from %d manga(s):" +msgstr "%d yeni bölüm bulundu %d mangadan:" + +#: usilentthread.rs_silentthreadloadstatus +msgid "Loading: %d/%d" +msgstr "Yükleniyor: %d/%d" + +#: usubthread.rs_btncheckupdates +msgctxt "usubthread.rs_btncheckupdates" +msgid "Check for new version" +msgstr "Yeni sürümü kontrol et" + +#: usubthread.rs_currentversion +msgid "Installed Version" +msgstr "İndirilmiş Sürüm" + +#: usubthread.rs_latestversion +msgid "Latest Version " +msgstr "Son Sürüm " + +#: usubthread.rs_newversionfound +msgid "New Version found!" +msgstr "Yeni Sürüm bulundu!" + +#: uupdatethread.rs_dlghasnewmanga +msgid "%s has %d new manga(s)" +msgstr "%s için %d yeni manga bulundu" + +#: uupdatethread.rs_gettingdirectory +msgid "Getting directory" +msgstr "Dizin alınıyor" + +#: uupdatethread.rs_gettinginfo +msgid "Getting info" +msgstr "Bilgi alınıyor" + +#: uupdatethread.rs_gettinglistfor +msgid "Getting list for" +msgstr "Şunun için liste alınıyor" + +#: uupdatethread.rs_indexingnewtitle +msgid "Indexing new title(s)" +msgstr "Yeni başlık(lar) indeksleniyor" + +#: uupdatethread.rs_lookingfornewtitle +msgid "Looking for new title(s)" +msgstr "Yeni başlık(lar) aranıyor" + +#: uupdatethread.rs_lookingfornewtitlefromanotherdirectory +msgid "Looking for new title(s) from another directory" +msgstr "Başka bir dizinden yeni başlık(lar) aranıyor" + +#: uupdatethread.rs_preparing +msgctxt "uupdatethread.rs_preparing" +msgid "Preparing" +msgstr "Hazırlanıyor" + +#: uupdatethread.rs_removingduplicatefromcurrentdata +msgid "Removing duplicate from current data" +msgstr "Şu anki veriden çiftler kaldırılıyor" + +#: uupdatethread.rs_removingduplicatefromlocaldata +msgid "Removing duplicate from local data" +msgstr "Yerel veriden çiftler kaldırılıyor" + +#: uupdatethread.rs_removingduplicatefromnewtitle +msgid "Removing duplicate from new title(s)" +msgstr "Başlıktan çiftler kaldırılıyor" + +#: uupdatethread.rs_savingdata +msgid "Saving data" +msgstr "Veri kaydediliyor" + +#: uupdatethread.rs_synchronizingdata +msgid "Synchronizing data" +msgstr "Veri eşitleniyor" + +#: uupdatethread.rs_updatinglist +msgid "Updating list" +msgstr "Liste güncelleniyor" + diff --git a/mangadownloader/md.lpi b/mangadownloader/md.lpi index 42c6d6e05..20b87d1f5 100644 --- a/mangadownloader/md.lpi +++ b/mangadownloader/md.lpi @@ -1,14 +1,18 @@ - + + <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> <Icon Value="0"/> </General> <i18n> @@ -18,15 +22,11 @@ <VersionInfo> <UseVersionInfo Value="True"/> <MinorVersionNr Value="9"/> - <RevisionNr Value="18"/> - <BuildNr Value="2"/> + <RevisionNr Value="158"/> <Attributes pvaPrivateBuild="True"/> - <StringTable Comments="Unofficial Build" FileDescription="Free Manga Downloader" LegalCopyright="©2015 FMD Project Team" OriginalFilename="fmd.exe" ProductName="Free Manga Downloader" ProductVersion="$BuildMode()" PrivateBuild="Cholif"/> + <StringTable Comments="https://github.com/riderkick/FMD" FileDescription="Free Manga Downloader" LegalCopyright="©2015-2018" OriginalFilename="fmd.exe" ProductName="Free Manga Downloader" ProductVersion="$BuildMode()" PrivateBuild="riderkick"/> </VersionInfo> - <MacroValues Count="1"> - <Macro1 Name="LCLWidgetType" Value="win32"/> - </MacroValues> - <BuildModes Count="5"> + <BuildModes Count="6"> <Item1 Name="Win32" Default="True"/> <Item2 Name="Win64"> <CompilerOptions> @@ -36,9 +36,7 @@ <Filename Value="..\bin\fmd"/> </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir);..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\baseunits\includes\Batoto;..\baseunits\includes\AnimeA;..\baseunits\includes\MangaHere;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\BlogTruyen;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EatManga;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Fakku;..\baseunits\includes\Hentai2Read;..\baseunits\includes\HugeManga;..\baseunits\includes\Kivmanga;..\baseunits\includes\Komikid;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\Mabuns;..\baseunits\includes\Manga24h;..\baseunits\includes\MangaAe;..\baseunits\includes\MangaAr;..\baseunits\includes\Mangacan;..\baseunits\includes\Mangacow;..\baseunits\includes\MangaEden;..\baseunits\includes\MangaEsta;..\baseunits\includes\MangaFox;..\baseunits\includes\MangaFrame;..\baseunits\includes\MangaGo;..\baseunits\includes\MangaInn;..\baseunits\includes\MangaPanda;..\baseunits\includes\MangaPark;..\baseunits\includes\MangaReader;..\baseunits\includes\MangaStream;..\baseunits\includes\MangaTraders;..\baseunits\includes\MangaVadisi;..\baseunits\includes\PecintaKomik;..\baseunits\includes\Pururin;..\baseunits\includes\RedHawkScans;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\SenManga;..\baseunits\includes\Starkana;..\baseunits\includes\SubManga;..\baseunits\includes\TruyenTranhTuan;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\includes\MangaStreamTo;..\baseunits\includes\EHentai"/> - <Libraries Value="..\3rd\Imaging\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits;..\baseunits\animatedgifs;..\baseunits\fasthtmlparser;..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\3rd\Imaging\Extras\Extensions;..\baseunits\SimpleException;forms"/> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> @@ -46,9 +44,10 @@ <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="4"/> <VariablesInRegisters Value="True"/> </Optimizations> + <SmallerCode Value="True"/> </CodeGeneration> <Linking> <Debugging> @@ -64,12 +63,6 @@ </Win32> </Options> </Linking> - <Other> - <CustomOptions Value="-dMANGADOWNLOADER --dDOWNLOADER --dSELFUPDATE --dRELEASEWIN64"/> - </Other> </CompilerOptions> </Item2> <Item3 Name="Win32 Debug"> @@ -80,15 +73,17 @@ <Filename Value="..\bin\fmd"/> </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir);..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\baseunits\includes\Batoto;..\baseunits\includes\AnimeA;..\baseunits\includes\MangaHere;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\BlogTruyen;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EatManga;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Fakku;..\baseunits\includes\Hentai2Read;..\baseunits\includes\HugeManga;..\baseunits\includes\Kivmanga;..\baseunits\includes\Komikid;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\Mabuns;..\baseunits\includes\Manga24h;..\baseunits\includes\MangaAe;..\baseunits\includes\MangaAr;..\baseunits\includes\Mangacan;..\baseunits\includes\Mangacow;..\baseunits\includes\MangaEden;..\baseunits\includes\MangaEsta;..\baseunits\includes\MangaFox;..\baseunits\includes\MangaFrame;..\baseunits\includes\MangaGo;..\baseunits\includes\MangaInn;..\baseunits\includes\MangaPanda;..\baseunits\includes\MangaPark;..\baseunits\includes\MangaReader;..\baseunits\includes\MangaStream;..\baseunits\includes\MangaTraders;..\baseunits\includes\MangaVadisi;..\baseunits\includes\PecintaKomik;..\baseunits\includes\Pururin;..\baseunits\includes\RedHawkScans;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\SenManga;..\baseunits\includes\Starkana;..\baseunits\includes\SubManga;..\baseunits\includes\TruyenTranhTuan;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\includes\MangaStreamTo;..\baseunits\includes\EHentai"/> - <Libraries Value="..\3rd\Imaging\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits;..\baseunits\animatedgifs;..\baseunits\fasthtmlparser;..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\3rd\Imaging\Extras\Extensions;..\baseunits\SimpleException;forms"/> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> - <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> @@ -112,10 +107,6 @@ <CompilerMessages> <IgnoredMessages idx4079="True"/> </CompilerMessages> - <CustomOptions Value="-dMANGADOWNLOADER --dDOWNLOADER --dSELFUPDATE --dDEBUGWIN32"/> </Other> </CompilerOptions> </Item3> @@ -127,15 +118,17 @@ <Filename Value="..\bin\fmd"/> </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir);..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\baseunits\includes\Batoto;..\baseunits\includes\AnimeA;..\baseunits\includes\MangaHere;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\BlogTruyen;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EatManga;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Fakku;..\baseunits\includes\Hentai2Read;..\baseunits\includes\HugeManga;..\baseunits\includes\Kivmanga;..\baseunits\includes\Komikid;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\Mabuns;..\baseunits\includes\Manga24h;..\baseunits\includes\MangaAe;..\baseunits\includes\MangaAr;..\baseunits\includes\Mangacan;..\baseunits\includes\Mangacow;..\baseunits\includes\MangaEden;..\baseunits\includes\MangaEsta;..\baseunits\includes\MangaFox;..\baseunits\includes\MangaFrame;..\baseunits\includes\MangaGo;..\baseunits\includes\MangaInn;..\baseunits\includes\MangaPanda;..\baseunits\includes\MangaPark;..\baseunits\includes\MangaReader;..\baseunits\includes\MangaStream;..\baseunits\includes\MangaTraders;..\baseunits\includes\MangaVadisi;..\baseunits\includes\PecintaKomik;..\baseunits\includes\Pururin;..\baseunits\includes\RedHawkScans;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\SenManga;..\baseunits\includes\Starkana;..\baseunits\includes\SubManga;..\baseunits\includes\TruyenTranhTuan;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\includes\MangaStreamTo;..\baseunits\includes\EHentai"/> - <Libraries Value="..\3rd\Imaging\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits;..\baseunits\animatedgifs;..\baseunits\fasthtmlparser;..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\3rd\Imaging\Extras\Extensions;..\baseunits\SimpleException;forms"/> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> - <RangeChecks Value="True"/> <OverflowChecks Value="True"/> <StackChecks Value="True"/> </Checks> @@ -155,12 +148,6 @@ </Win32> </Options> </Linking> - <Other> - <CustomOptions Value="-dMANGADOWNLOADER --dDOWNLOADER --dSELFUPDATE --dDEBUGWIN64"/> - </Other> </CompilerOptions> </Item4> <Item5 Name="Win32 Debug Leaks"> @@ -171,11 +158,15 @@ <Filename Value="..\bin\fmd"/> </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir);..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\baseunits\includes\Batoto;..\baseunits\includes\AnimeA;..\baseunits\includes\MangaHere;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\BlogTruyen;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EatManga;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Fakku;..\baseunits\includes\Hentai2Read;..\baseunits\includes\HugeManga;..\baseunits\includes\Kivmanga;..\baseunits\includes\Komikid;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\Mabuns;..\baseunits\includes\Manga24h;..\baseunits\includes\MangaAe;..\baseunits\includes\MangaAr;..\baseunits\includes\Mangacan;..\baseunits\includes\Mangacow;..\baseunits\includes\MangaEden;..\baseunits\includes\MangaEsta;..\baseunits\includes\MangaFox;..\baseunits\includes\MangaFrame;..\baseunits\includes\MangaGo;..\baseunits\includes\MangaInn;..\baseunits\includes\MangaPanda;..\baseunits\includes\MangaPark;..\baseunits\includes\MangaReader;..\baseunits\includes\MangaStream;..\baseunits\includes\MangaTraders;..\baseunits\includes\MangaVadisi;..\baseunits\includes\PecintaKomik;..\baseunits\includes\Pururin;..\baseunits\includes\RedHawkScans;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\SenManga;..\baseunits\includes\Starkana;..\baseunits\includes\SubManga;..\baseunits\includes\TruyenTranhTuan;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\includes\MangaStreamTo;..\baseunits\includes\EHentai"/> - <Libraries Value="..\3rd\Imaging\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits;..\baseunits\animatedgifs;..\baseunits\fasthtmlparser;..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\3rd\Imaging\Extras\Extensions;..\baseunits\SimpleException;forms"/> + <IncludeFiles Value="$(ProjOutDir);..\baseunits\includes\AnimeA;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Kivmanga;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\MangaAr;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\Starkana;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\lua"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\animatedgifs;..\baseunits\SimpleException;..\baseunits\modules;..\baseunits\extras;..\baseunits\lua;forms"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> <CodeGeneration> <Checks> <IOChecks Value="True"/> @@ -191,6 +182,7 @@ </CodeGeneration> <Linking> <Debugging> + <UseHeaptrc Value="True"/> <UseExternalDbgSyms Value="True"/> </Debugging> <Options> @@ -200,21 +192,71 @@ </Options> </Linking> <Other> - <CustomOptions Value="-dMANGADOWNLOADER --dDOWNLOADER --dSELFUPDATE --dLOGACTIVE --dDEBUGWIN32 --dDEBUGLEAKS"/> <ExecuteAfter> <Command Value="cmd.exe /c copy /y languages\*.po ..\bin\languages\"/> </ExecuteAfter> </Other> </CompilerOptions> </Item5> - <SharedMatrixOptions Count="2"> - <Item1 ID="004106748078" Modes="Win32" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/> - <Item2 ID="255873403449" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/> + <Item6 Name="Win64 Debug Leaks"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\fmd"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);..\baseunits\includes\AnimeA;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Kivmanga;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\MangaAr;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\Starkana;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\lua"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\animatedgifs;..\baseunits\SimpleException;..\baseunits\modules;..\baseunits\extras;..\baseunits\lua;forms"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + <TargetCPU Value="x86_64"/> + <TargetOS Value="win64"/> + <Optimizations> + <VariablesInRegisters Value="True"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <UseHeaptrc Value="True"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <ExecuteAfter> + <Command Value="cmd.exe /c copy /y languages\*.po ..\bin\languages\"/> + </ExecuteAfter> + </Other> + </CompilerOptions> + </Item6> + <SharedMatrixOptions Count="10"> + <Item1 ID="285210846225" Targets="#project" Modes="Win32 Debug Leaks,Win64 Debug Leaks,Win64 Debug,Win32 Debug,Win64,Win32" Value="-Fu..\baseunits -Fu..\baseunits\animatedgifs -Fu..\baseunits\SimpleException -Fu..\baseunits\modules -Fu..\baseunits\extras -Fuforms"/> + <Item2 ID="787838556410" Targets="#project" Modes="Win32 Debug Leaks,Win64 Debug Leaks,Win64 Debug,Win32 Debug,Win32,Win64" Value="-Fi..\baseunits\includes\AnimeA -Fi..\baseunits\includes\AnimeStory -Fi..\baseunits\includes\AnimExtremist -Fi..\baseunits\includes\CentralDeMangas -Fi..\baseunits\includes\EGScans -Fi..\baseunits\includes\EsMangaHere -Fi..\baseunits\includes\Kivmanga -Fi..\baseunits\includes\LectureEnLigne -Fi..\baseunits\includes\MangaAr -Fi..\baseunits\includes\S2scans -Fi..\baseunits\includes\ScanManga -Fi..\baseunits\includes\Starkana -Fi..\baseunits\includes\Turkcraft -Fi..\baseunits\includes\VnSharing -Fi..\baseunits\includes\MeinManga -Fi..\baseunits\includes\MangaREADER_POR -Fi..\baseunits\includes\MangasPROJECT"/> + <Item3 ID="465017374973" Targets="#project" Modes="Win32,Win64 Debug Leaks,Win32 Debug Leaks,Win64 Debug,Win32 Debug,Win64" Value="-dMANGADOWNLOADER -dDOWNLOADER -dSELFUPDATE -dMULTILOG"/> + <Item4 ID="729045573668" Targets="#project" Modes="Win32 Debug Leaks,Win64 Debug Leaks,Win32,Win64,Win32 Debug,Win64 Debug" Value="-Fu..\baseunits\lua -Fu..\baseunits\pcre"/> + <Item5 ID="534084266787" Targets="#project" Modes="Win64 Debug Leaks,Win32 Debug Leaks" Value="-dDEBUGLEAKS -dDEVBUILD -WC"/> + <Item6 ID="951904047630" Targets="#project" Value="-uUSE_FLRE_WITH_CACHE -dUSE_SOROKINS_REGEX -uUSE_BBFLRE_UNICODE -dUSE_BBFULL_UNICODE"/> + <Item7 ID="140379931701" Targets="#project" Value="-Fi..\3rd\BESEN\src -Fi..\3rd\internettools\data -Fu..\3rd\BESEN\src -Fu..\3rd\internettools\data -Fu..\3rd\internettools\internet -Fu..\3rd\internettools\system -Fu..\3rd\internettools\import\flre\src"/> + <Item8 ID="403646715137" Targets="BESENPkg,internettools" Modes="Win32 Debug Leaks,Win64 Debug Leaks,Win64 Debug,Win32 Debug,Win32,Win64" Value="-CX -O3 -Xs -XX -g- -Os"/> + <Item9 ID="127282585717" Targets="internettools" Modes="Win32,Win64,Win32 Debug,Win64 Debug,Win64 Debug Leaks,Win32 Debug Leaks" Value="-uUSE_FLRE_WITH_CACHE -dUSE_SOROKINS_REGEX -uUSE_BBFLRE_UNICODE -dUSE_BBFULL_UNICODE"/> + <Item10 ID="939088584661" Targets="LazControls,TAChartLazarusPkg" Modes="Win64 Debug,Win32 Debug,Win64,Win32,Win32 Debug Leaks,Win64 Debug Leaks" Value="-CX -O3 -Xs -XX -g- -Os"/> </SharedMatrixOptions> </BuildModes> <PublishOptions> @@ -229,21 +271,40 @@ <FormatVersion Value="1"/> </local> </RunParams> - <RequiredPackages Count="4"> + <RequiredPackages Count="10"> <Item1> - <PackageName Value="TAChartLazarusPkg"/> + <PackageName Value="RunTimeTypeInfoControls"/> </Item1> <Item2> - <PackageName Value="richmemopackage"/> + <PackageName Value="LazControls"/> </Item2> <Item3> - <PackageName Value="virtualtreeview_package"/> + <PackageName Value="LCL"/> </Item3> <Item4> - <PackageName Value="LCL"/> + <PackageName Value="TAChartLazarusPkg"/> </Item4> + <Item5> + <PackageName Value="richmemopackage"/> + </Item5> + <Item6> + <PackageName Value="virtualtreeview_package"/> + </Item6> + <Item7> + <PackageName Value="multiloglaz"/> + </Item7> + <Item8> + <PackageName Value="laz_synapse"/> + </Item8> + <Item9> + <PackageName Value="dcpcrypt"/> + </Item9> + <Item10> + <PackageName Value="internettools"/> + <DefaultFilename Value="..\3rd\internettools\internettools.lpk" Prefer="True"/> + </Item10> </RequiredPackages> - <Units Count="19"> + <Units Count="18"> <Unit0> <Filename Value="md.lpr"/> <IsPartOfProject Value="True"/> @@ -291,53 +352,75 @@ <ResourceBaseClass Value="Form"/> </Unit6> <Unit7> - <Filename Value="..\baseunits\uDownloadsManager.pas"/> + <Filename Value="forms\frmAccountManager.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="AccountManagerForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit7> <Unit8> - <Filename Value="..\baseunits\uFavoritesManager.pas"/> + <Filename Value="forms\frmAccountSet.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="AccountSetForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit8> <Unit9> - <Filename Value="..\baseunits\uUpdateThread.pas"/> + <Filename Value="forms\frmWebsiteSelection.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="WebsiteSelectionForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit9> <Unit10> - <Filename Value="..\baseunits\uSubThread.pas"/> + <Filename Value="forms\frmCustomColor.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="CustomColorForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit10> <Unit11> - <Filename Value="..\baseunits\uUpdateDBThread.pas"/> + <Filename Value="forms\frmLogger.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="FormLogger"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit11> <Unit12> - <Filename Value="..\baseunits\uSilentThread.pas"/> + <Filename Value="forms\frmSelectDirectory.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="SelectDirectoryForm"/> + <ResourceBaseClass Value="Form"/> </Unit12> <Unit13> - <Filename Value="..\baseunits\uFMDThread.pas"/> + <Filename Value="forms\frmTransferFavorites.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="TransferFavoritesForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit13> <Unit14> - <Filename Value="..\baseunits\uPacker.pas"/> + <Filename Value="forms\frmLuaModulesUpdater.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="LuaModulesUpdaterForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit14> <Unit15> - <Filename Value="..\baseunits\uGetMangaInfosThread.pas"/> + <Filename Value="..\baseunits\DBUpdater.pas"/> <IsPartOfProject Value="True"/> </Unit15> <Unit16> - <Filename Value="..\baseunits\uBaseUnit.pas"/> + <Filename Value="..\baseunits\SelfUpdater.pas"/> <IsPartOfProject Value="True"/> </Unit16> <Unit17> - <Filename Value="..\baseunits\uData.pas"/> + <Filename Value="forms\frmWebsiteSettings.pas"/> <IsPartOfProject Value="True"/> + <ComponentName Value="WebsiteSettingsForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> </Unit17> - <Unit18> - <Filename Value="..\baseunits\uMisc.pas"/> - <IsPartOfProject Value="True"/> - </Unit18> </Units> </ProjectOptions> <CompilerOptions> @@ -347,9 +430,7 @@ <Filename Value="..\bin\fmd"/> </Target> <SearchPaths> - <IncludeFiles Value="$(ProjOutDir);..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\baseunits\includes\Batoto;..\baseunits\includes\AnimeA;..\baseunits\includes\MangaHere;..\baseunits\includes\AnimeStory;..\baseunits\includes\AnimExtremist;..\baseunits\includes\BlogTruyen;..\baseunits\includes\CentralDeMangas;..\baseunits\includes\EatManga;..\baseunits\includes\EGScans;..\baseunits\includes\EsMangaHere;..\baseunits\includes\Fakku;..\baseunits\includes\Hentai2Read;..\baseunits\includes\HugeManga;..\baseunits\includes\Kivmanga;..\baseunits\includes\Komikid;..\baseunits\includes\LectureEnLigne;..\baseunits\includes\Mabuns;..\baseunits\includes\Manga24h;..\baseunits\includes\MangaAe;..\baseunits\includes\MangaAr;..\baseunits\includes\Mangacan;..\baseunits\includes\Mangacow;..\baseunits\includes\MangaEden;..\baseunits\includes\MangaEsta;..\baseunits\includes\MangaFox;..\baseunits\includes\MangaFrame;..\baseunits\includes\MangaGo;..\baseunits\includes\MangaInn;..\baseunits\includes\MangaPanda;..\baseunits\includes\MangaPark;..\baseunits\includes\MangaReader;..\baseunits\includes\MangaStream;..\baseunits\includes\MangaTraders;..\baseunits\includes\MangaVadisi;..\baseunits\includes\PecintaKomik;..\baseunits\includes\Pururin;..\baseunits\includes\RedHawkScans;..\baseunits\includes\S2scans;..\baseunits\includes\ScanManga;..\baseunits\includes\SenManga;..\baseunits\includes\Starkana;..\baseunits\includes\SubManga;..\baseunits\includes\TruyenTranhTuan;..\baseunits\includes\Turkcraft;..\baseunits\includes\VnSharing;..\baseunits\includes\MeinManga;..\baseunits\includes\MangaREADER_POR;..\baseunits\includes\MangasPROJECT;..\baseunits\includes\MangaStreamTo;..\baseunits\includes\EHentai"/> - <Libraries Value="..\3rd\Imaging\Extras\Extensions\J2KObjects"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits;..\baseunits\animatedgifs;..\baseunits\fasthtmlparser;..\3rd\Imaging\Source;..\3rd\Imaging\Source\ZLib;..\3rd\Imaging\Source\JpegLib;..\3rd\Imaging\Extras\Extensions;..\baseunits\SimpleException;forms"/> + <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> @@ -357,9 +438,10 @@ <TargetCPU Value="i386"/> <TargetOS Value="win32"/> <Optimizations> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="4"/> <VariablesInRegisters Value="True"/> </Optimizations> + <SmallerCode Value="True"/> </CodeGeneration> <Linking> <Debugging> @@ -379,10 +461,6 @@ <CompilerMessages> <IgnoredMessages idx5028="True"/> </CompilerMessages> - <CustomOptions Value="-dMANGADOWNLOADER --dDOWNLOADER --dSELFUPDATE --dRELEASEWIN32"/> </Other> </CompilerOptions> <Debugging> diff --git a/mangadownloader/md.lpr b/mangadownloader/md.lpr index 2da98d4ff..e7f1cb7ee 100644 --- a/mangadownloader/md.lpr +++ b/mangadownloader/md.lpr @@ -5,32 +5,37 @@ {$DEFINE MANGADOWNLOADER} uses - {$IFDEF DEBUGLEAKS} - heaptrc, SysUtils, - {$ENDIF} - {$DEFINE UseCThreads} - {$IFDEF UNIX} - {$IFDEF UseCThreads} - cthreads, - {$ENDIF} - {$ENDIF} - Forms, Interfaces, FileUtil, tachartlazaruspkg, simpleipc, IniFiles, - uBaseUnit, frmMain; + {$IFDEF UNIX} {$IFDEF UseCThreads} + cthreads, + {$ENDIF} {$ENDIF} + {$ifdef windows} + windows, + {$endif} + Interfaces, // this includes the LCL widgetset + Forms, LazFileUtils, IniFiles, simpleipc, sqlite3dyn, FMDOptions, uBaseUnit, FMDVars, webp, + LuaWebsiteModules, SimpleException, Classes, sysutils, frmMain, MultiLog, + FileChannel, ssl_openssl_lib; var CheckInstance: Boolean = True; AllowedToRun: Boolean = True; + EnableLogging: Boolean = False; + LogFileName: String = ''; + s: TStringList; + {$IFDEF DEBUGLEAKS} + trcfile: String; + {$ENDIF DEBUGLEAKS} + i: Integer; + p: String; + + {$ifdef windows} + evpathlen: Integer; + evpath: String; + {$endif} {$R *.res} begin - with TIniFile.Create(CorrectFilePath(GetCurrentDirUTF8) + CONFIG_FOLDER + CONFIG_FILE) do - try - CheckInstance := ReadBool('general', 'OneInstanceOnly', True); - finally - Free; - end; - if CheckInstance then begin with TSimpleIPCClient.Create(nil) do @@ -49,13 +54,72 @@ if AllowedToRun then begin + {$ifdef windows} + // set environment variables + evpathlen:=windows.GetEnvironmentVariable('PATH',nil,0); + setlength(evpath,evpathlen-1); + windows.GetEnvironmentVariable('PATH',pchar(evpath),evpathlen); + evpath:=FMD_DIRECTORY+';'+evpath; + windows.SetEnvironmentVariable('PATH',pchar(evpath)); + {$endif} + + for i := 1 to ParamCount do + begin + p := AnsiLowerCase(ParamStr(i)); + if p = '--lua-dofile' then + LuaWebsiteModules.AlwaysLoadLuaFromFile := True; + end; + + Application.Scaled := True; + with TIniFile.Create(CONFIG_FILE) do + try + CheckInstance := ReadBool('general', 'OneInstanceOnly', True); + EnableLogging := ReadBool('logger', 'Enabled', False); + if EnableLogging then + LogFileName := ExpandFileNameUTF8(ReadString('logger', 'LogFileName', DEFAULT_LOG_FILE), FMD_DIRECTORY); + finally + Free; + end; + + Logger.ThreadSafe := True; + {$IFDEF DEBUGLEAKS} - if FileExists(ChangeFileExt(Application.ExeName, '.trc')) then - DeleteFile(ChangeFileExt(Application.ExeName, '.trc')); - SetHeapTraceOutput(ChangeFileExt(Application.ExeName, '.trc')); + trcfile := FMD_DIRECTORY + FMD_EXENAME + '.trc'; + if FileExistsUTF8(trcfile) then + DeleteFileUTF8(trcfile); + SetHeapTraceOutput(trcfile); {$ENDIF DEBUGLEAKS} Application.Title := 'Free Manga Downloader'; RequireDerivedFormResource := True; + Logger.Enabled := False; + InitSimpleExceptionHandler(LogFileName); + if EnableLogging then + begin + Logger.Enabled := True; + if MainExceptionHandler.LogFileOK then + begin + FileLogger := TFileChannel.Create(LogFileName, [fcoShowHeader, fcoShowPrefix, fcoShowTime]); + Logger.Channels.Add(FileLogger); + Logger.Send(QuotedStrd(Application.Title)+' started with [PID:'+IntToStr(GetProcessID)+'] [HANDLE:'+IntToStr(GetCurrentProcess)+']'); + end; + s := TStringList.Create; + try + s.AddText(SimpleException.GetApplicationInfo); + Logger.Send('Application info', s); + finally + s.Free; + end; + end; + + if FileExists(FMD_DIRECTORY + Sqlite3Lib) then + SQLiteDefaultLibrary := FMD_DIRECTORY + Sqlite3Lib; + if FileExists(FMD_DIRECTORY + DLLSSLName) then + DLLSSLName := FMD_DIRECTORY + DLLSSLName; + if FileExists(FMD_DIRECTORY + DLLUtilName) then + DLLUtilName := FMD_DIRECTORY + DLLUtilName; + if FileExists(FMD_DIRECTORY + DLLWebPName) then + DLLWebPName := FMD_DIRECTORY + DLLWebPName; + Application.Initialize; Application.CreateForm(TMainForm, MainForm); Application.Run; diff --git a/readme.txt b/readme.txt deleted file mode 100644 index 835adad88..000000000 --- a/readme.txt +++ /dev/null @@ -1,37 +0,0 @@ -FMD -The Free Manga Downloader. - ---------------------------------- - -Content: - 1.) About FMD - 2.) Build instructions - 3.) Localization - ---------------------------------- - -FMD homesite is at http://sourceforge.net/projects/fmd/ or http://akarink.wordpress.com - ---------------------------------- - -1.) About FMD - -The Free Manga Downloader is a free open source application written in Object Pascal for managing and downloading manga from various websites. The source code was released under the GPLv2 license. - -2.) Build instructions - -In order to build FMD from the source code, you must install Lazarus latest version and Free Pascal Compiler v2.6.4. Then you must install the following 3rd party libraries and components: - - RichMemo. - - Virtual TreeView. - - Synapse. - - Vampyre Imaging Library. - -After everything is installed, open the file md.lpi by using Lazarus IDE, select Run->Build to build the source code. If everything is ok, the binary file should be in FMD_source_code_folder/bin - -3.) Localization - -Translations are stored inside "languages" folder with .po extension. In order to translate FMD to your native languages you can copy "fmd.po" and rename it to "fmd.xx.po", where xx stand for two-letter language code. Additionally you can add country code at the end of language code. For reference you can look at http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes and http://en.wikipedia.org/wiki/ISO_3166-1. For example "id_ID" will be recognized as "Bahasa Indonesia (Indonesia)". To translate the content of the file you need to use translation tools like Poedit. Once you have finished translating all of its content you can launch FMD and it will automatically detect your new languages upon startup. - ---------------------------------- - -Last update 25-05-2015 diff --git a/update b/update index 6835a1a4b..e4f0f2460 100644 --- a/update +++ b/update @@ -1,8 +1,5 @@ -0.9.8.1 -https://github.com/riderkick/FMD/releases/download/0.9.8.1/fmd_0.9.8.1.7z - -## update info above was deprecated - -VERSION=0.9.18.2 -WIN32=https://github.com/riderkick/FMD/releases/download/0.9.18.2/fmd_0.9.18.2.7z -WIN64=https://github.com/riderkick/FMD/releases/download/0.9.18.2/fmd_0.9.18.2_Win64.7z +VERSION=0.9.158.0 +; WIN32=https://sourceforge.net/projects/newfmd/files/0.9.158.0/fmd_0.9.158.0.7z/download +; WIN64=https://sourceforge.net/projects/newfmd/files/0.9.158.0/fmd_0.9.158.0_Win64.7z/download +WIN32=https://github.com/riderkick/FMD/releases/download/0.9.158.0/fmd_0.9.158.0.7z +WIN64=https://github.com/riderkick/FMD/releases/download/0.9.158.0/fmd_0.9.158.0_Win64.7z diff --git a/updater/languages/updater.el_GR.po b/updater/languages/updater.el_GR.po new file mode 100644 index 000000000..e7c351344 --- /dev/null +++ b/updater/languages/updater.el_GR.po @@ -0,0 +1,117 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: Free Manga Downloader 0.9.118\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: geogeo.gr <geogeo.gr@gmail.com>\n" +"Language-Team: Greek <www.geogeo.gr>\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: en\n" +"X-Generator: Poedit 1.8.8\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" +"X-Poedit-Language: Greek\n" +"X-Poedit-Country: GREECE\n" +"X-Poedit-SourceCharset: UTF-8\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "Free Manga Downloader - Ενημέρωση" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Μέγεθος αρχείου" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Παρακαλώ περιμένετε..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Ρυθμός μεταφοράς" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Βοήθεια" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "Δεν είναι δυνατή η εξαγωγή του αρχείου επειδή το 7za.exe δεν βρέθηκε!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "Παρουσιάστηκε ένα σφάλμα κατά την προσπάθεια λήψης του αρχείου." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "Λήψη [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Σφάλμα κατά την αποθήκευση του αρχείου. Ελέγξτε το πρόγραμμά σας για την προστασία από ιούς!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Η λήψη του αρχείου απέτυχε!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Η φόρτωση της σελίδας απέτυχε!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Το αρχείο δεν βρέθηκε!" + +#: umain.rs_finished +msgid "Finished." +msgstr "Ολοκληρώθηκε." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "Μη έγκυρη URL!" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Φόρτωση σελίδας..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Ανακατεύθυνση..." + +#: umain.rs_response +msgid "Response" +msgstr "Απόκριση" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "Επανάληψη λήψης [%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Επανάληψη φόρτωσης σελίδας [%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Αποθήκευση αρχείου... " + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Σφάλμα απόκρισης διακομιστή!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(άγνωστο)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Αποσυμπίεση αρχείων [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Αναμονή κύριας εφαρμογής για κλείσιμο..." + diff --git a/updater/languages/updater.en.po b/updater/languages/updater.en.po index 59fe6a004..78bab6e03 100644 --- a/updater/languages/updater.en.po +++ b/updater/languages/updater.en.po @@ -9,11 +9,11 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: en\n" -"X-Generator: Poedit 1.7.6\n" +"X-Generator: Poedit 1.8.8\n" #: tfrmmain.caption msgid "Free Manga Downloader - Updater" -msgstr "Free Manga Downloader - Updater" +msgstr "" #: tfrmmain.lbfilesize.caption msgid "File size" @@ -27,6 +27,10 @@ msgstr "Waiting..." msgid "Transfer rate" msgstr "Transfer rate" +#: tfrmmessage.caption +msgid "Help" +msgstr "Help" + #: umain.rs_7znotfound msgid "Can't extract file because 7za.exe not found!" msgstr "Can't extract file because 7za.exe not found!" @@ -55,32 +59,6 @@ msgstr "Failed loading page!" msgid "File not found!" msgstr "File not found!" -#: umain.rs_filenotfound_mfdatalink -#| msgid "" -#| "File not found!\n" -#| "This site probably have been added to unofficial build.\n" -#| "\n" -#| "Remedy:\n" -#| "Build you manga list from scratch or download manually from this link:\n" -#| "%s\n" -#| "Link copied to clipboard!\n" -msgid "" -"File not found!\n" -"This site probably have been added to unofficial build.\n" -"\n" -"Remedy:\n" -"Build you manga list from scratch or download manually from this link:\n" -"%s\n" -"Link copied to clipboard!\n" -msgstr "" -"File not found!\n" -"This site probably have been added to unofficial build.\n" -"\n" -"Remedy:\n" -"Build you manga list from scratch or download manually from this link:\n" -"%s\n" -"Link copied to clipboard!\n" - #: umain.rs_finished msgid "Finished." msgstr "Finished." diff --git a/updater/languages/updater.es.po b/updater/languages/updater.es.po new file mode 100644 index 000000000..1c70b0363 --- /dev/null +++ b/updater/languages/updater.es.po @@ -0,0 +1,109 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: updater.es\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: Mariolr\n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: es\n" +"X-Generator: Poedit 1.8.11\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Tamaño del Archivo" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Esperando..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Ratio de Transferencia" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Ayuda" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "No se Puede Extraer Archivo porque 7za.exe no se Encontró!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "Un Error Ocurrió Cuando se Trató de Descargar el Archivo." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "Descargando [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Error al Guardar Archivo, Revisa tu Antivirus!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Error al Descargar Archivo!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Error al Cargar la Página!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Archivo no Encontrado!" + +#: umain.rs_finished +msgid "Finished." +msgstr "Terminado." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "URL no válida!" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Cargando Página..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Redirigido..." + +#: umain.rs_response +msgid "Response" +msgstr "Respuesta" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "Reintentando Descargar [%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Reintentando Cargar Página [%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Guardando Archivo... " + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Error de Respuesta del Servidor!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(Desconocido)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Extrayendo Archivo [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Esperando Aplicación Principal que se Cierre..." + diff --git a/updater/languages/updater.id_ID.po b/updater/languages/updater.id_ID.po index 73c55a716..157337cd2 100644 --- a/updater/languages/updater.id_ID.po +++ b/updater/languages/updater.id_ID.po @@ -9,11 +9,11 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: id_ID\n" -"X-Generator: Poedit 1.7.6\n" +"X-Generator: Poedit 1.8.8\n" #: tfrmmain.caption msgid "Free Manga Downloader - Updater" -msgstr "Free Manga Downloader - Pembaruan" +msgstr "" #: tfrmmain.lbfilesize.caption msgid "File size" @@ -27,6 +27,10 @@ msgstr "Menunggu..." msgid "Transfer rate" msgstr "Kecepatan" +#: tfrmmessage.caption +msgid "Help" +msgstr "Bantuan" + #: umain.rs_7znotfound msgid "Can't extract file because 7za.exe not found!" msgstr "Tidak bisa meng-ekstrak karena 7za.exe tidak ditemukan!" @@ -49,29 +53,12 @@ msgstr "Gagal mengunduh berkas!" #: umain.rs_failedloadpage msgid "Failed loading page!" -msgstr "Gagal mengambil halaman!" +msgstr "Gagal memuat halaman!" #: umain.rs_filenotfound msgid "File not found!" msgstr "Berkas tidak ditemukan!" -#: umain.rs_filenotfound_mfdatalink -msgid "" -"File not found!\n" -"This site probably have been added to unofficial build.\n" -"\n" -"Remedy:\n" -"Build you manga list from scratch or download manually from this link:\n" -"%s\n" -"Link copied to clipboard!\n" -msgstr "" -"Berkas tidak ditemukan\n" -"Kemungkinan situs ini telah ditambahkan ke versi tidak resmi.\n" -"\n" -"Buat sendiri list kamu dari awal atau coba download dari link ini:\n" -"%s\n" -"Link sudah disalin ke clipboard!\n" - #: umain.rs_finished msgid "Finished." msgstr "Selesai." @@ -82,7 +69,7 @@ msgstr "URL tidak valid!" #: umain.rs_loadingpage msgid "Loading page..." -msgstr "Mebuka halaman..." +msgstr "Memuat halaman..." #: umain.rs_redirected msgid "Redirected..." @@ -98,7 +85,7 @@ msgstr "Mencoba mengunduh[%d] [%s]..." #: umain.rs_retryloadpage msgid "Retry loading page[%d]..." -msgstr "Mencoba mebuka halaman[%d]..." +msgstr "Mencoba memuat halaman[%d]..." #: umain.rs_savefile msgid "Saving file... " diff --git a/updater/languages/updater.pl_PL.po b/updater/languages/updater.pl_PL.po new file mode 100644 index 000000000..5e6230c1e --- /dev/null +++ b/updater/languages/updater.pl_PL.po @@ -0,0 +1,110 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: \n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: pl_PL\n" +"X-Generator: Poedit 1.7.4\n" +"Plural-Forms: nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Rozmiar pliku" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Oczekiwanie..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Prędkość transferu" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Pomoc" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "Nie można wyodrębnić pliku, ponieważ 7za.exe nie znaleziono!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "Wystąpił błąd podczas próby pobrania pliku." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "Pobieranie [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Błąd zapisu pliku, sprawdź AntiVirus!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Niepowodzenie pobierania pliku!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Błąd ładowania strony!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Nie znaleziono pliku" + +#: umain.rs_finished +msgid "Finished." +msgstr "Zakończono." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "Nieprawidłowy URL" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Ładowanie strony ..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Przekierowany ..." + +#: umain.rs_response +msgid "Response" +msgstr "Odpowiedź" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "Ponów pobieranie [%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Ponowna próba załadowania strony [%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Zapisywanie pliku..." + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Serwer odpowiedział: Error!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(nieznany)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Rozpakowanie pliku [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Oczekiwanie aż główna aplikacja się zamknie..." + diff --git a/updater/languages/updater.po b/updater/languages/updater.po index 8f14f02c9..56c7490de 100644 --- a/updater/languages/updater.po +++ b/updater/languages/updater.po @@ -17,6 +17,10 @@ msgstr "" msgid "Transfer rate" msgstr "" +#: tfrmmessage.caption +msgid "Help" +msgstr "" + #: umain.rs_7znotfound msgid "Can't extract file because 7za.exe not found!" msgstr "" @@ -45,17 +49,6 @@ msgstr "" msgid "File not found!" msgstr "" -#: umain.rs_filenotfound_mfdatalink -msgid "" -"File not found!\n" -"This site probably have been added to unofficial build.\n" -"\n" -"Remedy:\n" -"Build you manga list from scratch or download manually from this link:\n" -"%s\n" -"Link copied to clipboard!\n" -msgstr "" - #: umain.rs_finished msgid "Finished." msgstr "" diff --git a/updater/languages/updater.pt_BR.po b/updater/languages/updater.pt_BR.po new file mode 100644 index 000000000..1fefe84d3 --- /dev/null +++ b/updater/languages/updater.pt_BR.po @@ -0,0 +1,108 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=utf-8\n" +"Project-Id-Version: \n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: \n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: pt-BR\n" +"X-Generator: Poedit 1.8.8\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "Free Manga Downloader - Atualizador" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Tamanho do arquivo" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Aguardando..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Velocidade" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Ajuda" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "Não pode extrair o arquivo porque 7za.exe não foi encontrado!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "Um erro ocorreu quando tentou baixar o arquivo." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "Baixando [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Erro ao salvar o arquivo, cheque seu antivírus!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Falha ao baixar arquivo!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Falha ao carregar página!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Arquivo não encontrado!" + +#: umain.rs_finished +msgid "Finished." +msgstr "Terminado." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "URL Inválida!" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Carregando página..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Redirecionado..." + +#: umain.rs_response +msgid "Response" +msgstr "Resposta" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "Tentar novamente o download[%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Tentar novamente carregar página[%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Salvando arquivo... " + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Erro de resposta do servidor!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(desconhecido)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Descompactar arquivo [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Esperando o aplicativo principal para fechar..." diff --git a/updater/languages/updater.ru_RU.po b/updater/languages/updater.ru_RU.po new file mode 100644 index 000000000..3c1c05184 --- /dev/null +++ b/updater/languages/updater.ru_RU.po @@ -0,0 +1,108 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: 0.9.118.0\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: Tokc.D.K. <tokcdk@gmail.com>\n" +"Language-Team: TokcDK\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: ru_RU\n" +"X-Generator: Poedit 2.0.2\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "Free Manga Downloader - Обновление" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Размер файла" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Ожидание..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Скорость передачи" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Помощь" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "Не удалось извлечь файл, т.к. 7za.exe не найден!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "При загрузке файла произошла ошибка." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "Загружается [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Ошбка сохранения файла, проверьте свой антивирус!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Не удалось загрузить файл!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Не удалось загрузить страницу!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Файл не найден!" + +#: umain.rs_finished +msgid "Finished." +msgstr "Завершено." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "Неверный адрес!" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Загрузка страницы..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Перенаправлено..." + +#: umain.rs_response +msgid "Response" +msgstr "Ответ" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "Попытка загрузки[%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Попытка загрузки страницы[%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Сохранение файла... " + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Ошибка ответа сервера!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(неизвестно)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Распаковка файла [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Ожидание закрытия основного приложения..." diff --git a/updater/languages/updater.tr_TR.po b/updater/languages/updater.tr_TR.po new file mode 100644 index 000000000..e508439f9 --- /dev/null +++ b/updater/languages/updater.tr_TR.po @@ -0,0 +1,108 @@ +msgid "" +msgstr "" +"Content-Type: text/plain; charset=UTF-8\n" +"Project-Id-Version: The Free Manga Downloader\n" +"POT-Creation-Date: \n" +"PO-Revision-Date: \n" +"Last-Translator: \n" +"Language-Team: Tmp341\n" +"MIME-Version: 1.0\n" +"Content-Transfer-Encoding: 8bit\n" +"Language: tr\n" +"X-Generator: Poedit 2.0.3\n" + +#: tfrmmain.caption +msgid "Free Manga Downloader - Updater" +msgstr "Free Manga Downloader - Güncelleyici" + +#: tfrmmain.lbfilesize.caption +msgid "File size" +msgstr "Dosya boyutu" + +#: tfrmmain.lbstatus.caption +msgid "Waiting..." +msgstr "Bekliyor..." + +#: tfrmmain.lbtransferrate.caption +msgid "Transfer rate" +msgstr "Transfer oranı" + +#: tfrmmessage.caption +msgid "Help" +msgstr "Yardım" + +#: umain.rs_7znotfound +msgid "Can't extract file because 7za.exe not found!" +msgstr "Çıkarılamıyor, çünkü 7za.exe bulunamadı!" + +#: umain.rs_anerroroccured +msgid "An error occured when trying to download file." +msgstr "Dosyayı indirmeye çalışırken bir hata ile karşılaşıldı." + +#: umain.rs_downloading +msgid "Downloading [%s]..." +msgstr "İndiriliyor [%s]..." + +#: umain.rs_errorcheckantivirus +msgid "Error saving file, check your AntiVirus!" +msgstr "Dosya kaydedilirken hata, AntiVirus programınızı kontrol edin!" + +#: umain.rs_faileddownloadpage +msgid "Failed downloading file!" +msgstr "Dosyayı indirme başarısız!" + +#: umain.rs_failedloadpage +msgid "Failed loading page!" +msgstr "Sayfayı yükleme başarısız!" + +#: umain.rs_filenotfound +msgid "File not found!" +msgstr "Dosya bulunamadı!" + +#: umain.rs_finished +msgid "Finished." +msgstr "Tamamlandı." + +#: umain.rs_invalidurl +msgid "Invalid URL!" +msgstr "Geçersiz URL!" + +#: umain.rs_loadingpage +msgid "Loading page..." +msgstr "Sayfa yükleniyor..." + +#: umain.rs_redirected +msgid "Redirected..." +msgstr "Yeniden yönlendirildi..." + +#: umain.rs_response +msgid "Response" +msgstr "Cevap" + +#: umain.rs_retrydownloading +msgid "Retry downloading[%d] [%s]..." +msgstr "İndirmeyi tekrar dene[%d] [%s]..." + +#: umain.rs_retryloadpage +msgid "Retry loading page[%d]..." +msgstr "Sayfayı yüklemeyi yeniden dene[%d]..." + +#: umain.rs_savefile +msgid "Saving file... " +msgstr "Dosya kaydediliyor... " + +#: umain.rs_servererror +msgid "Server response error!" +msgstr "Sunucudan cevap alınamadı!" + +#: umain.rs_unknown +msgid "(unknown)" +msgstr "(bilinmeyen)" + +#: umain.rs_unpackfile +msgid "Unpacking file [%s]..." +msgstr "Dosya çıkartılıyor [%s]..." + +#: umain.rs_waitmainapp +msgid "Waiting main app to close..." +msgstr "Uygulamanın kapanması bekleniyor..." diff --git a/updater/uMain.lfm b/updater/uMain.lfm index aadd78367..8dc2c55ed 100644 --- a/updater/uMain.lfm +++ b/updater/uMain.lfm @@ -13,7 +13,7 @@ object frmMain: TfrmMain OnDestroy = FormDestroy OnShow = FormShow Position = poOwnerFormCenter - LCLVersion = '1.5' + LCLVersion = '1.7' object pbDownload: TProgressBar Left = 8 Height = 20 @@ -24,27 +24,37 @@ object frmMain: TfrmMain TabOrder = 0 end object lbTransferRateValue: TLabel - Left = 96 - Height = 1 + AnchorSideLeft.Control = lbTransferRate + AnchorSideLeft.Side = asrBottom + AnchorSideBottom.Control = lbTransferRate + AnchorSideBottom.Side = asrBottom + Left = 83 + Height = 15 Top = 52 - Width = 229 - Anchors = [akTop, akLeft, akRight] + Width = 242 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Left = 10 ParentColor = False end object lbTransferRate: TLabel Left = 8 Height = 15 Top = 52 - Width = 66 + Width = 65 Caption = 'Transfer rate' ParentColor = False end object lbFileSizeValue: TLabel - Left = 96 - Height = 1 + AnchorSideLeft.Control = lbTransferRateValue + AnchorSideBottom.Control = lbFileSize + AnchorSideBottom.Side = asrBottom + Left = 83 + Height = 15 Top = 34 - Width = 229 - Anchors = [akTop, akLeft, akRight] + Width = 242 + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False ParentColor = False end object lbFileSize: TLabel @@ -67,7 +77,7 @@ object frmMain: TfrmMain object itMonitor: TIdleTimer Enabled = False OnTimer = itMonitorTimer - left = 168 - top = 8 + Left = 264 + Top = 16 end end diff --git a/updater/uMain.lrj b/updater/uMain.lrj new file mode 100644 index 000000000..8a7917a17 --- /dev/null +++ b/updater/uMain.lrj @@ -0,0 +1,6 @@ +{"version":1,"strings":[ +{"hash":193843458,"name":"tfrmmain.caption","sourcebytes":[70,114,101,101,32,77,97,110,103,97,32,68,111,119,110,108,111,97,100,101,114,32,45,32,85,112,100,97,116,101,114],"value":"Free Manga Downloader - Updater"}, +{"hash":131060021,"name":"tfrmmain.lbtransferrate.caption","sourcebytes":[84,114,97,110,115,102,101,114,32,114,97,116,101],"value":"Transfer rate"}, +{"hash":41414149,"name":"tfrmmain.lbfilesize.caption","sourcebytes":[70,105,108,101,32,115,105,122,101],"value":"File size"}, +{"hash":184637710,"name":"tfrmmain.lbstatus.caption","sourcebytes":[87,97,105,116,105,110,103,46,46,46],"value":"Waiting..."} +]} diff --git a/updater/uMain.pas b/updater/uMain.pas index 7b6f377bf..873142eaa 100644 --- a/updater/uMain.pas +++ b/updater/uMain.pas @@ -9,9 +9,10 @@ interface cthreads, cmem, {$endif} - Classes, SysUtils, zipper, FileUtil, UTF8Process, Forms, Dialogs, ComCtrls, - StdCtrls, Clipbrd, ExtCtrls, DefaultTranslator, RegExpr, IniFiles, process, - USimpleException, uMisc, uTranslation, httpsend, blcksock, ssl_openssl; + Classes, SysUtils, zipper, FileUtil, LazFileUtils, LazUTF8, LazUTF8Classes, + Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls, RegExpr, IniFiles, blcksock, + ssl_openssl, ssl_openssl_lib, synacode, httpsendthread, uMisc, BaseThread, + SimpleTranslator, SimpleException; type @@ -24,48 +25,45 @@ TfrmMain = class(TForm) lbFileSizeValue: TLabel; lbStatus: TLabel; lbTransferRateValue: TLabel; - pbDownload :TProgressBar; + pbDownload: TProgressBar; procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender :TObject); + procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); - procedure FormShow(Sender :TObject); + procedure FormShow(Sender: TObject); procedure itMonitorTimer(Sender: TObject); private { private declarations } public - procedure ExceptionHandler(Sender: TObject; E: Exception); { public declarations } end; { TDownloadThread } - TDownloadThread = class(TThread) + TDownloadThread = class(TBaseThread) private - FTotalSize, FCurrentSize :integer; - FHTTP :THTTPSend; - FStatus :string; - FProgress :string; - FErrorMessage :string; - UZip :TUnZipper; + FTotalSize, FCurrentSize: Integer; + FHTTP: THTTPSendThread; + FStatus: String; + FProgress: String; + FErrorMessage: String; + UZip: TUnZipper; protected - procedure SockOnStatus(Sender :TObject; Reason :THookSocketReason; - const Value :string); - procedure SockOnHeartBeat(Sender :TObject); - procedure UZipOnStartFile(Sender :TObject; const AFileName :string); + procedure SockOnStatus(Sender: TObject; Reason: THookSocketReason; + const Value: String); + procedure UZipOnStartFile(Sender: TObject; const AFileName: String); procedure MainThreadUpdateStatus; procedure MainThreadUpdateProgress; procedure MainThreadUpdateProgressLabel; procedure MainThreadErrorGetting; - procedure UpdateStatus(AStatus :string); - procedure ShowErrorMessage(AMessage :string); + procedure UpdateStatus(AStatus: String); + procedure ShowErrorMessage(AMessage: String); procedure Execute; override; public - URL :string; - isSFURL :boolean; - FileName :string; - DirPath :string; - MaxRetry :cardinal; - Extract :boolean; + URL: String; + FileName: String; + DirPath: String; + MaxRetry: Cardinal; + Extract: Boolean; constructor Create; destructor Destroy; override; end; @@ -73,30 +71,37 @@ TDownloadThread = class(TThread) procedure IncReadCount(const ACount: Int64); var - frmMain :TfrmMain; - dl :TDownloadThread; - isDownload :boolean = False; - ReadCount :Integer = 0; - CS_ReadCount :TRTLCriticalSection; - - _UpdApp :boolean = False; - _Extract :boolean = False; - _NoError :boolean = False; - _URL :string = ''; - _MaxRetry :cardinal = 1; - _LaunchApp :string = ''; - - ProxyType :string; - ProxyHost :string; - ProxyPort :string; - ProxyUser :string; - ProxyPass :string; + frmMain: TfrmMain; + dl: TDownloadThread; + isDownload: Boolean = False; + ReadCount: Integer = 0; + CS_ReadCount: TRTLCriticalSection; + + _UpdApp: Boolean = False; + _Extract: Boolean = False; + _NoError: Boolean = False; + _URL: String = ''; + _MaxRetry: Cardinal = 1; + _LaunchApp: String = ''; + + ProxyType: String; + ProxyHost: String; + ProxyPort: String; + ProxyUser: String; + ProxyPass: String; + + FMD_DIR: String; + CONFIG_DIR: String; + LANGUAGES_DIR: String; + CONFIG_FILE: String; + SZA: String; + OSZA: String; const Symbols: array [0..10] of Char = ('\', '/', ':', '*', '?', '"', '<', '>', '|', #9, ';'); - mf_data_link = 'https://www.mediafire.com/folder/fwa8eomz80uk1/Data'; + UA_CURL = 'curl/7.42.1'; resourcestring RS_InvalidURL = 'Invalid URL!'; @@ -116,21 +121,13 @@ procedure IncReadCount(const ACount: Int64); RS_UnpackFile = 'Unpacking file [%s]...'; RS_Finished = 'Finished.'; RS_ErrorCheckAntiVirus = 'Error saving file, check your AntiVirus!'; - RS_FileNotFound_mfdatalink = - 'File not found!' + LineEnding + - 'This site probably have been added to unofficial build.' + LineEnding + - LineEnding + - 'Remedy:' + LineEnding + - 'Build you manga list from scratch or download manually from this link:' + - LineEnding + - '%s' + LineEnding + - 'Link copied to clipboard!'; RS_7zNotFound = 'Can''t extract file because 7za.exe not found!'; RS_Unknown = '(unknown)'; implementation -uses uMessage; +uses + uMessage; {$R *.lfm} @@ -152,36 +149,6 @@ function RemoveSymbols(const input: String): String; end; end; -function RunExternalProcess(Exe: String; Params: array of String; ShowWind: Boolean = True; - Detached: Boolean = False): Boolean; -var - Process: TProcessUTF8; - I: Integer; -begin - Result := True; - Process := TProcessUTF8.Create(nil); - try - Process.InheritHandles := False; - Process.Executable := Exe; - Process.Parameters.AddStrings(Params); - if Detached then - Process.Options := [] - else - Process.Options := Process.Options + [poWaitOnExit]; - if ShowWind then - Process.ShowWindow := swoShow - else - Process.ShowWindow := swoHIDE; - // Copy default environment variables including DISPLAY variable for GUI application to work - for I := 0 to GetEnvironmentVariableCount - 1 do - Process.Environment.Add(GetEnvironmentString(I)); - Process.Execute; - except - Result := False; - end; - Process.Free; -end; - procedure IncReadCount(const ACount: Int64); begin EnterCriticalsection(CS_ReadCount); @@ -198,12 +165,10 @@ constructor TDownloadThread.Create; begin inherited Create(True); isDownload := True; - FreeOnTerminate := True; - FHTTP := THTTPSend.Create; - FHTTP.Headers.NameValueSeparator := ':'; + FHTTP := THTTPSendThread.Create(Self); FHTTP.Sock.OnStatus := @SockOnStatus; - FHTTP.Sock.OnHeartbeat := @SockOnHeartBeat; - FHTTP.Sock.HeartbeatRate := 250; + FHTTP.Timeout := 10000; + FHTTP.SetProxy(ProxyType, ProxyHost, ProxyPort, ProxyUser, ProxyPass); FTotalSize := 0; FCurrentSize := 0; URL := ''; @@ -215,7 +180,7 @@ constructor TDownloadThread.Create; destructor TDownloadThread.Destroy; begin - FHTTP.Free; + if FHTTP <> nil then FHTTP.Free; isDownload := False; inherited Destroy; end; @@ -225,34 +190,25 @@ procedure TDownloadThread.MainThreadUpdateStatus; frmMain.lbStatus.Caption := FStatus; end; -procedure TDownloadThread.UpdateStatus(AStatus :string); +procedure TDownloadThread.UpdateStatus(AStatus: String); begin FStatus := AStatus; Synchronize(@MainThreadUpdateStatus); end; -procedure TDownloadThread.ShowErrorMessage(AMessage: string); +procedure TDownloadThread.ShowErrorMessage(AMessage: String); begin FErrorMessage := AMessage; Synchronize(@MainThreadErrorGetting); end; -procedure TDownloadThread.SockOnHeartBeat(Sender :TObject); -begin - if Self.Terminated then - begin - TBlockSocket(Sender).StopFlag := True; - TBlockSocket(Sender).AbortSocket; - end; -end; - procedure TDownloadThread.MainThreadUpdateProgress; var barPos: Integer; - prgText: string; + prgText: String; begin if Terminated then Exit; - if FCurrentSize > 0then + if FCurrentSize > 0 then begin if FTotalSize > 0 then begin @@ -281,19 +237,19 @@ procedure TDownloadThread.MainThreadErrorGetting; mtError, [mbOK], 0); end; -procedure TDownloadThread.SockOnStatus(Sender :TObject; Reason :THookSocketReason; - const Value :string); +procedure TDownloadThread.SockOnStatus(Sender: TObject; Reason: THookSocketReason; + const Value: String); begin if Terminated then Exit; if FHTTP.Headers.IndexOfName('Content-Length') > -1 then FTotalSize := StrToIntDef(FHTTP.Headers.Values['Content-Length'], 0); case Reason of - HR_Connect :FCurrentSize := 0; - HR_ReadCount : - begin - Inc(FCurrentSize, StrToIntDef(Value, 0)); - IncReadCount(StrToIntDef(Value, 0)); - end; + HR_Connect: FCurrentSize := 0; + HR_ReadCount: + begin + Inc(FCurrentSize, StrToIntDef(Value, 0)); + IncReadCount(StrToIntDef(Value, 0)); + end; end; Synchronize(@MainThreadUpdateProgress); end; @@ -303,7 +259,7 @@ procedure TDownloadThread.MainThreadUpdateProgressLabel; frmMain.lbFileSizeValue.Caption := FProgress; end; -procedure TDownloadThread.UZipOnStartFile(Sender :TObject; const AFileName :string); +procedure TDownloadThread.UZipOnStartFile(Sender: TObject; const AFileName: String); begin if FileExistsUTF8(AFileName) then DeleteFileUTF8(AFileName); @@ -311,76 +267,39 @@ procedure TDownloadThread.UZipOnStartFile(Sender :TObject; const AFileName :stri end; procedure TDownloadThread.Execute; - - procedure PrepareHTTP(var HTTP :THTTPSend); - begin - if HTTP <> nil then - begin - FHTTP.Clear; - FHTTP.Cookies.Clear; - FHTTP.Protocol := '1.1'; - FHTTP.UserAgent := UA_FIREFOX; - FHTTP.Timeout := 30000; - - if ProxyType = 'HTTP' then - begin - HTTP.ProxyHost := ProxyHost; - HTTP.ProxyPort := ProxyPort; - HTTP.ProxyUser := ProxyUser; - HTTP.ProxyPass := ProxyPass; - end - else - if (ProxyType = 'SOCKS4') or (ProxyType = 'SOCKS5') then - begin - if ProxyType = 'SOCKS4' then - HTTP.Sock.SocksType := ST_Socks4 - else - if ProxyType = 'SOCKS5' then - HTTP.Sock.SocksType := ST_Socks5; - HTTP.Sock.SocksIP := ProxyHost; - HTTP.Sock.SocksPort := ProxyPort; - HTTP.Sock.SocksUsername := ProxyUser; - http.Sock.SocksPassword := ProxyPass; - end - else - begin - HTTP.Sock.SocksIP := ProxyHost; - HTTP.Sock.SocksPort := ProxyPort; - HTTP.Sock.SocksUsername := ProxyUser; - http.Sock.SocksPassword := ProxyPass; - HTTP.ProxyHost := ProxyHost; - HTTP.ProxyPort := ProxyPort; - HTTP.ProxyUser := ProxyUser; - HTTP.ProxyPass := ProxyPass; - end; - end; - end; - var - regx : TRegExpr; - i, ctry : Cardinal; - Sza, + sf: Boolean = False; + regx: TRegExpr; + i, ctry: Cardinal; + csza, rurl, fname, sproject, sdir, - sfile : String; + s, sfile: String; st, HTTPHeaders: TStringList; - + filestream: TFileStreamUTF8; begin - URL := Trim(URL); + URL := EncodeURL(DecodeURL(Trim(URL))); HTTPHeaders := TStringList.Create; regx := TRegExpr.Create; try - PrepareHTTP(FHTTP); - HTTPHeaders.NameValueSeparator := ':'; + HTTPHeaders.Assign(FHTTP.Headers); regx.ModifierI := True; - if isSFURL then + s := LowerCase(URL); + if (Pos('sourceforge.net/', s) <> 0) or (Pos('sf.net/', s) <> 0) then begin + sf := True; FHTTP.UserAgent := UA_CURL; regx.Expression := '/download$'; URL := Trim(regx.Replace(URL, '', False)); - //**parsing SF url + //**parsing and fixing SF url + if Pos('sf.net/', s) > 0 then begin + URL := StringReplace(URL, 'sf.net/', 'sourceforge.net/', [rfIgnoreCase]); + s := LowerCase(URL); + end; + if Pos('sourceforge.net/p/', s) > 0 then + URL := StringReplace(URL, 'sourceforge.net/p/', 'sourceforge.net/projects/', [rfIgnoreCase]); regx.Expression := '^.*sourceforge.net/projects/(.+)/files/(.+)/([^/]+)$'; if not regx.Exec(URL) then begin @@ -393,7 +312,11 @@ procedure TDownloadThread.Execute; sfile := regx.Replace(URL, '$3', True); if FileName = '' then FileName := sfile; - rurl := 'http://sourceforge.net/projects/' + sproject + '/files/' + + if Pos('https://', LowerCase(URL)) = 1 then + rurl := 'https://' + else + rurl := 'http://'; + rurl := rurl + 'sourceforge.net/projects/' + sproject + '/files/' + sdir + '/' + sfile + '/download'; end else @@ -409,7 +332,7 @@ procedure TDownloadThread.Execute; FileName := 'new_version.7z'; end; - FHTTP.Headers.Text := HTTPHeaders.Text; + FHTTP.Headers.Assign(HTTPHeaders); //**loading page UpdateStatus(RS_LoadingPage); ctry := 0; @@ -434,35 +357,20 @@ procedure TDownloadThread.Execute; if (FHTTP.ResultCode >= 400) and (FHTTP.ResultCode < 500) then begin UpdateStatus(RS_FileNotFound); - if _UpdApp then - ShowErrorMessage(RS_FileNotFound + LineEnding + LineEnding + - RS_Response + ':' + LineEnding + - IntToStr(FHTTP.ResultCode) + ' ' + FHTTP.ResultString) - else - begin - Clipboard.AsText := mf_data_link; - ShowErrorMessage(Format(RS_FileNotFound_mfdatalink, [mf_data_link])); - end; + ShowErrorMessage(RS_FileNotFound + LineEnding + LineEnding + + RS_Response + ':' + LineEnding + + IntToStr(FHTTP.ResultCode) + ' ' + FHTTP.ResultString); Break; end; FHTTP.Clear; end; - if (FHTTP.ResultCode >= 300) or isSFURL then + if (FHTTP.ResultCode >= 300) and (FHTTP.Headers.Values['Location'] <> '') then begin - HTTPHeaders.Values['Referer'] := ' ' + rurl; + if not sf then + HTTPHeaders.Values['Referer'] := ' ' + rurl; UpdateStatus(RS_Redirected); rurl := Trim(FHTTP.Headers.Values['Location']); - if isSFURL then - begin - if (Pos('use_mirror=', rurl) > 0) then - begin - regx.Expression := '.*use_mirror=(.+)$'; - rurl := regx.Replace(rurl, '$1', True); - rurl := 'http://' + rurl + '.dl.sourceforge.net/project/' + - sproject + '/' + sdir + '/' + sfile; - end; - end; end; //**download file @@ -471,8 +379,8 @@ procedure TDownloadThread.Execute; UpdateStatus(Format(RS_Downloading, [FileName])); ctry := 0; FHTTP.Clear; - HTTPHeaders.Values['Accept'] := ' */*'; - FHTTP.Headers.Text := HTTPHeaders.Text; + FHTTP.Headers.Assign(HTTPHeaders); + FHTTP.Cookies.Clear; while (not FHTTP.HTTPMethod('GET', Trim(rurl))) or (FHTTP.ResultCode >= 300) do begin @@ -493,17 +401,20 @@ procedure TDownloadThread.Execute; else if (FHTTP.ResultCode >= 400) and (FHTTP.ResultCode < 500) then begin - UpdateStatus(RS_FileNotFound); - if _UpdApp then + if ctry >= MaxRetry then + begin + UpdateStatus(RS_FileNotFound); ShowErrorMessage(RS_FileNotFound + LineEnding + LineEnding + RS_Response + ':' + LineEnding + - IntToStr(FHTTP.ResultCode) + ' ' + FHTTP.ResultString) - else - begin - Clipboard.AsText := mf_data_link; - ShowErrorMessage(Format(RS_FileNotFound_mfdatalink, [mf_data_link])); + IntToStr(FHTTP.ResultCode) + ' ' + FHTTP.ResultString); + Break; end; - Break; + //try to load previous url, in case it was temporary url + if ctry > 0 then begin + rurl := URL; + FHTTP.Cookies.Clear; + end; + Inc(ctry); end else if FHTTP.ResultCode >= 300 then @@ -512,7 +423,7 @@ procedure TDownloadThread.Execute; rurl := Trim(FHTTP.Headers.Values['location']); end; FHTTP.Clear; - FHTTP.Headers.Text := HTTPHeaders.Text; + FHTTP.Headers.Assign(HTTPHeaders); end; end; @@ -521,78 +432,86 @@ procedure TDownloadThread.Execute; (FHTTP.ResultCode >= 100) and (FHTTP.ResultCode < 300) and (FCurrentSize >= FTotalSize) then begin - fname := DirPath + DirectorySeparator + FileName; + fname := DirPath + FileName; if FileExistsUTF8(fname) then DeleteFileUTF8(fname); if ForceDirectoriesUTF8(DirPath) then begin UpdateStatus(RS_SaveFile); - FHTTP.Document.SaveToFile(fname); + filestream := TFileStreamUTF8.Create(fname, fmCreate); + try + FHTTP.Document.SaveToStream(filestream); + finally + filestream.Free; + end; end; if not FileExistsUTF8(fname) then ShowErrorMessage(RS_ErrorCheckAntiVirus); if Extract and FileExistsUTF8(fname) then begin + FHTTP.Free; + FHTTP := nil; + SSLImplementation := TSSLNone; + ssl_openssl_lib.DestroySSLInterface; + UpdateStatus(Format(RS_UnpackFile, [fname])); - Sza := GetCurrentDirUTF8 + DirectorySeparator + '7za.exe'; if _UpdApp and - FileExistsUTF8(GetCurrentDirUTF8 + DirectorySeparator + '7za.exe') then - begin - st := TStringList.Create; - try - FindAllFiles(st, GetCurrentDirUTF8, '*.dbg', False); - if st.Count > 0 then - for i := 0 to st.Count - 1 do - DeleteFileUTF8(st[i]); - finally - st.Free; - end; - CopyFile(GetCurrentDirUTF8 + DirectorySeparator + '7za.exe', - GetCurrentDirUTF8 + DirectorySeparator + 'old_7za.exe'); - Sza := GetCurrentDirUTF8 + DirectorySeparator + 'old_7za.exe'; + FileExistsUTF8(SZA) then + begin + st := TStringList.Create; + try + FindAllFiles(st, FMD_DIR, '*.dbg', False); + if st.Count > 0 then + for i := 0 to st.Count - 1 do + DeleteFileUTF8(st[i]); + finally + st.Free; end; + if FileExistsUTF8(OSZA) then + DeleteFileUTF8(OSZA); + CopyFile(SZA, OSZA); + csza := OSZA; + end; if Pos('.zip', LowerCase(FileName)) <> 0 then begin UZip := TUnZipper.Create; UZip.OnStartFile := @UZipOnStartFile; try - UZip.FileName := DirPath + DirectorySeparator + FileName; + UZip.FileName := DirPath + FileName; UZip.OutputPath := Dirpath; UZip.Examine; UZip.UnZipAllFiles; finally UZip.Free; - DeleteFileUTF8(DirPath + DirectorySeparator + FileName); + DeleteFileUTF8(DirPath + FileName); end; end else begin - if FileExistsUTF8(Sza) then + if FileExistsUTF8(csza) then begin - RunExternalProcess(Sza, ['x', fname, '-o' + - AnsiQuotedStr(DirPath, '"'), '-aoa'], False, False); - Sleep(250); + RunExternalProcess(csza, ['x', fname, '-o' + + AnsiQuotedStr(DirPath, '"'), '-aoa'], False, True); DeleteFileUTF8(fname); end else ShowErrorMessage(RS_7zNotFound); end; - if FileExistsUTF8(GetCurrentDirUTF8 + DirectorySeparator + 'old_7za.exe') then - if FileExistsUTF8(GetCurrentDirUTF8 + DirectorySeparator + '7za.exe') then - DeleteFileUTF8(GetCurrentDirUTF8 + DirectorySeparator + 'old_7za.exe') + if FileExistsUTF8(OSZA) then + if FileExistsUTF8(SZA) then + DeleteFileUTF8(OSZA) else - RenameFileUTF8(GetCurrentDirUTF8 + DirectorySeparator + 'old_7za.exe', - GetCurrentDirUTF8 + DirectorySeparator + '7za.exe'); + RenameFileUTF8(OSZA, SZA); end; end; UpdateStatus(RS_Finished); if (not Self.Terminated) and _UpdApp and (_LaunchApp <> '') then - RunExternalProcess(_LaunchApp, [''], True, True); + RunExternalProcess(_LaunchApp, [''], True, False); except on E: Exception do - frmMain.ExceptionHandler(Self, E); + ExceptionHandle(Self, E); end; regx.Free; HTTPHeaders.Free; @@ -602,45 +521,62 @@ procedure TDownloadThread.Execute; procedure TfrmMain.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin + try if isDownload then begin dl.Terminate; dl.WaitFor; end; CloseAction := caFree; + except + on E: Exception do + ExceptionHandle(Self, E); + end; end; -procedure TfrmMain.FormCreate(Sender :TObject); -var - config :TIniFile; +procedure TfrmMain.FormCreate(Sender: TObject); begin Randomize; - InitSimpleExceptionHandler(ChangeFileExt(Application.ExeName, '.log')); - uTranslation.LangDir := GetCurrentDirUTF8 + PathDelim + 'languages'; - uTranslation.LangAppName := 'updater'; - uTranslation.CollectLanguagesFiles; + FMD_DIR := CleanAndExpandDirectory(ExtractFilePath(Application.ExeName)); + CONFIG_DIR := FMD_DIR + 'config'; + LANGUAGES_DIR := FMD_DIR + 'languages'; + CONFIG_FILE := CONFIG_DIR + PathDelim + 'config.ini'; + SZA := FMD_DIR + '7za.exe'; + OSZA := FMD_DIR + 'old_7za.exe'; + + InitSimpleExceptionHandler; + try + SimpleTranslator.LangDir := LANGUAGES_DIR; + SimpleTranslator.LangAppName := 'updater'; + SimpleTranslator.CollectLanguagesFiles; InitCriticalSection(CS_ReadCount); //load proxy config from fmd - config := TIniFile.Create('config/config.ini'); - try - if config.ReadBool('connections', 'UseProxy', False) then - begin - ProxyType := config.ReadString('connections', 'ProxyType', 'HTTP'); - ProxyHost := config.ReadString('connections', 'Host', ''); - ProxyPort := config.ReadString('connections', 'Port', ''); - ProxyUser := config.ReadString('connections', 'User', ''); - ProxyPass := config.ReadString('connections', 'Pass', ''); - end - else - begin - ProxyType := ''; - ProxyHost := ''; - ProxyPort := ''; - ProxyUser := ''; - ProxyPass := ''; + if not FileExistsUTF8(CONFIG_FILE) then Exit; + with TIniFile.Create(CONFIG_FILE) do + try + SimpleTranslator.SetLang(ReadString('languages', 'Selected', 'en'), 'updater'); + if ReadBool('connections', 'UseProxy', False) then + begin + ProxyType := ReadString('connections', 'ProxyType', 'HTTP'); + ProxyHost := ReadString('connections', 'Host', ''); + ProxyPort := ReadString('connections', 'Port', ''); + ProxyUser := ReadString('connections', 'User', ''); + ProxyPass := ReadString('connections', 'Pass', ''); + end + else + begin + ProxyType := ''; + ProxyHost := ''; + ProxyPort := ''; + ProxyUser := ''; + ProxyPass := ''; + end; + finally + Free; end; - finally - FreeAndNil(config); + except + on E: Exception do + ExceptionHandle(Self, E); end; end; @@ -649,12 +585,13 @@ procedure TfrmMain.FormDestroy(Sender: TObject); DoneCriticalsection(CS_ReadCount); end; -procedure TfrmMain.FormShow(Sender :TObject); +procedure TfrmMain.FormShow(Sender: TObject); var - s :string; - i :Integer; - sh :boolean = False; + s: String; + i: Integer; + sh: Boolean = False; begin + try if Paramcount > 0 then begin for i := 1 to Paramcount do @@ -684,7 +621,7 @@ procedure TfrmMain.FormShow(Sender :TObject); else if s = '-l' then _LaunchApp := ParamStrUTF8(i + 1) else if (LowerCase(s) = '--lang') then - uTranslation.SetLang(ParamStrUTF8(i + 1)); + SimpleTranslator.SetLang(ParamStrUTF8(i + 1), 'updater'); end; end; end; @@ -705,12 +642,11 @@ procedure TfrmMain.FormShow(Sender :TObject); begin dl := TDownloadThread.Create; dl.URL := _URL; - dl.isSFURL := (Pos('sourceforge.net/', LowerCase(dl.URL)) <> 0) or - (Pos('sf.net/', dl.URL) <> 0); dl.MaxRetry := _MaxRetry; - dl.DirPath := GetCurrentDirUTF8; - if not _UpdApp then - dl.DirPath := dl.DirPath + DirectorySeparator + 'data'; + if _UpdApp then + dl.DirPath := FMD_DIR + else + dl.DirPath := FMD_DIR + 'data' + PathDelim; dl.Extract := _Extract; dl.Start; itMonitor.Enabled := True; @@ -721,6 +657,10 @@ procedure TfrmMain.FormShow(Sender :TObject); Self.Close; end; end; + except + on E: Exception do + ExceptionHandle(Self, E); + end; end; procedure TfrmMain.itMonitorTimer(Sender: TObject); @@ -738,13 +678,8 @@ procedure TfrmMain.itMonitorTimer(Sender: TObject); else begin itMonitor.Enabled := False; - Self.Close + Self.Close; end; end; -procedure TfrmMain.ExceptionHandler(Sender : TObject; E : Exception); -begin - USimpleException.ExceptionHandle(Sender, E); -end; - end. diff --git a/updater/uMessage.lfm b/updater/uMessage.lfm index adf35e6fc..5a7145919 100644 --- a/updater/uMessage.lfm +++ b/updater/uMessage.lfm @@ -4,12 +4,12 @@ object frmMessage: TfrmMessage Top = 235 Width = 642 BorderIcons = [biSystemMenu] - Caption = 'frmMessage' + Caption = 'Help' ClientHeight = 239 ClientWidth = 642 FormStyle = fsSystemStayOnTop Position = poDesktopCenter - LCLVersion = '1.5' + LCLVersion = '1.7' object mmMessage: TMemo Left = 0 Height = 239 diff --git a/updater/uMessage.lrj b/updater/uMessage.lrj new file mode 100644 index 000000000..d4f021028 --- /dev/null +++ b/updater/uMessage.lrj @@ -0,0 +1,3 @@ +{"version":1,"strings":[ +{"hash":322608,"name":"tfrmmessage.caption","sourcebytes":[72,101,108,112],"value":"Help"} +]} diff --git a/updater/updater.lpi b/updater/updater.lpi index bbae49445..38fb9946c 100644 --- a/updater/updater.lpi +++ b/updater/updater.lpi @@ -1,7 +1,7 @@ <?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="9"/> + <Version Value="10"/> <PathDelim Value="\"/> <General> <SessionStorage Value="InProjectDir"/> @@ -18,12 +18,11 @@ <VersionInfo> <UseVersionInfo Value="True"/> <MajorVersionNr Value="2"/> - <MinorVersionNr Value="2"/> - <RevisionNr Value="1"/> + <MinorVersionNr Value="5"/> <Attributes pvaPrivateBuild="True"/> <StringTable FileDescription="Updater for Free Manga Downloader" LegalCopyright="©2015 FMD Project Team" OriginalFilename="updater.exe" ProductName="Updater" ProductVersion="$BuildMode()" PrivateBuild="Cholif"/> </VersionInfo> - <BuildModes Count="2"> + <BuildModes Count="4"> <Item1 Name="Win32" Default="True"/> <Item2 Name="Win64"> <CompilerOptions> @@ -34,7 +33,7 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits\SimpleException;..\baseunits"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\SimpleException"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> @@ -42,8 +41,9 @@ <TargetCPU Value="x86_64"/> <TargetOS Value="win64"/> <Optimizations> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="4"/> </Optimizations> + <SmallerCode Value="True"/> </CodeGeneration> <Linking> <Debugging> @@ -59,6 +59,64 @@ </Linking> </CompilerOptions> </Item2> + <Item3 Name="Win32 Debug"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\updater"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\SimpleException"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <TargetCPU Value="i386"/> + <TargetOS Value="win32"/> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + </Item3> + <Item4 Name="Win64 Debug"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\updater"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\SimpleException"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <TargetCPU Value="x86_64"/> + <TargetOS Value="win64"/> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + </Item4> </BuildModes> <PublishOptions> <Version Value="2"/> @@ -68,10 +126,13 @@ <FormatVersion Value="1"/> </local> </RunParams> - <RequiredPackages Count="1"> + <RequiredPackages Count="2"> <Item1> - <PackageName Value="LCL"/> + <PackageName Value="laz_synapse"/> </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> </RequiredPackages> <Units Count="4"> <Unit0> @@ -106,7 +167,7 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> - <OtherUnitFiles Value="..\3rd\synapse\source;..\baseunits\SimpleException;..\baseunits"/> + <OtherUnitFiles Value="..\baseunits;..\baseunits\SimpleException"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <CodeGeneration> @@ -114,8 +175,9 @@ <TargetCPU Value="i386"/> <TargetOS Value="win32"/> <Optimizations> - <OptimizationLevel Value="3"/> + <OptimizationLevel Value="4"/> </Optimizations> + <SmallerCode Value="True"/> </CodeGeneration> <Linking> <Debugging> diff --git a/updaterslim/updater.lpi b/updaterslim/updater.lpi new file mode 100644 index 000000000..10f27a086 --- /dev/null +++ b/updaterslim/updater.lpi @@ -0,0 +1,103 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <MainUnitHasScaledStatement Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="updater"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + </General> + <BuildModes Count="2"> + <Item1 Name="Win32" Default="True"/> + <Item2 Name="Win64"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\updater"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="x86_64"/> + <TargetOS Value="win64"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + </CompilerOptions> + </Item2> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="updater.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="..\bin\updater"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="i386"/> + <TargetOS Value="win32"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + <SmallerCode Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/updaterslim/updater.lpr b/updaterslim/updater.lpr new file mode 100644 index 000000000..38c938db9 --- /dev/null +++ b/updaterslim/updater.lpr @@ -0,0 +1,119 @@ +program updater; + +uses + {$ifdef windows} + windows, + {$else} + fileutil, + {$endif} + sysutils, process; + +const + RetryCount = 30; + +var + exefile, zipexefile, updatepackagefile, maindir, ozipexefile, oexefile: String; + counter: Integer; + +{$R *.res} + +procedure cleanupsuccess; +begin + DeleteFile(oexefile); + DeleteFile(ozipexefile); + DeleteFile(updatepackagefile); +end; + +procedure cleanupfailed; +begin + if FileExists(oexefile) then + begin + if FileExists(exefile) then + DeleteFile(oexefile) + else + RenameFile(oexefile,exefile); + end; + if FileExists(ozipexefile) then + begin + if FileExists(zipexefile) then + DeleteFile(ozipexefile) + else + RenameFile(ozipexefile,zipexefile); + end; +end; + +begin + if ParamCount<4 then + begin + writeln('Parameters insuficient, ',ParamCount,' of 4'); + readln; + exit; + end; + exefile:=ParamStr(1); + zipexefile:=ParamStr(2); + updatepackagefile:=ParamStr(3); + maindir:=ParamStr(4); + if not (FileExists(zipexefile) or FileExists(updatepackagefile)) then Exit; + oexefile:=ExtractFilePath(exefile)+'old_'+ExtractFileName(exefile); + if FileExists(oexefile) then DeleteFile(oexefile); + while true do + begin + counter:=0; + {$ifdef windows} + windows.CopyFile(pchar(exefile),pchar(oexefile),false); + {$else} + CopyFile(exefile,oexefile); + {$endif} + while FileExists(exefile) do begin + if DeleteFile(exefile) then break; + Inc(counter); + writeln('Waiting to close ',counter,'/',RetryCount,' ',exefile); + Sleep(1000); + if counter=RetryCount then break; + end; + if not FileExists(exefile) then + begin + with TProcess.Create(nil) do try + ozipexefile:=ExtractFilePath(zipexefile)+'old_'+ExtractFileName(zipexefile); + if FileExists(ozipexefile) then + DeleteFile(ozipexefile); + RenameFile(zipexefile,ozipexefile); + Executable:=ozipexefile; + CurrentDirectory:=maindir; + Parameters.Add('x'); + Parameters.Add(updatepackagefile); + Parameters.Add('-o'+AnsiQuotedStr(maindir,'"')); + Parameters.Add('-aoa'); + Options:=Options+[poWaitOnExit]; + Execute; + if ExitStatus=0 then + begin + cleanupsuccess; + Executable:=exefile; + Parameters.Clear; + Options:=Options-[poWaitOnExit]; + Execute; + Break; + end + else + begin + cleanupfailed; + writeln; + writeln('Press enter to retry.'); + readln; + end; + finally + Free; + end; + end + else + begin + cleanupfailed; + writeln; + writeln('Can''t delete file ',exefile); + writeln('Press enter to retry.'); + readln; + end; + end; +end. +